module Data.Derive.BinaryDefer(makeBinaryDefer) where
import Language.Haskell.TH.All hiding (unit)
#ifdef GUESS
import Data.DeriveGuess
import Data.Binary.Defer
instance Eq (DataName a) where
example = (,) "BinaryDefer" [d|
instance BinaryDefer a => BinaryDefer (DataName a) where
bothDefer = defer [\ ~(CtorZero) -> unit CtorZero
,\ ~(CtorOne x1) -> unit CtorOne << x1
,\ ~(CtorTwo x1 x2) -> unit CtorTwo << x1 << x2
,\ ~(CtorTwo' x1 x2) -> unit CtorTwo' << x1 << x2
]
|]
#endif
makeBinaryDefer :: Derivation
makeBinaryDefer = derivation binarydefer' "BinaryDefer"
binarydefer' dat = [instance_context ["BinaryDefer"] "BinaryDefer" dat [ValD (
VarP (mkName "bothDefer")) (NormalB (AppE (VarE (mkName "defer")) (ListE ((
map (\(ctorInd,ctor) -> (LamE [(TildeP (ConP (mkName (ctorName ctor)) ((map
(\field -> (VarP (mkName ("x" ++ show field)))) (id [1..ctorArity ctor]))++
[])))] (foldr1With (VarE (mkName "<<")) ((map (\field -> (VarE (mkName ("x"
++ show field)))) (reverse [1..ctorArity ctor]))++[(AppE (VarE (mkName
"unit")) (ConE (mkName (ctorName ctor))))]++[])))) (id (zip [0..] (
dataCtors dat))))++[])))) []]]