Copyright | © 2018 Luka Hadžiegrić |
---|---|
License | MIT |
Maintainer | Luka Hadžiegrić <reygoch@gmail.com> |
Stability | experimental |
Portability | portable |
Safe Haskell | Safe |
Language | Haskell2010 |
This module provides a general way for validating data. It was inspired by
forma
and digestive-functors
and some of their shortcomings.
In short, approach taken by the Valor
is to try and parse the error from the
data instead of data from some fixed structured format like the JSON.
Main feature of Valor
is that you are not forced to use specific input type
like JSON, or to use specific output type like 'digestive-functors' View
.
You can use what ever you like as an input and use custom error type as the
output (although it does have to follow a specific format).
To use Valor
you first need to have some "input" data type that you want to
validate and an "error" data type that will store validation errors of your
data. Although the "shapes" of your input and error data types can differ, in the
most common use case your input and error would be of the same shape.
Here is an example:
data Article = Article { id :: Int , title :: String , content :: String , tags :: [String] , author :: User } deriving ( Show ) data ArticleError = ArticleError { id :: Maybe String -- ^ here I've intended for 'id' to have only one error message , title :: Maybe [String] -- ^ for 'title' field there might be many error messages , content :: Maybe [String] , tags :: Maybe [Maybe [String]] -- ^ here every 'tag' can have multiple error messages (or none) , author :: Maybe UserError -- ^ here we have a possible 'UserError' in case validation fails } deriving ( Show ) -- data User = User { username :: String } deriving ( Show ) data UserError = UserError { username :: Maybe [String] } deriving ( Show )
You might think that this will introduce a lot of duplicated code, and you are
right! But there is a solution. If you do not need the flexibility of this first
approach, you can use provided Validatable
type family to ease the pain (or
even write your own type family, Valor
doesn't care).
So, here is how the above code would look if we were to use type families:
{# LANGUAGE FlexibleInstances #} {# LANGUAGE StandaloneDeriving #} {# LANGUAGE TypeSynonymInstances #} -- data Article' a = Article { id :: Validatable a String Int , title :: Validatable a [String] String , content :: Validatable a [String] String , tags :: Validatable a [Maybe [String]] [String] , author :: Validatable a (User' a) (User' a) } type Article = Article' Identity deriving instance Show Article type ArticleError = Article' Validate deriving instance Show ArticleError -- data User' a = User { username :: Validatable a [String] String } type User = User' Identity deriving instance Show User type UserError = User' Validate deriving instance Show UserError
As you can see, we have to enable a couple of language extensions to allow us type class derivation with this approach.
Validatable
is basically a type level function that takes three arguments and
returns a type.
- First argument has kind
* -> *
which means it is a type that takes another type as an argument to make a concrete type. One common example of this isMaybe
. In this case however, we can pass inIdentity
toArticle'
to create our "value/input" type andValidate
to create our "error" type. If we pass in any other type it will just get applied to the third argument (which is basic field value of our input type). - Second argument is the type we want to use for storing error(s). This will be
the resulting type of
Validatable
but wrapped inMaybe
if we applyValidate
. - Third argument is the basic value type for the field of our input type. This
will be the resulting type in case we apply
Identity
- data Validator i m e
- skip :: Applicative m => Validator i m (Maybe e)
- check :: forall i x m e. (Functor m, Monoid e) => (i -> x) -> (x -> ExceptT e m x) -> Validator i m (Maybe e)
- checks :: forall i x m e. (Applicative m, Monoid e, Semigroup e) => (i -> x) -> [x -> ExceptT e m x] -> Validator i m (Maybe e)
- mapCheck :: forall i f x m e. (Traversable f, Monad m, Monoid e) => (i -> f x) -> (x -> ExceptT e m x) -> Validator i m (Maybe (f (Maybe e)))
- mapChecks :: forall i f x m e. (Monad m, Monoid e, Traversable f, Semigroup (f (Maybe e))) => (i -> f x) -> [x -> ExceptT e m x] -> Validator i m (Maybe (f (Maybe e)))
- subValidator :: forall i x m e. Functor m => (i -> x) -> Validator x m e -> Validator i m (Maybe e)
- mapSubValidator :: forall i f x m e. (Monad m, Traversable f) => (i -> f x) -> Validator x m e -> Validator i m (Maybe (f (Maybe e)))
- validate :: Functor m => Validator i m e -> i -> m (Maybe e)
- validatePure :: Validator i Identity e -> i -> Maybe e
- data Validate a
- type family Validatable a e x where ...
- newtype Identity a :: * -> * = Identity {
- runIdentity :: a
- data ExceptT e (m :: * -> *) a :: * -> (* -> *) -> * -> *
- runExceptT :: ExceptT e m a -> m (Either e a)
- throwE :: Monad m => e -> ExceptT e m a
Constructing a Validator
Now that we have defined our input and error data types we can start
constructing a Validator
for our data. In essence validator is just a function
that takes in an input i
and returns an error e
wrapped in a monad m
if
your input was invalid.
Validator
is an Applicative
and you can construct a new one by using
functions: skip
, check
, mapCheck
, checks
, mapChecks
, subValidator
and mapSubValidator
. Those functions have to be provided with actual checks to
perform, and we define a single check by using ExceptT
, so let's create some
simple checks to perform on our data:
over18 :: Monad m => Int -> ExceptT String m Int over18 n | n < 18 = throwE "must be over 18" | otherwise = pure n nonempty :: Monad m => String -> ExceptT [String] m String nonempty s | length s == 0 = throwE ["can't be empty"] | otherwise = pure s nonbollocks :: Monad m => String -> ExceptT [String] m String nonbollocks s | s == "bollocks" = throwE ["can't be bollocks"] | otherwise = pure s nonshort :: Monad m => String -> ExceptT [String] m String nonshort s = if length s < 10 then throwE ["too short"] else pure s
With this we can finally create Validator
s for our User
and Article
data
types:
articleValidator :: Monad m => Validator Article m ArticleError articleValidator = Article <$> check id over18 <*> checks title [nonempty, nonbollocks] <*> checks content [nonempty, nonbollocks, nonshort] <*> mapChecks tags [nonempty, nonbollocks] <*> subValidator author userValidator userValidator :: Monad m => Validator User m UserError userValidator = User <$> checks username [nonempty, nonbollocks]
:: Applicative m | |
=> Validator i m (Maybe e) | just a dummy validator that always succeeds. |
skip
is used when you are not interested in validating certain fields.
:: (Functor m, Monoid e) | |
=> (i -> x) | field selector |
-> (x -> ExceptT e m x) | check to be performed |
-> Validator i m (Maybe e) | resulting validator |
Check if a single condition is satisfied.
:: (Applicative m, Monoid e, Semigroup e) | |
=> (i -> x) | field selector |
-> [x -> ExceptT e m x] | list of checks |
-> Validator i m (Maybe e) | resulting validator |
Check if mutiple conditions are satisfied.
:: (Traversable f, Monad m, Monoid e) | |
=> (i -> f x) | field selector |
-> (x -> ExceptT e m x) | check to be performed |
-> Validator i m (Maybe (f (Maybe e))) | resulting validator |
Apply a single check to multiple values within Traversable
structure.
:: (Monad m, Monoid e, Traversable f, Semigroup (f (Maybe e))) | |
=> (i -> f x) | field selector |
-> [x -> ExceptT e m x] | list of checks |
-> Validator i m (Maybe (f (Maybe e))) | resulting validator |
Apply a multiple checks to values within Traversable
structure.
:: Functor m | |
=> (i -> x) | field selector |
-> Validator x m e |
|
-> Validator i m (Maybe e) | resulting |
Apply a Validator
instead of check to the field. This is useful when
validating nested records.
Validating the data
:: Functor m | |
=> Validator i m e |
|
-> i | value that is being validated |
-> m (Maybe e) | final result wrapped in a monad of our choosing |
Once you have constructed your Validator
you can run it against your
input data. If there were no validation errors you will get Nothing
wrapped
in a monad of your choice as a result.
Here is the result of running articleValidator
against some bad data:
badArticle :: Article badArticle = Article { id = 17 , title = "Some interesting title" , content = "bollocks" , tags = ["I'm ok", "me too", "bollocks"] , author = badUser } badUser :: User badUser = User ""
>>> validatePure articleValidator badArticle Just ( Article { id = Just "must be over 18" , title = Nothing , content = Just ["can't be bollocks","too short"] , tags = Just [Nothing,Nothing,Just ["can't be bollocks"]] , author = Just (User {username = Just ["can't be empty"]}) } )
Utilities
Tag used with type family to tell the compiler that we are constructing the "error" record.
type family Validatable a e x where ... Source #
A simple type family used for constructing your data structure.
Validatable Validate e x = Maybe e | |
Validatable Identity e x = x | |
Validatable a e x = a x |
Convenient re-exports
newtype Identity a :: * -> * #
Identity functor and monad. (a non-strict monad)
Since: 4.8.0.0
Identity | |
|
Monad Identity | Since: 4.8.0.0 |
Functor Identity | Since: 4.8.0.0 |
MonadFix Identity | Since: 4.8.0.0 |
Applicative Identity | Since: 4.8.0.0 |
Foldable Identity | Since: 4.8.0.0 |
Traversable Identity | |
Eq1 Identity | Since: 4.9.0.0 |
Ord1 Identity | Since: 4.9.0.0 |
Read1 Identity | Since: 4.9.0.0 |
Show1 Identity | Since: 4.9.0.0 |
Bounded a => Bounded (Identity a) | |
Enum a => Enum (Identity a) | |
Eq a => Eq (Identity a) | |
Floating a => Floating (Identity a) | |
Fractional a => Fractional (Identity a) | |
Integral a => Integral (Identity a) | |
Num a => Num (Identity a) | |
Ord a => Ord (Identity a) | |
Read a => Read (Identity a) | This instance would be equivalent to the derived instances of the
Since: 4.8.0.0 |
Real a => Real (Identity a) | |
RealFloat a => RealFloat (Identity a) | |
RealFrac a => RealFrac (Identity a) | |
Show a => Show (Identity a) | This instance would be equivalent to the derived instances of the
Since: 4.8.0.0 |
Ix a => Ix (Identity a) | |
Generic (Identity a) | |
Semigroup a => Semigroup (Identity a) | Since: 4.9.0.0 |
Monoid a => Monoid (Identity a) | |
Storable a => Storable (Identity a) | |
Bits a => Bits (Identity a) | |
FiniteBits a => FiniteBits (Identity a) | |
Generic1 * Identity | |
type Rep (Identity a) | |
type Rep1 * Identity | |
data ExceptT e (m :: * -> *) a :: * -> (* -> *) -> * -> * #
A monad transformer that adds exceptions to other monads.
ExceptT
constructs a monad parameterized over two things:
- e - The exception type.
- m - The inner monad.
The return
function yields a computation that produces the given
value, while >>=
sequences two subcomputations, exiting on the
first exception.
MonadTrans (ExceptT e) | |
Monad m => Monad (ExceptT e m) | |
Functor m => Functor (ExceptT e m) | |
MonadFix m => MonadFix (ExceptT e m) | |
MonadFail m => MonadFail (ExceptT e m) | |
(Functor m, Monad m) => Applicative (ExceptT e m) | |
Foldable f => Foldable (ExceptT e f) | |
Traversable f => Traversable (ExceptT e f) | |
(Eq e, Eq1 m) => Eq1 (ExceptT e m) | |
(Ord e, Ord1 m) => Ord1 (ExceptT e m) | |
(Read e, Read1 m) => Read1 (ExceptT e m) | |
(Show e, Show1 m) => Show1 (ExceptT e m) | |
MonadZip m => MonadZip (ExceptT e m) | |
MonadIO m => MonadIO (ExceptT e m) | |
(Functor m, Monad m, Monoid e) => Alternative (ExceptT e m) | |
(Monad m, Monoid e) => MonadPlus (ExceptT e m) | |
(Eq e, Eq1 m, Eq a) => Eq (ExceptT e m a) | |
(Ord e, Ord1 m, Ord a) => Ord (ExceptT e m a) | |
(Read e, Read1 m, Read a) => Read (ExceptT e m a) | |
(Show e, Show1 m, Show a) => Show (ExceptT e m a) | |
runExceptT :: ExceptT e m a -> m (Either e a) #
The inverse of ExceptT
.