module Data.Derive.PlateDirect(makePlateDirect) where
import Language.Haskell.TH.All
makePlateDirect :: Derivation
makePlateDirect = derivation plateDirect' "PlateDirect"
plateDirect' :: Dec -> [Dec]
plateDirect' (DataD _ typ [] cs _) =
[InstanceD [] (l2 "PlateAll" t t) [funN "plateAll" [sclause [] (l0 "plateSelf")]]
,InstanceD [] (l1 "PlateOne" t) [funN "plateOne" (map f cs)]
]
where
t = l0 $ show typ
f x = sclause [ctp x 'x'] $ foldl1 AppE args
where args = l1 "plate" (l0 $ ctorName x) : zipWith g (ctv x 'x') (ctorTypes x)
g s (AppT (ConT c) t) | show c == "[]" = g s (AppT ListT t)
g s (AppT ListT (ConT t)) | t == typ = l1 "||*" s
g s (AppT ListT _) = l1 "||+" s
g s (ConT t) | t == typ = l1 "|*" s
g s _ = l1 "|+" s
plateDirect' (NewtypeD a b c d e) = plateDirect' (DataD a b c [d] e)
plateDirect' _ = []