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

       , CppOptions(..)
       , defaultCppOptions
       ) where

    import qualified Bag            as GHC
    import qualified DriverPhases   as GHC
    import qualified DriverPipeline as GHC
    import qualified DynFlags       as GHC
    import qualified ErrUtils       as GHC
    import qualified FastString     as GHC
    import qualified GHC            as GHC hiding (parseModule)
    import qualified HscTypes       as GHC
    import qualified Lexer          as GHC
    import qualified MonadUtils     as GHC
    import qualified SrcLoc         as GHC
    import qualified StringBuffer   as GHC

    import SrcLoc (mkSrcSpan, mkSrcLoc)
    import FastString (mkFastString)

    import Control.Exception
    import Data.List hiding (find)
    import Data.Maybe
    #if __GLASGOW_HASKELL__ <= 800
    import Language.Haskell.GHC.ExactPrint.GhcInterim (commentToAnnotation)
    #endif
    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, [Comment])
    stripLinePragmas :: String -> (String, [Comment])
    stripLinePragmas = ([String], [Maybe Comment]) -> (String, [Comment])
    forall a. ([String], [Maybe a]) -> (String, [a])
    unlines' (([String], [Maybe Comment]) -> (String, [Comment]))
    -> (String -> ([String], [Maybe Comment]))
    -> String
    -> (String, [Comment])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(String, Maybe Comment)] -> ([String], [Maybe Comment])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(String, Maybe Comment)] -> ([String], [Maybe Comment]))
    -> (String -> [(String, Maybe Comment)])
    -> String
    -> ([String], [Maybe Comment])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [(String, Maybe Comment)]
    findLines ([String] -> [(String, Maybe Comment)])
    -> (String -> [String]) -> String -> [(String, Maybe Comment)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines
      where
        unlines' :: ([String], [Maybe a]) -> (String, [a])
    unlines' (a :: [String]
    a, b :: [Maybe a]
    b) = ([String] -> String
    unlines [String]
    a, [Maybe a] -> [a]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe a]
    b)

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

    checkLine :: Int -> String -> (String, Maybe Comment)
    checkLine :: Int -> String -> (String, Maybe Comment)
    checkLine line :: Int
    line s :: String
    s
      |  "{-# LINE" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    s =
           let (pragma :: String
    pragma, res :: String
    res) = String -> (String, String)
    getPragma String
    s
               size :: Int
    size   = String -> 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 "LINE")
               ss :: SrcSpan
    ss     = SrcLoc -> SrcLoc -> SrcSpan
    mkSrcSpan (Int -> Int -> SrcLoc
    mSrcLoc Int
    line 1) (Int -> Int -> SrcLoc
    mSrcLoc Int
    line (Int
    sizeInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1))
           in (String
    res, Comment -> Maybe Comment
    forall a. a -> Maybe a
    Just (Comment -> Maybe Comment) -> Comment -> Maybe Comment
    forall a b. (a -> b) -> a -> b
    $ String -> SrcSpan -> Comment
    mkComment String
    pragma SrcSpan
    ss)
      -- Deal with shebang/cpp directives too
      -- x |  "#" `isPrefixOf` s = ("",Just $ Comment ((line, 1), (line, length s)) s)
      |  "#!" 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 "SHEBANG")
            ss :: SrcSpan
    ss = SrcLoc -> SrcLoc -> SrcSpan
    mkSrcSpan (Int -> Int -> SrcLoc
    mSrcLoc Int
    line 1) (Int -> Int -> SrcLoc
    mSrcLoc Int
    line (String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s))
        in
        ("",Comment -> Maybe Comment
    forall a. a -> Maybe a
    Just (Comment -> Maybe Comment) -> Comment -> Maybe Comment
    forall a b. (a -> b) -> a -> b
    $ String -> SrcSpan -> Comment
    mkComment String
    s SrcSpan
    ss)
      | Bool
    otherwise = (String
    s, Maybe Comment
    forall a. Maybe a
    Nothing)

    getPragma :: String -> (String, String)
    getPragma :: String -> (String, String)
    getPragma [] = String -> (String, String)
    forall a. HasCallStack => String -> a
    error "Input must not be empty"
    getPragma s :: String
    s@(x :: Char
    x:xs :: String
    xs)
      | "#-}" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    s = ("#-}", "   " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop 3 String
    s)
      | Bool
    otherwise =
          let (prag :: String
    prag, remline :: String
    remline) = String -> (String, String)
    getPragma String
    xs
          in (Char
    xChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    prag, ' '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 [Comment]
    getCppTokensAsComments :: CppOptions -> String -> m [Comment]
    getCppTokensAsComments cppOptions :: CppOptions
    cppOptions sourceFile :: String
    sourceFile = do
      StringBuffer
    source <- IO StringBuffer -> m StringBuffer
    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) 1 1
      (_txt :: String
    _txt,strSrcBuf :: StringBuffer
    strSrcBuf,flags2 :: DynFlags
    flags2) <- CppOptions -> String -> m (String, StringBuffer, DynFlags)
    forall (m :: * -> *).
    GhcMonad m =>
    CppOptions -> String -> m (String, StringBuffer, DynFlags)
    getPreprocessedSrcDirectPrim CppOptions
    cppOptions String
    sourceFile
      -- #ifdef tokens
      [(Located Token, String)]
    directiveToks <- IO [(Located Token, String)] -> m [(Located Token, String)]
    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 #ifdef
      [(Located Token, String)]
    nonDirectiveToks <- RealSrcLoc
    -> DynFlags -> StringBuffer -> m [(Located Token, String)]
    forall (m :: * -> *).
    GhcMonad m =>
    RealSrcLoc
    -> DynFlags -> StringBuffer -> m [(Located Token, String)]
    tokeniseOriginalSrc RealSrcLoc
    startLoc DynFlags
    flags2 StringBuffer
    source
      case StringBuffer
    -> RealSrcLoc -> DynFlags -> ParseResult [Located Token]
    GHC.lexTokenStream StringBuffer
    strSrcBuf RealSrcLoc
    startLoc DynFlags
    flags2 of
            GHC.POk _ ts :: [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
                      [Comment] -> m [Comment]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Comment] -> m [Comment]) -> [Comment] -> m [Comment]
    forall a b. (a -> b) -> a -> b
    $ (Comment -> Bool) -> [Comment] -> [Comment]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Comment -> Bool
    goodComment
    #if __GLASGOW_HASKELL__ > 800
                             ([Comment] -> [Comment]) -> [Comment] -> [Comment]
    forall a b. (a -> b) -> a -> b
    $  ((Located Token, String) -> Comment)
    -> [(Located Token, String)] -> [Comment]
    forall a b. (a -> b) -> [a] -> [b]
    map (Located AnnotationComment -> Comment
    tokComment (Located AnnotationComment -> Comment)
    -> ((Located Token, String) -> Located AnnotationComment)
    -> (Located Token, String)
    -> Comment
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Located Token -> Located AnnotationComment
    GHC.commentToAnnotation (Located Token -> Located AnnotationComment)
    -> ((Located Token, String) -> Located Token)
    -> (Located Token, String)
    -> Located AnnotationComment
    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
    #else
                             $  map (tokComment . commentToAnnotation . fst) cppCommentToks
    #endif
    #if __GLASGOW_HASKELL__ >= 804
            GHC.PFailed _ sspan :: SrcSpan
    sspan err :: MsgDoc
    err -> DynFlags -> SrcSpan -> MsgDoc -> m [Comment]
    forall (m :: * -> *) b. DynFlags -> SrcSpan -> MsgDoc -> m b
    parseError DynFlags
    flags2 SrcSpan
    sspan MsgDoc
    err
    #else
            GHC.PFailed sspan err -> parseError flags2 sspan err
    #endif

    goodComment :: Comment -> Bool
    goodComment :: Comment -> Bool
    goodComment (Comment "" _ _) = Bool
    False
    goodComment _              = Bool
    True

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

    -- | 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 directiveToks :: [(Located Token, String)]
    directiveToks origSrcToks :: [(Located Token, String)]
    origSrcToks postCppToks :: [(Located Token, String)]
    postCppToks = [(Located Token, String)]
    toks
      where
        locFn :: (GenLocated a e, b) -> (GenLocated a e, b) -> Ordering
    locFn (GHC.L l1 :: a
    l1 _,_) (GHC.L l2 :: a
    l2 _,_) = a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    l1 a
    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 a e b e b.
    Ord a =>
    (GenLocated a e, b) -> (GenLocated a 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 :: [SrcSpan]
    origSpans = ((Located Token, String) -> SrcSpan)
    -> [(Located Token, String)] -> [SrcSpan]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(GHC.L l :: SrcSpan
    l _,_) -> SrcSpan
    l) [(Located Token, String)]
    origSrcToks
        m1Spans :: [SrcSpan]
    m1Spans = ((Located Token, String) -> SrcSpan)
    -> [(Located Token, String)] -> [SrcSpan]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(GHC.L l :: SrcSpan
    l _,_) -> SrcSpan
    l) [(Located Token, String)]
    m1Toks
        missingSpans :: Set SrcSpan
    missingSpans = [SrcSpan] -> Set SrcSpan
    forall a. Ord a => [a] -> Set a
    Set.fromList [SrcSpan]
    origSpans Set SrcSpan -> Set SrcSpan -> Set SrcSpan
    forall a. Ord a => Set a -> Set a -> Set a
    Set.\\ [SrcSpan] -> Set SrcSpan
    forall a. Ord a => [a] -> Set a
    Set.fromList [SrcSpan]
    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 l :: SrcSpan
    l _,_) -> SrcSpan -> Set SrcSpan -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member SrcSpan
    l Set SrcSpan
    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 l :: SrcSpan
    l _,s :: String
    s) = (SrcSpan -> Token -> Located Token
    forall l e. l -> e -> GenLocated l e
    GHC.L SrcSpan
    l (String -> Token
    GHC.ITlineComment String
    s),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 a e b e b.
    Ord a =>
    (GenLocated a e, b) -> (GenLocated a e, b) -> Ordering
    locFn [(Located Token, String)]
    directiveToks [(Located Token, String)]
    missingAsComments

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

    tokeniseOriginalSrc ::
      GHC.GhcMonad m
      => GHC.RealSrcLoc -> GHC.DynFlags -> GHC.StringBuffer
      -> m [(GHC.Located GHC.Token, String)]
    tokeniseOriginalSrc :: RealSrcLoc
    -> DynFlags -> StringBuffer -> m [(Located Token, String)]
    tokeniseOriginalSrc startLoc :: RealSrcLoc
    startLoc flags :: DynFlags
    flags buf :: StringBuffer
    buf = do
      let src :: StringBuffer
    src = StringBuffer -> StringBuffer
    stripPreprocessorDirectives StringBuffer
    buf
      case StringBuffer
    -> RealSrcLoc -> DynFlags -> ParseResult [Located Token]
    GHC.lexTokenStream StringBuffer
    src RealSrcLoc
    startLoc DynFlags
    flags of
        GHC.POk _ ts :: [Located Token]
    ts -> [(Located Token, String)] -> m [(Located Token, String)]
    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
    #if __GLASGOW_HASKELL__ >= 804
        GHC.PFailed _ sspan :: SrcSpan
    sspan err :: MsgDoc
    err -> DynFlags -> SrcSpan -> MsgDoc -> m [(Located Token, String)]
    forall (m :: * -> *) b. DynFlags -> SrcSpan -> MsgDoc -> m b
    parseError DynFlags
    flags SrcSpan
    sspan MsgDoc
    err
    #else
        GHC.PFailed sspan err -> parseError flags sspan err
    #endif

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

    -- | Strip out the CPP directives so that the balance of the source
    -- can tokenised.
    stripPreprocessorDirectives :: GHC.StringBuffer -> GHC.StringBuffer
    stripPreprocessorDirectives :: StringBuffer -> StringBuffer
    stripPreprocessorDirectives buf :: 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 (\line :: String
    line -> if String
    line String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [] Bool -> Bool -> Bool
    && String -> Char
    forall a. [a] -> a
    head String
    line Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '#' then "" 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 _buf :: ForeignPtr Word8
    _buf len :: Int
    len _cur :: Int
    _cur) = StringBuffer -> Int -> String
    GHC.lexemeToString StringBuffer
    sb Int
    len

    -- ---------------------------------------------------------------------
    getPreprocessedSrcDirect :: (GHC.GhcMonad m)
                             => CppOptions
                             -> FilePath
                             -> m (String, GHC.DynFlags)
    getPreprocessedSrcDirect :: CppOptions -> String -> m (String, DynFlags)
    getPreprocessedSrcDirect cppOptions :: CppOptions
    cppOptions src :: String
    src =
        (\(s :: String
    s,_,d :: 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 :: CppOptions -> String -> m (String, StringBuffer, DynFlags)
    getPreprocessedSrcDirectPrim cppOptions :: CppOptions
    cppOptions src_fn :: 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 }
    #if __GLASGOW_HASKELL__ >= 808
      -- (dflags', hspp_fn) <-
      Either ErrorMessages (DynFlags, String)
    r <- IO (Either ErrorMessages (DynFlags, String))
    -> m (Either ErrorMessages (DynFlags, String))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    GHC.liftIO (IO (Either ErrorMessages (DynFlags, String))
     -> m (Either ErrorMessages (DynFlags, String)))
    -> IO (Either ErrorMessages (DynFlags, String))
    -> m (Either ErrorMessages (DynFlags, String))
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> String
    -> Maybe StringBuffer
    -> Maybe Phase
    -> IO (Either ErrorMessages (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 ErrorMessages (DynFlags, String)
    r of
        Left err :: ErrorMessages
    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
    err
        Right (dflags' :: DynFlags
    dflags', hspp_fn :: String
    hspp_fn) -> do
          StringBuffer
    buf <- IO StringBuffer -> m StringBuffer
    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 (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 (m :: * -> *) a. Monad m => a -> m a
    return (String
    txt, StringBuffer
    buf, DynFlags
    dflags')
    #else
      (dflags', hspp_fn) <-
          GHC.liftIO $ GHC.preprocess new_env (src_fn, Just (GHC.Cpp GHC.HsSrcFile))
      buf <- GHC.liftIO $ GHC.hGetStringBuffer hspp_fn
      txt <- GHC.liftIO $ readFileGhc hspp_fn
      return (txt, buf, dflags')
    #endif

    #if __GLASGOW_HASKELL__ >= 808
    showErrorMessages :: GHC.ErrorMessages -> String
    showErrorMessages :: ErrorMessages -> String
    showErrorMessages msgs :: ErrorMessages
    msgs = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "\n" ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (ErrMsg -> String) -> [ErrMsg] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ErrMsg -> String
    forall a. Show a => a -> String
    show ([ErrMsg] -> [String]) -> [ErrMsg] -> [String]
    forall a b. (a -> b) -> a -> b
    $ ErrorMessages -> [ErrMsg]
    forall a. Bag a -> [a]
    GHC.bagToList ErrorMessages
    msgs
    #endif

    injectCppOptions :: CppOptions -> GHC.DynFlags -> GHC.DynFlags
    injectCppOptions :: CppOptions -> DynFlags -> DynFlags
    injectCppOptions CppOptions{..} dflags :: DynFlags
    dflags =
      (String -> DynFlags -> DynFlags)
    -> DynFlags -> [String] -> DynFlags
    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 = ("-D" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)
        mkIncludeDir :: String -> String
    mkIncludeDir = ("-I" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)
        mkInclude :: String -> String
    mkInclude = ("-include" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)

    addOptP :: String -> GHC.DynFlags -> GHC.DynFlags
    addOptP :: String -> DynFlags -> DynFlags
    addOptP   f :: String
    f = (Settings -> Settings) -> DynFlags -> DynFlags
    alterSettings (\s :: Settings
    s -> Settings
    s { sOpt_P :: [String]
    GHC.sOpt_P   = String
    f String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : Settings -> [String]
    GHC.sOpt_P Settings
    s})

    alterSettings :: (GHC.Settings -> GHC.Settings) -> GHC.DynFlags -> GHC.DynFlags
    alterSettings :: (Settings -> Settings) -> DynFlags -> DynFlags
    alterSettings f :: Settings -> Settings
    f dflags :: DynFlags
    dflags = DynFlags
    dflags { settings :: Settings
    GHC.settings = Settings -> Settings
    f (DynFlags -> Settings
    GHC.settings DynFlags
    dflags) }

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

    -- | 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 srcFile :: 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 (\(_lineNum :: Int
    _lineNum,line :: String
    line) -> String
    line String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [] Bool -> Bool -> Bool
    && String -> Char
    forall a. [a] -> a
    head String
    line Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '#')
                        ([(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 [1..] (String -> [String]
    lines String
    fcontents)

      let mkTok :: (Int, String) -> (Located Token, String)
    mkTok (lineNum :: Int
    lineNum,line :: String
    line) = (SrcSpan -> Token -> Located Token
    forall l e. l -> e -> GenLocated l e
    GHC.L SrcSpan
    l (String -> Token
    GHC.ITlineComment String
    line),String
    line)
           where
             start :: SrcLoc
    start = FastString -> Int -> Int -> SrcLoc
    GHC.mkSrcLoc (String -> FastString
    GHC.mkFastString String
    srcFile) Int
    lineNum 1
             end :: SrcLoc
    end   = FastString -> Int -> Int -> SrcLoc
    GHC.mkSrcLoc (String -> FastString
    GHC.mkFastString String
    srcFile) Int
    lineNum (String -> 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 (m :: * -> *) a. Monad m => a -> m a
    return [(Located Token, String)]
    toks

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

    parseError :: GHC.DynFlags -> GHC.SrcSpan -> GHC.MsgDoc -> m b
    parseError :: DynFlags -> SrcSpan -> MsgDoc -> m b
    parseError dflags :: DynFlags
    dflags sspan :: SrcSpan
    sspan err :: MsgDoc
    err = do
         SourceError -> m b
    forall a e. Exception e => e -> a
    throw (SourceError -> m b) -> SourceError -> m b
    forall a b. (a -> b) -> a -> b
    $ ErrorMessages -> SourceError
    GHC.mkSrcErr (ErrMsg -> ErrorMessages
    forall a. a -> Bag a
    GHC.unitBag (ErrMsg -> ErrorMessages) -> ErrMsg -> ErrorMessages
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> SrcSpan -> MsgDoc -> ErrMsg
    GHC.mkPlainErrMsg DynFlags
    dflags SrcSpan
    sspan MsgDoc
    err)

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

    readFileGhc :: FilePath -> IO String
    readFileGhc :: String -> IO String
    readFileGhc file :: String
    file = do
      buf :: StringBuffer
    buf@(GHC.StringBuffer _ len :: Int
    len _) <- String -> IO StringBuffer
    GHC.hGetStringBuffer String
    file
      String -> IO String
    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 :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
    mergeBy _cmp :: a -> a -> Ordering
    _cmp [] ys :: [a]
    ys = [a]
    ys
    mergeBy _cmp :: a -> a -> Ordering
    _cmp xs :: [a]
    xs [] = [a]
    xs
    mergeBy cmp :: a -> a -> Ordering
    cmp (allx :: [a]
    allx@(x :: a
    x:xs :: [a]
    xs)) (ally :: [a]
    ally@(y :: a
    y:ys :: [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