packages feed

transformers 0.5.5.2 → 0.5.6.0

raw patch · 20 files changed

+740/−21 lines, 20 filesdep ~base

Dependency ranges changed: base

Files

Control/Monad/Trans/Accum.hs view
@@ -192,8 +192,10 @@         ~(b, w'') <- runAccumT (k a) (w `mappend` w')         return (b, w' `mappend` w'')     {-# INLINE (>>=) #-}+#if !(MIN_VERSION_base(4,13,0))     fail msg = AccumT $ const (fail msg)     {-# INLINE fail #-}+#endif  #if MIN_VERSION_base(4,9,0) instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (AccumT w m) where
Control/Monad/Trans/Error.hs view
@@ -238,7 +238,9 @@         case a of             Left  l -> return (Left l)             Right r -> runErrorT (k r)+#if !(MIN_VERSION_base(4,13,0))     fail msg = ErrorT $ return (Left (strMsg msg))+#endif  #if MIN_VERSION_base(4,9,0) instance (Monad m, Error e) => Fail.MonadFail (ErrorT e m) where
Control/Monad/Trans/Except.hs view
@@ -80,8 +80,8 @@  -- | Constructor for computations in the exception monad. -- (The inverse of 'runExcept').-except :: Either e a -> Except e a-except m = ExceptT (Identity m)+except :: (Monad m) => Either e a -> ExceptT e m a+except m = ExceptT (return m) {-# INLINE except #-}  -- | Extractor for computations in the exception monad.@@ -220,8 +220,10 @@             Left e -> return (Left e)             Right x -> runExceptT (k x)     {-# INLINE (>>=) #-}+#if !(MIN_VERSION_base(4,13,0))     fail = ExceptT . fail     {-# INLINE fail #-}+#endif  #if MIN_VERSION_base(4,9,0) instance (Fail.MonadFail m) => Fail.MonadFail (ExceptT e m) where
Control/Monad/Trans/Identity.hs view
@@ -124,8 +124,10 @@ #endif     m >>= k = IdentityT $ runIdentityT . k =<< runIdentityT m     {-# INLINE (>>=) #-}+#if !(MIN_VERSION_base(4,13,0))     fail msg = IdentityT $ fail msg     {-# INLINE fail #-}+#endif  #if MIN_VERSION_base(4,9,0) instance (Fail.MonadFail m) => Fail.MonadFail (IdentityT m) where
Control/Monad/Trans/List.hs view
@@ -123,8 +123,10 @@         b <- mapM (runListT . k) a         return (concat b)     {-# INLINE (>>=) #-}+#if !(MIN_VERSION_base(4,13,0))     fail _ = ListT $ return []     {-# INLINE fail #-}+#endif  #if MIN_VERSION_base(4,9,0) instance (Monad m) => Fail.MonadFail (ListT m) where@@ -143,8 +145,8 @@  instance (MonadFix m) => MonadFix (ListT m) where     mfix f = ListT $ mfix (runListT . f . head) >>= \ xs -> case xs of-        [] -> return []-        x:_ -> liftM (x:) (runListT (mfix (mapListT (liftM tail) . f)))+        [] -> pure []+        x:_ -> (x:) <$> (runListT . mfix) ((mapListT . fmap) tail . f)     {-# INLINE mfix #-}  instance MonadTrans ListT where
Control/Monad/Trans/Maybe.hs view
@@ -167,8 +167,10 @@             Nothing -> return Nothing             Just y  -> runMaybeT (f y)     {-# INLINE (>>=) #-}+#if !(MIN_VERSION_base(4,13,0))     fail _ = MaybeT (return Nothing)     {-# INLINE fail #-}+#endif  #if MIN_VERSION_base(4,9,0) instance (Monad m) => Fail.MonadFail (MaybeT m) where
Control/Monad/Trans/RWS.hs view
@@ -14,8 +14,8 @@ -- Portability :  portable -- -- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'.--- This version is lazy; for a strict version, see--- "Control.Monad.Trans.RWS.Strict", which has the same interface.+-- This version is lazy; for a constant-space version with almost the+-- same interface, see "Control.Monad.Trans.RWS.CPS". -----------------------------------------------------------------------------  module Control.Monad.Trans.RWS (
+ Control/Monad/Trans/RWS/CPS.hs view
@@ -0,0 +1,406 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Safe #-}+#endif+#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE AutoDeriveTypeable #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Trans.RWS.CPS+-- Copyright   :  (c) Daniel Mendler 2016,+--                (c) Andy Gill 2001,+--                (c) Oregon Graduate Institute of Science and Technology, 2001+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  R.Paterson@city.ac.uk+-- Stability   :  experimental+-- Portability :  portable+--+-- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'.+-- This version uses continuation-passing-style for the writer part+-- to achieve constant space usage.+-- For a lazy version with the same interface,+-- see "Control.Monad.Trans.RWS.Lazy".+-----------------------------------------------------------------------------+  +module Control.Monad.Trans.RWS.CPS (+    -- * The RWS monad+    RWS,+    rws,+    runRWS,+    evalRWS,+    execRWS,+    mapRWS,+    withRWS,+    -- * The RWST monad transformer+    RWST,+    rwsT,+    runRWST,+    evalRWST,+    execRWST,+    mapRWST,+    withRWST,+    -- * Reader operations+    reader,+    ask,+    local,+    asks,+    -- * Writer operations+    writer,+    tell,+    listen,+    listens,+    pass,+    censor,+    -- * State operations+    state,+    get,+    put,+    modify,+    gets,+    -- * Lifting other operations+    liftCallCC,+    liftCallCC',+    liftCatch,+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Signatures+import Data.Functor.Identity++#if !(MIN_VERSION_base(4,8,0))+import Data.Monoid+#endif++#if MIN_VERSION_base(4,9,0)+import qualified Control.Monad.Fail as Fail+#endif++-- | A monad containing an environment of type @r@, output of type @w@+-- and an updatable state of type @s@.+type RWS r w s = RWST r w s Identity++-- | Construct an RWS computation from a function.+-- (The inverse of 'runRWS'.)+rws :: (Monoid w) => (r -> s -> (a, s, w)) -> RWS r w s a+rws f = RWST $ \ r s w ->+    let (a, s', w') = f r s; wt = w `mappend` w' in wt `seq` return (a, s', wt)+{-# INLINE rws #-}++-- | Unwrap an RWS computation as a function.+-- (The inverse of 'rws'.)+runRWS :: (Monoid w) => RWS r w s a -> r -> s -> (a, s, w)+runRWS m r s = runIdentity (runRWST m r s)+{-# INLINE runRWS #-}++-- | Evaluate a computation with the given initial state and environment,+-- returning the final value and output, discarding the final state.+evalRWS :: (Monoid w)+        => RWS r w s a  -- ^RWS computation to execute+        -> r            -- ^initial environment+        -> s            -- ^initial value+        -> (a, w)       -- ^final value and output+evalRWS m r s = let+    (a, _, w) = runRWS m r s+    in (a, w)+{-# INLINE evalRWS #-}++-- | Evaluate a computation with the given initial state and environment,+-- returning the final state and output, discarding the final value.+execRWS :: (Monoid w)+        => RWS r w s a  -- ^RWS computation to execute+        -> r            -- ^initial environment+        -> s            -- ^initial value+        -> (s, w)       -- ^final state and output+execRWS m r s = let+    (_, s', w) = runRWS m r s+    in (s', w)+{-# INLINE execRWS #-}++-- | Map the return value, final state and output of a computation using+-- the given function.+--+-- * @'runRWS' ('mapRWS' f m) r s = f ('runRWS' m r s)@+mapRWS :: (Monoid w, Monoid w') => ((a, s, w) -> (b, s, w')) -> RWS r w s a -> RWS r w' s b+mapRWS f = mapRWST (Identity . f . runIdentity)+{-# INLINE mapRWS #-}++-- | @'withRWS' f m@ executes action @m@ with an initial environment+-- and state modified by applying @f@.+--+-- * @'runRWS' ('withRWS' f m) r s = 'uncurry' ('runRWS' m) (f r s)@+withRWS :: (r' -> s -> (r, s)) -> RWS r w s a -> RWS r' w s a+withRWS = withRWST+{-# INLINE withRWS #-}++-- ---------------------------------------------------------------------------+-- | A monad transformer adding reading an environment of type @r@,+-- collecting an output of type @w@ and updating a state of type @s@+-- to an inner monad @m@.+newtype RWST r w s m a = RWST { unRWST :: r -> s -> w -> m (a, s, w) }++-- | Construct an RWST computation from a function.+-- (The inverse of 'runRWST'.)+rwsT :: (Functor m, Monoid w) => (r -> s -> m (a, s, w)) -> RWST r w s m a+rwsT f = RWST $ \ r s w ->+     (\ (a, s', w') -> let wt = w `mappend` w' in wt `seq` (a, s', wt)) <$> f r s+{-# INLINE rwsT #-}++-- | Unwrap an RWST computation as a function.+-- (The inverse of 'rwsT'.)+runRWST :: (Monoid w) => RWST r w s m a -> r -> s -> m (a, s, w)+runRWST m r s = unRWST m r s mempty+{-# INLINE runRWST #-}++-- | Evaluate a computation with the given initial state and environment,+-- returning the final value and output, discarding the final state.+evalRWST :: (Monad m, Monoid w)+         => RWST r w s m a      -- ^computation to execute+         -> r                   -- ^initial environment+         -> s                   -- ^initial value+         -> m (a, w)            -- ^computation yielding final value and output+evalRWST m r s = do+    (a, _, w) <- runRWST m r s+    return (a, w)+{-# INLINE evalRWST #-}++-- | Evaluate a computation with the given initial state and environment,+-- returning the final state and output, discarding the final value.+execRWST :: (Monad m, Monoid w)+         => RWST r w s m a      -- ^computation to execute+         -> r                   -- ^initial environment+         -> s                   -- ^initial value+         -> m (s, w)            -- ^computation yielding final state and output+execRWST m r s = do+    (_, s', w) <- runRWST m r s+    return (s', w)+{-# INLINE execRWST #-}++-- | Map the inner computation using the given function.+--+-- * @'runRWST' ('mapRWST' f m) r s = f ('runRWST' m r s)@+--mapRWST :: (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b+mapRWST :: (Monad n, Monoid w, Monoid w') =>+    (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b+mapRWST f m = RWST $ \ r s w -> do+    (a, s', w') <- f (runRWST m r s)+    let wt = w `mappend` w'+    wt `seq` return (a, s', wt)+{-# INLINE mapRWST #-}++-- | @'withRWST' f m@ executes action @m@ with an initial environment+-- and state modified by applying @f@.+--+-- * @'runRWST' ('withRWST' f m) r s = 'uncurry' ('runRWST' m) (f r s)@+withRWST :: (r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a+withRWST f m = RWST $ \ r s -> uncurry (unRWST m) (f r s)+{-# INLINE withRWST #-}++instance (Functor m) => Functor (RWST r w s m) where+    fmap f m = RWST $ \ r s w -> (\ (a, s', w') -> (f a, s', w')) <$> unRWST m r s w+    {-# INLINE fmap #-}++instance (Functor m, Monad m) => Applicative (RWST r w s m) where+    pure a = RWST $ \ _ s w -> return (a, s, w)+    {-# INLINE pure #-}++    RWST mf <*> RWST mx = RWST $ \ r s w -> do+        (f, s', w')    <- mf r s w+        (x, s'', w'') <- mx r s' w'+        return (f x, s'', w'')+    {-# INLINE (<*>) #-}++instance (Functor m, MonadPlus m) => Alternative (RWST r w s m) where+    empty = RWST $ \ _ _ _ -> mzero+    {-# INLINE empty #-}++    RWST m <|> RWST n = RWST $ \ r s w -> m r s w `mplus` n r s w+    {-# INLINE (<|>) #-}++instance (Monad m) => Monad (RWST r w s m) where+#if !(MIN_VERSION_base(4,8,0))+    return a = RWST $ \ _ s w -> return (a, s, w)+    {-# INLINE return #-}+#endif++    m >>= k = RWST $ \ r s w -> do+        (a, s', w')    <- unRWST m r s w+        unRWST (k a) r s' w'+    {-# INLINE (>>=) #-}++#if !(MIN_VERSION_base(4,13,0))+    fail msg = RWST $ \ _ _ _ -> fail msg+    {-# INLINE fail #-}+#endif++#if MIN_VERSION_base(4,9,0)+instance (Fail.MonadFail m) => Fail.MonadFail (RWST r w s m) where+    fail msg = RWST $ \ _ _ _ -> Fail.fail msg+    {-# INLINE fail #-}+#endif++instance (Functor m, MonadPlus m) => MonadPlus (RWST r w s m) where+    mzero = empty+    {-# INLINE mzero #-}+    mplus = (<|>)+    {-# INLINE mplus #-}++instance (MonadFix m) => MonadFix (RWST r w s m) where+    mfix f = RWST $ \ r s w -> mfix $ \ ~(a, _, _) -> unRWST (f a) r s w+    {-# INLINE mfix #-}++instance MonadTrans (RWST r w s) where+    lift m = RWST $ \ _ s w -> do+        a <- m+        return (a, s, w)+    {-# INLINE lift #-}++instance (MonadIO m) => MonadIO (RWST r w s m) where+    liftIO = lift . liftIO+    {-# INLINE liftIO #-}+-- ---------------------------------------------------------------------------+-- Reader operations++-- | Constructor for computations in the reader monad (equivalent to 'asks').+reader :: (Monad m) => (r -> a) -> RWST r w s m a+reader = asks+{-# INLINE reader #-}++-- | Fetch the value of the environment.+ask :: (Monad m) => RWST r w s m r+ask = asks id+{-# INLINE ask #-}++-- | Execute a computation in a modified environment+--+-- * @'runRWST' ('local' f m) r s = 'runRWST' m (f r) s@+local :: (r -> r) -> RWST r w s m a -> RWST r w s m a+local f m = RWST $ \ r s w -> unRWST m (f r) s w+{-# INLINE local #-}++-- | Retrieve a function of the current environment.+--+-- * @'asks' f = 'liftM' f 'ask'@+asks :: (Monad m) => (r -> a) -> RWST r w s m a+asks f = RWST $ \ r s w -> return (f r, s, w)+{-# INLINE asks #-}++-- ---------------------------------------------------------------------------+-- Writer operations++-- | Construct a writer computation from a (result, output) pair.+writer :: (Monoid w, Monad m) => (a, w) -> RWST r w s m a+writer (a, w') = RWST $ \ _ s w -> let wt = w `mappend` w' in wt `seq` return (a, s, wt)+{-# INLINE writer #-}++-- | @'tell' w@ is an action that produces the output @w@.+tell :: (Monoid w, Monad m) => w -> RWST r w s m ()+tell w' = writer ((), w')+{-# INLINE tell #-}++-- | @'listen' m@ is an action that executes the action @m@ and adds its+-- output to the value of the computation.+--+-- * @'runRWST' ('listen' m) r s = 'liftM' (\\ (a, w) -> ((a, w), w)) ('runRWST' m r s)@+listen :: (Monoid w, Monad m) => RWST r w s m a -> RWST r w s m (a, w)+listen = listens id+{-# INLINE listen #-}++-- | @'listens' f m@ is an action that executes the action @m@ and adds+-- the result of applying @f@ to the output to the value of the computation.+--+-- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@+--+-- * @'runRWST' ('listens' f m) r s = 'liftM' (\\ (a, w) -> ((a, f w), w)) ('runRWST' m r s)@+listens :: (Monoid w, Monad m) => (w -> b) -> RWST r w s m a -> RWST r w s m (a, b)+listens f m = RWST $ \ r s w -> do+    (a, s', w') <- runRWST m r s+    let wt = w `mappend` w'+    wt `seq` return ((a, f w'), s', wt)+{-# INLINE listens #-}++-- | @'pass' m@ is an action that executes the action @m@, which returns+-- a value and a function, and returns the value, applying the function+-- to the output.+--+-- * @'runRWST' ('pass' m) r s = 'liftM' (\\ ((a, f), w) -> (a, f w)) ('runRWST' m r s)@+pass :: (Monoid w, Monoid w', Monad m) => RWST r w s m (a, w -> w') -> RWST r w' s m a+pass m = RWST $ \ r s w -> do+    ((a, f), s', w') <- runRWST m r s+    let wt = w `mappend` f w'+    wt `seq` return (a, s', wt)+{-# INLINE pass #-}++-- | @'censor' f m@ is an action that executes the action @m@ and+-- applies the function @f@ to its output, leaving the return value+-- unchanged.+--+-- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@+--+-- * @'runRWST' ('censor' f m) r s = 'liftM' (\\ (a, w) -> (a, f w)) ('runRWST' m r s)@+censor :: (Monoid w, Monad m) => (w -> w) -> RWST r w s m a -> RWST r w s m a+censor f m = RWST $ \ r s w -> do+    (a, s', w') <- runRWST m r s+    let wt = w `mappend` f w'+    wt `seq` return (a, s', wt)+{-# INLINE censor #-}++-- ---------------------------------------------------------------------------+-- State operations++-- | Construct a state monad computation from a state transformer function.+state :: (Monad m) => (s -> (a, s)) -> RWST r w s m a+state f = RWST $ \ _ s w -> let (a, s') = f s in return (a, s', w)+{-# INLINE state #-}++-- | Fetch the current value of the state within the monad.+get :: (Monad m) =>RWST r w s m s+get = gets id+{-# INLINE get #-}++-- | @'put' s@ sets the state within the monad to @s@.+put :: (Monad m) =>s -> RWST r w s m ()+put s = RWST $ \ _ _ w -> return ((), s, w)+{-# INLINE put #-}++-- | @'modify' f@ is an action that updates the state to the result of+-- applying @f@ to the current state.+--+-- * @'modify' f = 'get' >>= ('put' . f)@+modify :: (Monad m) =>(s -> s) -> RWST r w s m ()+modify f = RWST $ \ _ s w -> return ((), f s, w)+{-# INLINE modify #-}++-- | Get a specific component of the state, using a projection function+-- supplied.+--+-- * @'gets' f = 'liftM' f 'get'@+gets :: (Monad m) =>(s -> a) -> RWST r w s m a+gets f = RWST $ \ _ s w -> return (f s, s, w)+{-# INLINE gets #-}++-- | Uniform lifting of a @callCC@ operation to the new monad.+-- This version rolls back to the original state on entering the+-- continuation.+liftCallCC :: CallCC m (a,s,w) (b,s,w) -> CallCC (RWST r w s m) a b+liftCallCC callCC f = RWST $ \ r s w ->+    callCC $ \ c -> unRWST (f (\ a -> RWST $ \ _ _ _ -> c (a, s, w))) r s w+{-# INLINE liftCallCC #-}++-- | In-situ lifting of a @callCC@ operation to the new monad.+-- This version uses the current state on entering the continuation.+liftCallCC' :: CallCC m (a,s,w) (b,s,w) -> CallCC (RWST r w s m) a b+liftCallCC' callCC f = RWST $ \ r s w ->+    callCC $ \ c -> unRWST (f (\ a -> RWST $ \ _ s' _ -> c (a, s', w))) r s w+{-# INLINE liftCallCC' #-}++-- | Lift a @catchE@ operation to the new monad.+liftCatch :: Catch e m (a,s,w) -> Catch e (RWST r w s m) a+liftCatch catchE m h =+    RWST $ \ r s w -> unRWST m r s w `catchE` \ e -> unRWST (h e) r s w+{-# INLINE liftCatch #-}
Control/Monad/Trans/RWS/Lazy.hs view
@@ -17,8 +17,8 @@ -- Portability :  portable -- -- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'.--- This version is lazy; for a strict version with the same interface,--- see "Control.Monad.Trans.RWS.Strict".+-- This version is lazy; for a constant-space version with almost the+-- same interface, see "Control.Monad.Trans.RWS.CPS". -----------------------------------------------------------------------------  module Control.Monad.Trans.RWS.Lazy (@@ -205,8 +205,10 @@         ~(b, s'',w') <- runRWST (k a) r s'         return (b, s'', w `mappend` w')     {-# INLINE (>>=) #-}+#if !(MIN_VERSION_base(4,13,0))     fail msg = RWST $ \ _ _ -> fail msg     {-# INLINE fail #-}+#endif  #if MIN_VERSION_base(4,9,0) instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (RWST r w s m) where
Control/Monad/Trans/RWS/Strict.hs view
@@ -19,6 +19,9 @@ -- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'. -- This version is strict; for a lazy version with the same interface, -- see "Control.Monad.Trans.RWS.Lazy".+-- Although the output is built strictly, it is not possible to+-- achieve constant space behaviour with this transformer: for that,+-- use "Control.Monad.Trans.RWS.CPS" instead. -----------------------------------------------------------------------------  module Control.Monad.Trans.RWS.Strict (@@ -205,8 +208,10 @@         (b, s'',w') <- runRWST (k a) r s'         return (b, s'', w `mappend` w')     {-# INLINE (>>=) #-}+#if !(MIN_VERSION_base(4,13,0))     fail msg = RWST $ \ _ _ -> fail msg     {-# INLINE fail #-}+#endif  #if MIN_VERSION_base(4,9,0) instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (RWST r w s m) where
Control/Monad/Trans/Reader.hs view
@@ -2,9 +2,6 @@ #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} #endif-#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE PolyKinds #-}-#endif #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE AutoDeriveTypeable #-} #endif@@ -180,8 +177,10 @@     m >> k = ReaderT $ \ r -> runReaderT m r >> runReaderT k r #endif     {-# INLINE (>>) #-}+#if !(MIN_VERSION_base(4,13,0))     fail msg = lift (fail msg)     {-# INLINE fail #-}+#endif  #if MIN_VERSION_base(4,9,0) instance (Fail.MonadFail m) => Fail.MonadFail (ReaderT r m) where
Control/Monad/Trans/State/Lazy.hs view
@@ -227,8 +227,10 @@         ~(a, s') <- runStateT m s         runStateT (k a) s'     {-# INLINE (>>=) #-}+#if !(MIN_VERSION_base(4,13,0))     fail str = StateT $ \ _ -> fail str     {-# INLINE fail #-}+#endif  #if MIN_VERSION_base(4,9,0) instance (Fail.MonadFail m) => Fail.MonadFail (StateT s m) where
Control/Monad/Trans/State/Strict.hs view
@@ -224,8 +224,10 @@         (a, s') <- runStateT m s         runStateT (k a) s'     {-# INLINE (>>=) #-}+#if !(MIN_VERSION_base(4,13,0))     fail str = StateT $ \ _ -> fail str     {-# INLINE fail #-}+#endif  #if MIN_VERSION_base(4,9,0) instance (Fail.MonadFail m) => Fail.MonadFail (StateT s m) where
Control/Monad/Trans/Writer.hs view
@@ -14,8 +14,8 @@ -- Portability :  portable -- -- The WriterT monad transformer.--- This version is lazy; for a strict version, see--- "Control.Monad.Trans.Writer.Strict", which has the same interface.+-- This version builds its output lazily; for a constant-space version+-- with almost the same interface, see "Control.Monad.Trans.Writer.CPS". -----------------------------------------------------------------------------  module Control.Monad.Trans.Writer (
+ Control/Monad/Trans/Writer/CPS.hs view
@@ -0,0 +1,283 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Safe #-}+#endif+#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE AutoDeriveTypeable #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Trans.Writer.CPS+-- Copyright   :  (c) Daniel Mendler 2016,+--                (c) Andy Gill 2001,+--                (c) Oregon Graduate Institute of Science and Technology, 2001+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  R.Paterson@city.ac.uk+-- Stability   :  experimental+-- Portability :  portable+--+-- The strict 'WriterT' monad transformer, which adds collection of+-- outputs (such as a count or string output) to a given monad.+--+-- This monad transformer provides only limited access to the output+-- during the computation. For more general access, use+-- "Control.Monad.Trans.State" instead.+--+-- This version builds its output strictly and uses continuation-passing-style+-- to achieve constant space usage. This transformer can be used as a+-- drop-in replacement for "Control.Monad.Trans.Writer.Strict".+-----------------------------------------------------------------------------++module Control.Monad.Trans.Writer.CPS (+    -- * The Writer monad+    Writer,+    writer,+    runWriter,+    execWriter,+    mapWriter,+    -- * The WriterT monad transformer+    WriterT,+    writerT,+    runWriterT,+    execWriterT,+    mapWriterT,+    -- * Writer operations+    tell,+    listen,+    listens,+    pass,+    censor,+    -- * Lifting other operations+    liftCallCC,+    liftCatch,+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Signatures+import Data.Functor.Identity++#if !(MIN_VERSION_base(4,8,0))+import Data.Monoid+#endif++#if MIN_VERSION_base(4,9,0)+import qualified Control.Monad.Fail as Fail+#endif++-- ---------------------------------------------------------------------------+-- | A writer monad parameterized by the type @w@ of output to accumulate.+--+-- The 'return' function produces the output 'mempty', while '>>='+-- combines the outputs of the subcomputations using 'mappend'.+type Writer w = WriterT w Identity++-- | Construct a writer computation from a (result, output) pair.+-- (The inverse of 'runWriter'.)+writer :: (Monoid w, Monad m) => (a, w) -> WriterT w m a+writer (a, w') = WriterT $ \ w ->+    let wt = w `mappend` w' in wt `seq` return (a, wt)+{-# INLINE writer #-}++-- | Unwrap a writer computation as a (result, output) pair.+-- (The inverse of 'writer'.)+runWriter :: (Monoid w) => Writer w a -> (a, w)+runWriter = runIdentity . runWriterT+{-# INLINE runWriter #-}++-- | Extract the output from a writer computation.+--+-- * @'execWriter' m = 'snd' ('runWriter' m)@+execWriter :: (Monoid w) => Writer w a -> w+execWriter = runIdentity . execWriterT+{-# INLINE execWriter #-}++-- | Map both the return value and output of a computation using+-- the given function.+--+-- * @'runWriter' ('mapWriter' f m) = f ('runWriter' m)@+mapWriter :: (Monoid w, Monoid w') =>+    ((a, w) -> (b, w')) -> Writer w a -> Writer w' b+mapWriter f = mapWriterT (Identity . f . runIdentity)+{-# INLINE mapWriter #-}++-- ---------------------------------------------------------------------------+-- | A writer monad parameterized by:+--+--   * @w@ - the output to accumulate.+--+--   * @m@ - The inner monad.+--+-- The 'return' function produces the output 'mempty', while '>>='+-- combines the outputs of the subcomputations using 'mappend'.++newtype WriterT w m a = WriterT { unWriterT :: w -> m (a, w) }++-- | Construct a writer computation from a (result, output) computation.+-- (The inverse of 'runWriterT'.)+writerT :: (Functor m, Monoid w) => m (a, w) -> WriterT w m a+writerT f = WriterT $ \ w ->+    (\ (a, w') -> let wt = w `mappend` w' in wt `seq` (a, wt)) <$> f+{-# INLINE writerT #-}++-- | Unwrap a writer computation.+-- (The inverse of 'writerT'.)+runWriterT :: (Monoid w) => WriterT w m a -> m (a, w)+runWriterT m = unWriterT m mempty+{-# INLINE runWriterT #-}++-- | Extract the output from a writer computation.+--+-- * @'execWriterT' m = 'liftM' 'snd' ('runWriterT' m)@+execWriterT :: (Monad m, Monoid w) => WriterT w m a -> m w+execWriterT m = do+    (_, w) <- runWriterT m+    return w+{-# INLINE execWriterT #-}++-- | Map both the return value and output of a computation using+-- the given function.+--+-- * @'runWriterT' ('mapWriterT' f m) = f ('runWriterT' m)@+mapWriterT :: (Monad n, Monoid w, Monoid w') =>+    (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b+mapWriterT f m = WriterT $ \ w -> do+    (a, w') <- f (runWriterT m)+    let wt = w `mappend` w'+    wt `seq` return (a, wt)+{-# INLINE mapWriterT #-}++instance (Functor m) => Functor (WriterT w m) where+    fmap f m = WriterT $ \ w -> (\ (a, w') -> (f a, w')) <$> unWriterT m w+    {-# INLINE fmap #-}++instance (Functor m, Monad m) => Applicative (WriterT w m) where+    pure a = WriterT $ \ w -> return (a, w)+    {-# INLINE pure #-}++    WriterT mf <*> WriterT mx = WriterT $ \ w -> do+        (f, w') <- mf w+        (x, w'') <- mx w'+        return (f x, w'')+    {-# INLINE (<*>) #-}++instance (Functor m, MonadPlus m) => Alternative (WriterT w m) where+    empty = WriterT $ const mzero+    {-# INLINE empty #-}++    WriterT m <|> WriterT n = WriterT $ \ w -> m w `mplus` n w+    {-# INLINE (<|>) #-}++instance (Monad m) => Monad (WriterT w m) where+#if !(MIN_VERSION_base(4,8,0))+    return a = WriterT $ \ w -> return (a, w)+    {-# INLINE return #-}+#endif++    m >>= k = WriterT $ \ w -> do+        (a, w') <- unWriterT m w+        unWriterT (k a) w'+    {-# INLINE (>>=) #-}++#if !(MIN_VERSION_base(4,13,0))+    fail msg = WriterT $ \ _ -> fail msg+    {-# INLINE fail #-}+#endif++#if MIN_VERSION_base(4,9,0)+instance (Fail.MonadFail m) => Fail.MonadFail (WriterT w m) where+    fail msg = WriterT $ \ _ -> Fail.fail msg+    {-# INLINE fail #-}+#endif++instance (Functor m, MonadPlus m) => MonadPlus (WriterT w m) where+    mzero = empty+    {-# INLINE mzero #-}+    mplus = (<|>)+    {-# INLINE mplus #-}++instance (MonadFix m) => MonadFix (WriterT w m) where+    mfix f = WriterT $ \ w -> mfix $ \ ~(a, _) -> unWriterT (f a) w+    {-# INLINE mfix #-}++instance MonadTrans (WriterT w) where+    lift m = WriterT $ \ w -> do+        a <- m+        return (a, w)+    {-# INLINE lift #-}++instance (MonadIO m) => MonadIO (WriterT w m) where+    liftIO = lift . liftIO+    {-# INLINE liftIO #-}++-- | @'tell' w@ is an action that produces the output @w@.+tell :: (Monoid w, Monad m) => w -> WriterT w m ()+tell w = writer ((), w)+{-# INLINE tell #-}++-- | @'listen' m@ is an action that executes the action @m@ and adds its+-- output to the value of the computation.+--+-- * @'runWriterT' ('listen' m) = 'liftM' (\\ (a, w) -> ((a, w), w)) ('runWriterT' m)@+listen :: (Monoid w, Monad m) => WriterT w m a -> WriterT w m (a, w)+listen = listens id+{-# INLINE listen #-}++-- | @'listens' f m@ is an action that executes the action @m@ and adds+-- the result of applying @f@ to the output to the value of the computation.+--+-- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@+--+-- * @'runWriterT' ('listens' f m) = 'liftM' (\\ (a, w) -> ((a, f w), w)) ('runWriterT' m)@+listens :: (Monoid w, Monad m) =>+    (w -> b) -> WriterT w m a -> WriterT w m (a, b)+listens f m = WriterT $ \ w -> do+    (a, w') <- runWriterT m+    let wt = w `mappend` w'+    wt `seq` return ((a, f w'), wt)+{-# INLINE listens #-}++-- | @'pass' m@ is an action that executes the action @m@, which returns+-- a value and a function, and returns the value, applying the function+-- to the output.+--+-- * @'runWriterT' ('pass' m) = 'liftM' (\\ ((a, f), w) -> (a, f w)) ('runWriterT' m)@+pass :: (Monoid w, Monoid w', Monad m) =>+    WriterT w m (a, w -> w') -> WriterT w' m a+pass m = WriterT $ \ w -> do+    ((a, f), w') <- runWriterT m+    let wt = w `mappend` f w'+    wt `seq` return (a, wt)+{-# INLINE pass #-}++-- | @'censor' f m@ is an action that executes the action @m@ and+-- applies the function @f@ to its output, leaving the return value+-- unchanged.+--+-- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@+--+-- * @'runWriterT' ('censor' f m) = 'liftM' (\\ (a, w) -> (a, f w)) ('runWriterT' m)@+censor :: (Monoid w, Monad m) => (w -> w) -> WriterT w m a -> WriterT w m a+censor f m = WriterT $ \ w -> do+    (a, w') <- runWriterT m+    let wt = w `mappend` f w'+    wt `seq` return (a, wt)+{-# INLINE censor #-}++-- | Uniform lifting of a @callCC@ operation to the new monad.+-- This version rolls back to the original state on entering the+-- continuation.+liftCallCC :: CallCC m (a, w) (b, w) -> CallCC (WriterT w m) a b+liftCallCC callCC f = WriterT $ \ w ->+    callCC $ \ c -> unWriterT (f (\ a -> WriterT $ \ _ -> c (a, w))) w+{-# INLINE liftCallCC #-}++-- | Lift a @catchE@ operation to the new monad.+liftCatch :: Catch e m (a, w) -> Catch e (WriterT w m) a+liftCatch catchE m h = WriterT $ \ w ->+    unWriterT m w `catchE` \ e -> unWriterT (h e) w+{-# INLINE liftCatch #-}
Control/Monad/Trans/Writer/Lazy.hs view
@@ -23,8 +23,8 @@ -- during the computation.  For more general access, use -- "Control.Monad.Trans.State" instead. ----- This version builds its output lazily; for a strict version with--- the same interface, see "Control.Monad.Trans.Writer.Strict".+-- This version builds its output lazily; for a constant-space version+-- with almost the same interface, see "Control.Monad.Trans.Writer.CPS". -----------------------------------------------------------------------------  module Control.Monad.Trans.Writer.Lazy (@@ -204,8 +204,10 @@         ~(b, w') <- runWriterT (k a)         return (b, w `mappend` w')     {-# INLINE (>>=) #-}+#if !(MIN_VERSION_base(4,13,0))     fail msg = WriterT $ fail msg     {-# INLINE fail #-}+#endif  #if MIN_VERSION_base(4,9,0) instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (WriterT w m) where
Control/Monad/Trans/Writer/Strict.hs view
@@ -27,7 +27,7 @@ -- the same interface, see "Control.Monad.Trans.Writer.Lazy". -- Although the output is built strictly, it is not possible to -- achieve constant space behaviour with this transformer: for that,--- use "Control.Monad.Trans.State.Strict" instead.+-- use "Control.Monad.Trans.Writer.CPS" instead. -----------------------------------------------------------------------------  module Control.Monad.Trans.Writer.Strict (@@ -207,8 +207,10 @@         (b, w') <- runWriterT (k a)         return (b, w `mappend` w')     {-# INLINE (>>=) #-}+#if !(MIN_VERSION_base(4,13,0))     fail msg = WriterT $ fail msg     {-# INLINE fail #-}+#endif  #if MIN_VERSION_base(4,9,0) instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (WriterT w m) where
Data/Functor/Reverse.hs view
@@ -94,8 +94,10 @@ #endif     m >>= f = Reverse (getReverse m >>= getReverse . f)     {-# INLINE (>>=) #-}+#if !(MIN_VERSION_base(4,13,0))     fail msg = Reverse (fail msg)     {-# INLINE fail #-}+#endif  #if MIN_VERSION_base(4,9,0) instance (Fail.MonadFail m) => Fail.MonadFail (Reverse m) where
changelog view
@@ -1,10 +1,10 @@ -*-change-log-*- -0.5.5.2 Ross Paterson <R.Paterson@city.ac.uk> Apr 2019-	* Added MonadFix instance for ListT and backward compatability fixes--0.5.5.1 Ross Paterson <R.Paterson@city.ac.uk> Apr 2019+0.5.6.0 Ross Paterson <R.Paterson@city.ac.uk> Feb 2019+	* Generalized type of except+	* Added Control.Monad.Trans.Writer.CPS and Control.Monad.Trans.RWS.CPS 	* Added Contravariant instances+	* Added MonadFix instance for ListT  0.5.5.0 Ross Paterson <R.Paterson@city.ac.uk> Oct 2017 	* Added mapSelect and mapSelectT
transformers.cabal view
@@ -1,5 +1,5 @@ name:         transformers-version:      0.5.5.2+version:      0.5.6.0 license:      BSD3 license-file: LICENSE author:       Andy Gill, Ross Paterson@@ -76,6 +76,7 @@     Control.Monad.Trans.Maybe     Control.Monad.Trans.Reader     Control.Monad.Trans.RWS+    Control.Monad.Trans.RWS.CPS     Control.Monad.Trans.RWS.Lazy     Control.Monad.Trans.RWS.Strict     Control.Monad.Trans.Select@@ -83,6 +84,7 @@     Control.Monad.Trans.State.Lazy     Control.Monad.Trans.State.Strict     Control.Monad.Trans.Writer+    Control.Monad.Trans.Writer.CPS     Control.Monad.Trans.Writer.Lazy     Control.Monad.Trans.Writer.Strict     Data.Functor.Constant