Make some commands work

arion-compose.cabal

@@ -30,8 +30,10 @@ common deps
                    , aeson-pretty
                    , async
                    , bytestring
+                   , directory
                    , process
                    , process-extras
+                   , temporary
                    , text
                    , protolude
 
@@ -43,6 +45,7 @@ library
   import:              deps
   exposed-modules:     Arion.Nix
                        Arion.Aeson
+                       Arion.DockerCompose
   other-modules:       Paths_arion_compose
   -- other-extensions:
   hs-source-dirs:      src/haskell/lib

nix/overlay.nix

@@ -28,6 +28,7 @@ in
       buildInputs = [
         haskellPkgs.cabal-install
         haskellPkgs.ghcid
+        super.docker-compose
       ];
     };
   };

src/haskell/exe/Main.hs

@@ -7,6 +7,7 @@ import Protolude hiding (Down)
 
 import           Arion.Nix
 import           Arion.Aeson
+import qualified Arion.DockerCompose as DockerCompose
 
 import Options.Applicative
 import Control.Applicative
@@ -131,29 +132,43 @@ commandDC run cmdStr help =
 --------------------------------------------------------------------------------
 
 runDC :: Text -> DockerComposeArgs -> CommonOptions -> IO ()
-runDC cmd (DockerComposeArgs args) opts =
-  panic $ "TODO: docker-compose " <> cmd <> " " <> T.unwords args
+runDC cmd (DockerComposeArgs args) opts = do
+  DockerCompose.run DockerCompose.Args
+    { files = []
+    , otherArgs = [cmd] ++ args
+    }
 
 runBuildAndDC :: Text -> DockerComposeArgs -> CommonOptions -> IO ()
 runBuildAndDC cmd dopts opts = do
-  T.putStrLn "TODO: build"
-  runDC cmd dopts opts
+  ea <- defaultEvaluationArgs opts
+  Arion.Nix.withBuiltComposition ea $ \path ->
+    DockerCompose.run DockerCompose.Args
+      { files = [path]
+      , otherArgs = [cmd] ++ unDockerComposeArgs dopts
+      }
 
 runEvalAndDC :: Text -> DockerComposeArgs -> CommonOptions -> IO ()
 runEvalAndDC cmd dopts opts = do
-  T.putStrLn "TODO: eval"
-  runDC cmd dopts opts
+  ea <- defaultEvaluationArgs opts
+  Arion.Nix.withEvaluatedComposition ea $ \path ->
+    DockerCompose.run DockerCompose.Args
+      { files = [path]
+      , otherArgs = [cmd] ++ unDockerComposeArgs dopts
+      }
+
+defaultEvaluationArgs :: CommonOptions -> IO EvaluationArgs
+defaultEvaluationArgs co = pure EvaluationArgs
+  { evalUid = 0 -- TODO
+  , evalModules = files co
+  , evalPkgs = pkgs co
+  , evalWorkDir = Nothing
+  , evalMode = ReadWrite
+  , evalUserArgs = nixArgs co
+  }
 
 runCat :: CommonOptions -> IO ()
 runCat co = do
-  v <- Arion.Nix.evaluateComposition EvaluationArgs
-    { evalUid = 0 -- TODO
-    , evalModules = files co
-    , evalPkgs = pkgs co
-    , evalWorkDir = Nothing
-    , evalMode = ReadWrite
-    , evalUserArgs = nixArgs co
-    }
+  v <- Arion.Nix.evaluateComposition =<< defaultEvaluationArgs co
   T.hPutStrLn stdout (pretty v)
 
 runRepl :: CommonOptions -> IO ()

src/haskell/lib/Arion/DockerCompose.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Arion.DockerCompose where
+
+import           Prelude                        ( )
+import           Protolude
+import           Arion.Aeson                    ( pretty )
+import           Data.Aeson
+import qualified Data.String
+import           System.Process
+import qualified Data.ByteString               as BS
+import qualified Data.ByteString.Lazy          as BL
+import qualified System.Process.ByteString.Lazy
+                                                as PBL
+import           Paths_arion_compose
+import           Control.Applicative
+
+import qualified Data.Text                     as T
+import qualified Data.Text.IO                  as T
+
+import qualified Data.List.NonEmpty            as NE
+import           Data.List.NonEmpty             ( NonEmpty(..) )
+
+import           Control.Arrow                  ( (>>>) )
+import           System.IO.Temp                 ( withTempFile )
+import           System.IO                      ( hClose )
+
+data Args = Args
+  { files :: [FilePath]
+  , otherArgs :: [Text]
+  }
+
+run :: Args -> IO ()
+run args = do
+  let fileArgs = files args >>= \f -> ["--file", f]
+      allArgs  = fileArgs ++ map toS (otherArgs args)
+
+      procSpec = proc "docker-compose" allArgs
+
+  -- hPutStrLn stderr ("Running docker-compose with " <> show allArgs :: Text)
+
+  withCreateProcess procSpec $ \_in _out _err procHandle -> do
+
+    -- Wait for process exit and 'err' printout
+    exitCode <- waitForProcess procHandle
+
+    case exitCode of
+      ExitSuccess -> pass
+      ExitFailure 1 -> exitFailure
+      e@ExitFailure {} -> do
+        throwIO $ FatalError $ "docker-compose failed with " <> show exitCode
+        exitWith e

