diff options
Diffstat (limited to 'src/Verismith/Result.hs')
| -rw-r--r-- | src/Verismith/Result.hs | 14 |
1 files changed, 13 insertions, 1 deletions
diff --git a/src/Verismith/Result.hs b/src/Verismith/Result.hs index 2ecb728..78c8dd6 100644 --- a/src/Verismith/Result.hs +++ b/src/Verismith/Result.hs @@ -29,13 +29,15 @@ module Verismith.Result ) where +import Control.Monad (liftM) import Control.Monad.Base import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.Control import Data.Bifunctor (Bifunctor (..)) import Shelly (RunFailed (..), Sh, catch_sh) -import Shelly.Lifted (MonadSh, liftSh) +import Shelly.Lifted (MonadSh, MonadShControl, ShM, + liftSh, liftShWith, restoreSh) -- | Result type which is equivalent to 'Either' or 'Error'. This is -- reimplemented so that there is full control over the 'Monad' definition and @@ -134,6 +136,16 @@ instance MonadBaseControl IO m => MonadBaseControl IO (ResultT a m) where {-# INLINABLE liftBaseWith #-} {-# INLINABLE restoreM #-} +instance (MonadShControl m) + => MonadShControl (ResultT a m) where + newtype ShM (ResultT a m) b = ResultTShM (ShM m (Result a b)) + liftShWith f = + ResultT $ liftM return $ liftShWith $ \runInSh -> f $ \k -> + liftM ResultTShM $ runInSh $ runResultT k + restoreSh (ResultTShM m) = ResultT . restoreSh $ m + {-# INLINE liftShWith #-} + {-# INLINE restoreSh #-} + infix 0 <?> (<?>) :: (Monad m, Monoid a) => ResultT a m b -> a -> ResultT a m b |