```{-# OPTIONS_GHC -fth -cpp #-}

-- | Derivation for Neil Mitchell's BinaryDefer class.  XXX: do research, write useful haddock
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))))++[])))) []]]

{-

derive dat = simple_instance "BinaryDefer" dat [funN "bothDefer" [ body ] ]
where
body = sclause [] (l1 "defer" (lst [ f ct | ct <- dataCtors dat ]))

f ctor = LamE [TildeP (ctp ctor 'v')] \$
foldl (l2 "<<") (l1 "unit" (ctc ctor)) (ctv ctor 'v')
-}
```