    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Language.Haskell.Exts.Annotated.Build
    -- Copyright   :  (c) The GHC Team, 1997-2000,
    --                (c) Niklas Broberg 2004
    -- License     :  BSD-style (see the file LICENSE.txt)
    --
    -- Maintainer  :  Niklas Broberg, d00nibro@chalmers.se
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- This module contains combinators to use when building
    -- Haskell source trees programmatically, as opposed to
    -- parsing them from a string. The contents here are quite
    -- experimental and will likely receive a lot of attention
    -- when the rest has stabilised.
    --
    -----------------------------------------------------------------------------

    module Language.Haskell.Exts.Annotated.Build (

        -- * Syntax building functions
        name,       -- :: String -> Name
        sym,        -- :: String -> Name
        var,        -- :: Name -> Exp
        op,         -- :: Name -> QOp
        qvar,       -- :: Module -> Name -> Exp
        pvar,       -- :: Name -> Pat
        app,        -- :: Exp -> Exp -> Exp
        infixApp,   -- :: Exp -> QOp -> Exp -> Exp
        appFun,     -- :: Exp -> [Exp] -> Exp
        pApp,       -- :: Name -> [Pat] -> Pat
        tuple,      -- :: [Exp] -> Exp
        pTuple,     -- :: [Pat] -> Pat
        varTuple,   -- :: [Name] -> Exp
        pvarTuple,  -- :: [Name] -> Pat
        function,   -- :: String -> Exp
        strE,       -- :: String -> Exp
        charE,      -- :: Char -> Exp
        intE,       -- :: Integer -> Exp
        strP,       -- :: String -> Pat
        charP,      -- :: Char -> Pat
        intP,       -- :: Integer -> Pat
        doE,        -- :: [Stmt] -> Exp
        lamE,       -- :: SrcLoc -> [Pat] -> Exp -> Exp
        letE,       -- :: [Decl] -> Exp -> Exp
        caseE,      -- :: Exp -> [Alt] -> Exp
        alt,        -- :: SrcLoc -> Pat -> Exp -> Alt
        altGW,      -- :: SrcLoc -> Pat -> [Stmt] -> Exp -> Binds -> Alt
        listE,      -- :: [Exp] -> Exp
        eList,      -- :: Exp
        peList,     -- :: Pat
        paren,      -- :: Exp -> Exp
        pParen,     -- :: Pat -> Pat
        qualStmt,   -- :: Exp -> Stmt
        genStmt,    -- :: SrcLoc -> Pat -> Exp -> Stmt
        letStmt,    -- :: [Decl] -> Stmt
        binds,      -- :: [Decl] -> Binds
        noBinds,    -- :: Binds
        wildcard,   -- :: Pat
        genNames,   -- :: String -> Int -> [Name]

        -- * More advanced building
        sfun,           -- :: SrcLoc -> Name -> [Name] -> Rhs -> Binds -> Decl
        simpleFun,      -- :: SrcLoc -> Name -> Name -> Exp -> Decl
        patBind,        -- :: SrcLoc -> Pat -> Exp -> Decl
        patBindWhere,   -- :: SrcLoc -> Pat -> Exp -> [Decl] -> Decl
        nameBind,       -- :: SrcLoc -> Name -> Exp -> Decl
        metaFunction,   -- :: String -> [Exp] -> Exp
        metaConPat      -- :: String -> [Pat] -> Pat
      ) where

    import Language.Haskell.Exts.Annotated.Syntax

    -----------------------------------------------------------------------------
    -- Help functions for Abstract syntax

    -- | An identifier with the given string as its name.
    --   The string should be a valid Haskell identifier.
    name :: l -> String -> Name l
    name = Ident

    -- | A symbol identifier. The string should be a valid
    --   Haskell symbol identifier.
    sym :: l -> String -> Name l
    sym = Symbol

    -- | A local variable as expression.
    var :: l -> Name l -> Exp l
    var l = Var l . UnQual l

    -- | Use the given identifier as an operator.
    op :: l -> Name l -> QOp l
    op l = QVarOp l . UnQual l

    -- | A qualified variable as expression.
    qvar :: l -> ModuleName l -> Name l -> Exp l
    qvar l m = Var l . Qual l m

    -- | A pattern variable.
    pvar :: l -> Name l -> Pat l
    pvar = PVar

    -- | Application of expressions by juxtaposition.
    app :: l -> Exp l -> Exp l -> Exp l
    app = App

    -- | Apply an operator infix.
    infixApp :: l -> Exp l -> QOp l -> Exp l -> Exp l
    infixApp = InfixApp

    -- | Apply a function to a list of arguments.
    appFun :: [l] -> Exp l -> [Exp l] -> Exp l
    appFun _ f [] = f
    appFun (l:ls) f (a:as) = appFun ls (app l f a) as

    -- | A constructor pattern, with argument patterns.
    pApp :: l -> Name l -> [Pat l] -> Pat l
    pApp l n = PApp l (UnQual l n)

    -- | A tuple expression.
    tuple :: l -> [Exp l] -> Exp l
    tuple = Tuple

    -- | A tuple pattern.
    pTuple :: l -> [Pat l] -> Pat l
    pTuple = PTuple

    -- | A tuple expression consisting of variables only.
    varTuple :: l -> [Name l] -> Exp l
    varTuple l ns = tuple l $ map (var l) ns

    -- | A tuple pattern consisting of variables only.
    pvarTuple :: l -> [Name l] -> Pat l
    pvarTuple l ns = pTuple l $ map (pvar l) ns

    -- | A function with a given name.
    function :: l -> String -> Exp l
    function l = var l . Ident l

    -- | A literal string expression.
    strE :: l -> String -> Exp l
    strE l s = Lit l $ String l s s

    -- | A literal character expression.
    charE :: l -> Char -> Exp l
    charE l c = Lit l $ Char l c [c]

    -- | A literal integer expression.
    intE :: l -> Integer -> Exp l
    intE l i = Lit l $ Int l i (show i)

    -- | A literal string pattern.
    strP :: l -> String -> Pat l
    strP l s = PLit l $ String l s s

    -- | A literal character pattern.
    charP :: l -> Char -> Pat l
    charP l c = PLit l $ Char l c [c]

    -- | A literal integer pattern.
    intP :: l -> Integer -> Pat l
    intP l i = PLit l $ Int l i (show i)

    -- | A do block formed by the given statements.
    --   The last statement in the list should be
    --   a 'Qualifier' expression.
    doE :: l -> [Stmt l] -> Exp l
    doE = Do

    -- | Lambda abstraction, given a list of argument
    --   patterns and an expression body.
    lamE :: l -> [Pat l] -> Exp l -> Exp l
    lamE = Lambda

    -- | A @let@ ... @in@ block.
    letE :: l -> [Decl l] -> Exp l -> Exp l
    letE l ds e = Let l (binds l ds) e

    -- | A @case@ expression.
    caseE :: l -> Exp l -> [Alt l] -> Exp l
    caseE = Case

    -- | An unguarded alternative in a @case@ expression.
    alt :: l -> Pat l -> Exp l -> Alt l
    alt l p e = Alt l p (unGAlt l e) Nothing

    -- | An alternative with a single guard in a @case@ expression.
    altGW :: l -> Pat l -> [Stmt l] -> Exp l -> Binds l -> Alt l
    altGW l p gs e w = Alt l p (gAlt l gs e) (Just w)

    -- | An unguarded righthand side of a @case@ alternative.
    unGAlt :: l -> Exp l -> GuardedAlts l
    unGAlt = UnGuardedAlt

    -- | An list of guarded righthand sides for a @case@ alternative.
    gAlts :: l -> [([Stmt l], Exp l)] -> GuardedAlts l
    gAlts l as = GuardedAlts l $ map (\(gs,e) -> GuardedAlt l gs e) as

    -- | A single guarded righthand side for a @case@ alternative.
    gAlt :: l -> [Stmt l] -> Exp l -> GuardedAlts l
    gAlt l gs e = gAlts l [(gs,e)]

    -- | A list expression.
    listE :: l -> [Exp l] -> Exp l
    listE = List

    -- | The empty list expression.
    eList :: l -> Exp l
    eList l = List l []

    -- | The empty list pattern.
    peList :: l -> Pat l
    peList l = PList l []

    -- | Put parentheses around an expression.
    paren :: l -> Exp l -> Exp l
    paren = Paren

    -- | Put parentheses around a pattern.
    pParen :: l -> Pat l -> Pat l
    pParen = PParen

    -- | A qualifier expression statement.
    qualStmt :: l -> Exp l -> Stmt l
    qualStmt = Qualifier

    -- | A generator statement: /pat/ @<-@ /exp/
    genStmt :: l -> Pat l -> Exp l -> Stmt l
    genStmt = Generator

    -- | A @let@ binding group as a statement.
    letStmt :: l -> [Decl l] -> Stmt l
    letStmt l ds = LetStmt l $ binds l ds

    -- | Hoist a set of declarations to a binding group.
    binds :: l -> [Decl l] -> Binds l
    binds = BDecls

    -- | An empty binding group.
    noBinds :: l -> Binds l
    noBinds l = binds l []

    -- | The wildcard pattern: @_@
    wildcard :: l -> Pat l
    wildcard = PWildCard

    -- | Generate k names by appending numbers 1 through k to a given string.
    genNames :: l -> String -> Int -> [Name l]
    genNames l s k = [ Ident l $ s ++ show i | i <- [1..k] ]

    -------------------------------------------------------------------------------
    -- Some more specialised help functions

    -- | A function with a single clause
    sfun :: l -> Name l -> [Name l] -> Rhs l -> Maybe (Binds l) -> Decl l
    sfun l f pvs rhs mbs = FunBind l [Match l f (map (pvar l) pvs) rhs mbs]

    -- | A function with a single clause, a single argument, no guards
    -- and no where declarations
    simpleFun :: l -> Name l -> Name l -> Exp l -> Decl l
    simpleFun l f a e = let rhs = UnGuardedRhs l e
                 in sfun l f [a] rhs Nothing

    -- | A pattern bind where the pattern is a variable, and where
    -- there are no guards and no 'where' clause.
    patBind :: l -> Pat l -> Exp l -> Decl l
    patBind l p e = let rhs = UnGuardedRhs l e
             in PatBind l p Nothing rhs Nothing

    -- | A pattern bind where the pattern is a variable, and where
    -- there are no guards, but with a 'where' clause.
    patBindWhere :: l -> Pat l -> Exp l -> [Decl l] -> Decl l
    patBindWhere l p e ds = let rhs = UnGuardedRhs l e
                 in PatBind l p Nothing rhs (Just $ binds l ds)

    -- | Bind an identifier to an expression.
    nameBind :: l -> Name l -> Exp l -> Decl l
    nameBind l n e = patBind l (pvar l n) e

    -- | Apply function of a given name to a list of arguments.
    metaFunction :: l -> String -> [Exp l] -> Exp l
    metaFunction l s es = mf l s (reverse es)
      where mf l s []     = var l $ name l s
            mf l s (e:es) = app l (mf l s es) e

    -- | Apply a constructor of a given name to a list of pattern
    --   arguments, forming a constructor pattern.
    metaConPat :: l -> String -> [Pat l] -> Pat l
    metaConPat l s ps = pApp l (name l s) ps