neither 0.0.2 → 0.1.0

raw patch · 9 files changed

+257/−162 lines, 9 filesdep −MonadCatchIO-mtldep −MonadCatchIO-transformersdep −mtlsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies removed: MonadCatchIO-mtl, MonadCatchIO-transformers, mtl

API changes (from Hackage documentation)

Files

• Control/Monad/Invert.hs +128/−0
• Data/Neither.hs +120/−4
• Data/Neither/Base.hs +0/−66
• Data/Neither/Class.hs +0/−45
• Data/Neither/Mtl.hs +0/−18
• Data/Neither/Transformers.hs +0/−19
• Setup.hs +0/−2
• Setup.lhs +7/−0
• neither.cabal +2/−8

@@ -0,0 +1,128 @@+{-# LANGUAGE TypeFamilies #-}+module Control.Monad.Invert+    ( -- * Typeclass+      MonadInvertIO (..)+      -- * Exceptions+    , finally+    , catch+    , block+    , unblock+    , bracket+    , bracket_+    , onException+      -- * Memory allocation+    , alloca+    , allocaBytes+    , withForeignPtr+    ) where++import Prelude hiding (catch)+import Control.Monad.Trans.Identity+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Writer+import Control.Monad.Trans.Error+import Control.Monad.Trans.State+import Control.Monad (liftM)+import qualified Control.Exception as E+import Data.Monoid (Monoid)+import qualified Foreign.Marshal.Alloc as A+import Foreign.Storable (Storable)+import Foreign.Ptr (Ptr)+import Foreign.ForeignPtr (ForeignPtr)+import qualified Foreign.ForeignPtr as F+import Control.Monad.IO.Class (MonadIO)++class MonadIO m => MonadInvertIO m where+    data InvertedIO m :: * -> *+    type InvertedArg m+    invertIO :: m a -> InvertedArg m -> IO (InvertedIO m a)+    revertIO :: (InvertedArg m -> IO (InvertedIO m a)) -> m a++instance MonadInvertIO m => MonadInvertIO (IdentityT m) where+    newtype InvertedIO (IdentityT m) a =+        InvIdentIO { runInvIdentIO :: InvertedIO m a }+    type InvertedArg (IdentityT m) = InvertedArg m+    invertIO = liftM (fmap InvIdentIO) . invertIO . runIdentityT+    revertIO f = IdentityT $ revertIO $ liftM runInvIdentIO . f++instance (Error e, MonadInvertIO m) => MonadInvertIO (ErrorT e m) where+    newtype InvertedIO (ErrorT e m) a =+        InvErrorIO { runInvErrorIO :: InvertedIO m (Either e a) }+    type InvertedArg (ErrorT e m) = InvertedArg m+    invertIO = liftM (fmap InvErrorIO) . invertIO . runErrorT+    revertIO f = ErrorT $ revertIO $ liftM runInvErrorIO . f++instance MonadInvertIO m => MonadInvertIO (ReaderT r m) where+    newtype InvertedIO (ReaderT r m) a =+        InvReaderIO { runInvReaderIO :: InvertedIO m a }+    type InvertedArg (ReaderT r m) = (r, InvertedArg m)+    invertIO (ReaderT f) (r, arg) = liftM InvReaderIO $ invertIO (f r) arg+    revertIO f = ReaderT $ \r -> revertIO (\a -> liftM runInvReaderIO (f (r, a)))++instance (Monoid w, MonadInvertIO m) => MonadInvertIO (WriterT w m) where+    newtype InvertedIO (WriterT w m) a =+        InvWriterIO { runInvWriterIO :: InvertedIO m (a, w) }+    type InvertedArg (WriterT w m) = InvertedArg m+    invertIO = liftM (fmap InvWriterIO) . invertIO . runWriterT+    revertIO f = WriterT $ revertIO $ liftM runInvWriterIO . f++instance MonadInvertIO m => MonadInvertIO (StateT s m) where+    newtype InvertedIO (StateT s m) a =+        InvStateIO { runInvStateIO :: InvertedIO m (a, s) }+    type InvertedArg (StateT s m) = (s, InvertedArg m)+    invertIO (StateT f) (r, arg) = liftM InvStateIO $ invertIO (f r) arg+    revertIO f = StateT $ \r -> revertIO (\a -> liftM runInvStateIO (f (r, a)))++instance MonadInvertIO IO where+    newtype InvertedIO IO a = InvIO { runInvIO :: a }+    type InvertedArg IO = ()+    invertIO = const . liftM InvIO+    revertIO = liftM runInvIO . ($ ())++finally :: MonadInvertIO m => m a -> m b -> m a+finally action after =+    revertIO $ \a -> invertIO action a `E.finally` invertIO after a++onException :: MonadInvertIO m => m a -> m b -> m a+onException action after =+    revertIO $ \a -> invertIO action a `E.onException` invertIO after a++catch :: (E.Exception e, MonadInvertIO m) => m a -> (e -> m a) -> m a+catch action handler =+    revertIO $ \a -> invertIO action a `E.catch` (\e -> invertIO (handler e) a)++block :: MonadInvertIO m => m a -> m a+block action = revertIO $ \a -> E.block $ invertIO action a++unblock :: MonadInvertIO m => m a -> m a+unblock action = revertIO $ \a -> E.unblock $ invertIO action a++-- | There is a very important distinction between this function and+-- 'bracket_': in this version, the monadic side effects from the+-- initialization function and kept, while in bracket_ they are discarded.+bracket :: MonadInvertIO m+        => m a+        -> (a -> m b)+        -> (a -> m c)+        -> m c+bracket acquire cleanup action = revertIO $ \a -> E.bracket+    (invertIO acquire a)+    (\x -> invertIO (revertIO (const $ return x) >>= cleanup) a)+    (\x -> invertIO (revertIO (const $ return x) >>= action) a)++-- | See 'bracket'.+bracket_ :: MonadInvertIO m => m a -> m b -> m c -> m c+bracket_ acquire cleanup action = revertIO $ \a -> E.bracket_+    (invertIO acquire a)+    (invertIO cleanup a)+    (invertIO action a)++alloca :: (Storable a, MonadInvertIO m) => (Ptr a -> m b) -> m b+alloca f = revertIO $ \x -> A.alloca $ flip invertIO x . f++allocaBytes :: MonadInvertIO m => Int -> (Ptr a -> m b) -> m b+allocaBytes i f = revertIO $ \x -> A.allocaBytes i $ flip invertIO x . f++withForeignPtr :: MonadInvertIO m => ForeignPtr a -> (Ptr a -> m b) -> m b+withForeignPtr p f =+    revertIO $ \x -> F.withForeignPtr p $ flip invertIO x . f

@@ -1,3 +1,7 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-} -- | This module provides three different datatypes: 'AEither' is the -- applicative version of Either. It does not provide a monad instance, and -- 'mappend's together error values. 'MEither' is the monadic version, which@@ -28,7 +32,119 @@     , partitionEithers     ) where -import Data.Neither.Base-import Data.Neither.Class-import Data.Neither.Transformers ()-import Data.Neither.Mtl ()+import Prelude hiding (either, catch)+import qualified Data.Either as E+import Control.Monad+import Control.Arrow ((&&&))+import Data.Monoid+import Control.Applicative+import Control.Failure+import Data.Typeable+import Data.Data+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Invert++class Neither e where+  left :: a -> e a b+  right :: b -> e a b+  either :: (a -> c) -> (b -> c) -> e a b -> c++instance Neither Either where+  left = Left+  right = Right+  either = E.either++instance Neither MEither where+  left = MLeft+  right = MRight+  either = meither++instance Neither AEither where+  left = ALeft+  right = ARight+  either = aeither++mapLeft :: Neither e => (a -> c) -> e a b -> e c b+mapLeft = flip mapEither id++mapRight :: Neither e => (b -> c) -> e a b -> e a c+mapRight = mapEither id++mapEither :: Neither e => (a -> c) -> (b -> d) -> e a b -> e c d+mapEither f g = either (left . f) (right . g)++lefts :: (Neither e, MonadPlus m) => m (e a b) -> m a+lefts = (=<<) $ either return (const mzero)++rights :: (Neither e, MonadPlus m) => m (e a b) -> m b+rights = (=<<) $ either (const mzero) return++partitionEithers :: (Neither e, MonadPlus m) => m (e a b) -> (m a, m b)+partitionEithers = lefts &&& rights++data MEither a b = MLeft a | MRight b+    deriving (Typeable, Eq, Data, Ord, Read, Show)+instance Monad (MEither a) where+    return = MRight+    (MLeft a) >>= _ = MLeft a+    (MRight b) >>= f = f b+instance Functor (MEither a) where+    fmap = liftM+instance Applicative (MEither a) where+    pure = return+    (<*>) = ap+instance Failure e (MEither e) where+    failure = MLeft+meither :: (a -> c) -> (b -> c) -> MEither a b -> c+meither f _ (MLeft a) = f a+meither _ f (MRight b) = f b++data AEither a b = ALeft a | ARight b+    deriving (Typeable, Eq, Data, Ord, Read, Show)+instance Functor (AEither a) where+    fmap _ (ALeft a) = ALeft a+    fmap f (ARight b) = ARight $ f b+instance Monoid a => Applicative (AEither a) where+    pure = ARight+    ALeft x <*> ALeft y = ALeft $ x `mappend` y+    ALeft x <*> _ = ALeft x+    _ <*> ALeft y = ALeft y+    ARight x <*> ARight y = ARight $ x y+aeither :: (a -> c) -> (b -> c) -> AEither a b -> c+aeither f _ (ALeft a) = f a+aeither _ f (ARight b) = f b++newtype MEitherT e m a = MEitherT+    { runMEitherT :: m (MEither e a)+    }+mapMEitherT :: (m (MEither e a) -> n (MEither e' b))+             -> MEitherT e m a+             -> MEitherT e' n b+mapMEitherT f m = MEitherT $ f (runMEitherT m)++throwMEither :: Monad m => e -> MEitherT e m a+throwMEither = MEitherT . return . MLeft++instance Functor m => Functor (MEitherT e m) where+    fmap f = MEitherT . fmap (fmap f) . runMEitherT+instance (Functor m, Monad m) => Applicative (MEitherT e m) where+    pure = return+    (<*>) = ap+instance Monad m => Monad (MEitherT e m) where+    return = MEitherT . return . return+    (MEitherT x) >>= f = MEitherT $+        x >>= meither (return . MLeft) (runMEitherT . f)+instance Monad m => Failure e (MEitherT e m) where+    failure = MEitherT . return . MLeft+instance MonadTrans (MEitherT e) where+    lift = MEitherT . liftM MRight+instance MonadIO m => MonadIO (MEitherT e m) where+    liftIO = lift . liftIO++instance MonadInvertIO m => MonadInvertIO (MEitherT e m) where+    newtype InvertedIO (MEitherT e m) a =+        InvErrorIO { runInvErrorIO :: InvertedIO m (MEither e a) }+    type InvertedArg (MEitherT e m) = InvertedArg m+    invertIO = liftM (fmap InvErrorIO) . invertIO . runMEitherT+    revertIO f = MEitherT $ revertIO $ liftM runInvErrorIO . f

@@ -1,66 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-module Data.Neither.Base where--import Control.Applicative-import Control.Monad-import Control.Failure-import Data.Typeable-import Data.Data-import Data.Monoid--data MEither a b = MLeft a | MRight b-    deriving (Typeable, Eq, Data, Ord, Read, Show)-instance Monad (MEither a) where-    return = MRight-    (MLeft a) >>= _ = MLeft a-    (MRight b) >>= f = f b-instance Functor (MEither a) where-    fmap = liftM-instance Applicative (MEither a) where-    pure = return-    (<*>) = ap-instance Failure e (MEither e) where-    failure = MLeft-meither :: (a -> c) -> (b -> c) -> MEither a b -> c-meither f _ (MLeft a) = f a-meither _ f (MRight b) = f b--data AEither a b = ALeft a | ARight b-    deriving (Typeable, Eq, Data, Ord, Read, Show)-instance Functor (AEither a) where-    fmap _ (ALeft a) = ALeft a-    fmap f (ARight b) = ARight $ f b-instance Monoid a => Applicative (AEither a) where-    pure = ARight-    ALeft x <*> ALeft y = ALeft $ x `mappend` y-    ALeft x <*> _ = ALeft x-    _ <*> ALeft y = ALeft y-    ARight x <*> ARight y = ARight $ x y-aeither :: (a -> c) -> (b -> c) -> AEither a b -> c-aeither f _ (ALeft a) = f a-aeither _ f (ARight b) = f b--newtype MEitherT e m a = MEitherT-    { runMEitherT :: m (MEither e a)-    }-mapMEitherT :: (m (MEither e a) -> n (MEither e' b))-             -> MEitherT e m a-             -> MEitherT e' n b-mapMEitherT f m = MEitherT $ f (runMEitherT m)--throwMEither :: Monad m => e -> MEitherT e m a-throwMEither = MEitherT . return . MLeft--instance Functor m => Functor (MEitherT e m) where-    fmap f = MEitherT . fmap (fmap f) . runMEitherT-instance (Functor m, Monad m) => Applicative (MEitherT e m) where-    pure = return-    (<*>) = ap-instance Monad m => Monad (MEitherT e m) where-    return = MEitherT . return . return-    (MEitherT x) >>= f = MEitherT $-        x >>= meither (return . MLeft) (runMEitherT . f)-instance Monad m => Failure e (MEitherT e m) where-    failure = MEitherT . return . MLeft

@@ -1,45 +0,0 @@-module Data.Neither.Class where--import Prelude hiding (either)-import qualified Data.Either as E-import Data.Neither.Base-import Control.Monad-import Control.Arrow ((&&&))--class Neither e where-  left :: a -> e a b-  right :: b -> e a b-  either :: (a -> c) -> (b -> c) -> e a b -> c--instance Neither Either where-  left = Left-  right = Right-  either = E.either--instance Neither MEither where-  left = MLeft-  right = MRight-  either = meither--instance Neither AEither where-  left = ALeft-  right = ARight-  either = aeither--mapLeft :: Neither e => (a -> c) -> e a b -> e c b-mapLeft = flip mapEither id--mapRight :: Neither e => (b -> c) -> e a b -> e a c-mapRight = mapEither id--mapEither :: Neither e => (a -> c) -> (b -> d) -> e a b -> e c d-mapEither f g = either (left . f) (right . g)--lefts :: (Neither e, MonadPlus m) => m (e a b) -> m a-lefts = (=<<) $ either return (const mzero)--rights :: (Neither e, MonadPlus m) => m (e a b) -> m b-rights = (=<<) $ either (const mzero) return--partitionEithers :: (Neither e, MonadPlus m) => m (e a b) -> (m a, m b)-partitionEithers = lefts &&& rights

@@ -1,18 +0,0 @@-{-# LANGUAGE PackageImports #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Data.Neither.Mtl () where--import Data.Neither.Base-import Prelude hiding (catch)-import Control.Monad-import "mtl" Control.Monad.Trans-import "MonadCatchIO-mtl" Control.Monad.CatchIO (MonadCatchIO (..))--instance MonadTrans (MEitherT e) where-    lift = MEitherT . liftM MRight-instance MonadIO m => MonadIO (MEitherT e m) where-    liftIO = lift . liftIO-instance MonadCatchIO m => MonadCatchIO (MEitherT e m) where-    m `catch` f = mapMEitherT (\m' -> m' `catch` \e -> runMEitherT $ f e) m-    block       = mapMEitherT block-    unblock     = mapMEitherT unblock

@@ -1,19 +0,0 @@-{-# LANGUAGE PackageImports #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Data.Neither.Transformers () where--import Data.Neither.Base-import Prelude hiding (catch)-import Control.Monad-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import "MonadCatchIO-transformers" Control.Monad.CatchIO (MonadCatchIO (..))--instance MonadTrans (MEitherT e) where-    lift = MEitherT . liftM MRight-instance MonadIO m => MonadIO (MEitherT e m) where-    liftIO = lift . liftIO-instance MonadCatchIO m => MonadCatchIO (MEitherT e m) where-    m `catch` f = mapMEitherT (\m' -> m' `catch` \e -> runMEitherT $ f e) m-    block       = mapMEitherT block-    unblock     = mapMEitherT unblock

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain

@@ -1,5 +1,5 @@ name:            neither-version:         0.0.2+version:         0.1.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -20,15 +20,9 @@ library     build-depends:   base >= 4 && < 5,                      transformers >= 0.2.1 && < 0.3,-                     MonadCatchIO-transformers >= 0.2.2 && < 0.3,-                     mtl >= 1.1.0.2 && < 1.2,-                     MonadCatchIO-mtl >= 0.3.0.1 && < 0.4,                      failure >= 0.1.0 && < 0.2     exposed-modules: Data.Neither-    other-modules:   Data.Neither.Base-                     Data.Neither.Class-                     Data.Neither.Transformers-                     Data.Neither.Mtl+                     Control.Monad.Invert     ghc-options:     -Wall  source-repository head