Moved exception handler from runHapistrano to main

app/Main.hs

@@ -26,6 +26,8 @@ import qualified System.Hapistrano.Config   as C
 import qualified System.Hapistrano.Core     as Hap
 import           System.Hapistrano.Types
 import           System.IO
+import System.Hapistrano (createHapistranoDeployState)
+import Control.Monad.Error.Class (throwError, catchError)
 
 ----------------------------------------------------------------------------
 
@@ -119,6 +121,10 @@ main = do
   let task rf = Task { taskDeployPath    = configDeployPath
                      , taskSource        = configSource
                      , taskReleaseFormat = rf }
+  let failStateAndThrow e@(_, maybeRelease) =
+        case maybeRelease of
+          (Just release) -> createHapistranoDeployState configDeployPath release Fail >> throwError e
+          Nothing -> throwError e
   let printFnc dest str = atomically $
         writeTChan chan (PrintMsg dest str)
       hap shell sshOpts = do
@@ -160,6 +166,7 @@ main = do
             Rollback n -> do
               Hap.rollback configTargetSystem configDeployPath n
               forM_ configRestartCommand (flip Hap.exec Nothing)
+          `catchError` failStateAndThrow
         atomically (writeTChan chan FinishMsg)
         return r
       printer :: Int -> IO ()

hapistrano.cabal

@@ -82,6 +82,7 @@ executable hap
                      , formatting         >= 6.2 && < 8.0
                      , gitrev             >= 1.2 && < 1.4
                      , hapistrano
+                     , mtl                >= 2.0 && < 3.0
                      , optparse-applicative >= 0.11 && < 0.17
                      , path               >= 0.5 && < 0.9
                      , path-io            >= 1.2 && < 1.7

src/System/Hapistrano.hs

@@ -46,7 +46,6 @@ import           Path
 import           System.Hapistrano.Commands
 import           System.Hapistrano.Core
 import           System.Hapistrano.Types
-import qualified System.Hapistrano.Config as C
 
 ----------------------------------------------------------------------------
 
@@ -56,11 +55,10 @@ runHapistrano ::
   => Maybe SshOptions -- ^ SSH options to use or 'Nothing' if we run locally
   -> Shell -- ^ Shell to run commands
   -> (OutputDest -> String -> IO ()) -- ^ How to print messages
-  -> C.Config -- ^ Config file options
   -> 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 C.Config{..} m =
+runHapistrano sshOptions shell' printFnc m =
   liftIO $ do
     let config =
           Config
@@ -68,17 +66,18 @@ runHapistrano sshOptions shell' printFnc C.Config{..} m =
             , configShellOptions = shell'
             , configPrint = printFnc
             }
-    r <- runReaderT (runExceptT $ m `catchError` failStateAndThrow) config
+    r <- runReaderT (runExceptT m) config
+    -- r <- runReaderT (runExceptT $ m `catchError` failStateAndThrow) config
     case r of
       Left (Failure n msg, _) -> do
         forM_ msg (printFnc StderrDest)
         return (Left n)
       Right x -> return (Right x)
-    where
-      failStateAndThrow e@(_, maybeRelease) =
-        case maybeRelease of
-          (Just release) -> createHapistranoDeployState configDeployPath release Fail >> throwError e
-          Nothing -> throwError e
+    -- where
+    --   failStateAndThrow e@(_, maybeRelease) =
+    --     case maybeRelease of
+    --       (Just release) -> createHapistranoDeployState configDeployPath release Fail >> throwError e
+    --       Nothing -> throwError e
 
 -- High-level functionality