diff --git a/.gitignore b/.gitignore
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,5 @@
 dist
+dist-newstyle
 docs
 wiki
 TAGS
@@ -11,3 +12,21 @@
 *.hi
 *~
 *#
+.cabal-sandbox/
+cabal.sandbox.config
+.stack-work/
+cabal-dev
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+*.prof
+*.aux
+*.hp
+*.eventlog
+cabal.project.local
+cabal.project.local~
+.HTF/
+.ghc.environment.*
diff --git a/.travis.yml b/.travis.yml
deleted file mode 100644
--- a/.travis.yml
+++ /dev/null
@@ -1,8 +0,0 @@
-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}"
diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,113 @@
+5.0.3 [2025.06.17]
+------------------
+* Replace `test-framework` with `tasty` in the test suite.
+* Drop support for pre-8.0 versions of GHC.
+
+5.0.2 [2022.05.07]
+------------------
+* Tweak error messages of `fromRight'` and `fromLeft'` for clarity.
+* Allow building with `mtl-2.3.*`.
+
+5.0.1.1 [2019.05.02]
+--------------------
+* Only incur a `semigroups` dependency on pre-8.0 GHCs.
+
+5.0.1 [2018.07.03]
+------------------
+* Make the `Semigroup`, `Apply`, and `Applicative` instances for `Validation`
+  lazier.
+* Make `vap` lazier in its second argument.
+* Introduce `vapm`, an even lazier version of `vap` which requires a
+  `Monoid` constraint. Also add `apm`, a counterpart for `Validation`.
+* Use `test-framework` and `QuickCheck` in the test suite.
+
+5
+-
+* Changed the semantics of the `Validation` `Alt` and `Alternative` instances to collect errors.
+  The previous implementation did not correctly abide the laws.
+* Added `vap`, for when users want validation like semantics but don't want to convert back and forth to validation all the time. Similarly, added `ealt` to give either's `Alt` semantics to validation.
+* Dropped the deprecated `Control.Monad.Trans.Either`.  Use `Control.Monad.Trans.Except` from `transformers` and/or
+  `transformers-compat` instead.
+
+4.5
+----
+* Add `MMonad` instance for `EitherT`
+* Deprecate `Control.Monad.Trans.Either` in favor of `Control.Monad.Trans.Except`
+* Add `firstEitherT`
+
+4.4.1.1
+-------
+* Fixed building on newer GHCs. (type synonyms require explicit foralls for unused variables these days)
+
+4.4.1
+-----
+* `transformers` 0.5 support
+* Documentation fixes
+
+4.4
+---
+* Support `mmorph`
+
+4.3.4.1
+-------
+* Support `MonadRandom` 0.4
+
+4.3.4
+-----
+* Support `bifunctors` 5, `profunctors` 5, and `semigroupoids` 5.
+
+4.3.3.3
+-------
+* Fixed and enhanced documentation for `eitherToError`.
+
+4.3.3.2
+-------
+* Support `exceptions` 0.8
+
+4.3.3.1
+-------
+* Support `exceptions` 0.7
+
+4.3.3
+-----
+* Added `eitherToError`.
+
+4.3.2.1
+-------
+* Support `monad-control` 1.0
+
+4.3.2
+-----
+* Added `Validation`.
+
+4.3.0.2
+-------
+* Updated MonadRandom support.
+
+4.3.0.1
+-------
+* Fixed import of `MonadCatch` to support versions of `base` before 4.6
+
+4.3
+---
+* Inverted dependency between `free` and `either`.
+
+4.2
+---
+* Added instances for `MonadThrow`, `MonadCatch`.
+
+4.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
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright 2008-2011 Edward Kmett
+Copyright 2008-2014 Edward Kmett
 
 All rights reserved.
 
diff --git a/README.markdown b/README.markdown
--- a/README.markdown
+++ b/README.markdown
@@ -1,9 +1,7 @@
 either
 ======
 
