Catch IO exceptions thrown during command execution

1 files changed, 7 insertions, 1 deletions

diff --git a/main/Main.hs b/main/Main.hs
index 5dbad60..d94c9dd 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -5,6 +5,7 @@ module Main (main) where
 
 import Control.Arrow (first)
 import Control.Concurrent
+import Control.Exception
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
@@ -265,11 +266,16 @@ data CommandContext = NoContext
                     | SelectedContact Contact
 
 newtype CommandM a = CommandM (ReaderT CommandInput (StateT CommandState (ExceptT String IO)) a)
-    deriving (Functor, Applicative, Monad, MonadIO, MonadReader CommandInput, MonadState CommandState, MonadError String)
+    deriving (Functor, Applicative, Monad, MonadReader CommandInput, MonadState CommandState, MonadError String)
 
 instance MonadFail CommandM where
     fail = throwError
 
+instance MonadIO CommandM where
+    liftIO act = CommandM (liftIO (try act)) >>= \case
+        Left (e :: SomeException) -> throwError (show e)
+        Right x -> return x
+
 instance MonadRandom CommandM where
     getRandomBytes = liftIO . getRandomBytes