{-# LANGUAGE Safe #-}

module Valida.ValidationUtils
    ( -- * Transformations between 'Either' and 'Validation'

      fromEither
    , toEither
      -- * Utilities for working with 'Validation'

    , validation
    , validationConst
    , fromSuccess
    , fromFailure
    , isSuccess
    , isFailure
    , successes
    , failures
    , partitionValidations
    ) where

import Valida.Validation (Validation (..), validation, validationConst)

{- | Convert a 'Validation' to an 'Either'.

Given, __Validation a b__-

  * __Failure a__ is converted to __Left a__.
  * __Success b__ is converted to __Right b__.

==== __Examples__

>>> toEither (Success 'c' :: Validation String Char)
Right 'c'
>>> toEither (Failure 42 :: Validation Int Char)
Left 42
-}
toEither :: Validation a b -> Either a b
toEither :: Validation a b -> Either a b
toEither = (a -> Either a b)
-> (b -> Either a b) -> Validation a b -> Either a b
forall e c a. (e -> c) -> (a -> c) -> Validation e a -> c
validation a -> Either a b
forall a b. a -> Either a b
Left b -> Either a b
forall a b. b -> Either a b
Right

{- | Convert a 'Either' to an 'Validation'.

Given, __Either e a__-

  * __Left e__ is converted to __Failure e__.
  * __Right a__ is converted to __Success a__.

==== __Examples__

>>> fromEither (Right 'c' :: Either String Char)
Success 'c'
>>> fromEither (Left 42 :: Either Int Char)
Failure 42
-}
fromEither :: Either e a -> Validation e a
fromEither :: Either e a -> Validation e a
fromEither = (e -> Validation e a)
-> (a -> Validation e a) -> Either e a -> Validation e a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Validation e a
forall e a. e -> Validation e a
Failure a -> Validation e a
forall e a. a -> Validation e a
Success

-- | Return True if the given value is a 'Failure'-value, False otherwise.

isFailure :: Validation e a -> Bool
isFailure :: Validation e a -> Bool
isFailure (Failure e
_) = Bool
True
isFailure Validation e a
_           = Bool
False

-- | Return True if the given value is a 'Success'-value, False otherwise.

isSuccess :: Validation e a -> Bool
isSuccess :: Validation e a -> Bool
isSuccess (Success a
_) = Bool
True
isSuccess Validation e a
_           = Bool
False

{- | Return the contents of a 'Failure'-value or a default value otherwise.

==== __Examples__

>>> fromFailure 0 (Success 48 :: Validation Int Int)
0
>>> fromFailure 0 (Failure 27 :: Validation Int Int)
27
-}
fromFailure :: e -> Validation e a -> e
fromFailure :: e -> Validation e a -> e
fromFailure e
_ (Failure e
e) = e
e
fromFailure e
e Validation e a
_           = e
e

{- | Return the contents of a 'Success'-value or a default value otherwise.

==== __Examples__

>>> fromSuccess 0 (Success 48 :: Validation Int Int)
48
>>> fromSuccess 0 (Failure 27 :: Validation Int Int)
0
-}
fromSuccess :: a -> Validation e a -> a
fromSuccess :: a -> Validation e a -> a
fromSuccess a
_ (Success a
a) = a
a
fromSuccess a
a Validation e a
_           = a
a

{- | Extracts from a list of 'Validation' all the 'Failure' values, in order.

==== __Examples__

>>> failures [Success 48, Failure "err1", Failure "err2", Success 2, Failure "err3"]
["err1","err2","err3"]
>>> failures ([Success 1, Success 2, Success 3] :: [Validation String Int])
[]
-}
failures :: [Validation e a] -> [e]
failures :: [Validation e a] -> [e]
failures [Validation e a]
xs = [e
e | Failure e
e <- [Validation e a]
xs]
{-# INLINABLE failures #-}

{- | Extracts from a list of 'Validation' all the Success elements, in order.

==== __Examples__

>>> successes [Success 1, Failure "err1", Failure "err2", Success 2, Failure "err3"]
[1,2]
>>> successes ([Failure "err1", Failure "err2", Failure "err3"] :: [Validation String Int])
[]
-}
successes :: [Validation e a] -> [a]
successes :: [Validation e a] -> [a]
successes [Validation e a]
xs = [a
a | Success a
a <- [Validation e a]
xs]
{-# INLINABLE successes #-}

{- | Partitions a list of Either into two lists.

All the Left elements are extracted, in order, to the first component of the output.
Similarly the Right elements are extracted to the second component of the output.

@partitionValidations xs = ('failures' xs, 'successes' xs)@

==== __Examples__

>>> partitionValidations [Success 1, Failure "err1", Failure "err2", Success 2, Failure "err3"]
(["err1","err2","err3"],[1,2])
-}
partitionValidations :: [Validation e a] -> ([e], [a])
partitionValidations :: [Validation e a] -> ([e], [a])
partitionValidations = (Validation e a -> ([e], [a]) -> ([e], [a]))
-> ([e], [a]) -> [Validation e a] -> ([e], [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((e -> ([e], [a]) -> ([e], [a]))
-> (a -> ([e], [a]) -> ([e], [a]))
-> Validation e a
-> ([e], [a])
-> ([e], [a])
forall e c a. (e -> c) -> (a -> c) -> Validation e a -> c
validation e -> ([e], [a]) -> ([e], [a])
forall a b. a -> ([a], b) -> ([a], b)
failure a -> ([e], [a]) -> ([e], [a])
forall a a. a -> (a, [a]) -> (a, [a])
success) ([],[])
  where
    failure :: a -> ([a], b) -> ([a], b)
failure a
a ~([a]
l, b
r) = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
l, b
r)
    success :: a -> (a, [a]) -> (a, [a])
success a
a ~(a
l, [a]
r) = (a
l, a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r)