    {-# LANGUAGE OverloadedStrings #-}
    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}

    module Haddock.Backends.Hyperlinker.Parser (parse) where

    import Control.Applicative (Alternative (..))
    import Control.Monad.Trans.Class
    import Control.Monad.Trans.Maybe
    import qualified Data.ByteString as BS
    import Data.List (isPrefixOf, isSuffixOf)
    import GHC.Data.Bag (bagToList)
    import GHC.Data.FastString (mkFastString)
    import GHC.Data.StringBuffer (StringBuffer, atEnd)
    import GHC.Parser.Errors.Ppr ()
    import GHC.Parser.Lexer as Lexer
      ( P (..)
      , PState (..)
      , ParseResult (..)
      , ParserOpts
      , Token (..)
      , getPsErrorMessages
      , initParserState
      , lexer
      )
    import qualified GHC.Types.Error as E
    import GHC.Types.SourceText
    import GHC.Types.SrcLoc
    import GHC.Utils.Error (pprLocMsgEnvelopeDefault)
    import GHC.Utils.Outputable (SDocContext, text, ($$))
    import qualified GHC.Utils.Outputable as Outputable
    import GHC.Utils.Panic (panic)

    import Haddock.Backends.Hyperlinker.Types as T
    import Haddock.GhcUtils

    -- | Turn source code string into a stream of more descriptive tokens.
    --
    -- Result should retain original file layout (including comments,
    -- whitespace, and CPP).
    parse
      :: ParserOpts
      -> SDocContext
      -> FilePath
      -- ^ Path to the source of this module
      -> BS.ByteString
      -- ^ Raw UTF-8 encoded source of this module
      -> [T.Token]
    parse :: ParserOpts -> SDocContext -> [Char] -> ByteString -> [Token]
    parse ParserOpts
    parserOpts SDocContext
    sDocContext [Char]
    fpath ByteString
    bs = case P [Token] -> PState -> ParseResult [Token]
    forall a. P a -> PState -> ParseResult a
    unP (Bool -> [Token] -> P [Token]
    go Bool
    False []) PState
    initState of
      POk PState
    _ [Token]
    toks -> [Token] -> [Token]
    forall a. [a] -> [a]
    reverse [Token]
    toks
      PFailed PState
    pst ->
        let MsgEnvelope PsMessage
    err : [MsgEnvelope PsMessage]
    _ = Bag (MsgEnvelope PsMessage) -> [MsgEnvelope PsMessage]
    forall a. Bag a -> [a]
    bagToList (Messages PsMessage -> Bag (MsgEnvelope PsMessage)
    forall e. Messages e -> Bag (MsgEnvelope e)
    E.getMessages (Messages PsMessage -> Bag (MsgEnvelope PsMessage))
    -> Messages PsMessage -> Bag (MsgEnvelope PsMessage)
    forall a b. (a -> b) -> a -> b
    $ PState -> Messages PsMessage
    getPsErrorMessages PState
    pst)
         in [Char] -> [Token]
    forall a. HasCallStack => [Char] -> a
    panic ([Char] -> [Token]) -> [Char] -> [Token]
    forall a b. (a -> b) -> a -> b
    $
              SDocContext -> SDoc -> [Char]
    Outputable.renderWithContext SDocContext
    sDocContext (SDoc -> [Char]) -> SDoc -> [Char]
    forall a b. (a -> b) -> a -> b
    $
                [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Hyperlinker parse error:" SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ MsgEnvelope PsMessage -> SDoc
    forall e. Diagnostic e => MsgEnvelope e -> SDoc
    pprLocMsgEnvelopeDefault MsgEnvelope PsMessage
    err
      where
        initState :: PState
    initState = ParserOpts -> StringBuffer -> RealSrcLoc -> PState
    initParserState ParserOpts
    parserOpts StringBuffer
    buf RealSrcLoc
    start
        buf :: StringBuffer
    buf = ByteString -> StringBuffer
    stringBufferFromByteString ByteString
    bs
        start :: RealSrcLoc
    start = FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc ([Char] -> FastString
    mkFastString [Char]
    fpath) Int
    1 Int
    1
        go
          :: Bool
          -- \^ are we currently in a pragma?
          -> [T.Token]
          -- \^ tokens accumulated so far (in reverse)
          -> P [T.Token]
        go :: Bool -> [Token] -> P [Token]
    go Bool
    inPrag [Token]
    toks = do
          (b, _) <- P (StringBuffer, RealSrcLoc)
    getInput
          if not (atEnd b)
            then do
              mtok <- runMaybeT (parseCppLine <|> parsePlainTok inPrag)
              (newToks, inPrag') <- case mtok of
                Maybe ([Token], Bool)
    Nothing -> P ([Token], Bool)
    unknownLine
                Just ([Token], Bool)
    a -> ([Token], Bool) -> P ([Token], Bool)
    forall a. a -> P a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([Token], Bool)
    a
              go inPrag' (newToks ++ toks)
            else pure toks

        -- \| Like 'Lexer.lexer', but slower, with a better API, and filtering out empty tokens
        wrappedLexer :: P (RealLocated Lexer.Token)
        wrappedLexer :: P (RealLocated Token)
    wrappedLexer = Bool
    -> (Located Token -> P (RealLocated Token))
    -> P (RealLocated Token)
    forall a. Bool -> (Located Token -> P a) -> P a
    Lexer.lexer Bool
    False Located Token -> P (RealLocated Token)
    andThen
          where
            andThen :: Located Token -> P (RealLocated Token)
    andThen (L (RealSrcSpan RealSrcSpan
    s Maybe BufSpan
    _) Token
    t)
              | RealSrcSpan -> Int
    srcSpanStartLine RealSrcSpan
    s Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= RealSrcSpan -> Int
    srcSpanEndLine RealSrcSpan
    s
                  Bool -> Bool -> Bool
    || RealSrcSpan -> Int
    srcSpanStartCol RealSrcSpan
    s Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= RealSrcSpan -> Int
    srcSpanEndCol RealSrcSpan
    s =
                  RealLocated Token -> P (RealLocated Token)
    forall a. a -> P a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (RealSrcSpan -> Token -> RealLocated Token
    forall l e. l -> e -> GenLocated l e
    L RealSrcSpan
    s Token
    t)
            andThen (L (RealSrcSpan RealSrcSpan
    s Maybe BufSpan
    _) Token
    ITeof) = RealLocated Token -> P (RealLocated Token)
    forall a. a -> P a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (RealSrcSpan -> Token -> RealLocated Token
    forall l e. l -> e -> GenLocated l e
    L RealSrcSpan
    s Token
    ITeof)
            andThen Located Token
    _ = P (RealLocated Token)
    wrappedLexer

        -- \| Try to parse a CPP line (can fail)
        parseCppLine :: MaybeT P ([T.Token], Bool)
        parseCppLine :: MaybeT P ([Token], Bool)
    parseCppLine = P (Maybe ([Token], Bool)) -> MaybeT P ([Token], Bool)
    forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
    MaybeT (P (Maybe ([Token], Bool)) -> MaybeT P ([Token], Bool))
    -> P (Maybe ([Token], Bool)) -> MaybeT P ([Token], Bool)
    forall a b. (a -> b) -> a -> b
    $ do
          (b, l) <- P (StringBuffer, RealSrcLoc)
    getInput
          case tryCppLine l b of
            Just (ByteString
    cppBStr, RealSrcLoc
    l', StringBuffer
    b') ->
              let cppTok :: Token
    cppTok =
                    T.Token
                      { tkType :: TokenType
    tkType = TokenType
    TkCpp
                      , tkValue :: ByteString
    tkValue = ByteString
    cppBStr
                      , tkSpan :: RealSrcSpan
    tkSpan = RealSrcLoc -> RealSrcLoc -> RealSrcSpan
    mkRealSrcSpan RealSrcLoc
    l RealSrcLoc
    l'
                      }
               in (StringBuffer, RealSrcLoc) -> P ()
    setInput (StringBuffer
    b', RealSrcLoc
    l') P () -> P (Maybe ([Token], Bool)) -> P (Maybe ([Token], Bool))
    forall a b. P a -> P b -> P b
    forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
    *> Maybe ([Token], Bool) -> P (Maybe ([Token], Bool))
    forall a. a -> P a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (([Token], Bool) -> Maybe ([Token], Bool)
    forall a. a -> Maybe a
    Just ([Token
    cppTok], Bool
    False))
            Maybe (ByteString, RealSrcLoc, StringBuffer)
    _ -> Maybe ([Token], Bool) -> P (Maybe ([Token], Bool))
    forall a. a -> P a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Maybe ([Token], Bool)
    forall a. Maybe a
    Nothing

        -- \| Try to parse a regular old token (can fail)
        parsePlainTok :: Bool -> MaybeT P ([T.Token], Bool) -- return list is only ever 0-2 elements
        parsePlainTok :: Bool -> MaybeT P ([Token], Bool)
    parsePlainTok Bool
    inPrag = do
          (bInit, lInit) <- P (StringBuffer, RealSrcLoc) -> MaybeT P (StringBuffer, RealSrcLoc)
    forall (m :: Type -> Type) a. Monad m => m a -> MaybeT m a
    forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift P (StringBuffer, RealSrcLoc)
    getInput
          L sp tok <- tryP (Lexer.lexer False return)
          (bEnd, _) <- lift getInput
          case sp of
            UnhelpfulSpan UnhelpfulSpanReason
    _ -> ([Token], Bool) -> MaybeT P ([Token], Bool)
    forall a. a -> MaybeT P a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([], Bool
    False) -- pretend the token never existed
            RealSrcSpan RealSrcSpan
    rsp Maybe BufSpan
    _ -> do
              let typ :: TokenType
    typ = if Bool
    inPrag then TokenType
    TkPragma else Token -> TokenType
    classify Token
    tok
                  RealSrcLoc RealSrcLoc
    lStart Maybe BufPos
    _ = SrcSpan -> SrcLoc
    srcSpanStart SrcSpan
    sp -- safe since @sp@ is real
                  (ByteString
    spaceBStr, StringBuffer
    bStart) = RealSrcLoc
    -> RealSrcLoc -> StringBuffer -> (ByteString, StringBuffer)
    spanPosition RealSrcLoc
    lInit RealSrcLoc
    lStart StringBuffer
    bInit
                  inPragDef :: Bool
    inPragDef = Bool -> Token -> Bool
    inPragma Bool
    inPrag Token
    tok

              (bEnd', inPrag') <- case Token
    tok of
                -- Update internal line + file position if this is a LINE pragma
                ITline_prag SourceText
    _ -> (StringBuffer, Bool)
    -> MaybeT P (StringBuffer, Bool) -> MaybeT P (StringBuffer, Bool)
    forall (f :: Type -> Type) a. Alternative f => a -> f a -> f a
    tryOrElse (StringBuffer
    bEnd, Bool
    inPragDef) (MaybeT P (StringBuffer, Bool) -> MaybeT P (StringBuffer, Bool))
    -> MaybeT P (StringBuffer, Bool) -> MaybeT P (StringBuffer, Bool)
    forall a b. (a -> b) -> a -> b
    $ do
                  L _ (ITinteger (IL{il_value = line})) <- P (RealLocated Token) -> MaybeT P (RealLocated Token)
    forall a. P a -> MaybeT P a
    tryP P (RealLocated Token)
    wrappedLexer
                  L _ (ITstring _ file) <- tryP wrappedLexer
                  L spF ITclose_prag <- tryP wrappedLexer

                  let newLoc = FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc FastString
    file (Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    line Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) (RealSrcSpan -> Int
    srcSpanEndCol RealSrcSpan
    spF)
                  (bEnd'', _) <- lift getInput
                  lift $ setInput (bEnd'', newLoc)

                  pure (bEnd'', False)

                -- Update internal column position if this is a COLUMN pragma
                ITcolumn_prag SourceText
    _ -> (StringBuffer, Bool)
    -> MaybeT P (StringBuffer, Bool) -> MaybeT P (StringBuffer, Bool)
    forall (f :: Type -> Type) a. Alternative f => a -> f a -> f a
    tryOrElse (StringBuffer
    bEnd, Bool
    inPragDef) (MaybeT P (StringBuffer, Bool) -> MaybeT P (StringBuffer, Bool))
    -> MaybeT P (StringBuffer, Bool) -> MaybeT P (StringBuffer, Bool)
    forall a b. (a -> b) -> a -> b
    $ do
                  L _ (ITinteger (IL{il_value = col})) <- P (RealLocated Token) -> MaybeT P (RealLocated Token)
    forall a. P a -> MaybeT P a
    tryP P (RealLocated Token)
    wrappedLexer
                  L spF ITclose_prag <- tryP wrappedLexer

                  let newLoc = FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc (RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    spF) (RealSrcSpan -> Int
    srcSpanEndLine RealSrcSpan
    spF) (Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    col)
                  (bEnd'', _) <- lift getInput
                  lift $ setInput (bEnd'', newLoc)

                  pure (bEnd'', False)
                Token
    _ -> (StringBuffer, Bool) -> MaybeT P (StringBuffer, Bool)
    forall a. a -> MaybeT P a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (StringBuffer
    bEnd, Bool
    inPragDef)

              let tokBStr = StringBuffer -> StringBuffer -> ByteString
    splitStringBuffer StringBuffer
    bStart StringBuffer
    bEnd'
                  plainTok =
                    T.Token
                      { tkType :: TokenType
    tkType = TokenType
    typ
                      , tkValue :: ByteString
    tkValue = ByteString
    tokBStr
                      , tkSpan :: RealSrcSpan
    tkSpan = RealSrcSpan
    rsp
                      }
                  spaceTok =
                    T.Token
                      { tkType :: TokenType
    tkType = TokenType
    TkSpace
                      , tkValue :: ByteString
    tkValue = ByteString
    spaceBStr
                      , tkSpan :: RealSrcSpan
    tkSpan = RealSrcLoc -> RealSrcLoc -> RealSrcSpan
    mkRealSrcSpan RealSrcLoc
    lInit RealSrcLoc
    lStart
                      }

              pure (plainTok : [spaceTok | not (BS.null spaceBStr)], inPrag')

        -- \| Parse whatever remains of the line as an unknown token (can't fail)
        unknownLine :: P ([T.Token], Bool)
        unknownLine :: P ([Token], Bool)
    unknownLine = do
          (b, l) <- P (StringBuffer, RealSrcLoc)
    getInput
          let (unkBStr, l', b') = spanLine l b
              unkTok =
                T.Token
                  { tkType :: TokenType
    tkType = TokenType
    TkUnknown
                  , tkValue :: ByteString
    tkValue = ByteString
    unkBStr
                  , tkSpan :: RealSrcSpan
    tkSpan = RealSrcLoc -> RealSrcLoc -> RealSrcSpan
    mkRealSrcSpan RealSrcLoc
    l RealSrcLoc
    l'
                  }
          setInput (b', l')
          pure ([unkTok], False)

    -- | Get the input
    getInput :: P (StringBuffer, RealSrcLoc)
    getInput :: P (StringBuffer, RealSrcLoc)
    getInput = (PState -> ParseResult (StringBuffer, RealSrcLoc))
    -> P (StringBuffer, RealSrcLoc)
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult (StringBuffer, RealSrcLoc))
     -> P (StringBuffer, RealSrcLoc))
    -> (PState -> ParseResult (StringBuffer, RealSrcLoc))
    -> P (StringBuffer, RealSrcLoc)
    forall a b. (a -> b) -> a -> b
    $ \p :: PState
    p@PState{buffer :: PState -> StringBuffer
    buffer = StringBuffer
    buf, loc :: PState -> PsLoc
    loc = PsLoc
    srcLoc} -> PState
    -> (StringBuffer, RealSrcLoc)
    -> ParseResult (StringBuffer, RealSrcLoc)
    forall a. PState -> a -> ParseResult a
    POk PState
    p (StringBuffer
    buf, PsLoc -> RealSrcLoc
    psRealLoc PsLoc
    srcLoc)

    -- | Set the input
    setInput :: (StringBuffer, RealSrcLoc) -> P ()
    setInput :: (StringBuffer, RealSrcLoc) -> P ()
    setInput (StringBuffer
    buf, RealSrcLoc
    srcLoc) =
      (PState -> ParseResult ()) -> P ()
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult ()) -> P ())
    -> (PState -> ParseResult ()) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \p :: PState
    p@PState{loc :: PState -> PsLoc
    loc = PsLoc RealSrcLoc
    _ BufPos
    buf_loc} ->
        PState -> () -> ParseResult ()
    forall a. PState -> a -> ParseResult a
    POk (PState
    p{buffer = buf, loc = PsLoc srcLoc buf_loc}) ()

    tryP :: P a -> MaybeT P a
    tryP :: forall a. P a -> MaybeT P a
    tryP (P PState -> ParseResult a
    f) = P (Maybe a) -> MaybeT P a
    forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
    MaybeT (P (Maybe a) -> MaybeT P a) -> P (Maybe a) -> MaybeT P a
    forall a b. (a -> b) -> a -> b
    $ (PState -> ParseResult (Maybe a)) -> P (Maybe a)
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult (Maybe a)) -> P (Maybe a))
    -> (PState -> ParseResult (Maybe a)) -> P (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ \PState
    s -> case PState -> ParseResult a
    f PState
    s of
      POk PState
    s' a
    a -> PState -> Maybe a -> ParseResult (Maybe a)
    forall a. PState -> a -> ParseResult a
    POk PState
    s' (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a)
      PFailed PState
    _ -> PState -> Maybe a -> ParseResult (Maybe a)
    forall a. PState -> a -> ParseResult a
    POk PState
    s Maybe a
    forall a. Maybe a
    Nothing

    tryOrElse :: Alternative f => a -> f a -> f a
    tryOrElse :: forall (f :: Type -> Type) a. Alternative f => a -> f a -> f a
    tryOrElse a
    x f a
    p = f a
    p f a -> f a -> f a
    forall a. f a -> f a -> f a
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
    <|> a -> f a
    forall a. a -> f a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure a
    x

    -- | Classify given tokens as appropriate Haskell token type.
    classify :: Lexer.Token -> TokenType
    classify :: Token -> TokenType
    classify Token
    tok =
      case Token
    tok of
        Token
    ITas -> TokenType
    TkKeyword
        Token
    ITcase -> TokenType
    TkKeyword
        Token
    ITclass -> TokenType
    TkKeyword
        Token
    ITdata -> TokenType
    TkKeyword
        Token
    ITdefault -> TokenType
    TkKeyword
        Token
    ITderiving -> TokenType
    TkKeyword
        ITdo{} -> TokenType
    TkKeyword
        Token
    ITelse -> TokenType
    TkKeyword
        Token
    IThiding -> TokenType
    TkKeyword
        Token
    ITforeign -> TokenType
    TkKeyword
        Token
    ITif -> TokenType
    TkKeyword
        Token
    ITimport -> TokenType
    TkKeyword
        Token
    ITin -> TokenType
    TkKeyword
        Token
    ITinfix -> TokenType
    TkKeyword
        Token
    ITinfixl -> TokenType
    TkKeyword
        Token
    ITinfixr -> TokenType
    TkKeyword
        Token
    ITinstance -> TokenType
    TkKeyword
        Token
    ITlet -> TokenType
    TkKeyword
        Token
    ITmodule -> TokenType
    TkKeyword
        Token
    ITnewtype -> TokenType
    TkKeyword
        Token
    ITof -> TokenType
    TkKeyword
        Token
    ITqualified -> TokenType
    TkKeyword
        Token
    ITthen -> TokenType
    TkKeyword
        Token
    ITtype -> TokenType
    TkKeyword
        Token
    ITvia -> TokenType
    TkKeyword
        Token
    ITwhere -> TokenType
    TkKeyword
        ITforall{} -> TokenType
    TkKeyword
        Token
    ITexport -> TokenType
    TkKeyword
        Token
    ITlabel -> TokenType
    TkKeyword
        Token
    ITdynamic -> TokenType
    TkKeyword
        Token
    ITsafe -> TokenType
    TkKeyword
        Token
    ITinterruptible -> TokenType
    TkKeyword
        Token
    ITunsafe -> TokenType
    TkKeyword
        Token
    ITstdcallconv -> TokenType
    TkKeyword
        Token
    ITccallconv -> TokenType
    TkKeyword
        Token
    ITcapiconv -> TokenType
    TkKeyword
        Token
    ITprimcallconv -> TokenType
    TkKeyword
        Token
    ITjavascriptcallconv -> TokenType
    TkKeyword
        ITmdo{} -> TokenType
    TkKeyword
        Token
    ITfamily -> TokenType
    TkKeyword
        Token
    ITrole -> TokenType
    TkKeyword
        Token
    ITgroup -> TokenType
    TkKeyword
        Token
    ITby -> TokenType
    TkKeyword
        Token
    ITusing -> TokenType
    TkKeyword
        Token
    ITpattern -> TokenType
    TkKeyword
        Token
    ITstatic -> TokenType
    TkKeyword
        Token
    ITstock -> TokenType
    TkKeyword
        Token
    ITanyclass -> TokenType
    TkKeyword
        Token
    ITunit -> TokenType
    TkKeyword
        Token
    ITsignature -> TokenType
    TkKeyword
        Token
    ITdependency -> TokenType
    TkKeyword
        Token
    ITrequires -> TokenType
    TkKeyword
        Token
    ITsplice   -> TokenType
    TkKeyword
        Token
    ITquote    -> TokenType
    TkKeyword
        ITinline_prag{} -> TokenType
    TkPragma
        ITopaque_prag{} -> TokenType
    TkPragma
        ITspec_prag{} -> TokenType
    TkPragma
        ITspec_inline_prag{} -> TokenType
    TkPragma
        ITsource_prag{} -> TokenType
    TkPragma
        ITrules_prag{} -> TokenType
    TkPragma
        ITwarning_prag{} -> TokenType
    TkPragma
        ITdeprecated_prag{} -> TokenType
    TkPragma
        ITline_prag{} -> TokenType
    TkPragma
        ITcolumn_prag{} -> TokenType
    TkPragma
        ITscc_prag{} -> TokenType
    TkPragma
        ITunpack_prag{} -> TokenType
    TkPragma
        ITnounpack_prag{} -> TokenType
    TkPragma
        ITann_prag{} -> TokenType
    TkPragma
        ITcomplete_prag{} -> TokenType
    TkPragma
        Token
    ITclose_prag -> TokenType
    TkPragma
        IToptions_prag{} -> TokenType
    TkPragma
        ITinclude_prag{} -> TokenType
    TkPragma
        Token
    ITlanguage_prag -> TokenType
    TkPragma
        ITminimal_prag{} -> TokenType
    TkPragma
        IToverlappable_prag{} -> TokenType
    TkPragma
        IToverlapping_prag{} -> TokenType
    TkPragma
        IToverlaps_prag{} -> TokenType
    TkPragma
        ITincoherent_prag{} -> TokenType
    TkPragma
        ITctype{} -> TokenType
    TkPragma
        Token
    ITdotdot -> TokenType
    TkGlyph
        Token
    ITcolon -> TokenType
    TkGlyph
        ITdcolon{} -> TokenType
    TkGlyph
        Token
    ITequal -> TokenType
    TkGlyph
        Token
    ITlam -> TokenType
    TkGlyph
        Token
    ITlcase -> TokenType
    TkGlyph
        Token
    ITlcases -> TokenType
    TkGlyph
        Token
    ITvbar -> TokenType
    TkGlyph
        ITlarrow{} -> TokenType
    TkGlyph
        ITrarrow{} -> TokenType
    TkGlyph
        ITlolly{} -> TokenType
    TkGlyph
        Token
    ITat -> TokenType
    TkGlyph
        Token
    ITtilde -> TokenType
    TkGlyph
        ITdarrow{} -> TokenType
    TkGlyph
        Token
    ITminus -> TokenType
    TkGlyph
        Token
    ITprefixminus -> TokenType
    TkGlyph
        Token
    ITbang -> TokenType
    TkGlyph
        Token
    ITdot -> TokenType
    TkOperator
        ITproj{} -> TokenType
    TkOperator
        ITstar{} -> TokenType
    TkOperator
        Token
    ITtypeApp -> TokenType
    TkGlyph
        Token
    ITpercent -> TokenType
    TkGlyph
        Token
    ITbiglam -> TokenType
    TkGlyph
        Token
    ITocurly -> TokenType
    TkSpecial
        Token
    ITccurly -> TokenType
    TkSpecial
        Token
    ITvocurly -> TokenType
    TkSpecial
        Token
    ITvccurly -> TokenType
    TkSpecial
        Token
    ITobrack -> TokenType
    TkSpecial
        Token
    ITopabrack -> TokenType
    TkSpecial
        Token
    ITcpabrack -> TokenType
    TkSpecial
        Token
    ITcbrack -> TokenType
    TkSpecial
        Token
    IToparen -> TokenType
    TkSpecial
        Token
    ITcparen -> TokenType
    TkSpecial
        Token
    IToubxparen -> TokenType
    TkSpecial
        Token
    ITcubxparen -> TokenType
    TkSpecial
        Token
    ITsemi -> TokenType
    TkSpecial
        Token
    ITcomma -> TokenType
    TkSpecial
        Token
    ITunderscore -> TokenType
    TkIdentifier
        Token
    ITbackquote -> TokenType
    TkSpecial
        Token
    ITsimpleQuote -> TokenType
    TkSpecial
        ITvarid{} -> TokenType
    TkIdentifier
        ITconid{} -> TokenType
    TkIdentifier
        ITvarsym{} -> TokenType
    TkOperator
        ITconsym{} -> TokenType
    TkOperator
        ITqvarid{} -> TokenType
    TkIdentifier
        ITqconid{} -> TokenType
    TkIdentifier
        ITqvarsym{} -> TokenType
    TkOperator
        ITqconsym{} -> TokenType
    TkOperator
        ITdupipvarid{} -> TokenType
    TkUnknown
        ITlabelvarid{} -> TokenType
    TkUnknown
        ITchar{} -> TokenType
    TkChar
        ITstring{} -> TokenType
    TkString
        ITstringMulti{} -> TokenType
    TkString
        ITinteger{} -> TokenType
    TkNumber
        ITrational{} -> TokenType
    TkNumber
        ITprimchar{} -> TokenType
    TkChar
        ITprimstring{} -> TokenType
    TkString
        ITprimint{} -> TokenType
    TkNumber
        ITprimword{} -> TokenType
    TkNumber
        ITprimint8{} -> TokenType
    TkNumber
        ITprimint16{} -> TokenType
    TkNumber
        ITprimint32{} -> TokenType
    TkNumber
        ITprimint64{} -> TokenType
    TkNumber
        ITprimword8{} -> TokenType
    TkNumber
        ITprimword16{} -> TokenType
    TkNumber
        ITprimword32{} -> TokenType
    TkNumber
        ITprimword64{} -> TokenType
    TkNumber
        ITprimfloat{} -> TokenType
    TkNumber
        ITprimdouble{} -> TokenType
    TkNumber
        ITopenExpQuote{} -> TokenType
    TkSpecial
        Token
    ITopenPatQuote -> TokenType
    TkSpecial
        Token
    ITopenDecQuote -> TokenType
    TkSpecial
        Token
    ITopenTypQuote -> TokenType
    TkSpecial
        ITcloseQuote{} -> TokenType
    TkSpecial
        ITopenTExpQuote{} -> TokenType
    TkSpecial
        Token
    ITcloseTExpQuote -> TokenType
    TkSpecial
        Token
    ITdollar -> TokenType
    TkSpecial
        Token
    ITdollardollar -> TokenType
    TkSpecial
        Token
    ITtyQuote -> TokenType
    TkSpecial
        ITquasiQuote{} -> TokenType
    TkUnknown
        ITqQuasiQuote{} -> TokenType
    TkUnknown
        Token
    ITproc -> TokenType
    TkKeyword
        Token
    ITrec -> TokenType
    TkKeyword
        IToparenbar{} -> TokenType
    TkGlyph
        ITcparenbar{} -> TokenType
    TkGlyph
        ITlarrowtail{} -> TokenType
    TkGlyph
        ITrarrowtail{} -> TokenType
    TkGlyph
        ITLarrowtail{} -> TokenType
    TkGlyph
        ITRarrowtail{} -> TokenType
    TkGlyph
        Token
    ITcomment_line_prag -> TokenType
    TkUnknown
        ITunknown{} -> TokenType
    TkUnknown
        Token
    ITeof -> TokenType
    TkUnknown
        ITlineComment{} -> TokenType
    TkComment
        ITdocComment{} -> TokenType
    TkComment
        ITdocOptions{} -> TokenType
    TkComment
        -- The lexer considers top-level pragmas as comments (see `pragState` in
        -- the GHC lexer for more), so we have to manually reverse this. The
        -- following is a hammer: it smashes _all_ pragma-like block comments into
        -- pragmas.
        ITblockComment [Char]
    c PsSpan
    _
          | [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf [Char]
    "{-#" [Char]
    c
          , [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isSuffixOf [Char]
    "#-}" [Char]
    c ->
              TokenType
    TkPragma
          | Bool
    otherwise -> TokenType
    TkComment

    -- | Classify given tokens as beginning pragmas (or not).
    inPragma
      :: Bool
      -- ^ currently in pragma
      -> Lexer.Token
      -- ^ current token
      -> Bool
      -- ^ new information about whether we are in a pragma
    inPragma :: Bool -> Token -> Bool
    inPragma Bool
    _ Token
    ITclose_prag = Bool
    False
    inPragma Bool
    True Token
    _ = Bool
    True
    inPragma Bool
    False Token
    tok =
      case Token
    tok of
        ITinline_prag{} -> Bool
    True
        ITopaque_prag{} -> Bool
    True
        ITspec_prag{} -> Bool
    True
        ITspec_inline_prag{} -> Bool
    True
        ITsource_prag{} -> Bool
    True
        ITrules_prag{} -> Bool
    True
        ITwarning_prag{} -> Bool
    True
        ITdeprecated_prag{} -> Bool
    True
        ITline_prag{} -> Bool
    True
        ITcolumn_prag{} -> Bool
    True
        ITscc_prag{} -> Bool
    True
        ITunpack_prag{} -> Bool
    True
        ITnounpack_prag{} -> Bool
    True
        ITann_prag{} -> Bool
    True
        ITcomplete_prag{} -> Bool
    True
        IToptions_prag{} -> Bool
    True
        ITinclude_prag{} -> Bool
    True
        Token
    ITlanguage_prag -> Bool
    True
        ITminimal_prag{} -> Bool
    True
        IToverlappable_prag{} -> Bool
    True
        IToverlapping_prag{} -> Bool
    True
        IToverlaps_prag{} -> Bool
    True
        ITincoherent_prag{} -> Bool
    True
        ITctype{} -> Bool
    True
        Token
    _ -> Bool
    False