    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE DataKinds #-}

    module GHC.Parser.Types
       ( SumOrTuple(..)
       , pprSumOrTuple
       , PatBuilder(..)
       , DataConBuilder(..)
       )
    where

    import GHC.Prelude
    import GHC.Types.Basic
    import GHC.Types.SrcLoc
    import GHC.Types.Name.Reader
    import GHC.Hs.Extension
    import GHC.Hs.Lit
    import GHC.Hs.Pat
    import GHC.Hs.Type
    import GHC.Utils.Outputable as Outputable
    import GHC.Data.OrdList

    import Data.Foldable
    import GHC.Parser.Annotation
    import Language.Haskell.Syntax

    data SumOrTuple b
      = Sum ConTag Arity (LocatedA b) [EpaLocation] [EpaLocation]
      -- ^ Last two are the locations of the '|' before and after the payload
      | Tuple [Either (EpAnn Bool) (LocatedA b)]

    pprSumOrTuple :: Outputable b => Boxity -> SumOrTuple b -> SDoc
    pprSumOrTuple :: forall b. Outputable b => Boxity -> SumOrTuple b -> SDoc
    pprSumOrTuple Boxity
    boxity = \case
        Sum Int
    alt Int
    arity LocatedA b
    e [EpaLocation]
    _ [EpaLocation]
    _ ->
          SDoc
    parOpen SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Int -> SDoc
    forall {doc}. IsLine doc => Int -> doc
    ppr_bars (Int
    alt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> LocatedA b -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LocatedA b
    e SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Int -> SDoc
    forall {doc}. IsLine doc => Int -> doc
    ppr_bars (Int
    arity Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    alt)
                  SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    parClose
        Tuple [Either (EpAnn Bool) (LocatedA b)]
    xs ->
          SDoc
    parOpen SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> ([SDoc] -> SDoc
    fcat ([SDoc] -> SDoc) -> ([SDoc] -> [SDoc]) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> [SDoc] -> [SDoc]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate SDoc
    forall doc. IsLine doc => doc
    comma ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (Either (EpAnn Bool) (LocatedA b) -> SDoc)
    -> [Either (EpAnn Bool) (LocatedA b)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Either (EpAnn Bool) (LocatedA b) -> SDoc
    forall {a} {a}. Outputable a => Either a a -> SDoc
    ppr_tup [Either (EpAnn Bool) (LocatedA b)]
    xs)
                  SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    parClose
      where
        ppr_tup :: Either a a -> SDoc
    ppr_tup (Left a
    _)  = SDoc
    forall doc. IsOutput doc => doc
    empty
        ppr_tup (Right a
    e) = a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    e

        ppr_bars :: Int -> doc
    ppr_bars Int
    n = [doc] -> doc
    forall doc. IsLine doc => [doc] -> doc
    hsep (Int -> doc -> [doc]
    forall a. Int -> a -> [a]
    replicate Int
    n (Char -> doc
    forall doc. IsLine doc => Char -> doc
    Outputable.char Char
    '|'))
        (SDoc
    parOpen, SDoc
    parClose) =
          case Boxity
    boxity of
            Boxity
    Boxed -> (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "(", String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ")")
            Boxity
    Unboxed -> (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "(#", String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "#)")

    -- | See Note [Ambiguous syntactic categories] and Note [PatBuilder]
    data PatBuilder p
      = PatBuilderPat (Pat p)
      | PatBuilderPar (EpToken "(") (LocatedA (PatBuilder p)) (EpToken ")")
      | PatBuilderApp (LocatedA (PatBuilder p)) (LocatedA (PatBuilder p))
      | PatBuilderAppType (LocatedA (PatBuilder p)) (EpToken "@") (HsTyPat GhcPs)
      | PatBuilderOpApp (LocatedA (PatBuilder p)) (LocatedN RdrName)
                        (LocatedA (PatBuilder p)) [AddEpAnn]
      | PatBuilderVar (LocatedN RdrName)
      | PatBuilderOverLit (HsOverLit GhcPs)

    -- These instances are here so that they are not orphans
    type instance Anno (GRHS GhcPs (LocatedA (PatBuilder GhcPs)))             = EpAnnCO
    type instance Anno [LocatedA (Match GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnL
    type instance Anno (Match GhcPs (LocatedA (PatBuilder GhcPs)))            = SrcSpanAnnA
    type instance Anno (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs)))     = SrcSpanAnnA

    instance Outputable (PatBuilder GhcPs) where
      ppr :: PatBuilder GhcPs -> SDoc
    ppr (PatBuilderPat Pat GhcPs
    p) = Pat GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Pat GhcPs
    p
      ppr (PatBuilderPar EpToken "("
    _ (L SrcSpanAnnA
    _ PatBuilder GhcPs
    p) EpToken ")"
    _) = SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (PatBuilder GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PatBuilder GhcPs
    p)
      ppr (PatBuilderApp (L SrcSpanAnnA
    _ PatBuilder GhcPs
    p1) (L SrcSpanAnnA
    _ PatBuilder GhcPs
    p2)) = PatBuilder GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PatBuilder GhcPs
    p1 SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> PatBuilder GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PatBuilder GhcPs
    p2
      ppr (PatBuilderAppType (L SrcSpanAnnA
    _ PatBuilder GhcPs
    p) EpToken "@"
    _ HsTyPat GhcPs
    t) = PatBuilder GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PatBuilder GhcPs
    p SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "@" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> HsTyPat GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsTyPat GhcPs
    t
      ppr (PatBuilderOpApp (L SrcSpanAnnA
    _ PatBuilder GhcPs
    p1) LocatedN RdrName
    op (L SrcSpanAnnA
    _ PatBuilder GhcPs
    p2) [AddEpAnn]
    _) = PatBuilder GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PatBuilder GhcPs
    p1 SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> LocatedN RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LocatedN RdrName
    op SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> PatBuilder GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PatBuilder GhcPs
    p2
      ppr (PatBuilderVar LocatedN RdrName
    v) = LocatedN RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LocatedN RdrName
    v
      ppr (PatBuilderOverLit HsOverLit GhcPs
    l) = HsOverLit GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsOverLit GhcPs
    l

    -- | An accumulator to build a prefix data constructor,
    --   e.g. when parsing @MkT A B C@, the accumulator will evolve as follows:
    --
    --  @
    --  1. PrefixDataConBuilder []        MkT
    --  2. PrefixDataConBuilder [A]       MkT
    --  3. PrefixDataConBuilder [A, B]    MkT
    --  4. PrefixDataConBuilder [A, B, C] MkT
    --  @
    --
    --  There are two reasons we have a separate builder type instead of using
    --  @HsConDeclDetails GhcPs@ directly:
    --
    --  1. It's faster, because 'OrdList' gives us constant-time snoc.
    --  2. Having a separate type helps ensure that we don't forget to finalize a
    --     'RecTy' into a 'RecCon' (we do that in 'dataConBuilderDetails').
    --
    --  See Note [PatBuilder] for another builder type used in the parser.
    --  Here the technique is similar, but the motivation is different.
    data DataConBuilder
      = PrefixDataConBuilder
          (OrdList (LHsType GhcPs))  -- Data constructor fields
          (LocatedN RdrName)         -- Data constructor name
      | InfixDataConBuilder
          (LHsType GhcPs)    -- LHS field
          (LocatedN RdrName) -- Data constructor name
          (LHsType GhcPs)    -- RHS field

    instance Outputable DataConBuilder where
      ppr :: DataConBuilder -> SDoc
    ppr (PrefixDataConBuilder OrdList (LHsType GhcPs)
    flds LocatedN RdrName
    data_con) =
        SDoc -> Int -> SDoc -> SDoc
    hang (LocatedN RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LocatedN RdrName
    data_con) Int
    2 ([SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    sep ((GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc)
    -> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> [GenLocated SrcSpanAnnA (HsType GhcPs)]
    forall a. OrdList a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList OrdList (LHsType GhcPs)
    OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
    flds)))
      ppr (InfixDataConBuilder LHsType GhcPs
    lhs LocatedN RdrName
    data_con LHsType GhcPs
    rhs) =
        GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsType GhcPs
    GenLocated SrcSpanAnnA (HsType GhcPs)
    lhs SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> LocatedN RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LocatedN RdrName
    data_con SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsType GhcPs
    GenLocated SrcSpanAnnA (HsType GhcPs)
    rhs

    type instance Anno [LocatedA (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnL