module Data.Validator
(
ValidationM, ValidationT
, ValidationRule, ValidationRuleT
, TransValidationRule, TransValidationRuleT
, runValidator, runValidatorT
, (>=>), (<=<)
, minLength, maxLength, lengthBetween, notEmpty
, largerThan, smallerThan, valueBetween
, matchesRegex
, conformsPred, conformsPredM
, requiredValue, nonEmptyList
, conformsPredTrans, conformsPredTransM
, HasLength(..), ConvertibleStrings(..)
, Int64
, re, mkRegexQQ, Regex
)
where
import Control.Applicative
import Control.Monad
import Control.Monad.Identity
import Control.Monad.Trans
import Control.Monad.Trans.Either
import Data.Int
import Data.String.Conversions
import Text.Regex.PCRE.Heavy
import qualified Data.List.NonEmpty as NEL
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
type ValidationM e = ValidationT e Identity
newtype ValidationT e m a
= ValidationT { unValidationT :: EitherT e m a }
deriving (Monad, Functor, Applicative, Alternative, MonadPlus, MonadTrans)
runValidator :: TransValidationRule e a b -> a -> Either e b
runValidator a b = runIdentity $ runValidatorT a b
runValidatorT :: Monad m => TransValidationRuleT e m a b -> a -> m (Either e b)
runValidatorT validationSteps input =
runEitherT $ unValidationT (validationSteps input)
type ValidationRule e a = ValidationRuleT e Identity a
type ValidationRuleT e m a = TransValidationRuleT e m a a
type TransValidationRule e a b = TransValidationRuleT e Identity a b
type TransValidationRuleT e m a b = a -> ValidationT e m b
class HasLength a where
getLength :: a -> Int64
instance HasLength [a] where
getLength = fromIntegral . length
instance HasLength T.Text where
getLength = fromIntegral . T.length
instance HasLength TL.Text where
getLength = TL.length
instance HasLength BS.ByteString where
getLength = fromIntegral . BS.length
instance HasLength BSL.ByteString where
getLength = BSL.length
checkFailed :: Monad m => e -> ValidationT e m a
checkFailed = ValidationT . left
minLength :: (Monad m, HasLength a) => Int64 -> e -> ValidationRuleT e m a
minLength lowerBound e obj = largerThan lowerBound e (getLength obj) >> return obj
maxLength :: (Monad m, HasLength a) => Int64 -> e -> ValidationRuleT e m a
maxLength upperBound e obj =
smallerThan upperBound e (getLength obj) >> return obj
lengthBetween :: (Monad m, HasLength a) => Int64 -> Int64 -> e -> ValidationRuleT e m a
lengthBetween lowerBound upperBound e obj = valueBetween lowerBound upperBound e (getLength obj) >> return obj
notEmpty :: (Monad m, HasLength a) => e -> ValidationRuleT e m a
notEmpty = minLength 1
largerThan :: (Monad m, Ord a) => a -> e -> ValidationRuleT e m a
largerThan lowerBound = conformsPred (>= lowerBound)
smallerThan :: (Monad m, Ord a) => a -> e -> ValidationRuleT e m a
smallerThan upperBound = conformsPred (<= upperBound)
valueBetween :: (Monad m, Ord a) => a -> a -> e -> ValidationRuleT e m a
valueBetween lowerBound upperBound e = largerThan lowerBound e >=> smallerThan upperBound e
matchesRegex :: (ConvertibleStrings SBS a, ConvertibleStrings a SBS, Monad m) => Regex -> e -> ValidationRuleT e m a
matchesRegex r = conformsPred (=~ r)
conformsPred :: Monad m => (a -> Bool) -> e -> ValidationRuleT e m a
conformsPred predicate e obj = unless (predicate obj) (checkFailed e) >> return obj
conformsPredM :: Monad m => (a -> m Bool) -> e -> ValidationRuleT e m a
conformsPredM predicate e obj =
do res <- lift $ predicate obj
unless res (checkFailed e) >> return obj
requiredValue :: Monad m => e -> TransValidationRuleT e m (Maybe a) a
requiredValue = conformsPredTrans id
nonEmptyList :: Monad m => e -> TransValidationRuleT e m [a] (NEL.NonEmpty a)
nonEmptyList = conformsPredTrans NEL.nonEmpty
conformsPredTrans :: Monad m => (a -> Maybe b) -> e -> TransValidationRuleT e m a b
conformsPredTrans f e obj =
case f obj of
Nothing -> checkFailed e
Just val -> return val
conformsPredTransM :: Monad m => (a -> m (Maybe b)) -> e -> TransValidationRuleT e m a b
conformsPredTransM f e obj =
do res <- lift $ f obj
case res of
Nothing -> checkFailed e
Just val -> return val