{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE MultiWayIf            #-}

module Development.IDE.Spans.Pragmas
  ( NextPragmaInfo(..)
  , LineSplitTextEdits(..)
  , getNextPragmaInfo
  , insertNewPragma ) where

import           Data.Bits                       (Bits (setBit))
import           Data.Function                   ((&))
import qualified Data.List                       as List
import qualified Data.Maybe                      as Maybe
import           Data.Text                       (Text, pack)
import qualified Data.Text                       as Text
import           Development.IDE                 (srcSpanToRange)
import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.Compat.Util
import           GHC.LanguageExtensions.Type     (Extension)
import qualified Language.LSP.Types              as LSP

getNextPragmaInfo :: DynFlags -> Maybe Text -> NextPragmaInfo
getNextPragmaInfo :: DynFlags -> Maybe Text -> NextPragmaInfo
getNextPragmaInfo DynFlags
dynFlags Maybe Text
sourceText =
  if | Just Text
sourceText <- Maybe Text
sourceText
     , let sourceStringBuffer :: StringBuffer
sourceStringBuffer = String -> StringBuffer
stringToStringBuffer (Text -> String
Text.unpack Text
sourceText)
     , POk PState
_ ParserState
parserState <- DynFlags -> StringBuffer -> ParseResult ParserState
parsePreDecl DynFlags
dynFlags StringBuffer
sourceStringBuffer
     -> case ParserState
parserState of
         ParserStateNotDone{ NextPragmaInfo
$sel:nextPragma:ParserStateNotDone :: ParserState -> NextPragmaInfo
nextPragma :: NextPragmaInfo
nextPragma } -> NextPragmaInfo
nextPragma
         ParserStateDone{ NextPragmaInfo
nextPragma :: NextPragmaInfo
$sel:nextPragma:ParserStateNotDone :: ParserState -> NextPragmaInfo
nextPragma }    -> NextPragmaInfo
nextPragma
     | Bool
otherwise
     -> Int -> Maybe LineSplitTextEdits -> NextPragmaInfo
NextPragmaInfo Int
0 Maybe LineSplitTextEdits
forall a. Maybe a
Nothing

insertNewPragma :: NextPragmaInfo -> Extension -> LSP.TextEdit
insertNewPragma :: NextPragmaInfo -> Extension -> TextEdit
insertNewPragma (NextPragmaInfo Int
_ (Just (LineSplitTextEdits TextEdit
ins TextEdit
_))) Extension
newPragma = TextEdit
ins { $sel:_newText:TextEdit :: Text
LSP._newText = Text
"{-# LANGUAGE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Extension -> String
forall a. Show a => a -> String
show Extension
newPragma) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" #-}\n" } :: LSP.TextEdit
insertNewPragma (NextPragmaInfo Int
nextPragmaLine Maybe LineSplitTextEdits
_) Extension
newPragma =  Range -> Text -> TextEdit
LSP.TextEdit Range
pragmaInsertRange (Text -> TextEdit) -> Text -> TextEdit
forall a b. (a -> b) -> a -> b
$ Text
"{-# LANGUAGE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Extension -> String
forall a. Show a => a -> String
show Extension
newPragma) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" #-}\n"
    where
        pragmaInsertPosition :: Position
pragmaInsertPosition = UInt -> UInt -> Position
LSP.Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nextPragmaLine) UInt
0
        pragmaInsertRange :: Range
pragmaInsertRange = Position -> Position -> Range
LSP.Range Position
pragmaInsertPosition Position
pragmaInsertPosition

-- Pre-declaration comments parser -----------------------------------------------------

-- | Each mode represents the "strongest" thing we've seen so far.
-- From strongest to weakest:
-- ModePragma, ModeHaddock, ModeComment, ModeInitial
data Mode = ModePragma | ModeHaddock | ModeComment | ModeInitial deriving Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show

data LineSplitTextEdits = LineSplitTextEdits {
  LineSplitTextEdits -> TextEdit
lineSplitInsertTextEdit :: !LSP.TextEdit,
  LineSplitTextEdits -> TextEdit
lineSplitDeleteTextEdit :: !LSP.TextEdit
} deriving Int -> LineSplitTextEdits -> ShowS
[LineSplitTextEdits] -> ShowS
LineSplitTextEdits -> String
(Int -> LineSplitTextEdits -> ShowS)
-> (LineSplitTextEdits -> String)
-> ([LineSplitTextEdits] -> ShowS)
-> Show LineSplitTextEdits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineSplitTextEdits] -> ShowS
$cshowList :: [LineSplitTextEdits] -> ShowS
show :: LineSplitTextEdits -> String
$cshow :: LineSplitTextEdits -> String
showsPrec :: Int -> LineSplitTextEdits -> ShowS
$cshowsPrec :: Int -> LineSplitTextEdits -> ShowS
Show

data NextPragmaInfo = NextPragmaInfo {
  NextPragmaInfo -> Int
nextPragmaLine     :: !Int,
  NextPragmaInfo -> Maybe LineSplitTextEdits
lineSplitTextEdits :: !(Maybe LineSplitTextEdits)
} deriving Int -> NextPragmaInfo -> ShowS
[NextPragmaInfo] -> ShowS
NextPragmaInfo -> String
(Int -> NextPragmaInfo -> ShowS)
-> (NextPragmaInfo -> String)
-> ([NextPragmaInfo] -> ShowS)
-> Show NextPragmaInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NextPragmaInfo] -> ShowS
$cshowList :: [NextPragmaInfo] -> ShowS
show :: NextPragmaInfo -> String
$cshow :: NextPragmaInfo -> String
showsPrec :: Int -> NextPragmaInfo -> ShowS
$cshowsPrec :: Int -> NextPragmaInfo -> ShowS
Show

