[Haskell-cafe] Higher order functor package?
Li-yao Xia
lysxia at gmail.com
Fri Jul 7 19:10:57 UTC 2017
Hi Clinton,
This should be a compilable Literate Haskell program; a copy of your
preliminary definitions is at the end.
> {-# LANGUAGE MultiParamTypeClasses, PolyKinds,
FunctionalDependencies, TypeOperators, GADTs,
> RankNTypes, DataKinds, StandaloneDeriving, UndecidableInstances,
FlexibleContexts, InstanceSigs #-}
>
> import Control.Category
> import Prelude hiding ((.), id, Functor(..))
What you want certainly looks like a functor[1] in the general sense,
only not in the usual category that the Functortype class is specialized
for.
A more general definition of functors can be found in the categories[2]
package.
This one also abstracts over the domain and codomain categories r and t.
You obtain the standard Functor by restricting to r ~ (->), t ~ (->).
> class (Category r, Category t) => Functor f r t | f r -> t, f t -> r
where
> fmap :: r a b -> t (f a) (f b)
The expected result type of myFmap is (f t -> f u), so the codomain
category is still (->) (category of types and functions).
But t and u here are objects in a different category, which can be
defined by the (:->) type below:
> -- Objects are types (t, u, ...) of kind (Param -> *),
> -- morphisms are polymorphic functions of type (forall a. t a -> u a).
> newtype (:->) t u = HFun (forall a. t a -> u a)
You can indeed implement the type class in Control.Category, and check
the category laws...
> instance Category (:->) where
> id = HFun id
> HFun f . HFun g = HFun (f . g)
And here is a Functor instance:
> instance Functor F (:->) (->) where
> fmap :: (t :-> u) -> F t -> F u
> fmap (HFun f) (F x1 x2) = F (f x1) (f x2)
Hide away the wrapping of the (:->) newtype:
> myFmap :: Functor f (:->) (->) => (forall a. t a -> u a) -> f t -> f u
> myFmap f = fmap (HFun f)
VoilĂ .
> main = print $ myFmap f (F (TInt 42) (TBool False))
[1] https://en.wikipedia.org/wiki/Category_(mathematics)
[2] http://hackage.haskell.org/package/categories
Auxiliary definitions
> data Param = Param1 | Param2
>
> data T (p :: Param) where
> TInt :: Int -> T Param1
> TInteger :: Integer -> T Param1
> TBool :: Bool -> T Param2
>
> data U (p :: Param) where
> UDouble :: Double -> U Param1
> UString :: String -> U Param2
>
> data F (t :: Param -> *) where
> F :: t Param1 -> t Param2 -> F t
>
> f :: T a -> U a
> f (TInt x) = UDouble (fromIntegral x)
> f (TInteger x) = UDouble (fromIntegral x)
> f (TBool x) = UString (show x)
>
> deriving instance Show (U a)
> deriving instance (Show (t Param1), Show (t Param2)) => Show (F t)
More information about the Haskell-Cafe
mailing list