diff --git a/app/Main.hs b/app/Main.hs index 6f4c892a..947bad77 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -63,6 +63,11 @@ optionParser = Opts <> metavar "PATH" <> showDefault <> help "Configuration file to use" ) + <*> flag + False + True + ( long "dry-run" + <> help "Display command (without running them)" ) deployParser :: Parser Command deployParser = Deploy @@ -153,7 +158,7 @@ runHapCmd Opts{..} hapCmd = do let printFnc dest str = atomically $ writeTChan chan (PrintMsg dest str) hap shell sshOpts executionMode = do - r <- Hap.runHapistrano sshOpts shell printFnc $ hapCmd hapConfig executionMode + r <- Hap.runHapistrano optsDryRun sshOpts shell printFnc $ hapCmd hapConfig executionMode atomically (writeTChan chan FinishMsg) return r printer :: Int -> IO () diff --git a/spec/System/HapistranoSpec.hs b/spec/System/HapistranoSpec.hs index 4832d47b..4c081a9e 100644 --- a/spec/System/HapistranoSpec.hs +++ b/spec/System/HapistranoSpec.hs @@ -469,7 +469,7 @@ runHapWithShell shell m = do case dest of StdoutDest -> putStr str StderrDest -> hPutStr stderr str - r <- Hap.runHapistrano Nothing shell printFnc m + r <- Hap.runHapistrano False Nothing shell printFnc m case r of Left n -> do expectationFailure ("Failed with status code: " ++ show n) diff --git a/src/System/Hapistrano.hs b/src/System/Hapistrano.hs index 77764d73..1a63a783 100644 --- a/src/System/Hapistrano.hs +++ b/src/System/Hapistrano.hs @@ -70,19 +70,21 @@ import qualified Text.Megaparsec.Char as M -- | Run the 'Hapistrano' monad. The monad hosts 'exec' actions. runHapistrano :: MonadIO m - => Maybe SshOptions -- ^ SSH options to use or 'Nothing' if we run locally + => Bool -- ^ Is running in dry run + -> Maybe SshOptions -- ^ SSH options to use or 'Nothing' if we run locally -> Shell -- ^ Shell to run commands -> (OutputDest -> String -> IO ()) -- ^ How to print messages -> Hapistrano a -- ^ The computation to run -> m (Either Int a) -- ^ Status code in 'Left' on failure, result in -- 'Right' on success -runHapistrano sshOptions shell' printFnc m = +runHapistrano isDryRun sshOptions shell' printFnc m = liftIO $ do let config = Config { configSshOptions = sshOptions , configShellOptions = shell' , configPrint = printFnc + , configDryRun = isDryRun } r <- try @HapistranoException $ unHapistrano m config case r of diff --git a/src/System/Hapistrano/Core.hs b/src/System/Hapistrano/Core.hs index e22e08b2..041f800e 100644 --- a/src/System/Hapistrano/Core.hs +++ b/src/System/Hapistrano/Core.hs @@ -137,23 +137,28 @@ exec' :: -> Hapistrano String -- ^ Raw stdout output of that program exec' cmd readProcessOutput maybeRelease = do Config {..} <- ask - time <- liftIO getZonedTime - let timeStampFormat = "%T, %F (%Z)" - printableTime = formatTime defaultTimeLocale timeStampFormat time - hostLabel = - case configSshOptions of - Nothing -> "localhost" - Just SshOptions {..} -> sshHost ++ ":" ++ show sshPort - hostInfo = colorizeString Blue $ putLine hostLabel - timestampInfo = colorizeString Cyan ("[" ++ printableTime ++ "] INFO -- : $ ") - cmdInfo = colorizeString Green (cmd ++ "\n") - liftIO $ configPrint StdoutDest (hostInfo ++ timestampInfo ++ cmdInfo) - (exitCode', stdout', stderr') <- liftIO readProcessOutput - unless (null stdout') . liftIO $ configPrint StdoutDest stdout' - unless (null stderr') . liftIO $ configPrint StderrDest stderr' - case exitCode' of - ExitSuccess -> return stdout' - ExitFailure n -> failWith n Nothing maybeRelease + if configDryRun + then do + liftIO $ configPrint StderrDest $ "[Dry run] " <> cmd + return "" + else do + time <- liftIO getZonedTime + let timeStampFormat = "%T, %F (%Z)" + printableTime = formatTime defaultTimeLocale timeStampFormat time + hostLabel = + case configSshOptions of + Nothing -> "localhost" + Just SshOptions {..} -> sshHost ++ ":" ++ show sshPort + hostInfo = colorizeString Blue $ putLine hostLabel + timestampInfo = colorizeString Cyan ("[" ++ printableTime ++ "] INFO -- : $ ") + cmdInfo = colorizeString Green (cmd ++ "\n") + liftIO $ configPrint StdoutDest (hostInfo ++ timestampInfo ++ cmdInfo) + (exitCode', stdout', stderr') <- liftIO readProcessOutput + unless (null stdout') . liftIO $ configPrint StdoutDest stdout' + unless (null stderr') . liftIO $ configPrint StderrDest stderr' + case exitCode' of + ExitSuccess -> return stdout' + ExitFailure n -> failWith n Nothing maybeRelease -- | Put something “inside” a line, sort-of beautifully. putLine :: String -> String diff --git a/src/System/Hapistrano/Types.hs b/src/System/Hapistrano/Types.hs index 46218cf3..be4e33ad 100644 --- a/src/System/Hapistrano/Types.hs +++ b/src/System/Hapistrano/Types.hs @@ -88,6 +88,7 @@ data Config = -- ^ One of the supported 'Shell's , configPrint :: !(OutputDest -> String -> IO ()) -- ^ How to print messages + , configDryRun :: !Bool } -- | The source of the repository. It can be from a version control provider @@ -189,6 +190,7 @@ data MaintenanceOptions = Enable | Disable data Opts = Opts { optsCommand :: Command , optsConfigFile :: FilePath + , optsDryRun :: Bool } -- | Command to execute and command-specific options.