feat: add --dry-run flag (#226)

app/Main.hs

@@ -61,6 +61,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
@@ -126,7 +131,7 @@ main = do
   let printFnc dest str = atomically $
         writeTChan chan (PrintMsg dest str)
       hap shell sshOpts executionMode = do
-        r <- Hap.runHapistrano sshOpts shell printFnc $
+        r <- Hap.runHapistrano optsDryRun sshOpts shell printFnc $
           case optsCommand of
             Deploy cliReleaseFormat cliKeepReleases cliKeepOneFailed ->
               Hap.deploy

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)

src/System/Hapistrano.hs

@@ -38,6 +38,7 @@ import           Control.Exception          (try)
 import           Control.Monad
 import           Control.Monad.Catch        (catch, throwM)
 import           Control.Monad.Except
+import           Control.Monad.IO.Class
 import           Control.Monad.Reader       (local)
 import           Data.List                  (dropWhileEnd, genericDrop, sortOn)
 import           Data.Maybe                 (fromMaybe, mapMaybe)
@@ -62,19 +63,21 @@ import           Text.Read                  (readMaybe)
 -- | 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

src/System/Hapistrano/Core.hs

@@ -138,23 +138,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
+  case configDryRun of
+    True -> do
+      liftIO $ configPrint StderrDest $ "[Dry run] " <> cmd
+      return ""
+    False -> 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

src/System/Hapistrano/Types.hs

@@ -81,6 +81,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
@@ -182,6 +183,7 @@ data MaintenanceOptions = Enable | Disable
 data Opts = Opts
   { optsCommand    :: Command
   , optsConfigFile :: FilePath
+  , optsDryRun     :: Bool
   }
 
 -- | Command to execute and command-specific options.