{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.Validator
    ( -- * Core monad and runners
      ValidationM, ValidationT
    , ValidationRule, ValidationRuleT
    , TransValidationRule, TransValidationRuleT
    , runValidator, runValidatorT
      -- * Combinators
    , (>=>), (<=<)
      -- * Checks
    , minLength, maxLength, lengthBetween, notEmpty
    , largerThan, smallerThan, valueBetween
    , matchesRegex
    , conformsPred, conformsPredM
      -- * Transforming checks
    , requiredValue, nonEmptyList
    , conformsPredTrans, conformsPredTransM
      -- * Helper classes and types
    , HasLength(..), ConvertibleStrings(..)
    , Int64
      -- * Regular expression helpers
    , re, mkRegexQQ, Regex
    )
where

import Control.Applicative
import Control.Monad
import Control.Monad.Identity
import Control.Monad.Trans
import Control.Monad.Trans.Except
import Data.Int
import Data.String.Conversions
import Text.Regex.PCRE.Heavy
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.List.NonEmpty as NEL
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

-- | The validation monad
type ValidationM e = ValidationT e Identity

-- | The validation monad transformer
newtype ValidationT e m a
    = ValidationT { ValidationT e m a -> ExceptT e m a
unValidationT :: ExceptT e m a }
      deriving (Applicative (ValidationT e m)
a -> ValidationT e m a
Applicative (ValidationT e m)
-> (forall a b.
    ValidationT e m a -> (a -> ValidationT e m b) -> ValidationT e m b)
-> (forall a b.
    ValidationT e m a -> ValidationT e m b -> ValidationT e m b)
-> (forall a. a -> ValidationT e m a)
-> Monad (ValidationT e m)
ValidationT e m a -> (a -> ValidationT e m b) -> ValidationT e m b
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
forall a. a -> ValidationT e m a
forall a b.
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
forall a b.
ValidationT e m a -> (a -> ValidationT e m b) -> ValidationT e m b
forall e (m :: * -> *). Monad m => Applicative (ValidationT e m)
forall e (m :: * -> *) a. Monad m => a -> ValidationT e m a
forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> (a -> ValidationT e m b) -> ValidationT e m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ValidationT e m a
$creturn :: forall e (m :: * -> *) a. Monad m => a -> ValidationT e m a
>> :: ValidationT e m a -> ValidationT e m b -> ValidationT e m b
$c>> :: forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
>>= :: ValidationT e m a -> (a -> ValidationT e m b) -> ValidationT e m b
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> (a -> ValidationT e m b) -> ValidationT e m b
$cp1Monad :: forall e (m :: * -> *). Monad m => Applicative (ValidationT e m)
Monad, a -> ValidationT e m b -> ValidationT e m a
(a -> b) -> ValidationT e m a -> ValidationT e m b
(forall a b. (a -> b) -> ValidationT e m a -> ValidationT e m b)
-> (forall a b. a -> ValidationT e m b -> ValidationT e m a)
-> Functor (ValidationT e m)
forall a b. a -> ValidationT e m b -> ValidationT e m a
forall a b. (a -> b) -> ValidationT e m a -> ValidationT e m b
forall e (m :: * -> *) a b.
Functor m =>
a -> ValidationT e m b -> ValidationT e m a
forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ValidationT e m a -> ValidationT e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ValidationT e m b -> ValidationT e m a
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a -> ValidationT e m b -> ValidationT e m a
fmap :: (a -> b) -> ValidationT e m a -> ValidationT e m b
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ValidationT e m a -> ValidationT e m b
Functor, Functor (ValidationT e m)
a -> ValidationT e m a
Functor (ValidationT e m)
-> (forall a. a -> ValidationT e m a)
-> (forall a b.
    ValidationT e m (a -> b) -> ValidationT e m a -> ValidationT e m b)
-> (forall a b c.
    (a -> b -> c)
    -> ValidationT e m a -> ValidationT e m b -> ValidationT e m c)
-> (forall a b.
    ValidationT e m a -> ValidationT e m b -> ValidationT e m b)
-> (forall a b.
    ValidationT e m a -> ValidationT e m b -> ValidationT e m a)
-> Applicative (ValidationT e m)
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
ValidationT e m a -> ValidationT e m b -> ValidationT e m a
ValidationT e m (a -> b) -> ValidationT e m a -> ValidationT e m b
(a -> b -> c)
-> ValidationT e m a -> ValidationT e m b -> ValidationT e m c
forall a. a -> ValidationT e m a
forall a b.
ValidationT e m a -> ValidationT e m b -> ValidationT e m a
forall a b.
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
forall a b.
ValidationT e m (a -> b) -> ValidationT e m a -> ValidationT e m b
forall a b c.
(a -> b -> c)
-> ValidationT e m a -> ValidationT e m b -> ValidationT e m c
forall e (m :: * -> *). Monad m => Functor (ValidationT e m)
forall e (m :: * -> *) a. Monad m => a -> ValidationT e m a
forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> ValidationT e m b -> ValidationT e m a
forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m (a -> b) -> ValidationT e m a -> ValidationT e m b
forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ValidationT e m a -> ValidationT e m b -> ValidationT e m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ValidationT e m a -> ValidationT e m b -> ValidationT e m a
$c<* :: forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> ValidationT e m b -> ValidationT e m a
*> :: ValidationT e m a -> ValidationT e m b -> ValidationT e m b
$c*> :: forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
liftA2 :: (a -> b -> c)
-> ValidationT e m a -> ValidationT e m b -> ValidationT e m c
$cliftA2 :: forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ValidationT e m a -> ValidationT e m b -> ValidationT e m c
<*> :: ValidationT e m (a -> b) -> ValidationT e m a -> ValidationT e m b
$c<*> :: forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m (a -> b) -> ValidationT e m a -> ValidationT e m b
pure :: a -> ValidationT e m a
$cpure :: forall e (m :: * -> *) a. Monad m => a -> ValidationT e m a
$cp1Applicative :: forall e (m :: * -> *). Monad m => Functor (ValidationT e m)
Applicative, Applicative (ValidationT e m)
ValidationT e m a
Applicative (ValidationT e m)
-> (forall a. ValidationT e m a)
-> (forall a.
    ValidationT e m a -> ValidationT e m a -> ValidationT e m a)
-> (forall a. ValidationT e m a -> ValidationT e m [a])
-> (forall a. ValidationT e m a -> ValidationT e m [a])
-> Alternative (ValidationT e m)
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
ValidationT e m a -> ValidationT e m [a]
ValidationT e m a -> ValidationT e m [a]
forall a. ValidationT e m a
forall a. ValidationT e m a -> ValidationT e m [a]
forall a.
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
forall e (m :: * -> *).
(Monad m, Monoid e) =>
Applicative (ValidationT e m)
forall e (m :: * -> *) a. (Monad m, Monoid e) => ValidationT e m a
forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ValidationT e m a -> ValidationT e m [a]
forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: ValidationT e m a -> ValidationT e m [a]
$cmany :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ValidationT e m a -> ValidationT e m [a]
some :: ValidationT e m a -> ValidationT e m [a]
$csome :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ValidationT e m a -> ValidationT e m [a]
<|> :: ValidationT e m a -> ValidationT e m a -> ValidationT e m a
$c<|> :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
empty :: ValidationT e m a
$cempty :: forall e (m :: * -> *) a. (Monad m, Monoid e) => ValidationT e m a
$cp1Alternative :: forall e (m :: * -> *).
(Monad m, Monoid e) =>
Applicative (ValidationT e m)
Alternative, Monad (ValidationT e m)
Alternative (ValidationT e m)
ValidationT e m a
Alternative (ValidationT e m)
-> Monad (ValidationT e m)
-> (forall a. ValidationT e m a)
-> (forall a.
    ValidationT e m a -> ValidationT e m a -> ValidationT e m a)
-> MonadPlus (ValidationT e m)
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
forall a. ValidationT e m a
forall a.
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
forall e (m :: * -> *).
(Monad m, Monoid e) =>
Monad (ValidationT e m)
forall e (m :: * -> *).
(Monad m, Monoid e) =>
Alternative (ValidationT e m)
forall e (m :: * -> *) a. (Monad m, Monoid e) => ValidationT e m a
forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: ValidationT e m a -> ValidationT e m a -> ValidationT e m a
$cmplus :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
mzero :: ValidationT e m a
$cmzero :: forall e (m :: * -> *) a. (Monad m, Monoid e) => ValidationT e m a
$cp2MonadPlus :: forall e (m :: * -> *).
(Monad m, Monoid e) =>
Monad (ValidationT e m)
$cp1MonadPlus :: forall e (m :: * -> *).
(Monad m, Monoid e) =>
Alternative (ValidationT e m)
MonadPlus, m a -> ValidationT e m a
(forall (m :: * -> *) a. Monad m => m a -> ValidationT e m a)
-> MonadTrans (ValidationT e)
forall e (m :: * -> *) a. Monad m => m a -> ValidationT e m a
forall (m :: * -> *) a. Monad m => m a -> ValidationT e m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> ValidationT e m a
$clift :: forall e (m :: * -> *) a. Monad m => m a -> ValidationT e m a
MonadTrans)

-- | Run a validation on a type 'a'
runValidator :: TransValidationRule e a b -> a -> Either e b
runValidator :: TransValidationRule e a b -> a -> Either e b
runValidator TransValidationRule e a b
a a
b = Identity (Either e b) -> Either e b
forall a. Identity a -> a
runIdentity (Identity (Either e b) -> Either e b)
-> Identity (Either e b) -> Either e b
forall a b. (a -> b) -> a -> b
$ TransValidationRule e a b -> a -> Identity (Either e b)
forall (m :: * -> *) e a b.
Monad m =>
TransValidationRuleT e m a b -> a -> m (Either e b)
runValidatorT TransValidationRule e a b
a a
b
{-# INLINE runValidator #-}

-- | Run a validation on a type 'a'
runValidatorT :: Monad m => TransValidationRuleT e m a b -> a -> m (Either e b)
runValidatorT :: TransValidationRuleT e m a b -> a -> m (Either e b)
runValidatorT TransValidationRuleT e m a b
validationSteps a
input =
    ExceptT e m b -> m (Either e b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e m b -> m (Either e b))
-> ExceptT e m b -> m (Either e b)
forall a b. (a -> b) -> a -> b
$ ValidationT e m b -> ExceptT e m b
forall e (m :: * -> *) a. ValidationT e m a -> ExceptT e m a
unValidationT (TransValidationRuleT e m a b
validationSteps a
input)
{-# INLINE runValidatorT #-}

-- | A validation rule. Combine using @('>=>')@ or @('<=<')@
type ValidationRule e a = ValidationRuleT e Identity a

-- | A validation rule. Combine using @('>=>')@ or @('<=<')@
type ValidationRuleT e m a = TransValidationRuleT e m a a

-- | A transforming validation rule. Combine using @('>=>')@ or @('<=<')@
type TransValidationRule e a b = TransValidationRuleT e Identity a b

-- | A transforming validation rule. Combine using @('>=>')@ or @('<=<')@
type TransValidationRuleT e m a b = a -> ValidationT e m b

-- | All types that have a length, eg. 'String', '[a]', 'Vector a', etc.
class HasLength a where
    getLength :: a -> Int64

instance HasLength [a] where
    getLength :: [a] -> Int64
getLength = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> ([a] -> Int) -> [a] -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
    {-# INLINE getLength #-}

instance HasLength T.Text where
    getLength :: Text -> Int64
getLength = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> (Text -> Int) -> Text -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length
    {-# INLINE getLength #-}

instance HasLength TL.Text where
    getLength :: Text -> Int64
getLength = Text -> Int64
TL.length
    {-# INLINE getLength #-}

instance HasLength BS.ByteString where
    getLength :: ByteString -> Int64
getLength = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> (ByteString -> Int) -> ByteString -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length
    {-# INLINE getLength #-}

instance HasLength BSL.ByteString where
    getLength :: ByteString -> Int64
getLength = ByteString -> Int64
BSL.length
    {-# INLINE getLength #-}

-- | Mark a custom check as failed
checkFailed :: Monad m => e -> ValidationT e m a
checkFailed :: e -> ValidationT e m a
checkFailed = ExceptT e m a -> ValidationT e m a
forall e (m :: * -> *) a. ExceptT e m a -> ValidationT e m a
ValidationT (ExceptT e m a -> ValidationT e m a)
-> (e -> ExceptT e m a) -> e -> ValidationT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ExceptT e m a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
{-# INLINE checkFailed #-}

-- | Check that the value is at least N elements long
minLength :: (Monad m, HasLength a) => Int64 -> e -> ValidationRuleT e m a
minLength :: Int64 -> e -> ValidationRuleT e m a
minLength Int64
lowerBound e
e a
obj = Int64 -> e -> ValidationRuleT e m Int64
forall (m :: * -> *) a e.
(Monad m, Ord a) =>
a -> e -> ValidationRuleT e m a
largerThan Int64
lowerBound e
e (a -> Int64
forall a. HasLength a => a -> Int64
getLength a
obj) ValidationT e m Int64 -> ValidationT e m a -> ValidationT e m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ValidationRuleT e m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
obj
{-# INLINE minLength #-}

-- | Check that the value is at maxium N elements long
maxLength :: (Monad m, HasLength a) => Int64 -> e -> ValidationRuleT e m a
maxLength :: Int64 -> e -> ValidationRuleT e m a
maxLength Int64
upperBound e
e a
obj =
    Int64 -> e -> ValidationRuleT e m Int64
forall (m :: * -> *) a e.
(Monad m, Ord a) =>
a -> e -> ValidationRuleT e m a
smallerThan Int64
upperBound e
e (a -> Int64
forall a. HasLength a => a -> Int64
getLength a
obj) ValidationT e m Int64 -> ValidationT e m a -> ValidationT e m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ValidationRuleT e m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
obj
{-# INLINE maxLength #-}

-- | Check that the value's length is between N and M
lengthBetween :: (Monad m, HasLength a) => Int64 -> Int64 -> e -> ValidationRuleT e m a
lengthBetween :: Int64 -> Int64 -> e -> ValidationRuleT e m a
lengthBetween Int64
lowerBound Int64
upperBound e
e a
obj = Int64 -> Int64 -> e -> ValidationRuleT e m Int64
forall (m :: * -> *) a e.
(Monad m, Ord a) =>
a -> a -> e -> ValidationRuleT e m a
valueBetween Int64
lowerBound Int64
upperBound e
e (a -> Int64
forall a. HasLength a => a -> Int64
getLength a
obj) ValidationT e m Int64 -> ValidationT e m a -> ValidationT e m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ValidationRuleT e m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
obj
{-# INLINE lengthBetween #-}

-- | Specialized minLength with N = 1
notEmpty :: (Monad m, HasLength a) => e -> ValidationRuleT e m a
notEmpty :: e -> ValidationRuleT e m a
notEmpty = Int64 -> e -> ValidationRuleT e m a
forall (m :: * -> *) a e.
(Monad m, HasLength a) =>
Int64 -> e -> ValidationRuleT e m a
minLength Int64
1
{-# INLINE notEmpty #-}

-- | Check that a value is larger than N
largerThan :: (Monad m, Ord a) => a -> e -> ValidationRuleT e m a
largerThan :: a -> e -> ValidationRuleT e m a
largerThan a
lowerBound = (a -> Bool) -> e -> ValidationRuleT e m a
forall (m :: * -> *) a e.
Monad m =>
(a -> Bool) -> e -> ValidationRuleT e m a
conformsPred (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
lowerBound)
{-# INLINE largerThan #-}

-- | Check that a value is smaller than N
smallerThan :: (Monad m, Ord a) => a -> e -> ValidationRuleT e m a
smallerThan :: a -> e -> ValidationRuleT e m a
smallerThan a
upperBound = (a -> Bool) -> e -> ValidationRuleT e m a
forall (m :: * -> *) a e.
Monad m =>
(a -> Bool) -> e -> ValidationRuleT e m a
conformsPred (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
upperBound)
{-# INLINE smallerThan #-}

-- | Check that a value is between M and N
valueBetween :: (Monad m, Ord a) => a -> a -> e -> ValidationRuleT e m a
valueBetween :: a -> a -> e -> ValidationRuleT e m a
valueBetween a
lowerBound a
upperBound e
e = a -> e -> ValidationRuleT e m a
forall (m :: * -> *) a e.
(Monad m, Ord a) =>
a -> e -> ValidationRuleT e m a
largerThan a
lowerBound e
e ValidationRuleT e m a
-> ValidationRuleT e m a -> ValidationRuleT e m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> e -> ValidationRuleT e m a
forall (m :: * -> *) a e.
(Monad m, Ord a) =>
a -> e -> ValidationRuleT e m a
smallerThan a
upperBound e
e
{-# INLINE valueBetween #-}

-- | Checks that a value matches a regular expression
matchesRegex :: (ConvertibleStrings SBS a, ConvertibleStrings a SBS, Monad m) => Regex -> e -> ValidationRuleT e m a
matchesRegex :: Regex -> e -> ValidationRuleT e m a
matchesRegex Regex
r = (a -> Bool) -> e -> ValidationRuleT e m a
forall (m :: * -> *) a e.
Monad m =>
(a -> Bool) -> e -> ValidationRuleT e m a
conformsPred (a -> Regex -> Bool
forall a.
(ConvertibleStrings ByteString a,
 ConvertibleStrings a ByteString) =>
a -> Regex -> Bool
=~ Regex
r)
{-# INLINE matchesRegex #-}

-- | Check that a value conforms a predicate
conformsPred :: Monad m => (a -> Bool) -> e -> ValidationRuleT e m a
conformsPred :: (a -> Bool) -> e -> ValidationRuleT e m a
conformsPred a -> Bool
predicate e
e a
obj = Bool -> ValidationT e m () -> ValidationT e m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a -> Bool
predicate a
obj) (e -> ValidationT e m ()
forall (m :: * -> *) e a. Monad m => e -> ValidationT e m a
checkFailed e
e) ValidationT e m () -> ValidationT e m a -> ValidationT e m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ValidationRuleT e m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
obj
{-# INLINE conformsPred #-}

-- | Check that a value conforms a predicate
conformsPredM :: Monad m => (a -> m Bool) -> e -> ValidationRuleT e m a
conformsPredM :: (a -> m Bool) -> e -> ValidationRuleT e m a
conformsPredM a -> m Bool
predicate e
e a
obj =
    do Bool
res <- m Bool -> ValidationT e m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ValidationT e m Bool) -> m Bool -> ValidationT e m Bool
forall a b. (a -> b) -> a -> b
$ a -> m Bool
predicate a
obj
       Bool -> ValidationT e m () -> ValidationT e m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
res (e -> ValidationT e m ()
forall (m :: * -> *) e a. Monad m => e -> ValidationT e m a
checkFailed e
e) ValidationT e m () -> ValidationT e m a -> ValidationT e m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ValidationRuleT e m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
obj
{-# INLINE conformsPredM #-}

-- | Check that an optional value is actually set to 'Just a'
requiredValue :: Monad m => e -> TransValidationRuleT e m (Maybe a) a
requiredValue :: e -> TransValidationRuleT e m (Maybe a) a
requiredValue = (Maybe a -> Maybe a) -> e -> TransValidationRuleT e m (Maybe a) a
forall (m :: * -> *) a b e.
Monad m =>
(a -> Maybe b) -> e -> TransValidationRuleT e m a b
conformsPredTrans Maybe a -> Maybe a
forall a. a -> a
id
{-# INLINE requiredValue #-}

-- | Check that a list is not empty
nonEmptyList :: Monad m => e -> TransValidationRuleT e m [a] (NEL.NonEmpty a)
nonEmptyList :: e -> TransValidationRuleT e m [a] (NonEmpty a)
nonEmptyList = ([a] -> Maybe (NonEmpty a))
-> e -> TransValidationRuleT e m [a] (NonEmpty a)
forall (m :: * -> *) a b e.
Monad m =>
(a -> Maybe b) -> e -> TransValidationRuleT e m a b
conformsPredTrans [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty
{-# INLINE nonEmptyList #-}

-- | Do some check returning 'Nothing' if the value is invalid and 'Just a' otherwise.
conformsPredTrans :: Monad m => (a -> Maybe b) -> e -> TransValidationRuleT e m a b
conformsPredTrans :: (a -> Maybe b) -> e -> TransValidationRuleT e m a b
conformsPredTrans a -> Maybe b
f e
e a
obj =
    case a -> Maybe b
f a
obj of
      Maybe b
Nothing -> e -> ValidationT e m b
forall (m :: * -> *) e a. Monad m => e -> ValidationT e m a
checkFailed e
e
      Just b
val -> b -> ValidationT e m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
val
{-# INLINE conformsPredTrans #-}

-- | Do some check returning 'Nothing' if the value is invalid and 'Just a' otherwise.
conformsPredTransM :: Monad m => (a -> m (Maybe b)) -> e -> TransValidationRuleT e m a b
conformsPredTransM :: (a -> m (Maybe b)) -> e -> TransValidationRuleT e m a b
conformsPredTransM a -> m (Maybe b)
f e
e a
obj =
    do Maybe b
res <- m (Maybe b) -> ValidationT e m (Maybe b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe b) -> ValidationT e m (Maybe b))
-> m (Maybe b) -> ValidationT e m (Maybe b)
forall a b. (a -> b) -> a -> b
$ a -> m (Maybe b)
f a
obj
       case Maybe b
res of
         Maybe b
Nothing -> e -> ValidationT e m b
forall (m :: * -> *) e a. Monad m => e -> ValidationT e m a
checkFailed e
e
         Just b
val -> b -> ValidationT e m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
val
{-# INLINE conformsPredTransM #-}