{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}

-- | A data type similar to @Data.Either@ that accumulates failures.
module Data.Validation
(
  -- * Data type
  Validation(..)
  -- * Constructing validations
, validate
, validationNel
, fromEither
, liftError
  -- * Functions on validations
, validation
, toEither
, orElse
, valueOr
, ensure
, codiagonal
, validationed
, bindValidation
  -- * Prisms
  -- | These prisms are useful for writing code which is polymorphic in its
  -- choice of Either or Validation. This choice can then be made later by a
  -- user, depending on their needs.
  --
  -- An example of this style of usage can be found
  -- <https://github.com/qfpl/validation/blob/master/examples/src/PolymorphicEmail.hs here>
, _Failure
, _Success
  -- * Isomorphisms
, Validate(..)
, revalidate
) where

import Control.Applicative(Applicative((<*>), pure), (<$>))
import Control.DeepSeq (NFData (rnf))
import Control.Lens (over, under)
import Control.Lens.Getter((^.))
import Control.Lens.Iso(Iso, iso, from
#if !MIN_VERSION_lens(4,20,0)
                       , Swapped(..))
#else
                       )
#endif
import Control.Lens.Prism(Prism, _Left, _Right)
import Control.Lens.Review(( # ))
import Data.Bifoldable(Bifoldable(bifoldr))
import Data.Bifunctor(Bifunctor(bimap))
import Data.Bifunctor.Swap(Swap(..))
import Data.Bitraversable(Bitraversable(bitraverse))
import Data.Data(Data)
import Data.Either(Either(Left, Right), either)
import Data.Eq(Eq)
import Data.Foldable(Foldable(foldr))
import Data.Function((.), ($), id)
import Data.Functor(Functor(fmap))
import Data.Functor.Alt(Alt((<!>)))
import Data.Functor.Apply(Apply((<.>)))
import Data.List.NonEmpty (NonEmpty)
import Data.Monoid(Monoid(mappend, mempty))
import Data.Ord(Ord)
import Data.Semigroup(Semigroup((<>)))
import Data.Traversable(Traversable(traverse))
import Data.Typeable(Typeable)
import GHC.Generics (Generic)
import Prelude(Show, Maybe(..))


-- | A @Validation@ is either a value of the type @err@ or @a@, similar to 'Either'. However,
-- the 'Applicative' instance for @Validation@ /accumulates/ errors using a 'Semigroup' on @err@.
-- In contrast, the @Applicative@ for @Either@ returns only the first error.
--
-- A consequence of this is that @Validation@ has no 'Data.Functor.Bind.Bind' or 'Control.Monad.Monad' instance. This is because
-- such an instance would violate the law that a Monad's 'Control.Monad.ap' must equal the
-- @Applicative@'s 'Control.Applicative.<*>'
--
-- An example of typical usage can be found <https://github.com/qfpl/validation/blob/master/examples/src/Email.hs here>.
--
data Validation err a =
  Failure err
  | Success a
  deriving (Typeable (Validation err a)
DataType
Constr
Typeable (Validation err a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> Validation err a
    -> c (Validation err a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Validation err a))
-> (Validation err a -> Constr)
-> (Validation err a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Validation err a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Validation err a)))
-> ((forall b. Data b => b -> b)
    -> Validation err a -> Validation err a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Validation err a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Validation err a -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Validation err a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Validation err a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Validation err a -> m (Validation err a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Validation err a -> m (Validation err a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Validation err a -> m (Validation err a))
-> Data (Validation err a)
Validation err a -> DataType
Validation err a -> Constr
(forall b. Data b => b -> b)
-> Validation err a -> Validation err a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Validation err a -> c (Validation err a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Validation err a)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Validation err a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Validation err a -> u
forall u. (forall d. Data d => d -> u) -> Validation err a -> [u]
forall err a. (Data err, Data a) => Typeable (Validation err a)
forall err a. (Data err, Data a) => Validation err a -> DataType
forall err a. (Data err, Data a) => Validation err a -> Constr
forall err a.
(Data err, Data a) =>
(forall b. Data b => b -> b)
-> Validation err a -> Validation err a
forall err a u.
(Data err, Data a) =>
Int -> (forall d. Data d => d -> u) -> Validation err a -> u
forall err a u.
(Data err, Data a) =>
(forall d. Data d => d -> u) -> Validation err a -> [u]
forall err a r r'.
(Data err, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Validation err a -> r
forall err a r r'.
(Data err, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Validation err a -> r
forall err a (m :: * -> *).
(Data err, Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> Validation err a -> m (Validation err a)
forall err a (m :: * -> *).
(Data err, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Validation err a -> m (Validation err a)
forall err a (c :: * -> *).
(Data err, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Validation err a)
forall err a (c :: * -> *).
(Data err, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Validation err a -> c (Validation err a)
forall err a (t :: * -> *) (c :: * -> *).
(Data err, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Validation err a))
forall err a (t :: * -> * -> *) (c :: * -> *).
(Data err, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Validation err a))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Validation err a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Validation err a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Validation err a -> m (Validation err a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Validation err a -> m (Validation err a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Validation err a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Validation err a -> c (Validation err a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Validation err a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Validation err a))
$cSuccess :: Constr
$cFailure :: Constr
$tValidation :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> Validation err a -> m (Validation err a)
$cgmapMo :: forall err a (m :: * -> *).
(Data err, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Validation err a -> m (Validation err a)
gmapMp :: (forall d. Data d => d -> m d)
-> Validation err a -> m (Validation err a)
$cgmapMp :: forall err a (m :: * -> *).
(Data err, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Validation err a -> m (Validation err a)
gmapM :: (forall d. Data d => d -> m d)
-> Validation err a -> m (Validation err a)
$cgmapM :: forall err a (m :: * -> *).
(Data err, Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> Validation err a -> m (Validation err a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Validation err a -> u
$cgmapQi :: forall err a u.
(Data err, Data a) =>
Int -> (forall d. Data d => d -> u) -> Validation err a -> u
gmapQ :: (forall d. Data d => d -> u) -> Validation err a -> [u]
$cgmapQ :: forall err a u.
(Data err, Data a) =>
(forall d. Data d => d -> u) -> Validation err a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Validation err a -> r
$cgmapQr :: forall err a r r'.
(Data err, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Validation err a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Validation err a -> r
$cgmapQl :: forall err a r r'.
(Data err, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Validation err a -> r
gmapT :: (forall b. Data b => b -> b)
-> Validation err a -> Validation err a
$cgmapT :: forall err a.
(Data err, Data a) =>
(forall b. Data b => b -> b)
-> Validation err a -> Validation err a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Validation err a))
$cdataCast2 :: forall err a (t :: * -> * -> *) (c :: * -> *).
(Data err, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Validation err a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Validation err a))
$cdataCast1 :: forall err a (t :: * -> *) (c :: * -> *).
(Data err, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Validation err a))
dataTypeOf :: Validation err a -> DataType
$cdataTypeOf :: forall err a. (Data err, Data a) => Validation err a -> DataType
toConstr :: Validation err a -> Constr
$ctoConstr :: forall err a. (Data err, Data a) => Validation err a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Validation err a)
$cgunfold :: forall err a (c :: * -> *).
(Data err, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Validation err a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Validation err a -> c (Validation err a)
$cgfoldl :: forall err a (c :: * -> *).
(Data err, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Validation err a -> c (Validation err a)
$cp1Data :: forall err a. (Data err, Data a) => Typeable (Validation err a)
Data, Validation err a -> Validation err a -> Bool
(Validation err a -> Validation err a -> Bool)
-> (Validation err a -> Validation err a -> Bool)
-> Eq (Validation err a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall err a.
(Eq err, Eq a) =>
Validation err a -> Validation err a -> Bool
/= :: Validation err a -> Validation err a -> Bool
$c/= :: forall err a.
(Eq err, Eq a) =>
Validation err a -> Validation err a -> Bool
== :: Validation err a -> Validation err a -> Bool
$c== :: forall err a.
(Eq err, Eq a) =>
Validation err a -> Validation err a -> Bool
Eq, (forall x. Validation err a -> Rep (Validation err a) x)
-> (forall x. Rep (Validation err a) x -> Validation err a)
-> Generic (Validation err a)
forall x. Rep (Validation err a) x -> Validation err a
forall x. Validation err a -> Rep (Validation err a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall err a x. Rep (Validation err a) x -> Validation err a
forall err a x. Validation err a -> Rep (Validation err a) x
$cto :: forall err a x. Rep (Validation err a) x -> Validation err a
$cfrom :: forall err a x. Validation err a -> Rep (Validation err a) x
Generic, Eq (Validation err a)
Eq (Validation err a)
-> (Validation err a -> Validation err a -> Ordering)
-> (Validation err a -> Validation err a -> Bool)
-> (Validation err a -> Validation err a -> Bool)
-> (Validation err a -> Validation err a -> Bool)
-> (Validation err a -> Validation err a -> Bool)
-> (Validation err a -> Validation err a -> Validation err a)
-> (Validation err a -> Validation err a -> Validation err a)
-> Ord (Validation err a)
Validation err a -> Validation err a -> Bool
Validation err a -> Validation err a -> Ordering
Validation err a -> Validation err a -> Validation err 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 err a. (Ord err, Ord a) => Eq (Validation err a)
forall err a.
(Ord err, Ord a) =>
Validation err a -> Validation err a -> Bool
forall err a.
(Ord err, Ord a) =>
Validation err a -> Validation err a -> Ordering
forall err a.
(Ord err, Ord a) =>
Validation err a -> Validation err a -> Validation err a
min :: Validation err a -> Validation err a -> Validation err a
$cmin :: forall err a.
(Ord err, Ord a) =>
Validation err a -> Validation err a -> Validation err a
max :: Validation err a -> Validation err a -> Validation err a
$cmax :: forall err a.
(Ord err, Ord a) =>
Validation err a -> Validation err a -> Validation err a
>= :: Validation err a -> Validation err a -> Bool
$c>= :: forall err a.
(Ord err, Ord a) =>
Validation err a -> Validation err a -> Bool
> :: Validation err a -> Validation err a -> Bool
$c> :: forall err a.
(Ord err, Ord a) =>
Validation err a -> Validation err a -> Bool
<= :: Validation err a -> Validation err a -> Bool
$c<= :: forall err a.
(Ord err, Ord a) =>
Validation err a -> Validation err a -> Bool
< :: Validation err a -> Validation err a -> Bool
$c< :: forall err a.
(Ord err, Ord a) =>
Validation err a -> Validation err a -> Bool
compare :: Validation err a -> Validation err a -> Ordering
$ccompare :: forall err a.
(Ord err, Ord a) =>
Validation err a -> Validation err a -> Ordering
$cp1Ord :: forall err a. (Ord err, Ord a) => Eq (Validation err a)
Ord, Int -> Validation err a -> ShowS
[Validation err a] -> ShowS
Validation err a -> String
(Int -> Validation err a -> ShowS)
-> (Validation err a -> String)
-> ([Validation err a] -> ShowS)
-> Show (Validation err a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall err a.
(Show err, Show a) =>
Int -> Validation err a -> ShowS
forall err a. (Show err, Show a) => [Validation err a] -> ShowS
forall err a. (Show err, Show a) => Validation err a -> String
showList :: [Validation err a] -> ShowS
$cshowList :: forall err a. (Show err, Show a) => [Validation err a] -> ShowS
show :: Validation err a -> String
$cshow :: forall err a. (Show err, Show a) => Validation err a -> String
showsPrec :: Int -> Validation err a -> ShowS
$cshowsPrec :: forall err a.
(Show err, Show a) =>
Int -> Validation err a -> ShowS
Show, Typeable)

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

instance Semigroup err => Apply (Validation err) where
  Failure err
e1 <.> :: Validation err (a -> b) -> Validation err a -> Validation err b
<.> Validation err a
b = err -> Validation err b
forall err a. err -> Validation err a
Failure (err -> Validation err b) -> err -> Validation err b
forall a b. (a -> b) -> a -> b
$ case Validation err a
b of
    Failure err
e2 -> err
e1 err -> err -> err
forall a. Semigroup a => a -> a -> a
<> err
e2
    Success a
_ -> err
e1
  Success a -> b
_  <.> Failure err
e2 =
    err -> Validation err b
forall err a. err -> Validation err a
Failure err
e2
  Success a -> b
f  <.> Success a
a  =
    b -> Validation err b
forall err a. a -> Validation err a
Success (a -> b
f a
a)
  {-# INLINE (<.>) #-}

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

-- | For two errors, this instance reports only the last of them.
instance Alt (Validation err) where
  Failure err
_ <!> :: Validation err a -> Validation err a -> Validation err a
<!> Validation err a
x =
    Validation err a
x
  Success a
a <!> Validation err a
_ =
    a -> Validation err a
forall err a. a -> Validation err a
Success a
a
  {-# INLINE (<!>) #-}

instance Foldable (Validation err) where
  foldr :: (a -> b -> b) -> b -> Validation err a -> b
foldr a -> b -> b
f b
x (Success a
a) =
    a -> b -> b
f a
a b
x
  foldr a -> b -> b
_ b
x (Failure err
_) =
    b
x
  {-# INLINE foldr #-}

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

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


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

instance Bitraversable Validation where
  bitraverse :: (a -> f c) -> (b -> f d) -> Validation a b -> f (Validation c d)
bitraverse a -> f c
_ b -> f d
g (Success b
a) =
    d -> Validation c d
forall err a. a -> Validation err 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 a -> f c
f b -> f d
_ (Failure a
e) =
    c -> Validation c d
forall err a. err -> Validation err 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
  {-# INLINE bitraverse #-}

appValidation ::
  (err -> err -> err)
  -> Validation err a
  -> Validation err a
  -> Validation err a
appValidation :: (err -> err -> err)
-> Validation err a -> Validation err a -> Validation err a
appValidation err -> err -> err
m (Failure err
e1) (Failure err
e2) =
  err -> Validation err a
forall err a. err -> Validation err a
Failure (err
e1 err -> err -> err
`m` err
e2)
appValidation err -> err -> err
_ (Failure err
_) (Success a
a2) =
  a -> Validation err a
forall err a. a -> Validation err a
Success a
a2
appValidation err -> err -> err
_ (Success a
a1) (Failure err
_) =
  a -> Validation err a
forall err a. a -> Validation err a
Success a
a1
appValidation err -> err -> err
_ (Success a
a1) (Success a
_) =
  a -> Validation err a
forall err a. a -> Validation err a
Success a
a1
{-# INLINE appValidation #-}

instance Semigroup e => Semigroup (Validation e a) where
  <> :: Validation e a -> Validation e a -> Validation e a
(<>) =
    (e -> e -> e) -> Validation e a -> Validation e a -> Validation e a
forall err a.
(err -> err -> err)
-> Validation err a -> Validation err a -> Validation err a
appValidation e -> e -> e
forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE (<>) #-}

instance Monoid e => Monoid (Validation e a) where
  mappend :: Validation e a -> Validation e a -> Validation e a
mappend =
    (e -> e -> e) -> Validation e a -> Validation e a -> Validation e a
forall err a.
(err -> err -> err)
-> Validation err a -> Validation err a -> Validation err a
appValidation e -> e -> e
forall a. Monoid a => a -> a -> a
mappend
  {-# INLINE mappend #-}
  mempty :: Validation e a
mempty =
    e -> Validation e a
forall err a. err -> Validation err a
Failure e
forall a. Monoid a => a
mempty
  {-# INLINE mempty #-}

#if !MIN_VERSION_lens(4,20,0)
instance Swapped Validation where
  swapped = iso swap swap
  {-# INLINE swapped #-}
#endif

instance Swap Validation where
  swap :: Validation a b -> Validation b a
swap Validation a b
v =
    case Validation a b
v of
      Failure a
e -> a -> Validation b a
forall err a. a -> Validation err a
Success a
e
      Success b
a -> b -> Validation b a
forall err a. err -> Validation err a
Failure b
a
  {-# INLINE swap #-}

instance (NFData e, NFData a) => NFData (Validation e a) where
  rnf :: Validation e a -> ()
rnf Validation e a
v =
    case Validation e a
v of
      Failure e
e -> e -> ()
forall a. NFData a => a -> ()
rnf e
e
      Success a
a -> a -> ()
forall a. NFData a => a -> ()
rnf a
a

-- | 'validate's an @a@ producing an updated optional value, returning
-- @e@ in the empty case.
--
-- This can be thought of as having the less general type:
--
-- @
-- validate :: e -> (a -> Maybe b) -> a -> Validation e b
-- @
validate :: Validate v => e -> (a -> Maybe b) -> a -> v e b
validate :: e -> (a -> Maybe b) -> a -> v e b
validate e
e a -> Maybe b
p a
a = case a -> Maybe b
p a
a of
  Maybe b
Nothing -> Tagged e (Identity e) -> Tagged (v e b) (Identity (v e b))
forall (f :: * -> * -> *) e1 a e2.
Validate f =>
Prism (f e1 a) (f e2 a) e1 e2
_Failure (Tagged e (Identity e) -> Tagged (v e b) (Identity (v e b)))
-> e -> v e b
forall t b. AReview t b -> b -> t
# e
e
  Just b
b  -> Tagged b (Identity b) -> Tagged (v e b) (Identity (v e b))
forall (f :: * -> * -> *) e a b.
Validate f =>
Prism (f e a) (f e b) a b
_Success (Tagged b (Identity b) -> Tagged (v e b) (Identity (v e b)))
-> b -> v e b
forall t b. AReview t b -> b -> t
# b
b

-- | 'validationNel' is 'liftError' specialised to 'NonEmpty' lists, since
-- they are a common semigroup to use.
validationNel :: Either e a -> Validation (NonEmpty e) a
validationNel :: Either e a -> Validation (NonEmpty e) a
validationNel = (e -> NonEmpty e) -> Either e a -> Validation (NonEmpty e) a
forall b e a. (b -> e) -> Either b a -> Validation e a
liftError e -> NonEmpty e
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Converts from 'Either' to 'Validation'.
fromEither :: Either e a -> Validation e a
fromEither :: Either e a -> Validation e a
fromEither = (e -> e) -> Either e a -> Validation e a
forall b e a. (b -> e) -> Either b a -> Validation e a
liftError e -> e
forall a. a -> a
id

-- | 'liftError' is useful for converting an 'Either' to an 'Validation'
-- when the @Left@ of the 'Either' needs to be lifted into a 'Semigroup'.
liftError :: (b -> e) -> Either b a -> Validation e a
liftError :: (b -> e) -> Either b a -> Validation e a
liftError b -> e
f = (b -> Validation e a)
-> (a -> Validation e a) -> Either b a -> Validation e a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> Validation e a
forall err a. err -> Validation err a
Failure (e -> Validation e a) -> (b -> e) -> b -> Validation e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> e
f) a -> Validation e a
forall err a. a -> Validation err a
Success

-- | 'validation' is the catamorphism for @Validation@.
validation :: (e -> c) -> (a -> c) -> Validation e a -> c
validation :: (e -> c) -> (a -> c) -> Validation e a -> c
validation e -> c
ec a -> c
ac = \case
  Failure e
e -> e -> c
ec e
e
  Success a
a -> a -> c
ac a
a

-- | Converts from 'Validation' to 'Either'.
toEither :: Validation e a -> Either e a
toEither :: Validation e a -> Either e a
toEither = (e -> Either e a)
-> (a -> Either e a) -> Validation e a -> Either e a
forall e c a. (e -> c) -> (a -> c) -> Validation e a -> c
validation e -> Either e a
forall a b. a -> Either a b
Left a -> Either e a
forall a b. b -> Either a b
Right

-- | @v 'orElse' a@ returns @a@ when @v@ is Failure, and the @a@ in @Success a@.
--
-- This can be thought of as having the less general type:
--
-- @
-- orElse :: Validation e a -> a -> a
-- @
orElse :: Validate v => v e a -> a -> a
orElse :: v e a -> a -> a
orElse v e a
v a
a = case v e a
v v e a
-> Getting (Validation e a) (v e a) (Validation e a)
-> Validation e a
forall s a. s -> Getting a s a -> a
^. Getting (Validation e a) (v e a) (Validation e a)
forall (f :: * -> * -> *) e a g b.
Validate f =>
Iso (f e a) (f g b) (Validation e a) (Validation g b)
_Validation of
  Failure e
_ -> a
a
  Success a
x -> a
x

-- | Return the @a@ or run the given function over the @e@.
--
-- This can be thought of as having the less general type:
--
-- @
-- valueOr :: (e -> a) -> Validation e a -> a
-- @
valueOr :: Validate v => (e -> a) -> v e a -> a
valueOr :: (e -> a) -> v e a -> a
valueOr e -> a
ea v e a
v = case v e a
v v e a
-> Getting (Validation e a) (v e a) (Validation e a)
-> Validation e a
forall s a. s -> Getting a s a -> a
^. Getting (Validation e a) (v e a) (Validation e a)
forall (f :: * -> * -> *) e a g b.
Validate f =>
Iso (f e a) (f g b) (Validation e a) (Validation g b)
_Validation of
  Failure e
e -> e -> a
ea e
e
  Success a
a -> a
a

-- | 'codiagonal' gets the value out of either side.
codiagonal :: Validation a a -> a
codiagonal :: Validation a a -> a
codiagonal = (a -> a) -> Validation a a -> a
forall (v :: * -> * -> *) e a. Validate v => (e -> a) -> v e a -> a
valueOr a -> a
forall a. a -> a
id

-- | 'ensure' ensures that a validation remains unchanged upon failure,
-- updating a successful validation with an optional value that could fail
-- with @e@ otherwise.
--
-- This can be thought of as having the less general type:
--
-- @
-- ensure :: e -> (a -> Maybe b) -> Validation e a -> Validation e b
-- @
ensure :: Validate v => e -> (a -> Maybe b) -> v e a -> v e b
ensure :: e -> (a -> Maybe b) -> v e a -> v e b
ensure e
e a -> Maybe b
p =
  ASetter (v e a) (v e b) (Validation e a) (Validation e b)
-> (Validation e a -> Validation e b) -> v e a -> v e b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (v e a) (v e b) (Validation e a) (Validation e b)
forall (f :: * -> * -> *) e a g b.
Validate f =>
Iso (f e a) (f g b) (Validation e a) (Validation g b)
_Validation ((Validation e a -> Validation e b) -> v e a -> v e b)
-> (Validation e a -> Validation e b) -> v e a -> v e b
forall a b. (a -> b) -> a -> b
$ \case
    Failure e
x -> e -> Validation e b
forall err a. err -> Validation err a
Failure e
x
    Success a
a -> e -> (a -> Maybe b) -> a -> Validation e b
forall (v :: * -> * -> *) e a b.
Validate v =>
e -> (a -> Maybe b) -> a -> v e b
validate e
e a -> Maybe b
p a
a

-- | Run a function on anything with a Validate instance (usually Either)
-- as if it were a function on Validation
--
-- This can be thought of as having the type
--
-- @(Either e a -> Either e' a') -> Validation e a -> Validation e' a'@
validationed :: Validate v => (v e a -> v e' a') -> Validation e a -> Validation e' a'
validationed :: (v e a -> v e' a') -> Validation e a -> Validation e' a'
validationed = AnIso (v e' a') (v e a) (Validation e' a') (Validation e a)
-> (v e a -> v e' a') -> Validation e a -> Validation e' a'
forall s t a b. AnIso s t a b -> (t -> s) -> b -> a
under AnIso (v e' a') (v e a) (Validation e' a') (Validation e a)
forall (f :: * -> * -> *) e a g b.
Validate f =>
Iso (f e a) (f g b) (Validation e a) (Validation g b)
_Validation

-- | @bindValidation@ binds through a Validation, which is useful for
-- composing Validations sequentially. Note that despite having a bind
-- function of the correct type, Validation is not a monad.
-- The reason is, this bind does not accumulate errors, so it does not
-- agree with the Applicative instance.
--
-- There is nothing wrong with using this function, it just does not make a
-- valid @Monad@ instance.
bindValidation :: Validation e a -> (a -> Validation e b) -> Validation e b
bindValidation :: Validation e a -> (a -> Validation e b) -> Validation e b
bindValidation Validation e a
v a -> Validation e b
f = case Validation e a
v of
  Failure e
e -> e -> Validation e b
forall err a. err -> Validation err a
Failure e
e
  Success a
a -> a -> Validation e b
f a
a

-- | The @Validate@ class carries around witnesses that the type @f@ is isomorphic
-- to Validation, and hence isomorphic to Either.
class Validate f where
  _Validation ::
    Iso (f e a) (f g b) (Validation e a) (Validation g b)

  _Either ::
    Iso (f e a) (f g b) (Either e a) (Either g b)
  _Either = p (Validation e a) (f (Validation g b)) -> p (f e a) (f (f g b))
forall (f :: * -> * -> *) e a g b.
Validate f =>
Iso (f e a) (f g b) (Validation e a) (Validation g b)
_Validation (p (Validation e a) (f (Validation g b)) -> p (f e a) (f (f g b)))
-> (p (Either e a) (f (Either g b))
    -> p (Validation e a) (f (Validation g b)))
-> p (Either e a) (f (Either g b))
-> p (f e a) (f (f g b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
toEither Either g b -> Validation g b
forall e a. Either e a -> Validation e a
fromEither
  {-# INLINE _Either #-}

instance Validate Validation where
  _Validation :: p (Validation e a) (f (Validation g b))
-> p (Validation e a) (f (Validation g b))
_Validation =
    p (Validation e a) (f (Validation g b))
-> p (Validation e a) (f (Validation g b))
forall a. a -> a
id
  {-# INLINE _Validation #-}

instance Validate Either where
  _Validation :: p (Validation e a) (f (Validation g b))
-> p (Either e a) (f (Either g b))
_Validation =
    (Either e a -> Validation e a)
-> (Validation g b -> Either g b)
-> Iso (Either e a) (Either g b) (Validation e a) (Validation g b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
      Either e a -> Validation e a
forall e a. Either e a -> Validation e a
fromEither
      Validation g b -> Either g b
forall e a. Validation e a -> Either e a
toEither
  {-# INLINE _Validation #-}
  _Either :: p (Either e a) (f (Either g b)) -> p (Either e a) (f (Either g b))
_Either =
    p (Either e a) (f (Either g b)) -> p (Either e a) (f (Either g b))
forall a. a -> a
id
  {-# INLINE _Either #-}

-- | This prism generalises 'Control.Lens.Prism._Left'. It targets the failure case of either 'Either' or 'Validation'.
_Failure ::
  Validate f =>
  Prism (f e1 a) (f e2 a) e1 e2
_Failure :: Prism (f e1 a) (f e2 a) e1 e2
_Failure = p (Either e1 a) (f (Either e2 a)) -> p (f e1 a) (f (f e2 a))
forall (f :: * -> * -> *) e a g b.
Validate f =>
Iso (f e a) (f g b) (Either e a) (Either g b)
_Either (p (Either e1 a) (f (Either e2 a)) -> p (f e1 a) (f (f e2 a)))
-> (p e1 (f e2) -> p (Either e1 a) (f (Either e2 a)))
-> p e1 (f e2)
-> p (f e1 a) (f (f e2 a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p e1 (f e2) -> p (Either e1 a) (f (Either e2 a))
forall a c b. Prism (Either a c) (Either b c) a b
_Left
{-# INLINE _Failure #-}

-- | This prism generalises 'Control.Lens.Prism._Right'. It targets the success case of either 'Either' or 'Validation'.
_Success ::
  Validate f =>
  Prism (f e a) (f e b) a b
_Success :: Prism (f e a) (f e b) a b
_Success = p (Either e a) (f (Either e b)) -> p (f e a) (f (f e b))
forall (f :: * -> * -> *) e a g b.
Validate f =>
Iso (f e a) (f g b) (Either e a) (Either g b)
_Either (p (Either e a) (f (Either e b)) -> p (f e a) (f (f e b)))
-> (p a (f b) -> p (Either e a) (f (Either e b)))
-> p a (f b)
-> p (f e a) (f (f e b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f b) -> p (Either e a) (f (Either e b))
forall c a b. Prism (Either c a) (Either c b) a b
_Right
{-# INLINE _Success #-}

-- | 'revalidate' converts between any two instances of 'Validate'.
revalidate :: (Validate f, Validate g) => Iso (f e1 s) (f e2 t) (g e1 s) (g e2 t)
revalidate :: Iso (f e1 s) (f e2 t) (g e1 s) (g e2 t)
revalidate = p (Validation e1 s) (f (Validation e2 t))
-> p (f e1 s) (f (f e2 t))
forall (f :: * -> * -> *) e a g b.
Validate f =>
Iso (f e a) (f g b) (Validation e a) (Validation g b)
_Validation (p (Validation e1 s) (f (Validation e2 t))
 -> p (f e1 s) (f (f e2 t)))
-> (p (g e1 s) (f (g e2 t))
    -> p (Validation e1 s) (f (Validation e2 t)))
-> p (g e1 s) (f (g e2 t))
-> p (f e1 s) (f (f e2 t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso (g e2 t) (g e1 s) (Validation e2 t) (Validation e1 s)
-> Iso (Validation e1 s) (Validation e2 t) (g e1 s) (g e2 t)
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso (g e2 t) (g e1 s) (Validation e2 t) (Validation e1 s)
forall (f :: * -> * -> *) e a g b.
Validate f =>
Iso (f e a) (f g b) (Validation e a) (Validation g b)
_Validation