    {-# 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.Monoid (Monoid(mappend, mempty))
    import Data.Profunctor
    import Data.Semigroup (Semigroup((<>)))
    import Data.Traversable (Traversable(traverse))
    import Prelude hiding (foldr)

    -- | 'Validation' is 'Either' with a Left that is a 'Monoid'
    data Validation e a
      = Failure e
      | Success a
      deriving (Validation e a -> Validation e a -> Bool
    (Validation e a -> Validation e a -> Bool)
    -> (Validation e a -> Validation e a -> Bool)
    -> Eq (Validation e a)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    forall e a.
    (Eq e, Eq a) =>
    Validation e a -> Validation e a -> Bool
    /= :: Validation e a -> Validation e a -> Bool
    $c/= :: forall e a.
    (Eq e, Eq a) =>
    Validation e a -> Validation e a -> Bool
    == :: Validation e a -> Validation e a -> Bool
    $c== :: forall e a.
    (Eq e, Eq a) =>
    Validation e a -> Validation e a -> Bool
    Eq, Eq (Validation e a)
    Eq (Validation e a) =>
    (Validation e a -> Validation e a -> Ordering)
    -> (Validation e a -> Validation e a -> Bool)
    -> (Validation e a -> Validation e a -> Bool)
    -> (Validation e a -> Validation e a -> Bool)
    -> (Validation e a -> Validation e a -> Bool)
    -> (Validation e a -> Validation e a -> Validation e a)
    -> (Validation e a -> Validation e a -> Validation e a)
    -> Ord (Validation e a)
    Validation e a -> Validation e a -> Bool
    Validation e a -> Validation e a -> Ordering
    Validation e a -> Validation e a -> Validation e a
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall e a. (Ord e, Ord a) => Eq (Validation e a)
    forall e a.
    (Ord e, Ord a) =>
    Validation e a -> Validation e a -> Bool
    forall e a.
    (Ord e, Ord a) =>
    Validation e a -> Validation e a -> Ordering
    forall e a.
    (Ord e, Ord a) =>
    Validation e a -> Validation e a -> Validation e a
    min :: Validation e a -> Validation e a -> Validation e a
    $cmin :: forall e a.
    (Ord e, Ord a) =>
    Validation e a -> Validation e a -> Validation e a
    max :: Validation e a -> Validation e a -> Validation e a
    $cmax :: forall e a.
    (Ord e, Ord a) =>
    Validation e a -> Validation e a -> Validation e a
    >= :: Validation e a -> Validation e a -> Bool
    $c>= :: forall e a.
    (Ord e, Ord a) =>
    Validation e a -> Validation e a -> Bool
    > :: Validation e a -> Validation e a -> Bool
    $c> :: forall e a.
    (Ord e, Ord a) =>
    Validation e a -> Validation e a -> Bool
    <= :: Validation e a -> Validation e a -> Bool
    $c<= :: forall e a.
    (Ord e, Ord a) =>
    Validation e a -> Validation e a -> Bool
    < :: Validation e a -> Validation e a -> Bool
    $c< :: forall e a.
    (Ord e, Ord a) =>
    Validation e a -> Validation e a -> Bool
    compare :: Validation e a -> Validation e a -> Ordering
    $ccompare :: forall e a.
    (Ord e, Ord a) =>
    Validation e a -> Validation e a -> Ordering
    $cp1Ord :: forall e a. (Ord e, Ord a) => Eq (Validation e a)
    Ord, Int -> Validation e a -> ShowS
    [Validation e a] -> ShowS
    Validation e a -> String
    (Int -> Validation e a -> ShowS)
    -> (Validation e a -> String)
    -> ([Validation e a] -> ShowS)
    -> Show (Validation e a)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    forall e a. (Show e, Show a) => Int -> Validation e a -> ShowS
    forall e a. (Show e, Show a) => [Validation e a] -> ShowS
    forall e a. (Show e, Show a) => Validation e a -> String
    showList :: [Validation e a] -> ShowS
    $cshowList :: forall e a. (Show e, Show a) => [Validation e a] -> ShowS
    show :: Validation e a -> String
    $cshow :: forall e a. (Show e, Show a) => Validation e a -> String
    showsPrec :: Int -> Validation e a -> ShowS
    $cshowsPrec :: forall e a. (Show e, Show a) => Int -> Validation e a -> ShowS
    Show)

    instance Functor (Validation e) where
       fmap :: (a -> b) -> Validation e a -> Validation e b
    fmap _ (Failure e :: e
    e) = e -> Validation e b
    forall e a. e -> Validation e a
    Failure e
    e
       fmap f :: a -> b
    f (Success a :: a
    a) = b -> Validation e b
    forall e a. a -> Validation e a
    Success (a -> b
    f a
    a)

    instance Semigroup e => Apply (Validation e) where
      Failure e1 :: e
    e1 <.> :: Validation e (a -> b) -> Validation e a -> Validation e b
    <.> b :: Validation e a
    b = e -> Validation e b
    forall e a. e -> Validation e a
    Failure (e -> Validation e b) -> e -> Validation e b
    forall a b. (a -> b) -> a -> b
    $ case Validation e a
    b of
        Failure e2 :: e
    e2 -> e
    e1 e -> e -> e
    forall a. Semigroup a => a -> a -> a
    <> e
    e2
        Success _  -> e
    e1
      Success _  <.> Failure e :: e
    e  = e -> Validation e b
    forall e a. e -> Validation e a
    Failure  e
    e
      Success f :: a -> b
    f  <.> Success x :: a
    x  = b -> Validation e b
    forall e a. a -> Validation e a
    Success (a -> b
    f a
    x)

    instance Semigroup e => Applicative (Validation e) where
      pure :: a -> Validation e a
    pure = a -> Validation e a
    forall e a. a -> Validation e a
    Success
      <*> :: Validation e (a -> b) -> Validation e a -> Validation e b
    (<*>) = Validation e (a -> b) -> Validation e a -> Validation e b
    forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
    (<.>)

    -- | For two errors, this instance reports both of them.
    instance Semigroup e => Alt (Validation e) where
      s :: Validation e a
    s@Success{} <!> :: Validation e a -> Validation e a -> Validation e a
    <!> _ = Validation e a
    s
      _ <!> s :: Validation e a
    s@Success{} = Validation e a
    s
      Failure m :: e
    m <!> Failure n :: e
    n = e -> Validation e a
    forall e a. e -> Validation e a
    Failure (e
    m e -> e -> e
    forall a. Semigroup a => a -> a -> a
    <> e
    n)

    instance (Semigroup e, Monoid e) => Alternative (Validation e) where
      empty :: Validation e a
    empty = e -> Validation e a
    forall e a. e -> Validation e a
    Failure e
    forall a. Monoid a => a
    mempty
      <|> :: Validation e a -> Validation e a -> Validation e a
    (<|>) = Validation e a -> Validation e a -> Validation e a
    forall (f :: * -> *) a. Alt f => f a -> f a -> f a
    (<!>)

    instance Foldable (Validation e) where
      foldr :: (a -> b -> b) -> b -> Validation e a -> b
    foldr f :: a -> b -> b
    f x :: b
    x (Success a :: a
    a) = a -> b -> b
    f a
    a b
    x
      foldr _ x :: b
    x (Failure _) = b
    x

    instance Traversable (Validation e) where
      traverse :: (a -> f b) -> Validation e a -> f (Validation e b)
    traverse f :: a -> f b
    f (Success a :: a
    a) = b -> Validation e b
    forall e a. a -> Validation e a
    Success (b -> Validation e b) -> f b -> f (Validation e b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> f b
    f a
    a
      traverse _ (Failure e :: e
    e) = Validation e b -> f (Validation e b)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (e -> Validation e b
    forall e a. e -> Validation e a
    Failure e
    e)

    instance Bifunctor Validation where
      bimap :: (a -> b) -> (c -> d) -> Validation a c -> Validation b d
    bimap f :: a -> b
    f _ (Failure e :: a
    e) = b -> Validation b d
    forall e a. e -> Validation e a
    Failure (a -> b
    f a
    e)
      bimap _ g :: c -> d
    g (Success a :: c
    a) = d -> Validation b d
    forall e a. a -> Validation e a
    Success (c -> d
    g c
    a)

    instance Bifoldable Validation where
      bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> Validation a b -> c
    bifoldr _ g :: b -> c -> c
    g x :: c
    x (Success a :: b
    a) = b -> c -> c
    g b
    a c
    x
      bifoldr f :: a -> c -> c
    f _ x :: c
    x (Failure e :: a
    e) = a -> c -> c
    f a
    e c
    x

    instance Bitraversable Validation where
      bitraverse :: (a -> f c) -> (b -> f d) -> Validation a b -> f (Validation c d)
    bitraverse _ g :: b -> f d
    g (Success a :: b
    a) = d -> Validation c d
    forall e a. a -> Validation e a
    Success (d -> Validation c d) -> f d -> f (Validation c d)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> b -> f d
    g b
    a
      bitraverse f :: a -> f c
    f _ (Failure e :: a
    e) = c -> Validation c d
    forall e a. e -> Validation e a
    Failure (c -> Validation c d) -> f c -> f (Validation c d)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> f c
    f a
    e

    instance Semigroup e => Semigroup (Validation e a) where
      x :: Validation e a
    x@Success{} <> :: Validation e a -> Validation e a -> Validation e a
    <> _ = Validation e a
    x
      _ <> x :: Validation e a
    x@Success{} = Validation e a
    x
      Failure e1 :: e
    e1 <> Failure e2 :: e
    e2 = e -> Validation e a
    forall e a. e -> Validation e a
    Failure (e
    e1 e -> e -> e
    forall a. Semigroup a => a -> a -> a
    <> e
    e2)

    instance Monoid e => Monoid (Validation e a) where
      mempty :: Validation e a
    mempty = e -> Validation e a
    forall e a. e -> Validation e a
    Failure e
    forall a. Monoid a => a
    mempty
      x :: Validation e a
    x@Success{} mappend :: Validation e a -> Validation e a -> Validation e a
    `mappend` _ = Validation e a
    x
      _ `mappend` x :: Validation e a
    x@Success{} = Validation e a
    x
      Failure e1 :: e
    e1 `mappend` Failure e2 :: e
    e2 = e -> Validation e a
    forall e a. e -> Validation e a
    Failure (e
    e1 e -> e -> e
    forall a. Monoid a => a -> a -> a
    `mappend` e
    e2)

    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 :: (b -> t) -> (s -> Either t a) -> Prism s t a b
    prism bt :: b -> t
    bt seta :: s -> Either t a
    seta = (s -> Either t a)
    -> (Either t (f b) -> f t)
    -> p (Either t a) (Either t (f b))
    -> p s (f t)
    forall (p :: * -> * -> *) a b c d.
    Profunctor p =>
    (a -> b) -> (c -> d) -> p b c -> p a d
    dimap s -> Either t a
    seta ((t -> f t) -> (f b -> f t) -> Either t (f b) -> f t
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either t -> f t
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((b -> t) -> f b -> f t
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap b -> t
    bt)) (p (Either t a) (Either t (f b)) -> p s (f t))
    -> (p a (f b) -> p (Either t a) (Either t (f b)))
    -> p a (f b)
    -> p s (f t)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . p a (f b) -> p (Either t a) (Either t (f b))
    forall (p :: * -> * -> *) a b c.
    Choice p =>
    p a b -> p (Either c a) (Either c b)
    right'
    {-# INLINE prism #-}

    _Failure :: Prism (Validation a c) (Validation b c) a b
    _Failure :: p a (f b) -> p (Validation a c) (f (Validation b c))
    _Failure = (b -> Validation b c)
    -> (Validation a c -> Either (Validation b c) a)
    -> Prism (Validation a c) (Validation b c) a b
    forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
    prism
               (\ x :: b
    x -> b -> Validation b c
    forall e a. e -> Validation e a
    Failure b
    x)
               (\ x :: Validation a c
    x
                -> case Validation a c
    x of
                  Failure y :: a
    y -> a -> Either (Validation b c) a
    forall a b. b -> Either a b
    Right a
    y
                  Success y :: c
    y -> Validation b c -> Either (Validation b c) a
    forall a b. a -> Either a b
    Left (c -> Validation b c
    forall e a. a -> Validation e a
    Success c
    y))
    {-# INLINE _Failure #-}

    _Success :: Prism (Validation c a) (Validation c b) a b
    _Success :: p a (f b) -> p (Validation c a) (f (Validation c b))
    _Success = (b -> Validation c b)
    -> (Validation c a -> Either (Validation c b) a)
    -> Prism (Validation c a) (Validation c b) a b
    forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
    prism
               (\ x :: b
    x -> b -> Validation c b
    forall e a. a -> Validation e a
    Success b
    x)
               (\ x :: Validation c a
    x
                -> case Validation c a
    x of
                  Failure y :: c
    y -> Validation c b -> Either (Validation c b) a
    forall a b. a -> Either a b
    Left (c -> Validation c b
    forall e a. e -> Validation e a
    Failure c
    y)
                  Success y :: a
    y -> a -> Either (Validation c b) a
    forall a b. b -> Either a b
    Right a
    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 :: (s -> a) -> (b -> t) -> Iso s t a b
    iso sa :: s -> a
    sa bt :: b -> t
    bt = (s -> a) -> (f b -> f t) -> p a (f b) -> p s (f t)
    forall (p :: * -> * -> *) a b c d.
    Profunctor p =>
    (a -> b) -> (c -> d) -> p b c -> p a d
    dimap s -> a
    sa ((b -> t) -> f b -> f t
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap b -> t
    bt)
    {-# INLINE iso #-}

    validationToEither :: Validation e a -> Either e a
    validationToEither :: Validation e a -> Either e a
    validationToEither x :: Validation e a
    x = case Validation e a
    x of
      Failure e :: e
    e -> e -> Either e a
    forall a b. a -> Either a b
    Left e
    e
      Success a :: a
    a -> a -> Either e a
    forall a b. b -> Either a b
    Right a
    a
    {-# INLINE validationToEither #-}

    eitherToValidation :: Either e a -> Validation e a
    eitherToValidation :: Either e a -> Validation e a
    eitherToValidation x :: Either e a
    x = case Either e a
    x of
      Left e :: e
    e -> e -> Validation e a
    forall e a. e -> Validation e a
    Failure e
    e
      Right a :: a
    a -> a -> Validation e a
    forall e a. a -> Validation e a
    Success a
    a
    {-# INLINE eitherToValidation #-}

    -- | 'Validation' is isomorphic to 'Either'
    _Validation :: Iso (Validation e a) (Validation g b) (Either e a) (Either g b)
    _Validation :: p (Either e a) (f (Either g b))
    -> p (Validation e a) (f (Validation g b))
    _Validation = (Validation e a -> Either e a)
    -> (Either g b -> Validation g b)
    -> Iso (Validation e a) (Validation g b) (Either e a) (Either g b)
    forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
    iso Validation e a -> Either e a
    forall e a. Validation e a -> Either e a
    validationToEither Either g b -> Validation g b
    forall e a. Either e a -> Validation e a
    eitherToValidation
    {-# INLINE _Validation #-}

    vap :: Semigroup m => Either m (a -> b) -> Either m a -> Either m b
    vap :: Either m (a -> b) -> Either m a -> Either m b
    vap (Left m :: m
    m) b :: Either m a
    b = m -> Either m b
    forall a b. a -> Either a b
    Left (m -> Either m b) -> m -> Either m b
    forall a b. (a -> b) -> a -> b
    $ case Either m a
    b of
      Left n :: m
    n  -> m
    m m -> m -> m
    forall a. Semigroup a => a -> a -> a
    <> m
    n
      Right{} -> m
    m
    vap Right{} (Left n :: m
    n) = m -> Either m b
    forall a b. a -> Either a b
    Left m
    n
    vap (Right f :: a -> b
    f) (Right a :: a
    a) = b -> Either m b
    forall a b. b -> Either a b
    Right (a -> b
    f a
    a)
    {-# INLINE vap #-}

    apm :: Monoid m => Validation m (a -> b) -> Validation m a -> Validation m b
    apm :: Validation m (a -> b) -> Validation m a -> Validation m b
    apm (Failure m :: m
    m) b :: Validation m a
    b = m -> Validation m b
    forall e a. e -> Validation e a
    Failure (m -> Validation m b) -> m -> Validation m b
    forall a b. (a -> b) -> a -> b
    $ m
    m m -> m -> m
    forall a. Monoid a => a -> a -> a
    `mappend` case Validation m a
    b of
      Failure n :: m
    n  -> m
    n
      Success{} -> m
    forall a. Monoid a => a
    mempty
    apm Success{} (Failure n :: m
    n) = m -> Validation m b
    forall e a. e -> Validation e a
    Failure m
    n
    apm (Success f :: a -> b
    f) (Success a :: a
    a) = b -> Validation m b
    forall e a. a -> Validation e a
    Success (a -> b
    f a
    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 :: Either m (a -> b) -> Either m a -> Either m b
    vapm (Left m :: m
    m) b :: Either m a
    b = m -> Either m b
    forall a b. a -> Either a b
    Left (m -> Either m b) -> m -> Either m b
    forall a b. (a -> b) -> a -> b
    $ m
    m m -> m -> m
    forall a. Monoid a => a -> a -> a
    `mappend` case Either m a
    b of
      Left n :: m
    n  -> m
    n
      Right{} -> m
    forall a. Monoid a => a
    mempty
    vapm Right{} (Left n :: m
    n) = m -> Either m b
    forall a b. a -> Either a b
    Left m
    n
    vapm (Right f :: a -> b
    f) (Right a :: a
    a) = b -> Either m b
    forall a b. b -> Either a b
    Right (a -> b
    f a
    a)
    {-# INLINE vapm #-}

    ealt :: Validation e a -> Validation e a -> Validation e a
    ealt :: Validation e a -> Validation e a -> Validation e a
    ealt Failure{} r :: Validation e a
    r = Validation e a
    r
    ealt (Success a :: a
    a) _ = a -> Validation e a
    forall e a. a -> Validation e a
    Success a
    a
    {-# INLINE ealt #-}