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