{-# Language TemplateHaskell #-}
module Transformation.Full.TH (deriveDownFunctor, deriveDownFoldable, deriveDownTraversable,
deriveUpFunctor, deriveUpFoldable, deriveUpTraversable)
where
import Language.Haskell.TH
import qualified Transformation
import qualified Transformation.Deep
import qualified Transformation.Full
deriveDownFunctor :: Q Type -> Q Type -> Q [Dec]
deriveDownFunctor :: Q Type -> Q Type -> Q [Dec]
deriveDownFunctor Q Type
transformation Q Type
node = do
let domain :: Q Type
domain = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Domain forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation
deepConstraint :: Q Type
deepConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Deep.Functor forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
node
fullConstraint :: Q Type
fullConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Full.Functor forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
node
shallowConstraint :: Q Type
shallowConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.At forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` (Q Type
node forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
domain forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
domain)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD (forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt [Q Type
deepConstraint, Q Type
shallowConstraint])
Q Type
fullConstraint
[forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD '(Transformation.Full.<$>) [forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [] (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> m Exp
varE 'Transformation.Full.mapDownDefault) []]]]
deriveUpFunctor :: Q Type -> Q Type -> Q [Dec]
deriveUpFunctor :: Q Type -> Q Type -> Q [Dec]
deriveUpFunctor Q Type
transformation Q Type
node = do
let codomain :: Q Type
codomain = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Codomain forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation
deepConstraint :: Q Type
deepConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Deep.Functor forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
node
fullConstraint :: Q Type
fullConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Full.Functor forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
node
shallowConstraint :: Q Type
shallowConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.At forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` (Q Type
node forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
codomain forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
codomain)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD (forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt [Q Type
deepConstraint, Q Type
shallowConstraint])
Q Type
fullConstraint
[forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD '(Transformation.Full.<$>) [forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [] (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> m Exp
varE 'Transformation.Full.mapUpDefault) []]]]
deriveDownFoldable :: Q Type -> Q Type -> Q [Dec]
deriveDownFoldable :: Q Type -> Q Type -> Q [Dec]
deriveDownFoldable Q Type
transformation Q Type
node = do
let domain :: Q Type
domain = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Domain forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation
deepConstraint :: Q Type
deepConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Deep.Foldable forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
node
fullConstraint :: Q Type
fullConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Full.Foldable forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
node
shallowConstraint :: Q Type
shallowConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.At forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` (Q Type
node forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
domain forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
domain)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD (forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt [Q Type
deepConstraint, Q Type
shallowConstraint])
Q Type
fullConstraint
[forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD 'Transformation.Full.foldMap [forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [] (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> m Exp
varE 'Transformation.Full.foldMapDownDefault) []]]]
deriveUpFoldable :: Q Type -> Q Type -> Q [Dec]
deriveUpFoldable :: Q Type -> Q Type -> Q [Dec]
deriveUpFoldable Q Type
transformation Q Type
node = do
let codomain :: Q Type
codomain = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Codomain forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation
deepConstraint :: Q Type
deepConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Deep.Foldable forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
node
fullConstraint :: Q Type
fullConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Full.Foldable forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
node
shallowConstraint :: Q Type
shallowConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.At forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` (Q Type
node forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
codomain forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
codomain)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD (forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt [Q Type
deepConstraint, Q Type
shallowConstraint])
Q Type
fullConstraint
[forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD 'Transformation.Full.foldMap [forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [] (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> m Exp
varE 'Transformation.Full.foldMapUpDefault) []]]]
deriveDownTraversable :: Q Type -> Q Type -> Q [Dec]
deriveDownTraversable :: Q Type -> Q Type -> Q [Dec]
deriveDownTraversable Q Type
transformation Q Type
node = do
let domain :: Q Type
domain = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Domain forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation
deepConstraint :: Q Type
deepConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Deep.Traversable forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
node
fullConstraint :: Q Type
fullConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Full.Traversable forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
node
shallowConstraint :: Q Type
shallowConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.At forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` (Q Type
node forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
domain forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
domain)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD (forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt [Q Type
deepConstraint, Q Type
shallowConstraint])
Q Type
fullConstraint
[forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD 'Transformation.Full.traverse [forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [] (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> m Exp
varE 'Transformation.Full.traverseDownDefault) []]]]
deriveUpTraversable :: Q Type -> Q Type -> Q [Dec]
deriveUpTraversable :: Q Type -> Q Type -> Q [Dec]
deriveUpTraversable Q Type
transformation Q Type
node = do
let codomain :: Q Type
codomain = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Codomain forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation
deepConstraint :: Q Type
deepConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Deep.Traversable forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
node
fullConstraint :: Q Type
fullConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.Full.Traversable forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
node
shallowConstraint :: Q Type
shallowConstraint = forall (m :: * -> *). Quote m => Name -> m Type
conT ''Transformation.At forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
transformation forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` (Q Type
node forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
codomain forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
codomain)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD (forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt [Q Type
deepConstraint, Q Type
shallowConstraint])
Q Type
fullConstraint
[forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD 'Transformation.Full.traverse [forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [] (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> m Exp
varE 'Transformation.Full.traverseUpDefault) []]]]