{- |
Copyright:  (c) 2020-2022 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer:  Kowainik <xrom.xkov@gmail.com>
Stability:   Stable
Portability: Portable

Helpful combinators to work with 'Validation' data type.
-}

module Validation.Combinators
    ( validateAll

      -- * When* functions
    , whenSuccess
    , whenFailure
    , whenSuccess_
    , whenFailure_
    , whenSuccessM
    , whenFailureM
    , whenSuccessM_
    , whenFailureM_

      -- * 'Maybe' conversion
    , failureToMaybe
    , successToMaybe
    , maybeToFailure
    , maybeToSuccess

    ) where

import Data.Foldable (foldl')

import {-# SOURCE #-} Validation (Validation (..), validation)


{- | Validate all given checks in a 'Foldable'. Returns the 'Success' of the
start element when all checks are successful.


A basic example of usage could look like this:

@
> __let__ validatePassword = 'validateAll'
        [ validateEmptyPassword
        , validateShortPassword
        ]

> 'validateAll' \"VeryStrongPassword\"
'Success' \"VeryStrongPassword\"

> 'validateAll' ""
'Failure' (EmptyPassword :| [ShortPassword])
@
-}
validateAll
    :: forall e b a f
    .  (Foldable f, Semigroup e)
    => f (a -> Validation e b)
    -> a
    -> Validation e a
validateAll :: f (a -> Validation e b) -> a -> Validation e a
validateAll f (a -> Validation e b)
fs a
a = (Validation e a -> (a -> Validation e b) -> Validation e a)
-> Validation e a -> f (a -> Validation e b) -> Validation e a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Validation e a
res a -> Validation e b
f -> Validation e a
res Validation e a -> Validation e b -> Validation e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* a -> Validation e b
f a
a) (a -> Validation e a
forall e a. a -> Validation e a
Success a
a) f (a -> Validation e b)
fs
{-# INLINE validateAll #-}

{- | Applies the given action to 'Validation' if it is 'Failure' and returns the
result. In case of 'Success' the default value is returned.

>>> whenFailure "bar" (Failure 42) (\a -> "foo" <$ print a)
42
"foo"

>>> whenFailure "bar" (Success 42) (\a -> "foo" <$ print a)
"bar"
-}
whenFailure :: Applicative f => x -> Validation e a -> (e -> f x) -> f x
whenFailure :: x -> Validation e a -> (e -> f x) -> f x
whenFailure x
_ (Failure e
e) e -> f x
f = e -> f x
f e
e
whenFailure x
a (Success a
_) e -> f x
_ = x -> f x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
a
{-# INLINE whenFailure #-}

{- | Applies given action to the 'Validation' content if it is 'Failure'.

Similar to 'whenFailure' but the default value is @()@.

>>> whenFailure_ (Success 42) putStrLn
>>> whenFailure_ (Failure "foo") putStrLn
foo
-}
whenFailure_ :: Applicative f => Validation e a -> (e -> f ()) -> f ()
whenFailure_ :: Validation e a -> (e -> f ()) -> f ()
whenFailure_ = () -> Validation e a -> (e -> f ()) -> f ()
forall (f :: * -> *) x e a.
Applicative f =>
x -> Validation e a -> (e -> f x) -> f x
whenFailure ()
{-# INLINE whenFailure_ #-}

{- | Monadic version of 'whenFailure'.
Applies monadic action to the given 'Validation' in case of 'Failure'.
Returns the resulting value, or provided default.

>>> whenFailureM "bar" (pure $ Failure 42) (\a -> "foo" <$ print a)
42
"foo"

>>> whenFailureM "bar" (pure $ Success 42) (\a -> "foo" <$ print a)
"bar"
-}
whenFailureM :: Monad m => x -> m (Validation e a) -> (e -> m x) -> m x
whenFailureM :: x -> m (Validation e a) -> (e -> m x) -> m x
whenFailureM x
x m (Validation e a)
mv e -> m x
f = m (Validation e a)
mv m (Validation e a) -> (Validation e a -> m x) -> m x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Validation e a
v -> x -> Validation e a -> (e -> m x) -> m x
forall (f :: * -> *) x e a.
Applicative f =>
x -> Validation e a -> (e -> f x) -> f x
whenFailure x
x Validation e a
v e -> m x
f
{-# INLINE whenFailureM #-}

{- | Monadic version of 'whenFailure_'.
Applies monadic action to the given 'Validation' in case of 'Failure'.
Similar to 'whenFailureM' but the default is @()@.

>>> whenFailureM_ (pure $ Success 42) putStrLn
>>> whenFailureM_ (pure $ Failure "foo") putStrLn
foo
-}
whenFailureM_ :: Monad m => m (Validation e a) -> (e -> m ()) -> m ()
whenFailureM_ :: m (Validation e a) -> (e -> m ()) -> m ()
whenFailureM_ m (Validation e a)
mv e -> m ()
f = m (Validation e a)
mv m (Validation e a) -> (Validation e a -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Validation e a
v -> Validation e a -> (e -> m ()) -> m ()
forall (f :: * -> *) e a.
Applicative f =>
Validation e a -> (e -> f ()) -> f ()
whenFailure_ Validation e a
v e -> m ()
f
{-# INLINE whenFailureM_ #-}

{- | Applies the given action to 'Validation' if it is 'Success' and returns the
result. In case of 'Failure' the default value is returned.

>>> whenSuccess "bar" (Failure "foo") (\a -> "success!" <$ print a)
"bar"

>>> whenSuccess "bar" (Success 42) (\a -> "success!" <$ print a)
42
"success!"
-}
whenSuccess :: Applicative f => x -> Validation e a -> (a -> f x) -> f x
whenSuccess :: x -> Validation e a -> (a -> f x) -> f x
whenSuccess x
x (Failure  e
_) a -> f x
_ = x -> f x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x
whenSuccess x
_ (Success a
a) a -> f x
f  = a -> f x
f a
a
{-# INLINE whenSuccess #-}

{- | Applies given action to the 'Validation' content if it is 'Success'.

Similar to 'whenSuccess' but the default value is @()@.

>>> whenSuccess_ (Failure "foo") print
>>> whenSuccess_ (Success 42) print
42
-}
whenSuccess_ :: Applicative f => Validation e a -> (a -> f ()) -> f ()
whenSuccess_ :: Validation e a -> (a -> f ()) -> f ()
whenSuccess_ = () -> Validation e a -> (a -> f ()) -> f ()
forall (f :: * -> *) x e a.
Applicative f =>
x -> Validation e a -> (a -> f x) -> f x
whenSuccess ()
{-# INLINE whenSuccess_ #-}

{- | Monadic version of 'whenSuccess'.
Applies monadic action to the given 'Validation' in case of 'Success'.
Returns the resulting value, or provided default.

>>> whenSuccessM "bar" (pure $ Failure "foo") (\a -> "success!" <$ print a)
"bar"

>>> whenSuccessM "bar" (pure $ Success 42) (\a -> "success!" <$ print a)
42
"success!"
-}
whenSuccessM :: Monad m => x -> m (Validation e a) -> (a -> m x) -> m x
whenSuccessM :: x -> m (Validation e a) -> (a -> m x) -> m x
whenSuccessM x
x m (Validation e a)
mv a -> m x
f = m (Validation e a)
mv m (Validation e a) -> (Validation e a -> m x) -> m x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Validation e a
v -> x -> Validation e a -> (a -> m x) -> m x
forall (f :: * -> *) x e a.
Applicative f =>
x -> Validation e a -> (a -> f x) -> f x
whenSuccess x
x Validation e a
v a -> m x
f
{-# INLINE whenSuccessM #-}

{- | Monadic version of 'whenSuccess_'.
Applies monadic action to the given 'Validation' in case of 'Success'.
Similar to 'whenSuccessM' but the default is @()@.

>>> whenSuccessM_ (pure $ Failure "foo") print
>>> whenSuccessM_ (pure $ Success 42) print
42
-}
whenSuccessM_ :: Monad m => m (Validation e a) -> (a -> m ()) -> m ()
whenSuccessM_ :: m (Validation e a) -> (a -> m ()) -> m ()
whenSuccessM_ m (Validation e a)
mv a -> m ()
f = m (Validation e a)
mv m (Validation e a) -> (Validation e a -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Validation e a
v -> Validation e a -> (a -> m ()) -> m ()
forall (f :: * -> *) e a.
Applicative f =>
Validation e a -> (a -> f ()) -> f ()
whenSuccess_ Validation e a
v a -> m ()
f
{-# INLINE whenSuccessM_ #-}


{- | Maps 'Failure' of 'Validation' to 'Just'.

>>> failureToMaybe (Failure True)
Just True
>>> failureToMaybe (Success "aba")
Nothing
-}
failureToMaybe :: Validation e a -> Maybe e
failureToMaybe :: Validation e a -> Maybe e
failureToMaybe = (e -> Maybe e) -> (a -> Maybe e) -> Validation e a -> Maybe e
forall e x a. (e -> x) -> (a -> x) -> Validation e a -> x
validation e -> Maybe e
forall a. a -> Maybe a
Just (Maybe e -> a -> Maybe e
forall a b. a -> b -> a
const Maybe e
forall a. Maybe a
Nothing)
{-# INLINE failureToMaybe #-}

{- | Maps 'Success' of 'Validation' to 'Just'.

>>> successToMaybe (Failure True)
Nothing
>>> successToMaybe (Success "aba")
Just "aba"
-}
successToMaybe :: Validation e a -> Maybe a
successToMaybe :: Validation e a -> Maybe a
successToMaybe = (e -> Maybe a) -> (a -> Maybe a) -> Validation e a -> Maybe a
forall e x a. (e -> x) -> (a -> x) -> Validation e a -> x
validation (Maybe a -> e -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just
{-# INLINE successToMaybe #-}

{- | Maps 'Just' to 'Failure' In case of 'Nothing' it wraps the given default
value into 'Success'.

>>> maybeToFailure True (Just "aba")
Failure "aba"
>>> maybeToFailure True Nothing
Success True
-}
maybeToFailure :: a -> Maybe e -> Validation e a
maybeToFailure :: a -> Maybe e -> Validation e a
maybeToFailure a
a = Validation e a
-> (e -> Validation e a) -> Maybe e -> Validation e a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> Validation e a
forall e a. a -> Validation e a
Success a
a) e -> Validation e a
forall e a. e -> Validation e a
Failure
{-# INLINE maybeToFailure #-}

{- | Maps 'Just' to 'Success'. In case of 'Nothing' it wraps the given default
value into 'Failure'

>>> maybeToSuccess True (Just "aba")
Success "aba"
>>> maybeToSuccess True Nothing
Failure True
-}
maybeToSuccess :: e -> Maybe a -> Validation e a
maybeToSuccess :: e -> Maybe a -> Validation e a
maybeToSuccess e
e = Validation e a
-> (a -> Validation e a) -> Maybe a -> Validation e a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> Validation e a
forall e a. e -> Validation e a
Failure e
e) a -> Validation e a
forall e a. a -> Validation e a
Success
{-# INLINE maybeToSuccess #-}