module Language.Haskell.HBB.Internal.GHC where
import DynFlags (parseDynamicFlagsCmdLine)
import GhcMonad (liftIO)
import Bag (bagToList)
import GHC
runGhcWithCmdLineFlags :: [String] -> Maybe FilePath -> Ghc a -> IO a
runGhcWithCmdLineFlags cmdLineFlags mbLibDir ghcAction = do
_ <- do (_,warns) <- parseStaticFlags (map (mkGeneralLocated "on the command line") cmdLineFlags)
case warns of [] -> return ()
((L _ x):_) -> error $ "Warnings at parsing (static) GHC flags: " ++ x
runGhc mbLibDir $ do
basicDFlags <- getSessionDynFlags
let str2locStr :: String -> Located String
str2locStr = (mkGeneralLocated "on the command line")
dynFlags <- do
(newDFlags,restArgs,errMsgs) <- parseDynamicFlagsCmdLine basicDFlags (map str2locStr cmdLineFlags)
_ <- case restArgs of
[] -> return ()
((L _ x):_) -> error $ "Unable to parse all GHC flags. E.g.: " ++ x
_ <- case errMsgs of
[] -> return ()
((L _ x):_) -> error $ "An error occured parsing the GHC flags at: " ++ x
return newDFlags
_ <- setSessionDynFlags dynFlags
ghcAction
extractRenamedAST :: GhcMonad m => ModSummary -> m RenamedSource
extractRenamedAST modSum = do
t <- (parseModule modSum >>= typecheckModule)
case tm_renamed_source t of Nothing -> error "internal failure (no hsgroup)"
Just x -> return x
updateDynFlagsToSuppressFileOutput :: GhcMonad m => m ()
updateDynFlagsToSuppressFileOutput = do
dflags <- getSessionDynFlags
setSessionDynFlags dflags {
hscTarget = HscInterpreted ,
ghcLink = LinkInMemory
}
return ()
searchModGraphFor :: GhcMonad m => Either FilePath Module -> m (ModuleName,ModSummary)
searchModGraphFor what = do
modGraph <- getModuleGraph
return $ case what of
Left filename -> searchModGraphInternalFi filename modGraph
Right mod -> searchModGraphInternalMo mod modGraph
where
searchModGraphInternalMo mo [] = error $ "Internal error (module isn't part of the module graph)"
searchModGraphInternalMo mo (x:rest) | (ms_mod x) == mo = (ms_mod_name x,x)
searchModGraphInternalMo mo (_:rest) = searchModGraphInternalMo mo rest
searchModGraphInternalFi fn [] = error $ "Internal error (module for source file " ++
fn ++ " isn't part of the module graph)"
searchModGraphInternalFi fn (x:rest) =
case ml_hs_file (ms_location x) of
Nothing -> searchModGraphInternalFi fn rest
Just hs -> if fn == hs then (ms_mod_name x,x)
else searchModGraphInternalFi fn rest
fileToTarget :: FilePath -> Target
fileToTarget filename = Target { targetId = (TargetFile filename Nothing),
targetAllowObjCode = False,
targetContents = Nothing }
loadTargetsFromFilename :: GhcMonad m => FilePath -> m ()
loadTargetsFromFilename filename = do
setTargets [fileToTarget filename]
_ <- load LoadAllTargets
return ()