either 3.0.2 → 3.0.3

raw patch · 8 files changed

+196/−134 lines, 8 filesdep ~semigroupoidsdep ~semigroupsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: semigroupoids, semigroups

API changes (from Hackage documentation)

Files

• .ghci +1/−0
• .gitignore +13/−0
• .travis.yml +7/−0
• .vim.custom +31/−0
• CHANGELOG.markdown +3/−0
• Control/Monad/Trans/Either.hs +0/−130
• either.cabal +11/−4
• src/Control/Monad/Trans/Either.hs +130/−0

@@ -0,0 +1,1 @@+:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h

@@ -0,0 +1,13 @@+dist+docs+wiki+TAGS+tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#

@@ -1,1 +1,8 @@ language: haskell+notifications:+  irc:+    channels:+      - "irc.freenode.org#haskell-lens"+    skip_join: true+    template:+      - "\x0313either\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"

@@ -0,0 +1,31 @@+" Add the following to your .vimrc to automatically load this on startup++" if filereadable(".vim.custom")+"     so .vim.custom+" endif++function StripTrailingWhitespace()+  let myline=line(".")+  let mycolumn = col(".")+  silent %s/  *$//+  call cursor(myline, mycolumn)+endfunction++" enable syntax highlighting+syntax on++" search for the tags file anywhere between here and /+set tags=TAGS;/++" highlight tabs and trailing spaces+set listchars=tab:‗‗,trail:‗+set list++" f2 runs hasktags+map <F2> :exec ":!hasktags -x -c --ignore src"<CR><CR>++" strip trailing whitespace before saving+" au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace()++" rebuild hasktags after saving+au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src"

@@ -0,0 +1,3 @@+3.0.3+-----+* Started CHANGELOG

