module Language.C.Preprocessor.Remover.Internal.Preprocess
(
parseModuleWithCpp
, getPreprocessedSrcDirect
) where
import Control.Monad (void)
import Data.Tuple.Extra (fst3)
import Lens.Micro
import Language.C.Preprocessor.Remover.Internal.Types
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import qualified DriverPhases as GHC
import qualified DriverPipeline as GHC
import qualified DynFlags as GHC
import qualified GHC
import qualified GHC.Paths as GHC
import qualified HeaderInfo as GHC
import qualified HscTypes as GHC
import qualified MonadUtils as GHC
# if __GLASGOW_HASKELL__ >= 800
import qualified Language.Haskell.TH.LanguageExtensions as LE
# endif
parseModuleWithCpp :: CppOptions -> FilePath -> IO String
parseModuleWithCpp cppOptions file = GHC.runGhc (Just GHC.libdir) $ do
dflags <- initDynFlags file
#if __GLASGOW_HASKELL__ >= 800
let useCpp = GHC.xopt LE.Cpp dflags
#else
let useCpp = GHC.xopt GHC.Opt_Cpp dflags
#endif
if useCpp
then getPreprocessedSrcDirect cppOptions file
else GHC.liftIO (readFile file)
initDynFlags :: GHC.GhcMonad m => FilePath -> m GHC.DynFlags
initDynFlags file = do
dflags0 <- GHC.getSessionDynFlags
src_opts <- GHC.liftIO $ GHC.getOptionsFromFile dflags0 file
dflags1 <- fst3 <$> GHC.parseDynamicFilePragma dflags0 src_opts
let dflags2 = dflags1 {GHC.log_action = GHC.defaultLogAction}
void $ GHC.setSessionDynFlags dflags2
return dflags2
getPreprocessedSrcDirect :: GHC.GhcMonad m => CppOptions -> FilePath -> m String
getPreprocessedSrcDirect cppOptions file = do
hscEnv <- injectCppOptions cppOptions <$> GHC.getSession
(_, tempFile) <- GHC.liftIO $ GHC.preprocess hscEnv (file, cppPhase)
GHC.liftIO (readFile tempFile)
where
cppPhase = Just (GHC.Cpp GHC.HsSrcFile)
injectCppOptions :: CppOptions -> GHC.HscEnv -> GHC.HscEnv
injectCppOptions CppOptions{..} = over (_hsc_dflags . _settings . _sOpt_P)
(encodedOptions ++)
where
encodedOptions = map ("-D" ++) cppDefine
++ map ("-I" ++) cppInclude
++ map ("-include" ++) cppFile
_hsc_dflags :: Lens' GHC.HscEnv GHC.DynFlags
_hsc_dflags = lens GHC.hsc_dflags
(\hscEnv dynFlags -> hscEnv {GHC.hsc_dflags = dynFlags})
_settings :: Lens' GHC.DynFlags GHC.Settings
_settings = lens GHC.settings
(\dynFlags setting -> dynFlags {GHC.settings = setting})
_sOpt_P :: Lens' GHC.Settings [String]
_sOpt_P = lens GHC.sOpt_P
(\setting strings -> setting {GHC.sOpt_P = strings})