module System.Build(BuildArgs(..), asBinaryName, asStackArg
, stackInDocker) where
import Data.Functor
import Data.String
import System.Directory
import System.Docker
import System.IO
import System.IO.Extra
import System.Process
data BuildArgs = SimpleTarget String
| FullTarget String String
| GHCOption String
| MoreArgs BuildArgs BuildArgs
| NoArgs
deriving (Eq, Show, Read)
instance Monoid BuildArgs where
mempty = NoArgs
mappend = MoreArgs
instance IsString BuildArgs where
fromString = SimpleTarget
asStackArg :: BuildArgs -> [String]
asStackArg NoArgs = []
asStackArg (SimpleTarget t) = [":" ++ t]
asStackArg (FullTarget pref t) = [pref ++ ":exe:" ++ t]
asStackArg (GHCOption opt) = ["--ghc-options", opt]
asStackArg (MoreArgs l r) = asStackArg l ++ asStackArg r
asBinaryName :: BuildArgs -> String
asBinaryName NoArgs = ""
asBinaryName (SimpleTarget t) = t
asBinaryName (FullTarget _ t) = t
asBinaryName (GHCOption _) = ""
asBinaryName (MoreArgs l r) = asBinaryName l ++ asBinaryName r
stackInDocker :: ImageName -> FilePath -> BuildArgs -> IO FilePath
stackInDocker img@(ImageName imgName) srcDir buildTarget = do
absSrcDir <- canonicalizePath srcDir
buildAlreadyRun <- doesFileExist ".cidfile"
if buildAlreadyRun
then do
cid <- readFile ".cidfile"
removeFile ".cidfile"
callProcess "docker" $ ["run", "--cidfile=.cidfile", "-v", absSrcDir ++ ":/build", "--volumes-from=" ++ cid,
"-v", "/root/.stack", "-w", "/build" , imgName, "stack", "build","--allow-different-user" ] ++ asStackArg buildTarget
else callProcess "docker" $ ["run", "--cidfile=.cidfile", "-v", absSrcDir ++ ":/build",
"-v", "/root/.stack", "-w", "/build" , imgName, "stack", "build","--allow-different-user" ] ++ asStackArg buildTarget
exportBinary img (asBinaryName buildTarget)
exportBinary :: ImageName -> String -> IO FilePath
exportBinary (ImageName imgName) targetName = do
cid <- readFile ".cidfile"
let reuseVolumes = if not (null cid)
then "--volumes-from=" ++ cid
else ""
stackRoot <- filter (/= '\n') <$> readProcess "docker" [ "run", "--rm",reuseVolumes , "-w", "/build", imgName, "stack", "path", "--allow-different-user", "--local-install-root" ] ""
(_, Just hout, _, phdl) <- createProcess $ (proc "docker" ["run", "--rm", reuseVolumes, "busybox","dd", "if=" ++ stackRoot ++ "/bin/" ++ targetName ]) { std_out = CreatePipe }
withBinaryFile targetName WriteMode $ \ hDst -> copy hout hDst
void $ waitForProcess phdl
return targetName