-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE CPP #-}

module Development.IDE.Core.Preprocessor
  ( preprocessor
  ) where

import           Development.IDE.GHC.Compat
import qualified Development.IDE.GHC.Compat.Util   as Util
import           Development.IDE.GHC.CPP
import           Development.IDE.GHC.Orphans       ()
import qualified Development.IDE.GHC.Util          as Util

import           Control.DeepSeq                   (NFData (rnf))
import           Control.Exception                 (evaluate)
import           Control.Exception.Safe            (catch, throw)
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Except
import           Data.Char
import           Data.IORef                        (IORef, modifyIORef,
                                                    newIORef, readIORef)
import           Data.List.Extra
import           Data.Maybe
import           Data.Text                         (Text)
import qualified Data.Text                         as T
import           Development.IDE.GHC.Error
import           Development.IDE.Types.Diagnostics
import           Development.IDE.Types.Location
import qualified GHC.LanguageExtensions            as LangExt
import           System.FilePath
import           System.IO.Extra

-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]

#if MIN_VERSION_ghc(9,3,0)
import           GHC.Utils.Logger                  (LogFlags (..))
#endif

-- | Given a file and some contents, apply any necessary preprocessors,
--   e.g. unlit/cpp. Return the resulting buffer and the DynFlags it implies.
preprocessor :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO (Util.StringBuffer, [String], HscEnv, Util.Fingerprint)
preprocessor :: HscEnv
-> String
-> Maybe StringBuffer
-> ExceptT
     [FileDiagnostic] IO (StringBuffer, [String], HscEnv, Fingerprint)
preprocessor HscEnv
env String
filename Maybe StringBuffer
mbContents = do
    -- Perform unlit
    (Bool
isOnDisk, StringBuffer
contents) <-
        if String -> Bool
isLiterate String
filename then do
            StringBuffer
newcontent <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HscEnv -> String -> Maybe StringBuffer -> IO StringBuffer
runLhs HscEnv
env String
filename Maybe StringBuffer
mbContents
            forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, StringBuffer
newcontent)
        else do
            StringBuffer
contents <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO StringBuffer
Util.hGetStringBuffer String
filename) forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StringBuffer
mbContents
            let isOnDisk :: Bool
isOnDisk = forall a. Maybe a -> Bool
isNothing Maybe StringBuffer
mbContents
            forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
isOnDisk, StringBuffer
contents)

    -- Compute the source hash before the preprocessor because this is
    -- how GHC does it.
    !Fingerprint
src_hash <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ StringBuffer -> IO Fingerprint
Util.fingerprintFromStringBuffer StringBuffer
contents

    -- Perform cpp
    ([String]
opts, HscEnv
pEnv) <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ HscEnv
-> String
-> StringBuffer
-> IO (Either [FileDiagnostic] ([String], HscEnv))
parsePragmasIntoHscEnv HscEnv
env String
filename StringBuffer
contents
    let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
pEnv
    let logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
pEnv
    (Bool
newIsOnDisk, StringBuffer
newContents, [String]
newOpts, HscEnv
newEnv) <-
        if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Extension -> DynFlags -> Bool
xopt Extension
LangExt.Cpp DynFlags
dflags then
            forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
isOnDisk, StringBuffer
contents, [String]
opts, HscEnv
pEnv)
        else do
            IORef [CPPLog]
cppLogs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef []
            let newLogger :: Logger
newLogger = (LogAction -> LogAction) -> Logger -> Logger
pushLogHook (forall a b. a -> b -> a
const (LogActionCompat -> LogAction
logActionCompat forall a b. (a -> b) -> a -> b
$ IORef [CPPLog] -> LogActionCompat
logAction IORef [CPPLog]
cppLogs)) Logger
logger
            StringBuffer
con <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT
                        forall a b. (a -> b) -> a -> b
