diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,12 @@ +## 0.3.8.0 +### Added +* `execWithInheritStdout` was added to `System.Hapistrano.Core` to stream output children's +to the parent's `stdout`. + +### Changed +* `playScript` and `playScriptLocally` use `execWithInheritStdout` to stream children's +stdout to parent's stdout. + ## 0.3.7.0 * Read `release-format` and `keep-releases` from the configuration file. diff --git a/hapistrano.cabal b/hapistrano.cabal --- a/hapistrano.cabal +++ b/hapistrano.cabal @@ -1,5 +1,5 @@ name: hapistrano -version: 0.3.7.0 +version: 0.3.8.0 synopsis: A deployment library for Haskell applications description: . @@ -56,8 +56,10 @@ , formatting >= 6.2 && < 7.0 , gitrev >= 1.2 && < 1.4 , mtl >= 2.0 && < 3.0 + , stm >= 2.0 && < 2.6 , path >= 0.5 && < 0.7 , process >= 1.4 && < 1.7 + , typed-process >= 0.2 && < 0.3 , time >= 1.5 && < 1.9 , transformers >= 0.4 && < 0.6 if flag(dev) @@ -106,6 +108,7 @@ , path-io >= 1.2 && < 1.5 , process >= 1.4 && < 1.7 , QuickCheck >= 2.5.1 && < 3.0 + , silently >= 1.2 && < 1.3 , temporary >= 1.1 && < 1.4 if flag(dev) ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Werror diff --git a/spec/System/HapistranoSpec.hs b/spec/System/HapistranoSpec.hs --- a/spec/System/HapistranoSpec.hs +++ b/spec/System/HapistranoSpec.hs @@ -14,6 +14,7 @@ import qualified System.Hapistrano.Commands as Hap import qualified System.Hapistrano.Core as Hap import System.Hapistrano.Types +import System.IO.Silently (capture_) import System.Info (os) import System.IO import Test.Hspec hiding (shouldBe, shouldReturn) @@ -26,6 +27,16 @@ spec :: Spec spec = do + describe "execWithInheritStdout" $ + context "given a command that prints to stdout" $ + it "redirects commands' output to stdout first" $ + let (Just commandTest) = Hap.mkGenericCommand "echo \"hapistrano\"; sleep 2; echo \"onartsipah\"" + commandExecution = Hap.execWithInheritStdout commandTest + expectedOutput = "hapistrano\nonartsipah\n*** localhost ******************************************************************\n$ echo \"hapistrano\"; sleep 2; echo \"onartsipah\"\n" + in do + actualOutput <- capture_ (runHap commandExecution) + actualOutput `Hspec.shouldBe` expectedOutput + describe "readScript" $ it "performs all the necessary normalizations correctly" $ do spath <- makeAbsolute $(mkRelFile "script/clean-build.sh") @@ -79,7 +90,6 @@ context "and the config file value is not present" $ it "returns the default value" $ fromMaybeKeepReleases Nothing Nothing `Hspec.shouldBe` 5 - around withSandbox $ do describe "pushRelease" $ do diff --git a/src/System/Hapistrano.hs b/src/System/Hapistrano.hs --- a/src/System/Hapistrano.hs +++ b/src/System/Hapistrano.hs @@ -136,7 +136,7 @@ -> Hapistrano () playScript deployDir release cmds = do rpath <- releasePath deployDir release - forM_ cmds (exec . Cd rpath) + forM_ cmds (execWithInheritStdout . Cd rpath) -- | Plays the given script on your machine locally. @@ -147,7 +147,7 @@ c { configSshOptions = Nothing }) $ - forM_ cmds exec + forM_ cmds execWithInheritStdout ---------------------------------------------------------------------------- -- Helpers diff --git a/src/System/Hapistrano/Core.hs b/src/System/Hapistrano/Core.hs --- a/src/System/Hapistrano/Core.hs +++ b/src/System/Hapistrano/Core.hs @@ -18,6 +18,7 @@ ( runHapistrano , failWith , exec + , execWithInheritStdout , scpFile , scpDir ) where @@ -25,12 +26,15 @@ import Control.Monad import Control.Monad.Except import Control.Monad.Reader +import Control.Concurrent.STM (atomically) import Data.Proxy import Path import System.Exit import System.Hapistrano.Commands import System.Hapistrano.Types import System.Process +import System.Process.Typed (ProcessConfig) +import qualified System.Process.Typed as SPT -- | Run the 'Hapistrano' monad. The monad hosts 'exec' actions. @@ -60,6 +64,9 @@ -- determined from settings contained in the 'Hapistrano' monad -- configuration. Commands that return non-zero exit codes will result in -- short-cutting of execution. +-- __NOTE:__ the commands executed with 'exec' will create their own pipe and +-- will stream output there and once the command finishes its execution it will +-- parse the result. exec :: forall a. Command a => a -> Hapistrano (Result a) exec typedCmd = do @@ -71,8 +78,37 @@ Just SshOptions {..} -> ("ssh", [sshHost, "-p", show sshPort, cmd]) cmd = renderCommand typedCmd - parseResult (Proxy :: Proxy a) <$> exec' prog args cmd + parseResult (Proxy :: Proxy a) <$> exec' cmd (readProcessWithExitCode prog args "") +-- | Same as 'exec' but it streams to stdout only for _GenericCommand_s + +execWithInheritStdout :: Command a => a -> Hapistrano () +execWithInheritStdout typedCmd = do + Config {..} <- ask + let (prog, args) = + case configSshOptions of + Nothing -> + ("bash", ["-c", cmd]) + Just SshOptions {..} -> + ("ssh", [sshHost, "-p", show sshPort, cmd]) + cmd = renderCommand typedCmd + void $ exec' cmd (readProcessWithExitCode' (SPT.proc prog args)) + where + -- | Prepares a process, reads @stdout@ and @stderr@ and returns exit code + -- NOTE: @strdout@ and @stderr@ are empty string because we're writing + -- the output to the parent. + readProcessWithExitCode' + :: ProcessConfig stdin stdoutIgnored stderrIgnored + -> IO (ExitCode, String, String) + readProcessWithExitCode' pc = + SPT.withProcess pc' $ \p -> atomically $ + (,,) <$> SPT.waitExitCodeSTM p + <*> return "" + <*> return "" + where + pc' = SPT.setStdout SPT.inherit + $ SPT.setStderr SPT.inherit pc + -- | Copy a file from local path to target server. scpFile @@ -108,7 +144,7 @@ Nothing -> "" Just x -> x ++ ":" args = extraArgs ++ portArg ++ [src, hostPrefix ++ dest] - void (exec' prog args (prog ++ " " ++ unwords args)) + void (exec' (prog ++ " " ++ unwords args) (readProcessWithExitCode prog args "")) ---------------------------------------------------------------------------- -- Helpers @@ -116,24 +152,22 @@ -- | A helper for 'exec' and similar functions. exec' - :: String -- ^ Name of program to run - -> [String] -- ^ Arguments to that program - -> String -- ^ How to show the command in print-outs + :: String -- ^ How to show the command in print-outs + -> IO (ExitCode, String, String) -- ^ Handler to get (ExitCode, Output, Error) it can change accordingly to @stdout@ and @stderr@ of child process -> Hapistrano String -- ^ Raw stdout output of that program -exec' prog args cmd = do +exec' cmd readProcessOutput = do Config {..} <- ask let hostLabel = case configSshOptions of Nothing -> "localhost" Just SshOptions {..} -> sshHost ++ ":" ++ show sshPort liftIO $ configPrint StdoutDest (putLine hostLabel ++ "$ " ++ cmd ++ "\n") - (exitCode, stdout', stderr') <- liftIO - (readProcessWithExitCode prog args "") + (exitCode', stdout', stderr') <- liftIO readProcessOutput unless (null stdout') . liftIO $ configPrint StdoutDest stdout' unless (null stderr') . liftIO $ configPrint StderrDest stderr' - case exitCode of + case exitCode' of ExitSuccess -> return stdout' ExitFailure n ->