valida 0.1.0 → 1.0.0
raw patch · 10 files changed
+734/−700 lines, 10 filesdep +profunctorsdep ~basedep ~smallcheckPVP ok
version bump matches the API change (PVP)
Dependencies added: profunctors
Dependency ranges changed: base, smallcheck
API changes (from Hackage documentation)
- Valida: (<??>) :: Validator x inp a -> e -> Validator e inp a
- Valida: data ValidationRule e a
- Valida: labelV :: e -> Validator x inp a -> Validator e inp a
- Valida: type Selector a b = a -> b
- Valida: validate :: ValidationRule e a -> Validator e a a
- Valida: vrule :: (a -> Validation e ()) -> ValidationRule e a
- Valida.Combinators: falseRule :: Monoid e => ValidationRule e a
- Valida.Combinators: negateRule :: e -> ValidationRule e1 a -> ValidationRule e a
- Valida.Combinators: negateRule' :: ValidationRule e a -> ValidationRule () a
+ Valida: fixV :: Validator e a x -> Validator e a a
+ Valida.Combinators: failV :: Monoid e => Validator e inp a
+ Valida.Combinators: negateV :: e -> Validator e1 a x -> Validator e a a
+ Valida.Combinators: negateV' :: Validator e a x -> Validator () a a
- Valida: (-?>) :: Selector a b -> ValidationRule e b -> Validator e a b
+ Valida: (-?>) :: (a -> b) -> Validator e b x -> Validator e a x
- Valida: (<?>) :: ValidationRule x a -> e -> ValidationRule e a
+ Valida: (<?>) :: Validator x inp a -> e -> Validator e inp a
- Valida: infix 6 <??>
+ Valida: infix 6 <?>
- Valida: label :: e -> ValidationRule x a -> ValidationRule e a
+ Valida: label :: e -> Validator x inp a -> Validator e inp a
- Valida: verify :: ValidationRule e b -> Selector a b -> Validator e a b
+ Valida: verify :: Validator e b x -> (a -> b) -> Validator e a x
- Valida.Combinators: (</>) :: Semigroup e => ValidationRule e a -> ValidationRule e a -> ValidationRule e a
+ Valida.Combinators: (</>) :: Semigroup e => Validator e inp a -> Validator e inp a -> Validator e inp a
- Valida.Combinators: andAlso :: ValidationRule e a -> ValidationRule e a -> ValidationRule e a
+ Valida.Combinators: andAlso :: Validator e inp a -> Validator e inp a -> Validator e inp a
- Valida.Combinators: atleastContains :: Foldable t => (a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
+ Valida.Combinators: atleastContains :: Foldable t => (a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
- Valida.Combinators: atleastContains' :: Foldable t => (a -> Bool) -> ValidationRule () (t a)
+ Valida.Combinators: atleastContains' :: Foldable t => (a -> Bool) -> Validator () (t a) (t a)
- Valida.Combinators: failureIf :: (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
+ Valida.Combinators: failureIf :: (a -> Bool) -> e -> Validator (NonEmpty e) a a
- Valida.Combinators: failureIf' :: (a -> Bool) -> ValidationRule () a
+ Valida.Combinators: failureIf' :: (a -> Bool) -> Validator () a a
- Valida.Combinators: failureUnless :: (a -> Bool) -> e -> ValidationRule (NonEmpty e) a
+ Valida.Combinators: failureUnless :: (a -> Bool) -> e -> Validator (NonEmpty e) a a
- Valida.Combinators: failureUnless' :: (a -> Bool) -> ValidationRule () a
+ Valida.Combinators: failureUnless' :: (a -> Bool) -> Validator () a a
- Valida.Combinators: lengthAbove :: Foldable t => Int -> e -> ValidationRule (NonEmpty e) (t a)
+ Valida.Combinators: lengthAbove :: Foldable t => Int -> e -> Validator (NonEmpty e) (t a) (t a)
- Valida.Combinators: lengthAbove' :: Foldable t => Int -> ValidationRule () (t a)
+ Valida.Combinators: lengthAbove' :: Foldable t => Int -> Validator () (t a) (t a)
- Valida.Combinators: lengthBelow :: Foldable t => Int -> e -> ValidationRule (NonEmpty e) (t a)
+ Valida.Combinators: lengthBelow :: Foldable t => Int -> e -> Validator (NonEmpty e) (t a) (t a)
- Valida.Combinators: lengthBelow' :: Foldable t => Int -> ValidationRule () (t a)
+ Valida.Combinators: lengthBelow' :: Foldable t => Int -> Validator () (t a) (t a)
- Valida.Combinators: lengthWithin :: Foldable t => (Int, Int) -> e -> ValidationRule (NonEmpty e) (t a)
+ Valida.Combinators: lengthWithin :: Foldable t => (Int, Int) -> e -> Validator (NonEmpty e) (t a) (t a)
- Valida.Combinators: lengthWithin' :: Foldable t => (Int, Int) -> ValidationRule () (t a)
+ Valida.Combinators: lengthWithin' :: Foldable t => (Int, Int) -> Validator () (t a) (t a)
- Valida.Combinators: maxLengthOf :: Foldable t => Int -> e -> ValidationRule (NonEmpty e) (t a)
+ Valida.Combinators: maxLengthOf :: Foldable t => Int -> e -> Validator (NonEmpty e) (t a) (t a)
- Valida.Combinators: maxLengthOf' :: Foldable t => Int -> ValidationRule () (t a)
+ Valida.Combinators: maxLengthOf' :: Foldable t => Int -> Validator () (t a) (t a)
- Valida.Combinators: maxValueOf :: Ord a => a -> e -> ValidationRule (NonEmpty e) a
+ Valida.Combinators: maxValueOf :: Ord a => a -> e -> Validator (NonEmpty e) a a
- Valida.Combinators: maxValueOf' :: Ord a => a -> ValidationRule () a
+ Valida.Combinators: maxValueOf' :: Ord a => a -> Validator () a a
- Valida.Combinators: minLengthOf :: Foldable t => Int -> e -> ValidationRule (NonEmpty e) (t a)
+ Valida.Combinators: minLengthOf :: Foldable t => Int -> e -> Validator (NonEmpty e) (t a) (t a)
- Valida.Combinators: minLengthOf' :: Foldable t => Int -> ValidationRule () (t a)
+ Valida.Combinators: minLengthOf' :: Foldable t => Int -> Validator () (t a) (t a)
- Valida.Combinators: minValueOf :: Ord a => a -> e -> ValidationRule (NonEmpty e) a
+ Valida.Combinators: minValueOf :: Ord a => a -> e -> Validator (NonEmpty e) a a
- Valida.Combinators: minValueOf' :: Ord a => a -> ValidationRule () a
+ Valida.Combinators: minValueOf' :: Ord a => a -> Validator () a a
- Valida.Combinators: mustBe :: Eq a => a -> e -> ValidationRule (NonEmpty e) a
+ Valida.Combinators: mustBe :: Eq a => a -> e -> Validator (NonEmpty e) a a
- Valida.Combinators: mustBe' :: Eq a => a -> ValidationRule () a
+ Valida.Combinators: mustBe' :: Eq a => a -> Validator () a a
- Valida.Combinators: mustContain :: (Foldable t, Eq a) => a -> e -> ValidationRule (NonEmpty e) (t a)
+ Valida.Combinators: mustContain :: (Foldable t, Eq a) => a -> e -> Validator (NonEmpty e) (t a) (t a)
- Valida.Combinators: mustContain' :: (Foldable t, Eq a) => a -> ValidationRule () (t a)
+ Valida.Combinators: mustContain' :: (Foldable t, Eq a) => a -> Validator () (t a) (t a)
- Valida.Combinators: notEmpty :: Foldable t => e -> ValidationRule (NonEmpty e) (t a)
+ Valida.Combinators: notEmpty :: Foldable t => e -> Validator (NonEmpty e) (t a) (t a)
- Valida.Combinators: notEmpty' :: Foldable t => ValidationRule () (t a)
+ Valida.Combinators: notEmpty' :: Foldable t => Validator () (t a) (t a)
- Valida.Combinators: ofLength :: Foldable t => Int -> e -> ValidationRule (NonEmpty e) (t a)
+ Valida.Combinators: ofLength :: Foldable t => Int -> e -> Validator (NonEmpty e) (t a) (t a)
- Valida.Combinators: ofLength' :: Foldable t => Int -> ValidationRule () (t a)
+ Valida.Combinators: ofLength' :: Foldable t => Int -> Validator () (t a) (t a)
- Valida.Combinators: onlyContains :: Foldable t => (a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a)
+ Valida.Combinators: onlyContains :: Foldable t => (a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a)
- Valida.Combinators: onlyContains' :: Foldable t => (a -> Bool) -> ValidationRule () (t a)
+ Valida.Combinators: onlyContains' :: Foldable t => (a -> Bool) -> Validator () (t a) (t a)
- Valida.Combinators: optionally :: ValidationRule e a -> ValidationRule e (Maybe a)
+ Valida.Combinators: optionally :: Validator e a x -> Validator e (Maybe a) (Maybe a)
- Valida.Combinators: orElse :: Semigroup e => ValidationRule e a -> ValidationRule e a -> ValidationRule e a
+ Valida.Combinators: orElse :: Semigroup e => Validator e inp a -> Validator e inp a -> Validator e inp a
- Valida.Combinators: satisfyAll :: Foldable t => t (ValidationRule e a) -> ValidationRule e a
+ Valida.Combinators: satisfyAll :: Foldable t => t (Validator e inp a) -> Validator e inp a
- Valida.Combinators: satisfyAny :: (Foldable t, Semigroup e) => t (ValidationRule e a) -> ValidationRule e a
+ Valida.Combinators: satisfyAny :: (Foldable t, Semigroup e) => t (Validator e inp a) -> Validator e inp a
- Valida.Combinators: valueAbove :: Ord a => a -> e -> ValidationRule (NonEmpty e) a
+ Valida.Combinators: valueAbove :: Ord a => a -> e -> Validator (NonEmpty e) a a
- Valida.Combinators: valueAbove' :: Ord a => a -> ValidationRule () a
+ Valida.Combinators: valueAbove' :: Ord a => a -> Validator () a a
- Valida.Combinators: valueBelow :: Ord a => a -> e -> ValidationRule (NonEmpty e) a
+ Valida.Combinators: valueBelow :: Ord a => a -> e -> Validator (NonEmpty e) a a
- Valida.Combinators: valueBelow' :: Ord a => a -> ValidationRule () a
+ Valida.Combinators: valueBelow' :: Ord a => a -> Validator () a a
- Valida.Combinators: valueWithin :: Ord a => (a, a) -> e -> ValidationRule (NonEmpty e) a
+ Valida.Combinators: valueWithin :: Ord a => (a, a) -> e -> Validator (NonEmpty e) a a
- Valida.Combinators: valueWithin' :: Ord a => (a, a) -> ValidationRule () a
+ Valida.Combinators: valueWithin' :: Ord a => (a, a) -> Validator () a a
Files
- ChangeLog.md +23/−1
- README.md +87/−65
- src/Valida.hs +61/−61
- src/Valida/Combinators.hs +246/−214
- src/Valida/Validation.hs +11/−15
- src/Valida/ValidationRule.hs +0/−73
- src/Valida/ValidationUtils.hs +24/−18
- src/Valida/Validator.hs +72/−36
- test/Spec.hs +146/−154
- valida.cabal +64/−63
ChangeLog.md view
@@ -1,3 +1,25 @@ # Changelog for valida -## Unreleased changes +## 1.0.0 (Aug 24, 2021) +* Add `profunctors` dependency. +* Add `Profunctor` instance for `Validator`. +* Rework `Validator` semigroup instance. + + The new semigroup instance now works similar to the `ValidationRule` semigroup instance. +* Add `Monoid` instance for `Validator`. +* Remove `ValidationRule`. +* Remove `Selector` type alias. +* Rewrite all previous `ValidationRule` combinators to work with `Validator`s instead. +* Rename `negateRule` -> `negateV`. +* Rename `falseRule` -> `failV`. +* Add `fixV` - refer to the documentation for more information. +* Remove `validate` - no longer necessary. +* Rename `labelV` -> `label`. +* Rename `<??>` -> `<?>`. Infix precedence 6. +* Remove `label` and `<?>`. +* `verify` is now an alias to flipped `lmap` from `Data.Profunctor`, specialized for `Validator`s. +* Allow usage with base == 4.12 +* Explicitly constraint smallcheck dependency to 1.2.0+ + +## 0.1.0 (Aug 20, 2021) +Initial release.
README.md view
@@ -1,13 +1,16 @@ # Valida -Simple, elegant, applicative validation for product types - batteries included! +Simple, elegant, profunctorial, applicative validation for product types - batteries included! -Read the documentation on [hackage](). +Read the documentation on [hackage](https://hackage.haskell.org/package/valida). # Highlights -* Minimal - *Zero dependencies* apart from `base`. -* Batteries included - `ValidationRule` combinators for almost every scenario. -* Validation without the boiler plate - a highly specialized usage of contravariant functors to conveniently model the common validation usecases, without extra boilerplate. +* Minimal - **Singular** external dependency: profunctors. + If you'd like a more lightweight version. Checkout [valida-base](https://hackage.haskell.org/package/valida-base), which offers similar functionalites *without **any** external dependency*. +* Batteries included - `Validator` combinators for almost every scenario. +* Validation without the boiler plate - Implementation of contravariance to conveniently model the common validation usecases, without extra boilerplate. +* Profunctorial, Applicative Validator - Relating to the previous point, the provided `Validator` type is not only an applicative functor, but also a profunctor. This is what allows the contravariance on its input argument. + # Quick Taste ```hs import Data.List.NonEmpty (NonEmpty) @@ -34,7 +37,7 @@ | InvalidEmailLength deriving (Show) --- | Validator for each field in the input form - built using 'ValidationRule' combinators. +-- | Validator for each field in the input form - built using 'Validator' combinators. inpFormValidator :: Validator (NonEmpty FormErr) InputForm ValidInput inpFormValidator = ValidInput -- Name should be between 1 and 20 characters long @@ -54,35 +57,35 @@ main :: IO () main = do - print (runForm inpFormValidator goodInput) + print (runValidator inpFormValidator goodInput) -- Prints- Success (ValidInput {vInpName = "John Doe", vInpAge = 42, vInpEmail = Nothing}) - print (runForm inpFormValidator badInput) + print (runValidator inpFormValidator badInput) -- Prints- Failure (InvalidAge :| [InvalidEmailLength]) ``` You can also find more examples [here](./examples/Main.hs). # Quick Start -The primary purpose of the `Validator` type is to validate each field in product types. To do this, you'll use `verify`. +The primary purpose of the `Validator` type is to validate each field in product types. To do this, you'll use [`verify`](https://hackage.haskell.org/package/valida/docs/Valida.html#v:verify). `verify` takes 2 inputs- * The "selector", which essentially just takes the product type as input, and returns the specific value of the specific field to validate. -* The `ValidationRule`, which specifies the predicate the field must satisfy - as well as the error value to yield if it doesn't satisfy said predicate +* The `Validator`, which specifies the predicate the field must satisfy, the error value to yield if it doesn't satisfy said predicate, and the output upon successful validation. Let's validate a pair for example, the first field should be an int less than 10, the second field should be a non empty string. Then, the validator would look like- ```hs pairValidator :: Validator (NonEmpty String) (Int, String) (Int, String) pairValidator = (,) <$> verify (failureIf (>=10) "NotLessThan10") fst <*> verify (notEmpty "EmptyString") snd ``` -Or, if you prefer using operators - you can use `-?>`, which is a flipped version of `verify`. +Or, if you prefer using operators - you can use [`-?>`](https://hackage.haskell.org/package/valida/docs/Valida.html#v:-45--63--62-), which is a flipped version of `verify`. ```hs pairValidator :: Validator (NonEmpty String) (Int, String) (Int, String) pairValidator = (,) - <$> fst -?> failureUnless (<10) "NotLessThan10" + <$> fst -?> failureIf (>=10) "NotLessThan10" <*> snd -?> notEmpty "EmptyString" ``` -You can then run the validator on your input using `runValidator`- +You can then run the validator on your input using [`runValidator`](https://hackage.haskell.org/package/valida/docs/Valida.html#t:Validator)- ```hs >>> runValidator pairValidator (9, "foo") Success (9,"foo") @@ -92,91 +95,79 @@ Failure ("EmptyString" :| []) ``` -This is the core concept for building the validators. You can use the primitive combinators (e.g `failureIf`, `failureUnless`) to build `ValidationRule`s directly from predicate functions, or you can choose one of the many derivate combinators (e.g `notEmpty`) to build `ValidationRule`s. Check out the `Valida.Combinators` module documentation to view all the included combinators. - -## Validators for non product types -Although the primary purpose of `Valida` is building convenient validators for product types. Sometimes, you'll find yourself not needing to select on any field, but validating the input directly. In that case, you may find yourself using this pattern- -```hs --- | Make sure int input is not even. -intValidator :: Validator (NonEmpty String) Int Int -intValidator = verify (failureIf even "Even") id -``` +This is the core concept for building the validators. You can use the primitive combinators (e.g [`failureIf`](https://hackage.haskell.org/package/valida/docs/Valida-Combinators.html#v:failureIf), [`failureUnless`](https://hackage.haskell.org/package/valida/docs/Valida-Combinators.html#v:failureUnless)) to build `Validator`s directly from predicate functions, or you can choose one of the many derivate combinators (e.g [`notEmpty`](https://hackage.haskell.org/package/valida/docs/Valida-Combinators.html#v:notEmpty)) to build `Validator`s. Check out the [`Valida.Combinators`](https://hackage.haskell.org/package/valida/docs/Valida-Combinators.html) module documentation to view all the included combinators. -In these situations, instead of using `verify` with `id` as selector, you should use `validate` instead, which is the same as `flip verify id`- -```hs -intValidator :: Validator (NonEmpty String) Int Int -intValidator = validate (failureIf even "Even") -``` +## Combining multiple `Validator`s +Often, you'll find yourself in situations where you expect the input to satisfy *multiple* `Validator`s (but don't need applicative composition), or situations where you expect the input to satisfy *at least one* of multiple `Validator`s. This is where [`andAlso`](https://hackage.haskell.org/package/valida/docs/Valida-Combinators.html#v:andAlso), and [`orElse`](https://hackage.haskell.org/package/valida/docs/Valida-Combinators.html#v:orElse) come into play. -## Combining multiple `ValidationRule`s -Often, you'll find yourself in situations where you expect the input to satisfy *multiple* `ValidationRule`s, or situations where you expect the input to satisfy *at least one* of many `ValidationRule`s. This is where `andAlso`, and `orElse` come into play. +### Combining multiple `Validator`s with `andAlso` +`andAlso` is the semigroup implementation of `Validator`, and thus is the same as `<>`. Combining 2 validators with `<>` creates a new validator that is only satisfied when *both of the given validators are satisfied*. -### Combining multiple `ValidationRule`s with `andAlso` -`andAlso` is the semigroup implementation of `ValidationRule`, and thus is the same as `<>`. Combining 2 rules with `<>` creates a new rule that is only satisfied when *both of the given rules are satisfied*. Otherwise, the very first (left most) failure value is returned - and the rest are not tried. +Otherwise, the **first (left most)** failure value is returned - and the rest are not tried. Upon successful validation, the **right-most** `Success` value is returned. This means that if all validators succeed, only the right-most validator's success value is returned. -The following rule only succeeds if the input is **odd**, *and* **not divisble by 3**. +The following validator only succeeds if the input is **odd**, *and* **not divisble by 3**. ```hs -rule :: ValidationRule (NonEmpty String) Int -rule = failureIf even "IsEven" `andAlso` failureIf ((==0) . flip mod 3) "IsDivisbleBy3" +validator :: Validator (NonEmpty String) Int Int +validator = failureIf even "IsEven" `andAlso` failureIf ((==0) . flip mod 3) "IsDivisbleBy3" ``` (OR) ```hs -rule :: ValidationRule (NonEmpty String) Int -rule = failureIf even "IsEven" <> failureIf ((==0) . flip mod 3) "IsDivisbleBy3" +validator :: Validator (NonEmpty String) Int Int +validator = failureIf even "IsEven" <> failureIf ((==0) . flip mod 3) "IsDivisbleBy3" ``` Usages- ```hs ->>> runValidator (validate rule) 5 +>>> runValidator validator 5 Success 5 ->>> runValidator (validate rule) 4 +>>> runValidator validator 4 Failure ("IsEven" :| []) ->>> runValidator (validate rule) 15 +>>> runValidator validator 15 Failure ("IsDivisbleBy3" :| []) ->>> runValidator (validate rule) 6 +>>> runValidator validator 6 Failure ("IsEven" :| []) ``` -### Combining multiple `ValidationRule`s with `orElse` -`orElse` also forms a semigroup, `</>` is aliased to `orElse`. Combining 2 rules with `</>` creates a new rule that is satisfied when *either of the given rules are satsified*. If all of them fail, the `Failure` values are accumulated. +### Combining multiple `Validator`s with `orElse` +`orElse` also forms a semigroup, `</>` is aliased to `orElse`. Combining 2 validators with `</>` creates a new validator that is satisfied when *either of the given validators are satsified*. If all of them fail, the `Failure` values are **accumulated**. The **left-most** `Success` value is returned, remaining validators are not tried. -The following rule succeeds if the input is *either* **odd**, *or* **not divisble by 3**. +The following validator succeeds if the input is *either* **odd**, *or* **not divisble by 3**. ```hs -rule :: ValidationRule (NonEmpty String) Int -rule = failureIf even "IsEven" `orElse` failureIf ((==0) . flip mod 3) "IsDivisbleBy3" +validator :: Validator (NonEmpty String) Int Int +validator = failureIf even "IsEven" `orElse` failureIf ((==0) . flip mod 3) "IsDivisbleBy3" ``` (OR) ```hs -rule :: ValidationRule (NonEmpty String) Int -rule = failureIf even "IsEven" </> failureIf ((==0) . flip mod 3) "IsDivisbleBy3" +validator :: Validator (NonEmpty String) Int Int +validator = failureIf even "IsEven" </> failureIf ((==0) . flip mod 3) "IsDivisbleBy3" ``` Usages- ```hs ->>> runValidator (validate rule) 5 +>>> runValidator validator 5 Success 5 ->>> runValidator (validate rule) 4 +>>> runValidator validator 4 Success 4 ->>> runValidator (validate rule) 15 +>>> runValidator validator 15 Success 15 ->>> runValidator (validate rule) 6 +>>> runValidator validator 6 Failure ("IsEven" :| ["IsDivisbleBy3"]) ``` -### Combining a foldable of `ValidationRule`s -You can combine a foldable of `ValidationRule`s using `satisfyAll` and `satisfyAny`. `satisfyAll` folds using `andAlso`/`<>`, while `satisfyAny` folds using `orElse`/`</>`. +### Combining a foldable of `Validator`s +You can combine a foldable of `Validator`s using [`satisfyAll`](https://hackage.haskell.org/package/valida/docs/Valida-Combinators.html#v:satisfyAll) and [`satisfyAny`](https://hackage.haskell.org/package/valida/docs/Valida-Combinators.html#v:satisfyAny). `satisfyAll` folds using `andAlso`/`<>`, while `satisfyAny` folds using `orElse`/`</>`. ## Ignoring errors -Although, highly inadvisable and generally not useful in serious code, you may use alternative versions of `ValidationRule` combinators that use `()` (unit) as its error type so you don't have to supply error values. For example, `failureIf'` does not require an error value to be supplied. In case of failure, it simply yields `Failure ()`. +Although, highly inadvisable and generally not useful in serious code, you may use alternative versions of `Validator` combinators that use `()` (unit) as the error type so you don't have to supply error values. For example, [`failureIf'`](https://hackage.haskell.org/package/valida/docs/Valida-Combinators.html#v:failureIf-39-) does not require an error value to be supplied. In case of failure, it simply yields `Failure ()`. ```hs ->>> runValidator (validate (failureIf' even)) 2 +>>> runValidator (failureIf' even) 2 Failure () ``` ## Re-assigning errors -Using the `label`/`<?>` and `labelV`/`<??>` functions, you can use override the errors `ValidationRule`s and `Validator`s yield. +Using the [`label`](https://hackage.haskell.org/package/valida/docs/Valida.html#v:label)/[`<?>`](https://hackage.haskell.org/package/valida/docs/Valida.html#v:-60--63--62-) function, you can override the errors `Validator`s yield. -For example, to re assign the error on a `ValidationRule`- +For example, to re assign the error on a `Validator`- ```hs label "IsEven" (failureIf even "Foo") ``` @@ -185,28 +176,59 @@ failureIf even "Foo" <?> "IsEven" ``` -This is useful with `ValidationRule`s that use unit as their error type. You can create a `ValidationRule`, skip assigning an error to it - and label a specific error when you need it later. +This is useful with `Validator`s that use unit as their error type. You can create a `Validator`, skip assigning an error to it - and label a specific error when you need to later. ```hs label "IsEven" (failureIf' even) ``` -Re-labeled `ValidationRule`s will yield the newly assigned error value when the rule is not satisfied. +Re-labeled `Validator`s will yield the newly assigned error value when the validator is not satisfied. -Similarly, `labelV` (or `<??>`) can be used to relabel the error value of an entire `Validator`. +# Core Idea +All usecases of applicative validation, involving validation of product types, have one noticable thing in common. A well written validator typically looks something like- +```hs +data InputForm = InpForm + { inpName :: String + , inpAge :: Int + , inpDate :: String + } deriving (Show) -## Wait, couldn't this be done using contravariant functors? -Yes! The concept of *keeping the input of a `Validator`* set to the same product type, but *letting it validate a specific field* of said input, can be generalized to contravariant functors. The `Validator` type looks like- `Validator e inp a`, to keep applicative composition working, the `inp` needs to stay the same - but each validator within said composition should also be able to *consume* a specific part of the `inp`. `ValidationRule` itself, is the typical example of a contravariant functor as well. It's essentially a specialized predicate function- `a -> Validation e ()`. The `verify` function simply combines these 2 *potentially generalizable* contravariant functors, into a very specialized usecase. +validateName :: String -> Validation [String] String +validateAge :: Int -> Validation [String] Int +validateDate :: String -> Validation [String] String -I do think adding instances for actual generalized contravariant functors/profunctors for `ValidationRule` and `Validator`, *could* be more powerful, while also being able to provide the same specialized functions. However, I've refrained from doing so as I didn't want to pull in the extra dependencies. I think the separation of `ValidationRule` and `Validator`, combined with the provided functions, *should* be able to reliably, and elegantly model any scenario of building a validator. I have yet to find a usecase where the generalized contravariant instances *would be significantly useful*. But it could certainly be more idiomatic for haskell. I may consider creating a package that *does* go the contravariant/profunctor route though. +validateForm :: InputForm -> Validation [String] InputForm +validateForm form = InputForm + <$> validateName (inpName form) + <*> validateAge (inpAge form) + <*> validateDate (inpDate form) +``` +There's a few things unideal with this. The functions `validateName`, `validateAge`, and `validateDate` are defined elsewhere - but all of their definitions are really similar. Yet, without handy combinators - they can't be defined in a terse way. However, the bigger problem, is how all of the validators need to be fed their specific input by selecting the field from the product type. It could look better if the validator functions could somehow just be linked to a specific field selector in an elegant way. Something like `inpName -?> validateName`, perhaps. + +This is the perfect usecase for contravariance. A validation function, is really just a [`Predicate`](https://hackage.haskell.org/package/base-4.14.1.0/docs/Data-Functor-Contravariant.html#t:Predicate), the idiomatic example of a contravariant functor. However, it *also* needs to be an applicative functor to allow for the elegant composition. In fact, the type of a validation function needs to parameterize on 3 types - `inp -> Validation e a` +* The input type +* The error type +* The output type + +The output is covariant, but the input is contravariant. This is a [Profunctor](https://hackage.haskell.org/package/profunctors-5.6.2/docs/Data-Profunctor.html)! With a profunctorial validator, you now have the ability to *not only* map the output type, *but also* contramap the input type. + +Given a validator that makes sure an int input is even, and returns said int input as output - `evenValidator`, you can *easily* use it in the applicative validation of a `(Int, Int)` using `lmap`- +```hs +(,) <$> lmap fst evenValidator <*> lmap snd evenValidator +``` + +Contravariant input, mixed with covariant output - is the bread and butter of Valida! It allows for elegant encoding of well composable validators using only 2 simple concepts. + +There's one more core idea that `Valida` uses though - [`fixV`](https://hackage.haskell.org/package/valida/docs/Valida.html#v:fixV). `fixV` "fixes" a validator's output, to be the same as its input. `fmap` lets you *map* over the output, `lmap` lets you *contramap* over the input, `fixV` allows `fmap` to now *map* over the input value, on the output position. `fixV` also allows you to regain the input value in the output position if a validator has been `fmap`ed on. + # Comparison and Motivation The concept of the `Validation` data type used in this package isn't new. It's also used in the following packages- * [either](https://hackage.haskell.org/package/either) * [validation](https://hackage.haskell.org/package/validation) * [validation-selective](https://hackage.haskell.org/package/validation-selective) -`Valida` aims to be a minimal in terms of dependencies, but batteries included in terms of API. It borrows many philosophies from `Data.Validation` (from `validation`) and `Validation` (from `validation-selective`), and aims to provide a convenient, minimal way to model the common usecases of them. +Valida aims to be a minimal in terms of dependencies, but batteries included in terms of API. It borrows many philosophies from `Data.Validation` (from `validation`) and `Validation` (from `validation-selective`), and aims to provide a convenient, minimal way to model the common usecases of them. -The `verify` function, combined with the `ValidationRule` combinators, and the parsec-esque `Validator` aims to assist in easily modeling typical validation usecases without too much boilerplate. The core idea, really, is [contravariance](#wait-couldnt-this-be-done-using-contravariant-functors) - the typical usecases, especially when validating product types (the most common target of validation), simply showcases contravariant functors. +The `verify` function, combined with the built in `Validator` combinators, and the parsec-esque `Validator` aims to assist in easily modeling typical validation usecases without too much boilerplate, using applicative composition and contravariant input. In essence, the validation style itself, is designed to look like [forma](https://hackage.haskell.org/package/forma). Though the actual types, and core concepts are significantly different.
src/Valida.hs view
@@ -2,7 +2,7 @@ {- | Module : Valida -Description : Simple applicative validation for product types, batteries included! +Description : Core Validator builders, utilities, and combinators Copyright : (c) TotallyNotChase, 2021 License : MIT Maintainer : totallynotchase42@gmail.com @@ -11,55 +11,55 @@ This module exports the primary validator building functions. It also exports all of "Valida.Combinators". +For a full tutorial, check out the README at <https://github.com/TotallyNotChase/valida#readme>. Refer to the hackage documentation for function reference and examples. -You can also find examples in the README, and also in the github repo, within the examples directory. + +You can also find more examples within the examples directory in linked github repo. -} module Valida - ( Selector - -- * Primary data types - , Validation (..) - , ValidationRule + ( -- * Primary data types + Validation (..) , Validator (runValidator) - -- * Functions for building Valida data types - , validate + -- * Building and modifying 'Validator's + , fixV , verify - , vrule , (-?>) -- * Reassigning errors , label - , labelV , (<?>) - , (<??>) -- | Re-exports of "Valida.Combinators" , module Valida.Combinators , module Valida.ValidationUtils ) where -import Data.Bifunctor (Bifunctor (first)) +import Data.Bifunctor (Bifunctor (first)) +import Data.Profunctor (Profunctor (lmap)) import Valida.Combinators import Valida.Validation (Validation (..)) -import Valida.ValidationRule (ValidationRule (..), vrule) import Valida.ValidationUtils -import Valida.Validator (Selector, Validator (..)) +import Valida.Validator (Validator (..)) -{- | Build a validator from a 'ValidationRule' and a 'Selector'. +{- | An alias to 'lmap' specialized to 'Validator'. -The 'Validator` first runs given __selector__ on its input to obtain the validation target. Then, it runs the -'ValidationRule' on the target. +'verify' allows a validator taking input /b/ to work with input /a/, provided a function of type: @a -> b@. -If validation is successful, the validation target is put into the 'Validation' result. +The new 'Validator` first runs the __selector__ on its input to obtain the validation target. Then, it runs the +predicate on the target. +If validation is successful, the the *original* output is put into the 'Validation' result. + ==== __Examples__ -This is the primary function for building validators for your record types. -To validate a pair, the most basic record type, such that the first element is a non empty string, and the second +This is the primary functions to build validators for product types. +To validate a pair, the most basic product type, such that the first element is a non empty string, and the second element is a number greater than 9, you can use: >>> let pairValidator = (,) <$> verify (notEmpty "EmptyString") fst <*> verify (failureIf (<10) "LessThan10") snd You can then run the validator on your input, using 'runValidator': + >>> runValidator pairValidator ("foo", 12) Success ("foo",12) >>> runValidator pairValidator ("", 12) @@ -69,43 +69,53 @@ >>> runValidator pairValidator ("", 9) Failure ("EmptyString" :| ["LessThan10"]) -} -verify :: ValidationRule e b -> Selector a b -> Validator e a b -verify (ValidationRule rule) selector = Validator $ \x -> selector x <$ rule (selector x) +verify :: Validator e b x -> (a -> b) -> Validator e a x +verify = flip lmap -- | A synonym for 'verify' with its arguments flipped. infix 5 -?> -(-?>) :: Selector a b -> ValidationRule e b -> Validator e a b -(-?>) = flip verify +(-?>) :: (a -> b) -> Validator e b x -> Validator e a x +(-?>) = lmap ---------------------------------------------------------------------- --- Reassigning corresponding error to 'ValidationRule'. ---------------------------------------------------------------------- +{- | Fix a validator's output to be the same as its input. -{- | Relabel a 'ValidationRule' with a different error. +@fixV . fixV = 'id' . fixV@ -Many combinators, like 'failureIf'' and 'failureUnless'', simply return the given error value -within /NonEmpty/ upon failure. You can use 'label' to override this return value. +@'fmap' ('const' x) . fixV = 'fmap' ('const' x)@ +__Note__: The primitive and derivative combinators already fix the validator output to be the +same as its input. + ==== __Examples__ ->>> let rule = label "NotEven" (failureUnless' even) ->>> runValidator (validate rule) 1 -Failure "NotEven" +This is useful for regaining the input value in the output position after multiple 'fmap's. ->>> let rule = label "DefinitelyNotEven" (failureUnless even "NotEven") ->>> runValidator (validate rule) 1 -Failure "DefinitelyNotEven" --} -label :: e -> ValidationRule x a -> ValidationRule e a -label err (ValidationRule rule) = vrule $ first (const err) . rule +Assume we have a validator that fails when input number is even- --- | A synonym for 'label' with its arguments flipped. -infix 6 <?> +>>> let evenValidator = failureIf even "Even" -(<?>) :: ValidationRule x a -> e -> ValidationRule e a -(<?>) = flip label +This validator, when run, will yield its input value, wrapped in 'Success', if input is not even. 'fixV' would be redundant on this. +However, if the output was 'fmap'ed to be something else- + +>>> let evenValidator' = fmap (:[]) evenValidator + +Now the output type is `[Int]`. The value of the output is no longer the same as the input. If we needed to get the +original input back into the output, 'fixV' would be the right choice. + +>>> let evenValidator'' = fixV evenValidator' + +evenValidator'' is now the exact same as evenValidator, which was fixed from the start. + +>>> (("foo" <$ failureIf even "Even") <> ("bar" <$ failureIf (<0) "Negative")) `runValidator` 5 +Success "bar" +>>> fixV (("foo" <$ failureIf even "Even") <> ("bar" <$ failureIf (<0) "Negative")) `runValidator` 5 +Success 5 +-} +fixV :: Validator e a x -> Validator e a a +fixV (Validator v) = Validator $ \x -> x <$ v x + --------------------------------------------------------------------- -- Reassigning corresponding error to 'Validator'. --------------------------------------------------------------------- @@ -114,29 +124,19 @@ ==== __Examples__ ->>> let validator = labelV "NotEven" (validate (failureUnless' even)) +>>> let validator = label "NotEven" (failureUnless' even) >>> runValidator validator 1 Failure "NotEven" ->>> let validator = labelV "DefinitelyNotEven" (validate (failureUnless even "NotEven")) +>>> let validator = label "DefinitelyNotEven" (failureUnless even "NotEven") >>> runValidator validator 1 Failure "DefinitelyNotEven" -} -labelV :: e -> Validator x inp a -> Validator e inp a -labelV err (Validator v) = Validator $ first (const err) . v - --- | A synonym for 'labelV' with its arguments flipped. -infix 6 <??> - -(<??>) :: Validator x inp a -> e -> Validator e inp a -(<??>) = flip labelV - -{- | Build a basic validator from a 'ValidationRule'. +label :: e -> Validator x inp a -> Validator e inp a +label err (Validator v) = Validator $ first (const err) . v -The 'Validator' runs the rule on its input. If validation is successful, the input is put into the 'Validation' -result. +-- | A synonym for 'label' with its arguments flipped. +infix 6 <?> -prop> validate rule = verify rule id --} -validate :: ValidationRule e a -> Validator e a a -validate = (-?>) id +(<?>) :: Validator x inp a -> e -> Validator e inp a +(<?>) = flip label
src/Valida/Combinators.hs view
@@ -2,7 +2,7 @@ {- | Module : Valida.Combinators -Description : Combinators and utilities for building and combining 'ValidationRule's. +Description : Combinators and utilities for building and combining 'Validator's Copyright : (c) TotallyNotChase, 2021 License : MIT Maintainer : totallynotchase42@gmail.com @@ -11,8 +11,11 @@ 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. +This module exports the primitive, as well as utility, 'Validator' combinators. As well as the 'orElse', 'andAlso', 'satisfyAny', and 'satisfyAll' functions, and some more utilities. + +__Note__: All the primitive combinators and derivative combinators use the same type for @inp@ and @a@. +In those cases - upon successful validation, the input itself, wrapped in 'Success', is returned. -} module Valida.Combinators @@ -22,13 +25,14 @@ -- * Primitive /Unit/ combinators , failureIf' , failureUnless' - -- * Negating 'ValidationRule' - , negateRule - , negateRule' - -- * Combining 'ValidationRule's + -- * Negating 'Validator' + , negateV + , negateV' + -- * Combining 'Validator's , andAlso - , falseRule , orElse + -- + , failV , satisfyAll , satisfyAny , (</>) @@ -66,20 +70,16 @@ , valueAbove' , valueBelow' , valueWithin' - -- * Type specific 'ValidationRule's + -- * Type specific 'Validator'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) +import Valida.Utils (neSingleton) +import Valida.Validation (Validation (..), validationConst) +import Valida.Validator (Validator (Validator)) --------------------------------------------------------------------- -- Primitive 'NonEmpty' combinators @@ -87,73 +87,75 @@ {- | Build a rule that /fails/ with given error __if the given predicate succeeds__. -prop> failureIf predc = failureUnless (not . predc) +@failureIf predc = 'failureUnless' ('not' . predc)@ ==== __Examples__ ->>> runValidator (validate (failureIf (>0) "Positive")) 5 +>>> runValidator (failureIf (>0) "Positive") 5 Failure ("Positive" :| []) ->>> runValidator (validate (failureIf (>0) "Positive")) 0 +>>> runValidator (failureIf (>0) "Positive") 0 Success 0 ->>> runValidator (validate (failureIf (>0) "Positive")) (-1) +>>> runValidator (failureIf (>0) "Positive") (-1) Success (-1) -} -failureIf :: (a -> Bool) -> e -> ValidationRule (NonEmpty e) a -failureIf predc = predToRule (not . predc) . neSingleton +failureIf :: (a -> Bool) -> e -> Validator (NonEmpty e) a a +failureIf predc = validatorFrom (not . predc) . neSingleton {- | Build a rule that /fails/ with given error __unless the given predicate succeeds__. -prop> failureUnless predc = failureIf (not . predc) +@failureUnless predc = 'failureIf' ('not' . predc)@ ==== __Examples__ ->>> runValidator (validate (failureUnless (>0) "NonPositive")) 5 +>>> runValidator (failureUnless (>0) "NonPositive") 5 Success 5 ->>> runValidator (validate (failureUnless (>0) "NonPositive")) 0 +>>> runValidator (failureUnless (>0) "NonPositive") 0 Failure ("NonPositive" :| []) ->>> runValidator (validate (failureUnless (>0) "NonPositive")) (-1) +>>> runValidator (failureUnless (>0) "NonPositive") (-1) Failure ("NonPositive" :| []) -} -failureUnless :: (a -> Bool) -> e -> ValidationRule (NonEmpty e) a -failureUnless predc = predToRule predc . neSingleton +failureUnless :: (a -> Bool) -> e -> Validator (NonEmpty e) a a +failureUnless predc = validatorFrom predc . neSingleton --------------------------------------------------------------------- -- Primitive /Unit/ combinators --------------------------------------------------------------------- -{- | Like 'failureIf' but uses /Unit/ as the 'ValidationRule' error type. +{- | Like 'failureIf' but uses /Unit/ as the 'Validator' error type. -prop> failureIf' predc = failureUnless' (not . predc) -prop> label (const (err :| [])) (failureIf' predc) = failureIf predc err +@failureIf' predc = 'failureUnless'' ('not' . predc)@ +@label ('const' (err :| [])) (failureIf' predc) = 'failureIf' predc err@ + ==== __Examples__ ->>> runValidator (validate (failureIf' (>0))) 5 +>>> runValidator (failureIf' (>0)) 5 Failure () ->>> runValidator (validate (failureIf' (>0))) 0 +>>> runValidator (failureIf' (>0)) 0 Success 0 ->>> runValidator (validate (failureIf' (>0))) (-1) +>>> runValidator (failureIf' (>0)) (-1) Success (-1) -} -failureIf' :: (a -> Bool) -> ValidationRule () a -failureIf' predc = predToRule (not . predc) () +failureIf' :: (a -> Bool) -> Validator () a a +failureIf' predc = validatorFrom (not . predc) () -{- | Like 'failureUnless' but uses /Unit/ as the 'ValidationRule' error type. +{- | Like 'failureUnless' but uses /Unit/ as the 'Validator' error type. -prop> failureUnless' predc = failureIf' (not . predc) -prop> label (const (err :| [])) (failureUnless' predc) = failureUnless predc err +@failureUnless' predc = 'failureIf'' ('not' . predc)@ +@label ('const' (err :| [])) (failureUnless' predc) = 'failureUnless' predc err@ + ==== __Examples__ ->>> runValidator (validate (failureUnless' (>0))) 5 +>>> runValidator (failureUnless' (>0)) 5 Success 5 ->>> runValidator (validate (failureUnless' (>0))) 0 +>>> runValidator (failureUnless' (>0)) 0 Failure () ->>> runValidator (validate (failureUnless' (>0))) (-1) +>>> runValidator (failureUnless' (>0)) (-1) Failure () -} -failureUnless' :: (a -> Bool) -> ValidationRule () a -failureUnless' = flip predToRule () +failureUnless' :: (a -> Bool) -> Validator () a a +failureUnless' = flip validatorFrom () --------------------------------------------------------------------- -- Common derivates of primitive 'NonEmpty' combinators @@ -161,392 +163,422 @@ {- | Build an equality rule for value. -prop> mustBe x = failureUnless (==x) +@mustBe x = 'failureUnless' (==x)@ -} -mustBe :: Eq a => a -> e -> ValidationRule (NonEmpty e) a +mustBe :: Eq a => a -> e -> Validator (NonEmpty e) a a mustBe x = failureUnless (==x) {-# INLINABLE mustBe #-} {- | Build an equality rule for length. -prop> ofLength x = failureUnless ((==x) . length) +@ofLength x = 'failureUnless' ((==x) . 'length')@ -} -ofLength :: Foldable t => Int -> e -> ValidationRule (NonEmpty e) (t a) +ofLength :: Foldable t => Int -> e -> Validator (NonEmpty e) (t a) (t a) ofLength n = failureUnless $ (==n) . length {-# INLINABLE ofLength #-} -{-# SPECIALIZE ofLength :: Int -> e -> ValidationRule (NonEmpty e) [a] #-} +{-# SPECIALIZE ofLength :: Int -> e -> Validator (NonEmpty e) [a] [a] #-} {- | Build a minimum length (inclusive) rule. -prop> minLengthOf x = failureUnless ((>=n) . length) +@minLengthOf x = 'failureUnless' ((>=n) . 'length')@ -} -minLengthOf :: Foldable t => Int -> e -> ValidationRule (NonEmpty e) (t a) +minLengthOf :: Foldable t => Int -> e -> Validator (NonEmpty e) (t a) (t a) minLengthOf n = failureUnless $ (>=n) . length {-# INLINABLE minLengthOf #-} -{-# SPECIALIZE minLengthOf :: Int -> e -> ValidationRule (NonEmpty e) [a] #-} +{-# SPECIALIZE minLengthOf :: Int -> e -> Validator (NonEmpty e) [a] [a] #-} {- | Build a maximum length (inclusive) rule. -prop> maxLengthOf n = failureUnless ((<=n) . length) +@maxLengthOf n = 'failureUnless' ((<=n) . 'length')@ -} -maxLengthOf :: Foldable t => Int -> e -> ValidationRule (NonEmpty e) (t a) +maxLengthOf :: Foldable t => Int -> e -> Validator (NonEmpty e) (t a) (t a) maxLengthOf n = failureUnless $ (<=n) . length {-# INLINABLE maxLengthOf #-} -{-# SPECIALIZE maxLengthOf :: Int -> e -> ValidationRule (NonEmpty e) [a] #-} +{-# SPECIALIZE maxLengthOf :: Int -> e -> Validator (NonEmpty e) [a] [a] #-} {- | Build a minimum length (inclusive) rule. -prop> lengthAbove x = minLengthOf (x + 1) -prop> lengthAbove x = failureUnless ((>n) . length) +@lengthAbove x = 'minLengthOf' (x + 1)@ + +@lengthAbove x = 'failureUnless' ((>n) . 'length')@ -} -lengthAbove :: Foldable t => Int -> e -> ValidationRule (NonEmpty e) (t a) +lengthAbove :: Foldable t => Int -> e -> Validator (NonEmpty e) (t a) (t a) lengthAbove n = failureUnless $ (>n) . length {-# INLINABLE lengthAbove #-} -{-# SPECIALIZE lengthAbove :: Int -> e -> ValidationRule (NonEmpty e) [a] #-} +{-# SPECIALIZE lengthAbove :: Int -> e -> Validator (NonEmpty e) [a] [a] #-} {- | Build a maximum length (inclusive) rule. -prop> lengthBelow x = maxLengthOf (x - 1) -prop> lengthBelow x = failureUnless ((<n) . length) +@lengthBelow x = 'maxLengthOf' (x - 1)@ + +@lengthBelow x = 'failureUnless' ((<n) . 'length')@ -} -lengthBelow :: Foldable t => Int -> e -> ValidationRule (NonEmpty e) (t a) +lengthBelow :: Foldable t => Int -> e -> Validator (NonEmpty e) (t a) (t a) lengthBelow n = failureUnless $ (<n) . length {-# INLINABLE lengthBelow #-} -{-# SPECIALIZE lengthBelow :: Int -> e -> ValidationRule (NonEmpty e) [a] #-} +{-# SPECIALIZE lengthBelow :: Int -> e -> Validator (NonEmpty e) [a] [a] #-} {- | Build a maximum length rule. -prop> notEmpty = minLengthOf 1 -prop> notEmpty = failureIf null +@notEmpty = 'minLengthOf' 1@ + +@notEmpty = 'failureIf' 'null'@ -} -notEmpty :: Foldable t => e -> ValidationRule (NonEmpty e) (t a) +notEmpty :: Foldable t => e -> Validator (NonEmpty e) (t a) (t a) notEmpty = failureIf null {-# INLINABLE notEmpty #-} -{-# SPECIALIZE notEmpty :: e -> ValidationRule (NonEmpty e) [a] #-} +{-# SPECIALIZE notEmpty :: e -> Validator (NonEmpty e) [a] [a] #-} {- | Build an 'inRange' rule for length. -prop> lengthWithin (min, max) = minLengthOf min `andAlso` maxLengthOf max -prop> lengthWithin r = failureUnless (inRange r . 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 :: Foldable t => (Int, Int) -> e -> Validator (NonEmpty e) (t a) (t a) lengthWithin r = failureUnless $ inRange r . length {-# INLINABLE lengthWithin #-} -{-# SPECIALIZE lengthWithin :: (Int, Int) -> e -> ValidationRule (NonEmpty e) [a] #-} +{-# SPECIALIZE lengthWithin :: (Int, Int) -> e -> Validator (NonEmpty e) [a] [a] #-} {- | Build a minimum value (inclusive) rule. -prop> minValueOf x = failureUnless (>=x) +@minValueOf x = 'failureUnless' (>=x)@ -} -minValueOf :: Ord a => a -> e -> ValidationRule (NonEmpty e) a +minValueOf :: Ord a => a -> e -> Validator (NonEmpty e) a a minValueOf x = failureUnless (>=x) {-# INLINABLE minValueOf #-} {- | Build a maximum value (inclusive) rule. -prop> maxValueOf x = failureUnless (<=x) +@maxValueOf x = 'failureUnless' (<=x)@ -} -maxValueOf :: Ord a => a -> e -> ValidationRule (NonEmpty e) a +maxValueOf :: Ord a => a -> e -> Validator (NonEmpty e) a a maxValueOf x = failureUnless (<=x) {-# INLINABLE maxValueOf #-} {- | Build a minimum value (exclusive) rule. -prop> valueAbove x = minValueOf (x + 1) -prop> valueAbove x = failureUnless (>x) +@valueAbove x = 'minValueOf' (x + 1)@ + +@valueAbove x = 'failureUnless' (>x)@ -} -valueAbove :: Ord a => a -> e -> ValidationRule (NonEmpty e) a +valueAbove :: Ord a => a -> e -> Validator (NonEmpty e) a a valueAbove n = failureUnless (>n) {-# INLINABLE valueAbove #-} {- | Build a maximum value (exclusive) rule. -prop> valueBelow x = minValueOf (x - 1) -prop> valueBelow x = failureUnless (<x) +@valueBelow x = 'minValueOf' (x - 1)@ + +@valueBelow x = 'failureUnless' (<x)@ -} -valueBelow :: Ord a => a -> e -> ValidationRule (NonEmpty e) a +valueBelow :: Ord a => a -> e -> Validator (NonEmpty e) a a valueBelow n = failureUnless (<n) {-# INLINABLE valueBelow #-} {- | Build an 'inRange' rule for value. -prop> valueWithin (min, max) = minValueOf min `andAlso` maxValueOf max -prop> valueWithin (min, max) = failureUnless (\x -> m <= x && x <= n) +@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 :: Ord a => (a, a) -> e -> Validator (NonEmpty e) a a valueWithin (m, n) = failureUnless $ \x -> m <= x && x <= n {-# INLINABLE valueWithin #-} -{-# SPECIALIZE valueWithin :: (Int, Int) -> e -> ValidationRule (NonEmpty e) Int #-} +{-# SPECIALIZE valueWithin :: (Int, Int) -> e -> Validator (NonEmpty e) Int Int #-} {- | Build an 'all' rule. -prop> onlyContains x = failureUnless (all x) +@onlyContains x = 'failureUnless' ('all' x)@ -} -onlyContains :: Foldable t => (a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a) +onlyContains :: Foldable t => (a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a) onlyContains x = failureUnless $ all x {-# INLINABLE onlyContains #-} -{-# SPECIALIZE onlyContains :: (a -> Bool) -> e -> ValidationRule (NonEmpty e) [a] #-} +{-# SPECIALIZE onlyContains :: (a -> Bool) -> e -> Validator (NonEmpty e) [a] [a] #-} {- | Build an 'any' rule. -prop> atleastContains x = failureUnless (any x) +@atleastContains x = 'failureUnless' ('any' x)@ -} -atleastContains :: Foldable t => (a -> Bool) -> e -> ValidationRule (NonEmpty e) (t a) +atleastContains :: Foldable t => (a -> Bool) -> e -> Validator (NonEmpty e) (t a) (t a) atleastContains x = failureUnless $ any x {-# INLINABLE atleastContains #-} -{-# SPECIALIZE atleastContains :: (a -> Bool) -> e -> ValidationRule (NonEmpty e) [a] #-} +{-# SPECIALIZE atleastContains :: (a -> Bool) -> e -> Validator (NonEmpty e) [a] [a] #-} {- | Build an 'elem' rule. -prop> mustContain x = atleastContains (==x) +@mustContain x = 'atleastContains' (==x)@ -prop> mustContain x = failureUnless (elem x) +@mustContain x = 'failureUnless' ('elem' x)@ -} -mustContain :: (Foldable t, Eq a) => a -> e -> ValidationRule (NonEmpty e) (t a) +mustContain :: (Foldable t, Eq a) => a -> e -> Validator (NonEmpty e) (t a) (t a) mustContain x = failureUnless $ elem x {-# INLINABLE mustContain #-} -{-# SPECIALIZE mustContain :: Eq a => a -> e -> ValidationRule (NonEmpty e) [a] #-} +{-# SPECIALIZE mustContain :: Eq a => a -> e -> Validator (NonEmpty e) [a] [a] #-} --------------------------------------------------------------------- -- Common derivates of primitive /Unit/ combinators --------------------------------------------------------------------- --- | Like 'mustBe' but uses /Unit/ as the 'ValidationRule' error type. -mustBe' :: Eq a => a -> ValidationRule () a +-- | Like 'mustBe' but uses /Unit/ as the 'Validator' error type. +mustBe' :: Eq a => a -> Validator () a a mustBe' x = failureUnless' (==x) {-# INLINABLE mustBe' #-} --- | Like 'ofLength' but uses /Unit/ as the 'ValidationRule' error type. -ofLength' :: Foldable t => Int -> ValidationRule () (t a) +-- | Like 'ofLength' but uses /Unit/ as the 'Validator' error type. +ofLength' :: Foldable t => Int -> Validator () (t a) (t a) ofLength' n = failureUnless' $ (==n) . length {-# INLINABLE ofLength' #-} -{-# SPECIALIZE ofLength' :: Int -> ValidationRule () [a] #-} +{-# SPECIALIZE ofLength' :: Int -> Validator () [a] [a] #-} --- | Like 'minLengthOf' but uses /Unit/ as the 'ValidationRule' error type. -minLengthOf' :: Foldable t => Int -> ValidationRule () (t a) +-- | Like 'minLengthOf' but uses /Unit/ as the 'Validator' error type. +minLengthOf' :: Foldable t => Int -> Validator () (t a) (t a) minLengthOf' n = failureUnless' $ (>=n) . length {-# INLINABLE minLengthOf' #-} -{-# SPECIALIZE minLengthOf' :: Int -> ValidationRule () [a] #-} +{-# SPECIALIZE minLengthOf' :: Int -> Validator () [a] [a] #-} --- | Like 'maxLengthOf' but uses /Unit/ as the 'ValidationRule' error type. -maxLengthOf' :: Foldable t => Int -> ValidationRule () (t a) +-- | Like 'maxLengthOf' but uses /Unit/ as the 'Validator' error type. +maxLengthOf' :: Foldable t => Int -> Validator () (t a) (t a) maxLengthOf' n = failureUnless' $ (<=n) . length {-# INLINABLE maxLengthOf' #-} -{-# SPECIALIZE maxLengthOf' :: Int -> ValidationRule () [a] #-} +{-# SPECIALIZE maxLengthOf' :: Int -> Validator () [a] [a] #-} --- | Like 'lengthAbove' but uses /Unit/ as the 'ValidationRule' error type. -lengthAbove' :: Foldable t => Int -> ValidationRule () (t a) +-- | Like 'lengthAbove' but uses /Unit/ as the 'Validator' error type. +lengthAbove' :: Foldable t => Int -> Validator () (t a) (t a) lengthAbove' n = failureUnless' $ (>n) . length {-# INLINABLE lengthAbove' #-} -{-# SPECIALIZE lengthAbove' :: Int -> ValidationRule () [a] #-} +{-# SPECIALIZE lengthAbove' :: Int -> Validator () [a] [a] #-} --- | Like 'lengthBelow' but uses /Unit/ as the 'ValidationRule' error type. -lengthBelow' :: Foldable t => Int -> ValidationRule () (t a) +-- | Like 'lengthBelow' but uses /Unit/ as the 'Validator' error type. +lengthBelow' :: Foldable t => Int -> Validator () (t a) (t a) lengthBelow' n = failureUnless' $ (<n) . length {-# INLINABLE lengthBelow' #-} -{-# SPECIALIZE lengthBelow' :: Int -> ValidationRule () [a] #-} +{-# SPECIALIZE lengthBelow' :: Int -> Validator () [a] [a] #-} --- | Like 'notEmpty' but uses /Unit/ as the 'ValidationRule' error type. -notEmpty' :: Foldable t => ValidationRule () (t a) +-- | Like 'notEmpty' but uses /Unit/ as the 'Validator' error type. +notEmpty' :: Foldable t => Validator () (t a) (t a) notEmpty' = failureIf' null {-# INLINABLE notEmpty' #-} -{-# SPECIALIZE notEmpty' :: ValidationRule () [a] #-} +{-# SPECIALIZE notEmpty' :: Validator () [a] [a] #-} --- | Like 'lengthWithin' but uses /Unit/ as the 'ValidationRule' error type. -lengthWithin' :: Foldable t => (Int, Int) -> ValidationRule () (t a) +-- | Like 'lengthWithin' but uses /Unit/ as the 'Validator' error type. +lengthWithin' :: Foldable t => (Int, Int) -> Validator () (t a) (t a) lengthWithin' r = failureUnless' $ inRange r . length {-# INLINABLE lengthWithin' #-} -{-# SPECIALIZE ofLength' :: Int -> ValidationRule () [a] #-} +{-# SPECIALIZE ofLength' :: Int -> Validator () [a] [a] #-} --- | Like 'minValueOf' but uses /Unit/ as the 'ValidationRule' error type. -minValueOf' :: Ord a => a -> ValidationRule () a +-- | Like 'minValueOf' but uses /Unit/ as the 'Validator' error type. +minValueOf' :: Ord a => a -> Validator () a a minValueOf' x = failureUnless' (>=x) {-# INLINABLE minValueOf' #-} --- | Like 'maxValueOf' but uses /Unit/ as the 'ValidationRule' error type. -maxValueOf' :: Ord a => a -> ValidationRule () a +-- | Like 'maxValueOf' but uses /Unit/ as the 'Validator' error type. +maxValueOf' :: Ord a => a -> Validator () a a maxValueOf' x = failureUnless' (<=x) {-# INLINABLE maxValueOf' #-} --- | Like 'valueAbove' but uses /Unit/ as the 'ValidationRule' error type. -valueAbove' :: Ord a => a -> ValidationRule () a +-- | Like 'valueAbove' but uses /Unit/ as the 'Validator' error type. +valueAbove' :: Ord a => a -> Validator () a a valueAbove' n = failureUnless' (>n) {-# INLINABLE valueAbove' #-} --- | Like 'valueBelow' but uses /Unit/ as the 'ValidationRule' error type. -valueBelow' :: Ord a => a -> ValidationRule () a +-- | Like 'valueBelow' but uses /Unit/ as the 'Validator' error type. +valueBelow' :: Ord a => a -> Validator () a a valueBelow' n = failureUnless' (<n) {-# INLINABLE valueBelow' #-} --- | Like 'valueWithin' but uses /Unit/ as the 'ValidationRule' error type. -valueWithin' :: Ord a => (a, a) -> ValidationRule () a +-- | Like 'valueWithin' but uses /Unit/ as the 'Validator' error type. +valueWithin' :: Ord a => (a, a) -> Validator () a a valueWithin' (m, n) = failureUnless' $ \x -> m <= x && x <= n {-# INLINABLE valueWithin' #-} -{-# SPECIALIZE valueWithin' :: (Int, Int) -> ValidationRule () Int #-} +{-# SPECIALIZE valueWithin' :: (Int, Int) -> Validator () Int Int #-} --- | Like 'onlyContains' but uses /Unit/ as the 'ValidationRule' error type. -onlyContains' :: Foldable t => (a -> Bool) -> ValidationRule () (t a) +-- | Like 'onlyContains' but uses /Unit/ as the 'Validator' error type. +onlyContains' :: Foldable t => (a -> Bool) -> Validator () (t a) (t a) onlyContains' x = failureUnless' $ all x {-# INLINABLE onlyContains' #-} -{-# SPECIALIZE onlyContains' :: (a -> Bool) -> ValidationRule () [a] #-} +{-# SPECIALIZE onlyContains' :: (a -> Bool) -> Validator () [a] [a] #-} --- | Like 'atleastContains' but uses /Unit/ as the 'ValidationRule' error type. -atleastContains' :: Foldable t => (a -> Bool) -> ValidationRule () (t a) +-- | Like 'atleastContains' but uses /Unit/ as the 'Validator' error type. +atleastContains' :: Foldable t => (a -> Bool) -> Validator () (t a) (t a) atleastContains' x = failureUnless' $ any x {-# INLINABLE atleastContains' #-} -{-# SPECIALIZE atleastContains' :: (a -> Bool) -> ValidationRule () [a] #-} +{-# SPECIALIZE atleastContains' :: (a -> Bool) -> Validator () [a] [a] #-} --- | Like 'mustContain' but uses /Unit/ as the 'ValidationRule' error type. -mustContain' :: (Foldable t, Eq a) => a -> ValidationRule () (t a) +-- | Like 'mustContain' but uses /Unit/ as the 'Validator' error type. +mustContain' :: (Foldable t, Eq a) => a -> Validator () (t a) (t a) mustContain' x = failureUnless' $ elem x {-# INLINABLE mustContain' #-} -{-# SPECIALIZE mustContain' :: Eq a => a -> ValidationRule () [a] #-} +{-# SPECIALIZE mustContain' :: Eq a => a -> Validator () [a] [a] #-} --------------------------------------------------------------------- --- Negating 'ValidationRule' +-- Negating 'Validator' --------------------------------------------------------------------- -{- | Build a rule that succeeds if given rule fails and vice versa. +{- | Build a validator that succeeds if given validator fails and vice versa. +__Note__: This will set the output of the 'Validator' to be the same as its input, +thereby ignoring the original output. + ==== __Examples__ ->>> let rule = negateRule "NonPositive" (failureIf (>0) "Positive") ->>> runValidator (validate rule) 5 +>>> let vald = negateV "NonPositive" (failureIf (>0) "Positive") +>>> runValidator vald 5 Success 5 ->>> runValidator (validate rule) 0 +>>> runValidator vald 0 Failure "NonPositive" ->>> runValidator (validate rule) (-1) +>>> runValidator vald (-1) Failure "NonPositive" -} -negateRule :: e -> ValidationRule e1 a -> ValidationRule e a -negateRule err (ValidationRule rule) = vrule $ validationConst (Success ()) (Failure err) . rule +negateV :: e -> Validator e1 a x -> Validator e a a +negateV err (Validator v) = Validator $ \x -> validationConst (Success x) (Failure err) $ v x --- | Like 'negateRule' but uses /Unit/ as the 'ValidationRule' error type. -negateRule' :: ValidationRule e a -> ValidationRule () a -negateRule' (ValidationRule rule) = vrule $ ($ ()) . validationConst Success Failure . rule +-- | Like 'negateV' but uses /Unit/ as the 'Validator' error type. +negateV' :: Validator e a x -> Validator () a a +negateV' (Validator v) = Validator $ \x -> validationConst (Success x) (Failure ()) $ v x --------------------------------------------------------------------- --- Combining 'ValidationRule's +-- Combining 'Validator'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 rule1 </> ValidationRule rule2 = vrule $ liftA2 (<>) rule1 rule2 +(</>) :: Semigroup e => Validator e inp a -> Validator e inp a -> Validator e inp a +Validator v1 </> Validator v2 = Validator $ v1 <> v2 {-# 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 #-} + :: Validator (NonEmpty err) inp a + -> Validator (NonEmpty err) inp a + -> Validator (NonEmpty err) inp a #-} +{-# SPECIALIZE (</>) :: Validator () inp a -> Validator () inp a -> Validator () inp a #-} +{-# SPECIALIZE (</>) :: Validator [err] inp a -> Validator [err] inp a -> Validator [err] inp a #-} -{- | Build a rule that /succeeds/ if __either__ of the given rules succeed. If both fail, the errors are combined. +{- | Build a validator that /succeeds/ if __either__ of the given validators succeed. +The first (left-most) 'Success' is returned. If both fail, the errors are combined. +Other validator /is not used/ if first one succeeds. -prop> rule1 `orElse` (rule2 `orElse` rule3) = (rule1 `orElse` rule2) `orElse` rule3 -prop> falseRule e `orElse` rule = rule -prop> rule `orElse` falseRule e = rule +@vald1 \`orElse\` (vald2 \`orElse\` vald3) = (vald1 \`orElse\` vald2) \`orElse\` vald3@ +@'failV' e \`orElse\` vald = vald@ + +@vald \`orElse\` 'failV' e = vald@ + ==== __Examples__ ->>> let rule = failureIf (>0) "Positive" `orElse` failureIf even "Even" ->>> runValidator (validate rule) 5 +>>> let vald = failureIf (>0) "Positive" `orElse` failureIf even "Even" +>>> runValidator vald 5 Success 5 ->>> runValidator (validate rule) 4 +>>> runValidator vald 4 Failure ("Positive" :| ["Even"]) ->>> runValidator (validate rule) 0 +>>> runValidator vald 0 Success 0 ->>> runValidator (validate rule) (-1) +>>> runValidator vald (-1) Success (-1) -} -orElse :: Semigroup e => ValidationRule e a -> ValidationRule e a -> ValidationRule e a +orElse :: Semigroup e => Validator e inp a -> Validator e inp a -> Validator e inp a orElse = (</>) {-# INLINABLE orElse #-} -{- | A 'ValidationRule' that always fails with supplied error. This is the identity of 'orElse' (i.e '(</>)'). +{- | A 'Validator' that always fails with supplied error. This is the identity of 'orElse' (i.e '(</>)'). -prop> falseRule `orElse` rule = rule -prop> rule `orElse` falseRule = rule +@failV `'orElse'` vald = vald@ +@vald `'orElse'` failV = vald@ + ==== __Examples__ ->>> runValidator (validate falseRule) 42 -Failure () +>>> runValidator (failV :: Validator String Int Int) 42 +Failure "" -} -falseRule :: Monoid e => ValidationRule e a -falseRule = vrule $ const $ Failure mempty -{-# INLINABLE falseRule #-} +failV :: Monoid e => Validator e inp a +failV = Validator $ const $ Failure mempty +{-# INLINABLE failV #-} -{- | Build a rule that /only succeeds/ if __both__ of the given rules succeed. The very first failure is yielded. +{- | Build a validator that /only succeeds/ if __both__ of the given validators succeed. +The __first (left-most)__ failure is yielded. If both succeed, the __right-most__ 'Success' result is returned. +Other validator /is not used/ if first one fails. -This is the same as the semigroup operation (i.e '(<>)') on 'ValidationRule'. +This is the same as the semigroup operation (i.e '(<>)') on 'Validator'. -prop> rule1 `andAlso` (rule2 `andAlso` rule3) = (rule1 `andAlso` rule2) `andAlso` rule3 -prop> mempty `andAlso` rule = rule -prop> rule `andAlso` mempty = rule +@vald1 \`andAlso\` (vald2 \`andAlso\` vald3) = (vald1 \`andAlso\` vald2) \`andAlso\` vald3@ +@'mempty' \`andAlso\` vald = vald@ + +@vald \`andAlso\` 'mempty' = vald@ + ==== __Examples__ ->>> let rule = failureIf (>0) "Positive" `andAlso` failureIf even "Even" ->>> runValidator (validate rule) 5 +>>> let vald = failureIf (>0) "Positive" `andAlso` failureIf even "Even" +>>> runValidator vald 5 Failure ("Positive" :| []) ->>> runValidator (validate rule) (-2) +>>> runValidator vald (-2) Failure ("Even" :| []) ->>> runValidator (validate rule) (-1) +>>> runValidator vald (-1) Success (-1) -} -andAlso :: ValidationRule e a -> ValidationRule e a -> ValidationRule e a +andAlso :: Validator e inp a -> Validator e inp a -> Validator e inp a andAlso = (<>) {-# INLINABLE andAlso #-} -{- | Build a rule that /succeeds/ if __any__ of the given rules succeed. If all fail, the errors are combined. +{- | Build a validator that /succeeds/ if __any__ of the given validators succeed. If all fail, the errors are combined. +The __first (left-most)__ 'Success' is returned. If all fail, the errors are /combined/. +Remaining validators /are not used/ once one succeeds. -prop> satisfyAny = foldl1 orElse -prop> satisfyAny = foldr1 orElse -prop> satisfyAny = foldl orElse falseRule -prop> satisfyAny = foldr orElse falseRule +@satisfyAny = 'foldl1' 'orElse'@ + +@satisfyAny = 'foldr1' 'orElse'@ + +@satisfyAny = 'foldl' 'orElse' 'failV'@ + +@satisfyAny = 'foldr' 'orElse' 'failV'@ -} -satisfyAny :: (Foldable t, Semigroup e) => t (ValidationRule e a) -> ValidationRule e a -satisfyAny = foldr1 (</>) +satisfyAny :: (Foldable t, Semigroup e) => t (Validator e inp a) -> Validator e inp a +satisfyAny = foldr1 orElse {-# 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 #-} +{-# SPECIALIZE satisfyAny :: [Validator (NonEmpty err) inp a] -> Validator (NonEmpty err) inp a #-} +{-# SPECIALIZE satisfyAny :: [Validator () inp a] -> Validator () inp a #-} +{-# SPECIALIZE satisfyAny :: [Validator [err] inp a] -> Validator [err] inp a #-} -{- | Build a rule that /only succeeds/ if __all__ of the given rules succeed. The very first failure is yielded. +{- | Build a validator that /only succeeds/ if __all__ of the given validators succeed. +The __first (left-most)__ failure is yielded. If all succeed, the __right-most__ 'Success' result is returned. +Remaining validators /are not used/ once one fails. -prop> satisfyAll = fold -prop> satisfyAll = foldl1 andAlso -prop> satisfyAll = foldr1 andAlso -prop> satisfyAll = foldl andAlso mempty -prop> satisfyAll = foldr andAlso mempty +@satisfyAll = 'Data.Foldable.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 = fold +satisfyAll :: Foldable t => t (Validator e inp a) -> Validator e inp a +satisfyAll = foldr1 andAlso {-# INLINABLE satisfyAll #-} -{-# SPECIALIZE satisfyAll :: [ValidationRule e a] -> ValidationRule e a #-} +{-# SPECIALIZE satisfyAll :: [Validator e inp a] -> Validator e inp a #-} --------------------------------------------------------------------- --- Type specific 'ValidationRule's +-- Type specific 'Validator's --------------------------------------------------------------------- -{- | Build a rule that runs given rule only if input is 'Just'. +{- | Build a validator that runs given validator only if input is 'Just'. -Yields 'Success' when input is 'Nothing. +Yields 'Success' when input is 'Nothing'. ==== __Examples__ ->>> runValidator (validate (optionally (failureIf even "Even"))) (Just 5) +>>> runValidator (optionally (failureIf even "Even")) (Just 5) Success (Just 5) ->>> runValidator (validate (optionally (failureIf even "Even"))) (Just 6) +>>> runValidator (optionally (failureIf even "Even"))) (Just 6) Failure ("Even" :| []) ->>> runValidator (validate (optionally (failureIf even "Even"))) Nothing +>>> runValidator (optionally (failureIf even "Even")) Nothing Success Nothing -} -optionally :: ValidationRule e a -> ValidationRule e (Maybe a) -optionally (ValidationRule rule) = vrule $ maybe (Success ()) rule +optionally :: Validator e a x -> Validator e (Maybe a) (Maybe a) +optionally (Validator v) = Validator $ \x -> maybe (Success x) (fmap (const x) . v) x --- | Utility to convert a regular predicate function to a 'ValidationRule'. __INTERNAL__ -predToRule :: (a -> Bool) -> e -> ValidationRule e a -predToRule predc err = vrule $ bool (Failure err) (Success ()) . predc +-- | Utility to convert a regular predicate function to a 'Validator'. __INTERNAL__ +validatorFrom :: (a -> Bool) -> e -> Validator e a a +validatorFrom predc err = Validator $ \x -> if predc x then Success x else Failure err
src/Valida/Validation.hs view
@@ -26,10 +26,9 @@ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic) {- | - [@fmap@] 'fmap' maps given function over a 'Success' value, does nothing on 'Failure' value. -==== __Examples__ +__Examples__ >>> fmap (+1) (Success 2) Success 3 @@ -45,9 +44,9 @@ {- | [@pure@] 'pure' is a 'Success' value. -[@(<*>)@] '(<*>)' behaves similar to 'Either', but accumulates failures instead of stopping. +[@(\<*\>)@] '(<*>)' behaves similar to 'Either', but accumulates failures instead of stopping. -==== __Examples__ +__Examples__ >>> pure 2 :: Validation String Int Success 2 @@ -73,7 +72,7 @@ {- | [@(<>)@] This behaves similar to the 'Either' semigroup. i.e Returns the first 'Success'. But also accumulates 'Failure's. -==== __Examples__ +__Examples__ >>> Success 1 <> Success 2 Success 1 @@ -88,16 +87,15 @@ {-# SPECIALIZE instance Semigroup (Validation (NonEmpty err) a) #-} {-# SPECIALIZE instance Semigroup (Validation () a) #-} {-# SPECIALIZE instance Semigroup (Validation [err] a) #-} - s@(Success _) <> _ = s - _ <> s@(Success _) = s - Failure x <> Failure y = Failure $ x <> y + Failure x <> Failure y = Failure $ x <> y + Failure _ <> b = b + a <> _ = a {-# INLINEABLE (<>) #-} {- | - [@foldMap@] 'foldMap' maps given function over a 'Success' value, returns 'mempty' for a 'Failure' value. -==== __Examples__ +__Examples__ >>> foldMap (:[]) (Success 2) [2] @@ -108,11 +106,10 @@ foldMap = validation (const mempty) {- | - [@traverse@] In case of 'Success', 'traverse' applies given function to the inner value, and maps 'Success' over the result. In case of 'Failure', 'traverse' returns 'Failure', wrapped in minimal context of the corresponding type ('pure'). -==== __Examples__ +__Examples__ >>> traverse Just (Success 2) Just (Success 2) @@ -123,10 +120,9 @@ traverse f = validation (pure . Failure) (fmap Success . f) {- | - [@bifoldMap@] 'bifoldMap' is the same as 'validation'. -==== __Examples__ +__Examples__ 'bifoldMap' (and its more generalized version, 'validation') can eliminate the need to pattern match on 'Validation'. @@ -164,7 +160,7 @@ In case of 'Failure', return the first argument; otherwise, return the second argument. -prop> validationConst e a = validation (const e) (const a) +@validationConst e a = 'validation' ('const' e) ('const' a)@ ==== __Examples__
− src/Valida/ValidationRule.hs
@@ -1,73 +0,0 @@-{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE Safe #-} - -module Valida.ValidationRule - ( ValidationRule (..) - , vrule - ) where - -import Data.Typeable (Typeable) - -import GHC.Generics (Generic) - -import Valida.Validation (Validation (..)) - -{- | The rule a Validator uses to run validation. - -Contains a function that accepts the target type and returns a `Validation` result. - -The type- __ValidationRule (NonEmpty String) Int__, designates a rule that verifies the validity of an __Int__, and -uses a value of type __NonEmpty String__ to represent error, in case of failure. --} -newtype ValidationRule e a - -- | Builds a 'ValidationRule' from a function to generate error and a validation predicate. - = ValidationRule - -- ^ The validation predicate. - (a -> Validation e ()) - deriving (Typeable, Generic) - -{- | - -[@(<>)@] '(<>)' creates a new `ValidationRule` that only succeeds when both given rule succeed. -Otherwise left-most failure is returned. - -==== __Examples__ - ->>> runValidator (validate (failureIf even "IsEven" <> failureIf (>9) "GreaterThan9")) 5 -Success 5 ->>> runValidator (validate (failureIf even "IsEven" <> failureIf (>9) "GreaterThan9")) 4 -Failure ("IsEven" :| []) ->>> runValidator (validate (failureIf even "IsEven" <> failureIf (>9) "GreaterThan9")) 15 -Failure ("GreaterThan9" :| []) ->>> runValidator (validate (failureIf even "IsEven" <> failureIf (>9) "GreaterThan9")) 12 -Failure ("IsEven" :| []) --} -instance Semigroup (ValidationRule e a) where - ValidationRule rl1 <> ValidationRule rl2 = ValidationRule - $ \x -> case (rl1 x, rl2 x) of - (f@(Failure _), _) -> f - (_, b) -> b - -{- | - -[@mempty@] 'mempty' is a 'ValidationRule' that always succeeds. - -==== __Examples__ - ->>> runValidator (validate mempty) 'a' -Success 'a' --} -instance Monoid (ValidationRule e a) where - mempty = ValidationRule $ const $ Success () - -{- | Low level function to manually build a `ValidationRule`. You should use the combinators instead. - -==== __Examples__ - ->>> runValidator (validate (vrule (\x -> if isDigit x then Success () else Failure "NotDigit"))) 'a' -Failure "NotDigit" ->>> runValidator (validate (vrule (\x -> if isDigit x then Success () else Failure "NotDigit"))) '5' -Success '5' --} -vrule :: (a -> Validation e ()) -> ValidationRule e a -vrule = ValidationRule
src/Valida/ValidationUtils.hs view
@@ -5,15 +5,21 @@ fromEither , toEither -- * Utilities for working with 'Validation' - , failures - , fromFailure + , validation + , validationConst + -- , fromSuccess - , isFailure + -- + , fromFailure + -- , isSuccess - , partitionValidations + -- + , isFailure + -- , successes - , validation - , validationConst + -- + , failures + , partitionValidations ) where import Valida.Validation (Validation (..), validation, validationConst) @@ -52,17 +58,17 @@ fromEither :: Either e a -> Validation e a fromEither = either Failure Success --- | Return True if the given value is a Failure-value, False otherwise. +-- | Return True if the given value is a 'Failure'-value, False otherwise. isFailure :: Validation e a -> Bool isFailure (Failure _) = True isFailure _ = False --- | Return True if the given value is a Success-value, False otherwise. +-- | Return True if the given value is a 'Success'-value, False otherwise. isSuccess :: Validation e a -> Bool isSuccess (Success _) = True isSuccess _ = False -{- | Return the contents of a Failure-value or a default value otherwise. +{- | Return the contents of a 'Failure'-value or a default value otherwise. ==== __Examples__ @@ -75,7 +81,7 @@ fromFailure _ (Failure e) = e fromFailure e _ = e -{- | Return the contents of a Success-value or a default value otherwise. +{- | Return the contents of a 'Success'-value or a default value otherwise. ==== __Examples__ @@ -88,11 +94,11 @@ fromSuccess _ (Success a) = a fromSuccess a _ = a -{- | Extracts from a list of 'Validation' all the Failure elements, in order. +{- | Extracts from a list of 'Validation' all the 'Failure' values, in order. ==== __Examples__ ->>> failures ([Success 48, Failure "err1", Failure "err2", Success 2, Failure "err3"] :: [Validation String Int]) +>>> failures [Success 48, Failure "err1", Failure "err2", Success 2, Failure "err3"] ["err1","err2","err3"] >>> failures ([Success 1, Success 2, Success 3] :: [Validation String Int]) [] @@ -105,7 +111,7 @@ ==== __Examples__ ->>> successes ([Success 1, Failure "err1", Failure "err2", Success 2, Failure "err3"] :: [Validation String Int]) +>>> successes [Success 1, Failure "err1", Failure "err2", Success 2, Failure "err3"] [1,2] >>> successes ([Failure "err1", Failure "err2", Failure "err3"] :: [Validation String Int]) [] @@ -119,15 +125,15 @@ All the Left elements are extracted, in order, to the first component of the output. Similarly the Right elements are extracted to the second component of the output. -prop> partitionValidations xs = (failures xs, successes xs) +@partitionValidations xs = ('failures' xs, 'successes' xs)@ ==== __Examples__ ->>> partitionValidations ([Success 1, Failure "err1", Failure "err2", Success 2, Failure "err3"] :: [Validation String Int]) +>>> partitionValidations [Success 1, Failure "err1", Failure "err2", Success 2, Failure "err3"] (["err1","err2","err3"],[1,2]) -} partitionValidations :: [Validation e a] -> ([e], [a]) partitionValidations = foldr (validation failure success) ([],[]) - where - failure a ~(l, r) = (a:l, r) - success a ~(l, r) = (l, a:r) + where + failure a ~(l, r) = (a:l, r) + success a ~(l, r) = (l, a:r)
src/Valida/Validator.hs view
@@ -1,44 +1,55 @@-{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE Safe #-} module Valida.Validator - ( Selector - , Validator (..) + ( Validator (..) ) where import Data.List.NonEmpty (NonEmpty) +import Data.Profunctor (Profunctor (lmap, rmap)) import Data.Typeable (Typeable) import GHC.Generics (Generic) import Valida.Validation (Validation (..)) --- | Convenience alias for functions that "select" a record field. -type Selector a b = a -> b +{- | An applicative validator. Validates a predicate on an input when run and returns the 'Validation' result. --- | An applicative validator. Validates a predicate on an input when run and returns the 'Validation' result. +The type can be understood as- + +@ +Validator e inp a + ^ ^ ^------ The output type on successful validation + | | + Error type |-- The input on which validation is run +@ + +Validators are run using the __runValidator__ function. +The result is of type __Validation e a__, corresponding to the type params of the same name on 'Validator'. + +__Note__: All the primitive combinators (and derivative combinators) use the same type for @inp@ and @a@. +In those cases - upon successful validation, the input itself, wrapped in 'Success', is returned. +-} newtype Validator e inp a = Validator { runValidator :: inp -> Validation e a } deriving (Typeable, Generic) {- | - [@fmap@] 'fmap' maps given function over the 'Validation' result by re-using 'fmap' on it. -==== __Examples__ +__Examples__ ->>> runValidator (fmap (+1) (validate $ failureIf (==2) "IsTwo")) 3 +>>> runValidator (fmap (+1) (failureIf (==2) "IsTwo")) 3 Success 4 ->>> runValidator (fmap (+1) (validate $ failureIf (==2) "IsTwo")) 2 +>>> runValidator (fmap (+1) (failureIf (==2) "IsTwo")) 2 Failure ("IsTwo" :| []) -} instance Functor (Validator e inp) where fmap f (Validator v) = Validator $ fmap f . v {- | - [@pure@] 'pure' creates a 'Validator' that always yields given value wrapped in 'Success', ignoring its input. - -[@(<*>)@] '(<*>)' runs 2 validators to obtain the 2 'Validation' results and combines them with '(<*>)'. +[@(\<*\>)@] '(<*>)' runs 2 validators to obtain the 2 'Validation' results and combines them with '(<*>)'. This can be understood as- @ @@ -47,17 +58,15 @@ i.e Run __ff__ and __v__ on the input, and compose the 'Validation' results with '(<*>)'. -==== __Examples__ +__Examples__ >>> runValidator (pure 5) 42 Success 5 ->>> let v1 = validate (failureIf (==2) "IsTwo") ->>> let v2 = validate (failureIf even "IsEven") ->>> runValidator (const <$> v1 <*> v2) 5 +>>> runValidator (const <$> failureIf (==2) "IsTwo" <*> failureIf even "IsEven") 5 Success 5 ->>> runValidator (const <$> v1 <*> v2) 4 +>>> runValidator (const <$> failureIf (==2) "IsTwo" <*> failureIf even "IsEven") 4 Failure ("IsEven" :| []) ->>> runValidator (const <$> v1 <*> v2) 2 +>>> runValidator (const <$> failureIf (==2) "IsTwo" <*> failureIf even "IsEven") 2 Failure ("IsTwo" :| ["IsEven"]) -} instance Semigroup e => Applicative (Validator e inp) where @@ -70,26 +79,53 @@ {-# INLINEABLE (<*>) #-} {- | - -[@(<>)@] '(<>)' applies input over both validator functions, and combines the 'Validation' results using '(<>)'. - -==== __Examples__ +[@(<>)@] '(<>)' builds a validator that /succeeds/ only if both of the given validators succeed. +__Left-most__ failure is returned, other validator /is not used/ if one fails. If all validators succeed, +__right-most__ success is returned. -This essentially reuses the '(<>)' impl of 'Validation'. -i.e Returns the first 'Success'. But also accumulates 'Failure's. +__Examples__ ->>> let v1 = validate (failureIf (==2) "IsTwo") ->>> let v2 = validate (failureIf even "IsEven") +>>> let v1 = fixV (failureIf (==2) "IsTwo") +>>> let v2 = fixV (failureIf even "IsEven") >>> runValidator (v1 <> v2) 5 Success 5 >>> runValidator (v1 <> v2) 4 -Success 4 +Failure ("IsEven" :| []) >>> runValidator (v1 <> v2) 2 -Failure ("IsTwo" :| ["IsEven"]) +Failure ("IsTwo" :| []) -} -instance Semigroup e => Semigroup (Validator e inp a) where - {-# SPECIALIZE instance Semigroup (Validator (NonEmpty err) inp a) #-} - {-# SPECIALIZE instance Semigroup (Validator () inp a) #-} - {-# SPECIALIZE instance Semigroup (Validator [err] inp a) #-} - Validator f <> Validator g = Validator $ f <> g - {-# INLINEABLE (<>) #-} +instance Semigroup (Validator e inp a) where + Validator v1 <> Validator v2 = Validator $ \x -> case (v1 x, v2 x) of + (f@(Failure _), _) -> f + (_, b) -> b +{- | + +[@mempty@] 'mempty' is a validator that always succeeds and uses /unit/ as output type. + +__Examples__ + +>>> runValidator (mempty :: Validator String Int ()) 42 +Success () +-} +instance Monoid (Validator e inp ()) where + mempty = Validator $ const $ Success () + +{- | + +[@lmap@] 'lmap' runs given function on 'Validator' input before applying it to the validator function. +This is similar to the 'Data.Functor.Contravariant.Predicate' type. + +[@rmap@] 'rmap' is the same as 'fmap'. + +__Examples__ + +>>> runValidator (lmap fst (fixV $ failureIf (==2) "IsTwo")) (3, 2) +Success 3 +>>> runValidator (lmap snd (fixV $ failureIf (==2) "IsTwo")) (3, 2) +Failure ("IsTwo" :| []) +>>> runValidator (rmap (+1) (fixV $ failureIf (==2) "IsTwo")) 3 +Failure ("IsTwo" :| []) +-} +instance Profunctor (Validator e) where + lmap selector (Validator v) = Validator $ v . selector + rmap = fmap
test/Spec.hs view
@@ -2,9 +2,9 @@ ( main ) where -import Data.Bool (bool) import Data.Either (isRight) import Data.Foldable (Foldable (fold)) +import Data.Functor (void) import Data.List.NonEmpty (NonEmpty) import Data.Maybe (isNothing) import Data.Monoid (Sum) @@ -14,21 +14,17 @@ import qualified Test.Tasty.QuickCheck as QC import qualified Test.Tasty.SmallCheck as SC -import Valida (Validation (..), ValidationRule, Validator (runValidator), failureIf, failureIf', failureUnless, - failureUnless', failures, falseRule, fromEither, label, negateRule, negateRule', partitionValidations, - satisfyAll, satisfyAny, successes, toEither, validate, validation, validationConst, vrule, (-?>), (</>), - (<?>), (<??>)) +import Valida (Validation (..), Validator (runValidator), failV, failureIf, failureIf', failureUnless, failureUnless', + failures, fixV, fromEither, label, negateV, negateV', partitionValidations, satisfyAll, satisfyAny, + successes, toEither, validation, validationConst, (-?>), (</>), (<?>)) + import Gen (NonEmptyLQ, ValidationQ (..)) import Utils (neSingleton) --- | Helper to directly make a ValidationRule out of an error and predicate function. -predToVRule :: e -> (a -> Bool) -> ValidationRule e a -predToVRule err f = vrule $ bool (Failure err) (Success ()) . f - --- | Helper to build a validator and run it on input at once. -validatify :: ValidationRule e a -> a -> Validation e a -validatify = runValidator . validate +-- | Helper to build a validator with the raw given error. +validatorFrom :: (a -> Bool) -> e -> Validator e a a +validatorFrom predc err = failureUnless' predc <?> err -- | Test the primitive non empty combinators. testPrimCombs :: [TestTree] @@ -55,7 +51,7 @@ testValidator (failureUnless or, "Has True", [False, False, False], const . Failure . neSingleton) ] where - testValidator ~(rule, err, inp, expct) = rule err `validatify` inp @?= expct err inp + testValidator ~(validator, err, inp, expct) = validator err `runValidator` inp @?= expct err inp -- | Test the primitive unit combinators. testPrimCombs' :: [TestTree] @@ -82,7 +78,7 @@ testValidator (failureUnless' or, [False, False, False], const $ Failure ()) ] where - testValidator ~(rule, inp, expct) = rule `validatify` inp @?= expct inp + testValidator ~(validator, inp, expct) = validator `runValidator` inp @?= expct inp -- | Test the primitive unit combinators with labeled errors. testPrimCombs'' :: [TestTree] @@ -99,7 +95,7 @@ testValidator (failureUnless' or, "Has True", [False, False, False], Failure) ] where - testValidator ~(rule, err, inp, expct) = (rule <?> err) `validatify` inp @?= expct err + testValidator ~(validator, err, inp, expct) = (validator <?> err) `runValidator` inp @?= expct err -- | Test multiple validators combined. testValidatorCollc :: [TestTree] @@ -132,7 +128,7 @@ ) ] where - validatorOf f = validate $ predToVRule () f + validatorOf f = fixV $ validatorFrom f () testValidator ~(validator, inp, expct) = runValidator validator inp @?= expct inp -- | Test utility functions for Validation. @@ -186,22 +182,17 @@ partitionTest vqs = let xs = [v | ValidationQ v <- vqs] in partitionValidations xs == (failures xs, successes xs) --- | Test the label and labelV functions. +-- | Test the label and label functions. testLabel :: [TestTree] testLabel = - [ QC.testProperty "(QC) Validator should yield relabeled ValidationRule error upon failure" - (labelTest :: Int -> Char -> String -> Bool) - , SC.testProperty "(SC) Validator should yield relabeled ValidationRule error upon failure" - (labelTest :: [Int] -> Bool -> Char -> Bool) - , QC.testProperty "(QC) Validator should yield relabeled Bool error upon failure" - (labelVTest :: Sum Int -> Maybe Char -> String -> Bool) + [ QC.testProperty "(QC) Validator should yield relabeled Bool error upon failure" + (labelTest :: Sum Int -> Maybe Char -> String -> Bool) , SC.testProperty "(SC) Validator should yield relabeled Bool error upon failure" - (labelVTest :: [Int] -> Bool -> Char -> Bool) + (labelTest :: [Int] -> Bool -> Char -> Bool) ] where labelTest :: (Eq a, Eq e) => a -> e1 -> e -> Bool - labelTest inp err err' = (failureUnless (const False) err <?> err') `validatify` inp == Failure err' - labelVTest inp err err' = runValidator (validate (failureUnless (const False) err) <??> err') inp == Failure err' + labelTest inp err err' = runValidator (fixV (failureUnless (const False) err) <?> err') inp == Failure err' -- | Test validation errors being combined. testErrorPreservation :: [TestTree] @@ -212,7 +203,7 @@ where helper :: (Traversable t, Monoid e, Eq e, Eq (t inp)) => inp -> t e -> Bool helper inp errs = runValidator - (traverse (\e -> validate $ label e $ failureUnless' (const False)) errs) + (traverse (\e -> fixV $ label e $ failureUnless' (const False)) errs) inp == Failure (fold errs) -- | Test the relation between NonEmpty and Unit combinators. @@ -221,42 +212,42 @@ [ QC.testProperty "(QC) failureIf p err = label (const (neSingleton err)) (failureIf' p)" ((\predc inp err -> QC.classify (predc inp) "Significant" $ QC.classify (not $ predc inp) "Trivial" - $ failureIf predc err `validatify` inp - == (failureIf' predc <?> neSingleton err) `validatify` inp + $ failureIf predc err `runValidator` inp + == (failureIf' predc <?> neSingleton err) `runValidator` inp ) :: (Char -> Bool) -> Char -> String -> QC.Property ) , SC.testProperty "(SC) failureIf p err = label (const (neSingleton err)) (failureIf' p)" - ((\predc inp err -> failureIf predc err `validatify` inp - == (failureIf' predc <?> neSingleton err) `validatify` inp + ((\predc inp err -> failureIf predc err `runValidator` inp + == (failureIf' predc <?> neSingleton err) `runValidator` inp ) :: (Bool -> Bool) -> Bool -> Int -> Bool ) , QC.testProperty "(QC) failureUnless p err = label (const (neSingleton err)) (failureUnless' p)" ((\predc inp err -> QC.classify (not $ predc inp) "Significant" $ QC.classify (predc inp) "Trivial" - $ failureUnless predc err `validatify` inp - == (failureUnless' predc <?> neSingleton err) `validatify` inp + $ failureUnless predc err `runValidator` inp + == (failureUnless' predc <?> neSingleton err) `runValidator` inp ) :: (Char -> Bool) -> Char -> String -> QC.Property ) , SC.testProperty "(SC) failureUnless p err = label (const (neSingleton err)) (failureUnless' p)" - ((\predc inp err -> failureUnless predc err `validatify` inp - == (failureUnless' predc <?> neSingleton err) `validatify` inp + ((\predc inp err -> failureUnless predc err `runValidator` inp + == (failureUnless' predc <?> neSingleton err) `runValidator` inp ) :: (Bool -> Bool) -> Bool -> Int -> Bool ) ] --- | Test the negateRule function. -testNegateRule :: [TestTree] -testNegateRule = - [ QC.testProperty "(QC) negateRule . negateRule = id (assuming errors are unchanged)" +-- | Test the negateV function. +testnegateV :: [TestTree] +testnegateV = + [ QC.testProperty "(QC) negateV . negateV = id (assuming errors are unchanged)" (helper :: (String -> Bool, Int) -> String -> Bool) - , SC.testProperty "(SC) negateRule . negateRule = id (assuming errors are unchanged)" + , SC.testProperty "(SC) negateV . negateV = id (assuming errors are unchanged)" (helper :: (Bool -> Bool, [Bool]) -> Bool -> Bool) ] where helper :: (Eq a, Eq e) => (a -> Bool, e) -> a -> Bool - helper ~(predc, err) x = let rule = predToVRule err predc - in negateRule err (negateRule err rule) `validatify` x == rule `validatify` x - && negateRule' (negateRule' rule) `validatify` x == (rule <?> ()) `validatify` x + helper ~(predc, err) x = let validator = validatorFrom predc err + in negateV err (negateV err validator) `runValidator` x == validator `runValidator` x + && negateV' (negateV' validator) `runValidator` x == (validator <?> ()) `runValidator` x -- | Test the relation between failureIf and failureUnless. testIfUnlessRelation :: [TestTree] @@ -265,75 +256,75 @@ (helper :: (String -> Bool) -> String -> Bool) , SC.testProperty "(SC) failureIf' p = failureUnless' (not . p)" (helper :: (Bool -> Bool) -> Bool -> Bool) - , QC.testProperty "(QC) failureIf p err = negateRule (neSingleton err) (failureUnless' p)" + , QC.testProperty "(QC) failureIf p err = negateV (neSingleton err) (failureUnless' p)" (negateHelper :: (String -> Bool, String) -> String -> Bool) - , SC.testProperty "(SC) failureIf p err = negateRule (neSingleton err) (failureUnless' p)" + , SC.testProperty "(SC) failureIf p err = negateV (neSingleton err) (failureUnless' p)" (negateHelper :: (Bool -> Bool, Char) -> Bool -> Bool) - , QC.testProperty "(QC) failureIf' p = negateRule' (failureUnless' p)" + , QC.testProperty "(QC) failureIf' p = negateV' (failureUnless' p)" (negateHelper' :: (String -> Bool) -> String -> Bool) - , SC.testProperty "(SC) failureIf' p = negateRule' (failureUnless' p)" + , SC.testProperty "(SC) failureIf' p = negateV' (failureUnless' p)" (negateHelper' :: (Bool -> Bool) -> Bool -> Bool) ] where helper :: Eq a => (a -> Bool) -> a -> Bool - helper predc inp = failureIf' predc `validatify` inp - == failureUnless' (not . predc) `validatify` inp + helper predc inp = failureIf' predc `runValidator` inp + == failureUnless' (not . predc) `runValidator` inp negateHelper :: (Eq a, Eq e) => (a -> Bool, e) -> a -> Bool - negateHelper ~(predc, err) inp = failureIf predc err `validatify` inp - == negateRule (neSingleton err) (failureUnless' predc) `validatify` inp - && failureUnless predc err `validatify` inp - == negateRule (neSingleton err) (failureIf' predc) `validatify` inp + negateHelper ~(predc, err) inp = failureIf predc err `runValidator` inp + == negateV (neSingleton err) (failureUnless' predc) `runValidator` inp + && failureUnless predc err `runValidator` inp + == negateV (neSingleton err) (failureIf' predc) `runValidator` inp negateHelper' :: Eq a => (a -> Bool) -> a -> Bool - negateHelper' predc inp = failureIf' predc `validatify` inp - == negateRule' (failureUnless' predc) `validatify` inp - && failureUnless' predc `validatify` inp - == negateRule' (failureIf' predc) `validatify` inp + negateHelper' predc inp = failureIf' predc `runValidator` inp + == negateV' (failureUnless' predc) `runValidator` inp + && failureUnless' predc `runValidator` inp + == negateV' (failureIf' predc) `runValidator` inp -- | Test orElse properties. testOrElse :: [TestTree] testOrElse = - [ QC.testProperty "(QC) falseRule always fails" - (falseRuleTest :: String -> Bool) - , SC.testProperty "(SC) falseRule always fails" - (falseRuleTest :: Maybe Char -> Bool) - , QC.testProperty "(QC) Associativity: rule1 </> (rule2 </> rule3) = (rule1 </> rule2) </> rule3" + [ QC.testProperty "(QC) failV always fails" + (failVTest :: String -> Bool) + , SC.testProperty "(SC) failV always fails" + (failVTest :: Maybe Char -> Bool) + , QC.testProperty "(QC) Associativity: validator1 </> (validator2 </> validator3) = (validator1 </> validator2) </> validator3" (asscTest :: (Char -> Bool, String) -> (Char -> Bool, String) -> (Char -> Bool, String) -> Char -> Bool) - , SC.testProperty "(SC) Associativity: rule1 </> (rule2 </> rule3) = (rule1 </> rule2) </> rule3" + , SC.testProperty "(SC) Associativity: validator1 </> (validator2 </> validator3) = (validator1 </> validator2) </> validator3" (asscTest :: (Bool -> Bool, [()]) -> (Bool -> Bool, [()]) -> (Bool -> Bool, [()]) -> Bool -> Bool) - , QC.testProperty "(QC) Identity: rule </> falseRule = falseRule </> rule = rule" + , QC.testProperty "(QC) Identity: validator </> failV = failV </> validator = validator" (identTest :: (Int -> Bool, String) -> Int -> Bool) - , SC.testProperty "(SC) Identity: rule </> falseRule = falseRule </> rule = rule" + , SC.testProperty "(SC) Identity: validator </> failV = failV </> validator = validator" (identTest :: (Bool -> Bool, [Bool]) -> Bool -> Bool) - , QC.testProperty "(QC) Annihilator: rule </> mempty = mempty </> rule = mempty" - (annihilatorTest :: (Int -> Bool, String) -> Int -> Bool) - , SC.testProperty "(SC) Annihilator: rule </> mempty = mempty </> rule = mempty" - (annihilatorTest :: (Bool -> Bool, [Bool]) -> Bool -> Bool) - , QC.testProperty "(QC) Complement: rule </> (negateRule e rule) = (negateRule e rule) </> rule = Success" + , QC.testProperty "(QC) Annihilator: validator </> mempty = mempty </> validator = mempty" + (annihilatorTest :: ([Int] -> Bool, String) -> [Int] -> Bool) + , SC.testProperty "(SC) Annihilator: validator </> mempty = mempty </> validator = mempty" + (annihilatorTest :: (Maybe Bool -> Bool, [Bool]) -> Maybe Bool -> Bool) + , QC.testProperty "(QC) Complement: validator </> (negateV e validator) = (negateV e validator) </> validator = Success" (complmTest :: (Int -> Bool, String, String) -> Int -> Bool) - , SC.testProperty "(SC) Complement: rule </> (negateRule e rule) = (negateRule e rule) </> rule = Success" + , SC.testProperty "(SC) Complement: validator </> (negateV e validator) = (negateV e validator) </> validator = Success" (complmTest :: (Bool -> Bool, [Bool], [Bool]) -> Bool -> Bool) ] where - falseRuleTest :: Eq a => a -> Bool - falseRuleTest = (==Failure (mempty :: String)) . validatify falseRule + failVTest :: Eq a => a -> Bool + failVTest = (==Failure (mempty :: String)) . runValidator (fixV failV) asscTest :: (Eq a, Eq e, Semigroup e) => (a -> Bool, e) -> (a -> Bool, e) -> (a -> Bool, e) -> a -> Bool asscTest ~(f, err1) ~(g, err2) ~(h, err3) x = - let ~(rule1, rule2, rule3) = (predToVRule err1 f, predToVRule err2 g, predToVRule err3 h) - in (rule1 </> (rule2 </> rule3)) `validatify` x == ((rule1 </> rule2) </> rule3) `validatify` x + let ~(validator1, validator2, validator3) = (validatorFrom f err1, validatorFrom g err2, validatorFrom h err3) + in (validator1 </> (validator2 </> validator3)) `runValidator` x == ((validator1 </> validator2) </> validator3) `runValidator` x identTest :: (Eq a, Eq e, Monoid e) => (a -> Bool, e) -> a -> Bool - identTest ~(f, err) x = let rule = predToVRule err f - in (rule </> falseRule) `validatify` x == rule `validatify` x - && (falseRule </> rule) `validatify` x == rule `validatify` x - annihilatorTest :: (Eq a, Eq e, Monoid e) => (a -> Bool, e) -> a -> Bool - annihilatorTest ~(f, err) x = let rule = predToVRule err f - in (rule </> mempty) `validatify` x == Success x - && (mempty </> rule) `validatify` x == Success x + identTest ~(f, err) x = let validator = validatorFrom f err + in (validator </> failV) `runValidator` x == validator `runValidator` x + && (failV </> validator) `runValidator` x == validator `runValidator` x + annihilatorTest :: (Eq e, Monoid e) => (a -> Bool, e) -> a -> Bool + annihilatorTest ~(f, err) x = let validator = void $ validatorFrom f err + in (validator </> mempty) `runValidator` x == Success () + && (mempty </> validator) `runValidator` x == Success () complmTest :: (Eq a, Eq e, Semigroup e) => (a -> Bool, e, e) -> a -> Bool complmTest ~(f, err, err') x = - let rule = predToVRule err f - in let complmRule = negateRule err' rule - in (rule </> complmRule) `validatify` x == Success x - && (complmRule </> rule) `validatify` x == Success x + let validator = validatorFrom f err + in let complmvalidator = negateV err' validator + in (validator </> complmvalidator) `runValidator` x == Success x + && (complmvalidator </> validator) `runValidator` x == Success x {-# ANN testAndAlso "HLint: ignore Monoid law, right identity" #-} {-# ANN testAndAlso "HLint: ignore Monoid law, left identity" #-} @@ -344,51 +335,52 @@ (memptyTest :: String -> Bool) , SC.testProperty "(SC) mempty always succeeds" (memptyTest :: Maybe Char -> Bool) - , QC.testProperty "(QC) Associativity: rule1 <> (rule2 <> rule3) = (rule1 <> rule2) <> rule3" + , QC.testProperty "(QC) Associativity: validator1 <> (validator2 <> validator3) = (validator1 <> validator2) <> validator3" (asscTest :: (Char -> Bool, String) -> (Char -> Bool, String) -> (Char -> Bool, String) -> Char -> Bool) - , SC.testProperty "(SC) Associativity: rule1 <> (rule2 <> rule3) = (rule1 <> rule2) <> rule3" + , SC.testProperty "(SC) Associativity: validator1 <> (validator2 <> validator3) = (validator1 <> validator2) <> validator3" (asscTest :: (Bool -> Bool, [()]) -> (Bool -> Bool, [()]) -> (Bool -> Bool, [()]) -> Bool -> Bool) - , QC.testProperty "(QC) Identity: rule <> mempty = mempty <> rule = rule" - (identTest :: (Int -> Bool, String) -> Int -> Bool) - , SC.testProperty "(SC) Identity: rule <> mempty = mempty <> rule = rule" - (identTest :: (Bool -> Bool, [Bool]) -> Bool -> Bool) - , QC.testProperty "(QC) Annihilator: rule <> falseRule = falseRule <> rule = falseRule" + , QC.testProperty "(QC) Identity: validator <> mempty = mempty <> validator = validator" + (identTest :: ([Int] -> Bool, String) -> [Int] -> Bool) + , SC.testProperty "(SC) Identity: validator <> mempty = mempty <> validator = validator" + (identTest :: (Maybe Bool -> Bool, [Bool]) -> Maybe Bool -> Bool) + , QC.testProperty "(QC) Annihilator: validator <> failV = failV <> validator = failV" (annihilatorTest :: (Int -> Bool, String) -> Int -> Bool) - , SC.testProperty "(SC) Annihilator: rule <> falseRule = falseRule <> rule = falseRule" + , SC.testProperty "(SC) Annihilator: validator <> failV = failV <> validator = failV" (annihilatorTest :: (Bool -> Bool, [Bool]) -> Bool -> Bool) - , QC.testProperty "(QC) Complement: rule <> (negateRule e rule) = (negateRule e rule) <> rule = Failure" + , QC.testProperty "(QC) Complement: validator <> (negateV e validator) = (negateV e validator) <> validator = Failure" (complmTest :: (Int -> Bool, String, String) -> Int -> Bool) - , SC.testProperty "(SC) Complement: rule <> (negateRule e rule) = (negateRule e rule) <> rule = Failure" + , SC.testProperty "(SC) Complement: validator <> (negateV e validator) = (negateV e validator) <> validator = Failure" (complmTest :: (Bool -> Bool, [Bool], [Bool]) -> Bool -> Bool) - , QC.testProperty "(QC) Idempotence: rule <> rule = rule" + , QC.testProperty "(QC) Idempotence: validator <> validator = validator" (idempTest :: (Int -> Bool, String) -> Int -> Bool) - , SC.testProperty "(SC) Idempotence: rule <> rule = rule" + , SC.testProperty "(SC) Idempotence: validator <> validator = validator" (idempTest :: (Bool -> Bool, [Bool]) -> Bool -> Bool) ] where - memptyTest :: Eq a => a -> Bool - memptyTest = (==) <$> Success `asTypeOf` const (Failure "") <*> validatify mempty + memptyTest :: a -> Bool + memptyTest x = (Success () `asTypeOf` Failure "") + == runValidator mempty x asscTest :: (Eq a, Eq e) => (a -> Bool, e) -> (a -> Bool, e) -> (a -> Bool, e) -> a -> Bool asscTest ~(f, err1) (g, err2) (h, err3) x = - let ~(rule1, rule2, rule3) = (predToVRule err1 f, predToVRule err2 g, predToVRule err3 h) - in (rule1 <> (rule2 <> rule3)) `validatify` x == ((rule1 <> rule2) <> rule3) `validatify` x - identTest :: (Eq a, Eq e) => (a -> Bool, e) -> a -> Bool - identTest ~(f, err) x = let rule = predToVRule err f - in (rule <> mempty) `validatify` x == rule `validatify` x - && (mempty <> rule) `validatify` x == rule `validatify` x + let ~(validator1, validator2, validator3) = (validatorFrom f err1, validatorFrom g err2, validatorFrom h err3) + in (validator1 <> (validator2 <> validator3)) `runValidator` x == ((validator1 <> validator2) <> validator3) `runValidator` x + identTest :: Eq e => (a -> Bool, e) -> a -> Bool + identTest ~(f, err) x = let validator = void $ validatorFrom f err + in (validator <> mempty) `runValidator` x == validator `runValidator` x + && (mempty <> validator) `runValidator` x == validator `runValidator` x annihilatorTest :: (Eq a, Eq e, Monoid e) => (a -> Bool, e) -> a -> Bool - annihilatorTest ~(f, err) x = let rule = predToVRule err f - in (rule <> falseRule) `validatify` x == Failure (if f x then mempty else err) - && (falseRule <> rule) `validatify` x == Failure mempty + annihilatorTest ~(f, err) x = let validator = validatorFrom f err + in (validator <> failV) `runValidator` x == Failure (if f x then mempty else err) + && (failV <> validator) `runValidator` x == Failure mempty complmTest :: (Eq a, Eq e) => (a -> Bool, e, e) -> a -> Bool complmTest ~(f, err, err') x = - let rule = predToVRule err f - in let complmRule = negateRule err' rule - in (rule <> complmRule) `validatify` x == Failure (if f x then err' else err) - && (complmRule <> rule) `validatify` x == Failure (if f x then err' else err) + let validator = validatorFrom f err + in let complmvalidator = negateV err' validator + in (validator <> complmvalidator) `runValidator` x == Failure (if f x then err' else err) + && (complmvalidator <> validator) `runValidator` x == Failure (if f x then err' else err) idempTest :: (Eq a, Eq e) => (a -> Bool, e) -> a -> Bool - idempTest ~(f, err) x = let rule = predToVRule err f - in (rule <> rule) `validatify` x == rule `validatify` x + idempTest ~(f, err) x = let validator = validatorFrom f err + in (validator <> validator) `runValidator` x == validator `runValidator` x -- | Test the satisfyAny function. testSatisfyAny :: [TestTree] @@ -401,32 +393,32 @@ (rightFold1Test :: NonEmptyLQ (Int -> Bool, Sum Int) -> Int -> Bool) , SC.testProperty "satisfyAny = foldr1 orElse" (rightFold1Test :: NonEmptyLQ (Bool -> Bool, Maybe [Bool]) -> Bool -> Bool) - , QC.testProperty "satisfyAny = foldl orElse falseRule" + , QC.testProperty "satisfyAny = foldl orElse failV" (leftFoldTest :: NonEmptyLQ (Int -> Bool, Sum Int) -> Int -> Bool) - , SC.testProperty "satisfyAny = foldl orElse falseRule" + , SC.testProperty "satisfyAny = foldl orElse failV" (leftFoldTest :: NonEmptyLQ (Bool -> Bool, Maybe [Bool]) -> Bool -> Bool) - , QC.testProperty "satisfyAny = foldr orElse falseRule" + , QC.testProperty "satisfyAny = foldr orElse failV" (rightFoldTest :: NonEmptyLQ (Int -> Bool, Sum Int) -> Int -> Bool) - , SC.testProperty "satisfyAny = foldr orElse falseRule" + , SC.testProperty "satisfyAny = foldr orElse failV" (rightFoldTest :: NonEmptyLQ (Bool -> Bool, Maybe [Bool]) -> Bool -> Bool) ] where leftFold1Test :: (Eq a, Eq e, Semigroup e) => NonEmptyLQ (a -> Bool, e) -> a -> Bool - leftFold1Test predcs x = let rules = (\(f, err) -> predToVRule err f) <$> predcs - in satisfyAny rules `validatify` x - == foldl1 (</>) rules `validatify` x + leftFold1Test predcs x = let validators = uncurry validatorFrom <$> predcs + in satisfyAny validators `runValidator` x + == foldl1 (</>) validators `runValidator` x rightFold1Test :: (Eq a, Eq e, Semigroup e) => NonEmptyLQ (a -> Bool, e) -> a -> Bool - rightFold1Test predcs x = let rules = (\(f, err) -> predToVRule err f) <$> predcs - in satisfyAny rules `validatify` x - == foldr1 (</>) rules `validatify` x + rightFold1Test predcs x = let validators = uncurry validatorFrom <$> predcs + in satisfyAny validators `runValidator` x + == foldr1 (</>) validators `runValidator` x leftFoldTest :: (Eq a, Eq e, Monoid e) => NonEmptyLQ (a -> Bool, e) -> a -> Bool - leftFoldTest predcs x = let rules = (\(f, err) -> predToVRule err f) <$> predcs - in satisfyAny rules `validatify` x - == foldl (</>) falseRule rules `validatify` x + leftFoldTest predcs x = let validators = uncurry validatorFrom <$> predcs + in satisfyAny validators `runValidator` x + == foldl (</>) failV validators `runValidator` x rightFoldTest :: (Eq a, Eq e, Monoid e) => NonEmptyLQ (a -> Bool, e) -> a -> Bool - rightFoldTest predcs x = let rules = (\(f, err) -> predToVRule err f) <$> predcs - in satisfyAny rules `validatify` x - == foldr (</>) falseRule rules `validatify` x + rightFoldTest predcs x = let validators = uncurry validatorFrom <$> predcs + in satisfyAny validators `runValidator` x + == foldr (</>) failV validators `runValidator` x {-# ANN testSatisfyAll "HLint: ignore Use mconcat" #-} -- | Test the satisfyAll function. @@ -454,28 +446,28 @@ (rightFoldTest :: NonEmptyLQ (Bool -> Bool, Maybe [Bool]) -> Bool -> Bool) ] where - foldTest :: (Eq a, Eq e) => NonEmptyLQ (a -> Bool, e) -> a -> Bool - foldTest predcs x = let rules = (\(f, err) -> predToVRule err f) <$> predcs - in satisfyAll rules `validatify` x - == fold rules `validatify` x + foldTest :: Eq e => NonEmptyLQ (a -> Bool, e) -> a -> Bool + foldTest predcs x = let validators = fmap void $ uncurry validatorFrom <$> predcs + in satisfyAll validators `runValidator` x + == fold validators `runValidator` x leftFold1Test :: (Eq a, Eq e) => NonEmptyLQ (a -> Bool, e) -> a -> Bool - leftFold1Test predcs x = let rules = (\(f, err) -> predToVRule err f) <$> predcs - in satisfyAll rules `validatify` x - == foldl1 (<>) rules `validatify` x + leftFold1Test predcs x = let validators = uncurry validatorFrom <$> predcs + in satisfyAll validators `runValidator` x + == foldl1 (<>) validators `runValidator` x rightFold1Test :: (Eq a, Eq e) => NonEmptyLQ (a -> Bool, e) -> a -> Bool - rightFold1Test predcs x = let rules = (\(f, err) -> predToVRule err f) <$> predcs - in satisfyAll rules `validatify` x - == foldr1 (<>) rules `validatify` x - leftFoldTest :: (Eq a, Eq e) => NonEmptyLQ (a -> Bool, e) -> a -> Bool - leftFoldTest predcs x = let rules = (\(f, err) -> predToVRule err f) <$> predcs - in satisfyAll rules `validatify` x - == foldl (<>) mempty rules `validatify` x - rightFoldTest :: (Eq a, Eq e) => NonEmptyLQ (a -> Bool, e) -> a -> Bool - rightFoldTest predcs x = let rules = (\(f, err) -> predToVRule err f) <$> predcs - in satisfyAll rules `validatify` x - == foldr (<>) mempty rules `validatify` x + rightFold1Test predcs x = let validators = uncurry validatorFrom <$> predcs + in satisfyAll validators `runValidator` x + == foldr1 (<>) validators `runValidator` x + leftFoldTest :: Eq e => NonEmptyLQ (a -> Bool, e) -> a -> Bool + leftFoldTest predcs x = let validators = fmap void $ uncurry validatorFrom <$> predcs + in satisfyAll validators `runValidator` x + == foldl (<>) mempty validators `runValidator` x + rightFoldTest :: Eq e => NonEmptyLQ (a -> Bool, e) -> a -> Bool + rightFoldTest predcs x = let validators = fmap void $ uncurry validatorFrom <$> predcs + in satisfyAll validators `runValidator` x + == foldr (<>) mempty validators `runValidator` x --- | Test ValidationRule combinators. +-- | Test Validator combinators. testCombs :: [TestTree] testCombs = [ testGroup "Test primitive NonEmpty combinators" testPrimCombs @@ -485,7 +477,7 @@ , testGroup "Test relationship between primitive 'if' and 'unless' combinators" testIfUnlessRelation ] --- | Test functions that combine ValidationRules. +-- | Test functions that combine Validators. testCombMix :: [TestTree] testCombMix = [ testGroup "Test `orElse` function" testOrElse @@ -496,9 +488,9 @@ main :: IO () main = defaultMain $ testGroup "Test suite" - [ testGroup "Test ValidationRule combinators" testCombs - , testGroup "Test negateRule function" testNegateRule - , testGroup "Test ValidationRule combining functions" testCombMix + [ testGroup "Test Validator combinators" testCombs + , testGroup "Test negateV function" testnegateV + , testGroup "Test Validator combining functions" testCombMix , testGroup "Test validation of a collection of Validators" testValidatorCollc , testGroup "Test Validation utilities" testValidationUtils , testGroup "Test Validator relabeling" testLabel
valida.cabal view
@@ -1,64 +1,65 @@ cabal-version: 1.12 ---- This file has been generated from package.yaml by hpack version 0.34.4.------ see: https://github.com/sol/hpack--name: valida-version: 0.1.0-synopsis: Simple applicative validation for product types, batteries included!-description: Please see the README on GitHub at <https://github.com/TotallyNotChase/valida#readme>-category: Validation, Data-homepage: https://github.com/TotallyNotChase/valida#readme-bug-reports: https://github.com/TotallyNotChase/valida/issues-author: Chase-maintainer: totallynotchase42@gmail.com-copyright: TotallyNotChase-license: MIT-license-file: LICENSE-build-type: Simple-extra-source-files:- README.md- ChangeLog.md--source-repository head- type: git- location: https://github.com/TotallyNotChase/valida--library- exposed-modules:- Valida- Valida.Combinators- other-modules:- Valida.Utils- Valida.Validation- Valida.ValidationRule- Valida.ValidationUtils- Valida.Validator- Paths_valida- hs-source-dirs:- src- ghc-options: -Wall -Wcompat -Widentities -Wincomplete-uni-patterns -Wmissed-specialisations -Wmissing-export-lists -Wpartial-fields -Wredundant-constraints -O2- build-depends:- base >=4.13 && <5- default-language: Haskell2010--test-suite valida-test- type: exitcode-stdio-1.0- main-is: Spec.hs- other-modules:- Gen- Utils- Paths_valida- hs-source-dirs:- test- ghc-options: -Wall -Wcompat -Widentities -Wincomplete-uni-patterns -Wmissed-specialisations -Wmissing-export-lists -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N- build-depends:- base >=4.13 && <5- , smallcheck- , tasty- , tasty-hunit- , tasty-quickcheck- , tasty-smallcheck- , valida- default-language: Haskell2010+ +-- This file has been generated from package.yaml by hpack version 0.34.4. +-- +-- see: https://github.com/sol/hpack + +name: valida +version: 1.0.0 +synopsis: Simple applicative validation for product types, batteries included! +description: This package provides an applicative validator with support for contravariance. This makes building validators for product types idiomatic and simple. Many common utilities for building validators are also included. +category: Validation, Data +homepage: https://github.com/TotallyNotChase/valida#readme +bug-reports: https://github.com/TotallyNotChase/valida/issues +author: Chase +maintainer: totallynotchase42@gmail.com +copyright: TotallyNotChase +license: MIT +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://github.com/TotallyNotChase/valida + +library + exposed-modules: + Valida + Valida.Combinators + other-modules: + Valida.Utils + Valida.Validation + Valida.ValidationUtils + Valida.Validator + Paths_valida + hs-source-dirs: + src + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-uni-patterns -Wmissed-specialisations -Wmissing-export-lists -Wpartial-fields -Wredundant-constraints -O2 + build-depends: + base >=4.12 && <5 + , profunctors >=5 + default-language: Haskell2010 + +test-suite valida-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Gen + Utils + Paths_valida + hs-source-dirs: + test + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-uni-patterns -Wmissed-specialisations -Wmissing-export-lists -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.12 && <5 + , profunctors >=5 + , smallcheck >=1.2 + , tasty + , tasty-hunit + , tasty-quickcheck + , tasty-smallcheck + , valida + default-language: Haskell2010