data ParserState
  = ParserStateNotDone
    { ParserState -> NextPragmaInfo
nextPragma           :: !NextPragmaInfo
    , ParserState -> Mode
mode                 :: !Mode
    , ParserState -> Int
lastBlockCommentLine :: !Int
    , ParserState -> Int
lastPragmaLine       :: !Int
    , ParserState -> Bool
isLastTokenHash      :: !Bool
    }
  | ParserStateDone { nextPragma :: NextPragmaInfo }
  deriving Int -> ParserState -> ShowS
[ParserState] -> ShowS
ParserState -> String
(Int -> ParserState -> ShowS)
-> (ParserState -> String)
-> ([ParserState] -> ShowS)
-> Show ParserState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParserState] -> ShowS
$cshowList :: [ParserState] -> ShowS
show :: ParserState -> String
$cshow :: ParserState -> String
showsPrec :: Int -> ParserState -> ShowS
$cshowsPrec :: Int -> ParserState -> ShowS
Show

isPragma :: String -> Bool
isPragma :: String -> Bool
isPragma = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
List.isPrefixOf String
"{-#"

isDownwardBlockHaddock :: String -> Bool
isDownwardBlockHaddock :: String -> Bool
isDownwardBlockHaddock = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
List.isPrefixOf String
"{-|"

isDownwardLineHaddock :: String -> Bool
isDownwardLineHaddock :: String -> Bool
isDownwardLineHaddock = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
List.isPrefixOf String
"-- |"

-- need to merge tokens that are deleted/inserted into one TextEdit each
-- to work around some weird TextEdits applied in reversed order issue
updateLineSplitTextEdits :: LSP.Range -> String -> Maybe LineSplitTextEdits -> LineSplitTextEdits
updateLineSplitTextEdits :: Range -> String -> Maybe LineSplitTextEdits -> LineSplitTextEdits
updateLineSplitTextEdits Range
tokenRange String
tokenString Maybe LineSplitTextEdits
prevLineSplitTextEdits
  | Just LineSplitTextEdits
prevLineSplitTextEdits <- Maybe LineSplitTextEdits
prevLineSplitTextEdits
  , let LineSplitTextEdits
          { $sel:lineSplitInsertTextEdit:LineSplitTextEdits :: LineSplitTextEdits -> TextEdit
lineSplitInsertTextEdit = TextEdit
prevInsertTextEdit
          , $sel:lineSplitDeleteTextEdit:LineSplitTextEdits :: LineSplitTextEdits -> TextEdit
lineSplitDeleteTextEdit = TextEdit
prevDeleteTextEdit } = LineSplitTextEdits
prevLineSplitTextEdits
  , let LSP.TextEdit Range
prevInsertRange Text
prevInsertText = TextEdit
prevInsertTextEdit
  , let LSP.TextEdit Range
prevDeleteRange Text
_prevDeleteText = TextEdit
prevDeleteTextEdit
  , let LSP.Range Position
prevInsertStartPos  Position
prevInsertEndPos = Range
prevInsertRange
  , let LSP.Position UInt
_prevInsertStartLine UInt
_prevInsertStartCol = Position
prevInsertStartPos
  , let LSP.Position UInt
_prevInsertEndLine UInt
_prevInsertEndCol = Position
prevInsertEndPos
  , let LSP.Range Position
prevDeleteStartPos Position
prevDeleteEndPos = Range
prevDeleteRange
  , let LSP.Position UInt
_prevDeleteStartLine UInt
_prevDeleteStartCol = Position
prevDeleteStartPos
  , let LSP.Position UInt
_prevDeleteEndLine UInt
prevDeleteEndCol = Position
prevDeleteEndPos
  , let currInsertRange :: Range
currInsertRange = Range
prevInsertRange
  , let currInsertText :: Text
currInsertText =
          Text -> Text
Text.init Text
prevInsertText
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Int) -> UInt -> Int
forall a b. (a -> b) -> a -> b
$ UInt
startCol UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
prevDeleteEndCol) Text
" "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> ShowS
forall a. Int -> [a] -> [a]
List.take Int
newLineCol String
tokenString)
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  , let currInsertTextEdit :: TextEdit
currInsertTextEdit = Range -> Text -> TextEdit
LSP.TextEdit Range
currInsertRange Text
currInsertText
  , let currDeleteStartPos :: Position
currDeleteStartPos = Position
prevDeleteStartPos
  , let currDeleteEndPos :: Position
currDeleteEndPos = UInt -> UInt -> Position
LSP.Position UInt
endLine UInt
endCol
  , let currDeleteRange :: Range
currDeleteRange = Position -> Position -> Range
LSP.Range Position
currDeleteStartPos Position
currDeleteEndPos
  , let currDeleteTextEdit :: TextEdit
currDeleteTextEdit = Range -> Text -> TextEdit
LSP.TextEdit Range
currDeleteRange Text
""
  = TextEdit -> TextEdit -> LineSplitTextEdits
LineSplitTextEdits TextEdit
currInsertTextEdit TextEdit
currDeleteTextEdit
  | Bool
otherwise
  , let LSP.Range Position
startPos Position
_ = Range
tokenRange
  , let deleteTextEdit :: TextEdit
deleteTextEdit = Range -> Text -> TextEdit
LSP.TextEdit (Position -> Position -> Range
LSP.Range Position
startPos Position
startPos{ _character :: UInt
LSP._character = UInt
startCol UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
newLineCol }) Text
""
  , let insertPosition :: Position
