    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TypeApplications #-}
    -- | This module provides support for CPP, interpreter directives and line
    -- pragmas.
    module Language.Haskell.GHC.ExactPrint.Preprocess
       (
         stripLinePragmas
       , getCppTokensAsComments
       , getPreprocessedSrcDirect
       , readFileGhc

       , CppOptions(..)
       , defaultCppOptions
       , showErrorMessages
       ) where

    import qualified GHC            as GHC hiding (parseModule)

    import qualified Control.Monad.IO.Class as GHC
    import qualified GHC.Data.Bag          as GHC
    import qualified GHC.Data.FastString   as GHC
    import qualified GHC.Data.StringBuffer as GHC
    -- import qualified GHC.Driver.Config     as GHC
    import qualified GHC.Driver.Config.Parser     as GHC
    import qualified GHC.Driver.Env        as GHC
    import qualified GHC.Driver.Errors.Types        as GHC
    import qualified GHC.Driver.Phases     as GHC
    import qualified GHC.Driver.Pipeline   as GHC
    import qualified GHC.Fingerprint.Type  as GHC
    -- import qualified GHC.Parser.Errors.Ppr as GHC
    import qualified GHC.Parser.Lexer      as GHC
    import qualified GHC.Settings          as GHC
    import qualified GHC.Types.SourceError as GHC
    import qualified GHC.Types.SrcLoc      as GHC
    import qualified GHC.Types.SourceFile  as GHC
    import qualified GHC.Types.Error  as GHC
    -- import qualified GHC.Utils.Error       as GHC
    import qualified GHC.Utils.Fingerprint as GHC
    import GHC.Types.SrcLoc (mkSrcSpan, mkSrcLoc)
    import GHC.Data.FastString (mkFastString)

    import Data.List (isPrefixOf, intercalate)
    import Data.Maybe
    import Language.Haskell.GHC.ExactPrint.Types
    import Language.Haskell.GHC.ExactPrint.Utils
    import qualified Data.Set as Set

    -- import Debug.Trace
    --
    {-# ANN module ("HLint: ignore Eta reduce" :: String) #-}
    {-# ANN module ("HLint: ignore Redundant do" :: String) #-}
    {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}

    -- ---------------------------------------------------------------------

    data CppOptions = CppOptions
                    { CppOptions -> [String]
    cppDefine :: [String]    -- ^ CPP #define macros
                    , CppOptions -> [String]
    cppInclude :: [FilePath] -- ^ CPP Includes directory
                    , CppOptions -> [String]
    cppFile :: [FilePath]    -- ^ CPP pre-include file
                    }

    defaultCppOptions :: CppOptions
    defaultCppOptions :: CppOptions
    defaultCppOptions = [String] -> [String] -> [String] -> CppOptions
    CppOptions [] [] []

    -- ---------------------------------------------------------------------
    -- | Remove GHC style line pragams (@{-# LINE .. #-}@) and convert them into comments.
    stripLinePragmas :: String -> (String, [GHC.LEpaComment])
    stripLinePragmas :: String -> (String, [LEpaComment])
    stripLinePragmas = ([String], [Maybe LEpaComment]) -> (String, [LEpaComment])
    forall {a}. ([String], [Maybe a]) -> (String, [a])
    unlines' (([String], [Maybe LEpaComment]) -> (String, [LEpaComment]))
    -> (String -> ([String], [Maybe LEpaComment]))
    -> String
    -> (String, [LEpaComment])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(String, Maybe LEpaComment)] -> ([String], [Maybe LEpaComment])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(String, Maybe LEpaComment)] -> ([String], [Maybe LEpaComment]))
    -> (String -> [(String, Maybe LEpaComment)])
    -> String
    -> ([String], [Maybe LEpaComment])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [(String, Maybe LEpaComment)]
    findLines ([String] -> [(String, Maybe LEpaComment)])
    -> (String -> [String]) -> String -> [(String, Maybe LEpaComment)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines
      where
        unlines' :: ([String], [Maybe a]) -> (String, [a])
    unlines' ([String]
    a, [Maybe a]
    b) = ([String] -> String
    unlines [String]
    a, [Maybe a] -> [a]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe a]
    b)

    findLines :: [String] -> [(String, Maybe GHC.LEpaComment)]
    findLines :: [String] -> [(String, Maybe LEpaComment)]
    findLines = (Int -> String -> (String, Maybe LEpaComment))
    -> [Int] -> [String] -> [(String, Maybe LEpaComment)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> String -> (String, Maybe LEpaComment)
    checkLine [Int
    1..]

    checkLine :: Int -> String -> (String, Maybe GHC.LEpaComment)
    checkLine :: Int -> String -> (String, Maybe LEpaComment)
    checkLine Int
    line String
    s
      |  String
    "{-# LINE" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    s =
           let (String
    pragma, String
    res) = String -> (String, String)
    getPragma String
    s
               size :: Int
    size   = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    pragma
               mSrcLoc :: Int -> Int -> SrcLoc
    mSrcLoc = FastString -> Int -> Int -> SrcLoc
    mkSrcLoc (String -> FastString
    mkFastString String
    "LINE")
               ss :: SrcSpan
    ss     = SrcLoc -> SrcLoc -> SrcSpan
    mkSrcSpan (Int -> Int -> SrcLoc
    mSrcLoc Int
    line Int
    1) (Int -> Int -> SrcLoc
    mSrcLoc Int
    line (Int
    sizeInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1))
           in (String
    res, LEpaComment -> Maybe LEpaComment
    forall a. a -> Maybe a
    Just (LEpaComment -> Maybe LEpaComment)
    -> LEpaComment -> Maybe LEpaComment
    forall a b. (a -> b) -> a -> b
    $ String -> Anchor -> RealSrcSpan -> LEpaComment
    mkLEpaComment String
    pragma (SrcSpan -> Anchor
    GHC.spanAsAnchor SrcSpan
    ss) (SrcSpan -> RealSrcSpan
    GHC.realSrcSpan SrcSpan
    ss))
      -- Deal with shebang/cpp directives too
      -- x |  "#" `isPrefixOf` s = ("",Just $ Comment ((line, 1), (line, length s)) s)
      |  String
    "#!" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    s =
        let mSrcLoc :: Int -> Int -> SrcLoc
    mSrcLoc = FastString -> Int -> Int -> SrcLoc
    mkSrcLoc (String -> FastString
    mkFastString String
    "SHEBANG")
            ss :: SrcSpan
    ss = SrcLoc -> SrcLoc -> SrcSpan
    mkSrcSpan (Int -> Int -> SrcLoc
    mSrcLoc Int
    line Int
    1) (Int -> Int -> SrcLoc
    mSrcLoc Int
    line (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s))
        in
        (String
    "",LEpaComment -> Maybe LEpaComment
    forall a. a -> Maybe a
    Just (LEpaComment -> Maybe LEpaComment)
    -> LEpaComment -> Maybe LEpaComment
    forall a b. (a -> b) -> a -> b
    $ String -> Anchor -> RealSrcSpan -> LEpaComment
    mkLEpaComment String
    s (SrcSpan -> Anchor
    GHC.spanAsAnchor SrcSpan
    ss) (SrcSpan -> RealSrcSpan
    GHC.realSrcSpan SrcSpan
    ss))
      | Bool
    otherwise = (String
    s, Maybe LEpaComment
    forall a. Maybe a
    Nothing)

    getPragma :: String -> (String, String)
    getPragma :: String -> (String, String)
    getPragma [] = String -> (String, String)
    forall a. HasCallStack => String -> a
    error String
    "Input must not be empty"
    getPragma s :: String
    s@(Char
    x:String
    xs)
      | String
    "#-}" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    s = (String
    "#-}", String
    "   " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    3 String
    s)
      | Bool
    otherwise =
          let (String
    prag, String
    remline) = String -> (String, String)
    getPragma String
    xs
          in (Char
    xChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    prag, Char
    ' 'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    remline)

    -- ---------------------------------------------------------------------

    -- | Replacement for original 'getRichTokenStream' which will return
    -- the tokens for a file processed by CPP.
    -- See bug <http://ghc.haskell.org/trac/ghc/ticket/8265>
    getCppTokensAsComments :: GHC.GhcMonad m
                           => CppOptions  -- ^ Preprocessor Options
                           -> FilePath    -- ^ Path to source file
                           -> m [GHC.LEpaComment]
    getCppTokensAsComments :: forall (m :: * -> *).
    GhcMonad m =>
    CppOptions -> String -> m [LEpaComment]
    getCppTokensAsComments CppOptions
    cppOptions String
    sourceFile = do
      StringBuffer
    source <- IO StringBuffer -> m StringBuffer
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    GHC.liftIO (IO StringBuffer -> m StringBuffer)
    -> IO StringBuffer -> m StringBuffer
    forall a b. (a -> b) -> a -> b
    $ String -> IO StringBuffer
    GHC.hGetStringBuffer String
    sourceFile
      let startLoc :: RealSrcLoc
    startLoc = FastString -> Int -> Int -> RealSrcLoc
    GHC.mkRealSrcLoc (String -> FastString
    GHC.mkFastString String
    sourceFile) Int
    1 Int
    1
      (String
    _txt,StringBuffer
    strSrcBuf,DynFlags
    flags2') <- CppOptions -> String -> m (String, StringBuffer, DynFlags)
    forall (m :: * -> *).
    GhcMonad m =>
    CppOptions -> String -> m (String, StringBuffer, DynFlags)
    getPreprocessedSrcDirectPrim CppOptions
    cppOptions String
    sourceFile
      let flags2 :: ParserOpts
    flags2 = DynFlags -> ParserOpts
    GHC.initParserOpts DynFlags
    flags2'
      -- hash-ifdef tokens
      [(Located Token, String)]
    directiveToks <- IO [(Located Token, String)] -> m [(Located Token, String)]
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    GHC.liftIO (IO [(Located Token, String)] -> m [(Located Token, String)])
    -> IO [(Located Token, String)] -> m [(Located Token, String)]
    forall a b. (a -> b) -> a -> b
    $ String -> IO [(Located Token, String)]
    getPreprocessorAsComments String
    sourceFile
      -- Tokens without hash-ifdef
      [(Located Token, String)]
    nonDirectiveToks <- RealSrcLoc
    -> ParserOpts -> StringBuffer -> m [(Located Token, String)]
    forall (m :: * -> *).
    GhcMonad m =>
    RealSrcLoc
    -> ParserOpts -> StringBuffer -> m [(Located Token, String)]
    tokeniseOriginalSrc RealSrcLoc
    startLoc ParserOpts
    flags2 StringBuffer
    source
      case ParserOpts
    -> StringBuffer -> RealSrcLoc -> ParseResult [Located Token]
    GHC.lexTokenStream ParserOpts
    flags2 StringBuffer
    strSrcBuf RealSrcLoc
    startLoc of
            GHC.POk PState
    _ [Located Token]
    ts ->
                   do
                      let toks :: [(Located Token, String)]
    toks = RealSrcLoc
    -> StringBuffer -> [Located Token] -> [(Located Token, String)]
    GHC.addSourceToTokens RealSrcLoc
    startLoc StringBuffer
    source [Located Token]
    ts
                          cppCommentToks :: [(Located Token, String)]
    cppCommentToks = [(Located Token, String)]
    -> [(Located Token, String)]
    -> [(Located Token, String)]
    -> [(Located Token, String)]
    getCppTokens [(Located Token, String)]
    directiveToks [(Located Token, String)]
    nonDirectiveToks [(Located Token, String)]
    toks
                      [LEpaComment] -> m [LEpaComment]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([LEpaComment] -> m [LEpaComment])
    -> [LEpaComment] -> m [LEpaComment]
    forall a b. (a -> b) -> a -> b
    $ (LEpaComment -> Bool) -> [LEpaComment] -> [LEpaComment]
    forall a. (a -> Bool) -> [a] -> [a]
    filter LEpaComment -> Bool
    goodComment
                             ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
    forall a b. (a -> b) -> a -> b
    $  ((Located Token, String) -> LEpaComment)
    -> [(Located Token, String)] -> [LEpaComment]
    forall a b. (a -> b) -> [a] -> [b]
    map (RealLocated Token -> LEpaComment
    GHC.commentToAnnotation (RealLocated Token -> LEpaComment)
    -> ((Located Token, String) -> RealLocated Token)
    -> (Located Token, String)
    -> LEpaComment
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Located Token -> RealLocated Token
    forall a. Located a -> RealLocated a
    toRealLocated (Located Token -> RealLocated Token)
    -> ((Located Token, String) -> Located Token)
    -> (Located Token, String)
    -> RealLocated Token
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Located Token, String) -> Located Token
    forall a b. (a, b) -> a
    fst) [(Located Token, String)]
    cppCommentToks
            GHC.PFailed PState
    pst -> PState -> m [LEpaComment]
    forall (m :: * -> *) b. MonadIO m => PState -> m b
    parseError PState
    pst

    goodComment :: GHC.LEpaComment -> Bool
    goodComment :: LEpaComment -> Bool
    goodComment LEpaComment
    c = [Comment] -> Bool
    isGoodComment (LEpaComment -> [Comment]
    tokComment LEpaComment
    c)
      where
        isGoodComment :: [Comment] -> Bool
        isGoodComment :: [Comment] -> Bool
    isGoodComment []                 = Bool
    False
        isGoodComment [Comment String
    "" Anchor
    _ RealSrcSpan
    _ Maybe AnnKeywordId
    _] = Bool
    False
        isGoodComment [Comment]
    _                  = Bool
    True

    toRealLocated :: GHC.Located a -> GHC.RealLocated a
    toRealLocated :: forall a. Located a -> RealLocated a
    toRealLocated (GHC.L (GHC.RealSrcSpan RealSrcSpan
    s Maybe BufSpan
    _) a
    x) = RealSrcSpan -> a -> GenLocated RealSrcSpan a
    forall l e. l -> e -> GenLocated l e
    GHC.L RealSrcSpan
    s              a
    x
    toRealLocated (GHC.L SrcSpan
    _ a
    x)                     = RealSrcSpan -> a -> GenLocated RealSrcSpan a
    forall l e. l -> e -> GenLocated l e
    GHC.L RealSrcSpan
    badRealSrcSpan a
    x

    -- ---------------------------------------------------------------------

    -- | Combine the three sets of tokens to produce a single set that
    -- represents the code compiled, and will regenerate the original
    -- source file.
    -- [@directiveToks@] are the tokens corresponding to preprocessor
    --                   directives, converted to comments
    -- [@origSrcToks@] are the tokenised source of the original code, with
    --                 the preprocessor directives stripped out so that
    --                 the lexer  does not complain
    -- [@postCppToks@] are the tokens that the compiler saw originally
    -- NOTE: this scheme will only work for cpp in -nomacro mode
    getCppTokens ::
         [(GHC.Located GHC.Token, String)]
      -> [(GHC.Located GHC.Token, String)]
      -> [(GHC.Located GHC.Token, String)]
      -> [(GHC.Located GHC.Token, String)]
    getCppTokens :: [(Located Token, String)]
    -> [(Located Token, String)]
    -> [(Located Token, String)]
    -> [(Located Token, String)]
    getCppTokens [(Located Token, String)]
    directiveToks [(Located Token, String)]
    origSrcToks [(Located Token, String)]
    postCppToks = [(Located Token, String)]
    toks
      where
        locFn :: (GenLocated SrcSpan e, b) -> (GenLocated SrcSpan e, b) -> Ordering
    locFn (GHC.L SrcSpan
    l1 e
    _,b
    _) (GHC.L SrcSpan
    l2 e
    _,b
    _) = RealSrcSpan -> RealSrcSpan -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (SrcSpan -> RealSrcSpan
    rs SrcSpan
    l1) (SrcSpan -> RealSrcSpan
    rs SrcSpan
    l2)
        m1Toks :: [(Located Token, String)]
    m1Toks = ((Located Token, String) -> (Located Token, String) -> Ordering)
    -> [(Located Token, String)]
    -> [(Located Token, String)]
    -> [(Located Token, String)]
    forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
    mergeBy (Located Token, String) -> (Located Token, String) -> Ordering
    forall {e} {b} {e} {b}.
    (GenLocated SrcSpan e, b) -> (GenLocated SrcSpan e, b) -> Ordering
    locFn [(Located Token, String)]
    postCppToks [(Located Token, String)]
    directiveToks

        -- We must now find the set of tokens that are in origSrcToks, but
        -- not in m1Toks

        -- GHC.Token does not have Ord, can't use a set directly
        origSpans :: [RealSrcSpan]
    origSpans = ((Located Token, String) -> RealSrcSpan)
    -> [(Located Token, String)] -> [RealSrcSpan]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(GHC.L SrcSpan
    l Token
    _,String
    _) -> SrcSpan -> RealSrcSpan
    rs SrcSpan
    l) [(Located Token, String)]
    origSrcToks
        m1Spans :: [RealSrcSpan]
    m1Spans = ((Located Token, String) -> RealSrcSpan)
    -> [(Located Token, String)] -> [RealSrcSpan]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(GHC.L SrcSpan
    l Token
    _,String
    _) -> SrcSpan -> RealSrcSpan
    rs SrcSpan
    l) [(Located Token, String)]
    m1Toks
        missingSpans :: Set RealSrcSpan
    missingSpans = [RealSrcSpan] -> Set RealSrcSpan
    forall a. Ord a => [a] -> Set a
    Set.fromList [RealSrcSpan]
    origSpans Set RealSrcSpan -> Set RealSrcSpan -> Set RealSrcSpan
    forall a. Ord a => Set a -> Set a -> Set a
    Set.\\ [RealSrcSpan] -> Set RealSrcSpan
    forall a. Ord a => [a] -> Set a
    Set.fromList [RealSrcSpan]
    m1Spans

        missingToks :: [(Located Token, String)]
    missingToks = ((Located Token, String) -> Bool)
    -> [(Located Token, String)] -> [(Located Token, String)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(GHC.L SrcSpan
    l Token
    _,String
    _) -> RealSrcSpan -> Set RealSrcSpan -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member (SrcSpan -> RealSrcSpan
    rs SrcSpan
    l) Set RealSrcSpan
    missingSpans) [(Located Token, String)]
    origSrcToks

        missingAsComments :: [(Located Token, String)]
    missingAsComments = ((Located Token, String) -> (Located Token, String))
    -> [(Located Token, String)] -> [(Located Token, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Located Token, String) -> (Located Token, String)
    mkCommentTok [(Located Token, String)]
    missingToks
          where
            mkCommentTok :: (GHC.Located GHC.Token,String) -> (GHC.Located GHC.Token,String)
            mkCommentTok :: (Located Token, String) -> (Located Token, String)
    mkCommentTok (GHC.L SrcSpan
    l Token
    _,String
    s) = (SrcSpan -> Token -> Located Token
    forall l e. l -> e -> GenLocated l e
    GHC.L SrcSpan
    l (String -> PsSpan -> Token
    GHC.ITlineComment String
    s (SrcSpan -> PsSpan
    makeBufSpan SrcSpan
    l)),String
    s)

        toks :: [(Located Token, String)]
    toks = ((Located Token, String) -> (Located Token, String) -> Ordering)
    -> [(Located Token, String)]
    -> [(Located Token, String)]
    -> [(Located Token, String)]
    forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
    mergeBy (Located Token, String) -> (Located Token, String) -> Ordering
    forall {e} {b} {e} {b}.
    (GenLocated SrcSpan e, b) -> (GenLocated SrcSpan e, b) -> Ordering
    locFn [(Located Token, String)]
    directiveToks [(Located Token, String)]
    missingAsComments

    -- ---------------------------------------------------------------------

    tokeniseOriginalSrc ::
      GHC.GhcMonad m
      => GHC.RealSrcLoc -> GHC.ParserOpts -> GHC.StringBuffer
      -> m [(GHC.Located GHC.Token, String)]
    tokeniseOriginalSrc :: forall (m :: * -> *).
    GhcMonad m =>
    RealSrcLoc
    -> ParserOpts -> StringBuffer -> m [(Located Token, String)]
    tokeniseOriginalSrc RealSrcLoc
    startLoc ParserOpts
    flags StringBuffer
    buf = do
      let src :: StringBuffer
    src = StringBuffer -> StringBuffer
    stripPreprocessorDirectives StringBuffer
    buf
      case ParserOpts
    -> StringBuffer -> RealSrcLoc -> ParseResult [Located Token]
    GHC.lexTokenStream ParserOpts
    flags StringBuffer
    src RealSrcLoc
    startLoc of
        GHC.POk PState
    _ [Located Token]
    ts -> [(Located Token, String)] -> m [(Located Token, String)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Located Token, String)] -> m [(Located Token, String)])
    -> [(Located Token, String)] -> m [(Located Token, String)]
    forall a b. (a -> b) -> a -> b
    $ RealSrcLoc
    -> StringBuffer -> [Located Token] -> [(Located Token, String)]
    GHC.addSourceToTokens RealSrcLoc
    startLoc StringBuffer
    src [Located Token]
    ts
        GHC.PFailed PState
    pst -> PState -> m [(Located Token, String)]
    forall (m :: * -> *) b. MonadIO m => PState -> m b
    parseError PState
    pst

    -- ---------------------------------------------------------------------

    -- | Strip out the CPP directives so that the balance of the source
    -- can tokenised.
    stripPreprocessorDirectives :: GHC.StringBuffer -> GHC.StringBuffer
    stripPreprocessorDirectives :: StringBuffer -> StringBuffer
    stripPreprocessorDirectives StringBuffer
    buf = StringBuffer
    buf'
      where
        srcByLine :: [String]
    srcByLine = String -> [String]
    lines (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ StringBuffer -> String
    sbufToString StringBuffer
    buf
        noDirectivesLines :: [String]
    noDirectivesLines = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    line -> if String
    line String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [] Bool -> Bool -> Bool
    && String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    line Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '#' then String
    "" else String
    line) [String]
    srcByLine
        buf' :: StringBuffer
    buf' = String -> StringBuffer
    GHC.stringToStringBuffer (String -> StringBuffer) -> String -> StringBuffer
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines [String]
    noDirectivesLines

    -- ---------------------------------------------------------------------

    sbufToString :: GHC.StringBuffer -> String
    sbufToString :: StringBuffer -> String
    sbufToString sb :: StringBuffer
    sb@(GHC.StringBuffer ForeignPtr Word8
    _buf Int
    len Int
    _cur) = StringBuffer -> Int -> String
    GHC.lexemeToString StringBuffer
    sb Int
    len

    -- ---------------------------------------------------------------------
    getPreprocessedSrcDirect :: (GHC.GhcMonad m)
                             => CppOptions
                             -> FilePath
                             -> m (String, GHC.DynFlags)
    getPreprocessedSrcDirect :: forall (m :: * -> *).
    GhcMonad m =>
    CppOptions -> String -> m (String, DynFlags)
    getPreprocessedSrcDirect CppOptions
    cppOptions String
    src =
        (\(String
    s,StringBuffer
    _,DynFlags
    d) -> (String
    s,DynFlags
    d)) ((String, StringBuffer, DynFlags) -> (String, DynFlags))
    -> m (String, StringBuffer, DynFlags) -> m (String, DynFlags)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CppOptions -> String -> m (String, StringBuffer, DynFlags)
    forall (m :: * -> *).
    GhcMonad m =>
    CppOptions -> String -> m (String, StringBuffer, DynFlags)
    getPreprocessedSrcDirectPrim CppOptions
    cppOptions String
    src

    getPreprocessedSrcDirectPrim :: (GHC.GhcMonad m)
                                  => CppOptions
                                  -> FilePath
                                  -> m (String, GHC.StringBuffer, GHC.DynFlags)
    getPreprocessedSrcDirectPrim :: forall (m :: * -> *).
    GhcMonad m =>
    CppOptions -> String -> m (String, StringBuffer, DynFlags)
    getPreprocessedSrcDirectPrim CppOptions
    cppOptions String
    src_fn = do
      HscEnv
    hsc_env <- m HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    GHC.getSession
      let dfs :: DynFlags
    dfs = HscEnv -> DynFlags
    GHC.hsc_dflags HscEnv
    hsc_env
          new_env :: HscEnv
    new_env = HscEnv
    hsc_env { hsc_dflags :: DynFlags
    GHC.hsc_dflags = CppOptions -> DynFlags -> DynFlags
    injectCppOptions CppOptions
    cppOptions DynFlags
    dfs }
      Either DriverMessages (DynFlags, String)
    r <- IO (Either DriverMessages (DynFlags, String))
    -> m (Either DriverMessages (DynFlags, String))
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    GHC.liftIO (IO (Either DriverMessages (DynFlags, String))
     -> m (Either DriverMessages (DynFlags, String)))
    -> IO (Either DriverMessages (DynFlags, String))
    -> m (Either DriverMessages (DynFlags, String))
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> String
    -> Maybe StringBuffer
    -> Maybe Phase
    -> IO (Either DriverMessages (DynFlags, String))
    GHC.preprocess HscEnv
    new_env String
    src_fn Maybe StringBuffer
    forall a. Maybe a
    Nothing (Phase -> Maybe Phase
    forall a. a -> Maybe a
    Just (HscSource -> Phase
    GHC.Cpp HscSource
    GHC.HsSrcFile))
      case Either DriverMessages (DynFlags, String)
    r of
        Left DriverMessages
    err -> String -> m (String, StringBuffer, DynFlags)
    forall a. HasCallStack => String -> a
    error (String -> m (String, StringBuffer, DynFlags))
    -> String -> m (String, StringBuffer, DynFlags)
    forall a b. (a -> b) -> a -> b
    $ ErrorMessages -> String
    showErrorMessages (ErrorMessages -> String) -> ErrorMessages -> String
    forall a b. (a -> b) -> a -> b
    $ (DriverMessage -> GhcMessage) -> DriverMessages -> ErrorMessages
    forall a b. (a -> b) -> Messages a -> Messages b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DriverMessage -> GhcMessage
    GHC.GhcDriverMessage DriverMessages
    err
        Right (DynFlags
    dflags', String
    hspp_fn) -> do
          StringBuffer
    buf <- IO StringBuffer -> m StringBuffer
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    GHC.liftIO (IO StringBuffer -> m StringBuffer)
    -> IO StringBuffer -> m StringBuffer
    forall a b. (a -> b) -> a -> b
    $ String -> IO StringBuffer
    GHC.hGetStringBuffer String
    hspp_fn
          String
    txt <- IO String -> m String
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    GHC.liftIO (IO String -> m String) -> IO String -> m String
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    readFileGhc String
    hspp_fn
          (String, StringBuffer, DynFlags)
    -> m (String, StringBuffer, DynFlags)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    txt, StringBuffer
    buf, DynFlags
    dflags')

    showErrorMessages :: GHC.ErrorMessages -> String
    showErrorMessages :: ErrorMessages -> String
    showErrorMessages ErrorMessages
    msgs = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n"
        ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (MsgEnvelope GhcMessage -> String)
    -> [MsgEnvelope GhcMessage] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (forall a. Show a => a -> String
    show @(GHC.MsgEnvelope GHC.DiagnosticMessage) (MsgEnvelope DiagnosticMessage -> String)
    -> (MsgEnvelope GhcMessage -> MsgEnvelope DiagnosticMessage)
    -> MsgEnvelope GhcMessage
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GhcMessage -> DiagnosticMessage)
    -> MsgEnvelope GhcMessage -> MsgEnvelope DiagnosticMessage
    forall a b. (a -> b) -> MsgEnvelope a -> MsgEnvelope b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap GhcMessage -> DiagnosticMessage
    forall e. Diagnostic e => e -> DiagnosticMessage
    toDiagnosticMessage)
        ([MsgEnvelope GhcMessage] -> [String])
    -> [MsgEnvelope GhcMessage] -> [String]
    forall a b. (a -> b) -> a -> b
    $ Bag (MsgEnvelope GhcMessage) -> [MsgEnvelope GhcMessage]
    forall a. Bag a -> [a]
    GHC.bagToList
        (Bag (MsgEnvelope GhcMessage) -> [MsgEnvelope GhcMessage])
    -> Bag (MsgEnvelope GhcMessage) -> [MsgEnvelope GhcMessage]
    forall a b. (a -> b) -> a -> b
    $ ErrorMessages -> Bag (MsgEnvelope GhcMessage)
    forall e. Diagnostic e => Messages e -> Bag (MsgEnvelope e)
    GHC.getErrorMessages ErrorMessages
    msgs

    -- | Show Error Messages relies on show instance for MsgEnvelope DiagnosticMessage
    -- We convert a known Diagnostic into this generic version
    toDiagnosticMessage :: GHC.Diagnostic e => e -> GHC.DiagnosticMessage
    toDiagnosticMessage :: forall e. Diagnostic e => e -> DiagnosticMessage
    toDiagnosticMessage e
    msg = GHC.DiagnosticMessage { diagMessage :: DecoratedSDoc
    diagMessage = e -> DecoratedSDoc
    forall a. Diagnostic a => a -> DecoratedSDoc
    GHC.diagnosticMessage e
    msg
                                                    , diagReason :: DiagnosticReason
    diagReason  = e -> DiagnosticReason
    forall a. Diagnostic a => a -> DiagnosticReason
    GHC.diagnosticReason  e
    msg
                                                    , diagHints :: [GhcHint]
    diagHints   = e -> [GhcHint]
    forall a. Diagnostic a => a -> [GhcHint]
    GHC.diagnosticHints   e
    msg
                                                    }

    injectCppOptions :: CppOptions -> GHC.DynFlags -> GHC.DynFlags
    injectCppOptions :: CppOptions -> DynFlags -> DynFlags
    injectCppOptions CppOptions{[String]
    cppDefine :: CppOptions -> [String]
    cppInclude :: CppOptions -> [String]
    cppFile :: CppOptions -> [String]
    cppDefine :: [String]
    cppInclude :: [String]
    cppFile :: [String]
    ..} DynFlags
    dflags =
      (String -> DynFlags -> DynFlags)
    -> DynFlags -> [String] -> DynFlags
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr String -> DynFlags -> DynFlags
    addOptP DynFlags
    dflags ((String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    mkDefine [String]
    cppDefine [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    mkIncludeDir [String]
    cppInclude [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    mkInclude [String]
    cppFile)
      where
        mkDefine :: String -> String
    mkDefine = (String
    "-D" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)
        mkIncludeDir :: String -> String
    mkIncludeDir = (String
    "-I" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)
        mkInclude :: String -> String
    mkInclude = (String
    "-include" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)

    addOptP :: String -> GHC.DynFlags -> GHC.DynFlags
    addOptP :: String -> DynFlags -> DynFlags
    addOptP   String
    f = (ToolSettings -> ToolSettings) -> DynFlags -> DynFlags
    alterToolSettings ((ToolSettings -> ToolSettings) -> DynFlags -> DynFlags)
    -> (ToolSettings -> ToolSettings) -> DynFlags -> DynFlags
    forall a b. (a -> b) -> a -> b
    $ \ToolSettings
    s -> ToolSettings
    s
              { toolSettings_opt_P :: [String]
    GHC.toolSettings_opt_P   = String
    f String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : ToolSettings -> [String]
    GHC.toolSettings_opt_P ToolSettings
    s
              , toolSettings_opt_P_fingerprint :: Fingerprint
    GHC.toolSettings_opt_P_fingerprint = [String] -> Fingerprint
    fingerprintStrings (String
    f String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : ToolSettings -> [String]
    GHC.toolSettings_opt_P ToolSettings
    s)
              }
    alterToolSettings :: (GHC.ToolSettings -> GHC.ToolSettings) -> GHC.DynFlags -> GHC.DynFlags
    alterToolSettings :: (ToolSettings -> ToolSettings) -> DynFlags -> DynFlags
    alterToolSettings ToolSettings -> ToolSettings
    f DynFlags
    dynFlags = DynFlags
    dynFlags { toolSettings :: ToolSettings
    GHC.toolSettings = ToolSettings -> ToolSettings
    f (DynFlags -> ToolSettings
    GHC.toolSettings DynFlags
    dynFlags) }

    fingerprintStrings :: [String] -> GHC.Fingerprint
    fingerprintStrings :: [String] -> Fingerprint
    fingerprintStrings [String]
    ss = [Fingerprint] -> Fingerprint
    GHC.fingerprintFingerprints ([Fingerprint] -> Fingerprint) -> [Fingerprint] -> Fingerprint
    forall a b. (a -> b) -> a -> b
    $ (String -> Fingerprint) -> [String] -> [Fingerprint]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Fingerprint
    GHC.fingerprintString [String]
    ss

    -- ---------------------------------------------------------------------

    -- | Get the preprocessor directives as comment tokens from the
    -- source.
    getPreprocessorAsComments :: FilePath -> IO [(GHC.Located GHC.Token, String)]
    getPreprocessorAsComments :: String -> IO [(Located Token, String)]
    getPreprocessorAsComments String
    srcFile = do
      String
    fcontents <- String -> IO String
    readFileGhc String
    srcFile
      let directives :: [(Int, String)]
    directives = ((Int, String) -> Bool) -> [(Int, String)] -> [(Int, String)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(Int
    _lineNum,String
    line) -> String
    line String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [] Bool -> Bool -> Bool
    && String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    line Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '#')
                        ([(Int, String)] -> [(Int, String)])
    -> [(Int, String)] -> [(Int, String)]
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [String] -> [(Int, String)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1..] (String -> [String]
    lines String
    fcontents)

      let mkTok :: (Int, String) -> (Located Token, String)
    mkTok (Int
    lineNum,String
    line) = (SrcSpan -> Token -> Located Token
    forall l e. l -> e -> GenLocated l e
    GHC.L SrcSpan
    l (String -> PsSpan -> Token
    GHC.ITlineComment String
    line (SrcSpan -> PsSpan
    makeBufSpan SrcSpan
    l)),String
    line)
           where
             start :: SrcLoc
    start = FastString -> Int -> Int -> SrcLoc
    GHC.mkSrcLoc (String -> FastString
    GHC.mkFastString String
    srcFile) Int
    lineNum Int
    1
             end :: SrcLoc
    end   = FastString -> Int -> Int -> SrcLoc
    GHC.mkSrcLoc (String -> FastString
    GHC.mkFastString String
    srcFile) Int
    lineNum (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    line)
             l :: SrcSpan
    l = SrcLoc -> SrcLoc -> SrcSpan
    GHC.mkSrcSpan SrcLoc
    start SrcLoc
    end

      let toks :: [(Located Token, String)]
    toks = ((Int, String) -> (Located Token, String))
    -> [(Int, String)] -> [(Located Token, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, String) -> (Located Token, String)
    mkTok [(Int, String)]
    directives
      [(Located Token, String)] -> IO [(Located Token, String)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Located Token, String)]
    toks

    makeBufSpan :: GHC.SrcSpan -> GHC.PsSpan
    makeBufSpan :: SrcSpan -> PsSpan
    makeBufSpan SrcSpan
    ss = PsSpan
    pspan
      where
        bl :: BufPos
    bl = Int -> BufPos
    GHC.BufPos Int
    0
        pspan :: PsSpan
    pspan = RealSrcSpan -> BufSpan -> PsSpan
    GHC.PsSpan (SrcSpan -> RealSrcSpan
    GHC.realSrcSpan SrcSpan
    ss) (BufPos -> BufPos -> BufSpan
    GHC.BufSpan BufPos
    bl BufPos
    bl)

    -- ---------------------------------------------------------------------

    parseError :: (GHC.MonadIO m) => GHC.PState -> m b
    parseError :: forall (m :: * -> *) b. MonadIO m => PState -> m b
    parseError PState
    pst = do
         let
           -- (warns,errs) = GHC.getMessages pst dflags
         -- throw $ GHC.mkSrcErr (GHC.unitBag $ GHC.mkPlainErrMsg dflags sspan err)
         -- GHC.throwErrors (fmap GHC.mkParserErr (GHC.getErrorMessages pst))
         ErrorMessages -> m b
    forall (io :: * -> *) a. MonadIO io => ErrorMessages -> io a
    GHC.throwErrors ((PsMessage -> GhcMessage) -> Messages PsMessage -> ErrorMessages
    forall a b. (a -> b) -> Messages a -> Messages b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PsMessage -> GhcMessage
    GHC.GhcPsMessage (PState -> Messages PsMessage
    GHC.getPsErrorMessages PState
    pst))

    -- ---------------------------------------------------------------------

    readFileGhc :: FilePath -> IO String
    readFileGhc :: String -> IO String
    readFileGhc String
    file = do
      buf :: StringBuffer
    buf@(GHC.StringBuffer ForeignPtr Word8
    _ Int
    len Int
    _) <- String -> IO StringBuffer
    GHC.hGetStringBuffer String
    file
      String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (StringBuffer -> Int -> String
    GHC.lexemeToString StringBuffer
    buf Int
    len)

    -- ---------------------------------------------------------------------

    -- Copied over from MissingH, the dependency cause travis to fail

    {- | Merge two sorted lists using into a single, sorted whole,
    allowing the programmer to specify the comparison function.

    QuickCheck test property:

    prop_mergeBy xs ys =
        mergeBy cmp (sortBy cmp xs) (sortBy cmp ys) == sortBy cmp (xs ++ ys)
              where types = xs :: [ (Int, Int) ]
                    cmp (x1,_) (x2,_) = compare x1 x2
    -}
    mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
    mergeBy :: forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
    mergeBy a -> a -> Ordering
    _cmp [] [a]
    ys = [a]
    ys
    mergeBy a -> a -> Ordering
    _cmp [a]
    xs [] = [a]
    xs
    mergeBy a -> a -> Ordering
    cmp (allx :: [a]
    allx@(a
    x:[a]
    xs)) (ally :: [a]
    ally@(a
    y:[a]
    ys))
            -- Ordering derives Eq, Ord, so the comparison below is valid.
            -- Explanation left as an exercise for the reader.
            -- Someone please put this code out of its misery.
        | (a
    x a -> a -> Ordering
    `cmp` a
    y) Ordering -> Ordering -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Ordering
    EQ = a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : (a -> a -> Ordering) -> [a] -> [a] -> [a]
    forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
    mergeBy a -> a -> Ordering
    cmp [a]
    xs [a]
    ally
        | Bool
    otherwise = a
    y a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : (a -> a -> Ordering) -> [a] -> [a] -> [a]
    forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
    mergeBy a -> a -> Ordering
    cmp [a]
    allx [a]
    ys