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

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 ()

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

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

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

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.