insertPosition = UInt -> UInt -> Position
LSP.Position (UInt
startLine UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
1) UInt
0
  , let insertRange :: Range
insertRange = Position -> Position -> Range
LSP.Range Position
insertPosition Position
insertPosition
  , let insertText :: Text
insertText = String -> Text
Text.pack (Int -> ShowS
forall a. Int -> [a] -> [a]
List.take Int
newLineCol String
tokenString) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  , let insertTextEdit :: TextEdit
insertTextEdit = Range -> Text -> TextEdit
LSP.TextEdit Range
insertRange Text
insertText
  = TextEdit -> TextEdit -> LineSplitTextEdits
LineSplitTextEdits TextEdit
insertTextEdit TextEdit
deleteTextEdit
  where
    LSP.Range (LSP.Position UInt
startLine UInt
startCol) (LSP.Position UInt
endLine UInt
endCol) = Range
tokenRange

    newLineCol :: Int
newLineCol = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
Maybe.fromMaybe (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tokenString) (Char -> String -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
List.elemIndex Char
'\n' String
tokenString)

-- ITvarsym "#" after a block comment is a parse error so we don't need to worry about it
updateParserState :: Token -> LSP.Range -> ParserState -> ParserState
updateParserState :: Token -> Range -> ParserState -> ParserState
updateParserState Token
token Range
range ParserState
prevParserState
  | ParserStateNotDone
      { $sel:nextPragma:ParserStateNotDone :: ParserState -> NextPragmaInfo
nextPragma = prevNextPragma :: NextPragmaInfo
prevNextPragma@NextPragmaInfo{ $sel:lineSplitTextEdits:NextPragmaInfo :: NextPragmaInfo -> Maybe LineSplitTextEdits
lineSplitTextEdits = Maybe LineSplitTextEdits
prevLineSplitTextEdits }
      , $sel:mode:ParserStateNotDone :: ParserState -> Mode
mode = Mode
prevMode
      , Int
lastBlockCommentLine :: Int
$sel:lastBlockCommentLine:ParserStateNotDone :: ParserState -> Int
lastBlockCommentLine
      , Int
lastPragmaLine :: Int
$sel:lastPragmaLine:ParserStateNotDone :: ParserState -> Int
lastPragmaLine
      } <- ParserState
prevParserState
  , let defaultParserState :: ParserState
defaultParserState = ParserState
prevParserState { $sel:isLastTokenHash:ParserStateNotDone :: Bool
isLastTokenHash = Bool
False }
  , let LSP.Range (LSP.Position (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
startLine) UInt
_) (LSP.Position (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
endLine) UInt
_) = Range
range
  = case Mode
prevMode of
      Mode
ModeInitial ->
        case Token
token of
          ITvarsym FastString
"#" -> ParserState
defaultParserState{ $sel:isLastTokenHash:ParserStateNotDone :: Bool
isLastTokenHash = Bool
True }
#if !MIN_VERSION_ghc(9,2,0)
          ITlineComment String
s
#else
          ITlineComment s _
#endif
            | String -> Bool
isDownwardLineHaddock String
s -> ParserState
defaultParserState{ $sel:mode:ParserStateNotDone :: Mode
mode = Mode
ModeHaddock }
            | Bool
otherwise ->
                ParserState