src/haskell/lib/Arion/Nix.hs

@@ -1,10 +1,18 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Arion.Nix where
+module Arion.Nix
+  ( evaluateComposition
+  , withEvaluatedComposition
+  , withBuiltComposition
+  , EvaluationArgs(..)
+  , EvaluationMode(..)
+  ) where
 
 import           Prelude                        ( )
 import           Protolude
+import           Arion.Aeson                    ( pretty )
 import           Data.Aeson
 import qualified Data.String
+import qualified System.Directory              as Directory
 import           System.Process
 import qualified Data.ByteString               as BS
 import qualified Data.ByteString.Lazy          as BL
@@ -20,6 +28,8 @@ import qualified Data.List.NonEmpty            as NE
 import           Data.List.NonEmpty             ( NonEmpty(..) )
 
 import           Control.Arrow                  ( (>>>) )
+import           System.IO.Temp                 ( withTempFile )
+import           System.IO                      ( hClose )
 
 data EvaluationMode =
   ReadWrite | ReadOnly
@@ -35,7 +45,7 @@ data EvaluationArgs = EvaluationArgs
 
 evaluateComposition :: EvaluationArgs -> IO Value
 evaluateComposition ea = do
-  evalComposition <- getDataFileName "nix/eval-composition.nix"
+  evalComposition <- getEvalCompositionFile
   let commandArgs =
         [ "--eval"
         , "--strict"
@@ -43,22 +53,11 @@ evaluateComposition ea = do
         , "--attr"
         , "config.build.dockerComposeYamlAttrs"
         ]
-      argArgs =
-        [ "--argstr"
-        , "uid"
-        , show $ evalUid ea
-        , "--arg"
-        , "modules"
-        , modulesNixExpr $ evalModules ea
-        , "--arg"
-        , "pkgs"
-        , toS $ evalPkgs ea
-        ]
       args =
         [ evalComposition ]
         ++ commandArgs
         ++ modeArguments (evalMode ea)
-        ++ argArgs
+        ++ argArgs ea
         ++ map toS (evalUserArgs ea)
       stdin    = mempty
       procSpec = (proc "nix-instantiate" args) { cwd = evalWorkDir ea }
@@ -83,6 +82,77 @@ evaluateComposition ea = do
     Right r -> pure r
     Left  e -> throwIO $ FatalError "Couldn't parse nix-instantiate output"
 
+-- | Run with docker-compose.yaml tmpfile
+withEvaluatedComposition :: EvaluationArgs -> (FilePath -> IO r) -> IO r
+withEvaluatedComposition ea f = do
+  v <- evaluateComposition ea
+  withTempFile "." ".tmp-arion-docker-compose.yaml" $ \path handle -> do
+    T.hPutStrLn handle (pretty v)
+    hClose handle
+    f path
+
+
+buildComposition :: FilePath -> EvaluationArgs -> IO ()
+buildComposition outLink ea = do
+  evalComposition <- getEvalCompositionFile
+  let commandArgs =
+        [ "--attr"
+        , "config.build.dockerComposeYaml"
+        , "--out-link"
+        , outLink
+        ]
+      args =
+        [ evalComposition ]
+        ++ commandArgs
+        ++ argArgs ea
+        ++ map toS (evalUserArgs ea)
+      stdin    = mempty
+      procSpec = (proc "nix-build" args) { cwd = evalWorkDir ea }
+  
+  -- TODO: lazy IO is tricky. Let's use conduit/pipes instead?
+  (exitCode, out, err) <- PBL.readCreateProcessWithExitCode procSpec stdin
+    
+  -- Stream 'err'
+  errDone <- async (BL.hPutStr stderr err)
+
+  -- Force 'out'
+  -- TODO: use it?
+  _v <- Protolude.evaluate out
+
+  -- Wait for process exit and 'err' printout
+  wait errDone
+
+  case exitCode of
+    ExitSuccess -> pass
+    ExitFailure e -> throwIO $ FatalError "Build failed" -- TODO: don't print this exception in main
+
+-- | Do something with a docker-compose.yaml.
+withBuiltComposition :: EvaluationArgs -> (FilePath -> IO r) -> IO r
+withBuiltComposition ea f = do
+  withTempFile "." ".tmp-arion-docker-compose.yaml" $ \path handle -> do
+    hClose handle
+    -- Known problem: kills atomicity of withTempFile; won't fix because we should manage gc roots,
+    -- impl of which will probably avoid this "problem". It seems unlikely to cause issues.
+    Directory.removeFile path
+    buildComposition path ea
+    f path
+
+argArgs :: EvaluationArgs -> [[Char]]
+argArgs ea =
+      [ "--argstr"
+      , "uid"
+      , show $ evalUid ea
+      , "--arg"
+      , "modules"
+      , modulesNixExpr $ evalModules ea
+      , "--arg"
+      , "pkgs"
+      , toS $ evalPkgs ea
+      ]
+
+getEvalCompositionFile :: IO FilePath
+getEvalCompositionFile = getDataFileName "nix/eval-composition.nix"
+
 modeArguments :: EvaluationMode -> [[Char]]
 modeArguments ReadWrite = [ "--read-write-mode" ]
 modeArguments ReadOnly = [ "--readonly-mode" ]