Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- validate :: (Validatable e m a, Functor m) => Unvalidated a -> m (Either (Seq e) a)
- validate' :: Validatable e Identity a => Unvalidated a -> Either (Seq e) a
- newtype CheckChain (e :: Type) (m :: Type -> Type) (a :: Type) = CheckChain {
- runCheckChain :: [Check e m a]
- overChain :: (Check e m a -> Check e' n b) -> CheckChain e m a -> CheckChain e' n b
- (+?+) :: CheckChain e m a -> CheckChain e m a -> CheckChain e m a
- singleChain :: Check e m a -> CheckChain e m a
- class Validatable (e :: Type) (m :: Type -> Type) (a :: Type) | a -> m, a -> e where
- checkChain :: CheckChain e m a
- defaultCheck :: Check e m a
- isValid :: Unvalidated a -> m Bool
- newtype TrivialCheck a = TrivialCheck {
- unTrivialCheck :: a
Checkable
The Validatable
typeclass.
Note: It is not inteded to be used for testing of
internal integrity of types, i.e. it does not check if a Text
has a valid internal
representation. For testing internal integrity please use the package
(validity)[https:/stackage.orgpackage/validity].
The typeclass is split up into three parts:
checkChain
: A list of checks that will be performed in that order. This has to be provided to give an instance. For the reason why it is given as a list and the checks are not combined via '(<>)', see the point forisValid
.defaulCheck
: A check performing all checks ofcheckChain
defaultCheck = fold checkChain
isValid
: A function determining whether a value is valid. This functions stops checking after the first of the checks fromcheckChain
fails .This function is the reason why we need thecheckChain
, as aCheck
constructed by '(<>)' goes through all operands, so `passed $ runCheck (shortCheck <> longCheck) unvalidatedInput` evalutes the argument withlongCheck
even ifshortCheck
failed. But if we define
instance Validatable e m T where checkChain = CheckChain [ shortCheck, longCheck ]
then `isValid unvalidatedInput` stops after shortCheck
failed.
validate :: (Validatable e m a, Functor m) => Unvalidated a -> m (Either (Seq e) a) Source #
validate' :: Validatable e Identity a => Unvalidated a -> Either (Seq e) a Source #
These are the functions used to validate data. Return either a validated result or a sequence of all validation errors that occured.
newtype CheckChain (e :: Type) (m :: Type -> Type) (a :: Type) Source #
CheckChain | |
|
Instances
overChain :: (Check e m a -> Check e' n b) -> CheckChain e m a -> CheckChain e' n b Source #
(+?+) :: CheckChain e m a -> CheckChain e m a -> CheckChain e m a infixr 5 Source #
Convenience synonym.
singleChain :: Check e m a -> CheckChain e m a Source #
Constructs a chain with only one check.
class Validatable (e :: Type) (m :: Type -> Type) (a :: Type) | a -> m, a -> e where Source #
Nothing
checkChain :: CheckChain e m a Source #
checkChain :: (Generic a, GValidatable e m (Rep a)) => CheckChain e m a Source #
defaultCheck :: Check e m a Source #
defaultCheck :: Applicative m => Check e m a Source #
isValid :: Unvalidated a -> m Bool Source #
isValid :: Applicative m => Unvalidated a -> m Bool Source #
Instances
newtype TrivialCheck a Source #
Instances
Validatable Void Identity (TrivialCheck a) Source # | |
Defined in Control.Validation.Class checkChain :: CheckChain Void Identity (TrivialCheck a) Source # defaultCheck :: Check Void Identity (TrivialCheck a) Source # isValid :: Unvalidated (TrivialCheck a) -> Identity Bool Source # |
Helper for deriving Validatable
Helper for deriving Validatable
Intended for use with `-XDerivingVia` like
data X = X Int deriving (Validatable Void Identity) via (TrivialCheck X) -- or with `-XStandaloneDeriving` data Y = Y String deriving via (TrivialCheck Y) instance (Validatable Void Identity Y)