{- |
Compiling the custom executable. The majority of the code actually
deals with error handling, and not the compilation itself /per se/.
-}
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(..) )

-- | Return the path to the error file.
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"

-- | If the error file exists and actually has some contents, return
--   'Just' the error string. Otherwise return 'Nothing'.
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

-- | Attempts to compile the configuration file. Will return a string
--   containing any compiler output.
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

    -- Compile occurs in here
    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

    -- Display a helpful little status message
    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."

-- | Assemble the arguments to GHC so everything compiles right.
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] -- Only if force is true
                      ]
  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]