module Generics.MultiRec.HFunctor where
import Control.Monad (liftM, liftM2)
import Control.Applicative (Applicative(..), (<$>), (<*>), WrappedMonad(..))
import Generics.MultiRec.Base
class HFunctor phi f where
hmapA :: (Applicative a) =>
(forall ix. phi ix -> r ix -> a (r' ix)) ->
f r ix -> a (f r' ix)
instance El phi xi => HFunctor phi (I xi) where
hmapA f (I x) = I <$> f proof x
instance HFunctor phi (K x) where
hmapA _ (K x) = pure (K x)
instance HFunctor phi U where
hmapA _ U = pure U
instance (HFunctor phi f, HFunctor phi g) => HFunctor phi (f :+: g) where
hmapA f (L x) = L <$> hmapA f x
hmapA f (R y) = R <$> hmapA f y
instance (HFunctor phi f, HFunctor phi g) => HFunctor phi (f :*: g) where
hmapA f (x :*: y) = (:*:) <$> hmapA f x <*> hmapA f y
instance HFunctor phi f => HFunctor phi (f :>: ix) where
hmapA f (Tag x) = Tag <$> hmapA f x
instance (Constructor c, HFunctor phi f) => HFunctor phi (C c f) where
hmapA f (C x) = C <$> hmapA f x
hmap :: (HFunctor phi f) =>
(forall ix. phi ix -> r ix -> r' ix) ->
f r ix -> f r' ix
hmap f x = unI0 (hmapA (\ ix x -> I0 (f ix x)) x)
hmapM :: (HFunctor phi f, Monad m) =>
(forall ix. phi ix -> r ix -> m (r' ix)) ->
f r ix -> m (f r' ix)
hmapM f x = unwrapMonad (hmapA (\ ix x -> WrapMonad (f ix x)) x)