From ff5065834a9dc8fe8a2c30feb3fd7a327f8536f6 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Thu, 26 Dec 2019 01:34:52 +0100 Subject: Add configuration for default Yosys location --- src/Verismith/Result.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'src/Verismith/Result.hs') 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 -- cgit