git.iko.soy/obelisk
on master help sign in
Merge pull request #85 from obsidiansystems/sr-ob-deploy-spinner
1ceabcaLuigy Leon
lib/command/src/Obelisk/CLI/Process.hs−1
compare with master
unifiedsplit
@@ -87,7 +87,6 @@ withProcess
87 => CreateProcess -> (Handle -> Handle -> m ()) -> m (Handle, Handle)
87 => CreateProcess -> (Handle -> Handle -> m ()) -> m (Handle, Handle)
88withProcess process f = do
88withProcess process f = do
89 let procTitle = T.pack $ show $ cmdspec process
89 let procTitle = T.pack $ show $ cmdspec process
90− putLog Debug $ "Starting process: " <> procTitle
91 (_, Just out, Just err, p) <- createProcess $ process
90 (_, Just out, Just err, p) <- createProcess $ process
92 { std_out = CreatePipe
91 { std_out = CreatePipe
93 , std_err = CreatePipe
92 , std_err = CreatePipe
lib/command/src/Obelisk/Command/Deploy.hs+24−22
@@ -16,12 +16,11 @@ import Data.Monoid
16import qualified Data.Text as T
16import qualified Data.Text as T
17import qualified Data.Text.IO as T
17import qualified Data.Text.IO as T
18import System.Directory
18import System.Directory
19−import System.Exit (ExitCode (..))
20import System.FilePath
19import System.FilePath
21−import System.Process
20+import System.Process (delegate_ctlc, env, proc, readProcess)
22
21
23import Obelisk.App (MonadObelisk)
22import Obelisk.App (MonadObelisk)
24−import Obelisk.CLI (Severity (..), callProcessAndLogOutput, failWith)
23+import Obelisk.CLI (Severity (..), callProcessAndLogOutput, failWith, withSpinner)
25import Obelisk.Command.Nix
24import Obelisk.Command.Nix
26import Obelisk.Command.Thunk
25import Obelisk.Command.Thunk
27import Obelisk.Command.Utils
26import Obelisk.Command.Utils
@@ -77,31 +76,34 @@ deployPush deployPath = do
77 _ <- failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."
76 _ <- failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."
78 return Nothing
77 return Nothing
79 _ -> return Nothing
78 _ -> return Nothing
80− liftIO $ forM_ result $ \res -> do
79+ forM_ result $ \res -> do
81 let deployAndSwitch outputPath sshAgentEnv = do
80 let deployAndSwitch outputPath sshAgentEnv = do
81+ withSpinner "Adding ssh key" $ do
82− callProcess' (Just sshAgentEnv) "ssh-add" [deployPath </> "ssh_key"]
82+ callProcess' (Just sshAgentEnv) "ssh-add" [deployPath </> "ssh_key"]
83+ withSpinner "Uploading closure" $ do
83− callProcess' (Just sshAgentEnv) "nix-copy-closure" ["-v", "--to", "root@" <> host, "--gzip", outputPath]
84+ callProcess' (Just sshAgentEnv) "nix-copy-closure" ["-v", "--to", "root@" <> host, "--gzip", outputPath]
85+ withSpinner "Switching to new configuration" $ do
84− callProcess' (Just sshAgentEnv) "ssh"
86+ callProcess' (Just sshAgentEnv) "ssh"
85− [ "root@" <> host
87+ [ "root@" <> host
86− , unwords
88+ , unwords
87− [ "nix-env -p /nix/var/nix/profiles/system --set " <> outputPath
89+ [ "nix-env -p /nix/var/nix/profiles/system --set " <> outputPath
88− , "&&"
90+ , "&&"
89− , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"
91+ , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"
90− ]
92+ ]
91− ]
93+ ]
92− sshAgentEnv <- sshAgent
94+ sshAgentEnv <- liftIO sshAgent
93 deployAndSwitch res sshAgentEnv `finally` callProcess' (Just sshAgentEnv) "ssh-agent" ["-k"]
95 deployAndSwitch res sshAgentEnv `finally` callProcess' (Just sshAgentEnv) "ssh-agent" ["-k"]
94− isClean <- checkGitCleanStatus deployPath
96+ isClean <- liftIO $ checkGitCleanStatus deployPath
95 when (not isClean) $ do
97 when (not isClean) $ do
98+ withSpinner "Commiting changes to Git" $ do
99+ callProcessAndLogOutput (Debug, Error) $ proc "git"
96− callProcess "git" ["-C", deployPath, "add", "--update"]
100+ ["-C", deployPath, "add", "--update"]
101+ callProcessAndLogOutput (Debug, Error) $ proc "git"
97− callProcess "git" ["-C", deployPath, "commit", "-m", "New deployment"]
102+ ["-C", deployPath, "commit", "-m", "New deployment"]
98 where
103 where
99 callProcess' e cmd args = do
104 callProcess' e cmd args = do
100 let p = (proc cmd args) { delegate_ctlc = True, env = e }
105 let p = (proc cmd args) { delegate_ctlc = True, env = e }
101− exit_code <- withCreateProcess p $ \_ _ _ ph -> waitForProcess ph
106+ callProcessAndLogOutput (Notice, Notice) p
102− case exit_code of
103− ExitSuccess -> return ()
104− ExitFailure r -> fail $ "callProcess'" <> "(exit: " <> show r <> ")"
105
107
106deployUpdate :: MonadObelisk m => FilePath -> m ()
108deployUpdate :: MonadObelisk m => FilePath -> m ()
107deployUpdate deployPath = updateThunkToLatest $ deployPath </> "src"
109deployUpdate deployPath = updateThunkToLatest $ deployPath </> "src"