either-4.1/0000755000000000000000000000000012256357602011034 5ustar0000000000000000either-4.1/.ghci0000644000000000000000000000012512256357602011745 0ustar0000000000000000:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h either-4.1/.gitignore0000644000000000000000000000010412256357602013017 0ustar0000000000000000dist docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# either-4.1/.travis.yml0000644000000000000000000000033312256357602013144 0ustar0000000000000000language: haskell notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313either\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" either-4.1/.vim.custom0000644000000000000000000000137712256357602013151 0ustar0000000000000000" 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 :exec ":!hasktags -x -c --ignore src" " 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" either-4.1/CHANGELOG.markdown0000644000000000000000000000171612256357602014074 0ustar00000000000000004.1 --- * Added instances for `MonadBase`, `MonadBaseControl`, and `MonadTransControl`. 4.0 --- * Updated dependencies. 3.4.2 ----- * Added 'Data.Either.Combinators'. 3.4.1 ----- * Trustworthy despite UndecidableInstances 3.4 --- * Delegate `fail` to the underlying `Monad`, rather than `error`. 3.3 --- * Inverted roles between `Semigroup` and `Alt`. This let us write `Alternative` and `MonadPlus` instances that are compatible. * Removed the `Functor` constraint on most instances in exchange for incurring a `Monad` constraint on `Traversable`. `EitherT` is after all, a `Monad` transformer first and foremost. 3.2 --- * Changed the `Semigroup` to use a `Semigroup` to combine `Left` branches. Left `Alt` untouched, so you can mix and match. 3.1 --- * Added instances for `mtl` classes and `MonadRandom`. * The meaning of `mapEitherT` has changed to match `mapErrorT` in the `mtl`. The old `mapEitherT` is now `bimapEitherT`. 3.0.3 ----- * Started `CHANGELOG` either-4.1/either.cabal0000644000000000000000000000220112256357602013273 0ustar0000000000000000name: either category: Control, Monads version: 4.1 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/either/ bug-reports: http://github.com/ekmett/either/issues copyright: Copyright (C) 2008-2013 Edward A. Kmett synopsis: An either monad transformer description: An either monad transformer build-type: Simple extra-source-files: .gitignore .ghci .vim.custom .travis.yml CHANGELOG.markdown README.markdown source-repository head type: git location: git://github.com/ekmett/either.git library build-depends: base >= 4 && < 5, monad-control >= 0.3.2, MonadRandom == 0.1.*, mtl >= 2.0 && < 2.2, semigroups >= 0.8.3.1 && < 1, semigroupoids >= 4 && < 5, transformers >= 0.2 && < 0.4, transformers-base >= 0.4 extensions: CPP exposed-modules: Control.Monad.Trans.Either, Data.Either.Combinators ghc-options: -Wall hs-source-dirs: src either-4.1/LICENSE0000644000000000000000000000266012256357602012045 0ustar0000000000000000Copyright 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. either-4.1/README.markdown0000644000000000000000000000113512256357602013535 0ustar0000000000000000either ====== [![Build Status](https://secure.travis-ci.org/ekmett/either.png?branch=master)](http://travis-ci.org/ekmett/either) This provides an `Either` monad transformer that unlike `ErrorT` is unencumbered by a constraint on its `Left` hand argument. This is needed for a number of applications of this monad transformer, notably in [recursion-schemes](https://github.com/ekmett/recursion-schemes). Contact Information ------------------- Contributions and bug reports are welcome! Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net. -Edward Kmett either-4.1/Setup.lhs0000644000000000000000000000016512256357602012646 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain either-4.1/src/0000755000000000000000000000000012256357602011623 5ustar0000000000000000either-4.1/src/Control/0000755000000000000000000000000012256357602013243 5ustar0000000000000000either-4.1/src/Control/Monad/0000755000000000000000000000000012256357602014301 5ustar0000000000000000either-4.1/src/Control/Monad/Trans/0000755000000000000000000000000012256357602015370 5ustar0000000000000000either-4.1/src/Control/Monad/Trans/Either.hs0000644000000000000000000002214112256357602017144 0ustar0000000000000000{-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Trans.Either -- Copyright : (C) 2008-2013 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : MPTCs -- -- This module provides a minimalist 'Either' monad transformer. ----------------------------------------------------------------------------- module Control.Monad.Trans.Either ( EitherT(..) , eitherT , bimapEitherT , mapEitherT , hoistEither , left , right ) where import Control.Applicative import Control.Monad (liftM, MonadPlus(..)) import Control.Monad.Base (MonadBase(..), liftBaseDefault) import Control.Monad.Cont.Class import Control.Monad.Error.Class import Control.Monad.Fix import Control.Monad.IO.Class import Control.Monad.Reader.Class import Control.Monad.State (MonadState,get,put) import Control.Monad.Trans.Class import Control.Monad.Trans.Control (MonadBaseControl(..), MonadTransControl(..), defaultLiftBaseWith, defaultRestoreM) import Control.Monad.Writer.Class import Control.Monad.Random (MonadRandom,getRandom,getRandoms,getRandomR,getRandomRs) import Data.Foldable import Data.Function (on) import Data.Functor.Bind import Data.Functor.Plus import Data.Traversable import Data.Semigroup -- | 'EitherT' is a version of 'Control.Monad.Trans.Error.ErrorT' that does not -- require a spurious 'Control.Monad.Error.Class.Error' instance for the 'Left' -- case. -- -- 'Either' is a perfectly usable 'Monad' without such a constraint. 'ErrorT' is -- not the generalization of the current 'Either' monad, it is something else. -- -- This is necessary for both theoretical and practical reasons. For instance an -- apomorphism is the generalized anamorphism for this Monad, but it cannot be -- written with 'ErrorT'. -- -- In addition to the combinators here, the @errors@ package provides a large -- number of combinators for working with this type. newtype EitherT e m a = EitherT { runEitherT :: m (Either e a) } instance Show (m (Either e a)) => Show (EitherT e m a) where showsPrec d (EitherT m) = showParen (d > 10) $ showString "EitherT " . showsPrec 11 m {-# INLINE showsPrec #-} instance Read (m (Either e a)) => Read (EitherT e m a) where readsPrec d = readParen (d > 10) (\r' -> [ (EitherT m, t) | ("EitherT", s) <- lex r' , (m, t) <- readsPrec 11 s]) {-# INLINE readsPrec #-} instance Eq (m (Either e a)) => Eq (EitherT e m a) where (==) = (==) `on` runEitherT {-# INLINE (==) #-} instance Ord (m (Either e a)) => Ord (EitherT e m a) where compare = compare `on` runEitherT {-# INLINE compare #-} -- | Given a pair of actions, one to perform in case of failure, and one to perform -- in case of success, run an 'EitherT' and get back a monadic result. 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 #-} -- | Analogous to 'Left'. Equivalent to 'throwError'. left :: Monad m => e -> EitherT e m a left = EitherT . return . Left {-# INLINE left #-} -- | Analogous to 'Right'. Equivalent to 'return'. right :: Monad m => a -> EitherT e m a right = return {-# INLINE right #-} -- | Map over both failure and success. bimapEitherT :: Functor m => (e -> f) -> (a -> b) -> EitherT e m a -> EitherT f m b bimapEitherT f g (EitherT m) = EitherT (fmap h m) where h (Left e) = Left (f e) h (Right a) = Right (g a) {-# INLINE bimapEitherT #-} -- | Map the unwrapped computation using the given function. -- -- @ -- 'runEitherT' ('mapEitherT' f m) = f ('runEitherT' m) -- @ mapEitherT :: (m (Either e a) -> n (Either e' b)) -> EitherT e m a -> EitherT e' n b mapEitherT f m = EitherT $ f (runEitherT m) {-# INLINE mapEitherT #-} -- | Lift an 'Either' into an 'EitherT' hoistEither :: Monad m => Either e a -> EitherT e m a hoistEither = EitherT . return {-# INLINE hoistEither #-} instance Monad m => Functor (EitherT e m) where fmap f = EitherT . liftM (fmap f) . runEitherT {-# INLINE fmap #-} instance 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)) {-# INLINE (<.>) #-} instance Monad m => Applicative (EitherT e m) where pure a = EitherT $ return (Right a) {-# INLINE pure #-} 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)) {-# INLINE (<*>) #-} instance (Monad m, Monoid e) => Alternative (EitherT e m) where EitherT m <|> EitherT n = EitherT $ m >>= \a -> case a of Left l -> liftM (\b -> case b of Left l' -> Left (mappend l l') Right r -> Right r) n Right r -> return (Right r) {-# INLINE (<|>) #-} empty = EitherT $ return (Left mempty) {-# INLINE empty #-} instance (Monad m, Monoid e) => MonadPlus (EitherT e m) where mplus = (<|>) {-# INLINE mplus #-} mzero = empty {-# INLINE mzero #-} 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) {-# INLINE (<>) #-} instance (Monad m, Semigroup e) => Alt (EitherT e m) where EitherT m EitherT n = EitherT $ m >>= \a -> case a of Left l -> liftM (\b -> case b of Left l' -> Left (l <> l') Right r -> Right r) n Right r -> return (Right r) {-# INLINE () #-} instance Monad m => Bind (EitherT e m) where (>>-) = (>>=) {-# INLINE (>>-) #-} instance Monad m => Monad (EitherT e m) where return a = EitherT $ return (Right a) {-# INLINE return #-} m >>= k = EitherT $ do a <- runEitherT m case a of Left l -> return (Left l) Right r -> runEitherT (k r) {-# INLINE (>>=) #-} fail = EitherT . fail {-# INLINE fail #-} instance Monad m => MonadError e (EitherT e m) where throwError = EitherT . return . Left {-# INLINE throwError #-} EitherT m `catchError` h = EitherT $ m >>= \a -> case a of Left l -> runEitherT (h l) Right r -> return (Right r) {-# INLINE catchError #-} 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" {-# INLINE mfix #-} instance MonadTrans (EitherT e) where lift = EitherT . liftM Right {-# INLINE lift #-} instance MonadIO m => MonadIO (EitherT e m) where liftIO = lift . liftIO {-# INLINE liftIO #-} instance MonadCont m => MonadCont (EitherT e m) where callCC f = EitherT $ callCC $ \c -> runEitherT (f (\a -> EitherT $ c (Right a))) {-# INLINE callCC #-} instance MonadReader r m => MonadReader r (EitherT e m) where ask = lift ask {-# INLINE ask #-} local f (EitherT m) = EitherT (local f m) {-# INLINE local #-} instance MonadState s m => MonadState s (EitherT e m) where get = lift get {-# INLINE get #-} put = lift . put {-# INLINE put #-} instance MonadWriter s m => MonadWriter s (EitherT e m) where tell = lift . tell {-# INLINE tell #-} listen = mapEitherT $ \ m -> do (a, w) <- listen m return $! fmap (\ r -> (r, w)) a {-# INLINE listen #-} pass = mapEitherT $ \ m -> pass $ do a <- m return $! case a of Left l -> (Left l, id) Right (r, f) -> (Right r, f) {-# INLINE pass #-} instance MonadRandom m => MonadRandom (EitherT e m) where getRandom = lift getRandom {-# INLINE getRandom #-} getRandoms = lift getRandoms {-# INLINE getRandoms #-} getRandomR = lift . getRandomR {-# INLINE getRandomR #-} getRandomRs = lift . getRandomRs {-# INLINE getRandomRs #-} instance Foldable m => Foldable (EitherT e m) where foldMap f = foldMap (either mempty f) . runEitherT {-# INLINE foldMap #-} instance (Monad f, Traversable f) => Traversable (EitherT e f) where traverse f (EitherT a) = EitherT <$> traverse (either (pure . Left) (fmap Right . f)) a {-# INLINE traverse #-} instance (Error e, MonadBase b m) => MonadBase b (EitherT e m) where liftBase = liftBaseDefault {-# INLINE liftBase #-} instance Error e => MonadTransControl (EitherT e) where newtype StT (EitherT e) a = StEitherT {unStEitherT :: Either e a} liftWith f = EitherT $ liftM return $ f $ liftM StEitherT . runEitherT {-# INLINE liftWith #-} restoreT = EitherT . liftM unStEitherT {-# INLINE restoreT #-} instance (Error e, MonadBaseControl b m) => MonadBaseControl b (EitherT e m) where newtype StM (EitherT e m) a = StMEitherT { unStMEitherT :: StM m (StT (EitherT e) a) } liftBaseWith = defaultLiftBaseWith StMEitherT {-# INLINE liftBaseWith #-} restoreM = defaultRestoreM unStMEitherT {-# INLINE restoreM #-} either-4.1/src/Data/0000755000000000000000000000000012256357602012474 5ustar0000000000000000either-4.1/src/Data/Either/0000755000000000000000000000000012256357602013714 5ustar0000000000000000either-4.1/src/Data/Either/Combinators.hs0000644000000000000000000001451212256357602016533 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Either.Combinators -- Copyright : (c) Gregory Crosswhite, Chris Done, Edward Kmett -- License : BSD-style -- -- Maintainer : ekmett@gmail.com -- Stability : provisional -- Portability : portable -- -- Functions for probing and unwrapping values inside of 'Either'. -- -- Most of these combinators are provided for pedagogical purposes and exist -- in more general forms in other libraries. To that end alternative definitions -- are supplied below. -- ----------------------------------------------------------------------------- module Data.Either.Combinators ( isLeft , isRight , fromLeft , fromRight , fromLeft' , fromRight' , mapBoth , mapLeft , mapRight , whenLeft , whenRight , unlessLeft , unlessRight , leftToMaybe , rightToMaybe ) where import Control.Applicative -- --------------------------------------------------------------------------- -- Functions over Either -- |The 'isLeft' function returns 'True' iff its argument is of the form @Left _@. -- -- Using @Control.Lens@: -- -- @ -- 'isLeft' ≡ has _Left -- @ -- -- >>> isLeft (Left 12) -- True -- -- >>> isLeft (Right 12) -- False isLeft :: Either a b -> Bool isLeft (Left _) = True isLeft _ = False -- |The 'isRight' function returns 'True' iff its argument is of the form @Right _@. -- -- Using @Control.Lens@: -- -- @ -- 'isRight' ≡ has _Right -- @ -- -- >>> isRight (Left 12) -- False -- -- >>> isRight (Right 12) -- True isRight :: Either a b -> Bool isRight (Right _) = True isRight _ = False -- | Extracts the element out of a 'Left' and -- throws an error if its argument take the form @'Right' _@. -- -- Using @Control.Lens@: -- -- @ -- 'fromLeft'' x ≡ x^?!_Left -- @ -- -- >>> fromLeft' (Left 12) -- 12 fromLeft' :: Either a b -> a fromLeft' (Right _) = error "Data.Either.Combinators.fromLeft: Argument takes form 'Right _'" -- yuck fromLeft' (Left x) = x -- | Extracts the element out of a 'Right' and -- throws an error if its argument take the form @'Left' _@. -- -- Using @Control.Lens@: -- -- @ -- 'fromRight'' x ≡ x^?!_Right -- @ -- -- >>> fromRight' (Right 12) -- 12 fromRight' :: Either a b -> b fromRight' (Left _) = error "Data.Either.Combinators.fromRight: Argument takes form 'Left _'" -- yuck fromRight' (Right x) = x -- | The 'mapBoth' function takes two functions and applies the first if iff the value -- takes the form @'Left' _@ and the second if the value takes the form @'Right' _@. -- -- Using @Data.Bifunctor@: -- -- @ -- 'mapBoth' = bimap -- @ -- -- Using @Control.Arrow@: -- -- @ -- 'mapBoth' = ('Control.Arrow.+++') -- @ -- -- >>> mapBoth (*2) (*3) (Left 4) -- Left 8 -- -- >>> mapBoth (*2) (*3) (Right 4) -- Right 12 mapBoth :: (a -> c) -> (b -> d) -> Either a b -> Either c d mapBoth f _ (Left x) = Left (f x) mapBoth _ f (Right x) = Right (f x) -- | The 'mapLeft' function takes a function and applies it to an Either value -- iff the value takes the form 'Left _'. -- -- Using @Data.Bifunctor@: -- -- @ -- 'mapLeft' = first -- @ -- -- Using @Control.Arrow@: -- -- @ -- 'mapLeft' = ('Control.Arrow.left') -- @ -- -- Using @Control.Lens@: -- -- @ -- 'mapLeft' = over _Left -- @ -- -- >>> mapLeft (*2) (Left 4) -- Left 8 -- -- >>> mapLeft (*2) (Right "hello") -- Right "hello" mapLeft :: (a -> c) -> Either a b -> Either c b mapLeft f = mapBoth f id -- | The 'mapLeft' function takes a function and applies it to an Either value -- iff the value takes the form 'Left _'. -- -- Using @Data.Bifunctor@: -- -- @ -- 'mapRight' = first -- @ -- -- Using @Control.Arrow@: -- -- @ -- 'mapRight' = ('Control.Arrow.right') -- @ -- -- Using @Control.Lens@: -- -- @ -- 'mapRight' = 'over' '_Right' -- @ -- -- >>> mapRight (*2) (Left "hello") -- Left "hello" -- -- >>> mapRight (*2) (Right 4) -- Right 8 mapRight :: (b -> c) -> Either a b -> Either a c mapRight = mapBoth id -- | The 'whenLeft' function takes an 'Either' value and a function which returns a monad. -- The monad is only executed when the given argument takes the form @Left _@, otherwise -- it does nothing. -- -- Using @Control.Lens@: -- -- @ -- 'whenLeft' ≡ forOf_ _Left -- @ -- -- >>> whenLeft (Left 12) print -- 12 whenLeft :: Applicative m => Either a b -> (a -> m ()) -> m () whenLeft (Left x) f = f x whenLeft _ _ = pure () -- | The 'whenLeft' function takes an 'Either' value and a function which returns a monad. -- The monad is only executed when the given argument takes the form @Right _@, otherwise -- it does nothing. -- -- Using @Data.Foldable@: -- -- @ -- 'whenRight' ≡ 'forM_' -- @ -- -- Using @Control.Lens@: -- -- @ -- 'whenRight' ≡ forOf_ _Right -- @ -- -- >>> whenRight (Right 12) print -- 12 whenRight :: Applicative m => Either a b -> (b -> m ()) -> m () whenRight (Right x) f = f x whenRight _ _ = pure () -- | A synonym of 'whenRight'. unlessLeft :: Applicative m => Either a b -> (b -> m ()) -> m () unlessLeft = whenRight -- | A synonym of 'whenLeft'. unlessRight :: Applicative m => Either a b -> (a -> m ()) -> m () unlessRight = whenLeft -- | Extract the left value or a default. -- -- @ -- 'fromLeft' ≡ 'either' 'id' -- @ -- -- >>> fromLeft "hello" (Right 42) -- "hello" -- -- >>> fromLeft "hello" (Left "world") -- "world" fromLeft :: a -> Either a b -> a fromLeft _ (Left x) = x fromLeft x _ = x -- | Extract the right value or a default. -- -- @ -- 'fromRight' b ≡ 'either' b 'id' -- @ -- -- >>> fromRight "hello" (Right "world") -- "world" -- -- >>> fromRight "hello" (Left 42) -- "hello" fromRight :: b -> Either a b -> b fromRight _ (Right x) = x fromRight x _ = x -- | Maybe get the 'Left' side of an 'Either'. -- -- @ -- 'leftToMaybe' ≡ 'either' 'Just' ('const' 'Nothing') -- @ -- -- Using @Control.Lens@: -- -- @ -- 'leftToMaybe' ≡ preview _Left -- 'leftToMaybe' x ≡ x^?_Left -- @ -- -- >>> leftToMaybe (Left 12) -- Just 12 -- -- >>> leftToMaybe (Right 12) -- Nothing leftToMaybe :: Either a b -> Maybe a leftToMaybe = either Just (const Nothing) -- | Maybe get the 'Right' side of an 'Either'. -- -- @ -- 'rightToMaybe' ≡ 'either' ('const' 'Nothing') 'Just' -- @ -- -- Using @Control.Lens@: -- -- @ -- 'rightToMaybe' ≡ preview _Right -- 'rightToMaybe' x ≡ x^?_Right -- @ -- -- >>> rightToMaybe (Left 12) -- Nothing -- -- >>> rightToMaybe (Right 12) -- Just 12 rightToMaybe :: Either a b -> Maybe b rightToMaybe = either (const Nothing) Just