monad-control 0.3.2.3 → 0.3.3.0
raw patch · 2 files changed
+126/−108 lines, 2 filesdep −base-unicode-symbolsdep ~transformersdep ~transformers-base
Dependencies removed: base-unicode-symbols
Dependency ranges changed: transformers, transformers-base
Files
- Control/Monad/Trans/Control.hs +123/−104
- monad-control.cabal +3/−4
Control/Monad/Trans/Control.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP- , UnicodeSyntax , NoImplicitPrelude , RankNTypes , TypeFamilies@@ -12,6 +11,11 @@ {-# LANGUAGE Trustworthy #-} #endif +#if MIN_VERSION_transformers(0,4,0)+-- Hide warnings for the deprecated ErrorT transformer:+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+#endif+ {- | Module : Control.Monad.Trans.Control Copyright : Bas van Dijk, Anders Kaseorg@@ -50,7 +54,7 @@ -------------------------------------------------------------------------------- -- from base:-import Data.Function ( ($), const )+import Data.Function ( (.), ($), const ) import Data.Monoid ( Monoid, mempty ) import Control.Monad ( Monad, (>>=), return, liftM ) import System.IO ( IO )@@ -66,9 +70,6 @@ import qualified Control.Monad.ST.Strict as Strict ( ST ) #endif --- from base-unicode-symbols:-import Data.Function.Unicode ( (∘) )- -- from transformers: import Control.Monad.Trans.Class ( MonadTrans ) @@ -81,6 +82,10 @@ import Control.Monad.Trans.Writer ( WriterT (WriterT), runWriterT ) import Control.Monad.Trans.RWS ( RWST (RWST), runRWST ) +#if MIN_VERSION_transformers(0,4,0)+import Control.Monad.Trans.Except ( ExceptT (ExceptT), runExceptT )+#endif+ import qualified Control.Monad.Trans.RWS.Strict as Strict ( RWST (RWST), runRWST ) import qualified Control.Monad.Trans.State.Strict as Strict ( StateT (StateT), runStateT ) import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT(WriterT), runWriterT )@@ -94,7 +99,7 @@ import Control.Monad ( void ) #else import Data.Functor (Functor, fmap)-void ∷ Functor f ⇒ f a → f ()+void :: Functor f => f a -> f () void = fmap (const ()) #endif @@ -102,9 +107,9 @@ -- MonadTransControl type class -------------------------------------------------------------------------------- -class MonadTrans t ⇒ MonadTransControl t where+class MonadTrans t => MonadTransControl t where -- | Monadic state of @t@.- data StT t ∷ * → *+ data StT t :: * -> * -- | @liftWith@ is similar to 'lift' in that it lifts a computation from -- the argument monad to the constructed monad.@@ -119,7 +124,7 @@ -- @liftWith@ captures the state of @t@. It then provides the @m@ -- computation with a 'Run' function that allows running @t n@ computations in -- @n@ (for all @n@) on the captured state.- liftWith ∷ Monad m ⇒ (Run t → m a) → t m a+ liftWith :: Monad m => (Run t -> m a) -> t m a -- | Construct a @t@ computation from the monadic state of @t@ that is -- returned from a 'Run' function.@@ -127,7 +132,7 @@ -- Instances should satisfy: -- -- @liftWith (\\run -> run t) >>= restoreT . return = t@- restoreT ∷ Monad m ⇒ m (StT t a) → t m a+ restoreT :: Monad m => m (StT t a) -> t m a -- | A function that runs a transformed monad @t n@ on the monadic state that -- was captured by 'liftWith'@@ -135,7 +140,7 @@ -- A @Run t@ function yields a computation in @n@ that returns the monadic state -- of @t@. This state can later be used to restore a @t@ computation using -- 'restoreT'.-type Run t = ∀ n b. Monad n ⇒ t n b → n (StT t b)+type Run t = forall n b. Monad n => t n b -> n (StT t b) --------------------------------------------------------------------------------@@ -159,21 +164,22 @@ -- @ -- | Default definition for the 'liftWith' method.-defaultLiftWith ∷ (Monad m, MonadTransControl n)- ⇒ (∀ b. n m b → t m b) -- ^ Monad constructor- → (∀ o b. t o b → n o b) -- ^ Monad deconstructor- → (∀ b. StT n b → StT t b) -- ^ 'StT' constructor- → (Run t → m a)- → t m a-defaultLiftWith t unT stT = \f → t $ liftWith $ \run → f $ liftM stT ∘ run ∘ unT+defaultLiftWith :: (Monad m, MonadTransControl n)+ => (forall b. n m b -> t m b) -- ^ Monad constructor+ -> (forall o b. t o b -> n o b) -- ^ Monad deconstructor+ -> (forall b. StT n b -> StT t b) -- ^ 'StT' constructor+ -> (Run t -> m a)+ -> t m a+defaultLiftWith t unT stT = \f -> t $ liftWith $ \run ->+ f $ liftM stT . run . unT {-# INLINE defaultLiftWith #-} -defaultRestoreT ∷ (Monad m, MonadTransControl n)- ⇒ (n m a → t m a) -- ^ Monad constructor- → (StT t a → StT n a) -- ^ 'StT' deconstructor- → m (StT t a)- → t m a-defaultRestoreT t unStT = t ∘ restoreT ∘ liftM unStT+defaultRestoreT :: (Monad m, MonadTransControl n)+ => (n m a -> t m a) -- ^ Monad constructor+ -> (StT t a -> StT n a) -- ^ 'StT' deconstructor+ -> m (StT t a)+ -> t m a+defaultRestoreT t unStT = t . restoreT . liftM unStT {-# INLINE defaultRestoreT #-} @@ -182,88 +188,97 @@ -------------------------------------------------------------------------------- instance MonadTransControl IdentityT where- newtype StT IdentityT a = StId {unStId ∷ a}- liftWith f = IdentityT $ f $ liftM StId ∘ runIdentityT- restoreT = IdentityT ∘ liftM unStId+ newtype StT IdentityT a = StId {unStId :: a}+ liftWith f = IdentityT $ f $ liftM StId . runIdentityT+ restoreT = IdentityT . liftM unStId {-# INLINE liftWith #-} {-# INLINE restoreT #-} instance MonadTransControl MaybeT where- newtype StT MaybeT a = StMaybe {unStMaybe ∷ Maybe a}- liftWith f = MaybeT $ liftM return $ f $ liftM StMaybe ∘ runMaybeT- restoreT = MaybeT ∘ liftM unStMaybe+ newtype StT MaybeT a = StMaybe {unStMaybe :: Maybe a}+ liftWith f = MaybeT $ liftM return $ f $ liftM StMaybe . runMaybeT+ restoreT = MaybeT . liftM unStMaybe {-# INLINE liftWith #-} {-# INLINE restoreT #-} -instance Error e ⇒ MonadTransControl (ErrorT e) where- newtype StT (ErrorT e) a = StError {unStError ∷ Either e a}- liftWith f = ErrorT $ liftM return $ f $ liftM StError ∘ runErrorT- restoreT = ErrorT ∘ liftM unStError+instance Error e => MonadTransControl (ErrorT e) where+ newtype StT (ErrorT e) a = StError {unStError :: Either e a}+ liftWith f = ErrorT $ liftM return $ f $ liftM StError . runErrorT+ restoreT = ErrorT . liftM unStError {-# INLINE liftWith #-} {-# INLINE restoreT #-} +#if MIN_VERSION_transformers(0,4,0)+instance MonadTransControl (ExceptT e) where+ newtype StT (ExceptT e) a = StExcept {unStExcept :: Either e a}+ liftWith f = ExceptT $ liftM return $ f $ liftM StExcept . runExceptT+ restoreT = ExceptT . liftM unStExcept+ {-# INLINE liftWith #-}+ {-# INLINE restoreT #-}+#endif+ instance MonadTransControl ListT where- newtype StT ListT a = StList {unStList ∷ [a]}- liftWith f = ListT $ liftM return $ f $ liftM StList ∘ runListT- restoreT = ListT ∘ liftM unStList+ newtype StT ListT a = StList {unStList :: [a]}+ liftWith f = ListT $ liftM return $ f $ liftM StList . runListT+ restoreT = ListT . liftM unStList {-# INLINE liftWith #-} {-# INLINE restoreT #-} instance MonadTransControl (ReaderT r) where- newtype StT (ReaderT r) a = StReader {unStReader ∷ a}- liftWith f = ReaderT $ \r → f $ \t → liftM StReader $ runReaderT t r- restoreT = ReaderT ∘ const ∘ liftM unStReader+ newtype StT (ReaderT r) a = StReader {unStReader :: a}+ liftWith f = ReaderT $ \r -> f $ \t -> liftM StReader $ runReaderT t r+ restoreT = ReaderT . const . liftM unStReader {-# INLINE liftWith #-} {-# INLINE restoreT #-} instance MonadTransControl (StateT s) where- newtype StT (StateT s) a = StState {unStState ∷ (a, s)}- liftWith f = StateT $ \s →- liftM (\x → (x, s))- (f $ \t → liftM StState $ runStateT t s)- restoreT = StateT ∘ const ∘ liftM unStState+ newtype StT (StateT s) a = StState {unStState :: (a, s)}+ liftWith f = StateT $ \s ->+ liftM (\x -> (x, s))+ (f $ \t -> liftM StState $ runStateT t s)+ restoreT = StateT . const . liftM unStState {-# INLINE liftWith #-} {-# INLINE restoreT #-} instance MonadTransControl (Strict.StateT s) where- newtype StT (Strict.StateT s) a = StState' {unStState' ∷ (a, s)}- liftWith f = Strict.StateT $ \s →- liftM (\x → (x, s))- (f $ \t → liftM StState' $ Strict.runStateT t s)- restoreT = Strict.StateT ∘ const ∘ liftM unStState'+ newtype StT (Strict.StateT s) a = StState' {unStState' :: (a, s)}+ liftWith f = Strict.StateT $ \s ->+ liftM (\x -> (x, s))+ (f $ \t -> liftM StState' $ Strict.runStateT t s)+ restoreT = Strict.StateT . const . liftM unStState' {-# INLINE liftWith #-} {-# INLINE restoreT #-} -instance Monoid w ⇒ MonadTransControl (WriterT w) where- newtype StT (WriterT w) a = StWriter {unStWriter ∷ (a, w)}- liftWith f = WriterT $ liftM (\x → (x, mempty))- (f $ liftM StWriter ∘ runWriterT)- restoreT = WriterT ∘ liftM unStWriter+instance Monoid w => MonadTransControl (WriterT w) where+ newtype StT (WriterT w) a = StWriter {unStWriter :: (a, w)}+ liftWith f = WriterT $ liftM (\x -> (x, mempty))+ (f $ liftM StWriter . runWriterT)+ restoreT = WriterT . liftM unStWriter {-# INLINE liftWith #-} {-# INLINE restoreT #-} -instance Monoid w ⇒ MonadTransControl (Strict.WriterT w) where- newtype StT (Strict.WriterT w) a = StWriter' {unStWriter' ∷ (a, w)}- liftWith f = Strict.WriterT $ liftM (\x → (x, mempty))- (f $ liftM StWriter' ∘ Strict.runWriterT)- restoreT = Strict.WriterT ∘ liftM unStWriter'+instance Monoid w => MonadTransControl (Strict.WriterT w) where+ newtype StT (Strict.WriterT w) a = StWriter' {unStWriter' :: (a, w)}+ liftWith f = Strict.WriterT $ liftM (\x -> (x, mempty))+ (f $ liftM StWriter' . Strict.runWriterT)+ restoreT = Strict.WriterT . liftM unStWriter' {-# INLINE liftWith #-} {-# INLINE restoreT #-} -instance Monoid w ⇒ MonadTransControl (RWST r w s) where- newtype StT (RWST r w s) a = StRWS {unStRWS ∷ (a, s, w)}- liftWith f = RWST $ \r s → liftM (\x → (x, s, mempty))- (f $ \t → liftM StRWS $ runRWST t r s)- restoreT mSt = RWST $ \_ _ → liftM unStRWS mSt+instance Monoid w => MonadTransControl (RWST r w s) where+ newtype StT (RWST r w s) a = StRWS {unStRWS :: (a, s, w)}+ liftWith f = RWST $ \r s -> liftM (\x -> (x, s, mempty))+ (f $ \t -> liftM StRWS $ runRWST t r s)+ restoreT mSt = RWST $ \_ _ -> liftM unStRWS mSt {-# INLINE liftWith #-} {-# INLINE restoreT #-} -instance Monoid w ⇒ MonadTransControl (Strict.RWST r w s) where- newtype StT (Strict.RWST r w s) a = StRWS' {unStRWS' ∷ (a, s, w)}+instance Monoid w => MonadTransControl (Strict.RWST r w s) where+ newtype StT (Strict.RWST r w s) a = StRWS' {unStRWS' :: (a, s, w)} liftWith f =- Strict.RWST $ \r s → liftM (\x → (x, s, mempty))- (f $ \t → liftM StRWS' $ Strict.runRWST t r s)- restoreT mSt = Strict.RWST $ \_ _ → liftM unStRWS' mSt+ Strict.RWST $ \r s -> liftM (\x -> (x, s, mempty))+ (f $ \t -> liftM StRWS' $ Strict.runRWST t r s)+ restoreT mSt = Strict.RWST $ \_ _ -> liftM unStRWS' mSt {-# INLINE liftWith #-} {-# INLINE restoreT #-} @@ -272,9 +287,9 @@ -- MonadBaseControl type class -------------------------------------------------------------------------------- -class MonadBase b m ⇒ MonadBaseControl b m | m → b where+class MonadBase b m => MonadBaseControl b m | m -> b where -- | Monadic state of @m@.- data StM m ∷ * → *+ data StM m :: * -> * -- | @liftBaseWith@ is similar to 'liftIO' and 'liftBase' in that it -- lifts a base computation to the constructed monad.@@ -289,7 +304,7 @@ -- @liftBaseWith@ captures the state of @m@. It then provides the base -- computation with a 'RunInBase' function that allows running @m@ -- computations in the base monad on the captured state.- liftBaseWith ∷ (RunInBase m b → b a) → m a+ liftBaseWith :: (RunInBase m b -> b a) -> m a -- | Construct a @m@ computation from the monadic state of @m@ that is -- returned from a 'RunInBase' function.@@ -297,7 +312,7 @@ -- Instances should satisfy: -- -- @liftBaseWith (\\runInBase -> runInBase m) >>= restoreM = m@- restoreM ∷ StM m a → m a+ restoreM :: StM m a -> m a -- | A function that runs a @m@ computation on the monadic state that was -- captured by 'liftBaseWith'@@ -305,7 +320,7 @@ -- A @RunInBase m@ function yields a computation in the base monad of @m@ that -- returns the monadic state of @m@. This state can later be used to restore the -- @m@ computation using 'restoreM'.-type RunInBase m b = ∀ a. m a → b (StM m a)+type RunInBase m b = forall a. m a -> b (StM m a) --------------------------------------------------------------------------------@@ -324,7 +339,7 @@ BASE(Maybe, St) BASE(Either e, StE) BASE([], StL)-BASE((→) r, StF)+BASE((->) r, StF) BASE(Identity, StI) #if MIN_VERSION_base(4,3,0)@@ -379,21 +394,21 @@ -- 'liftBaseWith' $ \\runInBase -> -- f $ liftM stM . runInBase . run -- @-defaultLiftBaseWith ∷ (MonadTransControl t, MonadBaseControl b m)- ⇒ (∀ c. ComposeSt t m c → StM (t m) c) -- ^ 'StM' constructor- → ((RunInBase (t m) b → b a) → t m a)-defaultLiftBaseWith stM = \f → liftWith $ \run →- liftBaseWith $ \runInBase →- f $ liftM stM ∘ runInBase ∘ run+defaultLiftBaseWith :: (MonadTransControl t, MonadBaseControl b m)+ => (forall c. ComposeSt t m c -> StM (t m) c) -- ^ 'StM' constructor+ -> ((RunInBase (t m) b -> b a) -> t m a)+defaultLiftBaseWith stM = \f -> liftWith $ \run ->+ liftBaseWith $ \runInBase ->+ f $ liftM stM . runInBase . run {-# INLINE defaultLiftBaseWith #-} -- | Default definition for the 'restoreM' method. -- -- Note that: @defaultRestoreM unStM = 'restoreT' . 'restoreM' . unStM@-defaultRestoreM ∷ (MonadTransControl t, MonadBaseControl b m)- ⇒ (StM (t m) a → ComposeSt t m a) -- ^ 'StM' deconstructor- → (StM (t m) a → t m a)-defaultRestoreM unStM = restoreT ∘ restoreM ∘ unStM+defaultRestoreM :: (MonadTransControl t, MonadBaseControl b m)+ => (StM (t m) a -> ComposeSt t m a) -- ^ 'StM' deconstructor+ -> (StM (t m) a -> t m a)+defaultRestoreM unStM = restoreT . restoreM . unStM {-# INLINE defaultRestoreM #-} @@ -401,17 +416,17 @@ -- MonadBaseControl transformer instances -------------------------------------------------------------------------------- -#define BODY(T, ST, unST) { \- newtype StM (T m) a = ST {unST ∷ ComposeSt (T) m a}; \- liftBaseWith = defaultLiftBaseWith ST; \- restoreM = defaultRestoreM unST; \- {-# INLINE liftBaseWith #-}; \+#define BODY(T, ST, unST) { \+ newtype StM (T m) a = ST {unST :: ComposeSt (T) m a}; \+ liftBaseWith = defaultLiftBaseWith ST; \+ restoreM = defaultRestoreM unST; \+ {-# INLINE liftBaseWith #-}; \ {-# INLINE restoreM #-}} #define TRANS( T, ST, unST) \- instance ( MonadBaseControl b m) ⇒ MonadBaseControl b (T m) where BODY(T, ST, unST)+ instance ( MonadBaseControl b m) => MonadBaseControl b (T m) where BODY(T, ST, unST) #define TRANS_CTX(CTX, T, ST, unST) \- instance (CTX, MonadBaseControl b m) ⇒ MonadBaseControl b (T m) where BODY(T, ST, unST)+ instance (CTX, MonadBaseControl b m) => MonadBaseControl b (T m) where BODY(T, ST, unST) TRANS(IdentityT, StMId, unStMId) TRANS(MaybeT, StMMaybe, unStMMaybe)@@ -420,6 +435,10 @@ TRANS(Strict.StateT s, StMStateS, unStMStateS) TRANS( StateT s, StMState, unStMState) +#if MIN_VERSION_transformers(0,4,0)+TRANS(ExceptT e, StMExcept, unStMExcept)+#endif+ TRANS_CTX(Error e, ErrorT e, StMError, unStMError) TRANS_CTX(Monoid w, Strict.WriterT w, StMWriterS, unStMWriterS) TRANS_CTX(Monoid w, WriterT w, StMWriter, unStMWriter)@@ -432,7 +451,7 @@ -------------------------------------------------------------------------------- -- | An often used composition: @control f = 'liftBaseWith' f >>= 'restoreM'@-control ∷ MonadBaseControl b m ⇒ (RunInBase m b → b (StM m a)) → m a+control :: MonadBaseControl b m => (RunInBase m b -> b (StM m a)) -> m a control f = liftBaseWith f >>= restoreM {-# INLINE control #-} @@ -444,10 +463,10 @@ -- For example: -- -- @liftBaseOp alloca :: 'MonadBaseControl' 'IO' m => (Ptr a -> m c) -> m c@-liftBaseOp ∷ MonadBaseControl b m- ⇒ ((a → b (StM m c)) → b (StM m d))- → ((a → m c) → m d)-liftBaseOp f = \g → control $ \runInBase → f $ runInBase ∘ g+liftBaseOp :: MonadBaseControl b m+ => ((a -> b (StM m c)) -> b (StM m d))+ -> ((a -> m c) -> m d)+liftBaseOp f = \g -> control $ \runInBase -> f $ runInBase . g {-# INLINE liftBaseOp #-} -- | @liftBaseOp_@ is a particular application of 'liftBaseWith' that allows@@ -458,10 +477,10 @@ -- For example: -- -- @liftBaseOp_ mask_ :: 'MonadBaseControl' 'IO' m => m a -> m a@-liftBaseOp_ ∷ MonadBaseControl b m- ⇒ (b (StM m a) → b (StM m c))- → ( m a → m c)-liftBaseOp_ f = \m → control $ \runInBase → f $ runInBase m+liftBaseOp_ :: MonadBaseControl b m+ => (b (StM m a) -> b (StM m c))+ -> ( m a -> m c)+liftBaseOp_ f = \m -> control $ \runInBase -> f $ runInBase m {-# INLINE liftBaseOp_ #-} -- | @liftBaseDiscard@ is a particular application of 'liftBaseWith' that allows@@ -476,6 +495,6 @@ -- For example: -- -- @liftBaseDiscard forkIO :: 'MonadBaseControl' 'IO' m => m () -> m ThreadId@-liftBaseDiscard ∷ MonadBaseControl b m ⇒ (b () → b a) → (m () → m a)-liftBaseDiscard f = \m → liftBaseWith $ \runInBase → f $ void $ runInBase m+liftBaseDiscard :: MonadBaseControl b m => (b () -> b a) -> (m () -> m a)+liftBaseDiscard f = \m -> liftBaseWith $ \runInBase -> f $ void $ runInBase m {-# INLINE liftBaseDiscard #-}
monad-control.cabal view
@@ -1,5 +1,5 @@ Name: monad-control-Version: 0.3.2.3+Version: 0.3.3.0 Synopsis: Lift control operations, like exception catching, through monad transformers License: BSD3 License-file: LICENSE@@ -52,8 +52,7 @@ Exposed-modules: Control.Monad.Trans.Control Build-depends: base >= 3 && < 5- , base-unicode-symbols >= 0.1.1 && < 0.3- , transformers >= 0.2 && < 0.4- , transformers-base >= 0.4.1 && < 0.5+ , transformers >= 0.2 && < 0.5+ , transformers-base >= 0.4.2 && < 0.5 Ghc-options: -Wall