module Data.Derive.PlateTypeable(makePlateTypeable) where
import Language.Haskell.TH.All
#ifdef GUESS
import Data.Generics.PlateTypeable
import Data.DeriveGuess
import Data.Typeable
example = (,) "PlateTypeable" [d|
instance (PlateAll a (DataName a), Typeable a) => Uniplate (DataName a) where
uniplate = uniplateAll
instance (Typeable t, Typeable a, Uniplate t, PlateAll a t) => PlateAll (DataName a) t where
plateAll CtorZero = plate CtorZero
plateAll (CtorOne x1) = plate CtorOne |+ x1
plateAll (CtorTwo x1 x2) = plate CtorTwo |+ x1 |+ x2
plateAll (CtorTwo' x1 x2) = plate CtorTwo' |+ x1 |+ x2
|]
#endif
makePlateTypeable :: Derivation
makePlateTypeable = derivation plateTypeable' "PlateTypeable"
plateTypeable' dat = [InstanceD (concat ([(map (\tdat -> (AppT (AppT (ConT (
mkName "PlateAll")) tdat) (lK (dataName dat) (dataVars dat)))) (dataVars
dat)),(map (\tdat -> (AppT (ConT (mkName "Typeable")) tdat)) (dataVars dat)
)])) (head [(AppT (ConT (mkName "Uniplate")) (lK (dataName dat) (dataVars
dat)))])[(ValD (VarP (mkName "uniplate")) (NormalB (VarE (mkName
"uniplateAll"))) [])],InstanceD (concat ([[(AppT (ConT (mkName "Typeable"))
(VarT (mkName "t")))],(map (\tdat -> (AppT (ConT (mkName "Typeable")) tdat)
) (dataVars dat)),[(AppT (ConT (mkName "Uniplate")) (VarT (mkName "t")))],(
map (\tdat -> (AppT (AppT (ConT (mkName "PlateAll")) tdat) (VarT (mkName
"t")))) (dataVars dat))])) (head [(AppT (AppT (ConT (mkName "PlateAll")) (
lK (dataName dat) (dataVars dat))) (VarT (mkName "t")))])[(FunD (mkName
"plateAll") ((map (\(ctorInd,ctor) -> (Clause [(ConP (mkName ("" ++
ctorName ctor)) ((map (\field -> (VarP (mkName ("x" ++ show field)))) (id [
1..ctorArity ctor]))++[]))] (NormalB (foldr1With (VarE (mkName "|+")) ((map
(\field -> (VarE (mkName ("x" ++ show field)))) (reverse [1..ctorArity ctor
]))++[(AppE (VarE (mkName "plate")) (ConE (mkName ("" ++ ctorName ctor))))]
++[]))) [])) (id (zip [0..] (dataCtors dat))))++[]))]]