    {-# LANGUAGE AllowAmbiguousTypes     #-}      -- for pprIfTc, etc.
    {-# LANGUAGE ConstraintKinds         #-}
    {-# LANGUAGE DataKinds               #-}
    {-# LANGUAGE DeriveDataTypeable      #-}
    {-# LANGUAGE EmptyDataDeriving       #-}
    {-# LANGUAGE FlexibleContexts        #-}
    {-# LANGUAGE FlexibleInstances       #-}
    {-# LANGUAGE GADTs                   #-}
    {-# LANGUAGE MultiParamTypeClasses   #-}
    {-# LANGUAGE RankNTypes              #-}
    {-# LANGUAGE ScopedTypeVariables     #-}
    {-# LANGUAGE TypeApplications        #-}
    {-# LANGUAGE TypeFamilyDependencies  #-}
    {-# LANGUAGE StandaloneDeriving      #-}
    {-# LANGUAGE UndecidableSuperClasses #-} -- for IsPass; see Note [NoGhcTc]
    {-# LANGUAGE UndecidableInstances    #-} -- Wrinkle in Note [Trees That Grow]
                                             -- in module Language.Haskell.Syntax.Extension

    {-# OPTIONS_GHC -Wno-orphans #-} -- Outputable

    module GHC.Hs.Extension where

    -- This module captures the type families to precisely identify the extension
    -- points for GHC.Hs syntax

    import GHC.Prelude

    import Data.Data hiding ( Fixity )
    import Language.Haskell.Syntax.Extension
    import GHC.Types.Name
    import GHC.Types.Name.Reader
    import GHC.Types.Var
    import GHC.Utils.Outputable hiding ((<>))
    import GHC.Types.SrcLoc (GenLocated(..), unLoc)
    import GHC.Utils.Panic
    import GHC.Parser.Annotation

    {-
    Note [IsPass]
    ~~~~~~~~~~~~~
    One challenge with the Trees That Grow approach
    is that we sometimes have different information in different passes.
    For example, we have

      type instance XViaStrategy GhcPs = LHsSigType GhcPs
      type instance XViaStrategy GhcRn = LHsSigType GhcRn
      type instance XViaStrategy GhcTc = Type

    This means that printing a DerivStrategy (which contains an XViaStrategy)
    might need to print a LHsSigType, or it might need to print a type. Yet we
    want one Outputable instance for a DerivStrategy, instead of one per pass. We
    could have a large constraint, including e.g. (Outputable (XViaStrategy p),
    Outputable (XViaStrategy GhcTc)), and pass that around in every context where
    we might output a DerivStrategy. But a simpler alternative is to pass a
    witness to whichever pass we're in. When we pattern-match on that (GADT)
    witness, we learn the pass identity and can then print away. To wit, we get
    the definition of GhcPass and the functions isPass. These allow us to do away
    with big constraints, passing around all manner of dictionaries we might or
    might not use. It does mean that we have to manually use isPass when printing,
    but these places are few.

    See Note [NoGhcTc] about the superclass constraint to IsPass.

    Note [NoGhcTc]
    ~~~~~~~~~~~~~~
    An expression is parsed into HsExpr GhcPs, renamed into HsExpr GhcRn, and
    then type-checked into HsExpr GhcTc. Not so for types! These get parsed
    into HsType GhcPs, renamed into HsType GhcRn, and then type-checked into
    Type. We never build an HsType GhcTc. Why do this? Because we need to be
    able to compare type-checked types for equality, and we don't want to do
    this with HsType.

    This causes wrinkles within the AST, where we normally think that the whole
    AST travels through the GhcPs --> GhcRn --> GhcTc pipeline as one. So we
    have the NoGhcTc type family, which just replaces GhcTc with GhcRn, so that
    user-written types can be preserved (as HsType GhcRn) even in e.g. HsExpr GhcTc.

    For example, this is used in ExprWithTySig:
        | ExprWithTySig
                    (XExprWithTySig p)

                    (LHsExpr p)
                    (LHsSigWcType (NoGhcTc p))

    If we have (e :: ty), we still want to be able to print that (with the :: ty)
    after type-checking. So we retain the LHsSigWcType GhcRn, even in an
    HsExpr GhcTc. That's what NoGhcTc does.

    When we're printing the type annotation, we need to know
    (Outputable (LHsSigWcType GhcRn)), even though we've assumed only that
    (OutputableBndrId GhcTc). We thus must be able to prove OutputableBndrId (NoGhcTc p)
    from OutputableBndrId p. The extra constraints in OutputableBndrId and
    the superclass constraints of IsPass allow this. Note that the superclass
    constraint of IsPass is *recursive*: it asserts that IsPass (NoGhcTcPass p) holds.
    For this to make sense, we need -XUndecidableSuperClasses and the other constraint,
    saying that NoGhcTcPass is idempotent.

    -}

    -- See Note [XRec and Anno in the AST] in GHC.Parser.Annotation
    type instance XRec (GhcPass p) a = GenLocated (Anno a) a

    type instance Anno RdrName = SrcSpanAnnN
    type instance Anno Name    = SrcSpanAnnN
    type instance Anno Id      = SrcSpanAnnN

    type IsSrcSpanAnn p a = ( Anno (IdGhcP p) ~ EpAnn a,
                              NoAnn a,
                              IsPass p)

    instance UnXRec (GhcPass p) where
      unXRec :: forall a. XRec (GhcPass p) a -> a
    unXRec = XRec (GhcPass p) a -> a
    GenLocated (Anno a) a -> a
    forall l e. GenLocated l e -> e
    unLoc
    instance MapXRec (GhcPass p) where
      mapXRec :: forall a b.
    (Anno a ~ Anno b) =>
    (a -> b) -> XRec (GhcPass p) a -> XRec (GhcPass p) b
    mapXRec = (a -> b) -> XRec (GhcPass p) a -> XRec (GhcPass p) b
    (a -> b) -> GenLocated (Anno b) a -> GenLocated (Anno b) b
    forall a b.
    (a -> b) -> GenLocated (Anno b) a -> GenLocated (Anno b) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap

    -- instance WrapXRec (GhcPass p) a where
    --   wrapXRec = noLocA

    {-
    Note [DataConCantHappen and strict fields]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Currently, any unused TTG extension constructor will generally look like the
    following:

      type instance XXHsDecl (GhcPass _) = DataConCantHappen
      data HsDecl p
        = ...
        | XHsDecl !(XXHsDecl p)

    The field of type `XXHsDecl p` is strict for a good reason: it allows the
    pattern-match coverage checker to conclude that any matches against XHsDecl
    are unreachable whenever `p ~ GhcPass _`. To see why this is the case, consider
    the following function which consumes an HsDecl:

      ex :: HsDecl GhcPs -> HsDecl GhcRn
      ...
      ex (XHsDecl nec) = dataConCantHappen nec

    Because `p` equals GhcPs (i.e., GhcPass 'Parsed), XHsDecl's field has the type
    DataConCantHappen. But since (1) the field is strict and (2) DataConCantHappen
    is an empty data type, there is no possible way to reach the right-hand side
    of the XHsDecl case. As a result, the coverage checker concludes that
    the XHsDecl case is inaccessible, so it can be removed.
    (See Note [Strict argument type constraints] in GHC.HsToCore.Pmc.Solver for
    more on how this works.)

    Bottom line: if you add a TTG extension constructor that uses DataConCantHappen, make
    sure that any uses of it as a field are strict.
    -}

    -- | Used as a data type index for the hsSyn AST; also serves
    -- as a singleton type for Pass
    data GhcPass (c :: Pass) where
      GhcPs :: GhcPass 'Parsed
      GhcRn :: GhcPass 'Renamed
      GhcTc :: GhcPass 'Typechecked

    -- This really should never be entered, but the data-deriving machinery
    -- needs the instance to exist.
    instance Typeable p => Data (GhcPass p) where
      gunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (GhcPass p)
    gunfold forall b r. Data b => c (b -> r) -> c r
    _ forall r. r -> c r
    _ Constr
    _ = String -> c (GhcPass p)
    forall a. HasCallStack => String -> a
    panic String
    "instance Data GhcPass"
      toConstr :: GhcPass p -> Constr
    toConstr  GhcPass p
    _   = String -> Constr
    forall a. HasCallStack => String -> a
    panic String
    "instance Data GhcPass"
      dataTypeOf :: GhcPass p -> DataType
    dataTypeOf GhcPass p
    _  = String -> DataType
    forall a. HasCallStack => String -> a
    panic String
    "instance Data GhcPass"

    data Pass = Parsed | Renamed | Typechecked
             deriving (Typeable Pass
    Typeable Pass =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> Pass -> c Pass)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c Pass)
    -> (Pass -> Constr)
    -> (Pass -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c Pass))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pass))
    -> ((forall b. Data b => b -> b) -> Pass -> Pass)
    -> (forall r r'.
        (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r)
    -> (forall r r'.
        (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r)
    -> (forall u. (forall d. Data d => d -> u) -> Pass -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> Pass -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> Pass -> m Pass)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> Pass -> m Pass)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> Pass -> m Pass)
    -> Data Pass
    Pass -> Constr
    Pass -> DataType
    (forall b. Data b => b -> b) -> Pass -> Pass
    forall a.
    Typeable a =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> a -> c a)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c a)
    -> (a -> Constr)
    -> (a -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c a))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
    -> ((forall b. Data b => b -> b) -> a -> a)
    -> (forall r r'.
        (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall r r'.
        (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall u. (forall d. Data d => d -> u) -> a -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> Data a
    forall u. Int -> (forall d. Data d => d -> u) -> Pass -> u
    forall u. (forall d. Data d => d -> u) -> Pass -> [u]
    forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r
    forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r
    forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Pass -> m Pass
    forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pass -> m Pass
    forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Pass
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Pass -> c Pass
    forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Pass)
    forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pass)
    $cgfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Pass -> c Pass
    gfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Pass -> c Pass
    $cgunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Pass
    gunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Pass
    $ctoConstr :: Pass -> Constr
    toConstr :: Pass -> Constr
    $cdataTypeOf :: Pass -> DataType
    dataTypeOf :: Pass -> DataType
    $cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Pass)
    dataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Pass)
    $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pass)
    dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pass)
    $cgmapT :: (forall b. Data b => b -> b) -> Pass -> Pass
    gmapT :: (forall b. Data b => b -> b) -> Pass -> Pass
    $cgmapQl :: forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r
    gmapQl :: forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r
    $cgmapQr :: forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r
    gmapQr :: forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r
    $cgmapQ :: forall u. (forall d. Data d => d -> u) -> Pass -> [u]
    gmapQ :: forall u. (forall d. Data d => d -> u) -> Pass -> [u]
    $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pass -> u
    gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pass -> u
    $cgmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Pass -> m Pass
    gmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Pass -> m Pass
    $cgmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pass -> m Pass
    gmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pass -> m Pass
    $cgmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pass -> m Pass
    gmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pass -> m Pass
    Data)

    -- Type synonyms as a shorthand for tagging
    type GhcPs   = GhcPass 'Parsed      -- Output of parser
    type GhcRn   = GhcPass 'Renamed     -- Output of renamer
    type GhcTc   = GhcPass 'Typechecked -- Output of typechecker

    -- | Allows us to check what phase we're in at GHC's runtime.
    -- For example, this class allows us to write
    --
    -- @
    -- f :: forall p. IsPass p => HsExpr (GhcPass p) -> blah
    -- f e = case ghcPass @p of
    --         GhcPs ->    ... in this RHS we have HsExpr GhcPs...
    --         GhcRn ->    ... in this RHS we have HsExpr GhcRn...
    --         GhcTc ->    ... in this RHS we have HsExpr GhcTc...
    -- @
    --
    -- which is very useful, for example, when pretty-printing.
    -- See Note [IsPass].
    class ( NoGhcTcPass (NoGhcTcPass p) ~ NoGhcTcPass p
          , IsPass (NoGhcTcPass p)
          ) => IsPass p where
      ghcPass :: GhcPass p

    instance IsPass 'Parsed where
      ghcPass :: GhcPass 'Parsed
    ghcPass = GhcPass 'Parsed
    GhcPs
    instance IsPass 'Renamed where
      ghcPass :: GhcPass 'Renamed
    ghcPass = GhcPass 'Renamed
    GhcRn
    instance IsPass 'Typechecked where
      ghcPass :: GhcPass 'Typechecked
    ghcPass = GhcPass 'Typechecked
    GhcTc

    type instance IdP (GhcPass p) = IdGhcP p

    -- | Maps the "normal" id type for a given GHC pass
    type family IdGhcP pass where
      IdGhcP 'Parsed      = RdrName
      IdGhcP 'Renamed     = Name
      IdGhcP 'Typechecked = Id

    -- | Marks that a field uses the GhcRn variant even when the pass
    -- parameter is GhcTc. Useful for storing HsTypes in GHC.Hs.Exprs, say, because
    -- HsType GhcTc should never occur.
    -- See Note [NoGhcTc]

    -- Breaking it up this way, GHC can figure out that the result is a GhcPass
    type instance NoGhcTc (GhcPass pass) = GhcPass (NoGhcTcPass pass)

    type family NoGhcTcPass (p :: Pass) :: Pass where
      NoGhcTcPass 'Typechecked = 'Renamed
      NoGhcTcPass other        = other

    -- |Constraint type to bundle up the requirement for 'OutputableBndr' on both
    -- the @id@ and the 'NoGhcTc' of it. See Note [NoGhcTc].
    type OutputableBndrId pass =
      ( OutputableBndr (IdGhcP pass)
      , OutputableBndr (IdGhcP (NoGhcTcPass pass))
      , Outputable (GenLocated (Anno (IdGhcP pass)) (IdGhcP pass))
      , Outputable (GenLocated (Anno (IdGhcP (NoGhcTcPass pass))) (IdGhcP (NoGhcTcPass pass)))
      , IsPass pass
      )

    -- useful helper functions:
    pprIfPs :: forall p. IsPass p => (p ~ 'Parsed => SDoc) -> SDoc
    pprIfPs :: forall (p :: Pass). IsPass p => ((p ~ 'Parsed) => SDoc) -> SDoc
    pprIfPs (p ~ 'Parsed) => SDoc
    pp = case forall (p :: Pass). IsPass p => GhcPass p
    ghcPass @p of GhcPass p
    GhcPs -> SDoc
    (p ~ 'Parsed) => SDoc
    pp
                                    GhcPass p
    _     -> SDoc
    forall doc. IsOutput doc => doc
    empty

    pprIfRn :: forall p. IsPass p => (p ~ 'Renamed => SDoc) -> SDoc
    pprIfRn :: forall (p :: Pass). IsPass p => ((p ~ 'Renamed) => SDoc) -> SDoc
    pprIfRn (p ~ 'Renamed) => SDoc
    pp = case forall (p :: Pass). IsPass p => GhcPass p
    ghcPass @p of GhcPass p
    GhcRn -> SDoc
    (p ~ 'Renamed) => SDoc
    pp
                                    GhcPass p
    _     -> SDoc
    forall doc. IsOutput doc => doc
    empty

    pprIfTc :: forall p. IsPass p => (p ~ 'Typechecked => SDoc) -> SDoc
    pprIfTc :: forall (p :: Pass).
    IsPass p =>
    ((p ~ 'Typechecked) => SDoc) -> SDoc
    pprIfTc (p ~ 'Typechecked) => SDoc
    pp = case forall (p :: Pass). IsPass p => GhcPass p
    ghcPass @p of GhcPass p
    GhcTc -> SDoc
    (p ~ 'Typechecked) => SDoc
    pp
                                    GhcPass p
    _     -> SDoc
    forall doc. IsOutput doc => doc
    empty

    --- Outputable

    instance Outputable NoExtField where
      ppr :: NoExtField -> SDoc
    ppr NoExtField
    _ = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "NoExtField"

    instance Outputable DataConCantHappen where
      ppr :: DataConCantHappen -> SDoc
    ppr = DataConCantHappen -> SDoc
    forall a. DataConCantHappen -> a
    dataConCantHappen