-- | This module exports the templates for automatic instance deriving of "Transformation.Full" type classes. The most
-- common way to use it would be
--
-- > import qualified Transformation.Full.TH
-- > data MyDataType f' f = ...
-- > $(Transformation.Full.TH.deriveUpFunctor (conT ''MyTransformation) (conT ''MyDataType))
--

{-# 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) []]]]