module Control.Category.Dual
( Dual(..)
) where
import Prelude hiding ((.), id)
import Control.Category
import Data.Data (Data(..), mkDataType, DataType, mkConstr, Constr, constrIndex, Fixity(..))
import Data.Typeable (Typeable2(..), TyCon, mkTyCon, mkTyConApp, gcast1)
data Dual k a b = Dual { runDual :: k b a }
instance Category k => Category (Dual k) where
id = Dual id
Dual f . Dual g = Dual (g . f)
instance Typeable2 (~>) => Typeable2 (Dual (~>)) where
typeOf2 tfab = mkTyConApp dataTyCon [typeOf2 (undefined `asDualArgsType` tfab)]
where asDualArgsType :: f b a -> t f a b -> f b a
asDualArgsType = const
dataTyCon :: TyCon
dataTyCon = mkTyCon "Control.Category.Dual.Dual"
dualConstr :: Constr
dualConstr = mkConstr dataDataType "Dual" [] Prefix
dataDataType :: DataType
dataDataType = mkDataType "Control.Category.Dual.Dual" [dualConstr]
instance (Typeable2 (~>), Data a, Data b, Data (b ~> a)) => Data (Dual (~>) a b) where
gfoldl f z (Dual a) = z Dual `f` a
toConstr _ = dualConstr
gunfold k z c = case constrIndex c of
1 -> k (z Dual)
_ -> error "gunfold"
dataTypeOf _ = dataDataType
dataCast1 f = gcast1 f