transformers-compat 0.1.1.1 → 0.2
raw patch · 5 files changed
+462/−9 lines, 5 filesdep ~transformersPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: transformers
API changes (from Hackage documentation)
Files
- src/Control/Monad/Signatures.hs +32/−0
- src/Control/Monad/Trans/Except.hs +230/−0
- src/Data/Functor/Classes.hs +116/−0
- src/Data/Functor/Sum.hs +59/−0
- transformers-compat.cabal +25/−9
+ src/Control/Monad/Signatures.hs view
@@ -0,0 +1,32 @@+-----------------------------------------------------------------------------+-- |+-- Module : Control.Monad.Signatures+-- Copyright : (c) Ross Paterson 2012+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : ross@soi.city.ac.uk+-- Stability : experimental+-- Portability : portable+--+-- Signatures for monad operations that require specialized lifting.+-----------------------------------------------------------------------------++module Control.Monad.Signatures (+ CallCC, Catch, Listen, Pass+ ) where++-- | Signature of the @callCC@ operation,+-- introduced in "Control.Monad.Trans.Cont".+type CallCC m a b = ((a -> m b) -> m a) -> m a++-- | Signature of the @catchE@ operation,+-- introduced in "Control.Monad.Trans.Except".+type Catch e m a = m a -> (e -> m a) -> m a++-- | Signature of the @listen@ operation,+-- introduced in "Control.Monad.Trans.Writer".+type Listen w m a = m a -> m (a, w)++-- | Signature of the @pass@ operation,+-- introduced in "Control.Monad.Trans.Writer".+type Pass w m a = m (a, w -> w) -> m a
+ src/Control/Monad/Trans/Except.hs view
@@ -0,0 +1,230 @@+-----------------------------------------------------------------------------+-- |+-- Module : Control.Monad.Trans.Except+-- Copyright : (C) 2013 Ross Paterson+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : ross@soi.city.ac.uk+-- Stability : experimental+-- Portability : portable+--+-- This monad transformer extends a monad with the ability throw exceptions.+--+-- A sequence of actions terminates normally, producing a value,+-- only if none of the actions in the sequence throws an exception.+-- If one throws an exception, the rest of the sequence is skipped and+-- the composite action exits with that exception.+--+-- If the value of the exception is not required, the variant in+-- "Control.Monad.Trans.Maybe" may be used instead.+-----------------------------------------------------------------------------++module Control.Monad.Trans.Except (+ -- * The Except monad+ Except,+ except,+ runExcept,+ mapExcept,+ withExcept,+ -- * The ExceptT monad transformer+ ExceptT(..),+ runExceptT,+ mapExceptT,+ withExceptT,+ -- * Exception operations+ throwE,+ catchE,+ -- * Lifting other operations+ liftCallCC,+ liftListen,+ liftPass,+ ) where++import Control.Monad.IO.Class+import Control.Monad.Signatures+import Control.Monad.Trans.Class+import Data.Functor.Classes+import Data.Functor.Identity++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Data.Foldable (Foldable(foldMap))+import Data.Monoid+import Data.Traversable (Traversable(traverse))++-- | The parameterizable exception monad.+--+-- Computations are either exceptions or normal values.+--+-- The 'return' function returns a normal value, while @>>=@ exits+-- on the first exception.+type Except e = ExceptT e Identity++-- | Constructor for computations in the exception monad.+-- (The inverse of 'runExcept').+except :: Either e a -> Except e a+except m = ExceptT (Identity m)++-- | Extractor for computations in the exception monad.+-- (The inverse of 'except').+runExcept :: Except e a -> Either e a+runExcept (ExceptT m) = runIdentity m++-- | Map the unwrapped computation using the given function.+--+-- * @'runExcept' ('mapExcept' f m) = f ('runExcept' m)@+mapExcept :: (Either e a -> Either e' b)+ -> Except e a+ -> Except e' b+mapExcept f = mapExceptT (Identity . f . runIdentity)++-- | Transform any exceptions thrown by the computation using the given+-- function (a specialization of 'withExceptT').+withExcept :: (e -> e') -> Except e a -> Except e' a+withExcept = withExceptT++-- | A monad transformer that adds exceptions to other monads.+--+-- @ExceptT@ constructs a monad parameterized over two things:+--+-- * e - The exception type.+--+-- * m - The inner 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))++instance (Eq e, Eq1 m, Eq a) => Eq (ExceptT e m a) where+ ExceptT x == ExceptT y = eq1 x y++instance (Ord e, Ord1 m, Ord a) => Ord (ExceptT e m a) where+ compare (ExceptT x) (ExceptT y) = compare1 x y++instance (Read e, Read1 m, Read a) => Read (ExceptT e m a) where+ readsPrec = readsData $ readsUnary1 "ExceptT" ExceptT++instance (Show e, Show1 m, Show a) => Show (ExceptT e m a) where+ showsPrec d (ExceptT m) = showsUnary1 "ExceptT" d m++instance (Eq e, Eq1 m) => Eq1 (ExceptT e m) where eq1 = (==)+instance (Ord e, Ord1 m) => Ord1 (ExceptT e m) where compare1 = compare+instance (Read e, Read1 m) => Read1 (ExceptT e m) where readsPrec1 = readsPrec+instance (Show e, Show1 m) => Show1 (ExceptT e m) where showsPrec1 = showsPrec++-- | The inverse of 'ExceptT'.+runExceptT :: ExceptT e m a -> m (Either e a)+runExceptT (ExceptT m) = m++-- | Map the unwrapped computation using the given function.+--+-- * @'runExceptT' ('mapExceptT' f m) = f ('runExceptT' m)@+mapExceptT :: (m (Either e a) -> n (Either e' b))+ -> ExceptT e m a+ -> ExceptT e' n b+mapExceptT f m = ExceptT $ f (runExceptT m)++-- | Transform any exceptions thrown by the computation using the+-- given function.+withExceptT :: (Functor m) => (e -> e') -> ExceptT e m a -> ExceptT e' m a+withExceptT f = mapExceptT $ fmap $ either (Left . f) Right++instance (Functor m) => Functor (ExceptT e m) where+ fmap f = ExceptT . fmap (fmap f) . runExceptT++instance (Foldable f) => Foldable (ExceptT e f) where+ foldMap f (ExceptT a) = foldMap (either (const mempty) f) a++instance (Traversable f) => Traversable (ExceptT e f) where+ traverse f (ExceptT a) =+ ExceptT <$> traverse (either (pure . Left) (fmap Right . f)) a++instance (Functor m, Monad m) => Applicative (ExceptT e m) where+ pure a = ExceptT $ return (Right a)+ ExceptT f <*> ExceptT v = ExceptT $ do+ mf <- f+ case mf of+ Left e -> return (Left e)+ Right k -> do+ mv <- v+ case mv of+ Left e -> return (Left e)+ Right x -> return (Right (k x))++instance (Functor m, Monad m, Monoid e) => Alternative (ExceptT e m) where+ empty = mzero+ (<|>) = mplus++instance (Monad m) => Monad (ExceptT e m) where+ return a = ExceptT $ return (Right a)+ m >>= k = ExceptT $ do+ a <- runExceptT m+ case a of+ Left e -> return (Left e)+ Right x -> runExceptT (k x)+ fail = ExceptT . fail++instance (Monad m, Monoid e) => MonadPlus (ExceptT e m) where+ mzero = ExceptT $ return (Left mempty)+ ExceptT m `mplus` ExceptT n = ExceptT $ do+ a <- m+ case a of+ Left e -> liftM (either (Left . mappend e) Right) n+ Right x -> return (Right x)++instance (MonadFix m) => MonadFix (ExceptT e m) where+ mfix f = ExceptT $ mfix $ \ a -> runExceptT $ f $ case a of+ Right x -> x+ Left _ -> error "mfix ExceptT: Left"++instance MonadTrans (ExceptT e) where+ lift = ExceptT . liftM Right++instance (MonadIO m) => MonadIO (ExceptT e m) where+ liftIO = lift . liftIO++-- | Signal an exception value @e@.+--+-- * @'runExceptT' ('throwE' e) = 'return' ('Left' e)@+--+-- * @'throwE' e >>= m = 'throwE' e@+throwE :: (Monad m) => e -> ExceptT e m a+throwE = ExceptT . return . Left++-- | Handle an exception.+--+-- * @'catchE' h ('lift' m) = 'lift' m@+--+-- * @'catchE' h ('throwE' e) = h e@+catchE :: (Monad m) =>+ ExceptT e m a -- ^ the inner computation+ -> (e -> ExceptT e' m a) -- ^ a handler for exceptions in the inner+ -- computation+ -> ExceptT e' m a+m `catchE` h = ExceptT $ do+ a <- runExceptT m+ case a of+ Left l -> runExceptT (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 (ExceptT e m) a b+liftCallCC callCC f = ExceptT $+ callCC $ \ c ->+ runExceptT (f (\ a -> ExceptT $ c (Right a)))++-- | Lift a @listen@ operation to the new monad.+liftListen :: (Monad m) => Listen w m (Either e a) -> Listen w (ExceptT e m) a+liftListen listen = mapExceptT $ \ 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 (ExceptT e m) a+liftPass pass = mapExceptT $ \ m -> pass $ do+ a <- m+ return $! case a of+ Left l -> (Left l, id)+ Right (r, f) -> (Right r, f)
+ src/Data/Functor/Classes.hs view
@@ -0,0 +1,116 @@+-- |+-- Module : Data.Functor.Classes+-- Copyright : (c) Ross Paterson 2013+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : ross@soi.city.ac.uk+-- Stability : experimental+-- Portability : portable+--+-- Prelude classes, lifted to unary type constructors.++module Data.Functor.Classes (+ -- * Liftings of Prelude classes+ Eq1(..),+ Ord1(..),+ Read1(..),+ Show1(..),+ -- * Helper functions+ readsData,+ readsUnary,+ readsUnary1,+ readsBinary1,+ showsUnary,+ showsUnary1,+ showsBinary1,+ ) where++-- | Lifting of the 'Eq' class to unary type constructors.+class Eq1 f where+ eq1 :: (Eq a) => f a -> f a -> Bool++-- | Lifting of the 'Ord' class to unary type constructors.+class (Eq1 f) => Ord1 f where+ compare1 :: (Ord a) => f a -> f a -> Ordering++-- | Lifting of the 'Read' class to unary type constructors.+class Read1 f where+ readsPrec1 :: (Read a) => Int -> ReadS (f a)++-- | Lifting of the 'Show' class to unary type constructors.+class Show1 f where+ showsPrec1 :: (Show a) => Int -> f a -> ShowS++-- Instances for Prelude type constructors++instance Eq1 Maybe where eq1 = (==)+instance Ord1 Maybe where compare1 = compare+instance Read1 Maybe where readsPrec1 = readsPrec+instance Show1 Maybe where showsPrec1 = showsPrec++instance Eq1 [] where eq1 = (==)+instance Ord1 [] where compare1 = compare+instance Read1 [] where readsPrec1 = readsPrec+instance Show1 [] where showsPrec1 = showsPrec++instance (Eq a) => Eq1 ((,) a) where eq1 = (==)+instance (Ord a) => Ord1 ((,) a) where compare1 = compare+instance (Read a) => Read1 ((,) a) where readsPrec1 = readsPrec+instance (Show a) => Show1 ((,) a) where showsPrec1 = showsPrec++instance (Eq a) => Eq1 (Either a) where eq1 = (==)+instance (Ord a) => Ord1 (Either a) where compare1 = compare+instance (Read a) => Read1 (Either a) where readsPrec1 = readsPrec+instance (Show a) => Show1 (Either a) where showsPrec1 = showsPrec++-- Building blocks++-- | @'readsData' p d@ is a parser for datatypes where each alternative+-- begins with a data constructor. It parses the constructor and+-- passes it to @p@. Parsers for various constructors can be constructed+-- with 'readsUnary', 'readsUnary1' and 'readsBinary1', and combined with+-- @mappend@ from the @Monoid@ class.+readsData :: (String -> ReadS a) -> Int -> ReadS a+readsData reader d =+ readParen (d > 10) $ \ r -> [res | (kw,s) <- lex r, res <- reader kw s]++-- | @'readsUnary' n c n'@ matches the name of a unary data constructor+-- and then parses its argument using 'readsPrec'.+readsUnary :: (Read a) => String -> (a -> t) -> String -> ReadS t+readsUnary name cons kw s =+ [(cons x,t) | kw == name, (x,t) <- readsPrec 11 s]++-- | @'readsUnary1' n c n'@ matches the name of a unary data constructor+-- and then parses its argument using 'readsPrec1'.+readsUnary1 :: (Read1 f, Read a) => String -> (f a -> t) -> String -> ReadS t+readsUnary1 name cons kw s =+ [(cons x,t) | kw == name, (x,t) <- readsPrec1 11 s]++-- | @'readsBinary1' n c n'@ matches the name of a binary data constructor+-- and then parses its arguments using 'readsPrec1'.+readsBinary1 :: (Read1 f, Read1 g, Read a) =>+ String -> (f a -> g a -> t) -> String -> ReadS t+readsBinary1 name cons kw s =+ [(cons x y,u) | kw == name,+ (x,t) <- readsPrec1 11 s, (y,u) <- readsPrec1 11 t]++-- | @'showsUnary' n d x@ produces the string representation of a unary data+-- constructor with name @n@ and argument @x@, in precedence context @d@.+showsUnary :: (Show a) => String -> Int -> a -> ShowS+showsUnary name d x = showParen (d > 10) $+ showString name . showChar ' ' . showsPrec 11 x++-- | @'showsUnary1' n d x@ produces the string representation of a unary data+-- constructor with name @n@ and argument @x@, in precedence context @d@.+showsUnary1 :: (Show1 f, Show a) => String -> Int -> f a -> ShowS+showsUnary1 name d x = showParen (d > 10) $+ showString name . showChar ' ' . showsPrec1 11 x++-- | @'showsBinary1' n d x@ produces the string representation of a binary+-- data constructor with name @n@ and arguments @x@ and @y@, in precedence+-- context @d@.+showsBinary1 :: (Show1 f, Show1 g, Show a) =>+ String -> Int -> f a -> g a -> ShowS+showsBinary1 name d x y = showParen (d > 10) $+ showString name . showChar ' ' . showsPrec1 11 x .+ showChar ' ' . showsPrec1 11 y
+ src/Data/Functor/Sum.hs view
@@ -0,0 +1,59 @@+-- |+-- Module : Data.Functor.Sum+-- Copyright : (c) Ross Paterson 2014+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : ross@soi.city.ac.uk+-- Stability : experimental+-- Portability : portable+--+-- Sums, lifted to functors.++module Data.Functor.Sum (+ Sum(..),+ ) where++import Control.Applicative+import Data.Foldable (Foldable(foldMap))+import Data.Functor.Classes+import Data.Monoid (mappend)+import Data.Traversable (Traversable(traverse))++-- | Lifted sum of functors.+data Sum f g a = InL (f a) | InR (g a)++instance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where+ InL x1 == InL x2 = eq1 x1 x2+ InR y1 == InR y2 = eq1 y1 y2+ _ == _ = False++instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where+ compare (InL x1) (InL x2) = compare1 x1 x2+ compare (InL _) (InR _) = LT+ compare (InR _) (InL _) = GT+ compare (InR y1) (InR y2) = compare1 y1 y2++instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where+ readsPrec = readsData $+ readsUnary1 "InL" InL `mappend` readsUnary1 "InR" InR++instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where+ showsPrec d (InL x) = showsUnary1 "InL" d x+ showsPrec d (InR y) = showsUnary1 "InR" d y++instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where eq1 = (==)+instance (Ord1 f, Ord1 g) => Ord1 (Sum f g) where compare1 = compare+instance (Read1 f, Read1 g) => Read1 (Sum f g) where readsPrec1 = readsPrec+instance (Show1 f, Show1 g) => Show1 (Sum f g) where showsPrec1 = showsPrec++instance (Functor f, Functor g) => Functor (Sum f g) where+ fmap f (InL x) = InL (fmap f x)+ fmap f (InR y) = InR (fmap f y)++instance (Foldable f, Foldable g) => Foldable (Sum f g) where+ foldMap f (InL x) = foldMap f x+ foldMap f (InR y) = foldMap f y++instance (Traversable f, Traversable g) => Traversable (Sum f g) where+ traverse f (InL x) = InL <$> traverse f x+ traverse f (InR y) = InR <$> traverse f y
transformers-compat.cabal view
@@ -1,6 +1,6 @@ name: transformers-compat category: Compatibility-version: 0.1.1.1+version: 0.2 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE@@ -13,18 +13,17 @@ synopsis: A small compatibility shim exposing the new types from transformers 0.3 to older Haskell platforms. description: This package includes backported versions of types that were added- to transformers in transformers 0.3 for users who need strict- transformers 0.2 compatibility to run on old versions of the+ to transformers in transformers 0.3 an 0.4 for users who need strict+ transformers 0.2 or 0.3 compatibility to run on old versions of the platform, but also need those types. . Those users should be able to just depend on @transformers >= 0.2@ and @transformers-compat@. .- Note: missing methods are not supplied- but this at least permits the types to be used.+ Note: missing methods are not supplied, but this at least permits the types to be used. build-type: Simple-tested-with: GHC == 7.0.4, GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.1+tested-with: GHC == 7.0.4, GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.1, GHC == 7.8.2 extra-source-files: .travis.yml .ghci@@ -42,6 +41,10 @@ default: False manual: False +flag transformers3+ default: False+ manual: False+ library build-depends: base >= 4.3 && < 5@@ -53,10 +56,23 @@ if flag(transformers2) build-depends: transformers >= 0.2 && < 0.3+ else+ if flag(transformers3)+ build-depends:+ transformers >= 0.3 && < 0.4+ else+ build-depends:+ transformers >= 0.4 && < 0.5++ if flag(transformers2) exposed-modules: Control.Applicative.Backwards Control.Applicative.Lift Data.Functor.Reverse- else- build-depends:- transformers >= 0.3 && < 0.4++ if flag(transformers2) || flag(transformers3)+ exposed-modules:+ Control.Monad.Trans.Except+ Control.Monad.Signatures+ Data.Functor.Classes+ Data.Functor.Sum