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

    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 EpaLocation) (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
    <+> Int -> SDoc
    ppr_bars (Int
    alt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) SDoc -> SDoc -> SDoc
    <+> LocatedA b -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LocatedA b
    e SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    ppr_bars (Int
    arity Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    alt)
                  SDoc -> SDoc -> SDoc
    <+> SDoc
    parClose
        Tuple [Either (EpAnn EpaLocation) (LocatedA b)]
    xs ->
          SDoc
    parOpen SDoc -> SDoc -> SDoc
    <> ([SDoc] -> SDoc
    fcat ([SDoc] -> SDoc) -> ([SDoc] -> [SDoc]) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (Either (EpAnn EpaLocation) (LocatedA b) -> SDoc)
    -> [Either (EpAnn EpaLocation) (LocatedA b)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Either (EpAnn EpaLocation) (LocatedA b) -> SDoc
    forall {a} {a}. Outputable a => Either a a -> SDoc
    ppr_tup [Either (EpAnn EpaLocation) (LocatedA b)]
    xs)
                  SDoc -> SDoc -> SDoc
    <> SDoc
    parClose
      where
        ppr_tup :: Either a a -> SDoc
    ppr_tup (Left a
    _)  = SDoc
    empty
        ppr_tup (Right a
    e) = a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    e

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

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

    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 (L SrcSpanAnnA
    _ PatBuilder GhcPs
    p) AnnParen
    _) = SDoc -> SDoc
    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
    <+> PatBuilder GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PatBuilder GhcPs
    p2
      ppr (PatBuilderAppType (L SrcSpanAnnA
    _ PatBuilder GhcPs
    p) HsPatSigType GhcPs
    t) = PatBuilder GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PatBuilder GhcPs
    p SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "@" SDoc -> SDoc -> SDoc
    <> HsPatSigType GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsPatSigType GhcPs
    t
      ppr (PatBuilderOpApp (L SrcSpanAnnA
    _ PatBuilder GhcPs
    p1) LocatedN RdrName
    op (L SrcSpanAnnA
    _ PatBuilder GhcPs
    p2) EpAnn [AddEpAnn]
    _) = PatBuilder GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PatBuilder GhcPs
    p1 SDoc -> SDoc -> SDoc
    <+> LocatedN RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LocatedN RdrName
    op SDoc -> SDoc -> SDoc
    <+> 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
    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 (t :: * -> *) a. Foldable t => t a -> [a]
    toList OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
    OrdList (LHsType 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 GenLocated SrcSpanAnnA (HsType GhcPs)
    LHsType GhcPs
    lhs SDoc -> SDoc -> SDoc
    <+> LocatedN RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LocatedN RdrName
    data_con SDoc -> SDoc -> SDoc
    <+> GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GenLocated SrcSpanAnnA (HsType GhcPs)
    LHsType GhcPs
    rhs

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