Permalink
Browse files

repo initialized

  • Loading branch information...
0 parents commit 039cca5bc9cf3072f9761a95ebf6e5cd38ce5e7d @ekmett committed Feb 18, 2011
Showing with 200 additions and 0 deletions.
  1. +2 −0 .gitignore
  2. +128 −0 Control/Monad/Trans/Either.hs
  3. +30 −0 LICENSE
  4. +7 −0 Setup.lhs
  5. +33 −0 either.cabal
@@ -0,0 +1,2 @@
+_darcs
+dist
@@ -0,0 +1,128 @@
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
+module Control.Monad.Trans.Either
+ ( EitherT(..)
+ , eitherT
+ , hoistEither
+ ) where
+
+import Control.Applicative
+import Data.Default
+import Data.Functor.Bind
+import Data.Functor.Plus
+import Data.Foldable
+import Data.Function (on)
+import Data.Traversable
+import Data.Monoid
+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 (MonadPlus(..), 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
+
+hoistEither :: Monad m => Either e a -> EitherT e m a
+hoistEither = EitherT . return
+
+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 (Monad m, Default e) => Monoid (EitherT e m a) where
+ mappend = (<>)
+ mempty = EitherT $ return $ Left def
+
+instance (Functor m, Monad m) => Alt (EitherT e m) where
+ (<!>) = (<>)
+
+instance (Functor m, Monad m, Default e) => Plus (EitherT e m) where
+ zero = EitherT $ return $ Left def
+
+instance (Functor m, Monad m, Default e) => Alternative (EitherT e m) where
+ empty = zero
+ (<|>) = (<!>)
+
+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 (Monad m, Default e) => MonadPlus (EitherT e m) where
+ mzero = EitherT $ return $ Left def
+ EitherT m `mplus` EitherT n = EitherT $ m >>= \a -> case a of
+ Left _ -> n
+ 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
30 LICENSE
@@ -0,0 +1,30 @@
+Copyright 2008-2011 Edward Kmett
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+3. Neither the name of the author nor the names of his contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
@@ -0,0 +1,7 @@
+#!/usr/bin/runhaskell
+> module Main (main) where
+
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain
@@ -0,0 +1,33 @@
+name: either
+category: Control, Monads
+version: 0.1
+license: BSD3
+cabal-version: >= 1.6
+license-file: LICENSE
+author: Edward A. Kmett
+maintainer: Edward A. Kmett <ekmett@gmail.com>
+stability: provisional
+homepage: git://github.com/ekmett/either/
+copyright: Copyright (C) 2008-2011 Edward A. Kmett
+synopsis: Haskell 98 either monad transformer
+description: Haskell 98 either monad transformer
+build-type: Simple
+
+source-repository head
+ type: git
+ location: git://github.com/ekmett/either.git
+
+library
+ build-depends:
+ base >= 4 && < 4.4,
+ data-default >= 0.2.0.1 && < 0.3,
+ semigroups >= 0.3.4 && < 0.4,
+ semigroupoids >= 1.1.1 && < 1.2,
+ transformers >= 0.2.0 && <= 0.3
+
+ extensions: CPP
+
+ exposed-modules:
+ Control.Monad.Trans.Either
+
+ ghc-options: -Wall

0 comments on commit 039cca5

Please sign in to comment.