defaultParserState
                  { $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = Int -> Maybe LineSplitTextEdits -> NextPragmaInfo
NextPragmaInfo (Int
endLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe LineSplitTextEdits
forall a. Maybe a
Nothing
                  , $sel:mode:ParserStateNotDone :: Mode
mode = Mode
ModeComment }
#if !MIN_VERSION_ghc(9,2,0)
          ITblockComment String
s
#else
          ITblockComment s _
#endif
            | String -> Bool
isPragma String
s ->
                ParserState
defaultParserState
                  { $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = Int -> Maybe LineSplitTextEdits -> NextPragmaInfo
NextPragmaInfo (Int
endLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe LineSplitTextEdits
forall a. Maybe a
Nothing
                  , $sel:mode:ParserStateNotDone :: Mode
mode = Mode
ModePragma
                  , $sel:lastPragmaLine:ParserStateNotDone :: Int
lastPragmaLine = Int
endLine }
            | String -> Bool
isDownwardBlockHaddock String
s -> ParserState
defaultParserState{ $sel:mode:ParserStateNotDone :: Mode
mode = Mode
ModeHaddock }
            | Bool
otherwise ->
                ParserState
defaultParserState
                  { $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = Int -> Maybe LineSplitTextEdits -> NextPragmaInfo
NextPragmaInfo (Int
endLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe LineSplitTextEdits
forall a. Maybe a
Nothing
                  , $sel:mode:ParserStateNotDone :: Mode
mode = Mode
ModeComment
                  , $sel:lastBlockCommentLine:ParserStateNotDone :: Int
lastBlockCommentLine = Int
endLine }
          Token
_ -> NextPragmaInfo -> ParserState
ParserStateDone NextPragmaInfo
prevNextPragma
      Mode
ModeComment ->
        case Token
token of
          ITvarsym FastString
"#" -> ParserState
defaultParserState{ $sel:isLastTokenHash:ParserStateNotDone :: Bool
isLastTokenHash = Bool
True }
#if !MIN_VERSION_ghc(9,2,0)
          ITlineComment String
s
#else
          ITlineComment s _
#endif
            | Int -> Maybe LineSplitTextEdits -> Bool
hasDeleteStartedOnSameLine Int
startLine Maybe LineSplitTextEdits
prevLineSplitTextEdits
            , let currLineSplitTextEdits :: LineSplitTextEdits
currLineSplitTextEdits = Range -> String -> Maybe LineSplitTextEdits -> LineSplitTextEdits
updateLineSplitTextEdits Range
range String
s Maybe LineSplitTextEdits
prevLineSplitTextEdits ->
                ParserState
defaultParserState{ $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = NextPragmaInfo
prevNextPragma{ $sel:lineSplitTextEdits:NextPragmaInfo :: Maybe LineSplitTextEdits
lineSplitTextEdits = LineSplitTextEdits -> Maybe LineSplitTextEdits
forall a. a -> Maybe a
Just LineSplitTextEdits
currLineSplitTextEdits } }
            | String -> Bool
isDownwardLineHaddock String
s
            , Int
lastBlockCommentLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
startLine
            , let currLineSplitTextEdits :: LineSplitTextEdits
currLineSplitTextEdits = Range -> String -> Maybe LineSplitTextEdits -> LineSplitTextEdits
updateLineSplitTextEdits Range
range String
s Maybe LineSplitTextEdits
forall a. Maybe a
Nothing ->
                ParserState
defaultParserState
                  { $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = NextPragmaInfo
prevNextPragma{ $sel:lineSplitTextEdits:NextPragmaInfo :: Maybe LineSplitTextEdits
lineSplitTextEdits = LineSplitTextEdits -> Maybe LineSplitTextEdits
forall a. a -> Maybe a
Just LineSplitTextEdits
currLineSplitTextEdits }
                  , $sel:mode:ParserStateNotDone :: Mode
mode = Mode
ModeHaddock }
            | Bool
otherwise ->
                ParserState
defaultParserState { $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = Int -> Maybe LineSplitTextEdits -> NextPragmaInfo
NextPragmaInfo (Int
endLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe LineSplitTextEdits
forall a. Maybe a
Nothing }
#if !MIN_VERSION_ghc(9,2,0)
          ITblockComment String
s
#else
          ITblockComment s _
#endif
            | String -> Bool
isPragma String
s ->
                ParserState
defaultParserState
                  { $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = Int -> Maybe LineSplitTextEdits -> NextPragmaInfo
NextPragmaInfo (Int
endLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe LineSplitTextEdits
forall a. Maybe a
Nothing
                  , $sel:mode:ParserStateNotDone :: Mode
mode = Mode
ModePragma
                  , $sel:lastPragmaLine:ParserStateNotDone :: Int
lastPragmaLine = Int
endLine }
            | Int -> Maybe LineSplitTextEdits -> Bool
hasDeleteStartedOnSameLine Int
startLine Maybe LineSplitTextEdits
prevLineSplitTextEdits
            , let currLineSplitTextEdits :: LineSplitTextEdits
currLineSplitTextEdits = Range -> String -> Maybe LineSplitTextEdits -> LineSplitTextEdits
updateLineSplitTextEdits Range
range String
s Maybe LineSplitTextEdits
prevLineSplitTextEdits ->
                ParserState
defaultParserState{ $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = NextPragmaInfo
prevNextPragma{ $sel:lineSplitTextEdits:NextPragmaInfo :: Maybe LineSplitTextEdits
lineSplitTextEdits = LineSplitTextEdits -> Maybe LineSplitTextEdits
forall a. a -> Maybe a
Just LineSplitTextEdits
currLineSplitTextEdits } }
            | String -> Bool
isDownwardBlockHaddock String
s
            , Int
lastBlockCommentLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
startLine
            , let currLineSplitTextEdits :: LineSplitTextEdits
currLineSplitTextEdits = Range -> String -> Maybe LineSplitTextEdits -> LineSplitTextEdits
updateLineSplitTextEdits Range
range String
s Maybe LineSplitTextEdits
forall a. Maybe a
Nothing ->
                ParserState
defaultParserState{
                  $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = NextPragmaInfo
prevNextPragma{ $sel:lineSplitTextEdits:NextPragmaInfo :: Maybe LineSplitTextEdits
lineSplitTextEdits = LineSplitTextEdits -> Maybe LineSplitTextEdits
forall a. a -> Maybe a
Just LineSplitTextEdits
currLineSplitTextEdits },
                  $sel:mode:ParserStateNotDone :: Mode
mode = Mode
ModeHaddock }
            | Bool
otherwise ->
                ParserState
defaultParserState{
                  $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = Int -> Maybe LineSplitTextEdits -> NextPragmaInfo
NextPragmaInfo (Int
endLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe LineSplitTextEdits
forall a. Maybe a
Nothing,
                  $sel:lastBlockCommentLine:ParserStateNotDone :: Int
lastBlockCommentLine = Int
endLine }
          Token
_ -> NextPragmaInfo -> ParserState
ParserStateDone NextPragmaInfo
prevNextPragma
      Mode
ModeHaddock ->
        case Token
token of
          ITvarsym FastString
"#" ->
            ParserState
defaultParserState{ $sel:isLastTokenHash:ParserStateNotDone :: Bool
isLastTokenHash = Bool
True }
#if !MIN_VERSION_ghc(9,2,0)
          ITlineComment String
s
#else
          ITlineComment s _
#endif
            | Int -> Maybe LineSplitTextEdits -> Bool
hasDeleteStartedOnSameLine Int
startLine Maybe LineSplitTextEdits
prevLineSplitTextEdits
            , let currLineSplitTextEdits :: LineSplitTextEdits
currLineSplitTextEdits = Range -> String -> Maybe LineSplitTextEdits -> LineSplitTextEdits
updateLineSplitTextEdits Range
range String
s Maybe LineSplitTextEdits
prevLineSplitTextEdits ->
                ParserState
defaultParserState{ $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = NextPragmaInfo
prevNextPragma{ $sel:lineSplitTextEdits:NextPragmaInfo :: Maybe LineSplitTextEdits
lineSplitTextEdits = LineSplitTextEdits -> Maybe LineSplitTextEdits
forall a. a -> Maybe a
Just LineSplitTextEdits
currLineSplitTextEdits } }
            | Bool
otherwise ->
                ParserState
defaultParserState
#if !MIN_VERSION_ghc(9,2,0)
          ITblockComment String
s
#else
          ITblockComment s _
#endif
            | String -> Bool
isPragma String
s ->
                ParserState
defaultParserState{
                  $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = Int -> Maybe LineSplitTextEdits -> NextPragmaInfo
NextPragmaInfo (Int
endLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe LineSplitTextEdits
forall a. Maybe a
Nothing,
                  $sel:mode:ParserStateNotDone :: Mode
mode = Mode
ModePragma,
                  $sel:lastPragmaLine:ParserStateNotDone :: Int
lastPragmaLine = Int
endLine }
            | Int -> Maybe LineSplitTextEdits -> Bool
hasDeleteStartedOnSameLine Int
startLine Maybe LineSplitTextEdits
prevLineSplitTextEdits
            , let currLineSplitTextEdits :: LineSplitTextEdits
currLineSplitTextEdits = Range -> String -> Maybe LineSplitTextEdits -> LineSplitTextEdits
updateLineSplitTextEdits Range
range String
s Maybe LineSplitTextEdits
prevLineSplitTextEdits ->
                ParserState
defaultParserState{ $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = NextPragmaInfo
prevNextPragma{ $sel:lineSplitTextEdits:NextPragmaInfo :: Maybe LineSplitTextEdits
lineSplitTextEdits = LineSplitTextEdits -> Maybe LineSplitTextEdits
forall a. a -> Maybe a
Just LineSplitTextEdits
currLineSplitTextEdits } }
            | Bool
otherwise -> ParserState
defaultParserState{ $sel:lastBlockCommentLine:ParserStateNotDone :: Int
lastBlockCommentLine = Int
endLine }
          Token
_ -> NextPragmaInfo -> ParserState
ParserStateDone NextPragmaInfo
prevNextPragma
      Mode
ModePragma ->
        case Token
token of
          ITvarsym FastString
"#" -> ParserState
defaultParserState{ $sel:isLastTokenHash:ParserStateNotDone :: Bool
isLastTokenHash = Bool
True }
#if !MIN_VERSION_ghc(9,2,0)
          ITlineComment String
s
#else
          ITlineComment s _
#endif
            | Int -> Maybe LineSplitTextEdits -> Bool
hasDeleteStartedOnSameLine Int
startLine Maybe LineSplitTextEdits
prevLineSplitTextEdits
            , let currLineSplitTextEdits :: LineSplitTextEdits
currLineSplitTextEdits = Range -> String -> Maybe LineSplitTextEdits -> LineSplitTextEdits
updateLineSplitTextEdits Range
range String
s Maybe LineSplitTextEdits
prevLineSplitTextEdits ->
                ParserState
defaultParserState{ $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = NextPragmaInfo
prevNextPragma{ $sel:lineSplitTextEdits:NextPragmaInfo :: Maybe LineSplitTextEdits
lineSplitTextEdits = LineSplitTextEdits -> Maybe LineSplitTextEdits
forall a. a -> Maybe a
Just LineSplitTextEdits
currLineSplitTextEdits } }
            | String -> Bool
isDownwardLineHaddock String
s
            , Int
lastPragmaLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
startLine
            , let currLineSplitTextEdits :: LineSplitTextEdits
currLineSplitTextEdits = Range -> String -> Maybe LineSplitTextEdits -> LineSplitTextEdits
updateLineSplitTextEdits Range
range String
s Maybe LineSplitTextEdits
forall a. Maybe a
Nothing ->
                ParserState
defaultParserState{ $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = NextPragmaInfo
prevNextPragma{ $sel:lineSplitTextEdits:NextPragmaInfo :: Maybe LineSplitTextEdits
lineSplitTextEdits = LineSplitTextEdits -> Maybe LineSplitTextEdits
forall a. a -> Maybe a
Just LineSplitTextEdits
currLineSplitTextEdits } }
            | Bool
otherwise ->
                ParserState
defaultParserState
#if !MIN_VERSION_ghc(9,2,0)
          ITblockComment String
s
#else
          ITblockComment s _
#endif
            | String -> Bool
isPragma String
s ->
                ParserState
defaultParserState{ $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = Int -> Maybe LineSplitTextEdits -> NextPragmaInfo
NextPragmaInfo (Int
endLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe LineSplitTextEdits
forall a. Maybe a
Nothing, $sel:lastPragmaLine:ParserStateNotDone :: Int
lastPragmaLine = Int
endLine }
            | Int -> Maybe LineSplitTextEdits -> Bool
hasDeleteStartedOnSameLine Int
startLine Maybe LineSplitTextEdits
prevLineSplitTextEdits
            , let currLineSplitTextEdits :: LineSplitTextEdits
currLineSplitTextEdits = Range -> String -> Maybe LineSplitTextEdits -> LineSplitTextEdits
updateLineSplitTextEdits Range
range String
s Maybe LineSplitTextEdits
prevLineSplitTextEdits ->
                ParserState
defaultParserState{ $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = NextPragmaInfo
prevNextPragma{ $sel:lineSplitTextEdits:NextPragmaInfo :: Maybe LineSplitTextEdits
lineSplitTextEdits = LineSplitTextEdits -> Maybe LineSplitTextEdits
forall a. a -> Maybe a
Just LineSplitTextEdits
currLineSplitTextEdits } }
            | String -> Bool
isDownwardBlockHaddock String
s
            , Int
lastPragmaLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
startLine
            , let currLineSplitTextEdits :: LineSplitTextEdits
currLineSplitTextEdits = Range -> String -> Maybe LineSplitTextEdits -> LineSplitTextEdits
updateLineSplitTextEdits Range
range String
s Maybe LineSplitTextEdits
forall a. Maybe a
Nothing ->
                ParserState
defaultParserState{ $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = NextPragmaInfo
prevNextPragma{ $sel:lineSplitTextEdits:NextPragmaInfo :: Maybe LineSplitTextEdits
lineSplitTextEdits = LineSplitTextEdits -> Maybe LineSplitTextEdits
forall a. a -> Maybe a
Just LineSplitTextEdits
currLineSplitTextEdits } }
            | Int
lastPragmaLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
startLine Bool -> Bool -> Bool
&& Int
startLine Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
endLine
            , let currLineSplitTextEdits :: LineSplitTextEdits
currLineSplitTextEdits = Range -> String -> Maybe LineSplitTextEdits -> LineSplitTextEdits
updateLineSplitTextEdits Range
range String
s Maybe LineSplitTextEdits
forall a. Maybe a
Nothing ->
                ParserState
defaultParserState{ $sel:nextPragma:ParserStateNotDone :: NextPragmaInfo
nextPragma = NextPragmaInfo
prevNextPragma{ $sel:lineSplitTextEdits:NextPragmaInfo :: Maybe LineSplitTextEdits
lineSplitTextEdits = LineSplitTextEdits -> Maybe LineSplitTextEdits
forall a. a -> Maybe a
Just LineSplitTextEdits
currLineSplitTextEdits } }
            | Bool
otherwise ->
                ParserState
defaultParserState{ $sel:lastBlockCommentLine:ParserStateNotDone :: Int
lastBlockCommentLine = Int
endLine }
          Token
_ -> NextPragmaInfo -> ParserState
ParserStateDone NextPragmaInfo
prevNextPragma
  | Bool
otherwise = ParserState
prevParserState
  where
    hasDeleteStartedOnSameLine :: Int -> Maybe LineSplitTextEdits -> Bool
    hasDeleteStartedOnSameLine :: Int -> Maybe LineSplitTextEdits -> Bool
hasDeleteStartedOnSameLine Int
line Maybe LineSplitTextEdits
lineSplitTextEdits
      | Just LineSplitTextEdits
lineSplitTextEdits <- Maybe LineSplitTextEdits
lineSplitTextEdits
      , let LineSplitTextEdits{ TextEdit
lineSplitDeleteTextEdit :: TextEdit
$sel:lineSplitDeleteTextEdit:LineSplitTextEdits :: LineSplitTextEdits -> TextEdit
lineSplitDeleteTextEdit } = LineSplitTextEdits
lineSplitTextEdits
      , let LSP.TextEdit Range
deleteRange Text
_ = TextEdit
lineSplitDeleteTextEdit
      , let LSP.Range Position
_ Position
deleteEndPosition = Range
deleteRange
      , let LSP.Position UInt
deleteEndLine UInt
_ = Position
deleteEndPosition
      = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
deleteEndLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line
      | Bool
otherwise = Bool
False

lexUntilNextLineIncl :: P (Located Token)
lexUntilNextLineIncl :: P (Located Token)
lexUntilNextLineIncl = do
  PState{ RealSrcSpan
last_loc :: PState -> RealSrcSpan
last_loc :: RealSrcSpan
last_loc } <- P PState
getPState
#if MIN_VERSION_ghc(9,0,0)
  let PsSpan{ psRealSpan = lastRealSrcSpan } = last_loc
#else
  let lastRealSrcSpan :: RealSrcSpan
lastRealSrcSpan = RealSrcSpan
last_loc
#endif
  let prevEndLine :: Int
prevEndLine = RealSrcSpan
lastRealSrcSpan RealSrcSpan -> (RealSrcSpan -> RealSrcLoc) -> RealSrcLoc
forall a b. a -> (a -> b) -> b
& RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcLoc -> (RealSrcLoc -> Int) -> Int
forall a b. a -> (a -> b) -> b
& RealSrcLoc -> Int
srcLocLine
  locatedToken :: Located Token
locatedToken@(L SrcSpan
srcSpan Token
_token) <- Bool -> (Located Token -> P (Located Token)) -> P (Located Token)
forall a. Bool -> (Located Token -> P a) -> P a
lexer Bool
False Located Token -> P (Located Token)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  if | RealSrcLoc RealSrcLoc
currEndRealSrcLoc Maybe BufPos
_ <- SrcSpan
srcSpan SrcSpan -> (SrcSpan -> SrcLoc) -> SrcLoc
forall a b. a -> (a -> b) -> b
& SrcSpan -> SrcLoc
srcSpanEnd
     , let currEndLine :: Int
currEndLine = RealSrcLoc
currEndRealSrcLoc RealSrcLoc -> (RealSrcLoc -> Int) -> Int
forall a b. a -> (a -> b) -> b
& RealSrcLoc -> Int
srcLocLine
     -> if Int
prevEndLine Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
currEndLine then
          Located Token -> P (Located Token)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located Token
locatedToken
        else P (Located Token)
lexUntilNextLineIncl
     | Bool
otherwise -> Located Token -> P (Located Token)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located Token
locatedToken

dropWhileStringBuffer :: (Char -> Bool) -> StringBuffer -> StringBuffer
dropWhileStringBuffer :: (Char -> Bool) -> StringBuffer -> StringBuffer
dropWhileStringBuffer Char -> Bool
predicate StringBuffer
buffer
  | StringBuffer -> Bool
atEnd StringBuffer
buffer = StringBuffer
buffer
  | let (Char
c, StringBuffer
remainingBuffer) = StringBuffer -> (Char, StringBuffer)
nextChar StringBuffer
buffer
  = if Char -> Bool
predicate Char
c then
      (Char -> Bool) -> StringBuffer -> StringBuffer
dropWhileStringBuffer Char -> Bool
predicate StringBuffer
remainingBuffer
    else
      StringBuffer
buffer

isHorizontalSpace :: Char -> Bool
isHorizontalSpace :: Char -> Bool
isHorizontalSpace Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'

data ShebangParserState = ShebangParserState {
  ShebangParserState -> Int
nextPragmaLine :: !Int,
  ShebangParserState -> Int
newlineCount   :: !Int,
  ShebangParserState -> Bool
prevCharIsHash :: !Bool,
  ShebangParserState -> StringBuffer
buffer         :: !StringBuffer
}

-- lexer seems to ignore shebangs completely hence this function
parseShebangs :: ShebangParserState -> ShebangParserState
parseShebangs :: ShebangParserState -> ShebangParserState
parseShebangs prev :: ShebangParserState
prev@ShebangParserState{ $sel:newlineCount:ShebangParserState :: ShebangParserState -> Int
newlineCount = Int
prevNewlineCount, Bool
prevCharIsHash :: Bool
$sel:prevCharIsHash:ShebangParserState :: ShebangParserState -> Bool
prevCharIsHash, $sel:buffer:ShebangParserState :: ShebangParserState -> StringBuffer
buffer = StringBuffer
prevBuffer }
  | StringBuffer -> Bool
atEnd StringBuffer
prevBuffer
  = ShebangParserState
prev
  | let (Char
c, StringBuffer
currBuffer) = StringBuffer -> (Char, StringBuffer)
nextChar ((Char -> Bool) -> StringBuffer -> StringBuffer
dropWhileStringBuffer Char -> Bool
isHorizontalSpace StringBuffer
prevBuffer)
  = if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' then
      ShebangParserState -> ShebangParserState
parseShebangs ShebangParserState
prev{ $sel:prevCharIsHash:ShebangParserState :: Bool
prevCharIsHash = Bool
True, $sel:buffer:ShebangParserState :: StringBuffer
buffer = StringBuffer
currBuffer }
    else if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!' Bool -> Bool -> Bool
&& Bool
prevCharIsHash then
      ShebangParserState -> ShebangParserState
parseShebangs ShebangParserState
prev{ $sel:nextPragmaLine:ShebangParserState :: Int
nextPragmaLine = Int
prevNewlineCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, $sel:buffer:ShebangParserState :: StringBuffer
buffer = (Char -> Bool) -> StringBuffer -> StringBuffer
dropWhileStringBuffer (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') StringBuffer
currBuffer }
    else if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then
      ShebangParserState -> ShebangParserState
parseShebangs ShebangParserState
prev{ $sel:newlineCount:ShebangParserState :: Int
newlineCount = Int
prevNewlineCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, $sel:buffer:ShebangParserState :: StringBuffer
buffer = StringBuffer
currBuffer }
    else
      ShebangParserState
prev


-- | Parses blank lines, comments, haddock comments ("-- |"), lines that start
-- with "#!", lines that start with "#", pragma lines using the GHC API lexer.
-- When it doesn't find one of these things then it's assumed that we've found
-- a declaration, end-of-file, or a ghc parse error, and the parser stops.
-- Shebangs are parsed separately than the rest becaues the lexer ignores them.
--
-- The reason for custom parsing instead of using annotations, or turning on/off
-- extensions in the dynflags is because there are a number of extensions that
-- while removing parse errors, can also introduce them. Hence, there are
-- cases where the file cannot be parsed without error when we want to insert
-- extension (and other) pragmas. The compiler (8.10.7) doesn't include
-- annotations in its failure state. So if the compiler someday returns
-- annotation or equivalent information when it fails then we can replace this
-- with that.
--
-- The reason for using the compiler lexer is to reduce duplicated
-- implementation, particularly nested comments, but in retrospect this comes
-- with the disadvantage of the logic feeling more complex, and not being able
-- to handle whitespace directly.
--
-- The parser keeps track of state in order to place the next pragma line
-- according to some rules:
--
-- - Ignore lines starting with '#' except for shebangs.
-- - If pragmas exist place after last pragma
-- - else if haddock comments exist:
--     - If comments exist place after last comment
--     - else if shebangs exist place after last shebang
--     - else place at first line
-- - else if comments exist place after last comment
-- - else if shebangs exist place after last shebang
-- - else place at first line
--
-- Additionally the parser keeps track of information to be able to insert
-- pragmas inbetween lines.
--
-- For example the parser keeps track of information so that
--
-- > {- block comment -} -- | haddock
--
-- can become
--
-- > {- block comment -}
-- > {-# pragma #-}
-- > -- | haddock
--
-- This information does not respect the type of whitespace, because the lexer
-- strips whitespace and gives locations.
--
-- In this example the tabs are converted to spaces in the TextEdits:
--
-- > {- block comment -}<space><tab><tab><space>-- | haddock
--
parsePreDecl :: DynFlags -> StringBuffer -> ParseResult ParserState
parsePreDecl :: DynFlags -> StringBuffer -> ParseResult ParserState
parsePreDecl DynFlags
dynFlags StringBuffer
buffer = P ParserState -> PState -> ParseResult ParserState
forall a. P a -> PState -> ParseResult a
unP (ParserState -> P ParserState
go ParserState
initialParserState) PState
pState
  where
    initialShebangParserState :: ShebangParserState
initialShebangParserState = ShebangParserState :: Int -> Int -> Bool -> StringBuffer -> ShebangParserState
ShebangParserState{
      $sel:nextPragmaLine:ShebangParserState :: Int
nextPragmaLine = Int
0,
      $sel:newlineCount:ShebangParserState :: Int
newlineCount = Int
0,
      $sel:prevCharIsHash:ShebangParserState :: Bool
prevCharIsHash = Bool
False,
      $sel:buffer:ShebangParserState :: StringBuffer
buffer = StringBuffer
buffer }
    ShebangParserState{ Int
nextPragmaLine :: Int
$sel:nextPragmaLine:ShebangParserState :: ShebangParserState -> Int
nextPragmaLine } = ShebangParserState -> ShebangParserState
parseShebangs ShebangParserState
initialShebangParserState
    pState :: PState
pState = DynFlags -> StringBuffer -> PState
mkLexerPState DynFlags
dynFlags StringBuffer
buffer
    initialParserState :: ParserState
initialParserState = NextPragmaInfo -> Mode -> Int -> Int -> Bool -> ParserState
ParserStateNotDone (Int -> Maybe LineSplitTextEdits -> NextPragmaInfo
NextPragmaInfo Int
nextPragmaLine Maybe LineSplitTextEdits
forall a. Maybe a
Nothing) Mode
ModeInitial (-Int
1) (-Int
1) Bool
False

    go :: ParserState -> P ParserState
    go :: ParserState -> P ParserState
go ParserState
prevParserState =
      case ParserState
prevParserState of
        ParserStateDone NextPragmaInfo
_ -> ParserState -> P ParserState
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParserState
prevParserState
        ParserStateNotDone{Bool
Int
NextPragmaInfo
Mode
isLastTokenHash :: Bool
lastPragmaLine :: Int
lastBlockCommentLine :: Int
mode :: Mode
nextPragma :: NextPragmaInfo
$sel:isLastTokenHash:ParserStateNotDone :: ParserState -> Bool
$sel:lastPragmaLine:ParserStateNotDone :: ParserState -> Int
$sel:lastBlockCommentLine:ParserStateNotDone :: ParserState -> Int
$sel:mode:ParserStateNotDone :: ParserState -> Mode
$sel:nextPragma:ParserStateNotDone :: ParserState -> NextPragmaInfo
..} -> do
          L SrcSpan
srcSpan Token
token <-
            if Bool
isLastTokenHash then
              P (Located Token)
lexUntilNextLineIncl
            else
              Bool -> (Located Token -> P (Located Token)) -> P (Located Token)
forall a. Bool -> (Located Token -> P a) -> P a
lexer Bool
False Located Token -> P (Located Token)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          case SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
srcSpan of
            Just Range
range -> ParserState -> P ParserState
go (Token -> Range -> ParserState -> ParserState
updateParserState Token
token Range
range ParserState
prevParserState)
            Maybe Range
Nothing    -> ParserState -> P ParserState
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParserState
prevParserState

mkLexerPState :: DynFlags -> StringBuffer -> PState
mkLexerPState :: DynFlags -> StringBuffer -> PState
mkLexerPState DynFlags
dynFlags StringBuffer
stringBuffer =
  let
    startRealSrcLoc :: RealSrcLoc
startRealSrcLoc = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
"asdf" Int
1 Int
1
    updateDynFlags :: DynFlags -> DynFlags
updateDynFlags = (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_Haddock (DynFlags -> DynFlags)
-> (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_set GeneralFlag
Opt_KeepRawTokenStream
    finalDynFlags :: DynFlags
finalDynFlags = DynFlags -> DynFlags
updateDynFlags DynFlags
dynFlags
#if !MIN_VERSION_ghc(8,8,1)
    pState = mkPState finalDynFlags stringBuffer startRealSrcLoc
    finalPState = pState{ use_pos_prags = False }
#elif !MIN_VERSION_ghc(8,10,1)
    mkLexerParserFlags =
      mkParserFlags'
      <$> warningFlags
      <*> extensionFlags
      <*> homeUnitId_
      <*> safeImportsOn
      <*> gopt Opt_Haddock
      <*> gopt Opt_KeepRawTokenStream
      <*> const False
    finalPState = mkPStatePure (mkLexerParserFlags finalDynFlags) stringBuffer startRealSrcLoc
#else
    pState :: PState
pState = DynFlags -> StringBuffer -> RealSrcLoc -> PState
initParserState (DynFlags -> DynFlags
initParserOpts DynFlags
finalDynFlags) StringBuffer
stringBuffer RealSrcLoc
startRealSrcLoc
    PState{ options :: PState -> ParserFlags
options = ParserFlags
pStateOptions } = PState
pState
    finalExtBitsMap :: ExtsBitmap
finalExtBitsMap = ExtsBitmap -> Int -> ExtsBitmap
forall a. Bits a => a -> Int -> a
setBit (ParserFlags -> ExtsBitmap
pExtsBitmap ParserFlags
pStateOptions) (ExtBits -> Int
forall a. Enum a => a -> Int
fromEnum ExtBits
UsePosPragsBit)
    finalPStateOptions :: ParserFlags
finalPStateOptions = ParserFlags
pStateOptions{ pExtsBitmap :: ExtsBitmap
pExtsBitmap = ExtsBitmap
finalExtBitsMap }
    finalPState :: PState
finalPState = PState
pState{ options :: ParserFlags
options = ParserFlags
finalPStateOptions }
#endif
  in
    PState
finalPState