    {-# OPTIONS_HADDOCK hide #-}
    module Language.Haskell.Exts.ParseSyntax where

    import Language.Haskell.Exts.Annotated.Syntax hiding ( Type(..), Asst(..), Exp(..), FieldUpdate(..), XAttr(..), Context(..) )
    import qualified Language.Haskell.Exts.Annotated.Syntax as S ( Type(..), Asst(..), Exp(..), FieldUpdate(..), XAttr(..), Context(..) )

    ---------------------------------------
    -- Expressions as we parse them (and patters, and regular patterns)

    data PExp l
        = Var l (QName l)                       -- ^ variable
        | IPVar l (IPName l)                    -- ^ implicit parameter variable
        | Con l (QName l)                       -- ^ data constructor
        | Lit l (Literal l)                     -- ^ literal constant
        | InfixApp l (PExp l) (QOp l) (PExp l)  -- ^ infix application
        | App l (PExp l) (PExp l)               -- ^ ordinary application
        | NegApp l (PExp l)                     -- ^ negation expression @-@ /exp/
        | Lambda l [Pat l] (PExp l)             -- ^ lambda expression
        | Let l (Binds l) (PExp l)              -- ^ local declarations with @let@
        | If l (PExp l) (PExp l) (PExp l)       -- ^ @if@ /exp/ @then@ /exp/ @else@ /exp/
        | Case l (PExp l) [Alt l]               -- ^ @case@ /exp/ @of@ /alts/
        | Do l [Stmt l]                         -- ^ @do@-expression:
                                                --   the last statement in the list
                                                --   should be an expression.
        | MDo l [Stmt l]                        -- ^ @mdo@-expression
    --    | Tuple [PExp]                        -- ^ tuple expression
        | TupleSection l [Maybe (PExp l)]       -- ^ tuple section expression, e.g. @(,,3)@
        | List l [PExp l]                       -- ^ list expression
        | Paren l (PExp l)                      -- ^ parenthesized expression
    --     RightSection QOp PExp                -- ^ right section @(@/qop/ /exp/@)@
        | RecConstr l (QName l) [PFieldUpdate l]
                                                -- ^ record construction expression
        | RecUpdate l (PExp l) [PFieldUpdate l]
                                                -- ^ record update expression
        | EnumFrom l (PExp l)                   -- ^ unbounded arithmetic sequence,
                                                --   incrementing by 1
        | EnumFromTo l (PExp l) (PExp l)        -- ^ bounded arithmetic sequence,
                                                --   incrementing by 1
        | EnumFromThen l (PExp l) (PExp l)      -- ^ unbounded arithmetic sequence,
                                                --   with first two elements given
        | EnumFromThenTo l (PExp l) (PExp l) (PExp l)
                                                -- ^ bounded arithmetic sequence,
                                                --   with first two elements given
        | ParComp l (PExp l) [[QualStmt l]]     -- ^ parallel list comprehension
        | ExpTypeSig l (PExp l) (S.Type l)      -- ^ expression type signature
        | AsPat l (Name l) (PExp l)             -- ^ patterns only
        | WildCard l                            -- ^ patterns only
        | IrrPat l (PExp l)                     -- ^ patterns only

    -- Post-ops for parsing left sections and regular patterns. Not to be left in the final tree.
        | PostOp l (PExp l) (QOp l)             -- ^ post-ops
        | PreOp l (QOp l) (PExp l)              -- ^ pre-ops

    -- View patterns
        | ViewPat l (PExp l) (PExp l)           -- ^ patterns only

    -- HaRP
        | SeqRP l [PExp l]                      -- ^ regular patterns only
        | GuardRP l (PExp l) [Stmt l]           -- ^ regular patterns only
        | EitherRP l (PExp l) (PExp l)          -- ^ regular patterns only
        | CAsRP l (Name l) (PExp l)             -- ^ regular patterns only

    -- Template Haskell
        | VarQuote l (QName l)                  -- ^ 'x
        | TypQuote l (QName l)                  -- ^ ''T
        | BracketExp l (Bracket l)
        | SpliceExp l (Splice l)
        | QuasiQuote l String String            -- ^ [$...|...]

    -- Hsx
        | XTag  l (XName l) [ParseXAttr l] (Maybe (PExp l)) [PExp l]
                                                -- ^ <Name>...</Name>
        | XETag l (XName l) [ParseXAttr l] (Maybe (PExp l))
                                                -- ^ <Name />
        | XPcdata l String                      -- ^ PCDATA
        | XExpTag l (PExp l)                    -- ^ <% ... %>
        | XRPats l [PExp l]                     -- ^ <[ ... ]>

    -- Pragmas
        | CorePragma l      String  (PExp l)    -- ^ {-# CORE #-} pragma
        | SCCPragma  l      String  (PExp l)    -- ^ {-# SCC #-} pragma
        | GenPragma  l      String (Int, Int) (Int, Int) (PExp l)
                                                -- ^ {-# GENERATED ... #-} pragma

    -- Generics
        | ExplTypeArg l (QName l) (S.Type l)    -- ^ f {| Int |} x = ...

    -- Bang Patterns
        | BangPat l (PExp l)                    -- ^ f !a = ...

    -- Arrows
        | Proc l (Pat l) (PExp l)               -- ^ proc p -> do
        | LeftArrApp      l (PExp l) (PExp l)   -- ^ e -< e
        | RightArrApp     l (PExp l) (PExp l)   -- ^ e >- e
        | LeftArrHighApp  l (PExp l) (PExp l)   -- ^ e -<< e
        | RightArrHighApp l (PExp l) (PExp l)   -- ^ e >>- e
       deriving (Eq,Show)

    data PFieldUpdate l
        = FieldUpdate l (QName l) (PExp l)
        | FieldPun l (Name l)
        | FieldWildcard l
      deriving (Eq,Show)

    data ParseXAttr l = XAttr l (XName l) (PExp l)
      deriving (Eq,Show)

    instance Annotated PExp where
        ann e = case e of
            Var l qn        -> l
            IPVar l ipn     -> l
            Con l qn        -> l
            Lit l lit       -> l
            InfixApp l e1 qop e2    -> l
            App l e1 e2     -> l
            NegApp l e      -> l
            Lambda l ps e   -> l
            Let l bs e      -> l
            If l ec et ee   -> l
            Case l e alts   -> l
            Do l ss         -> l
            MDo l ss        -> l
            TupleSection l mes  -> l
            List l es       -> l
            Paren l e       -> l
            RecConstr l qn fups     -> l
            RecUpdate l e  fups     -> l
            EnumFrom l e            -> l
            EnumFromTo l ef et      -> l
            EnumFromThen l ef et    -> l
            EnumFromThenTo l ef eth eto -> l
            ParComp  l e qsss       -> l
            ExpTypeSig l e t        -> l
            AsPat l n e             -> l
            WildCard l              -> l
            IrrPat l e              -> l
            PostOp l e op           -> l
            PreOp l op e            -> l
            ViewPat l e1 e2         -> l
            SeqRP l es              -> l
            GuardRP l e ss          -> l
            EitherRP l e1 e2        -> l
            CAsRP l n e             -> l

            VarQuote l qn           -> l
            TypQuote l qn           -> l
            BracketExp l br         -> l
            SpliceExp l sp          -> l
            QuasiQuote l sn se      -> l

            XTag  l xn xas me es    -> l
            XETag l xn xas me       -> l
            XPcdata l s             -> l
            XExpTag l e             -> l
            XRPats l es             -> l

            CorePragma l s e   -> l
            SCCPragma  l s e   -> l
            GenPragma  l s n12 n34 e -> l

            ExplTypeArg l qn t      -> l
            BangPat l e             -> l

            Proc            l p e   -> l
            LeftArrApp      l e1 e2 -> l
            RightArrApp     l e1 e2 -> l
            LeftArrHighApp  l e1 e2 -> l
            RightArrHighApp l e1 e2 -> l

        amap f e = case e of
            Var l qn                -> Var   (f l) qn
            IPVar l ipn             -> IPVar (f l) ipn
            Con l qn                -> Con   (f l) qn
            Lit l lit               -> Lit   (f l) lit
            InfixApp l e1 qop e2    -> InfixApp (f l) e1 qop e2
            App l e1 e2             -> App (f l) e1 e2
            NegApp l e              -> NegApp (f l) e
            Lambda l ps e           -> Lambda (f l) ps e
            Let l bs e              -> Let (f l) bs e
            If l ec et ee           -> If (f l) ec et ee
            Case l e alts           -> Case (f l) e alts
            Do l ss                 -> Do (f l) ss
            MDo l ss                -> MDo (f l) ss
            TupleSection l mes      -> TupleSection (f l) mes
            List l es               -> List (f l) es
            Paren l e               -> Paren (f l) e
            RecConstr l qn fups     -> RecConstr (f l) qn fups
            RecUpdate l e  fups     -> RecUpdate (f l) e  fups
            EnumFrom l e            -> EnumFrom (f l) e
            EnumFromTo l ef et      -> EnumFromTo (f l) ef et
            EnumFromThen l ef et    -> EnumFromThen (f l) ef et
            EnumFromThenTo l ef eth eto -> EnumFromThenTo (f l) ef eth eto
            ParComp  l e qsss       -> ParComp  (f l) e qsss
            ExpTypeSig l e t        -> ExpTypeSig (f l) e t

            AsPat l n e             -> AsPat (f l) n e
            WildCard l              -> WildCard (f l)
            IrrPat l e              -> IrrPat (f l) e
            PostOp l e op           -> PostOp (f l) e op
            PreOp l op e            -> PreOp (f l) op e
            ViewPat l e1 e2         -> ViewPat (f l) e1 e2
            SeqRP l es              -> SeqRP (f l) es
            GuardRP l e ss          -> GuardRP (f l) e ss
            EitherRP l e1 e2        -> EitherRP (f l) e1 e2
            CAsRP l n e             -> CAsRP (f l) n e
            ExplTypeArg l n t       -> ExplTypeArg (f l) n t
            BangPat l e             -> BangPat (f l) e

            VarQuote l qn           -> VarQuote (f l) qn
            TypQuote l qn           -> TypQuote (f l) qn
            BracketExp l br         -> BracketExp (f l) br
            SpliceExp l sp          -> SpliceExp (f l) sp
            QuasiQuote l sn se      -> QuasiQuote (f l) sn se

            XTag  l xn xas me es    -> XTag  (f l) xn xas me es
            XETag l xn xas me       -> XETag (f l) xn xas me
            XPcdata l s             -> XPcdata (f l) s
            XExpTag l e             -> XExpTag (f l) e

            CorePragma l s e        -> CorePragma (f l) s e
            SCCPragma  l s e        -> SCCPragma  (f l) s e
            GenPragma  l s n12 n34 e -> GenPragma  (f l) s n12 n34 e

            Proc            l p e   -> Proc            (f l) p e
            LeftArrApp      l e1 e2 -> LeftArrApp      (f l) e1 e2
            RightArrApp     l e1 e2 -> RightArrApp     (f l) e1 e2
            LeftArrHighApp  l e1 e2 -> LeftArrHighApp  (f l) e1 e2
            RightArrHighApp l e1 e2 -> RightArrHighApp (f l) e1 e2

    instance Functor PExp where
          fmap f e = case e of
              Var l qn                -> Var   (f l) (fmap f qn)
              IPVar l ipn             -> IPVar (f l) (fmap f ipn)
              Con l qn                -> Con   (f l) (fmap f qn)
              Lit l lit               -> Lit   (f l) (fmap f lit)
              InfixApp l e1 qop e2    -> InfixApp (f l) (fmap f e1) (fmap f qop) (fmap f e2)
              App l e1 e2             -> App (f l) (fmap f e1) (fmap f e2)
              NegApp l e              -> NegApp (f l) (fmap f e)
              Lambda l ps e           -> Lambda (f l) (map (fmap f) ps) (fmap f e)
              Let l bs e              -> Let (f l) (fmap f bs) (fmap f e)
              If l ec et ee           -> If (f l) (fmap f ec) (fmap f et) (fmap f ee)
              Case l e alts           -> Case (f l) (fmap f e) (map (fmap f) alts)
              Do l ss                 -> Do (f l) (map (fmap f) ss)
              MDo l ss                -> MDo (f l) (map (fmap f) ss)
              TupleSection l mes      -> TupleSection (f l) (map (fmap (fmap f)) mes)
              List l es               -> List (f l) (map (fmap f) es)
              Paren l e               -> Paren (f l) (fmap f e)
              RecConstr l qn fups     -> RecConstr (f l) (fmap f qn) (map (fmap f) fups)
              RecUpdate l e  fups     -> RecUpdate (f l) (fmap f e)  (map (fmap f) fups)
              EnumFrom l e            -> EnumFrom (f l) (fmap f e)
              EnumFromTo l ef et      -> EnumFromTo (f l) (fmap f ef) (fmap f et)
              EnumFromThen l ef et    -> EnumFromThen (f l) (fmap f ef) (fmap f et)
              EnumFromThenTo l ef eth eto -> EnumFromThenTo (f l) (fmap f ef) (fmap f eth) (fmap f eto)
              ParComp  l e qsss       -> ParComp  (f l) (fmap f e) (map (map (fmap f)) qsss)
              ExpTypeSig l e t        -> ExpTypeSig (f l) (fmap f e) (fmap f t)

              AsPat l n e             -> AsPat (f l) (fmap f n) (fmap f e)
              WildCard l              -> WildCard (f l)
              IrrPat l e              -> IrrPat (f l) (fmap f e)
              PostOp l e op           -> PostOp (f l) (fmap f e) (fmap f op)
              PreOp l op e            -> PreOp (f l) (fmap f op) (fmap f e)
              ViewPat l e1 e2         -> ViewPat (f l) (fmap f e1) (fmap f e2)
              SeqRP l es              -> SeqRP (f l) (map (fmap f) es)
              GuardRP l e ss          -> GuardRP (f l) (fmap f e) (map (fmap f) ss)
              EitherRP l e1 e2        -> EitherRP (f l) (fmap f e1) (fmap f e2)
              CAsRP l n e             -> CAsRP (f l) (fmap f n) (fmap f e)
              ExplTypeArg l n t       -> ExplTypeArg (f l) (fmap f n) (fmap f t)
              BangPat l e             -> BangPat (f l) (fmap f e)

              VarQuote l qn           -> VarQuote (f l) (fmap f qn)
              TypQuote l qn           -> TypQuote (f l) (fmap f qn)
              BracketExp l br         -> BracketExp (f l) (fmap f br)
              SpliceExp l sp          -> SpliceExp (f l) (fmap f sp)
              QuasiQuote l sn se      -> QuasiQuote (f l) sn se

              XTag  l xn xas me es    -> XTag  (f l) (fmap f xn) (map (fmap f) xas) (fmap (fmap f) me) (map (fmap f) es)
              XETag l xn xas me       -> XETag (f l) (fmap f xn) (map (fmap f) xas) (fmap (fmap f) me)
              XPcdata l s             -> XPcdata (f l) s
              XExpTag l e             -> XExpTag (f l) (fmap f e)

              CorePragma l s e        -> CorePragma (f l) s (fmap f e)
              SCCPragma  l s e        -> SCCPragma  (f l) s (fmap f e)
              GenPragma  l s n12 n34 e -> GenPragma  (f l) s n12 n34 (fmap f e)

              Proc            l p e   -> Proc            (f l) (fmap f p) (fmap f e)
              LeftArrApp      l e1 e2 -> LeftArrApp      (f l) (fmap f e1) (fmap f e2)
              RightArrApp     l e1 e2 -> RightArrApp     (f l) (fmap f e1) (fmap f e2)
              LeftArrHighApp  l e1 e2 -> LeftArrHighApp  (f l) (fmap f e1) (fmap f e2)
              RightArrHighApp l e1 e2 -> RightArrHighApp (f l) (fmap f e1) (fmap f e2)

    instance Functor PFieldUpdate where
        fmap f (FieldUpdate l qn e) = FieldUpdate (f l) (fmap f qn) (fmap f e)
        fmap f (FieldPun l n)       = FieldPun (f l) (fmap f n)
        fmap f (FieldWildcard l)    = FieldWildcard (f l)

    instance Annotated PFieldUpdate where
        ann (FieldUpdate l qn e) = l
        ann (FieldPun l n)       = l
        ann (FieldWildcard l)    = l
        amap f (FieldUpdate l qn e) = FieldUpdate (f l) qn e
        amap f (FieldPun l n)       = FieldPun (f l) n
        amap f (FieldWildcard l)    = FieldWildcard (f l)

    instance Functor ParseXAttr where
        fmap f (XAttr l xn e) = XAttr (f l) (fmap f xn) (fmap f e)

    instance Annotated ParseXAttr where
        ann (XAttr l _ _) = l
        amap f (XAttr l xn e) = XAttr (f l) xn e

    p_unit_con :: l -> PExp l
    p_unit_con l         = Con l (unit_con_name l)

    p_tuple_con :: l -> Boxed -> Int -> PExp l
    p_tuple_con l b i       = Con l (tuple_con_name l b i)

    p_unboxed_singleton_con :: l -> PExp l
    p_unboxed_singleton_con l = Con l (unboxed_singleton_con_name l)

    data PContext l
        = CxSingle l (PAsst l)
        | CxTuple  l [PAsst l]
        | CxParen  l (PContext l)
        | CxEmpty  l
     deriving (Eq, Show)

    instance Functor PContext where
      fmap f (CxSingle l asst) = CxSingle (f l) (fmap f asst)
      fmap f (CxTuple l assts) = CxTuple (f l) (map (fmap f) assts)
      fmap f (CxParen l ctxt)  = CxParen (f l) (fmap f ctxt)
      fmap f (CxEmpty l)       = CxEmpty (f l)

    instance Annotated PContext where
      ann (CxSingle l asst ) = l
      ann (CxTuple  l assts) = l
      ann (CxParen  l ctxt ) = l
      ann (CxEmpty  l)       = l
      amap f (CxSingle l asst ) = CxSingle (f l) asst
      amap f (CxTuple  l assts) = CxTuple  (f l) assts
      amap f (CxParen  l ctxt ) = CxParen  (f l) ctxt
      amap f (CxEmpty l) = CxEmpty (f l)

    data PType l
         = TyForall l
            (Maybe [TyVarBind l])
            (Maybe (PContext l))
            (PType l)
         | TyFun   l (PType l) (PType l)            -- ^ function type
         | TyTuple l Boxed     [PType l]            -- ^ tuple type, possibly boxed
         | TyList  l (PType l)                      -- ^ list syntax, e.g. [a], as opposed to [] a
         | TyApp   l (PType l) (PType l)            -- ^ application of a type constructor
         | TyVar   l (Name l)                       -- ^ type variable
         | TyCon   l (QName l)                      -- ^ named type or type constructor
         | TyParen l (PType l)                      -- ^ type surrounded by parentheses
         | TyPred  l (PAsst l)                      -- ^ assertion of an implicit parameter
         | TyInfix l (PType l) (QName l) (PType l)  -- ^ infix type constructor
         | TyKind  l (PType l) (Kind l)             -- ^ type with explicit kind signature
      deriving (Eq, Show)

    instance Functor PType where
        fmap f t = case t of
          TyForall l mtvs mcx t         -> TyForall (f l) (fmap (map (fmap f)) mtvs) (fmap (fmap f) mcx) (fmap f t)
          TyFun   l t1 t2               -> TyFun (f l) (fmap f t1) (fmap f t2)
          TyTuple l b ts                -> TyTuple (f l) b (map (fmap f) ts)
          TyList  l t                   -> TyList (f l) (fmap f t)
          TyApp   l t1 t2               -> TyApp (f l) (fmap f t1) (fmap f t2)
          TyVar   l n                   -> TyVar (f l) (fmap f n)
          TyCon   l qn                  -> TyCon (f l) (fmap f qn)
          TyParen l t                   -> TyParen (f l) (fmap f t)
          TyPred  l asst                -> TyPred (f l) (fmap f asst)
          TyInfix l ta qn tb            -> TyInfix (f l) (fmap f ta) (fmap f qn) (fmap f tb)
          TyKind  l t k                 -> TyKind (f l) (fmap f t) (fmap f k)

    instance Annotated PType where
        ann t = case t of
          TyForall l mtvs cx t          -> l
          TyFun   l t1 t2               -> l
          TyTuple l b ts                -> l
          TyList  l t                   -> l
          TyApp   l t1 t2               -> l
          TyVar   l n                   -> l
          TyCon   l qn                  -> l
          TyParen l t                   -> l
          TyInfix l ta qn tb            -> l
          TyKind  l t k                 -> l
        amap f t = case t of
          TyForall l mtvs mcx t         -> TyForall (f l) mtvs mcx t
          TyFun   l t1 t2               -> TyFun (f l) t1 t2
          TyTuple l b ts                -> TyTuple (f l) b ts
          TyList  l t                   -> TyList (f l) t
          TyApp   l t1 t2               -> TyApp (f l) t1 t2
          TyVar   l n                   -> TyVar (f l) n
          TyCon   l qn                  -> TyCon (f l) qn
          TyParen l t                   -> TyParen (f l) t
          TyInfix l ta qn tb            -> TyInfix (f l) ta qn tb
          TyKind  l t k                 -> TyKind (f l) t k

    data PAsst l
        = ClassA l (QName l) [PType l]
        | InfixA l (PType l) (QName l) (PType l)
        | IParam l (IPName l) (PType l)
        | EqualP l (PType l)  (PType l)
      deriving (Eq, Show)

    instance Functor PAsst where
        fmap f asst = case asst of
            ClassA l qn ts      -> ClassA (f l) (fmap f qn) (map (fmap f) ts)
            InfixA l ta qn tb   -> InfixA (f l) (fmap f ta) (fmap f qn) (fmap f tb)
            IParam l ipn t      -> IParam (f l) (fmap f ipn) (fmap f t)
            EqualP l t1 t2      -> EqualP (f l) (fmap f t1) (fmap f t2)

    instance Annotated PAsst where
        ann asst = case asst of
            ClassA l qn ts      -> l
            InfixA l ta qn tb   -> l
            IParam l ipn t      -> l
            EqualP l t1 t2      -> l
        amap f asst = case asst of
            ClassA l qn ts      -> ClassA (f l) qn ts
            InfixA l ta qn tb   -> InfixA (f l) ta qn tb
            IParam l ipn t      -> IParam (f l) ipn t
            EqualP l t1 t2      -> EqualP (f l) t1 t2

    unit_tycon, fun_tycon, list_tycon, unboxed_singleton_tycon :: l -> PType l
    unit_tycon              l = TyCon l (unit_tycon_name l)
    fun_tycon               l = TyCon l (fun_tycon_name l)
    list_tycon              l = TyCon l (list_tycon_name l)
    unboxed_singleton_tycon l = TyCon l (unboxed_singleton_tycon_name l)

    tuple_tycon :: l -> Boxed -> Int -> PType l
    tuple_tycon l b i         = TyCon l (tuple_tycon_name l b i)