monad-unlift (empty) → 0.1.0.0
raw patch · 9 files changed
+860/−0 lines, 9 filesdep +basedep +constraintsdep +exceptionssetup-changed
Dependencies added: base, constraints, exceptions, monad-control, mtl, mutable-containers, stm, transformers, transformers-base
Files
- ChangeLog.md +3/−0
- Control/Monad/Trans/RWS/Ref.hs +212/−0
- Control/Monad/Trans/State/Ref.hs +153/−0
- Control/Monad/Trans/Unlift.hs +116/−0
- Control/Monad/Trans/Writer/Ref.hs +172/−0
- LICENSE +20/−0
- README.md +152/−0
- Setup.hs +2/−0
- monad-unlift.cabal +30/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+## 0.1.0.0++* Initial release
+ Control/Monad/Trans/RWS/Ref.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+-- | An implementation of @RWST@ built on top of mutable references,+-- providing a proper monad morphism.+--+-- An additional advantage of this transformer over the standard @RWST@+-- transformers in the transformers package is that it does not have space+-- leaks in the writer component. For more information, see+-- <https://mail.haskell.org/pipermail/libraries/2012-October/018599.html>.+module Control.Monad.Trans.RWS.Ref+ ( RWSRefT+ , runRWSRefT+ , runRWSIORefT+ , runRWSSTRefT+ , module Control.Monad.RWS.Class+ ) where++import Control.Applicative (Applicative (..))+import Control.Monad (ap, liftM)+import Control.Monad.Catch (MonadCatch (..), MonadMask (..),+ MonadThrow (..))+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.RWS.Class+import Control.Monad.Trans.Control (defaultLiftBaseWith,+ defaultRestoreM)+import Control.Monad.Trans.Unlift+import Data.Monoid (Monoid, mappend, mempty)+import Data.Mutable (IORef, MCState, MutableRef,+ PrimMonad, PrimState, RealWorld,+ RefElement, STRef, modifyRef',+ newRef, readRef, writeRef)++-- |+--+-- Since 0.1.0+newtype RWSRefT refw refs r w s m a = RWSRefT+ { unRWSRefT :: r -> refw w -> refs s -> m a+ }+ deriving Functor++-- |+--+-- Since 0.1.0+runRWSRefT+ :: ( Monad m+ , w ~ RefElement (refw w)+ , s ~ RefElement (refs s)+ , MCState (refw w) ~ PrimState b+ , MCState (refs s) ~ PrimState b+ , MonadBase b m+ , MutableRef (refw w)+ , MutableRef (refs s)+ , PrimMonad b+ , Monoid w+ )+ => RWSRefT refw refs r w s m a+ -> r+ -> s+ -> m (a, s, w)+runRWSRefT (RWSRefT f) r s0 = do+ (refw, refs) <- liftBase $ (,) `liftM` newRef mempty `ap` newRef s0+ a <- f r refw refs+ (w, s) <- liftBase $ (,) `liftM` readRef refw `ap` readRef refs+ return (a, s, w)+{-# INLINEABLE runRWSRefT #-}++-- |+--+-- Since 0.1.0+runRWSIORefT+ :: ( Monad m+ , RealWorld ~ PrimState b+ , MonadBase b m+ , PrimMonad b+ , Monoid w+ )+ => RWSRefT IORef IORef r w s m a+ -> r+ -> s+ -> m (a, s, w)+runRWSIORefT = runRWSRefT+{-# INLINE runRWSIORefT #-}++-- |+--+-- Since 0.1.0+runRWSSTRefT+ :: ( Monad m+ , ps ~ PrimState b+ , MonadBase b m+ , PrimMonad b+ , Monoid w+ )+ => RWSRefT (STRef ps) (STRef ps) r w s m a+ -> r+ -> s+ -> m (a, s, w)+runRWSSTRefT = runRWSRefT+{-# INLINE runRWSSTRefT #-}++instance Applicative m => Applicative (RWSRefT refw refs r w s m) where+ pure m = RWSRefT $ \_ _ _ -> pure m+ {-# INLINE pure #-}+ RWSRefT f <*> RWSRefT g = RWSRefT $ \x y z -> f x y z <*> g x y z+ {-# INLINE (<*>) #-}+instance Monad m => Monad (RWSRefT refw refs r w s m) where+ return m = RWSRefT $ \_ _ _ -> return m+ {-# INLINE return #-}+ RWSRefT f >>= g = RWSRefT $ \x y z -> do+ a <- f x y z+ unRWSRefT (g a) x y z+ {-# INLINE (>>=) #-}++instance Monad m => MonadReader r (RWSRefT refw refs r w s m) where+ ask = RWSRefT $ \r _ _ -> return r+ {-# INLINE ask #-}+ local f (RWSRefT g) = RWSRefT $ \r w s -> g (f r) w s+instance ( MCState (refw w) ~ PrimState b+ , Monad m+ , w ~ RefElement (refw w)+ , MutableRef (refw w)+ , PrimMonad b+ , MonadBase b m+ , Monoid w+ )+ => MonadWriter w (RWSRefT refw refs r w s m) where+ writer (a, w) = RWSRefT $ \_ ref _ ->+ liftBase $ modifyRef' ref (`mappend` w) >> return a+ {-# INLINE writer #-}+ tell w = RWSRefT $ \_ ref _ -> liftBase $ modifyRef' ref (`mappend` w)+ {-# INLINE tell #-}+ listen (RWSRefT f) = RWSRefT $ \r _ s -> do+ ref <- liftBase (newRef mempty)+ a <- f r ref s+ w <- liftBase (readRef ref)+ return (a, w)+ {-# INLINEABLE listen #-}+ pass (RWSRefT f) = RWSRefT $ \r ref s -> do+ (a, g) <- f r ref s+ liftBase $ modifyRef' ref g+ return a+ {-# INLINEABLE pass #-}+instance ( MCState (refs s) ~ PrimState b+ , Monad m+ , s ~ RefElement (refs s)+ , MutableRef (refs s)+ , PrimMonad b+ , MonadBase b m+ )+ => MonadState s (RWSRefT refw refs r w s m) where+ get = RWSRefT $ \_ _ -> liftBase . readRef+ {-# INLINE get #-}+ put x = seq x $ RWSRefT $ \_ _ -> liftBase . (`writeRef` x)+ {-# INLINE put #-}+instance ( MCState (refw w) ~ PrimState b+ , MCState (refs s) ~ PrimState b+ , Monad m+ , w ~ RefElement (refw w)+ , s ~ RefElement (refs s)+ , MutableRef (refw w)+ , MutableRef (refs s)+ , PrimMonad b+ , MonadBase b m+ , Monoid w+ )+ => MonadRWS r w s (RWSRefT refw refs r w s m)++instance MonadTrans (RWSRefT refw refs r w s) where+ lift f = RWSRefT $ \_ _ _ -> f+ {-# INLINE lift #-}+instance MonadIO m => MonadIO (RWSRefT refw refs r w s m) where+ liftIO = lift . liftIO+ {-# INLINE liftIO #-}+instance MonadBase b m => MonadBase b (RWSRefT refw refs r w s m) where+ liftBase = lift . liftBase+ {-# INLINE liftBase #-}++instance MonadTransControl (RWSRefT refw refs r w s) where+ type StT (RWSRefT refw refs r w s) a = a+ liftWith f = RWSRefT $ \r w s -> f $ \t -> unRWSRefT t r w s+ restoreT f = RWSRefT $ \_ _ _ -> f+ {-# INLINABLE liftWith #-}+ {-# INLINABLE restoreT #-}++instance MonadBaseControl b m => MonadBaseControl b (RWSRefT refw refs r w s m) where+ type StM (RWSRefT refw refs r w s m) a = StM m a+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINE liftBaseWith #-}+ {-# INLINE restoreM #-}++instance MonadThrow m => MonadThrow (RWSRefT refw refs r w s m) where+ throwM = lift . throwM+ {-# INLINE throwM #-}+instance MonadCatch m => MonadCatch (RWSRefT refw refs r w s m) where+ catch (RWSRefT f) g = RWSRefT $ \e w s -> catch (f e w s)+ ((\m -> unRWSRefT m e w s) . g)++instance MonadMask m => MonadMask (RWSRefT refw refs r w s m) where+ mask a = RWSRefT $ \e w s -> mask $ \u -> unRWSRefT (a $ q u) e w s+ where q :: (m a -> m a) -> RWSRefT refw refs r w s m a -> RWSRefT refw refs r w s m a+ q u (RWSRefT b) = RWSRefT (\r w s -> u (b r w s))+ {-# INLINE mask #-}+ uninterruptibleMask a =+ RWSRefT $ \e w s -> uninterruptibleMask $ \u -> unRWSRefT (a $ q u) e w s+ where q :: (m a -> m a) -> RWSRefT refw refs r w s m a -> RWSRefT refw refs r w s m a+ q u (RWSRefT b) = RWSRefT (\r w s -> u (b r w s))+ {-# INLINE uninterruptibleMask #-}
+ Control/Monad/Trans/State/Ref.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+-- | An implementation of @StateT@ built on top of mutable references,+-- providing a proper monad morphism.+module Control.Monad.Trans.State.Ref+ ( StateRefT+ , runStateRefT+ , runStateIORefT+ , runStateSTRefT+ , module Control.Monad.State.Class+ ) where++import Control.Applicative (Applicative (..))+import Control.Monad.Catch (MonadCatch (..), MonadMask (..),+ MonadThrow (..))+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.State.Class+import Control.Monad.Trans.Control (defaultLiftBaseWith,+ defaultRestoreM)+import Control.Monad.Trans.Unlift+import Data.Mutable (IORef, MCState, MutableRef,+ PrimMonad, PrimState, RealWorld,+ RefElement, STRef, newRef,+ readRef, writeRef)++-- |+--+-- Since 0.1.0+newtype StateRefT ref s m a = StateRefT+ { unStateRefT :: ref s -> m a+ }+ deriving Functor++-- |+--+-- Since 0.1.0+runStateRefT+ :: ( Monad m+ , s ~ RefElement (ref s)+ , MCState (ref s) ~ PrimState b+ , MonadBase b m+ , MutableRef (ref s)+ , PrimMonad b+ )+ => StateRefT ref s m a+ -> s+ -> m (a, s)+runStateRefT (StateRefT f) v0 = do+ ref <- liftBase $ newRef v0+ a <- f ref+ v <- liftBase $ readRef ref+ return (a, v)+{-# INLINEABLE runStateRefT #-}++-- |+--+-- Since 0.1.0+runStateIORefT+ :: ( Monad m+ , RealWorld ~ PrimState b+ , MonadBase b m+ , PrimMonad b+ )+ => StateRefT IORef s m a+ -> s+ -> m (a, s)+runStateIORefT = runStateRefT+{-# INLINE runStateIORefT #-}++-- |+--+-- Since 0.1.0+runStateSTRefT+ :: ( Monad m+ , ps ~ PrimState b+ , MonadBase b m+ , PrimMonad b+ )+ => StateRefT (STRef ps) s m a+ -> s+ -> m (a, s)+runStateSTRefT = runStateRefT+{-# INLINE runStateSTRefT #-}++instance Applicative m => Applicative (StateRefT ref s m) where+ pure = StateRefT . const . pure+ {-# INLINE pure #-}+ StateRefT f <*> StateRefT g = StateRefT $ \x -> f x <*> g x+ {-# INLINE (<*>) #-}+instance Monad m => Monad (StateRefT ref s m) where+ return = StateRefT . const . return+ {-# INLINE return #-}+ StateRefT f >>= g = StateRefT $ \x -> do+ a <- f x+ unStateRefT (g a) x+ {-# INLINE (>>=) #-}+instance ( MCState (ref s) ~ PrimState b+ , Monad m+ , s ~ RefElement (ref s)+ , MutableRef (ref s)+ , PrimMonad b+ , MonadBase b m+ )+ => MonadState s (StateRefT ref s m) where+ get = StateRefT $ liftBase . readRef+ {-# INLINE get #-}+ put x = seq x $ StateRefT $ liftBase . (`writeRef` x)+ {-# INLINE put #-}++instance MonadTrans (StateRefT ref s) where+ lift = StateRefT . const+ {-# INLINE lift #-}+instance MonadIO m => MonadIO (StateRefT ref s m) where+ liftIO = lift . liftIO+ {-# INLINE liftIO #-}+instance MonadBase b m => MonadBase b (StateRefT ref s m) where+ liftBase = lift . liftBase+ {-# INLINE liftBase #-}++instance MonadTransControl (StateRefT ref s) where+ type StT (StateRefT ref s) a = a+ liftWith f = StateRefT $ \r -> f $ \t -> unStateRefT t r+ restoreT = StateRefT . const+ {-# INLINABLE liftWith #-}+ {-# INLINABLE restoreT #-}++instance MonadBaseControl b m => MonadBaseControl b (StateRefT ref s m) where+ type StM (StateRefT ref s m) a = StM m a+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINE liftBaseWith #-}+ {-# INLINE restoreM #-}++instance MonadThrow m => MonadThrow (StateRefT ref s m) where+ throwM = lift . throwM+ {-# INLINE throwM #-}+instance MonadCatch m => MonadCatch (StateRefT ref s m) where+ catch (StateRefT f) g = StateRefT $ \e -> catch (f e) ((`unStateRefT` e) . g)++instance MonadMask m => MonadMask (StateRefT ref s m) where+ mask a = StateRefT $ \e -> mask $ \u -> unStateRefT (a $ q u) e+ where q :: (m a -> m a) -> StateRefT ref s m a -> StateRefT ref s m a+ q u (StateRefT b) = StateRefT (u . b)+ {-# INLINE mask #-}+ uninterruptibleMask a =+ StateRefT $ \e -> uninterruptibleMask $ \u -> unStateRefT (a $ q u) e+ where q :: (m a -> m a) -> StateRefT ref s m a -> StateRefT ref s m a+ q u (StateRefT b) = StateRefT (u . b)+ {-# INLINE uninterruptibleMask #-}
+ Control/Monad/Trans/Unlift.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+-- | See overview in the README.md+module Control.Monad.Trans.Unlift+ ( -- * Trans+ MonadTransUnlift+ , Unlift (..)+ , askUnlift+ , askRun+ -- * Base+ , MonadBaseUnlift+ , UnliftBase (..)+ , askUnliftBase+ , askRunBase+ -- * Reexports+ , MonadTrans (..)+ , MonadBase (..)+ , MonadTransControl (..)+ , MonadBaseControl (..)+ ) where++import Control.Monad (ap, liftM)+import Control.Monad.Base (MonadBase (..))+import Control.Monad.ST (ST)+import Control.Monad.STM (STM)+import Control.Monad.Trans.Class (MonadTrans (..))+import Control.Monad.Trans.Control (MonadBaseControl (..),+ MonadTransControl (..))+import Control.Monad.Trans.Reader (ReaderT)+import Data.Constraint ((:-), (\\))+import Data.Constraint.Forall (Forall, inst)+import Data.Functor.Identity (Identity)++-- | A function which can move an action down the monad transformer stack, by+-- providing any necessary environment to the action.+--+-- Note that, if ImpredicativeTypes worked reliably, this type wouldn't be+-- necessary, and 'askUnlift' would simply include a more generalized type.+--+-- Since 0.1.0+newtype Unlift t = Unlift { unlift :: forall a n. Monad n => t n a -> n a }++class (StT t a ~ a) => Identical t a+instance (StT t a ~ a) => Identical t a++-- | A monad transformer which can be unlifted, obeying the monad morphism laws.+--+-- Since 0.1.0+class (MonadTransControl t, Forall (Identical t)) => MonadTransUnlift t+instance (MonadTransControl t, Forall (Identical t)) => MonadTransUnlift t++mkUnlift :: forall t m a . (Forall (Identical t), Monad m)+ => (forall n b. Monad n => t n b -> n (StT t b)) -> t m a -> m a+mkUnlift r act = r act \\ (inst :: Forall (Identical t) :- Identical t a)++-- | Get the 'Unlift' action for the current transformer layer.+--+-- Since 0.1.0+askUnlift :: forall t m. (MonadTransUnlift t, Monad m) => t m (Unlift t)+askUnlift = liftWith unlifter+ where+ unlifter :: (forall n b. Monad n => t n b -> n (StT t b)) -> m (Unlift t)+ unlifter r = return $ Unlift (mkUnlift r)++-- | A simplified version of 'askUnlift' which addresses the common case where+-- polymorphism isn't necessary.+--+-- Since 0.1.0+askRun :: (MonadTransUnlift t, Monad (t m), Monad m) => t m (t m a -> m a)+askRun = liftM unlift askUnlift+{-# INLINE askRun #-}++-- | Similar to 'Unlift', but instead of moving one layer down the stack, moves+-- the action to the base monad.+--+-- Since 0.1.0+newtype UnliftBase b m = UnliftBase { unliftBase :: forall a. m a -> b a }++class (StM m a ~ a) => IdenticalBase m a+instance (StM m a ~ a) => IdenticalBase m a++-- | A monad transformer stack which can be unlifted, obeying the monad morphism laws.+--+-- Since 0.1.0+class (MonadBaseControl b m, Forall (IdenticalBase m)) => MonadBaseUnlift b m | m -> b+instance (MonadBaseControl b m, Forall (IdenticalBase m)) => MonadBaseUnlift b m++mkUnliftBase :: forall m a b. (Forall (IdenticalBase m), Monad b)+ => (forall c. m c -> b (StM m c)) -> m a -> b a+mkUnliftBase r act = r act \\ (inst :: Forall (IdenticalBase m) :- IdenticalBase m a)++-- | Get the 'UnliftBase' action for the current transformer stack.+--+-- Since 0.1.0+askUnliftBase :: forall b m. (MonadBaseUnlift b m) => m (UnliftBase b m)+askUnliftBase = liftBaseWith unlifter+ where+ unlifter :: (forall c. m c -> b (StM m c)) -> b (UnliftBase b m)+ unlifter r = return $ UnliftBase (mkUnliftBase r)++-- | A simplified version of 'askUnliftBase' which addresses the common case+-- where polymorphism isn't necessary.+--+-- Since 0.1.0+askRunBase :: (MonadBaseUnlift b m)+ => m (m a -> b a)+askRunBase = liftM unliftBase askUnliftBase+{-# INLINE askRunBase #-}
+ Control/Monad/Trans/Writer/Ref.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+-- | An implementation of @WriterT@ built on top of mutable references,+-- providing a proper monad morphism.+--+-- An additional advantage of this transformer over the standard @WriterT@+-- transformers in the transformers package is that it does not have space+-- leaks. For more information, see+-- <https://mail.haskell.org/pipermail/libraries/2012-October/018599.html>.+module Control.Monad.Trans.Writer.Ref+ ( WriterRefT+ , runWriterRefT+ , runWriterIORefT+ , runWriterSTRefT+ , module Control.Monad.Writer.Class+ ) where++import Control.Applicative (Applicative (..))+import Control.Monad.Catch (MonadCatch (..), MonadMask (..),+ MonadThrow (..))+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Control (defaultLiftBaseWith,+ defaultRestoreM)+import Control.Monad.Trans.Unlift+import Control.Monad.Writer.Class+import Data.Monoid (Monoid, mappend, mempty)+import Data.Mutable (IORef, MCState, MutableRef,+ PrimMonad, PrimState, RealWorld,+ RefElement, STRef, modifyRef',+ newRef, readRef, writeRef)++-- |+--+-- Since 0.1.0+newtype WriterRefT ref w m a = WriterRefT+ { unWriterRefT :: ref w -> m a+ }+ deriving Functor++-- |+--+-- Since 0.1.0+runWriterRefT+ :: ( Monad m+ , w ~ RefElement (ref w)+ , MCState (ref w) ~ PrimState b+ , MonadBase b m+ , MutableRef (ref w)+ , PrimMonad b+ , Monoid w+ )+ => WriterRefT ref w m a+ -> m (a, w)+runWriterRefT (WriterRefT f) = do+ ref <- liftBase $ newRef mempty+ a <- f ref+ v <- liftBase $ readRef ref+ return (a, v)+{-# INLINEABLE runWriterRefT #-}++-- |+--+-- Since 0.1.0+runWriterIORefT+ :: ( Monad m+ , RealWorld ~ PrimState b+ , MonadBase b m+ , PrimMonad b+ , Monoid w+ )+ => WriterRefT IORef w m a+ -> m (a, w)+runWriterIORefT = runWriterRefT+{-# INLINE runWriterIORefT #-}++-- |+--+-- Since 0.1.0+runWriterSTRefT+ :: ( Monad m+ , ps ~ PrimState b+ , MonadBase b m+ , PrimMonad b+ , Monoid w+ )+ => WriterRefT (STRef ps) w m a+ -> m (a, w)+runWriterSTRefT = runWriterRefT+{-# INLINE runWriterSTRefT #-}++instance Applicative m => Applicative (WriterRefT ref w m) where+ pure = WriterRefT . const . pure+ {-# INLINE pure #-}+ WriterRefT f <*> WriterRefT g = WriterRefT $ \x -> f x <*> g x+ {-# INLINE (<*>) #-}+instance Monad m => Monad (WriterRefT ref w m) where+ return = WriterRefT . const . return+ {-# INLINE return #-}+ WriterRefT f >>= g = WriterRefT $ \x -> do+ a <- f x+ unWriterRefT (g a) x+ {-# INLINE (>>=) #-}+instance ( MCState (ref w) ~ PrimState b+ , Monad m+ , w ~ RefElement (ref w)+ , MutableRef (ref w)+ , PrimMonad b+ , MonadBase b m+ , Monoid w+ )+ => MonadWriter w (WriterRefT ref w m) where+ writer (a, w) = WriterRefT $ \ref ->+ liftBase $ modifyRef' ref (`mappend` w) >> return a+ {-# INLINE writer #-}+ tell w = WriterRefT $ \ref -> liftBase $ modifyRef' ref (`mappend` w)+ {-# INLINE tell #-}+ listen (WriterRefT f) = lift $ do+ ref <- liftBase (newRef mempty)+ a <- f ref+ w <- liftBase (readRef ref)+ return (a, w)+ {-# INLINEABLE listen #-}+ pass (WriterRefT f) = WriterRefT $ \ref -> do+ (a, g) <- f ref+ liftBase $ modifyRef' ref g+ return a+ {-# INLINEABLE pass #-}++instance MonadTrans (WriterRefT ref w) where+ lift = WriterRefT . const+ {-# INLINE lift #-}+instance MonadIO m => MonadIO (WriterRefT ref w m) where+ liftIO = lift . liftIO+ {-# INLINE liftIO #-}+instance MonadBase b m => MonadBase b (WriterRefT ref w m) where+ liftBase = lift . liftBase+ {-# INLINE liftBase #-}++instance MonadTransControl (WriterRefT ref w) where+ type StT (WriterRefT ref w) a = a+ liftWith f = WriterRefT $ \r -> f $ \t -> unWriterRefT t r+ restoreT = WriterRefT . const+ {-# INLINABLE liftWith #-}+ {-# INLINABLE restoreT #-}++instance MonadBaseControl b m => MonadBaseControl b (WriterRefT ref w m) where+ type StM (WriterRefT ref w m) a = StM m a+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINE liftBaseWith #-}+ {-# INLINE restoreM #-}++instance MonadThrow m => MonadThrow (WriterRefT ref w m) where+ throwM = lift . throwM+ {-# INLINE throwM #-}+instance MonadCatch m => MonadCatch (WriterRefT ref w m) where+ catch (WriterRefT f) g = WriterRefT $ \e -> catch (f e) ((`unWriterRefT` e) . g)++instance MonadMask m => MonadMask (WriterRefT ref w m) where+ mask a = WriterRefT $ \e -> mask $ \u -> unWriterRefT (a $ q u) e+ where q :: (m a -> m a) -> WriterRefT ref w m a -> WriterRefT ref w m a+ q u (WriterRefT b) = WriterRefT (u . b)+ {-# INLINE mask #-}+ uninterruptibleMask a =+ WriterRefT $ \e -> uninterruptibleMask $ \u -> unWriterRefT (a $ q u) e+ where q :: (m a -> m a) -> WriterRefT ref w m a -> WriterRefT ref w m a+ q u (WriterRefT b) = WriterRefT (u . b)+ {-# INLINE uninterruptibleMask #-}
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Michael Snoyman++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,152 @@+## monad-unlift++A common pattern is to have some kind of a monad transformer, and want to pass+an action into a function that requires actions in a base monad. That sounds a+bit abstract, so let's give a concrete example:++```haskell+-- From async+concurrently :: IO a -> IO b -> IO (a, b)++func1 :: ReaderT Foo IO String+func2 :: ReaderT Foo IO Double++doBoth :: ReaderT Foo IO (String, Double)+doBoth = _+```++Doing this manually is possible, but a bit tedious:++```haskell+doBoth :: ReaderT Foo IO (String, Double)+doBoth = ReaderT $ \foo -> concurrently+ (runReaderT func1 foo)+ (runReaderT func2 foo)+```++This also doesn't generalize at all; you'll be stuck writing `concurrently`+variants for every monad transformer stack. Fortunately, the `monad-control`+package generalizes this to a large number of transformer stacks. Let's+implement our generalized `concurrently`:++```haskell+concurrentlyG :: MonadBaseControl IO m+ => m a -> m b -> m (StM m a, StM m b)+concurrentlyG f g = liftBaseWith $ \run ->+ concurrently (run f) (run g)+```++Notice how, in the signature for `concurrentlyG`, we no longer return `(a, b)`,+but `(StM m a, StM m b)`. This is because there may be additional monadic+context for each thread of execution, and we have no way of merging these+together in general. Some examples of context are:++* With `WriterT`, it's the values that you called `tell` on+* With `EitherT`, the returned value may not exist at all++In addition to this difficulty, many people find the types in `monad-control`+difficult to navigate, due to their extreme generality (which is in fact the+power of that package!).++There is a subset of these transformer stacks that are in fact [monad+morphisms](http://www.stackage.org/package/mmorph). Simply stated, these are+transformer stacks that are isomorphic to `ReaderT`. For these monads, there is+not context in the returned value. Therefore, there's no need to combine+returned states or deal with possibly missing values.++This concept is represented by the monad-unlift package, which provides a pair of typeclasses for these kinds of transformer stacks. Before we dive in, let's see how we solve our `concurrentlyG` problem with it:++```haskell+concurrentlyG :: MonadBaseUnlift IO m+ => m a -> m b -> m (a, b)+concurrentlyG f g = do+ UnliftBase run <- askUnliftBase+ liftBase $ concurrently (run f) (run g)+```++Notice how we get `(a, b)` in the return type as desired. There's no need to+unwrap values are deal with context.++### MonadTransUnlift++`MonadTransUnlift` is a class for any monad transformer which is isomorphic+to `ReaderT`, in the sense that the environment can be captured and applied+later. Some interesting cases in this space are:++* `IdentityT` and things isomorphic to it; in this case, you can think of the environment as being `()`+* Transformers which contain a mutable reference in their environment. This allows them to behave like stateful transformers (e.g., `StateT` or `WriterT`), but still behave the monad morphism laws. (See below for more details.)++Due to weaknesses in GHC's ImpredicativeTypes, we have a helper datatype to+allow for getting polymorphic unlift functions, appropriately named `Unlift`.+For many common cases, you can get away with using `askRun` instead, e.g.:++```haskell+bar :: ReaderT Foo IO ()++baz :: ReaderT Foo IO ()+baz = do+ run <- askRun+ liftIO $ void $ forkIO $ run bar+```++Using `Unlift`, this would instead be:++```haskell+ Unlift run <- askUnlift+ liftIO $ void $ forkIO $ run bar+```++or equivalently:++```haskell+ u <- askUnlift+ liftIO $ void $ forkIO $ unlift u bar+```++### MonadBaseUnlift++`MonadBaseUnlift` extends this concept to entire transformer stacks. This is+typically the typeclass that people end up using. You can think of these two+typeclasses in exactly the same way as `MonadTrans` and `MonadIO`, or more+precisely `MonadTrans` and `MonadBase`.++For the same ImpredicativeTypes reason, there's a helper type `UnliftBase`.+Everything we just discussed should transfer directly to `MonadBaseUnlift`,+so learning something new isn't necessary. For example, you can rewrite the+last snippet as:++```haskell+ u <- askUnliftBase+ liftIO $ void $ forkIO $ unliftBase u bar+```++### Reference transformers++When playing transformer stack games with a transformer like `StateT`, it's+common to accidentally discard state modifications. Additionally, in the case+of runtime exceptions, it's usually impossible to retain the state. (Similar+statements apply to `WriterT` and `RWST`, both in strict and lazy variants.)++Another approach is to use a `ReaderT` and hold onto a mutable reference. This+is problematic since there's no built in support for operations like `get`,+`put`, or `tell`. What we want is to have a `MonadState` and/or `MonadWriter`+instance.++To address this case, this package includes variants of those transformers that+use mutable references. These reference are generic using the+[mutable-containers](http://www.stackage.org/package/mutable-containers)+package, which allows you to have highly efficient references like `PRef`+instead of always using boxed references like `IORef`.++### conduit++The `transPipe` function in conduit has caused confusion in the past due to its+requirement of provided functions to obey monad morphism laws. This package+makes a good companion to conduit to simplify that function's usage.++### Other notable instances++Both the `HandlerT` transformer from yesod-core and `LoggingT`/`NoLoggingT` are+valid monad morphisms. `HandlerT` is in fact my first example of using the+"enviornment holding a mutable reference" technique to overcome exceptions+destroying state.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ monad-unlift.cabal view
@@ -0,0 +1,30 @@+name: monad-unlift+version: 0.1.0.0+synopsis: Typeclasses for representing monad transformer unlifting+description: See README.md+homepage: https://github.com/fpco/monad-unlift+license: MIT+license-file: LICENSE+author: Michael Snoyman+maintainer: michael@fpcomplete.com+copyright: FP Complete+category: Control+build-type: Simple+extra-source-files: README.md ChangeLog.md+cabal-version: >=1.10++library+ exposed-modules: Control.Monad.Trans.Unlift+ Control.Monad.Trans.State.Ref+ Control.Monad.Trans.Writer.Ref+ Control.Monad.Trans.RWS.Ref+ build-depends: base >= 4.6 && < 5+ , monad-control >= 1.0 && < 1.1+ , transformers+ , mtl+ , transformers-base+ , mutable-containers >= 0.3 && < 0.4+ , exceptions >= 0.6+ , stm+ , constraints+ default-language: Haskell2010