{-# LANGUAGE Safe #-}

{- |
Module      : Valida.Combinators
Description : Combinators and utilities for building and combining 'ValidationRule'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, 'ValidationRule' combinators.
As well as the 'orElse', 'andAlso', 'satisfyAny', and 'satisfyAll' functions, and some more utilities.
-}

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

      failureIf
    , failureUnless
      -- * Primitive /Unit/ combinators

    , failureIf'
    , failureUnless'
      -- * Negating 'ValidationRule'

    , negateRule
    , negateRule'
      -- * Combining 'ValidationRule's

    , andAlso
    , falseRule
    , orElse
    , 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'
      -- * Type specific 'ValidationRule's

    , optionally
    ) where

import Control.Applicative (Applicative (liftA2))

import Data.Bool          (bool)
import Data.Foldable      (Foldable (fold))
import Data.Ix            (Ix (inRange))
import Data.List.NonEmpty (NonEmpty)

import Valida.Utils          (neSingleton)
import Valida.Validation     (Validation (..), validationConst)
import Valida.ValidationRule (ValidationRule (..), vrule)

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

-- Primitive 'NonEmpty' combinators

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


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

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

==== __Examples__

>>> runValidator (validate (failureIf (>0) "Positive")) 5
Failure ("Positive" :| [])
>>> runValidator (validate (failureIf (>0) "Positive")) 0
Success 0
>>> runValidator (validate (failureIf (>0) "Positive")) (-1)
Success (-1)
-}
failureIf :: (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
failureIf :: (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
failureIf a -> Bool
predc = (a -> Bool) -> NonEmpty e -> ValidationRule (NonEmpty e) a
forall a e. (a -> Bool) -> e -> ValidationRule e a
predToRule (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
predc) (NonEmpty e -> ValidationRule (NonEmpty e) a)
-> (e -> NonEmpty e) -> e -> ValidationRule (NonEmpty e) 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 (validate (failureUnless (>0) "NonPositive")) 5
Success 5
>>> runValidator (validate (failureUnless (>0) "NonPositive")) 0
Failure ("NonPositive" :| [])
>>> runValidator (validate (failureUnless (>0) "NonPositive")) (-1)
Failure ("NonPositive" :| [])
-}
failureUnless :: (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
failureUnless :: (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
failureUnless a -> Bool
predc = (a -> Bool) -> NonEmpty e -> ValidationRule (NonEmpty e) a
forall a e. (a -> Bool) -> e -> ValidationRule e a
predToRule a -> Bool
predc (NonEmpty e -> ValidationRule (NonEmpty e) a)
-> (e -> NonEmpty e) -> e -> ValidationRule (NonEmpty e) 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 'ValidationRule' error type.

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

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

==== __Examples__

>>> runValidator (validate (failureIf' (>0))) 5
Failure ()
>>> runValidator (validate (failureIf' (>0))) 0
Success 0
>>> runValidator (validate (failureIf' (>0))) (-1)
Success (-1)
-}
failureIf' :: (a -> Bool) -> ValidationRule () a
failureIf' :: (a -> Bool) -> ValidationRule () a
failureIf' a -> Bool
predc = (a -> Bool) -> () -> ValidationRule () a
forall a e. (a -> Bool) -> e -> ValidationRule e a
predToRule (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 'ValidationRule' error type.

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

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

==== __Examples__

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

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

-- Common derivates of primitive 'NonEmpty' combinators

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


{- | Build an equality rule for value.

@mustBe x = 'failureUnless' (==x)@
-}
mustBe :: Eq a => a -> e -> ValidationRule (NonEmpty e) a
mustBe :: a -> e -> ValidationRule (NonEmpty e) a
mustBe a
x = (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) 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 -> ValidationRule (NonEmpty e) (t a)
ofLength :: Int -> e -> ValidationRule (NonEmpty e) (t a)
ofLength Int
n = (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
failureUnless ((t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a))
-> (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (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 -> ValidationRule (NonEmpty e) [a] #-}

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

@minLengthOf x = 'failureUnless' ((>=n) . 'length')@
-}
minLengthOf :: Foldable t => Int -> e -> ValidationRule (NonEmpty e) (t a)
minLengthOf :: Int -> e -> ValidationRule (NonEmpty e) (t a)
minLengthOf Int
n = (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
failureUnless ((t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a))
-> (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (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 -> ValidationRule (NonEmpty e) [a] #-}

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

@maxLengthOf n = 'failureUnless' ((<=n) . 'length')@
-}
maxLengthOf :: Foldable t => Int -> e -> ValidationRule (NonEmpty e) (t a)
maxLengthOf :: Int -> e -> ValidationRule (NonEmpty e) (t a)
maxLengthOf Int
n = (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
failureUnless ((t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a))
-> (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (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 -> ValidationRule (NonEmpty e) [a] #-}

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

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

@lengthAbove x = 'failureUnless' ((>n) . 'length')@
-}
lengthAbove :: Foldable t => Int -> e -> ValidationRule (NonEmpty e) (t a)
lengthAbove :: Int -> e -> ValidationRule (NonEmpty e) (t a)
lengthAbove Int
n = (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
failureUnless ((t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a))
-> (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (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 -> ValidationRule (NonEmpty e) [a] #-}

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

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

@lengthBelow x = 'failureUnless' ((<n) . 'length')@
-}
lengthBelow :: Foldable t => Int -> e -> ValidationRule (NonEmpty e) (t a)
lengthBelow :: Int -> e -> ValidationRule (NonEmpty e) (t a)
lengthBelow Int
n = (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
failureUnless ((t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a))
-> (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (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 -> ValidationRule (NonEmpty e) [a] #-}

{- | Build a maximum length rule.

@notEmpty = 'minLengthOf' 1@

@notEmpty = 'failureIf' 'null'@
-}
notEmpty :: Foldable t => e -> ValidationRule (NonEmpty e) (t a)
notEmpty :: e -> ValidationRule (NonEmpty e) (t a)
notEmpty = (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
failureIf t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
{-# INLINABLE notEmpty #-}
{-# SPECIALIZE notEmpty :: e -> ValidationRule (NonEmpty e) [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 -> ValidationRule (NonEmpty e) (t a)
lengthWithin :: (Int, Int) -> e -> ValidationRule (NonEmpty e) (t a)
lengthWithin (Int, Int)
r = (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
failureUnless ((t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a))
-> (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (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 -> ValidationRule (NonEmpty e) [a] #-}

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

@minValueOf x = 'failureUnless' (>=x)@
-}
minValueOf :: Ord a => a -> e -> ValidationRule (NonEmpty e) a
minValueOf :: a -> e -> ValidationRule (NonEmpty e) a
minValueOf a
x = (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) 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 -> ValidationRule (NonEmpty e) a
maxValueOf :: a -> e -> ValidationRule (NonEmpty e) a
maxValueOf a
x = (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) 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 -> ValidationRule (NonEmpty e) a
valueAbove :: a -> e -> ValidationRule (NonEmpty e) a
valueAbove a
n = (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) 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 -> ValidationRule (NonEmpty e) a
valueBelow :: a -> e -> ValidationRule (NonEmpty e) a
valueBelow a
n = (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) 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 -> ValidationRule (NonEmpty e) a
valueWithin :: (a, a) -> e -> ValidationRule (NonEmpty e) a
valueWithin (a
m, a
n) = (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
failureUnless ((a -> Bool) -> e -> ValidationRule (NonEmpty e) a)
-> (a -> Bool) -> e -> ValidationRule (NonEmpty e) 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 -> ValidationRule (NonEmpty e) Int #-}

{- | Build an 'all' rule.

@onlyContains x = 'failureUnless' ('all' x)@
-}
onlyContains :: Foldable t => (a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
onlyContains :: (a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
onlyContains a -> Bool
x = (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
failureUnless ((t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a))
-> (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (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 -> ValidationRule (NonEmpty e) [a] #-}

{- | Build an 'any' rule.

@atleastContains x = 'failureUnless' ('any' x)@
-}
atleastContains :: Foldable t => (a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
atleastContains :: (a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
atleastContains a -> Bool
x = (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
failureUnless ((t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a))
-> (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (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 -> ValidationRule (NonEmpty e) [a] #-}

{- | Build an 'elem' rule.

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

@mustContain x = 'failureUnless' ('elem' x)@
-}
mustContain :: (Foldable t, Eq a) => a -> e -> ValidationRule (NonEmpty e) (t a)
mustContain :: a -> e -> ValidationRule (NonEmpty e) (t a)
mustContain a
x = (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
forall a e. (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
failureUnless ((t a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a))
-> (t a -> Bool) -> e -> ValidationRule (NonEmpty e) (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 -> ValidationRule (NonEmpty e) [a] #-}

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

-- Common derivates of primitive /Unit/ combinators

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


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

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

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

ofLength' :: Foldable t => Int -> ValidationRule () (t a)
ofLength' :: Int -> ValidationRule () (t a)
ofLength' Int
n = (t a -> Bool) -> ValidationRule () (t a)
forall a. (a -> Bool) -> ValidationRule () a
failureUnless' ((t a -> Bool) -> ValidationRule () (t a))
-> (t a -> Bool) -> ValidationRule () (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 -> ValidationRule () [a] #-}

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

minLengthOf' :: Foldable t => Int -> ValidationRule () (t a)
minLengthOf' :: Int -> ValidationRule () (t a)
minLengthOf' Int
n = (t a -> Bool) -> ValidationRule () (t a)
forall a. (a -> Bool) -> ValidationRule () a
failureUnless' ((t a -> Bool) -> ValidationRule () (t a))
-> (t a -> Bool) -> ValidationRule () (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 -> ValidationRule () [a] #-}

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

maxLengthOf' :: Foldable t => Int -> ValidationRule () (t a)
maxLengthOf' :: Int -> ValidationRule () (t a)
maxLengthOf' Int
n = (t a -> Bool) -> ValidationRule () (t a)
forall a. (a -> Bool) -> ValidationRule () a
failureUnless' ((t a -> Bool) -> ValidationRule () (t a))
-> (t a -> Bool) -> ValidationRule () (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 -> ValidationRule () [a] #-}

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

lengthAbove' :: Foldable t => Int -> ValidationRule () (t a)
lengthAbove' :: Int -> ValidationRule () (t a)
lengthAbove' Int
n = (t a -> Bool) -> ValidationRule () (t a)
forall a. (a -> Bool) -> ValidationRule () a
failureUnless' ((t a -> Bool) -> ValidationRule () (t a))
-> (t a -> Bool) -> ValidationRule () (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 -> ValidationRule () [a] #-}

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

lengthBelow' :: Foldable t => Int -> ValidationRule () (t a)
lengthBelow' :: Int -> ValidationRule () (t a)
lengthBelow' Int
n = (t a -> Bool) -> ValidationRule () (t a)
forall a. (a -> Bool) -> ValidationRule () a
failureUnless' ((t a -> Bool) -> ValidationRule () (t a))
-> (t a -> Bool) -> ValidationRule () (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 -> ValidationRule () [a] #-}

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

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

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

lengthWithin' :: Foldable t => (Int, Int) -> ValidationRule () (t a)
lengthWithin' :: (Int, Int) -> ValidationRule () (t a)
lengthWithin' (Int, Int)
r = (t a -> Bool) -> ValidationRule () (t a)
forall a. (a -> Bool) -> ValidationRule () a
failureUnless' ((t a -> Bool) -> ValidationRule () (t a))
-> (t a -> Bool) -> ValidationRule () (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 -> ValidationRule () [a] #-}

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

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

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

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

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

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

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

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

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

valueWithin' :: Ord a => (a, a) -> ValidationRule () a
valueWithin' :: (a, a) -> ValidationRule () a
valueWithin' (a
m, a
n) = (a -> Bool) -> ValidationRule () a
forall a. (a -> Bool) -> ValidationRule () a
failureUnless' ((a -> Bool) -> ValidationRule () a)
-> (a -> Bool) -> ValidationRule () 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) -> ValidationRule () Int #-}

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

onlyContains' :: Foldable t => (a -> Bool) -> ValidationRule () (t a)
onlyContains' :: (a -> Bool) -> ValidationRule () (t a)
onlyContains' a -> Bool
x = (t a -> Bool) -> ValidationRule () (t a)
forall a. (a -> Bool) -> ValidationRule () a
failureUnless' ((t a -> Bool) -> ValidationRule () (t a))
-> (t a -> Bool) -> ValidationRule () (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) -> ValidationRule () [a] #-}

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

atleastContains' :: Foldable t => (a -> Bool) -> ValidationRule () (t a)
atleastContains' :: (a -> Bool) -> ValidationRule () (t a)
atleastContains' a -> Bool
x = (t a -> Bool) -> ValidationRule () (t a)
forall a. (a -> Bool) -> ValidationRule () a
failureUnless' ((t a -> Bool) -> ValidationRule () (t a))
-> (t a -> Bool) -> ValidationRule () (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) -> ValidationRule () [a] #-}

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

mustContain' :: (Foldable t, Eq a) => a -> ValidationRule () (t a)
mustContain' :: a -> ValidationRule () (t a)
mustContain' a
x = (t a -> Bool) -> ValidationRule () (t a)
forall a. (a -> Bool) -> ValidationRule () a
failureUnless' ((t a -> Bool) -> ValidationRule () (t a))
-> (t a -> Bool) -> ValidationRule () (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 -> ValidationRule () [a] #-}

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

-- Negating 'ValidationRule'

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


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

==== __Examples__

>>> let rule = negateRule "NonPositive" (failureIf (>0) "Positive")
>>> runValidator (validate rule) 5
Success 5
>>> runValidator (validate rule) 0
Failure "NonPositive"
>>> runValidator (validate rule) (-1)
Failure "NonPositive"
-}
negateRule :: e -> ValidationRule e1 a -> ValidationRule e a
negateRule :: e -> ValidationRule e1 a -> ValidationRule e a
negateRule e
err (ValidationRule a -> Validation e1 ()
rule) = (a -> Validation e ()) -> ValidationRule e a
forall a e. (a -> Validation e ()) -> ValidationRule e a
vrule ((a -> Validation e ()) -> ValidationRule e a)
-> (a -> Validation e ()) -> ValidationRule e a
forall a b. (a -> b) -> a -> b
$ Validation e ()
-> Validation e () -> Validation e1 () -> Validation e ()
forall p e a. p -> p -> Validation e a -> p
validationConst (() -> Validation e ()
forall e a. a -> Validation e a
Success ()) (e -> Validation e ()
forall e a. e -> Validation e a
Failure e
err) (Validation e1 () -> Validation e ())
-> (a -> Validation e1 ()) -> a -> Validation e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Validation e1 ()
rule

-- | Like 'negateRule' but uses /Unit/ as the 'ValidationRule' error type.

negateRule' :: ValidationRule e a -> ValidationRule () a
negateRule' :: ValidationRule e a -> ValidationRule () a
negateRule' (ValidationRule a -> Validation e ()
rule) = (a -> Validation () ()) -> ValidationRule () a
forall a e. (a -> Validation e ()) -> ValidationRule e a
vrule ((a -> Validation () ()) -> ValidationRule () a)
-> (a -> Validation () ()) -> ValidationRule () a
forall a b. (a -> b) -> a -> b
$ ((() -> Validation () ()) -> () -> Validation () ()
forall a b. (a -> b) -> a -> b
$ ()) ((() -> Validation () ()) -> Validation () ())
-> (a -> () -> Validation () ()) -> a -> Validation () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> Validation () ())
-> (() -> Validation () ())
-> Validation e ()
-> ()
-> Validation () ()
forall p e a. p -> p -> Validation e a -> p
validationConst () -> Validation () ()
forall e a. a -> Validation e a
Success () -> Validation () ()
forall e a. e -> Validation e a
Failure (Validation e () -> () -> Validation () ())
-> (a -> Validation e ()) -> a -> () -> Validation () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Validation e ()
rule

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

-- Combining 'ValidationRule's

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


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

infixr 5 </>

(</>) :: Semigroup e => ValidationRule e a -> ValidationRule e a -> ValidationRule e a
ValidationRule a -> Validation e ()
rule1 </> :: ValidationRule e a -> ValidationRule e a -> ValidationRule e a
</> ValidationRule a -> Validation e ()
rule2 = (a -> Validation e ()) -> ValidationRule e a
forall a e. (a -> Validation e ()) -> ValidationRule e a
vrule ((a -> Validation e ()) -> ValidationRule e a)
-> (a -> Validation e ()) -> ValidationRule e a
forall a b. (a -> b) -> a -> b
$ (Validation e () -> Validation e () -> Validation e ())
-> (a -> Validation e ())
-> (a -> Validation e ())
-> a
-> Validation e ()
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Validation e () -> Validation e () -> Validation e ()
forall a. Semigroup a => a -> a -> a
(<>) a -> Validation e ()
rule1 a -> Validation e ()
rule2
{-# INLINABLE (</>)  #-}
{-# SPECIALIZE (</>)
    :: ValidationRule (NonEmpty err) a
    -> ValidationRule (NonEmpty err) a
    -> ValidationRule (NonEmpty err) a #-}
{-# SPECIALIZE (</>) :: ValidationRule () a -> ValidationRule () a -> ValidationRule () a #-}
{-# SPECIALIZE (</>) :: ValidationRule [err] a -> ValidationRule [err] a -> ValidationRule [err] a #-}

{- | Build a rule that /succeeds/ if __either__ of the given rules succeed. If both fail, the errors are combined.

@rule1 \`orElse\` (rule2 \`orElse\` rule3) = (rule1 \`orElse\` rule2) \`orElse\` rule3@

@'falseRule' e \`orElse\` rule = rule@

@rule \`orElse\` 'falseRule' e = rule@

==== __Examples__

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

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

@falseRule `'orElse'` rule = rule@

@rule `'orElse'` falseRule = rule@

==== __Examples__

>>> runValidator (validate falseRule) 42
Failure ()
-}
falseRule :: Monoid e => ValidationRule e a
falseRule :: ValidationRule e a
falseRule = (a -> Validation e ()) -> ValidationRule e a
forall a e. (a -> Validation e ()) -> ValidationRule e a
vrule ((a -> Validation e ()) -> ValidationRule e a)
-> (a -> Validation e ()) -> ValidationRule e a
forall a b. (a -> b) -> a -> b
$ Validation e () -> a -> Validation e ()
forall a b. a -> b -> a
const (Validation e () -> a -> Validation e ())
-> Validation e () -> a -> Validation e ()
forall a b. (a -> b) -> a -> b
$ e -> Validation e ()
forall e a. e -> Validation e a
Failure e
forall a. Monoid a => a
mempty
{-# INLINABLE falseRule #-}

{- | Build a rule that /only succeeds/ if __both__ of the given rules succeed. The very first failure is yielded.

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

@rule1 \`andAlso\` (rule2 \`andAlso\` rule3) = (rule1 \`andAlso\` rule2) \`andAlso\` rule3@

@'mempty' \`andAlso\` rule = rule@

@rule \`andAlso\` 'mempty' = rule@

==== __Examples__

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

{- | Build a rule that /succeeds/ if __any__ of the given rules succeed. If all fail, the errors are combined.

@satisfyAny = 'foldl1' 'orElse'@

@satisfyAny = 'foldr1' 'orElse'@

@satisfyAny = 'foldl' 'orElse' 'falseRule'@

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

{- | Build a rule that /only succeeds/ if __all__ of the given rules succeed. The very first failure is yielded.

@satisfyAll = 'fold'@

@satisfyAll = 'foldl1' 'andAlso'@

@satisfyAll = 'foldr1' 'andAlso'@

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

@satisfyAll = 'foldr' 'andAlso' 'mempty'@
-}
satisfyAll :: Foldable t => t (ValidationRule e a) -> ValidationRule e a
satisfyAll :: t (ValidationRule e a) -> ValidationRule e a
satisfyAll = t (ValidationRule e a) -> ValidationRule e a
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
{-# INLINABLE satisfyAll #-}
{-# SPECIALIZE satisfyAll :: [ValidationRule e a] -> ValidationRule e a #-}

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

-- Type specific 'ValidationRule's

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


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

Yields 'Success' when input is 'Nothing'.

==== __Examples__

>>> runValidator (validate (optionally (failureIf even "Even"))) (Just 5)
Success (Just 5)
>>> runValidator (validate (optionally (failureIf even "Even"))) (Just 6)
Failure ("Even" :| [])
>>> runValidator (validate (optionally (failureIf even "Even"))) Nothing
Success Nothing
-}
optionally :: ValidationRule e a -> ValidationRule e (Maybe a)
optionally :: ValidationRule e a -> ValidationRule e (Maybe a)
optionally (ValidationRule a -> Validation e ()
rule) = (Maybe a -> Validation e ()) -> ValidationRule e (Maybe a)
forall a e. (a -> Validation e ()) -> ValidationRule e a
vrule ((Maybe a -> Validation e ()) -> ValidationRule e (Maybe a))
-> (Maybe a -> Validation e ()) -> ValidationRule e (Maybe a)
forall a b. (a -> b) -> a -> b
$ Validation e ()
-> (a -> Validation e ()) -> Maybe a -> Validation e ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Validation e ()
forall e a. a -> Validation e a
Success ()) a -> Validation e ()
rule

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

predToRule :: (a -> Bool) -> e -> ValidationRule e a
predToRule :: (a -> Bool) -> e -> ValidationRule e a
predToRule a -> Bool
predc e
err = (a -> Validation e ()) -> ValidationRule e a
forall a e. (a -> Validation e ()) -> ValidationRule e a
vrule ((a -> Validation e ()) -> ValidationRule e a)
-> (a -> Validation e ()) -> ValidationRule e a
forall a b. (a -> b) -> a -> b
$ Validation e () -> Validation e () -> Bool -> Validation e ()
forall a. a -> a -> Bool -> a
bool (e -> Validation e ()
forall e a. e -> Validation e a
Failure e
err) (() -> Validation e ()
forall e a. a -> Validation e a
Success ()) (Bool -> Validation e ()) -> (a -> Bool) -> a -> Validation e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
predc