module Data.Derive.Traversable(makeTraversable, makeTraversableN) where
import Data.Derive.Internal.Traversal
import Data.Derive.Internal.Derivation
import Language.Haskell
makeTraversable :: Derivation
makeTraversable = makeTraversableN 1
makeTraversableN :: Int -> Derivation
makeTraversableN n = traversalDerivation1 traverseTraversal{traversalArg = n} "Traversable"
traverseTraversal = defaultTraversalType
{ traversalName = qname "traverse"
, traversalId = var "pure"
, traversalPlus = fail "variable used in multiple positions in a data type"
, traverseTuple = \args -> liftAN (Con $ Special $ TupleCon Unboxed $ length args) args
, traverseCtor = \ctor -> liftAN (con ctor)
, traverseFunc = \pat rhs -> Match sl (name "") [pVar "_f", pat] Nothing (UnGuardedRhs rhs) (BDecls [])
}
liftAN :: Exp -> [Exp] -> Exp
liftAN base args = foldl (<*>) (appP (var "pure") base) args
where x <*> y = InfixApp (paren x) (QVarOp $ UnQual $ Symbol "<*>") (paren y)