    {-
        This module is not written/maintained by the usual Data.Derive author.

        MAINTAINER: Twan van Laarhoven
        EMAIL: "twanvl" ++ "@" ++ "gmail" ++ "." ++ "com"

        Please send all patches to this module to Neil (ndmitchell -at- gmail),
        and CC Twan.
    -}

    -- NOTE: Cannot be guessed as it relies on type information

    module Data.Derive.Traversable(makeTraversable, makeTraversableN) where

    {-
    import Data.Traversable
    import Control.Applicative(pure, (<*>))

    instance Traversable (FailList t1) where
        traverse _f (Zoro) = pure Nil
        traverse _f (Fial a1) = pure (Fial a1)
        traverse _f (Const a1 a2) = (Const <$> _f a1) <*> traverse _f a2

    instance Traversable Sample where
        traverse _f (First) = pure First
        traverse _f (Second a1 a2) = (Second <$> _f a1) <*> _f a2
        traverse _f (Third a1) = Third <$> _f a1

    instance Traversable (Either t1) where
        traverse _f (Left a1) = pure (Left a1)
        traverse _f (Right a1) = Right <$> _f a1
    -}

    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)