{-# LANGUAGE Safe #-}

{- |
Module      : Valida.Combinators
Description : Combinators and utilities for building and combining 'Validator's
Copyright   : (c) TotallyNotChase, 2021
License     : MIT
Maintainer  : totallynotchase42@gmail.com
Stability   : Stable
Portability : Portable

This module is re-exported by "Valida". You probably don't need to import this.

This module exports the primitive, as well as utility, 'Validator' combinators.
As well as the 'orElse', 'andAlso', 'satisfyAny', and 'satisfyAll' functions, and some more utilities.

__Note__: All the primitive combinators and derivative combinators use the same type for @inp@ and @a@.
In those cases - upon successful validation, the input itself, wrapped in 'Success', is returned.
-}

module Valida.Combinators
    ( -- * Primitive 'NonEmpty' combinators

      failureIf
    , failureUnless
      -- * Primitive /Unit/ combinators

    , failureIf'
    , failureUnless'
      -- * Negating 'Validator'

    , negateV
    , negateV'
      -- * Combining 'Validator's

    , andAlso
    , orElse
      --

    , failV
    , satisfyAll
    , satisfyAny
    , (</>)
      -- * Common derivates of primitive 'NonEmpty' combinators

    , atleastContains
    , lengthAbove
    , lengthBelow
    , lengthWithin
    , maxLengthOf
    , maxValueOf
    , minLengthOf
    , minValueOf
    , mustBe
    , mustContain
    , notEmpty
    , ofLength
    , onlyContains
    , valueAbove
    , valueBelow
    , valueWithin
      -- * Common derivates of primitive /Unit/ combinators

    , atleastContains'
    , lengthAbove'
    , lengthBelow'
    , lengthWithin'
    , maxLengthOf'
    , maxValueOf'
    , minLengthOf'
    , minValueOf'
    , mustBe'
    , mustContain'
    , notEmpty'
    , ofLength'
    , onlyContains'
    , valueAbove'
    , valueBelow'
    , valueWithin'
      -- * Optional 'Validator's

    , optionally
    , withDefault
    ) where

import Data.Ix            (Ix (inRange))
import Data.List.NonEmpty (NonEmpty)

import Valida.Utils      (neSingleton)
import Valida.Validation (Validation (..), validationConst)
import Valida.Validator  (Validator (Validator))

---------------------------------------------------------------------

-- Primitive 'NonEmpty' combinators

---------------------------------------------------------------------


{- | Build a rule that /fails/ with given error __if the given predicate succeeds__.

@failureIf predc = 'failureUnless' ('not' . predc)@

==== __Examples__

>>> runValidator (failureIf (>0) "Positive") 5
Failure ("Positive" :| [])
>>> runValidator (failureIf (>0) "Positive") 0
Success 0
>>> runValidator (failureIf (>0) "Positive") (-1)
Success (-1)
-}
failureIf :: (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureIf :: (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureIf a -> Bool
predc = (a -> Bool) -> NonEmpty e -> Validator (NonEmpty e) a a
forall a e. (a -> Bool) -> e -> Validator e a a
validatorFrom (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
predc) (NonEmpty e -> Validator (NonEmpty e) a a)
-> (e -> NonEmpty e) -> e -> Validator (NonEmpty e) a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> NonEmpty e
forall a. a -> NonEmpty a
neSingleton

{- | Build a rule that /fails/ with given error __unless the given predicate succeeds__.

@failureUnless predc = 'failureIf' ('not' . predc)@

==== __Examples__

>>> runValidator (failureUnless (>0) "NonPositive") 5
Success 5
>>> runValidator (failureUnless (>0) "NonPositive") 0
Failure ("NonPositive" :| [])
>>> runValidator (failureUnless (>0) "NonPositive") (-1)
Failure ("NonPositive" :| [])
-}
failureUnless :: (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless :: (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless a -> Bool
predc = (a -> Bool) -> NonEmpty e -> Validator (NonEmpty e) a a
forall a e. (a -> Bool) -> e -> Validator e a a
validatorFrom a -> Bool
predc (NonEmpty e -> Validator (NonEmpty e) a a)
-> (e -> NonEmpty e) -> e -> Validator (NonEmpty e) a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> NonEmpty e
forall a. a -> NonEmpty a
neSingleton

---------------------------------------------------------------------

-- Primitive /Unit/ combinators

---------------------------------------------------------------------


{- | Like 'failureIf' but uses /Unit/ as the 'Validator' error type.

@failureIf' predc = 'failureUnless'' ('not' . predc)@

@label ('const' (err :| [])) (failureIf' predc) = 'failureIf' predc err@

==== __Examples__

>>> runValidator (failureIf' (>0)) 5
Failure ()
>>> runValidator (failureIf' (>0)) 0
Success 0
>>> runValidator (failureIf' (>0)) (-1)
Success (-1)
-}
failureIf' :: (a -> Bool) -> Validator () a a
failureIf' :: (a -> Bool) -> Validator () a a
failureIf' a -> Bool
predc = (a -> Bool) -> () -> Validator () a a
forall a e. (a -> Bool) -> e -> Validator e a a
validatorFrom (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
predc) ()

{- | Like 'failureUnless' but uses /Unit/ as the 'Validator' error type.

@failureUnless' predc = 'failureIf'' ('not' . predc)@

@label ('const' (err :| [])) (failureUnless' predc) = 'failureUnless' predc err@

==== __Examples__

>>> runValidator (failureUnless' (>0)) 5
Success 5
>>> runValidator (failureUnless' (>0)) 0
Failure ()
>>> runValidator (failureUnless' (>0)) (-1)
Failure ()
-}
failureUnless' :: (a -> Bool) -> Validator () a a
failureUnless' :: (a -> Bool) -> Validator () a a
failureUnless' = ((a -> Bool) -> () -> Validator () a a)
-> () -> (a -> Bool) -> Validator () a a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Bool) -> () -> Validator () a a
forall a e. (a -> Bool) -> e -> Validator e a a
validatorFrom ()

---------------------------------------------------------------------

-- Common derivates of primitive 'NonEmpty' combinators

---------------------------------------------------------------------


{- | Build an equality rule for value.

@mustBe x = 'failureUnless' (==x)@
-}
mustBe :: Eq a => a -> e -> Validator (NonEmpty e) a a
mustBe :: a -> e -> Validator (NonEmpty e) a a
mustBe a
x = (a -> Bool) -> e -> Validator (NonEmpty e) a a
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x)
{-# INLINABLE mustBe #-}

{- | Build an equality rule for length.

@ofLength x = 'failureUnless' ((==x) . 'length')@
-}
ofLength :: Foldable t => Int -> e -> Validator (NonEmpty e) (t a) (t a)
ofLength :: Int -> e -> Validator (NonEmpty e) (t a) (t a)
ofLength Int
n = (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless ((t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a))
-> (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
n) (Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
{-# INLINABLE ofLength #-}
{-# SPECIALIZE ofLength :: Int -> e -> Validator (NonEmpty e) [a] [a] #-}

{- | Build a minimum length (inclusive) rule.

@minLengthOf x = 'failureUnless' ((>=n) . 'length')@
-}
minLengthOf :: Foldable t => Int -> e -> Validator (NonEmpty e) (t a) (t a)
minLengthOf :: Int -> e -> Validator (NonEmpty e) (t a) (t a)
minLengthOf Int
n = (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless ((t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a))
-> (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
n) (Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
{-# INLINABLE minLengthOf #-}
{-# SPECIALIZE minLengthOf :: Int -> e -> Validator (NonEmpty e) [a] [a] #-}

{- | Build a maximum length (inclusive) rule.

@maxLengthOf n = 'failureUnless' ((<=n) . 'length')@
-}
maxLengthOf :: Foldable t => Int -> e -> Validator (NonEmpty e) (t a) (t a)
maxLengthOf :: Int -> e -> Validator (NonEmpty e) (t a) (t a)
maxLengthOf Int
n = (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless ((t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a))
-> (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
n) (Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
{-# INLINABLE maxLengthOf #-}
{-# SPECIALIZE maxLengthOf :: Int -> e -> Validator (NonEmpty e) [a] [a] #-}

{- | Build a minimum length (inclusive) rule.

@lengthAbove x = 'minLengthOf' (x + 1)@

@lengthAbove x = 'failureUnless' ((>n) . 'length')@
-}
lengthAbove :: Foldable t => Int -> e -> Validator (NonEmpty e) (t a) (t a)
lengthAbove :: Int -> e -> Validator (NonEmpty e) (t a) (t a)
lengthAbove Int
n = (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless ((t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a))
-> (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
n) (Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
{-# INLINABLE lengthAbove #-}
{-# SPECIALIZE lengthAbove :: Int -> e -> Validator (NonEmpty e) [a] [a] #-}

{- | Build a maximum length (inclusive) rule.

@lengthBelow x = 'maxLengthOf' (x - 1)@

@lengthBelow x = 'failureUnless' ((<n) . 'length')@
-}
lengthBelow :: Foldable t => Int -> e -> Validator (NonEmpty e) (t a) (t a)
lengthBelow :: Int -> e -> Validator (NonEmpty e) (t a) (t a)
lengthBelow Int
n = (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless ((t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a))
-> (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
n) (Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
{-# INLINABLE lengthBelow #-}
{-# SPECIALIZE lengthBelow :: Int -> e -> Validator (NonEmpty e) [a] [a] #-}

{- | Build a maximum length rule.

@notEmpty = 'minLengthOf' 1@

@notEmpty = 'failureIf' 'null'@
-}
notEmpty :: Foldable t => e -> Validator (NonEmpty e) (t a) (t a)
notEmpty :: e -> Validator (NonEmpty e) (t a) (t a)
notEmpty = (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureIf t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
{-# INLINABLE notEmpty #-}
{-# SPECIALIZE notEmpty :: e -> Validator (NonEmpty e) [a] [a] #-}

{- | Build an 'inRange' rule for length.

@lengthWithin (min, max) = 'minLengthOf' min `'andAlso'` 'maxLengthOf' max@

@lengthWithin r = 'failureUnless' ('inRange' r . 'length')@
-}
lengthWithin :: Foldable t => (Int, Int) -> e -> Validator (NonEmpty e) (t a) (t a)
lengthWithin :: (Int, Int) -> e -> Validator (NonEmpty e) (t a) (t a)
lengthWithin (Int, Int)
r = (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless ((t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a))
-> (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int, Int)
r (Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
{-# INLINABLE lengthWithin #-}
{-# SPECIALIZE lengthWithin :: (Int, Int) -> e -> Validator (NonEmpty e) [a] [a] #-}

{- | Build a minimum value (inclusive) rule.

@minValueOf x = 'failureUnless' (>=x)@
-}
minValueOf :: Ord a => a -> e -> Validator (NonEmpty e) a a
minValueOf :: a -> e -> Validator (NonEmpty e) a a
minValueOf a
x = (a -> Bool) -> e -> Validator (NonEmpty e) a a
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
x)
{-# INLINABLE minValueOf #-}

{- | Build a maximum value (inclusive) rule.

@maxValueOf x = 'failureUnless' (<=x)@
-}
maxValueOf :: Ord a => a -> e -> Validator (NonEmpty e) a a
maxValueOf :: a -> e -> Validator (NonEmpty e) a a
maxValueOf a
x = (a -> Bool) -> e -> Validator (NonEmpty e) a a
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=a
x)
{-# INLINABLE maxValueOf #-}

{- | Build a minimum value (exclusive) rule.

@valueAbove x = 'minValueOf' (x + 1)@

@valueAbove x = 'failureUnless' (>x)@
-}
valueAbove :: Ord a => a -> e -> Validator (NonEmpty e) a a
valueAbove :: a -> e -> Validator (NonEmpty e) a a
valueAbove a
n = (a -> Bool) -> e -> Validator (NonEmpty e) a a
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
n)
{-# INLINABLE valueAbove #-}

{- | Build a maximum value (exclusive) rule.

@valueBelow x = 'minValueOf' (x - 1)@

@valueBelow x = 'failureUnless' (<x)@
-}
valueBelow :: Ord a => a -> e -> Validator (NonEmpty e) a a
valueBelow :: a -> e -> Validator (NonEmpty e) a a
valueBelow a
n = (a -> Bool) -> e -> Validator (NonEmpty e) a a
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
n)
{-# INLINABLE valueBelow #-}

{- | Build an 'inRange' rule for value.

@valueWithin (m, n) = 'minValueOf' m `'andAlso'` 'maxValueOf' n@

@valueWithin (m, n) = 'failureUnless' (\x -> m <= x && x <= n)@
-}
valueWithin :: Ord a => (a, a) -> e -> Validator (NonEmpty e) a a
valueWithin :: (a, a) -> e -> Validator (NonEmpty e) a a
valueWithin (a
m, a
n) = (a -> Bool) -> e -> Validator (NonEmpty e) a a
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless ((a -> Bool) -> e -> Validator (NonEmpty e) a a)
-> (a -> Bool) -> e -> Validator (NonEmpty e) a a
forall a b. (a -> b) -> a -> b
$ \a
x -> a
m a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
n
{-# INLINABLE valueWithin #-}
{-# SPECIALIZE valueWithin :: (Int, Int) -> e -> Validator (NonEmpty e) Int Int #-}

{- | Build an 'all' rule.

@onlyContains x = 'failureUnless' ('all' x)@
-}
onlyContains :: Foldable t => (a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
onlyContains :: (a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
onlyContains a -> Bool
x = (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless ((t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a))
-> (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all a -> Bool
x
{-# INLINABLE onlyContains #-}
{-# SPECIALIZE onlyContains :: (a -> Bool) -> e -> Validator (NonEmpty e) [a] [a] #-}

{- | Build an 'any' rule.

@atleastContains x = 'failureUnless' ('any' x)@
-}
atleastContains :: Foldable t => (a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
atleastContains :: (a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
atleastContains a -> Bool
x = (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless ((t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a))
-> (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any a -> Bool
x
{-# INLINABLE atleastContains #-}
{-# SPECIALIZE atleastContains :: (a -> Bool) -> e -> Validator (NonEmpty e) [a] [a] #-}

{- | Build an 'elem' rule.

@mustContain x = 'atleastContains' (==x)@

@mustContain x = 'failureUnless' ('elem' x)@
-}
mustContain :: (Foldable t, Eq a) => a -> e -> Validator (NonEmpty e) (t a) (t a)
mustContain :: a -> e -> Validator (NonEmpty e) (t a) (t a)
mustContain a
x = (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a e. (a -> Bool) -> e -> Validator (NonEmpty e) a a
failureUnless ((t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a))
-> (t a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
forall a b. (a -> b) -> a -> b
$ a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x
{-# INLINABLE mustContain #-}
{-# SPECIALIZE mustContain :: Eq a => a -> e -> Validator (NonEmpty e) [a] [a] #-}

---------------------------------------------------------------------

-- Common derivates of primitive /Unit/ combinators

---------------------------------------------------------------------


-- | Like 'mustBe' but uses /Unit/ as the 'Validator' error type.

mustBe' :: Eq a => a -> Validator () a a
mustBe' :: a -> Validator () a a
mustBe' a
x = (a -> Bool) -> Validator () a a
forall a. (a -> Bool) -> Validator () a a
failureUnless' (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x)
{-# INLINABLE mustBe' #-}

-- | Like 'ofLength' but uses /Unit/ as the 'Validator' error type.

ofLength' :: Foldable t => Int -> Validator () (t a) (t a)
ofLength' :: Int -> Validator () (t a) (t a)
ofLength' Int
n = (t a -> Bool) -> Validator () (t a) (t a)
forall a. (a -> Bool) -> Validator () a a
failureUnless' ((t a -> Bool) -> Validator () (t a) (t a))
-> (t a -> Bool) -> Validator () (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
n) (Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
{-# INLINABLE ofLength' #-}
{-# SPECIALIZE ofLength' :: Int -> Validator () [a] [a] #-}

-- | Like 'minLengthOf' but uses /Unit/ as the 'Validator' error type.

minLengthOf' :: Foldable t => Int -> Validator () (t a) (t a)
minLengthOf' :: Int -> Validator () (t a) (t a)
minLengthOf' Int
n = (t a -> Bool) -> Validator () (t a) (t a)
forall a. (a -> Bool) -> Validator () a a
failureUnless' ((t a -> Bool) -> Validator () (t a) (t a))
-> (t a -> Bool) -> Validator () (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
n) (Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
{-# INLINABLE minLengthOf' #-}
{-# SPECIALIZE minLengthOf' :: Int -> Validator () [a] [a] #-}

-- | Like 'maxLengthOf' but uses /Unit/ as the 'Validator' error type.

maxLengthOf' :: Foldable t => Int -> Validator () (t a) (t a)
maxLengthOf' :: Int -> Validator () (t a) (t a)
maxLengthOf' Int
n = (t a -> Bool) -> Validator () (t a) (t a)
forall a. (a -> Bool) -> Validator () a a
failureUnless' ((t a -> Bool) -> Validator () (t a) (t a))
-> (t a -> Bool) -> Validator () (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
n) (Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
{-# INLINABLE maxLengthOf' #-}
{-# SPECIALIZE maxLengthOf' :: Int -> Validator () [a] [a] #-}

-- | Like 'lengthAbove' but uses /Unit/ as the 'Validator' error type.

lengthAbove' :: Foldable t => Int -> Validator () (t a) (t a)
lengthAbove' :: Int -> Validator () (t a) (t a)
lengthAbove' Int
n = (t a -> Bool) -> Validator () (t a) (t a)
forall a. (a -> Bool) -> Validator () a a
failureUnless' ((t a -> Bool) -> Validator () (t a) (t a))
-> (t a -> Bool) -> Validator () (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
n) (Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
{-# INLINABLE lengthAbove' #-}
{-# SPECIALIZE lengthAbove' :: Int -> Validator () [a] [a] #-}

-- | Like 'lengthBelow' but uses /Unit/ as the 'Validator' error type.

lengthBelow' :: Foldable t => Int -> Validator () (t a) (t a)
lengthBelow' :: Int -> Validator () (t a) (t a)
lengthBelow' Int
n = (t a -> Bool) -> Validator () (t a) (t a)
forall a. (a -> Bool) -> Validator () a a
failureUnless' ((t a -> Bool) -> Validator () (t a) (t a))
-> (t a -> Bool) -> Validator () (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
n) (Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
{-# INLINABLE lengthBelow' #-}
{-# SPECIALIZE lengthBelow' :: Int -> Validator () [a] [a] #-}

-- | Like 'notEmpty' but uses /Unit/ as the 'Validator' error type.

notEmpty' :: Foldable t => Validator () (t a) (t a)
notEmpty' :: Validator () (t a) (t a)
notEmpty' = (t a -> Bool) -> Validator () (t a) (t a)
forall a. (a -> Bool) -> Validator () a a
failureIf' t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
{-# INLINABLE notEmpty' #-}
{-# SPECIALIZE notEmpty' :: Validator () [a] [a] #-}

-- | Like 'lengthWithin' but uses /Unit/ as the 'Validator' error type.

lengthWithin' :: Foldable t => (Int, Int) -> Validator () (t a) (t a)
lengthWithin' :: (Int, Int) -> Validator () (t a) (t a)
lengthWithin' (Int, Int)
r = (t a -> Bool) -> Validator () (t a) (t a)
forall a. (a -> Bool) -> Validator () a a
failureUnless' ((t a -> Bool) -> Validator () (t a) (t a))
-> (t a -> Bool) -> Validator () (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int, Int)
r (Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
{-# INLINABLE lengthWithin' #-}
{-# SPECIALIZE ofLength' :: Int -> Validator () [a] [a] #-}

-- | Like 'minValueOf' but uses /Unit/ as the 'Validator' error type.

minValueOf' :: Ord a => a -> Validator () a a
minValueOf' :: a -> Validator () a a
minValueOf' a
x = (a -> Bool) -> Validator () a a
forall a. (a -> Bool) -> Validator () a a
failureUnless' (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
x)
{-# INLINABLE minValueOf' #-}

-- | Like 'maxValueOf' but uses /Unit/ as the 'Validator' error type.

maxValueOf' :: Ord a => a -> Validator () a a
maxValueOf' :: a -> Validator () a a
maxValueOf' a
x = (a -> Bool) -> Validator () a a
forall a. (a -> Bool) -> Validator () a a
failureUnless' (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=a
x)
{-# INLINABLE maxValueOf' #-}

-- | Like 'valueAbove' but uses /Unit/ as the 'Validator' error type.

valueAbove' :: Ord a => a -> Validator () a a
valueAbove' :: a -> Validator () a a
valueAbove' a
n = (a -> Bool) -> Validator () a a
forall a. (a -> Bool) -> Validator () a a
failureUnless' (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
n)
{-# INLINABLE valueAbove' #-}

-- | Like 'valueBelow' but uses /Unit/ as the 'Validator' error type.

valueBelow' :: Ord a => a -> Validator () a a
valueBelow' :: a -> Validator () a a
valueBelow' a
n = (a -> Bool) -> Validator () a a
forall a. (a -> Bool) -> Validator () a a
failureUnless' (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
n)
{-# INLINABLE valueBelow' #-}

-- | Like 'valueWithin' but uses /Unit/ as the 'Validator' error type.

valueWithin' :: Ord a => (a, a) -> Validator () a a
valueWithin' :: (a, a) -> Validator () a a
valueWithin' (a
m, a
n) = (a -> Bool) -> Validator () a a
forall a. (a -> Bool) -> Validator () a a
failureUnless' ((a -> Bool) -> Validator () a a)
-> (a -> Bool) -> Validator () a a
forall a b. (a -> b) -> a -> b
$ \a
x -> a
m a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
n
{-# INLINABLE valueWithin' #-}
{-# SPECIALIZE valueWithin' :: (Int, Int) -> Validator () Int Int #-}

-- | Like 'onlyContains' but uses /Unit/ as the 'Validator' error type.

onlyContains' :: Foldable t => (a -> Bool) -> Validator () (t a) (t a)
onlyContains' :: (a -> Bool) -> Validator () (t a) (t a)
onlyContains' a -> Bool
x = (t a -> Bool) -> Validator () (t a) (t a)
forall a. (a -> Bool) -> Validator () a a
failureUnless' ((t a -> Bool) -> Validator () (t a) (t a))
-> (t a -> Bool) -> Validator () (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all a -> Bool
x
{-# INLINABLE onlyContains' #-}
{-# SPECIALIZE onlyContains' :: (a -> Bool) -> Validator () [a] [a] #-}

-- | Like 'atleastContains' but uses /Unit/ as the 'Validator' error type.

atleastContains' :: Foldable t => (a -> Bool) -> Validator () (t a) (t a)
atleastContains' :: (a -> Bool) -> Validator () (t a) (t a)
atleastContains' a -> Bool
x = (t a -> Bool) -> Validator () (t a) (t a)
forall a. (a -> Bool) -> Validator () a a
failureUnless' ((t a -> Bool) -> Validator () (t a) (t a))
-> (t a -> Bool) -> Validator () (t a) (t a)
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any a -> Bool
x
{-# INLINABLE atleastContains' #-}
{-# SPECIALIZE atleastContains' :: (a -> Bool) -> Validator () [a] [a] #-}

-- | Like 'mustContain' but uses /Unit/ as the 'Validator' error type.

mustContain' :: (Foldable t, Eq a) => a -> Validator () (t a) (t a)
mustContain' :: a -> Validator () (t a) (t a)
mustContain' a
x = (t a -> Bool) -> Validator () (t a) (t a)
forall a. (a -> Bool) -> Validator () a a
failureUnless' ((t a -> Bool) -> Validator () (t a) (t a))
-> (t a -> Bool) -> Validator () (t a) (t a)
forall a b. (a -> b) -> a -> b
$ a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x
{-# INLINABLE mustContain' #-}
{-# SPECIALIZE mustContain' :: Eq a => a -> Validator () [a] [a] #-}

---------------------------------------------------------------------

-- Negating 'Validator'

---------------------------------------------------------------------


{- | Build a validator that succeeds if given validator fails and vice versa.

__Note__: This will set the output of the 'Validator' to be the same as its input,
thereby ignoring the original output.

==== __Examples__

>>> let vald = negateV "NonPositive" (failureIf (>0) "Positive")
>>> runValidator vald 5
Success 5
>>> runValidator vald 0
Failure "NonPositive"
>>> runValidator vald (-1)
Failure "NonPositive"
-}
negateV :: e -> Validator e1 a x -> Validator e a a
negateV :: e -> Validator e1 a x -> Validator e a a
negateV e
err (Validator a -> Validation e1 x
v) = (a -> Validation e a) -> Validator e a a
forall e inp a. (inp -> Validation e a) -> Validator e inp a
Validator ((a -> Validation e a) -> Validator e a a)
-> (a -> Validation e a) -> Validator e a a
forall a b. (a -> b) -> a -> b
$ \a
x -> Validation e a
-> Validation e a -> Validation e1 x -> Validation e a
forall p e a. p -> p -> Validation e a -> p
validationConst (a -> Validation e a
forall e a. a -> Validation e a
Success a
x) (e -> Validation e a
forall e a. e -> Validation e a
Failure e
err) (Validation e1 x -> Validation e a)
-> Validation e1 x -> Validation e a
forall a b. (a -> b) -> a -> b
$ a -> Validation e1 x
v a
x

-- | Like 'negateV' but uses /Unit/ as the 'Validator' error type.

negateV' :: Validator e a x -> Validator () a a
negateV' :: Validator e a x -> Validator () a a
negateV' (Validator a -> Validation e x
v) = (a -> Validation () a) -> Validator () a a
forall e inp a. (inp -> Validation e a) -> Validator e inp a
Validator ((a -> Validation () a) -> Validator () a a)
-> (a -> Validation () a) -> Validator () a a
forall a b. (a -> b) -> a -> b
$ \a
x -> Validation () a
-> Validation () a -> Validation e x -> Validation () a
forall p e a. p -> p -> Validation e a -> p
validationConst (a -> Validation () a
forall e a. a -> Validation e a
Success a
x) (() -> Validation () a
forall e a. e -> Validation e a
Failure ()) (Validation e x -> Validation () a)
-> Validation e x -> Validation () a
forall a b. (a -> b) -> a -> b
$ a -> Validation e x
v a
x

---------------------------------------------------------------------

-- Combining 'Validator's

---------------------------------------------------------------------


-- | A synonym for 'orElse'. Satisfies associativity law and hence forms a semigroup.

infixr 5 </>

(</>) :: Semigroup e => Validator e inp a -> Validator e inp a -> Validator e inp a
Validator inp -> Validation e a
v1 </> :: Validator e inp a -> Validator e inp a -> Validator e inp a
</> Validator inp -> Validation e a
v2 = (inp -> Validation e a) -> Validator e inp a
forall e inp a. (inp -> Validation e a) -> Validator e inp a
Validator ((inp -> Validation e a) -> Validator e inp a)
-> (inp -> Validation e a) -> Validator e inp a
forall a b. (a -> b) -> a -> b
$ inp -> Validation e a
v1 (inp -> Validation e a)
-> (inp -> Validation e a) -> inp -> Validation e a
forall a. Semigroup a => a -> a -> a
<> inp -> Validation e a
v2
{-# INLINABLE (</>)  #-}
{-# SPECIALIZE (</>)
    :: Validator (NonEmpty err) inp a
    -> Validator (NonEmpty err) inp a
    -> Validator (NonEmpty err) inp a #-}
{-# SPECIALIZE (</>) :: Validator () inp a -> Validator () inp a -> Validator () inp a #-}
{-# SPECIALIZE (</>) :: Validator [err] inp a -> Validator [err] inp a -> Validator [err] inp a #-}

{- | Build a validator that /succeeds/ if __either__ of the given validators succeed.
The first (left-most) 'Success' is returned. If both fail, the errors are combined.
Other validator /is not used/ if first one succeeds.

@vald1 \`orElse\` (vald2 \`orElse\` vald3) = (vald1 \`orElse\` vald2) \`orElse\` vald3@

@'failV' e \`orElse\` vald = vald@

@vald \`orElse\` 'failV' e = vald@

==== __Examples__

>>> let vald = failureIf (>0) "Positive" `orElse` failureIf even "Even"
>>> runValidator vald 5
Success 5
>>> runValidator vald 4
Failure ("Positive" :| ["Even"])
>>> runValidator vald 0
Success 0
>>> runValidator vald (-1)
Success (-1)
-}
orElse :: Semigroup e => Validator e inp a -> Validator e inp a -> Validator e inp a
orElse :: Validator e inp a -> Validator e inp a -> Validator e inp a
orElse = Validator e inp a -> Validator e inp a -> Validator e inp a
forall e inp a.
Semigroup e =>
Validator e inp a -> Validator e inp a -> Validator e inp a
(</>)
{-# INLINABLE orElse #-}

{- | A 'Validator' that always fails with supplied error. This is the identity of 'orElse' (i.e '(</>)').

@failV `'orElse'` vald = vald@

@vald `'orElse'` failV = vald@

==== __Examples__

>>> runValidator (failV :: Validator String Int Int) 42
Failure ""
-}
failV :: Monoid e => Validator e inp a
failV :: Validator e inp a
failV = (inp -> Validation e a) -> Validator e inp a
forall e inp a. (inp -> Validation e a) -> Validator e inp a
Validator ((inp -> Validation e a) -> Validator e inp a)
-> (inp -> Validation e a) -> Validator e inp a
forall a b. (a -> b) -> a -> b
$ Validation e a -> inp -> Validation e a
forall a b. a -> b -> a
const (Validation e a -> inp -> Validation e a)
-> Validation e a -> inp -> Validation e a
forall a b. (a -> b) -> a -> b
$ e -> Validation e a
forall e a. e -> Validation e a
Failure e
forall a. Monoid a => a
mempty
{-# INLINABLE failV #-}

{- | Build a validator that /only succeeds/ if __both__ of the given validators succeed.
The __first (left-most)__ failure is yielded. If both succeed, the __right-most__ 'Success' result is returned.
Other validator /is not used/ if first one fails.

This is the same as the semigroup operation (i.e '(<>)') on 'Validator'.

@vald1 \`andAlso\` (vald2 \`andAlso\` vald3) = (vald1 \`andAlso\` vald2) \`andAlso\` vald3@

@'mempty' \`andAlso\` vald = vald@

@vald \`andAlso\` 'mempty' = vald@

==== __Examples__

>>> let vald = failureIf (>0) "Positive" `andAlso` failureIf even "Even"
>>> runValidator vald 5
Failure ("Positive" :| [])
>>> runValidator vald (-2)
Failure ("Even" :| [])
>>> runValidator vald (-1)
Success (-1)
-}
andAlso :: Validator e inp a -> Validator e inp a -> Validator e inp a
andAlso :: Validator e inp a -> Validator e inp a -> Validator e inp a
andAlso = Validator e inp a -> Validator e inp a -> Validator e inp a
forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINABLE andAlso #-}

{- | Build a validator that /succeeds/ if __any__ of the given validators succeed. If all fail, the errors are combined.
The __first (left-most)__ 'Success' is returned. If all fail, the errors are /combined/.
Remaining validators /are not used/ once one succeeds.

@satisfyAny = 'foldl1' 'orElse'@

@satisfyAny = 'foldr1' 'orElse'@

@satisfyAny = 'foldl' 'orElse' 'failV'@

@satisfyAny = 'foldr' 'orElse' 'failV'@
-}
satisfyAny :: (Foldable t, Semigroup e) => t (Validator e inp a) -> Validator e inp a
satisfyAny :: t (Validator e inp a) -> Validator e inp a
satisfyAny = (Validator e inp a -> Validator e inp a -> Validator e inp a)
-> t (Validator e inp a) -> Validator e inp a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Validator e inp a -> Validator e inp a -> Validator e inp a
forall e inp a.
Semigroup e =>
Validator e inp a -> Validator e inp a -> Validator e inp a
orElse
{-# INLINABLE satisfyAny #-}
{-# SPECIALIZE satisfyAny :: [Validator (NonEmpty err) inp a] -> Validator (NonEmpty err) inp a #-}
{-# SPECIALIZE satisfyAny :: [Validator () inp a] -> Validator () inp a #-}
{-# SPECIALIZE satisfyAny :: [Validator [err] inp a] -> Validator [err] inp a #-}

{- | Build a validator that /only succeeds/ if __all__ of the given validators succeed.
The __first (left-most)__ failure is yielded. If all succeed, the __right-most__ 'Success' result is returned.
Remaining validators /are not used/ once one fails.

@satisfyAll = 'Data.Foldable.fold'@

@satisfyAll = 'foldl1' 'andAlso'@

@satisfyAll = 'foldr1' 'andAlso'@

@satisfyAll = 'foldl' 'andAlso' 'mempty'@

@satisfyAll = 'foldr' 'andAlso' 'mempty'@
-}
satisfyAll :: Foldable t => t (Validator e inp a) -> Validator e inp a
satisfyAll :: t (Validator e inp a) -> Validator e inp a
satisfyAll = (Validator e inp a -> Validator e inp a -> Validator e inp a)
-> t (Validator e inp a) -> Validator e inp a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Validator e inp a -> Validator e inp a -> Validator e inp a
forall e inp a.
Validator e inp a -> Validator e inp a -> Validator e inp a
andAlso
{-# INLINABLE satisfyAll #-}
{-# SPECIALIZE satisfyAll :: [Validator e inp a] -> Validator e inp a #-}

---------------------------------------------------------------------

-- Type specific 'Validator's

---------------------------------------------------------------------


{- | Build a validator that runs given validator only if input is 'Just'.

Yields 'Success' when input is 'Nothing'.

==== __Examples__

>>> runValidator (optionally (failureIf even "Even")) (Just 5)
Success (Just 5)
>>> runValidator (optionally (failureIf even "Even")) (Just 6)
Failure ("Even" :| [])
>>> runValidator (optionally (failureIf even "Even")) Nothing
Success Nothing
-}
optionally :: Validator e inp a -> Validator e (Maybe inp) (Maybe a)
optionally :: Validator e inp a -> Validator e (Maybe inp) (Maybe a)
optionally (Validator inp -> Validation e a
v) = (Maybe inp -> Validation e (Maybe a))
-> Validator e (Maybe inp) (Maybe a)
forall e inp a. (inp -> Validation e a) -> Validator e inp a
Validator ((Maybe inp -> Validation e (Maybe a))
 -> Validator e (Maybe inp) (Maybe a))
-> (Maybe inp -> Validation e (Maybe a))
-> Validator e (Maybe inp) (Maybe a)
forall a b. (a -> b) -> a -> b
$ Validation e (Maybe a)
-> (inp -> Validation e (Maybe a))
-> Maybe inp
-> Validation e (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> Validation e (Maybe a)
forall e a. a -> Validation e a
Success Maybe a
forall a. Maybe a
Nothing) ((a -> Maybe a) -> Validation e a -> Validation e (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Validation e a -> Validation e (Maybe a))
-> (inp -> Validation e a) -> inp -> Validation e (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. inp -> Validation e a
v)

{- | Build a validator that runs given validator only if input is 'Just'. Yields default value otherwise.

Yields 'Success' when input is 'Nothing', and wrapped around the default value.

@vald \`withDefault\` deflt = 'Data.Maybe.fromMaybe' deflt '<$>' 'optionally' vald@

==== __Examples__

>>> runValidator (failureIf even "Even" `withDefault` 0) (Just 5)
Success (Just 5)
>>> runValidator (failureIf even "Even" `withDefault` 0) (Just 6)
Failure ("Even" :| [])
>>> runValidator (failureIf even "Even" `withDefault` 0) Nothing
Success Nothing
-}
withDefault :: Validator e inp a -> a -> Validator e (Maybe inp) a
withDefault :: Validator e inp a -> a -> Validator e (Maybe inp) a
withDefault (Validator inp -> Validation e a
v) a
deflt = (Maybe inp -> Validation e a) -> Validator e (Maybe inp) a
forall e inp a. (inp -> Validation e a) -> Validator e inp a
Validator ((Maybe inp -> Validation e a) -> Validator e (Maybe inp) a)
-> (Maybe inp -> Validation e a) -> Validator e (Maybe inp) a
forall a b. (a -> b) -> a -> b
$ Validation e a
-> (inp -> Validation e a) -> Maybe inp -> 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
deflt) inp -> Validation e a
v

-- | Utility to convert a regular predicate function to a 'Validator'. __INTERNAL__

validatorFrom :: (a -> Bool) -> e -> Validator e a a
validatorFrom :: (a -> Bool) -> e -> Validator e a a
validatorFrom a -> Bool
predc e
err = (a -> Validation e a) -> Validator e a a
forall e inp a. (inp -> Validation e a) -> Validator e inp a
Validator ((a -> Validation e a) -> Validator e a a)
-> (a -> Validation e a) -> Validator e a a
forall a b. (a -> b) -> a -> b
$ \a
x -> if a -> Bool
predc a
x then a -> Validation e a
forall e a. a -> Validation e a
Success a
x else e -> Validation e a
forall e a. e -> Validation e a
Failure e
err