From c93e766b2dbe0e3ae3761ec33cee027f27145108 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Thu, 18 Apr 2024 20:45:56 +0200
Subject: Catch IO exceptions thrown during command execution

---
 main/Main.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

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
 
-- 
cgit v1.2.3