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 cfgType -> IO FilePath
getErrorPath params :: Params cfgType
params = do
(_,_,_, cacheDir :: FilePath
cacheDir, _) <- Params cfgType
-> IO (FilePath, FilePath, FilePath, FilePath, FilePath)
forall c.
Params c -> IO (FilePath, FilePath, FilePath, FilePath, FilePath)
getPaths Params cfgType
params
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
cacheDir FilePath -> FilePath -> FilePath
</> "errors.log"
getErrorString :: Params cfgType -> IO (Maybe String)
getErrorString :: Params cfgType -> IO (Maybe FilePath)
getErrorString params :: Params cfgType
params = do
FilePath
errorPath <- Params cfgType -> IO FilePath
forall cfgType. Params cfgType -> IO FilePath
getErrorPath Params cfgType
params
Bool
errorsExist <- FilePath -> IO Bool
doesFileExist FilePath
errorPath
if Bool -> Bool
not Bool
errorsExist
then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
else do FilePath
errorData <- FilePath -> IO FilePath
readFile FilePath
errorPath
if FilePath
errorData FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ""
then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
else Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> (FilePath -> Maybe FilePath) -> FilePath -> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> IO (Maybe FilePath))
-> FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
errorData
customCompile :: Params cfgType -> IO ()
customCompile :: Params cfgType -> IO ()
customCompile params :: Params cfgType
params@Params{statusOut :: forall cfgType. Params cfgType -> FilePath -> IO ()
statusOut = FilePath -> IO ()
output} = do
(thisBinary :: FilePath
thisBinary, tempBinary :: FilePath
tempBinary, configFile :: FilePath
configFile, cacheDir :: FilePath
cacheDir, libsDir :: FilePath
libsDir) <- Params cfgType
-> IO (FilePath, FilePath, FilePath, FilePath, FilePath)
forall c.
Params c -> IO (FilePath, FilePath, FilePath, FilePath, FilePath)
getPaths Params cfgType
params
FilePath -> IO ()
output (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Configuration '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
configFile FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "' changed. Recompiling."
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
cacheDir
FilePath
errFile <- Params cfgType -> IO FilePath
forall cfgType. Params cfgType -> IO FilePath
getErrorPath Params cfgType
params
ExitCode
result <- IO Handle
-> (Handle -> IO ()) -> (Handle -> IO ExitCode) -> IO ExitCode
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> IOMode -> IO Handle
openFile FilePath
errFile IOMode
WriteMode) Handle -> IO ()
hClose ((Handle -> IO ExitCode) -> IO ExitCode)
-> (Handle -> IO ExitCode) -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ \errHandle :: Handle
errHandle -> do
[FilePath]
ghcOpts <- Params cfgType
-> FilePath -> FilePath -> FilePath -> FilePath -> IO [FilePath]
forall cfgType.
Params cfgType
-> FilePath -> FilePath -> FilePath -> FilePath -> IO [FilePath]
makeFlags Params cfgType
params FilePath
configFile FilePath
tempBinary FilePath
cacheDir FilePath
libsDir
ProcessHandle
ghcProc <- FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ProcessHandle
runProcess FilePath
ghc [FilePath]
ghcOpts (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
cacheDir) Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
Maybe Handle
forall a. Maybe a
Nothing Maybe Handle
forall a. Maybe a
Nothing (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
errHandle)
ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ghcProc
if ExitCode
result ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
then FilePath -> IO ()
output "Error occurred while loading configuration file."
else FilePath -> IO ()
output "Program reconfiguration successful."
makeFlags :: Params cfgType -> FilePath -> FilePath -> FilePath
-> FilePath -> IO [String]
makeFlags :: Params cfgType
-> FilePath -> FilePath -> FilePath -> FilePath -> IO [FilePath]
makeFlags Params{ghcOpts :: forall cfgType. Params cfgType -> [FilePath]
ghcOpts = [FilePath]
flags, hidePackages :: forall cfgType. Params cfgType -> [FilePath]
hidePackages = [FilePath]
hides, forceRecomp :: forall cfgType. Params cfgType -> Bool
forceRecomp = Bool
force, includeCurrentDirectory :: forall cfgType. Params cfgType -> Bool
includeCurrentDirectory = Bool
includeCurDir}
cfgFile :: FilePath
cfgFile tmpFile :: FilePath
tmpFile cacheDir :: FilePath
cacheDir libsDir :: FilePath
libsDir = do
FilePath
currentDir <- IO FilePath
getCurrentDirectory
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath])
-> ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> IO [FilePath]) -> [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [ ["-v0", "-i" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
libsDir]
, if Bool
includeCurDir
then ["-i" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
currentDir]
else []
, ["-outputdir", FilePath
cacheDir]
, FilePath -> [FilePath] -> [FilePath]
forall (t :: * -> *) b. Foldable t => b -> t b -> [b]
prefix "-hide-package" [FilePath]
hides, [FilePath]
flags
, ["--make", FilePath
cfgFile, "-o", FilePath
tmpFile]
, ["-fforce-recomp" | Bool
force]
]
where prefix :: b -> t b -> [b]
prefix y :: b
y = (b -> [b]) -> t b -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((b -> [b]) -> t b -> [b]) -> (b -> [b]) -> t b -> [b]
forall a b. (a -> b) -> a -> b
$ \x :: b
x -> [b
y,b
x]