module Config.Dyre.Compile ( customCompile, getErrorPath, getErrorString ) where
import System.IO ( openFile, hClose, IOMode(..) )
import System.Exit ( ExitCode(..) )
import System.Process ( runProcess, waitForProcess )
import System.FilePath ( (</>) )
import System.Directory ( getCurrentDirectory, doesFileExist
, createDirectoryIfMissing )
import Control.Exception ( bracket )
import GHC.Paths ( ghc )
import Config.Dyre.Paths ( getPaths )
import Config.Dyre.Params ( Params(..) )
getErrorPath :: Params cfgType -> IO FilePath
getErrorPath params = do
(_,_,_, cacheDir, _) <- getPaths params
return $ cacheDir </> "errors.log"
getErrorString :: Params cfgType -> IO (Maybe String)
getErrorString params = do
errorPath <- getErrorPath params
errorsExist <- doesFileExist errorPath
if not errorsExist
then return Nothing
else do errorData <- readFile errorPath
if errorData == ""
then return Nothing
else return . Just $ errorData
customCompile :: Params cfgType -> IO ()
customCompile params@Params{statusOut = output} = do
(thisBinary, tempBinary, configFile, cacheDir, libsDir) <- getPaths params
output $ "Configuration '" ++ configFile ++ "' changed. Recompiling."
createDirectoryIfMissing True cacheDir
errFile <- getErrorPath params
result <- bracket (openFile errFile WriteMode) hClose $ \errHandle -> do
ghcOpts <- makeFlags params configFile tempBinary cacheDir libsDir
ghcProc <- runProcess ghc ghcOpts (Just cacheDir) Nothing
Nothing Nothing (Just errHandle)
waitForProcess ghcProc
if result /= ExitSuccess
then output "Error occurred while loading configuration file."
else output "Program reconfiguration successful."
makeFlags :: Params cfgType -> FilePath -> FilePath -> FilePath
-> FilePath -> IO [String]
makeFlags Params{ghcOpts = flags, hidePackages = hides, forceRecomp = force, includeCurrentDirectory = includeCurDir}
cfgFile tmpFile cacheDir libsDir = do
currentDir <- getCurrentDirectory
return . concat $ [ ["-v0", "-i" ++ libsDir]
, if includeCurDir
then ["-i" ++ currentDir]
else []
, ["-outputdir", cacheDir]
, prefix "-hide-package" hides, flags
, ["--make", cfgFile, "-o", tmpFile]
, ["-fforce-recomp" | force]
]
where prefix y = concatMap $ \x -> [y,x]