@@ -1,130 +0,0 @@-{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances #-}-module Control.Monad.Trans.Either-  ( EitherT(..)-  , eitherT-  , mapEitherT-  , hoistEither-  , left-  , right-  ) where--import Control.Applicative-import Data.Functor.Bind-import Data.Functor.Plus-import Data.Foldable-import Data.Function (on)-import Data.Traversable-import Data.Semigroup-import Control.Monad.Trans.Class--- import Control.Monad.Error.Class-import Control.Monad.IO.Class-import Control.Monad.Fix-import Control.Monad (liftM)--newtype EitherT e m a = EitherT { runEitherT :: m (Either e a) }--- TODO: Data, Typeable--instance Show (m (Either e a)) => Show (EitherT e m a) where-  showsPrec d (EitherT m) = showParen (d > 10) $-    showString "EitherT " . showsPrec 11 m--instance Read (m (Either e a)) => Read (EitherT e m a) where-  readsPrec d r = readParen (d > 10)-    (\r' -> [ (EitherT m, t)-            | ("EitherT", s) <- lex r'-            , (m, t) <- readsPrec 11 s]) r--instance Eq (m (Either e a)) => Eq (EitherT e m a) where-  (==) = (==) `on` runEitherT--instance Ord (m (Either e a)) => Ord (EitherT e m a) where-  compare = compare `on` runEitherT---eitherT :: Monad m => (a -> m c) -> (b -> m c) -> EitherT a m b -> m c-eitherT f g (EitherT m) = m >>= \z -> case z of-  Left a -> f a-  Right b -> g b-{-# INLINE eitherT #-}--left :: Monad m => e -> EitherT e m a-left = EitherT . return . Left-{-# INLINE left #-}--right :: Monad m => a -> EitherT e m a-right = return-{-# INLINE right #-}---mapEitherT :: Functor m => (e -> f) -> (a -> b) -> EitherT e m a -> EitherT f m b-mapEitherT f g (EitherT m) = EitherT (fmap h m) where-  h (Left e)  = Left (f e)-  h (Right a) = Right (g a)-{-# INLINE mapEitherT #-}--hoistEither :: Monad m => Either e a -> EitherT e m a-hoistEither = EitherT . return-{-# INLINE hoistEither #-}--instance Functor m => Functor (EitherT e m) where-  fmap f = EitherT . fmap (fmap f) . runEitherT--instance (Functor m, Monad m) => Apply (EitherT e m) where-  EitherT f <.> EitherT v = EitherT $ f >>= \mf -> case mf of-    Left  e -> return (Left e)-    Right k -> v >>= \mv -> case mv of-      Left  e -> return (Left e)-      Right x -> return (Right (k x))--instance (Functor m, Monad m) => Applicative (EitherT e m) where-  pure a  = EitherT $ return (Right a)-  EitherT f <*> EitherT v = EitherT $ f >>= \mf -> case mf of-    Left  e -> return (Left e)-    Right k -> v >>= \mv -> case mv of-      Left  e -> return (Left e)-      Right x -> return (Right (k x))--instance Monad m => Semigroup (EitherT e m a) where-  EitherT m <> EitherT n = EitherT $ m >>= \a -> case a of-    Left _ -> n-    Right r -> return (Right r)--instance (Functor m, Monad m) => Alt (EitherT e m) where-  (<!>) = (<>)--instance (Functor m, Monad m) => Bind (EitherT e m) where-  (>>-) = (>>=)--instance Monad m => Monad (EitherT e m) where-  return a = EitherT $ return (Right a)-  m >>= k  = EitherT $ do-    a <- runEitherT m-    case a of-      Left  l -> return (Left l)-      Right r -> runEitherT (k r)--{--instance Monad m => MonadError e (EitherT e m) where-  throwError = EitherT . return . Left-  EitherT m `catchError` h = EitherT $ m >>= \a -> case a of-    Left  l -> runEitherT (h l)-    Right r -> return (Right r)--}--instance MonadFix m => MonadFix (EitherT e m) where-  mfix f = EitherT $ mfix $ \a -> runEitherT $ f $ case a of-    Right r -> r-    _       -> error "empty mfix argument"--instance MonadTrans (EitherT e) where-  lift = EitherT . liftM Right--instance MonadIO m => MonadIO (EitherT e m) where-  liftIO = lift . liftIO--instance Foldable m => Foldable (EitherT e m) where-  foldMap f = foldMap (either mempty f) . runEitherT--instance (Traversable f) => Traversable (EitherT e f) where-  traverse f (EitherT a) =-    EitherT <$> traverse (either (pure . Left) (fmap Right . f)) a

@@ -1,6 +1,6 @@ name:          either category:      Control, Monads-version:       3.0.2+version:       3.0.3 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -13,7 +13,13 @@ synopsis:      Haskell 98 either monad transformer description:   Haskell 98 either monad transformer build-type:    Simple-extra-source-files: .travis.yml README.markdown+extra-source-files:+  .gitignore+  .ghci+  .vim.custom+  .travis.yml+  CHANGELOG.markdown+  README.markdown  source-repository head   type: git@@ -22,8 +28,8 @@ library   build-depends:     base          >= 4       && < 5,-    semigroups    >= 0.8.3.1 && < 0.9,-    semigroupoids >= 3.0     && < 3.1,+    semigroups    >= 0.8.3.1,+    semigroupoids >= 3,     transformers  >= 0.2     && < 0.4    extensions: CPP@@ -32,3 +38,4 @@     Control.Monad.Trans.Either    ghc-options:      -Wall+  hs-source-dirs: src

@@ -0,0 +1,130 @@+{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances #-}+module Control.Monad.Trans.Either+  ( EitherT(..)+  , eitherT+  , mapEitherT+  , hoistEither+  , left+  , right+  ) where++import Control.Applicative+import Data.Functor.Bind+import Data.Functor.Plus+import Data.Foldable+import Data.Function (on)+import Data.Traversable+import Data.Semigroup+import Control.Monad.Trans.Class+-- import Control.Monad.Error.Class+import Control.Monad.IO.Class+import Control.Monad.Fix+import Control.Monad (liftM)++newtype EitherT e m a = EitherT { runEitherT :: m (Either e a) }+-- TODO: Data, Typeable++instance Show (m (Either e a)) => Show (EitherT e m a) where+  showsPrec d (EitherT m) = showParen (d > 10) $+    showString "EitherT " . showsPrec 11 m++instance Read (m (Either e a)) => Read (EitherT e m a) where+  readsPrec d r = readParen (d > 10)+    (\r' -> [ (EitherT m, t)+            | ("EitherT", s) <- lex r'+            , (m, t) <- readsPrec 11 s]) r++instance Eq (m (Either e a)) => Eq (EitherT e m a) where+  (==) = (==) `on` runEitherT++instance Ord (m (Either e a)) => Ord (EitherT e m a) where+  compare = compare `on` runEitherT+++eitherT :: Monad m => (a -> m c) -> (b -> m c) -> EitherT a m b -> m c+eitherT f g (EitherT m) = m >>= \z -> case z of+  Left a -> f a+  Right b -> g b+{-# INLINE eitherT #-}++left :: Monad m => e -> EitherT e m a+left = EitherT . return . Left+{-# INLINE left #-}++right :: Monad m => a -> EitherT e m a+right = return+{-# INLINE right #-}+++mapEitherT :: Functor m => (e -> f) -> (a -> b) -> EitherT e m a -> EitherT f m b+mapEitherT f g (EitherT m) = EitherT (fmap h m) where+  h (Left e)  = Left (f e)+  h (Right a) = Right (g a)+{-# INLINE mapEitherT #-}++hoistEither :: Monad m => Either e a -> EitherT e m a+hoistEither = EitherT . return+{-# INLINE hoistEither #-}++instance Functor m => Functor (EitherT e m) where+  fmap f = EitherT . fmap (fmap f) . runEitherT++instance (Functor m, Monad m) => Apply (EitherT e m) where+  EitherT f <.> EitherT v = EitherT $ f >>= \mf -> case mf of+    Left  e -> return (Left e)+    Right k -> v >>= \mv -> case mv of+      Left  e -> return (Left e)+      Right x -> return (Right (k x))++instance (Functor m, Monad m) => Applicative (EitherT e m) where+  pure a  = EitherT $ return (Right a)+  EitherT f <*> EitherT v = EitherT $ f >>= \mf -> case mf of+    Left  e -> return (Left e)+    Right k -> v >>= \mv -> case mv of+      Left  e -> return (Left e)+      Right x -> return (Right (k x))++instance Monad m => Semigroup (EitherT e m a) where+  EitherT m <> EitherT n = EitherT $ m >>= \a -> case a of+    Left _ -> n+    Right r -> return (Right r)++instance (Functor m, Monad m) => Alt (EitherT e m) where+  (<!>) = (<>)++instance (Functor m, Monad m) => Bind (EitherT e m) where+  (>>-) = (>>=)++instance Monad m => Monad (EitherT e m) where+  return a = EitherT $ return (Right a)+  m >>= k  = EitherT $ do+    a <- runEitherT m+    case a of+      Left  l -> return (Left l)+      Right r -> runEitherT (k r)++{-+instance Monad m => MonadError e (EitherT e m) where+  throwError = EitherT . return . Left+  EitherT m `catchError` h = EitherT $ m >>= \a -> case a of+    Left  l -> runEitherT (h l)+    Right r -> return (Right r)+-}++instance MonadFix m => MonadFix (EitherT e m) where+  mfix f = EitherT $ mfix $ \a -> runEitherT $ f $ case a of+    Right r -> r+    _       -> error "empty mfix argument"++instance MonadTrans (EitherT e) where+  lift = EitherT . liftM Right++instance MonadIO m => MonadIO (EitherT e m) where+  liftIO = lift . liftIO++instance Foldable m => Foldable (EitherT e m) where+  foldMap f = foldMap (either mempty f) . runEitherT++instance (Traversable f) => Traversable (EitherT e f) where+  traverse f (EitherT a) =+    EitherT <$> traverse (either (pure . Left) (fmap Right . f)) a