diff --git a/Control/Applicative/Backwards.hs b/Control/Applicative/Backwards.hs --- a/Control/Applicative/Backwards.hs +++ b/Control/Applicative/Backwards.hs @@ -1,11 +1,12 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -26,19 +27,32 @@ Backwards(..), ) where +#if MIN_VERSION_base(4,18,0) +import Data.Foldable1 (Foldable1(foldMap1)) +#endif import Data.Functor.Classes #if MIN_VERSION_base(4,12,0) import Data.Functor.Contravariant #endif +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif import Prelude hiding (foldr, foldr1, foldl, foldl1, null, length) import Control.Applicative import Data.Foldable -import Data.Traversable +#if !(MIN_VERSION_base(4,8,0)) || defined(__MHS__) +import Data.Traversable (Traversable(traverse, sequenceA)) +#endif -- | The same functor, but with an 'Applicative' instance that performs -- actions in the reverse order. newtype Backwards f a = Backwards { forwards :: f a } +#if __GLASGOW_HASKELL__ >= 710 + deriving (Generic, Generic1) +#elif __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif instance (Eq1 f) => Eq1 (Backwards f) where liftEq eq (Backwards x) (Backwards y) = liftEq eq x y @@ -65,6 +79,8 @@ instance (Functor f) => Functor (Backwards f) where fmap f (Backwards a) = Backwards (fmap f a) {-# INLINE fmap #-} + x <$ Backwards a = Backwards (x <$ a) + {-# INLINE (<$) #-} -- | Apply @f@-actions in the reverse order. instance (Applicative f) => Applicative (Backwards f) where @@ -72,6 +88,16 @@ {-# INLINE pure #-} Backwards f <*> Backwards a = Backwards (a <**> f) {-# INLINE (<*>) #-} +#if MIN_VERSION_base(4,10,0) + liftA2 f (Backwards m) (Backwards n) = Backwards $ liftA2 (flip f) n m + {-# INLINE liftA2 #-} +#endif +#if MIN_VERSION_base(4,2,0) + Backwards xs *> Backwards ys = Backwards (ys <* xs) + {-# INLINE (*>) #-} + Backwards ys <* Backwards xs = Backwards (xs *> ys) + {-# INLINE (<*) #-} +#endif -- | Try alternatives in the same order as @f@. instance (Alternative f) => Alternative (Backwards f) where @@ -97,7 +123,14 @@ length (Backwards t) = length t #endif +#if MIN_VERSION_base(4,18,0) -- | Derived instance. +instance (Foldable1 f) => Foldable1 (Backwards f) where + foldMap1 f (Backwards t) = foldMap1 f t + {-# INLINE foldMap1 #-} +#endif + +-- | Derived instance. instance (Traversable f) => Traversable (Backwards f) where traverse f (Backwards t) = fmap Backwards (traverse f t) {-# INLINE traverse #-} @@ -106,7 +139,7 @@ #if MIN_VERSION_base(4,12,0) -- | Derived instance. -instance Contravariant f => Contravariant (Backwards f) where +instance (Contravariant f) => Contravariant (Backwards f) where contramap f = Backwards . contramap f . forwards {-# INLINE contramap #-} #endif diff --git a/Control/Applicative/Lift.hs b/Control/Applicative/Lift.hs --- a/Control/Applicative/Lift.hs +++ b/Control/Applicative/Lift.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -31,17 +32,30 @@ eitherToErrors ) where +#if MIN_VERSION_base(4,18,0) +import Data.Foldable1 (Foldable1(foldMap1)) +#endif import Data.Functor.Classes import Control.Applicative -import Data.Foldable (Foldable(foldMap)) import Data.Functor.Constant +#if !(MIN_VERSION_base(4,8,0)) || defined(__MHS__) +import Data.Foldable (Foldable(foldMap)) import Data.Monoid (Monoid(..)) import Data.Traversable (Traversable(traverse)) +#endif +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif -- | Applicative functor formed by adding pure computations to a given -- applicative functor. data Lift f a = Pure a | Other (f a) +#if __GLASGOW_HASKELL__ >= 710 + deriving (Generic, Generic1) +#elif __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif instance (Eq1 f) => Eq1 (Lift f) where liftEq eq (Pure x1) (Pure x2) = eq x1 x2 @@ -91,10 +105,8 @@ instance (Applicative f) => Applicative (Lift f) where pure = Pure {-# INLINE pure #-} - Pure f <*> Pure x = Pure (f x) - Pure f <*> Other y = Other (f <$> y) - Other f <*> Pure x = Other (($ x) <$> f) - Other f <*> Other y = Other (f <*> y) + Pure f <*> ax = f <$> ax + Other f <*> ax = Other (f <*> unLift ax) {-# INLINE (<*>) #-} -- | A combination is 'Pure' only either part is. @@ -106,6 +118,13 @@ Other x <|> Other y = Other (x <|> y) {-# INLINE (<|>) #-} +#if MIN_VERSION_base(4,18,0) +instance (Foldable1 f) => Foldable1 (Lift f) where + foldMap1 f (Pure x) = f x + foldMap1 f (Other y) = foldMap1 f y + {-# INLINE foldMap1 #-} +#endif + -- | Projection to the other functor. unLift :: (Applicative f) => Lift f a -> f a unLift (Pure x) = pure x @@ -131,8 +150,9 @@ -- | An applicative functor that collects a monoid (e.g. lists) of errors. -- A sequence of computations fails if any of its components do, but --- unlike monads made with 'ExceptT' from "Control.Monad.Trans.Except", --- these computations continue after an error, collecting all the errors. +-- unlike monads made with 'Control.Monad.Trans.Except.ExceptT' from +-- "Control.Monad.Trans.Except", these computations continue after an +-- error, collecting all the errors. -- -- * @'pure' f '<*>' 'pure' x = 'pure' (f x)@ -- diff --git a/Control/Monad/Signatures.hs b/Control/Monad/Signatures.hs --- a/Control/Monad/Signatures.hs +++ b/Control/Monad/Signatures.hs @@ -27,23 +27,27 @@ -- introduced in "Control.Monad.Trans.Cont". -- Any lifting function @liftCallCC@ should satisfy -- --- * @'lift' (f k) = f' ('lift' . k) => 'lift' (cf f) = liftCallCC cf f'@ +-- @'Control.Monad.Trans.Class.lift' (f k) = f' ('Control.Monad.Trans.Class.lift' . k) => 'Control.Monad.Trans.Class.lift' (cf f) = liftCallCC cf f'@ -- +-- This implies that on entry to the continuation any outer monad +-- transformer effect inside @callCC@ will have been rolled back. type CallCC m a b = ((a -> m b) -> m a) -> m a -- | Signature of the @catchE@ operation, -- introduced in "Control.Monad.Trans.Except". -- Any lifting function @liftCatch@ should satisfy -- --- * @'lift' (cf m f) = liftCatch ('lift' . cf) ('lift' f)@ +-- @'Control.Monad.Trans.Class.lift' (cf m h) = liftCatch cf ('Control.Monad.Trans.Class.lift' m) ('Control.Monad.Trans.Class.lift' . h)@ -- +-- This implies that on entry to the handler function any outer monad +-- transformer effect inside @catchE@ will have been rolled back. type Catch e m a = m a -> (e -> m a) -> m a -- | Signature of the @listen@ operation, -- introduced in "Control.Monad.Trans.Writer". -- Any lifting function @liftListen@ should satisfy -- --- * @'lift' . liftListen = liftListen . 'lift'@ +-- @'Control.Monad.Trans.Class.lift' . liftListen = liftListen . 'Control.Monad.Trans.Class.lift'@ -- type Listen w m a = m a -> m (a, w) @@ -51,6 +55,6 @@ -- introduced in "Control.Monad.Trans.Writer". -- Any lifting function @liftPass@ should satisfy -- --- * @'lift' . liftPass = liftPass . 'lift'@ +-- @'Control.Monad.Trans.Class.lift' . liftPass = liftPass . 'Control.Monad.Trans.Class.lift'@ -- type Pass w m a = m (a, w -> w) -> m a diff --git a/Control/Monad/Trans/Accum.hs b/Control/Monad/Trans/Accum.hs --- a/Control/Monad/Trans/Accum.hs +++ b/Control/Monad/Trans/Accum.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -17,10 +18,12 @@ -- -- The lazy 'AccumT' monad transformer, which adds accumulation -- capabilities (such as declarations or document patches) to a given monad. +-- Each computation has access to the combination of the input environment +-- and outputs added so far, and returns the outputs added. -- --- This monad transformer provides append-only accumulation --- during the computation. For more general access, use --- "Control.Monad.Trans.State" instead. +-- In applications requiring only the ability to accumulate an output and +-- to inspect the output so far, it would be considerably more efficient +-- to use "Control.Monad.Trans.State" instead. ----------------------------------------------------------------------------- module Control.Monad.Trans.Accum ( @@ -32,8 +35,7 @@ evalAccum, mapAccum, -- * The AccumT monad transformer - AccumT(AccumT), - runAccumT, + AccumT(..), execAccumT, evalAccumT, mapAccumT, @@ -70,12 +72,24 @@ #if !MIN_VERSION_base(4,8,0) import Data.Monoid #endif +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif -- --------------------------------------------------------------------------- --- | An accumulation monad parameterized by the type @w@ of output to accumulate. +-- | An accumulation monad (non-strict) 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'. +-- This monad is a more complex extension of both the reader and writer +-- monads. The 'return' function produces the output 'mempty', while @m +-- '>>=' k@ uses the output of @m@ both to extend the initial environment +-- of @k@ and to combine with the output of @k@: +-- +-- <> +-- +-- In applications requiring only the ability to accumulate an output and +-- to inspect the output so far, it would be considerably more efficient +-- to use a state monad. type Accum w = AccumT w Identity -- | Construct an accumulation computation from a (result, output) pair. @@ -120,21 +134,31 @@ -- -- * @m@ - The inner monad. -- --- The 'return' function produces the output 'mempty', while @>>=@ --- combines the outputs of the subcomputations using 'mappend'. +-- This monad transformer is a more complex extension of both the reader +-- and writer monad transformers. The 'return' function produces the +-- output 'mempty', while @m '>>=' k@ uses the output of @m@ both to +-- extend the initial environment of @k@ and to combine with the output +-- of @k@: -- --- This monad transformer is similar to both state and writer monad transformers. --- Thus it can be seen as +-- <> -- --- * a restricted append-only version of a state monad transformer or +-- In applications requiring only the ability to accumulate an output and +-- to inspect the output so far, it would be considerably more efficient +-- to use a state monad transformer. -- --- * a writer monad transformer with the extra ability to read all previous output. -newtype AccumT w m a = AccumT (w -> m (a, w)) - --- | Unwrap an accumulation computation. -runAccumT :: AccumT w m a -> w -> m (a, w) -runAccumT (AccumT f) = f -{-# INLINE runAccumT #-} +-- @AccumT w m@ is strict if and only if @m@ is. +newtype AccumT w m a = AccumT { + -- | Unwrap an accumulation computation. For example, in the call + -- + -- @ (value, locals) <- runAccumT action globals@ + -- + -- the action is fed an initial environment @globals@, and @locals@ is + -- the sum of all arguments to calls of 'add' executed by the action. + runAccumT :: w -> m (a, w) + } +#if __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif -- | Extract the output from an accumulation computation. -- @@ -145,8 +169,8 @@ return w' {-# INLINE execAccumT #-} --- | Evaluate an accumulation computation with the given initial output history --- and return the final value, discarding the final output. +-- | Evaluate an accumulation computation with the given initial output +-- history and return the final value, discarding the final output. -- -- * @'evalAccumT' m w = 'liftM' 'fst' ('runAccumT' m w)@ evalAccumT :: (Monad m, Monoid w) => AccumT w m a -> w -> m a @@ -155,8 +179,8 @@ return a {-# INLINE evalAccumT #-} --- | Map both the return value and output of a computation using --- the given function. +-- | Map both the return value and output of a computation using the +-- given function. -- -- * @'runAccumT' ('mapAccumT' f m) = f . 'runAccumT' m@ mapAccumT :: (m (a, w) -> n (b, w)) -> AccumT w m a -> AccumT w n b @@ -255,6 +279,9 @@ {-# INLINE liftCallCC' #-} -- | Lift a @catchE@ operation to the new monad. +-- The uniformity property (see "Control.Monad.Signatures") implies that +-- the lifted @catchE@ discards any output from the body on entering +-- the handler. liftCatch :: Catch e m (a, w) -> Catch e (AccumT w m) a liftCatch catchE m h = AccumT $ \ w -> runAccumT m w `catchE` \ e -> runAccumT (h e) w diff --git a/Control/Monad/Trans/Class.hs b/Control/Monad/Trans/Class.hs --- a/Control/Monad/Trans/Class.hs +++ b/Control/Monad/Trans/Class.hs @@ -2,9 +2,12 @@ #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif +#if __GLASGOW_HASKELL__ >= 806 +{-# LANGUAGE QuantifiedConstraints #-} +#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Trans.Class @@ -46,27 +49,56 @@ -- $example3 ) where --- | The class of monad transformers. Instances should satisfy the --- following laws, which state that 'lift' is a monad transformation: +-- | The class of monad transformers. +-- For any monad @m@, the result @t m@ should also be a monad, +-- and 'lift' should be a monad transformation from @m@ to @t m@, +-- i.e. it should satisfy the following laws: -- -- * @'lift' . 'return' = 'return'@ -- -- * @'lift' (m >>= f) = 'lift' m >>= ('lift' . f)@ - +-- +-- Since 0.6.0.0 and for GHC 8.6 and later, the requirement that @t m@ +-- be a 'Monad' is enforced by the implication constraint +-- @forall m. 'Monad' m => 'Monad' (t m)@ enabled by the +-- @QuantifiedConstraints@ extension. +-- +-- === __Ambiguity error with GHC 9.0 to 9.2.2__ +-- These versions of GHC have a bug +-- () +-- which causes constraints like +-- +-- @ +-- (MonadTrans t, forall m. Monad m => Monad (t m)) => ... +-- @ +-- +-- to be reported as ambiguous. For transformers 0.6 and later, this can +-- be fixed by removing the second constraint, which is implied by the first. +#if __GLASGOW_HASKELL__ >= 806 +class (forall m. Monad m => Monad (t m)) => MonadTrans t where +#else +-- Prior to GHC 8.8 (base-4.13), the Monad class included fail. +-- GHC 8.6 (base-4.12) has MonadFailDesugaring on by default, so there +-- is no need for users defining monad transformers to define fail in +-- the Monad instance of the transformed monad. class MonadTrans t where +#endif -- | Lift a computation from the argument monad to the constructed monad. lift :: (Monad m) => m a -> t m a {- $conventions -Most monad transformer modules include the special case of applying -the transformer to 'Data.Functor.Identity.Identity'. For example, +All monad transformer modules except 'Control.Monad.Trans.Maybe' +include the special case of applying the transformer +to 'Data.Functor.Identity.Identity'. For example, @'Control.Monad.Trans.State.Lazy.State' s@ is an abbreviation for @'Control.Monad.Trans.State.Lazy.StateT' s 'Data.Functor.Identity.Identity'@. +As a consequence, operations defined on the monad transformer can also +be used on this special case. Each monad transformer also comes with an operation @run@/XXX/@T@ to unwrap the transformer, exposing a computation of the inner monad. -(Currently these functions are defined as field labels, but in the next -major release they will be separate functions.) +(Currently these functions are defined as field labels, but in a future +major release they may be separate functions.) All of the monad transformers except 'Control.Monad.Trans.Cont.ContT' and 'Control.Monad.Trans.Cont.SelectT' are functors on the category @@ -94,20 +126,27 @@ {- $strict -A monad is said to be /strict/ if its '>>=' operation is strict in its first -argument. The base monads 'Maybe', @[]@ and 'IO' are strict: +A monad is said to be /strict/ if its '>>=' operation (and therefore also +'>>') is strict in its first argument. The base monads 'Maybe', @[]@ +and 'IO' are strict: ->>> undefined >> return 2 :: Maybe Integer +>>> undefined >> Just 2 *** Exception: Prelude.undefined +>>> undefined >> [2] +*** Exception: Prelude.undefined +>>> undefined >> print 2 +*** Exception: Prelude.undefined -However the monad 'Data.Functor.Identity.Identity' is not: +However, the monads 'Data.Functor.Identity.Identity' and @(->) a@ are not: ->>> runIdentity (undefined >> return 2) -2 +>>> undefined >> Identity 2 +Identity 2 +>>> (undefined >> (+1)) 5 +6 In a strict monad you know when each action is executed, but the monad is not necessarily strict in the return value, or in other components -of the monad, such as a state. However you can use 'seq' to create +of the monad, such as a state. However, you can use 'seq' to create an action that is strict in the component you want evaluated. -} diff --git a/Control/Monad/Trans/Cont.hs b/Control/Monad/Trans/Cont.hs --- a/Control/Monad/Trans/Cont.hs +++ b/Control/Monad/Trans/Cont.hs @@ -1,11 +1,12 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -52,13 +53,18 @@ import Control.Monad.Trans.Class import Data.Functor.Identity +#if !(MIN_VERSION_base(4,8,0)) import Control.Applicative +#endif #if MIN_VERSION_base(4,9,0) import qualified Control.Monad.Fail as Fail #endif +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif {- | -Continuation monad. +The continuation monad, which is non-strict. @Cont r a@ is a CPS ("continuation-passing style") computation that produces an intermediate result of type @a@ within a CPS computation whose final result type is @r@. @@ -133,7 +139,12 @@ -- -- 'ContT' is not a functor on the category of monads, and many operations -- cannot be lifted through it. +-- +-- @ContT r m@ is strict if and only if @m@ is. newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r } +#if __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif -- | The result of running a CPS computation with 'return' as the -- final continuation. diff --git a/Control/Monad/Trans/Error.hs b/Control/Monad/Trans/Error.hs deleted file mode 100644 --- a/Control/Monad/Trans/Error.hs +++ /dev/null @@ -1,333 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif -#if !(MIN_VERSION_base(4,9,0)) -{-# OPTIONS_GHC -fno-warn-orphans #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.Error --- Copyright : (c) Michael Weber 2001, --- (c) Jeff Newbern 2003-2006, --- (c) Andriy Palamarchuk 2006 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- This monad transformer adds the ability to fail or throw exceptions --- to a monad. --- --- A sequence of actions succeeds, producing a value, only if all the --- actions in the sequence are successful. If one fails with an error, --- the rest of the sequence is skipped and the composite action fails --- with that error. --- --- If the value of the error is not required, the variant in --- "Control.Monad.Trans.Maybe" may be used instead. --- --- /Note:/ This module will be removed in a future release. --- Instead, use "Control.Monad.Trans.Except", which does not restrict --- the exception type, and also includes a base exception monad. ------------------------------------------------------------------------------ - -module Control.Monad.Trans.Error - {-# DEPRECATED "Use Control.Monad.Trans.Except instead" #-} ( - -- * The ErrorT monad transformer - Error(..), - ErrorList(..), - ErrorT(..), - mapErrorT, - -- * Error operations - throwError, - catchError, - -- * Lifting other operations - liftCallCC, - liftListen, - liftPass, - -- * Examples - -- $examples - ) where - -import Control.Monad.IO.Class -import Control.Monad.Signatures -import Control.Monad.Trans.Class -import Data.Functor.Classes -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif - -import Control.Applicative -import Control.Exception (IOException) -import Control.Monad -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Control.Monad.Fix -#if !(MIN_VERSION_base(4,6,0)) -import Control.Monad.Instances () -- deprecated from base-4.6 -#endif -import Data.Foldable (Foldable(foldMap)) -import Data.Monoid (mempty) -import Data.Traversable (Traversable(traverse)) -import System.IO.Error - -#if !(MIN_VERSION_base(4,9,0)) --- These instances are in base-4.9.0 - -instance MonadPlus IO where - mzero = ioError (userError "mzero") - m `mplus` n = m `catchIOError` \ _ -> n - -instance Alternative IO where - empty = mzero - (<|>) = mplus - -# if !(MIN_VERSION_base(4,4,0)) --- exported by System.IO.Error from base-4.4 -catchIOError :: IO a -> (IOError -> IO a) -> IO a -catchIOError = catch -# endif -#endif - -instance (Error e) => Alternative (Either e) where - empty = Left noMsg - Left _ <|> n = n - m <|> _ = m - -instance (Error e) => MonadPlus (Either e) where - mzero = Left noMsg - Left _ `mplus` n = n - m `mplus` _ = m - -#if !(MIN_VERSION_base(4,3,0)) --- These instances are in base-4.3 - -instance Applicative (Either e) where - pure = Right - Left e <*> _ = Left e - Right f <*> r = fmap f r - -instance Monad (Either e) where - return = Right - Left l >>= _ = Left l - Right r >>= k = k r - -instance MonadFix (Either e) where - mfix f = let - a = f $ case a of - Right r -> r - _ -> error "empty mfix argument" - in a - -#endif /* base to 4.2.0.x */ - --- | An exception to be thrown. --- --- Minimal complete definition: 'noMsg' or 'strMsg'. -class Error a where - -- | Creates an exception without a message. - -- The default implementation is @'strMsg' \"\"@. - noMsg :: a - -- | Creates an exception with a message. - -- The default implementation of @'strMsg' s@ is 'noMsg'. - strMsg :: String -> a - - noMsg = strMsg "" - strMsg _ = noMsg - -instance Error IOException where - strMsg = userError - --- | A string can be thrown as an error. -instance (ErrorList a) => Error [a] where - strMsg = listMsg - --- | Workaround so that we can have a Haskell 98 instance @'Error' 'String'@. -class ErrorList a where - listMsg :: String -> [a] - -instance ErrorList Char where - listMsg = id - --- | The error monad transformer. It can be used to add error handling --- to other monads. --- --- The @ErrorT@ Monad structure is parameterized over two things: --- --- * e - The error type. --- --- * m - The inner monad. --- --- The 'return' function yields a successful computation, while @>>=@ --- sequences two subcomputations, failing on the first error. -newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) } - -instance (Eq e, Eq1 m) => Eq1 (ErrorT e m) where - liftEq eq (ErrorT x) (ErrorT y) = liftEq (liftEq eq) x y - -instance (Ord e, Ord1 m) => Ord1 (ErrorT e m) where - liftCompare comp (ErrorT x) (ErrorT y) = liftCompare (liftCompare comp) x y - -instance (Read e, Read1 m) => Read1 (ErrorT e m) where - liftReadsPrec rp rl = readsData $ - readsUnaryWith (liftReadsPrec rp' rl') "ErrorT" ErrorT - where - rp' = liftReadsPrec rp rl - rl' = liftReadList rp rl - -instance (Show e, Show1 m) => Show1 (ErrorT e m) where - liftShowsPrec sp sl d (ErrorT m) = - showsUnaryWith (liftShowsPrec sp' sl') "ErrorT" d m - where - sp' = liftShowsPrec sp sl - sl' = liftShowList sp sl - -instance (Eq e, Eq1 m, Eq a) => Eq (ErrorT e m a) where (==) = eq1 -instance (Ord e, Ord1 m, Ord a) => Ord (ErrorT e m a) where compare = compare1 -instance (Read e, Read1 m, Read a) => Read (ErrorT e m a) where - readsPrec = readsPrec1 -instance (Show e, Show1 m, Show a) => Show (ErrorT e m a) where - showsPrec = showsPrec1 - --- | Map the unwrapped computation using the given function. --- --- * @'runErrorT' ('mapErrorT' f m) = f ('runErrorT' m)@ -mapErrorT :: (m (Either e a) -> n (Either e' b)) - -> ErrorT e m a - -> ErrorT e' n b -mapErrorT f m = ErrorT $ f (runErrorT m) - -instance (Functor m) => Functor (ErrorT e m) where - fmap f = ErrorT . fmap (fmap f) . runErrorT - -instance (Foldable f) => Foldable (ErrorT e f) where - foldMap f (ErrorT a) = foldMap (either (const mempty) f) a - -instance (Traversable f) => Traversable (ErrorT e f) where - traverse f (ErrorT a) = - ErrorT <$> traverse (either (pure . Left) (fmap Right . f)) a - -instance (Functor m, Monad m) => Applicative (ErrorT e m) where - pure a = ErrorT $ return (Right a) - f <*> v = ErrorT $ do - mf <- runErrorT f - case mf of - Left e -> return (Left e) - Right k -> do - mv <- runErrorT v - case mv of - Left e -> return (Left e) - Right x -> return (Right (k x)) - -instance (Functor m, Monad m, Error e) => Alternative (ErrorT e m) where - empty = mzero - (<|>) = mplus - -instance (Monad m, Error e) => Monad (ErrorT e m) where -#if !(MIN_VERSION_base(4,8,0)) - return a = ErrorT $ return (Right a) -#endif - m >>= k = ErrorT $ do - a <- runErrorT m - 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 - fail msg = ErrorT $ return (Left (strMsg msg)) -#endif - -instance (Monad m, Error e) => MonadPlus (ErrorT e m) where - mzero = ErrorT $ return (Left noMsg) - m `mplus` n = ErrorT $ do - a <- runErrorT m - case a of - Left _ -> runErrorT n - Right r -> return (Right r) - -instance (MonadFix m, Error e) => MonadFix (ErrorT e m) where - mfix f = ErrorT $ mfix $ \ a -> runErrorT $ f $ case a of - Right r -> r - _ -> error "empty mfix argument" - -instance MonadTrans (ErrorT e) where - lift m = ErrorT $ do - a <- m - return (Right a) - -instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where - liftIO = lift . liftIO - -#if MIN_VERSION_base(4,12,0) -instance Contravariant m => Contravariant (ErrorT e m) where - contramap f = ErrorT . contramap (fmap f) . runErrorT -#endif - --- | Signal an error value @e@. --- --- * @'runErrorT' ('throwError' e) = 'return' ('Left' e)@ --- --- * @'throwError' e >>= m = 'throwError' e@ -throwError :: (Monad m) => e -> ErrorT e m a -throwError l = ErrorT $ return (Left l) - --- | Handle an error. --- --- * @'catchError' h ('lift' m) = 'lift' m@ --- --- * @'catchError' h ('throwError' e) = h e@ -catchError :: (Monad m) => - ErrorT e m a -- ^ the inner computation - -> (e -> ErrorT e m a) -- ^ a handler for errors in the inner - -- computation - -> ErrorT e m a -m `catchError` h = ErrorT $ do - a <- runErrorT m - case a of - Left l -> runErrorT (h l) - Right r -> return (Right r) - --- | Lift a @callCC@ operation to the new monad. -liftCallCC :: CallCC m (Either e a) (Either e b) -> CallCC (ErrorT e m) a b -liftCallCC callCC f = ErrorT $ - callCC $ \ c -> - runErrorT (f (\ a -> ErrorT $ c (Right a))) - --- | Lift a @listen@ operation to the new monad. -liftListen :: (Monad m) => Listen w m (Either e a) -> Listen w (ErrorT e m) a -liftListen listen = mapErrorT $ \ m -> do - (a, w) <- listen m - return $! fmap (\ r -> (r, w)) a - --- | Lift a @pass@ operation to the new monad. -liftPass :: (Monad m) => Pass w m (Either e a) -> Pass w (ErrorT e m) a -liftPass pass = mapErrorT $ \ m -> pass $ do - a <- m - return $! case a of - Left l -> (Left l, id) - Right (r, f) -> (Right r, f) - -{- $examples - -Wrapping an IO action that can throw an error @e@: - -> type ErrorWithIO e a = ErrorT e IO a -> ==> ErrorT (IO (Either e a)) - -An IO monad wrapped in @StateT@ inside of @ErrorT@: - -> type ErrorAndStateWithIO e s a = ErrorT e (StateT s IO) a -> ==> ErrorT (StateT s IO (Either e a)) -> ==> ErrorT (StateT (s -> IO (Either e a,s))) - --} diff --git a/Control/Monad/Trans/Except.hs b/Control/Monad/Trans/Except.hs --- a/Control/Monad/Trans/Except.hs +++ b/Control/Monad/Trans/Except.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -15,7 +16,8 @@ -- Stability : experimental -- Portability : portable -- --- This monad transformer extends a monad with the ability to throw exceptions. +-- This monad transformer extends a monad with the ability to throw +-- and catch exceptions. -- -- A sequence of actions terminates normally, producing a value, -- only if none of the actions in the sequence throws an exception. @@ -34,13 +36,16 @@ mapExcept, withExcept, -- * The ExceptT monad transformer - ExceptT(ExceptT), - runExceptT, + ExceptT(..), mapExceptT, withExceptT, -- * Exception operations throwE, catchE, + handleE, + tryE, + finallyE, + onE, -- * Lifting other operations liftCallCC, liftListen, @@ -65,13 +70,20 @@ #if MIN_VERSION_base(4,4,0) import Control.Monad.Zip (MonadZip(mzipWith)) #endif +#if !(MIN_VERSION_base(4,8,0)) || defined(__MHS__) import Data.Foldable (Foldable(foldMap)) -import Data.Monoid +import Data.Monoid (Monoid(mempty, mappend)) import Data.Traversable (Traversable(traverse)) +#endif +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif --- | The parameterizable exception monad. +-- | The parameterizable exception monad, which is strict. -- --- Computations are either exceptions or normal values. +-- Computations are either exceptions (of any type) or normal values. +-- These computations are plain values, and are unrelated to the +-- "Control.Exception" mechanism, which is tied to the 'IO' monad. -- -- The 'return' function returns a normal value, while @>>=@ exits on -- the first exception. For a variant that continues after an error @@ -107,16 +119,24 @@ -- | A monad transformer that adds exceptions to other monads. -- --- @ExceptT@ constructs a monad parameterized over two things: +-- @ExceptT@ constructs a strict monad parameterized over two things: -- --- * e - The exception type. +-- * e - An arbitrary exception type. -- -- * m - The inner monad. -- +-- The monadic computations are a plain values. They are unrelated to +-- the "Control.Exception" mechanism, which is tied to the 'IO' monad. +-- -- The 'return' function yields a computation that produces the given -- value, while @>>=@ sequences two subcomputations, exiting on the -- first exception. -newtype ExceptT e m a = ExceptT (m (Either e a)) +newtype ExceptT e m a = ExceptT { runExceptT :: m (Either e a) } +#if __GLASGOW_HASKELL__ >= 710 + deriving (Generic, Generic1) +#elif __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif instance (Eq e, Eq1 m) => Eq1 (ExceptT e m) where liftEq eq (ExceptT x) (ExceptT y) = liftEq (liftEq eq) x y @@ -150,11 +170,6 @@ instance (Show e, Show1 m, Show a) => Show (ExceptT e m a) where showsPrec = showsPrec1 --- | The inverse of 'ExceptT'. -runExceptT :: ExceptT e m a -> m (Either e a) -runExceptT (ExceptT m) = m -{-# INLINE runExceptT #-} - -- | Map the unwrapped computation using the given function. -- -- * @'runExceptT' ('mapExceptT' f m) = f ('runExceptT' m)@ @@ -291,6 +306,37 @@ Left l -> runExceptT (h l) Right r -> return (Right r) {-# INLINE catchE #-} + +-- | The same as @'flip' 'catchE'@, which is useful in situations where +-- the code for the handler is shorter. +handleE :: Monad m => (e -> ExceptT e' m a) -> ExceptT e m a -> ExceptT e' m a +handleE = flip catchE +{-# INLINE handleE #-} + +-- | Similar to 'catchE', but returns an 'Either' result which is +-- @('Right' a)@ if no exception was thown, or @('Left' ex)@ if an +-- exception @ex@ was thrown. +tryE :: Monad m => ExceptT e m a -> ExceptT e m (Either e a) +tryE m = catchE (liftM Right m) (return . Left) +{-# INLINE tryE #-} + +-- | @'finallyE' a b@ executes computation @a@ followed by computation @b@, +-- even if @a@ exits early by throwing an exception. In the latter case, +-- the exception is re-thrown after @b@ has been executed. +finallyE :: Monad m => ExceptT e m a -> ExceptT e m () -> ExceptT e m a +finallyE m closer = do + res <- tryE m + closer + either throwE return res +{-# INLINE finallyE #-} + +-- | If the first action succeeds, return its value, ignoring the +-- second action. If the first action throws an exception, run the +-- second action and then throw an exception, either the one thrown by +-- the second action, if any, or the one thrown by the first action. +onE :: (Monad m) => ExceptT e m a -> ExceptT e m b -> ExceptT e m a +onE action1 action2 = action1 `catchE` \ e -> action2 >> throwE e +{-# INLINE onE #-} -- | Lift a @callCC@ operation to the new monad. liftCallCC :: CallCC m (Either e a) (Either e b) -> CallCC (ExceptT e m) a b diff --git a/Control/Monad/Trans/Identity.hs b/Control/Monad/Trans/Identity.hs --- a/Control/Monad/Trans/Identity.hs +++ b/Control/Monad/Trans/Identity.hs @@ -1,11 +1,12 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -35,6 +36,9 @@ import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Signatures import Control.Monad.Trans.Class (MonadTrans(lift)) +#if MIN_VERSION_base(4,18,0) +import Data.Foldable1 (Foldable1(foldMap1)) +#endif import Data.Functor.Classes #if MIN_VERSION_base(4,12,0) import Data.Functor.Contravariant @@ -50,11 +54,21 @@ import Control.Monad.Zip (MonadZip(mzipWith)) #endif import Data.Foldable +#if !(MIN_VERSION_base(4,8,0)) || defined(__MHS__) import Data.Traversable (Traversable(traverse)) +#endif import Prelude hiding (foldr, foldr1, foldl, foldl1, null, length) +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif -- | The trivial monad transformer, which maps a monad to an equivalent monad. newtype IdentityT f a = IdentityT { runIdentityT :: f a } +#if __GLASGOW_HASKELL__ >= 710 + deriving (Generic, Generic1) +#elif __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif instance (Eq1 f) => Eq1 (IdentityT f) where liftEq eq (IdentityT x) (IdentityT y) = liftEq eq x y @@ -97,6 +111,12 @@ length (IdentityT t) = length t #endif +#if MIN_VERSION_base(4,18,0) +instance (Foldable1 m) => Foldable1 (IdentityT m) where + foldMap1 f (IdentityT t) = foldMap1 f t + {-# INLINE foldMap1 #-} +#endif + instance (Traversable f) => Traversable (IdentityT f) where traverse f (IdentityT a) = IdentityT <$> traverse f a {-# INLINE traverse #-} @@ -160,7 +180,7 @@ {-# INLINE lift #-} #if MIN_VERSION_base(4,12,0) -instance Contravariant f => Contravariant (IdentityT f) where +instance (Contravariant f) => Contravariant (IdentityT f) where contramap f = IdentityT . contramap f . runIdentityT {-# INLINE contramap #-} #endif diff --git a/Control/Monad/Trans/List.hs b/Control/Monad/Trans/List.hs deleted file mode 100644 --- a/Control/Monad/Trans/List.hs +++ /dev/null @@ -1,185 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.List --- Copyright : (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 ListT monad transformer, adding backtracking to a given monad, --- which must be commutative. ------------------------------------------------------------------------------ - -module Control.Monad.Trans.List - {-# DEPRECATED "This transformer is invalid on most monads" #-} ( - -- * The ListT monad transformer - ListT(..), - mapListT, - -- * Lifting other operations - liftCallCC, - liftCatch, - ) where - -import Control.Monad.IO.Class -import Control.Monad.Signatures -import Control.Monad.Trans.Class -import Data.Functor.Classes -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif - -import Control.Applicative -import Control.Monad -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Control.Monad.Fix -#if MIN_VERSION_base(4,4,0) -import Control.Monad.Zip (MonadZip(mzipWith)) -#endif -import Data.Foldable (Foldable(foldMap)) -import Data.Traversable (Traversable(traverse)) - --- | Parameterizable list monad, with an inner monad. --- --- /Note:/ this does not yield a monad unless the argument monad is commutative. -newtype ListT m a = ListT { runListT :: m [a] } - -instance (Eq1 m) => Eq1 (ListT m) where - liftEq eq (ListT x) (ListT y) = liftEq (liftEq eq) x y - {-# INLINE liftEq #-} - -instance (Ord1 m) => Ord1 (ListT m) where - liftCompare comp (ListT x) (ListT y) = liftCompare (liftCompare comp) x y - {-# INLINE liftCompare #-} - -instance (Read1 m) => Read1 (ListT m) where - liftReadsPrec rp rl = readsData $ - readsUnaryWith (liftReadsPrec rp' rl') "ListT" ListT - where - rp' = liftReadsPrec rp rl - rl' = liftReadList rp rl - -instance (Show1 m) => Show1 (ListT m) where - liftShowsPrec sp sl d (ListT m) = - showsUnaryWith (liftShowsPrec sp' sl') "ListT" d m - where - sp' = liftShowsPrec sp sl - sl' = liftShowList sp sl - -instance (Eq1 m, Eq a) => Eq (ListT m a) where (==) = eq1 -instance (Ord1 m, Ord a) => Ord (ListT m a) where compare = compare1 -instance (Read1 m, Read a) => Read (ListT m a) where readsPrec = readsPrec1 -instance (Show1 m, Show a) => Show (ListT m a) where showsPrec = showsPrec1 - --- | Map between 'ListT' computations. --- --- * @'runListT' ('mapListT' f m) = f ('runListT' m)@ -mapListT :: (m [a] -> n [b]) -> ListT m a -> ListT n b -mapListT f m = ListT $ f (runListT m) -{-# INLINE mapListT #-} - -instance (Functor m) => Functor (ListT m) where - fmap f = mapListT $ fmap $ map f - {-# INLINE fmap #-} - -instance (Foldable f) => Foldable (ListT f) where - foldMap f (ListT a) = foldMap (foldMap f) a - {-# INLINE foldMap #-} - -instance (Traversable f) => Traversable (ListT f) where - traverse f (ListT a) = ListT <$> traverse (traverse f) a - {-# INLINE traverse #-} - -instance (Applicative m) => Applicative (ListT m) where - pure a = ListT $ pure [a] - {-# INLINE pure #-} - f <*> v = ListT $ (<*>) <$> runListT f <*> runListT v - {-# INLINE (<*>) #-} - -instance (Applicative m) => Alternative (ListT m) where - empty = ListT $ pure [] - {-# INLINE empty #-} - m <|> n = ListT $ (++) <$> runListT m <*> runListT n - {-# INLINE (<|>) #-} - -instance (Monad m) => Monad (ListT m) where -#if !(MIN_VERSION_base(4,8,0)) - return a = ListT $ return [a] - {-# INLINE return #-} -#endif - m >>= k = ListT $ do - a <- runListT m - 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 - fail _ = ListT $ return [] - {-# INLINE fail #-} -#endif - -instance (Monad m) => MonadPlus (ListT m) where - mzero = ListT $ return [] - {-# INLINE mzero #-} - m `mplus` n = ListT $ do - a <- runListT m - b <- runListT n - return (a ++ b) - {-# INLINE mplus #-} - -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))) - {-# INLINE mfix #-} - -instance MonadTrans ListT where - lift m = ListT $ do - a <- m - return [a] - {-# INLINE lift #-} - -instance (MonadIO m) => MonadIO (ListT m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} - -#if MIN_VERSION_base(4,4,0) -instance (MonadZip m) => MonadZip (ListT m) where - mzipWith f (ListT a) (ListT b) = ListT $ mzipWith (zipWith f) a b - {-# INLINE mzipWith #-} -#endif - -#if MIN_VERSION_base(4,12,0) -instance Contravariant m => Contravariant (ListT m) where - contramap f = ListT . contramap (fmap f) . runListT - {-# INLINE contramap #-} -#endif - --- | Lift a @callCC@ operation to the new monad. -liftCallCC :: CallCC m [a] [b] -> CallCC (ListT m) a b -liftCallCC callCC f = ListT $ - callCC $ \ c -> - runListT (f (\ a -> ListT $ c [a])) -{-# INLINE liftCallCC #-} - --- | Lift a @catchE@ operation to the new monad. -liftCatch :: Catch e m [a] -> Catch e (ListT m) a -liftCatch catchE m h = ListT $ runListT m - `catchE` \ e -> runListT (h e) -{-# INLINE liftCatch #-} diff --git a/Control/Monad/Trans/Maybe.hs b/Control/Monad/Trans/Maybe.hs --- a/Control/Monad/Trans/Maybe.hs +++ b/Control/Monad/Trans/Maybe.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -31,6 +32,7 @@ MaybeT(..), mapMaybeT, -- * Monad transformations + hoistMaybe, maybeToExceptT, exceptToMaybeT, -- * Lifting other operations @@ -58,12 +60,17 @@ #if MIN_VERSION_base(4,4,0) import Control.Monad.Zip (MonadZip(mzipWith)) #endif -import Data.Foldable (Foldable(foldMap)) import Data.Maybe (fromMaybe) +#if !(MIN_VERSION_base(4,8,0)) || defined(__MHS__) +import Data.Foldable (Foldable(foldMap)) import Data.Traversable (Traversable(traverse)) +#endif +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif --- | The parameterizable maybe monad, obtained by composing an arbitrary --- monad with the 'Maybe' monad. +-- | The parameterizable maybe monad, a strict monad obtained by composing +-- an arbitrary monad with the 'Maybe' monad. -- -- Computations are actions that may produce a value or exit. -- @@ -71,6 +78,11 @@ -- value, while @>>=@ sequences two subcomputations, exiting if either -- computation does. newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) } +#if __GLASGOW_HASKELL__ >= 710 + deriving (Generic, Generic1) +#elif __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif instance (Eq1 m) => Eq1 (MaybeT m) where liftEq eq (MaybeT x) (MaybeT y) = liftEq (liftEq eq) x y @@ -105,6 +117,10 @@ mapMaybeT :: (m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b mapMaybeT f = MaybeT . f . runMaybeT {-# INLINE mapMaybeT #-} + +-- | Convert a 'Maybe' computation to 'MaybeT'. +hoistMaybe :: (Applicative m) => Maybe b -> MaybeT m b +hoistMaybe = MaybeT . pure -- | Convert a 'MaybeT' computation to 'ExceptT', with a default -- exception value. diff --git a/Control/Monad/Trans/RWS.hs b/Control/Monad/Trans/RWS.hs --- a/Control/Monad/Trans/RWS.hs +++ b/Control/Monad/Trans/RWS.hs @@ -13,7 +13,9 @@ -- Stability : experimental -- Portability : portable -- --- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'. +-- A monad transformer that combines 'Control.Monad.Trans.Reader.ReaderT', +-- 'Control.Monad.Trans.Writer.Lazy.WriterT' and +-- 'Control.Monad.Trans.State.Lazy.StateT'. -- This version is lazy; for a constant-space version with almost the -- same interface, see "Control.Monad.Trans.RWS.CPS". ----------------------------------------------------------------------------- diff --git a/Control/Monad/Trans/RWS/CPS.hs b/Control/Monad/Trans/RWS/CPS.hs --- a/Control/Monad/Trans/RWS/CPS.hs +++ b/Control/Monad/Trans/RWS/CPS.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -17,13 +18,15 @@ -- Stability : experimental -- Portability : portable -- --- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'. +-- A monad transformer that combines 'Control.Monad.Trans.Reader.ReaderT', +-- 'Control.Monad.Trans.Writer.CPS.WriterT' and +-- 'Control.Monad.Trans.State.Strict.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, @@ -80,6 +83,9 @@ #if MIN_VERSION_base(4,9,0) import qualified Control.Monad.Fail as Fail #endif +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif -- | A monad containing an environment of type @r@, output of type @w@ -- and an updatable state of type @s@. @@ -143,6 +149,9 @@ -- 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) } +#if __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif -- | Construct an RWST computation from a function. -- (The inverse of 'runRWST'.) @@ -400,6 +409,9 @@ {-# INLINE liftCallCC' #-} -- | Lift a @catchE@ operation to the new monad. +-- The uniformity property (see "Control.Monad.Signatures") implies that +-- the lifted @catchE@ discards any output or changes to the state from +-- the body on entering the handler. 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 diff --git a/Control/Monad/Trans/RWS/Lazy.hs b/Control/Monad/Trans/RWS/Lazy.hs --- a/Control/Monad/Trans/RWS/Lazy.hs +++ b/Control/Monad/Trans/RWS/Lazy.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -16,7 +17,9 @@ -- Stability : experimental -- Portability : portable -- --- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'. +-- A monad transformer that combines 'Control.Monad.Trans.Reader.ReaderT', +-- 'Control.Monad.Trans.Writer.Lazy.WriterT' and +-- 'Control.Monad.Trans.State.Lazy.StateT'. -- This version is lazy; for a constant-space version with almost the -- same interface, see "Control.Monad.Trans.RWS.CPS". ----------------------------------------------------------------------------- @@ -74,7 +77,12 @@ import qualified Control.Monad.Fail as Fail #endif import Control.Monad.Fix +#if !(MIN_VERSION_base(4,8,0)) import Data.Monoid +#endif +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif -- | A monad containing an environment of type @r@, output of type @w@ -- and an updatable state of type @s@. @@ -135,7 +143,9 @@ -- 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 { runRWST :: r -> s -> m (a, s, w) } - +#if __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif -- | Evaluate a computation with the given initial state and environment, -- returning the final value and output, discarding the final state. evalRWST :: (Monad m) @@ -383,6 +393,9 @@ {-# INLINE liftCallCC' #-} -- | Lift a @catchE@ operation to the new monad. +-- The uniformity property (see "Control.Monad.Signatures") implies that +-- the lifted @catchE@ discards any output or changes to the state from +-- the body on entering the handler. liftCatch :: Catch e m (a,s,w) -> Catch e (RWST r w s m) a liftCatch catchE m h = RWST $ \ r s -> runRWST m r s `catchE` \ e -> runRWST (h e) r s diff --git a/Control/Monad/Trans/RWS/Strict.hs b/Control/Monad/Trans/RWS/Strict.hs --- a/Control/Monad/Trans/RWS/Strict.hs +++ b/Control/Monad/Trans/RWS/Strict.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -16,7 +17,9 @@ -- Stability : experimental -- Portability : portable -- --- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'. +-- A monad transformer that combines 'Control.Monad.Trans.Reader.ReaderT', +-- 'Control.Monad.Trans.Writer.Strict.WriterT' and +-- 'Control.Monad.Trans.State.Strict.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 @@ -77,7 +80,12 @@ import qualified Control.Monad.Fail as Fail #endif import Control.Monad.Fix +#if !(MIN_VERSION_base(4,8,0)) import Data.Monoid +#endif +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif -- | A monad containing an environment of type @r@, output of type @w@ -- and an updatable state of type @s@. @@ -138,6 +146,9 @@ -- 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 { runRWST :: r -> s -> m (a, s, w) } +#if __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif -- | Evaluate a computation with the given initial state and environment, -- returning the final value and output, discarding the final state. @@ -386,6 +397,9 @@ {-# INLINE liftCallCC' #-} -- | Lift a @catchE@ operation to the new monad. +-- The uniformity property (see "Control.Monad.Signatures") implies that +-- the lifted @catchE@ discards any output or changes to the state from +-- the body on entering the handler. liftCatch :: Catch e m (a,s,w) -> Catch e (RWST r w s m) a liftCatch catchE m h = RWST $ \ r s -> runRWST m r s `catchE` \ e -> runRWST (h e) r s diff --git a/Control/Monad/Trans/Reader.hs b/Control/Monad/Trans/Reader.hs --- a/Control/Monad/Trans/Reader.hs +++ b/Control/Monad/Trans/Reader.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -63,16 +64,22 @@ #if MIN_VERSION_base(4,4,0) import Control.Monad.Zip (MonadZip(mzipWith)) #endif -#if MIN_VERSION_base(4,2,0) -import Data.Functor(Functor(..)) +#if (MIN_VERSION_base(4,2,0)) && !(MIN_VERSION_base(4,8,0)) +import Data.Functor ((<$)) #endif +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif --- | The parameterizable reader monad. +-- | The parameterizable reader monad, which is non-strict. -- -- Computations are functions of a shared environment. -- --- The 'return' function ignores the environment, while @>>=@ passes --- the inherited environment to both subcomputations. +-- The 'return' function ignores the environment, while @m '>>=' k@ +-- passes the inherited environment to both subcomputations: +-- +-- <> +-- type Reader r = ReaderT r Identity -- | Constructor for computations in the reader monad (equivalent to 'asks'). @@ -110,9 +117,19 @@ -- | The reader monad transformer, -- which adds a read-only environment to the given monad. -- --- The 'return' function ignores the environment, while @>>=@ passes --- the inherited environment to both subcomputations. +-- The 'return' function ignores the environment, while @m '>>=' k@ +-- passes the inherited environment to both subcomputations: +-- +-- <> +-- +-- +-- @ReaderT r m@ is strict if and only if @m@ is. newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a } +#if __GLASGOW_HASKELL__ >= 710 + deriving (Generic, Generic1) +#elif __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif -- | Transform the computation inside a @ReaderT@. -- diff --git a/Control/Monad/Trans/Select.hs b/Control/Monad/Trans/Select.hs --- a/Control/Monad/Trans/Select.hs +++ b/Control/Monad/Trans/Select.hs @@ -1,11 +1,12 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -36,12 +37,10 @@ runSelect, mapSelect, -- * The SelectT monad transformer - SelectT(SelectT), - runSelectT, + SelectT(..), mapSelectT, -- * Monad transformation selectToContT, - selectToCont, ) where import Control.Monad.IO.Class @@ -54,8 +53,11 @@ import qualified Control.Monad.Fail as Fail #endif import Data.Functor.Identity +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif --- | Selection monad. +-- | The selection monad, which is non-strict. type Select r = SelectT r Identity -- | Constructor for computations in the selection monad. @@ -80,13 +82,15 @@ -- -- 'SelectT' is not a functor on the category of monads, and many operations -- cannot be lifted through it. -newtype SelectT r m a = SelectT ((a -> m r) -> m a) - --- | Runs a @SelectT@ computation with a function for evaluating answers --- to select a particular answer. (The inverse of 'select'.) -runSelectT :: SelectT r m a -> (a -> m r) -> m a -runSelectT (SelectT g) = g -{-# INLINE runSelectT #-} +-- +-- @SelectT r m@ is strict if and only if @m@ is. +newtype SelectT r m a = SelectT { + -- | Runs a @SelectT@ computation with a function for evaluating + -- answers to select a particular answer. + runSelectT :: (a -> m r) -> m a } +#if __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif -- | Apply a function to transform the result of a selection computation. -- This has a more restricted type than the @map@ operations for other @@ -153,9 +157,4 @@ -- | Convert a selection computation to a continuation-passing computation. selectToContT :: (Monad m) => SelectT r m a -> ContT r m a selectToContT (SelectT g) = ContT $ \ k -> g k >>= k -{-# INLINE selectToCont #-} - --- | Deprecated name for 'selectToContT'. -{-# DEPRECATED selectToCont "Use selectToContT instead" #-} -selectToCont :: (Monad m) => SelectT r m a -> ContT r m a -selectToCont = selectToContT +{-# INLINE selectToContT #-} diff --git a/Control/Monad/Trans/State/Lazy.hs b/Control/Monad/Trans/State/Lazy.hs --- a/Control/Monad/Trans/State/Lazy.hs +++ b/Control/Monad/Trans/State/Lazy.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -55,6 +56,7 @@ put, modify, modify', + modifyM, gets, -- * Lifting other operations liftCallCC, @@ -62,6 +64,9 @@ liftCatch, liftListen, liftPass, + -- * Conversion to and from the strict version + strictToLazyStateT, + lazyToStrictStateT, -- * Examples -- ** State monads -- $examples @@ -76,6 +81,7 @@ import Control.Monad.IO.Class import Control.Monad.Signatures import Control.Monad.Trans.Class +import qualified Control.Monad.Trans.State.Strict as Strict #if MIN_VERSION_base(4,12,0) import Data.Functor.Contravariant #endif @@ -87,6 +93,9 @@ import qualified Control.Monad.Fail as Fail #endif import Control.Monad.Fix +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif -- --------------------------------------------------------------------------- -- | A state monad parameterized by the type @s@ of the state to carry. @@ -159,6 +168,9 @@ -- the final state of the first computation as the initial state of -- the second. newtype StateT s m a = StateT { runStateT :: s -> m (a,s) } +#if __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif -- | Evaluate a state computation with the given initial state -- and return the final value, discarding the final state. @@ -293,6 +305,14 @@ put $! f s {-# INLINE modify' #-} +-- | A variant of 'modify' in which the new state is generated by a +-- monadic action. +modifyM :: (Monad m) => (s -> m s) -> StateT s m () +modifyM f = StateT $ \ s -> do + s' <- f s + return ((), s') +{-# INLINE modifyM #-} + -- | Get a specific component of the state, using a projection function -- supplied. -- @@ -320,6 +340,9 @@ {-# INLINE liftCallCC' #-} -- | Lift a @catchE@ operation to the new monad. +-- The uniformity property (see "Control.Monad.Signatures") implies +-- that the lifted @catchE@ rolls back to the original state on entering +-- the handler. liftCatch :: Catch e m (a,s) -> Catch e (StateT s m) a liftCatch catchE m h = StateT $ \ s -> runStateT m s `catchE` \ e -> runStateT (h e) s @@ -338,6 +361,16 @@ ~((a, f), s') <- runStateT m s return ((a, s'), f) {-# INLINE liftPass #-} + +-- | Convert from the strict version to the lazy version +strictToLazyStateT :: Strict.StateT s m a -> StateT s m a +strictToLazyStateT (Strict.StateT f) = StateT f +{-# INLINE strictToLazyStateT #-} + +-- | Convert from the lazy version to the strict version +lazyToStrictStateT :: StateT s m a -> Strict.StateT s m a +lazyToStrictStateT (StateT f) = Strict.StateT f +{-# INLINE lazyToStrictStateT #-} {- $examples diff --git a/Control/Monad/Trans/State/Strict.hs b/Control/Monad/Trans/State/Strict.hs --- a/Control/Monad/Trans/State/Strict.hs +++ b/Control/Monad/Trans/State/Strict.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -52,6 +53,7 @@ put, modify, modify', + modifyM, gets, -- * Lifting other operations liftCallCC, @@ -84,6 +86,9 @@ import qualified Control.Monad.Fail as Fail #endif import Control.Monad.Fix +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif -- --------------------------------------------------------------------------- -- | A state monad parameterized by the type @s@ of the state to carry. @@ -156,6 +161,9 @@ -- the final state of the first computation as the initial state of -- the second. newtype StateT s m a = StateT { runStateT :: s -> m (a,s) } +#if __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif -- | Evaluate a state computation with the given initial state -- and return the final value, discarding the final state. @@ -284,12 +292,24 @@ -- new state. -- -- * @'modify'' f = 'get' >>= (('$!') 'put' . f)@ +-- +-- Note that this is only strict in the top level of the state. +-- Lazy components of the state will not be evaluated unless @f@ +-- evaluates them. modify' :: (Monad m) => (s -> s) -> StateT s m () modify' f = do s <- get put $! f s {-# INLINE modify' #-} +-- | A variant of 'modify' in which the new state is generated by a +-- monadic action. +modifyM :: (Monad m) => (s -> m s) -> StateT s m () +modifyM f = StateT $ \ s -> do + s' <- f s + return ((), s') +{-# INLINE modifyM #-} + -- | Get a specific component of the state, using a projection function -- supplied. -- @@ -317,6 +337,9 @@ {-# INLINE liftCallCC' #-} -- | Lift a @catchE@ operation to the new monad. +-- The uniformity property (see "Control.Monad.Signatures") implies +-- that the lifted @catchE@ rolls back to the original state on entering +-- the handler. liftCatch :: Catch e m (a,s) -> Catch e (StateT s m) a liftCatch catchE m h = StateT $ \ s -> runStateT m s `catchE` \ e -> runStateT (h e) s diff --git a/Control/Monad/Trans/Writer/CPS.hs b/Control/Monad/Trans/Writer/CPS.hs --- a/Control/Monad/Trans/Writer/CPS.hs +++ b/Control/Monad/Trans/Writer/CPS.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -68,12 +69,19 @@ #if MIN_VERSION_base(4,9,0) import qualified Control.Monad.Fail as Fail #endif +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#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'. +-- The 'return' function produces the output 'mempty', while @m '>>=' k@ +-- combines the outputs of the subcomputations using 'mappend' (also +-- known as @<>@): +-- +-- <> +-- type Writer w = WriterT w Identity -- | Construct a writer computation from a (result, output) pair. @@ -112,10 +120,16 @@ -- -- * @m@ - The inner monad. -- --- The 'return' function produces the output 'mempty', while '>>=' --- combines the outputs of the subcomputations using 'mappend'. - +-- The 'return' function produces the output 'mempty', while @m '>>=' k@ +-- combines the outputs of the subcomputations using 'mappend' (also +-- known as @<>@): +-- +-- <> +-- newtype WriterT w m a = WriterT { unWriterT :: w -> m (a, w) } +#if __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif -- | Construct a writer computation from a (result, output) computation. -- (The inverse of 'runWriterT'.) @@ -269,14 +283,18 @@ {-# INLINE censor #-} -- | Uniform lifting of a @callCC@ operation to the new monad. --- This version rolls back to the original state on entering the --- continuation. +-- The uniformity property (see "Control.Monad.Signatures") implies that +-- the lifted @callCC@ discards any output from the body on entering +-- the saved 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. +-- The uniformity property (see "Control.Monad.Signatures") implies that +-- the lifted @catchE@ discards any output from the body on entering +-- the handler. 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 diff --git a/Control/Monad/Trans/Writer/Lazy.hs b/Control/Monad/Trans/Writer/Lazy.hs --- a/Control/Monad/Trans/Writer/Lazy.hs +++ b/Control/Monad/Trans/Writer/Lazy.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -69,14 +70,23 @@ #endif import Data.Foldable import Data.Monoid +#if !(MIN_VERSION_base(4,8,0)) || defined(__MHS__) import Data.Traversable (Traversable(traverse)) +#endif import Prelude hiding (null, length) +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#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'. +-- The 'return' function produces the output 'mempty', while @m '>>=' k@ +-- combines the outputs of the subcomputations using 'mappend' (also +-- known as @<>@): +-- +-- <> +-- type Writer w = WriterT w Identity -- | Construct a writer computation from a (result, output) pair. @@ -113,9 +123,16 @@ -- -- * @m@ - The inner monad. -- --- The 'return' function produces the output 'mempty', while @>>=@ --- combines the outputs of the subcomputations using 'mappend'. +-- The 'return' function produces the output 'mempty', while @m '>>=' k@ +-- combines the outputs of the subcomputations using 'mappend' (also +-- known as @<>@): +-- +-- <> +-- newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } +#if __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif instance (Eq w, Eq1 m) => Eq1 (WriterT w m) where liftEq eq (WriterT m1) (WriterT m2) = liftEq (liftEq2 eq (==)) m1 m2 @@ -300,6 +317,9 @@ {-# INLINE censor #-} -- | Lift a @callCC@ operation to the new monad. +-- The uniformity property (see "Control.Monad.Signatures") implies that +-- the lifted @callCC@ discards any output from the body on entering +-- the saved condinuation. liftCallCC :: (Monoid w) => CallCC m (a,w) (b,w) -> CallCC (WriterT w m) a b liftCallCC callCC f = WriterT $ callCC $ \ c -> @@ -307,6 +327,9 @@ {-# INLINE liftCallCC #-} -- | Lift a @catchE@ operation to the new monad. +-- The uniformity property (see "Control.Monad.Signatures") implies that +-- the lifted @catchE@ discards any output from the body on entering +-- the handler. liftCatch :: Catch e m (a,w) -> Catch e (WriterT w m) a liftCatch catchE m h = WriterT $ runWriterT m `catchE` \ e -> runWriterT (h e) diff --git a/Control/Monad/Trans/Writer/Strict.hs b/Control/Monad/Trans/Writer/Strict.hs --- a/Control/Monad/Trans/Writer/Strict.hs +++ b/Control/Monad/Trans/Writer/Strict.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -72,14 +73,23 @@ #endif import Data.Foldable import Data.Monoid +#if !(MIN_VERSION_base(4,8,0)) || defined(__MHS__) import Data.Traversable (Traversable(traverse)) +#endif import Prelude hiding (null, length) +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#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'. +-- The 'return' function produces the output 'mempty', while @m '>>=' k@ +-- combines the outputs of the subcomputations using 'mappend' (also +-- known as @<>@): +-- +-- <> +-- type Writer w = WriterT w Identity -- | Construct a writer computation from a (result, output) pair. @@ -116,9 +126,16 @@ -- -- * @m@ - The inner monad. -- --- The 'return' function produces the output 'mempty', while @>>=@ --- combines the outputs of the subcomputations using 'mappend'. +-- The 'return' function produces the output 'mempty', while @m '>>=' k@ +-- combines the outputs of the subcomputations using 'mappend' (also +-- known as @<>@): +-- +-- <> +-- newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } +#if __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif instance (Eq w, Eq1 m) => Eq1 (WriterT w m) where liftEq eq (WriterT m1) (WriterT m2) = liftEq (liftEq2 eq (==)) m1 m2 @@ -303,6 +320,9 @@ {-# INLINE censor #-} -- | Lift a @callCC@ operation to the new monad. +-- The uniformity property (see "Control.Monad.Signatures") implies that +-- the lifted @callCC@ discards any output from the body on entering +-- the saved continuation. liftCallCC :: (Monoid w) => CallCC m (a,w) (b,w) -> CallCC (WriterT w m) a b liftCallCC callCC f = WriterT $ callCC $ \ c -> @@ -310,6 +330,9 @@ {-# INLINE liftCallCC #-} -- | Lift a @catchE@ operation to the new monad. +-- The uniformity property (see "Control.Monad.Signatures") implies that +-- the lifted @catchE@ discards any output from the body on entering +-- the handler. liftCatch :: Catch e m (a,w) -> Catch e (WriterT w m) a liftCatch catchE m h = WriterT $ runWriterT m `catchE` \ e -> runWriterT (h e) diff --git a/Data/Functor/Constant.hs b/Data/Functor/Constant.hs --- a/Data/Functor/Constant.hs +++ b/Data/Functor/Constant.hs @@ -1,11 +1,15 @@ {-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# LANGUAGE DeriveDataTypeable #-} +#endif #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -32,23 +36,40 @@ import Control.Applicative import Data.Foldable +#if !(MIN_VERSION_base(4,8,0)) || defined(__MHS__) import Data.Monoid (Monoid(..)) import Data.Traversable (Traversable(traverse)) +#endif #if MIN_VERSION_base(4,8,0) import Data.Bifunctor (Bifunctor(..)) #endif -#if MIN_VERSION_base(4,9,0) -import Data.Semigroup (Semigroup(..)) +#if (MIN_VERSION_base(4,9,0)) && !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup (Semigroup((<>))) #endif #if MIN_VERSION_base(4,10,0) import Data.Bifoldable (Bifoldable(..)) import Data.Bitraversable (Bitraversable(..)) #endif import Prelude hiding (null, length) +#if __GLASGOW_HASKELL__ >= 800 +import Data.Data +#endif +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif -- | Constant functor. newtype Constant a b = Constant { getConstant :: a } - deriving (Eq, Ord) + deriving (Eq, Ord +#if __GLASGOW_HASKELL__ >= 800 + , Data +#endif +#if __GLASGOW_HASKELL__ >= 710 + , Generic, Generic1 +#elif __GLASGOW_HASKELL__ >= 704 + , Generic +#endif + ) -- These instances would be equivalent to the derived instances of the -- newtype if the field were removed. diff --git a/Data/Functor/Reverse.hs b/Data/Functor/Reverse.hs --- a/Data/Functor/Reverse.hs +++ b/Data/Functor/Reverse.hs @@ -1,11 +1,12 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802 {-# LANGUAGE AutoDeriveTypeable #-} #endif ----------------------------------------------------------------------------- @@ -27,6 +28,9 @@ ) where import Control.Applicative.Backwards +#if MIN_VERSION_base(4,18,0) +import Data.Foldable1 (Foldable1(foldMap1)) +#endif import Data.Functor.Classes #if MIN_VERSION_base(4,12,0) import Data.Functor.Contravariant @@ -39,12 +43,22 @@ import qualified Control.Monad.Fail as Fail #endif import Data.Foldable -import Data.Traversable +#if !(MIN_VERSION_base(4,8,0)) || defined(__MHS__) +import Data.Traversable (Traversable(traverse)) +#endif import Data.Monoid +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics +#endif -- | The same functor, but with 'Foldable' and 'Traversable' instances -- that process the elements in the reverse order. newtype Reverse f a = Reverse { getReverse :: f a } +#if __GLASGOW_HASKELL__ >= 710 + deriving (Generic, Generic1) +#elif __GLASGOW_HASKELL__ >= 704 + deriving (Generic) +#endif instance (Eq1 f) => Eq1 (Reverse f) where liftEq eq (Reverse x) (Reverse y) = liftEq eq x y @@ -129,6 +143,12 @@ length (Reverse t) = length t #endif +#if MIN_VERSION_base(4,18,0) +-- | Fold from right to left. +instance (Foldable1 f) => Foldable1 (Reverse f) where + foldMap1 f (Reverse t) = getDual (foldMap1 (Dual . f) t) +#endif + -- | Traverse from right to left. instance (Traversable f) => Traversable (Reverse f) where traverse f (Reverse t) = @@ -137,7 +157,7 @@ #if MIN_VERSION_base(4,12,0) -- | Derived instance. -instance Contravariant f => Contravariant (Reverse f) where +instance (Contravariant f) => Contravariant (Reverse f) where contramap f = Reverse . contramap f . getReverse {-# INLINE contramap #-} #endif diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,5 +1,55 @@ -*-change-log-*- +0.6.3.0 Ross Paterson Jan 2026 + * Add Control.Monad.Trans.Except.onE + * Add strictToLazyState and lazyToStrictStateT + +0.6.2.0 Ross Paterson Apr 2025 + * Redefine runAccumT, runExceptT and runSelectT as fields + * Document strictness of some transformers + +0.6.1.2 Ross Paterson Sep 2024 + * Portability fixes for MicroHs + * Include image files in the bundle + * Expand ExceptT documentation + +0.6.1.1 Ross Paterson Aug 2023 + * Additions to documentation, especially of AccumT. + +0.6.1.0 Ross Paterson Feb 2023 + * Add instances of Foldable1 (class added to base-4.18) + * Add modifyM to StateT transformers + +0.6.0.6 Ross Paterson Jan 2023 + * Fix for GHC 8.6 + +0.6.0.5 Ross Paterson Jan 2023 + * Revert to allowing MonadTrans constraint with GHC >= 8.6 + +0.6.0.4 Ross Paterson Feb 2022 + * Restrict deriving (Generic) to GHC >= 7.4 + +0.6.0.3 Ross Paterson Feb 2022 + * Restrict MonadTrans constraint to GHC >= 8.8 + +0.6.0.2 Ross Paterson Jul 2021 + * Further backward compatability fix + +0.6.0.1 Ross Paterson Jul 2021 + * Backward compatability fixes + +0.6.0.0 Ross Paterson Jul 2021 + * Added quantified constraint to MonadTrans (for GHC >= 8.6) + * Added Generic and Data instances + * Added handleE, tryE and finallyE to Control.Monad.Trans.Except + * Added hoistMaybe to Control.Monad.Trans.Maybe + * Added Generic and Data instances + * Added pass-throughs to instances for Backwards + * Made Lift's <*> lazier + * Remove long-deprecated selectToCont + * Remove long-deprecated Control.Monad.Trans.Error + * Remove long-deprecated Control.Monad.Trans.List + 0.5.6.2 Ross Paterson Feb 2019 * Further backward compatability fix diff --git a/images/bind-AccumT.svg b/images/bind-AccumT.svg new file mode 100644 --- /dev/null +++ b/images/bind-AccumT.svg @@ -0,0 +1,66 @@ + + + + + + + + + + + + + + + + + + <> + + + + + <> + + + w + + + + + m + + k + + diff --git a/images/bind-ReaderT.svg b/images/bind-ReaderT.svg new file mode 100644 --- /dev/null +++ b/images/bind-ReaderT.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + r + + + + + m + + k + + diff --git a/images/bind-WriterT.svg b/images/bind-WriterT.svg new file mode 100644 --- /dev/null +++ b/images/bind-WriterT.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + <> + + + w + + + + + m + + k + + diff --git a/legacy/pre709/Data/Functor/Identity.hs b/legacy/pre709/Data/Functor/Identity.hs --- a/legacy/pre709/Data/Functor/Identity.hs +++ b/legacy/pre709/Data/Functor/Identity.hs @@ -61,7 +61,7 @@ #endif import Data.Ix (Ix(..)) import Foreign (Storable(..), castPtr) -#if __GLASGOW_HASKELL__ >= 702 +#if __GLASGOW_HASKELL__ >= 704 import GHC.Generics #endif @@ -71,7 +71,7 @@ #if __GLASGOW_HASKELL__ >= 700 , Data, Typeable #endif -#if __GLASGOW_HASKELL__ >= 702 +#if __GLASGOW_HASKELL__ >= 704 , Generic #endif #if __GLASGOW_HASKELL__ >= 706 diff --git a/legacy/pre711/Data/Functor/Compose.hs b/legacy/pre711/Data/Functor/Compose.hs --- a/legacy/pre711/Data/Functor/Compose.hs +++ b/legacy/pre711/Data/Functor/Compose.hs @@ -45,7 +45,7 @@ #endif import Data.Foldable (Foldable(foldMap)) import Data.Traversable (Traversable(traverse)) -#if __GLASGOW_HASKELL__ >= 702 +#if __GLASGOW_HASKELL__ >= 704 import GHC.Generics #endif @@ -56,7 +56,7 @@ -- but the composition of monads is not always a monad. newtype Compose f g a = Compose { getCompose :: f (g a) } -#if __GLASGOW_HASKELL__ >= 702 +#if __GLASGOW_HASKELL__ >= 704 deriving instance Generic (Compose f g a) instance Functor f => Generic1 (Compose f g) where diff --git a/legacy/pre711/Data/Functor/Product.hs b/legacy/pre711/Data/Functor/Product.hs --- a/legacy/pre711/Data/Functor/Product.hs +++ b/legacy/pre711/Data/Functor/Product.hs @@ -50,14 +50,14 @@ #endif import Data.Monoid (mappend) import Data.Traversable (Traversable(traverse)) -#if __GLASGOW_HASKELL__ >= 702 +#if __GLASGOW_HASKELL__ >= 704 import GHC.Generics #endif -- | Lifted product of functors. data Product f g a = Pair (f a) (g a) -#if __GLASGOW_HASKELL__ >= 702 +#if __GLASGOW_HASKELL__ >= 704 deriving instance Generic (Product f g a) instance Generic1 (Product f g) where diff --git a/legacy/pre711/Data/Functor/Sum.hs b/legacy/pre711/Data/Functor/Sum.hs --- a/legacy/pre711/Data/Functor/Sum.hs +++ b/legacy/pre711/Data/Functor/Sum.hs @@ -45,14 +45,14 @@ #endif import Data.Monoid (mappend) import Data.Traversable (Traversable(traverse)) -#if __GLASGOW_HASKELL__ >= 702 +#if __GLASGOW_HASKELL__ >= 704 import GHC.Generics #endif -- | Lifted sum of functors. data Sum f g a = InL (f a) | InR (g a) -#if __GLASGOW_HASKELL__ >= 702 +#if __GLASGOW_HASKELL__ >= 704 deriving instance Generic (Sum f g a) instance Generic1 (Sum f g) where diff --git a/transformers.cabal b/transformers.cabal --- a/transformers.cabal +++ b/transformers.cabal @@ -1,5 +1,5 @@ name: transformers -version: 0.5.6.2 +version: 0.6.3.0 license: BSD3 license-file: LICENSE author: Andy Gill, Ross Paterson @@ -31,24 +31,28 @@ the @mtl@ or @monads-tf@ packages, which automatically lift operations introduced by monad transformers through other transformers. build-type: Simple -extra-source-files: +extra-doc-files: changelog -cabal-version: >= 1.6 + images/bind-AccumT.svg + images/bind-ReaderT.svg + images/bind-WriterT.svg +cabal-version: 1.18 source-repository head type: darcs location: http://hub.darcs.net/ross/transformers library + default-language: Haskell2010 build-depends: base >= 2 && < 6 hs-source-dirs: . - if !impl(ghc>=7.9) + if impl(ghc<7.9) -- Data.Functor.Identity was moved into base-4.8.0.0 (GHC 7.10) -- see also https://ghc.haskell.org/trac/ghc/ticket/9664 -- NB: using impl(ghc>=7.9) instead of fragile Cabal flags hs-source-dirs: legacy/pre709 exposed-modules: Data.Functor.Identity - if !impl(ghc>=7.11) + if impl(ghc<7.11) -- modules moved into base-4.9.0 (GHC 8.0) -- see https://ghc.haskell.org/trac/ghc/ticket/10773 -- see https://ghc.haskell.org/trac/ghc/ticket/11135 @@ -61,7 +65,7 @@ Data.Functor.Sum if impl(ghc>=7.2 && <7.5) -- Prior to GHC 7.5, GHC.Generics lived in ghc-prim - build-depends: ghc-prim + build-depends: ghc-prim < 0.3 exposed-modules: Control.Applicative.Backwards Control.Applicative.Lift @@ -70,9 +74,7 @@ Control.Monad.Trans.Class Control.Monad.Trans.Cont Control.Monad.Trans.Except - Control.Monad.Trans.Error Control.Monad.Trans.Identity - Control.Monad.Trans.List Control.Monad.Trans.Maybe Control.Monad.Trans.Reader Control.Monad.Trans.RWS