-[![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).
+[![Hackage](https://img.shields.io/hackage/v/either.svg)](https://hackage.haskell.org/package/either) [![Build Status](https://github.com/ekmett/either/workflows/Haskell-CI/badge.svg)](https://github.com/ekmett/either/actions?query=workflow%3AHaskell-CI)
 
 Contact Information
 -------------------
diff --git a/either.cabal b/either.cabal
--- a/either.cabal
+++ b/either.cabal
@@ -1,40 +1,67 @@
 name:          either
 category:      Control, Monads
-version:       3.4.1
+version:       5.0.3
 license:       BSD3
-cabal-version: >= 1.6
+cabal-version: >= 1.10
 license-file:  LICENSE
 author:        Edward A. Kmett
 maintainer:    Edward A. Kmett <ekmett@gmail.com>
 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
+copyright:     Copyright (C) 2008-2017 Edward A. Kmett
+synopsis:      Combinators for working with sums
+description:   Combinators for working with sums.
 build-type:    Simple
+tested-with:   GHC == 8.0.2
+             , GHC == 8.2.2
+             , GHC == 8.4.4
+             , GHC == 8.6.5
+             , GHC == 8.8.4
+             , GHC == 8.10.7
+             , GHC == 9.0.2
+             , GHC == 9.2.8
+             , GHC == 9.4.8
+             , GHC == 9.6.6
+             , GHC == 9.8.4
+             , GHC == 9.10.1
+             , GHC == 9.12.1
 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
+  location: https://github.com/ekmett/either.git
 
 library
   build-depends:
-    base          >= 4       && < 5,
-    MonadRandom   == 0.1.*,
-    mtl           >= 2.0     && < 2.2,
-    semigroups    >= 0.8.3.1 && < 1,
-    semigroupoids >= 3       && < 4,
-    transformers  >= 0.2     && < 0.4
+    base              >= 4.9     && < 5,
+    bifunctors        >= 4       && < 6,
+    mtl               >= 2.0     && < 2.4,
+    profunctors       >= 4       && < 6,
+    semigroupoids     >= 4       && < 7
 
-  extensions: CPP
-  exposed-modules: Control.Monad.Trans.Either
+  other-extensions: CPP Rank2Types
   ghc-options: -Wall
   hs-source-dirs: src
+  default-language: Haskell2010
+  exposed-modules:
+    Data.Either.Combinators
+    Data.Either.Validation
+
+test-suite tests
+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
+  type: exitcode-stdio-1.0
+  main-is: Main.hs
+  hs-source-dirs: tests
+  build-depends:
+    base,
+    either,
+    tasty            >= 1.4  && < 1.6,
+    tasty-quickcheck >= 0.10 && < 0.12,
+    QuickCheck       >= 2.9  && < 2.17
+  default-language: Haskell2010
diff --git a/src/Control/Monad/Trans/Either.hs b/src/Control/Monad/Trans/Either.hs
deleted file mode 100644
--- a/src/Control/Monad/Trans/Either.hs
+++ /dev/null
@@ -1,267 +0,0 @@
-{-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
-{-# LANGUAGE Trustworthy #-}
-#endif
-
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE UndecidableInstances  #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Monad.Trans.Either
--- Copyright   :  (C) 2008-2013 Edward Kmett
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  Edward Kmett <ekmett@gmail.com>
--- 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.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.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 #-}
diff --git a/src/Data/Either/Combinators.hs b/src/Data/Either/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Either/Combinators.hs
@@ -0,0 +1,348 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Either.Combinators
+-- Copyright   :  (c) 2010-2014 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
+  , maybeToLeft
+  , maybeToRight
+  , eitherToError
+  , swapEither
+  ) where
+
+import Control.Monad.Error.Class ( MonadError(throwError) )
+
+-- ---------------------------------------------------------------------------
+-- 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' encountered a value of form 'Right _', consider using Data.Either.Combinators.fromLeft with a default value." -- 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' encountered a value of form 'Left _', consider using Data.Either.Combinators.fromRight with a default value." -- 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 'mapRight' function takes a function and applies it to an Either value
+-- iff the value takes the form @'Right' _@.
+--
+-- Using @Data.Bifunctor@:
+--
+-- @
+-- 'mapRight' = second
+-- @
+--
+-- 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 'whenRight' 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' b ≡ 'either' 'id' ('const' b)
+-- @
+--
+-- >>> 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' ('const' 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
+
+-- | Maybe produce a 'Left', otherwise produce a 'Right'.
+--
+-- >>> maybeToLeft "default" (Just 12)
+-- Left 12
+--
+-- >>> maybeToLeft "default" Nothing
+-- Right "default"
+maybeToLeft :: b -> Maybe a -> Either a b
+maybeToLeft _ (Just x) = Left x
+maybeToLeft y Nothing  = Right y
+
+-- | Maybe produce a 'Right', otherwise produce a 'Left'.
+--
+-- >>> maybeToRight "default" (Just 12)
+-- Right 12
+--
+-- >>> maybeToRight "default" Nothing
+-- Left "default"
+maybeToRight :: b -> Maybe a -> Either b a
+maybeToRight _ (Just x) = Right x
+maybeToRight y Nothing  = Left y
+
+-- | Generalize @Either e@ as @MonadError e m@.
+--
+-- If the argument has form @Left e@, an error is produced in the monad via
+-- 'throwError'. Otherwise, the @Right a@ part is forwarded.
+eitherToError :: (MonadError e m) => Either e a -> m a
+eitherToError = either throwError return
+
+-- | Swap the 'Left' and 'Right' sides of an 'Either'.
+--
+-- >>> swapEither (Right 3)
+-- Left 3
+--
+-- >>> swapEither (Left "error")
+-- Right "error"
+swapEither :: Either e a -> Either a e
+swapEither = either Right Left
+{-# INLINE swapEither #-}
diff --git a/src/Data/Either/Validation.hs b/src/Data/Either/Validation.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Either/Validation.hs
@@ -0,0 +1,184 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE Rank2Types #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Either.Validation
+-- Copyright   :  (c) 2014 Chris Allen, Edward Kmett
+-- License     :  BSD-style
+--
+-- Maintainer  :  ekmett@gmail.com
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Monoidal 'Validation' sibling to 'Either'.
+--
+-----------------------------------------------------------------------------
+
+module Data.Either.Validation
+  ( Validation(..)
+  , _Success
+  , _Failure
+  , eitherToValidation
+  , validationToEither
+  , _Validation
+  , vap
+  , ealt
+  -- combinators that leak less, but require monoid constraints
+  , vapm, apm
+  ) where
+
+import Control.Applicative
+import Data.Bifoldable(Bifoldable(bifoldr))
+import Data.Bifunctor(Bifunctor(bimap))
+import Data.Bitraversable(Bitraversable(bitraverse))
+import Data.Foldable (Foldable(foldr))
+import Data.Functor.Alt (Alt((<!>)))
+import Data.Functor.Apply (Apply ((<.>)))
+import Data.Profunctor
+import Prelude hiding (foldr)
+
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup (Semigroup((<>)))
+#endif
+
+-- | 'Validation' is 'Either' with a Left that is a 'Monoid'
+data Validation e a
+  = Failure e
+  | Success a
+  deriving (Eq, Ord, Show)
+
+instance Functor (Validation e) where
+   fmap _ (Failure e) = Failure e
+   fmap f (Success a) = Success (f a)
+
+instance Semigroup e => Apply (Validation e) where
+  Failure e1 <.> b = Failure $ case b of
+    Failure e2 -> e1 <> e2
+    Success _  -> e1
+  Success _  <.> Failure e  = Failure  e
+  Success f  <.> Success x  = Success (f x)
+
+instance Semigroup e => Applicative (Validation e) where
+  pure = Success
+  (<*>) = (<.>)
+
+-- | For two errors, this instance reports both of them.
+instance Semigroup e => Alt (Validation e) where
+  s@Success{} <!> _ = s
+  _ <!> s@Success{} = s
+  Failure m <!> Failure n = Failure (m <> n)
+
+instance (Semigroup e, Monoid e) => Alternative (Validation e) where
+  empty = Failure mempty
+  (<|>) = (<!>)
+
+instance Foldable (Validation e) where
+  foldr f x (Success a) = f a x
+  foldr _ x (Failure _) = x
+
+instance Traversable (Validation e) where
+  traverse f (Success a) = Success <$> f a
+  traverse _ (Failure e) = pure (Failure e)
+
+instance Bifunctor Validation where
+  bimap f _ (Failure e) = Failure (f e)
+  bimap _ g (Success a) = Success (g a)
+
+instance Bifoldable Validation where
+  bifoldr _ g x (Success a) = g a x
+  bifoldr f _ x (Failure e) = f e x
+
+instance Bitraversable Validation where
+  bitraverse _ g (Success a) = Success <$> g a
+  bitraverse f _ (Failure e) = Failure <$> f e
+
+instance Semigroup e => Semigroup (Validation e a) where
+  x@Success{} <> _ = x
+  _ <> x@Success{} = x
+  Failure e1 <> Failure e2 = Failure (e1 <> e2)
+
+instance Monoid e => Monoid (Validation e a) where
+  mempty = Failure mempty
+#if !(MIN_VERSION_base(4,11,0))
+  x@Success{} `mappend` _ = x
+  _ `mappend` x@Success{} = x
+  Failure e1 `mappend` Failure e2 = Failure (e1 `mappend` e2)
+#endif
+
+type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)
+
+prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
+prism bt seta = dimap seta (either pure (fmap bt)) . right'
+{-# INLINE prism #-}
+
+_Failure :: Prism (Validation a c) (Validation b c) a b
+_Failure = prism
+           (\ x -> Failure x)
+           (\ x
+            -> case x of
+              Failure y -> Right y
+              Success y -> Left (Success y))
+{-# INLINE _Failure #-}
+
+_Success :: Prism (Validation c a) (Validation c b) a b
+_Success = prism
+           (\ x -> Success x)
+           (\ x
+            -> case x of
+              Failure y -> Left (Failure y)
+              Success y -> Right y)
+{-# INLINE _Success #-}
+
+type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)
+
+iso :: (s -> a) -> (b -> t) -> Iso s t a b
+iso sa bt = dimap sa (fmap bt)
+{-# INLINE iso #-}
+
+validationToEither :: Validation e a -> Either e a
+validationToEither x = case x of
+  Failure e -> Left e
+  Success a -> Right a
+{-# INLINE validationToEither #-}
+
+eitherToValidation :: Either e a -> Validation e a
+eitherToValidation x = case x of
+  Left e -> Failure e
+  Right a -> Success a
+{-# INLINE eitherToValidation #-}
+
+-- | 'Validation' is isomorphic to 'Either'
+_Validation :: Iso (Validation e a) (Validation g b) (Either e a) (Either g b)
+_Validation = iso validationToEither eitherToValidation
+{-# INLINE _Validation #-}
+
+vap :: Semigroup m => Either m (a -> b) -> Either m a -> Either m b
+vap (Left m) b = Left $ case b of
+  Left n  -> m <> n
+  Right{} -> m
+vap Right{} (Left n) = Left n
+vap (Right f) (Right a) = Right (f a)
+{-# INLINE vap #-}
+
+apm :: Monoid m => Validation m (a -> b) -> Validation m a -> Validation m b
+apm (Failure m) b = Failure $ m `mappend` case b of
+  Failure n  -> n
+  Success{} -> mempty
+apm Success{} (Failure n) = Failure n
+apm (Success f) (Success a) = Success (f a)
+{-# INLINE apm #-}
+
+-- lazier version of vap that can leak less, but which requires a Monoid
+vapm :: Monoid m => Either m (a -> b) -> Either m a -> Either m b
+vapm (Left m) b = Left $ m `mappend` case b of
+  Left n  -> n
+  Right{} -> mempty
+vapm Right{} (Left n) = Left n
+vapm (Right f) (Right a) = Right (f a)
+{-# INLINE vapm #-}
+
+ealt :: Validation e a -> Validation e a -> Validation e a
+ealt Failure{} r = r
+ealt (Success a) _ = Success a
+{-# INLINE ealt #-}
diff --git a/tests/Main.hs b/tests/Main.hs
new file mode 100644
--- /dev/null
+++ b/tests/Main.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Control.Applicative
+import Data.Either.Validation
+import Data.Monoid (Sum(..))
+
+import Test.QuickCheck (Property, Gen, (===), (.&&.), Arbitrary (..), forAllShrink, oneof)
+import Test.Tasty (defaultMain, testGroup)
+import Test.Tasty.QuickCheck (testProperty)
+
+
+main :: IO ()
+main = defaultMain $
+  testGroup "either"
+    [ testProperty "identity" $ identity (<|>) empty genValSumInt shrinkValidation
+    , testProperty "associativity" $ associativity (<|>) genValSumInt shrinkValidation
+    ]
+
+genValSumInt :: Gen (Validation (Sum Int) (Sum Int))
+genValSumInt = genValidation
+
+genValidation :: (Arbitrary a, Arbitrary b) => Gen (Validation a b)
+genValidation = oneof
+    [ fmap Failure arbitrary
+    , fmap Success arbitrary
+    ]
+
+shrinkValidation :: (Arbitrary a, Arbitrary b) => Validation a b -> [Validation a b]
+shrinkValidation (Success x) = Success `fmap` shrink x
+shrinkValidation (Failure x) = Failure `fmap` shrink x
+
+-- -- empty is a neutral element
+-- empty <|> u  =  u
+-- u <|> empty  =  u
+-- -- (<|>) is associative
+-- u <|> (v <|> w)  =  (u <|> v) <|> w
+
+identity :: (Eq a, Show a) => (a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property
+identity f i gen shr = forAllShrink gen shr $ \x ->
+    f x i === x .&&. f i x === x
+
+associativity :: (Eq a, Show a) => (a -> a -> a) -> Gen a -> (a -> [a]) -> Property
+associativity f gen shr =
+    forAllShrink gen shr $ \x ->
+    forAllShrink gen shr $ \y ->
+    forAllShrink gen shr $ \z ->
+        f x (f y z) === f (f x y) z
