From 549942eb09b86f3ccdd8407679741dd07eed4977 Mon Sep 17 00:00:00 2001
From: Kiara Grouwstra <kiara.grouwstra@gmail.com>
Date: Sat, 3 Aug 2024 19:15:35 +0000
Subject: [PATCH] DRAFT: add deploy sub-command invoking docker stack deploy

my implementation here is a bit hacky, so this may need some more eyes.

that said, swarm deploy seems the primary command in docker stack/swarm
involving the compose file arion manages thru nix,
so one could as well just invoke their remaining commands directly.
---
 src/haskell/exe/Main.hs                |  7 ++++++-
 src/haskell/lib/Arion/DockerCompose.hs | 12 +++++++++---
 2 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/src/haskell/exe/Main.hs b/src/haskell/exe/Main.hs
index 3fa7f19..4d64ba1 100644
--- a/src/haskell/exe/Main.hs
+++ b/src/haskell/exe/Main.hs
@@ -112,6 +112,7 @@ parseCommand =
       <> commandDC runEvalAndDC "top" "Display the running processes"
       <> commandDC runEvalAndDC "unpause" "Unpause services"
       <> commandDC runBuildAndDC "up" "Create and start containers"
+      <> commandDC runEvalAndDC "deploy" "Deploy a new stack or update an existing stack"
       <> commandDC runDC "version" "Show the Docker-Compose version information"
 
       <> metavar "DOCKER-COMPOSE-COMMAND"
@@ -164,7 +165,10 @@ callDC cmd dopts opts shouldLoadImages path = do
   let firstOpts = projectArgs extendedInfo <> commonArgs opts
   DockerCompose.run DockerCompose.Args
     { files = [path]
-    , otherArgs = firstOpts ++ [cmd] ++ unDockerComposeArgs dopts
+    , otherArgs = case cmd of
+        "deploy" -> unDockerComposeArgs dopts ++ toList (projectName extendedInfo)
+        _ -> firstOpts ++ [cmd] ++ unDockerComposeArgs dopts
+    , useSwarm = cmd == "deploy"
     }
 
 projectArgs :: ExtendedInfo -> [Text]
@@ -314,6 +318,7 @@ runExec detach privileged user noTTY index envs workDir service commandAndArgs o
     DockerCompose.run DockerCompose.Args
       { files = [path]
       , otherArgs = projectArgs extendedInfo <> commonArgs opts <> args
+      , useSwarm = False
       }
 
 main :: IO ()
diff --git a/src/haskell/lib/Arion/DockerCompose.hs b/src/haskell/lib/Arion/DockerCompose.hs
index f44d86f..f3c4840 100644
--- a/src/haskell/lib/Arion/DockerCompose.hs
+++ b/src/haskell/lib/Arion/DockerCompose.hs
@@ -8,14 +8,20 @@ import           System.Process
 data Args = Args
   { files :: [FilePath]
   , otherArgs :: [Text]
+  , useSwarm :: Bool
   }
 
 run :: Args -> IO ()
 run args = do
-  let fileArgs = files args >>= \f -> ["--file", f]
-      allArgs  = fileArgs ++ map toS (otherArgs args)
+  let (executable, fileParam) = case useSwarm args of
+        False -> ("docker-compose", "--file")
+        True -> ("docker", "--compose-file")
+      fileArgs = files args >>= \f -> [fileParam, f]
+      allArgs = case useSwarm args of
+            False -> fileArgs ++ map toS (otherArgs args)
+            True -> ["stack", "deploy"] ++ fileArgs ++ map toS (otherArgs args)
 
-      procSpec = proc "docker-compose" allArgs
+      procSpec = proc executable allArgs
 
   -- hPutStrLn stderr ("Running docker-compose with " <> show allArgs :: Text)