$ (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HscEnv -> String -> Maybe StringBuffer -> IO StringBuffer
runCpp (Logger -> HscEnv -> HscEnv
putLogHook Logger
newLogger HscEnv
pEnv) String
filename
                                       forall a b. (a -> b) -> a -> b
$ if Bool
isOnDisk then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just StringBuffer
contents))
                            forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch`
                            ( \(GhcException
e :: Util.GhcException) -> do
                                [CPPLog]
logs <- forall a. IORef a -> IO a
readIORef IORef [CPPLog]
cppLogs
                                case String -> [CPPLog] -> [FileDiagnostic]
diagsFromCPPLogs String
filename (forall a. [a] -> [a]
reverse [CPPLog]
logs) of
                                  []    -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw GhcException
e
                                  [FileDiagnostic]
diags -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [FileDiagnostic]
diags
                            )
            ([String]
options, HscEnv
hscEnv) <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ HscEnv
-> String
-> StringBuffer
-> IO (Either [FileDiagnostic] ([String], HscEnv))
parsePragmasIntoHscEnv HscEnv
pEnv String
filename StringBuffer
con
            forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, StringBuffer
con, [String]
options, HscEnv
hscEnv)

    -- Perform preprocessor
    if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Pp DynFlags
dflags then
        forall (m :: * -> *) a. Monad m => a -> m a
return (StringBuffer
newContents, [String]
newOpts, HscEnv
newEnv, Fingerprint
src_hash)
    else do
        StringBuffer
con <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HscEnv -> String -> Maybe StringBuffer -> IO StringBuffer
runPreprocessor HscEnv
newEnv String
filename forall a b. (a -> b) -> a -> b
$ if Bool
newIsOnDisk then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just StringBuffer
newContents
        ([String]
options, HscEnv
hscEnv) <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ HscEnv
-> String
-> StringBuffer
-> IO (Either [FileDiagnostic] ([String], HscEnv))
parsePragmasIntoHscEnv HscEnv
newEnv String
filename StringBuffer
con
        forall (m :: * -> *) a. Monad m => a -> m a
return (StringBuffer
con, [String]
options, HscEnv
hscEnv, Fingerprint
src_hash)
  where
    logAction :: IORef [CPPLog] -> LogActionCompat
    logAction :: IORef [CPPLog] -> LogActionCompat
logAction IORef [CPPLog]
cppLogs DynFlags
dflags WarnReason
_reason Severity
severity SrcSpan
srcSpan PrintUnqualified
_style SDoc
msg = do
#if MIN_VERSION_ghc(9,3,0)
      let cppLog = CPPLog (fromMaybe SevWarning severity) srcSpan $ T.pack $ renderWithContext (log_default_user_context dflags) msg
#else
      let cppLog :: CPPLog
cppLog = Severity -> SrcSpan -> Text -> CPPLog
CPPLog Severity
severity SrcSpan
srcSpan forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> String
showSDoc DynFlags
dflags SDoc
msg
#endif
      forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [CPPLog]
cppLogs (CPPLog
cppLog forall a. a -> [a] -> [a]
:)



data CPPLog = CPPLog Severity SrcSpan Text
  deriving (Int -> CPPLog -> ShowS
[CPPLog] -> ShowS
CPPLog -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CPPLog] -> ShowS
$cshowList :: [CPPLog] -> ShowS
show :: CPPLog -> String
$cshow :: CPPLog -> String
showsPrec :: Int -> CPPLog -> ShowS
$cshowsPrec :: Int -> CPPLog -> ShowS
Show)


data CPPDiag
  = CPPDiag
      { CPPDiag -> Range
cdRange    :: Range,
        CPPDiag -> Maybe DiagnosticSeverity
cdSeverity :: Maybe DiagnosticSeverity,
        CPPDiag -> [Text]
cdMessage  :: [Text]
      }
  deriving (Int -> CPPDiag -> ShowS
[CPPDiag] -> ShowS
CPPDiag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CPPDiag] -> ShowS
$cshowList :: [CPPDiag] -> ShowS
show :: CPPDiag -> String
$cshow :: CPPDiag -> String
showsPrec :: Int -> CPPDiag -> ShowS
$cshowsPrec :: Int -> CPPDiag -> ShowS
Show)


diagsFromCPPLogs :: FilePath -> [CPPLog] -> [FileDiagnostic]
diagsFromCPPLogs :: String -> [CPPLog] -> [FileDiagnostic]
diagsFromCPPLogs String
filename [CPPLog]
logs =
  forall a b. (a -> b) -> [a] -> [b]
map (\CPPDiag
d -> (String -> NormalizedFilePath
toNormalizedFilePath' String
filename, ShowDiagnostic
ShowDiag, CPPDiag -> Diagnostic
cppDiagToDiagnostic CPPDiag
d)) forall a b. (a -> b) -> a -> b
$
    [CPPDiag] -> [CPPLog] -> [CPPDiag]
go [] [CPPLog]
logs
  where
    -- On errors, CPP calls logAction with a real span for the initial log and
    -- then additional informational logs with `UnhelpfulSpan`. Collect those
    -- informational log messages and attaches them to the initial log message.
    go :: [CPPDiag] -> [CPPLog] -> [CPPDiag]
    go :: [CPPDiag] -> [CPPLog] -> [CPPDiag]
go [CPPDiag]
acc [] = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\CPPDiag
d -> CPPDiag
d {cdMessage :: [Text]
cdMessage = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ CPPDiag -> [Text]
cdMessage CPPDiag
d}) [CPPDiag]
acc
    go [CPPDiag]
acc (CPPLog Severity
sev (RealSrcSpan RealSrcSpan
rSpan Maybe BufSpan
_) Text
msg : [CPPLog]
gLogs) =
      let diag :: CPPDiag
diag = Range -> Maybe DiagnosticSeverity -> [Text] -> CPPDiag
CPPDiag (RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
rSpan) (Severity -> Maybe DiagnosticSeverity
toDSeverity Severity
sev) [Text
msg]
       in [CPPDiag] -> [CPPLog] -> [CPPDiag]
go (CPPDiag
diag forall a. a -> [a] -> [a]
: [CPPDiag]
acc) [CPPLog]
gLogs
    go (CPPDiag
diag : [CPPDiag]
diags) (CPPLog Severity
_sev (UnhelpfulSpan UnhelpfulSpanReason
_) Text
msg : [CPPLog]
gLogs) =
      [CPPDiag] -> [CPPLog] -> [CPPDiag]
go (CPPDiag
diag {cdMessage :: [Text]
cdMessage = Text
msg forall a. a -> [a] -> [a]
: CPPDiag -> [Text]
cdMessage CPPDiag
diag} forall a. a -> [a] -> [a]
: [CPPDiag]
diags) [CPPLog]
gLogs
    go [] (CPPLog Severity
_sev (UnhelpfulSpan UnhelpfulSpanReason
_) Text
_msg : [CPPLog]
gLogs) = [CPPDiag] -> [CPPLog] -> [CPPDiag]
go [] [CPPLog]
gLogs
    cppDiagToDiagnostic :: CPPDiag -> Diagnostic
    cppDiagToDiagnostic :: CPPDiag -> Diagnostic
cppDiagToDiagnostic CPPDiag
d =
      Diagnostic
        { $sel:_range:Diagnostic :: Range
_range = CPPDiag -> Range
cdRange CPPDiag
d,
          $sel:_severity:Diagnostic :: Maybe DiagnosticSeverity
_severity = CPPDiag -> Maybe DiagnosticSeverity
cdSeverity CPPDiag
d,
          $sel:_code:Diagnostic :: Maybe (Int32 |? Text)
_code = forall a. Maybe a
Nothing,
          $sel:_source:Diagnostic :: Maybe Text
_source = forall a. a -> Maybe a
Just Text
"CPP",
          $sel:_message:Diagnostic :: Text
_message = [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ CPPDiag -> [Text]
cdMessage CPPDiag
d,
          $sel:_relatedInformation:Diagnostic :: Maybe [DiagnosticRelatedInformation]
_relatedInformation = forall a. Maybe a
Nothing,
          $sel:_tags:Diagnostic :: Maybe [DiagnosticTag]
_tags = forall a. Maybe a
Nothing,
          $sel:_codeDescription:Diagnostic :: Maybe CodeDescription
_codeDescription = forall a. Maybe a
Nothing,
          $sel:_data_:Diagnostic :: Maybe Value
_data_ = forall a. Maybe a
Nothing
        }


isLiterate :: FilePath -> Bool
isLiterate :: String -> Bool
isLiterate String
x = ShowS
takeExtension String
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".lhs",String
".lhs-boot"]


-- | This reads the pragma information directly from the provided buffer.
parsePragmasIntoHscEnv
    :: HscEnv
    -> FilePath
    -> Util.StringBuffer
    -> IO (Either [FileDiagnostic] ([String], HscEnv))
parsePragmasIntoHscEnv :: HscEnv
-> String
-> StringBuffer
-> IO (Either [FileDiagnostic] ([String], HscEnv))
parsePragmasIntoHscEnv HscEnv
env String
fp StringBuffer
contents = forall a.
DynFlags -> Text -> IO a -> IO (Either [FileDiagnostic] a)
catchSrcErrors DynFlags
dflags0 Text
"pragmas" forall a b. (a -> b) -> a -> b
$ do
#if MIN_VERSION_ghc(9,3,0)
    let (_warns,opts) = getOptions (initParserOpts dflags0) contents fp
#else
    let opts :: [Located String]
opts = DynFlags -> StringBuffer -> String -> [Located String]
getOptions DynFlags
dflags0 StringBuffer
contents String
fp
#endif

    -- Force bits that might keep the dflags and stringBuffer alive unnecessarily
    forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall a. NFData a => a -> ()
rnf [Located String]
opts

    (DynFlags
dflags, [Located String]
_, [Warn]
_) <- forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located String] -> m (DynFlags, [Located String], [Warn])
parseDynamicFilePragma DynFlags
dflags0 [Located String]
opts
    HscEnv
hsc_env' <- HscEnv -> IO HscEnv
initializePlugins (DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
dflags HscEnv
env)
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc [Located String]
opts, DynFlags -> HscEnv -> HscEnv
hscSetFlags (DynFlags -> DynFlags
disableWarningsAsErrors forall a b. (a -> b) -> a -> b
$ HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env') HscEnv
hsc_env')
  where dflags0 :: DynFlags
dflags0 = HscEnv -> DynFlags
hsc_dflags HscEnv
env

-- | Run (unlit) literate haskell preprocessor on a file, or buffer if set
runLhs :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> IO Util.StringBuffer
runLhs :: HscEnv -> String -> Maybe StringBuffer -> IO StringBuffer
runLhs HscEnv
env String
filename Maybe StringBuffer
contents = forall a. (String -> IO a) -> IO a
withTempDir forall a b. (a -> b) -> a -> b
$ \String
dir -> do
    let fout :: String
fout = String
dir String -> ShowS
</> ShowS
takeFileName String
filename String -> ShowS
<.> String
"unlit"
    String
filesrc <- case Maybe StringBuffer
contents of
        Maybe StringBuffer
Nothing   -> forall (m :: * -> *) a. Monad m => a -> m a
return String
filename
        Just StringBuffer
cnts -> do
            let fsrc :: String
fsrc = String
dir String -> ShowS
</> ShowS
takeFileName String
filename String -> ShowS
<.> String
"literate"
            forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
fsrc IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
h ->
                Handle -> StringBuffer -> IO ()
hPutStringBuffer Handle
h StringBuffer
cnts
            forall (m :: * -> *) a. Monad m => a -> m a
return String
fsrc
    String -> String -> IO ()
unlit String
filesrc String
fout
    String -> IO StringBuffer
Util.hGetStringBuffer String
fout
  where
    logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
env
    dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
env

    unlit :: String -> String -> IO ()
unlit String
filein String
fileout = Logger -> DynFlags -> [Option] -> IO ()
runUnlit Logger
logger DynFlags
dflags (String -> String -> [Option]
args String
filein String
fileout)
    args :: String -> String -> [Option]
args String
filein String
fileout = [
                      String -> Option
Option     String
"-h"
                    , String -> Option
Option     (ShowS
escape String
filename) -- name this file
                    , String -> String -> Option
FileOption String
"" String
filein       -- input file
                    , String -> String -> Option
FileOption String
"" String
fileout ]    -- output file
    -- taken from ghc's DriverPipeline.hs
    escape :: ShowS
escape (Char
'\\':String
cs) = Char
'\\'forall a. a -> [a] -> [a]
:Char
'\\'forall a. a -> [a] -> [a]
: ShowS
escape String
cs
    escape (Char
'\"':String
cs) = Char
'\\'forall a. a -> [a] -> [a]
:Char
'\"'forall a. a -> [a] -> [a]
: ShowS
escape String
cs
    escape (Char
'\'':String
cs) = Char
'\\'forall a. a -> [a] -> [a]
:Char
'\''forall a. a -> [a] -> [a]
: ShowS
escape String
cs
    escape (Char
c:String
cs)    = Char
c forall a. a -> [a] -> [a]
: ShowS
escape String
cs
    escape []        = []

-- | Run CPP on a file
runCpp :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> IO Util.StringBuffer
runCpp :: HscEnv -> String -> Maybe StringBuffer -> IO StringBuffer
runCpp HscEnv
env0 String
filename Maybe StringBuffer
mbContents = forall a. (String -> IO a) -> IO a
withTempDir forall a b. (a -> b) -> a -> b
$ \String
dir -> do
    let out :: String
out = String
dir String -> ShowS
</> ShowS
takeFileName String
filename String -> ShowS
<.> String
"out"
    let dflags1 :: DynFlags
dflags1 = String -> DynFlags -> DynFlags
addOptP String
"-D__GHCIDE__" (HscEnv -> DynFlags
hsc_dflags HscEnv
env0)
    let env1 :: HscEnv
env1 = DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
dflags1 HscEnv
env0

    case Maybe StringBuffer
mbContents of
        Maybe StringBuffer
Nothing -> do
            -- Happy case, file is not modified, so run CPP on it in-place
            -- which also makes things like relative #include files work
            -- and means location information is correct
            HscEnv -> String -> String -> IO ()
doCpp HscEnv
env1 String
filename String
out
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO StringBuffer
Util.hGetStringBuffer String
out

        Just StringBuffer
contents -> do
            -- Sad path, we have to create a version of the path in a temp dir
            -- __FILE__ macro is wrong, ignoring that for now (likely not a real issue)

            -- Relative includes aren't going to work, so we fix that by adding to the include path.
            let dflags2 :: DynFlags
dflags2 = String -> DynFlags -> DynFlags
addIncludePathsQuote (ShowS
takeDirectory String
filename) DynFlags
dflags1
            let env2 :: HscEnv
env2 = DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
dflags2 HscEnv
env0
            -- Location information is wrong, so we fix that by patching it afterwards.
            let inp :: String
inp = String
dir String -> ShowS
</> String
"___GHCIDE_MAGIC___"
            forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
inp IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
h ->
                Handle -> StringBuffer -> IO ()
hPutStringBuffer Handle
h StringBuffer
contents
            HscEnv -> String -> String -> IO ()
doCpp HscEnv
env2 String
inp String
out

            -- Fix up the filename in lines like:
            -- # 1 "C:/Temp/extra-dir-914611385186/___GHCIDE_MAGIC___"
            let tweak :: ShowS
tweak String
x
                    | Just String
y <- forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"# " String
x
                    , String
"___GHCIDE_MAGIC___" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
y
                    , let num :: String
num = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
y
                    -- important to use /, and never \ for paths, even on Windows, since then C escapes them
                    -- and GHC gets all confused
                        = String
"# " forall a. Semigroup a => a -> a -> a
<> String
num forall a. Semigroup a => a -> a -> a
<> String
" \"" forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map (\Char
z -> if Char -> Bool
isPathSeparator Char
z then Char
'/' else Char
z) String
filename forall a. Semigroup a => a -> a -> a
<> String
"\""
                    | Bool
otherwise = String
x
            String -> StringBuffer
Util.stringToStringBuffer forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ShowS
tweak forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFileUTF8' String
out


-- | Run a preprocessor on a file
runPreprocessor :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> IO Util.StringBuffer
runPreprocessor :: HscEnv -> String -> Maybe StringBuffer -> IO StringBuffer
runPreprocessor HscEnv
env String
filename Maybe StringBuffer
mbContents = forall a. (String -> IO a) -> IO a
withTempDir forall a b. (a -> b) -> a -> b
$ \String
dir -> do
    let out :: String
out = String
dir String -> ShowS
</> ShowS
takeFileName String
filename String -> ShowS
<.> String
"out"
    String
inp <- case Maybe StringBuffer
mbContents of
        Maybe StringBuffer
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return String
filename
        Just StringBuffer
contents -> do
            let inp :: String
inp = String
dir String -> ShowS
</> ShowS
takeFileName String
filename String -> ShowS
<.> String
"hs"
            forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
inp IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
h ->
                Handle -> StringBuffer -> IO ()
hPutStringBuffer Handle
h StringBuffer
contents
            forall (m :: * -> *) a. Monad m => a -> m a
return String
inp
    Logger -> DynFlags -> [Option] -> IO ()
runPp Logger
logger DynFlags
dflags [String -> Option
Option String
filename, String -> Option
Option String
inp, String -> String -> Option
FileOption String
"" String
out]
    String -> IO StringBuffer
Util.hGetStringBuffer String
out
  where
    logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
env
    dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
env