hapistrano 0.3.7.0 → 0.3.8.0

raw patch · 5 files changed

+69/−13 lines, 5 filesdep +silentlydep +typed-processdep ~stmPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: silently, typed-process

Dependency ranges changed: stm

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• hapistrano.cabal +4/−1
• spec/System/HapistranoSpec.hs +11/−1
• src/System/Hapistrano.hs +2/−2
• src/System/Hapistrano/Core.hs +43/−9

@@ -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. 

@@ -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

@@ -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

@@ -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

@@ -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 ->