├── .gitignore ├── package.json ├── .github ├── PULL_REQUEST_TEMPLATE.md └── workflows │ └── ci.yml ├── bower.json ├── README.md ├── LICENSE ├── CHANGELOG.md ├── src └── Data │ └── Validation │ ├── Semigroup.purs │ └── Semiring.purs └── examples └── Semigroup.purs /.gitignore: -------------------------------------------------------------------------------- 1 | /.* 2 | !/.gitignore 3 | !/.github/ 4 | package-lock.json 5 | /bower_components/ 6 | /node_modules/ 7 | /output/ 8 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "scripts": { 4 | "clean": "rimraf output && rimraf .pulp-cache", 5 | "build": "pulp build -- --censor-lib --strict", 6 | "build:example": "pulp build --include examples" 7 | }, 8 | "devDependencies": { 9 | "pulp": "16.0.0-0", 10 | "purescript-psa": "^0.8.2", 11 | "rimraf": "^3.0.2" 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | **Description of the change** 2 | 3 | Clearly and concisely describe the purpose of the pull request. If this PR relates to an existing issue or change proposal, please link to it. Include any other background context that would help reviewers understand the motivation for this PR. 4 | 5 | --- 6 | 7 | **Checklist:** 8 | 9 | - [ ] Added the change to the changelog's "Unreleased" section with a reference to this PR (e.g. "- Made a change (#0000)") 10 | - [ ] Linked any existing issues or proposals that this pull request should close 11 | - [ ] Updated or added relevant documentation 12 | - [ ] Added a test for the contribution (if applicable) 13 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [master] 6 | pull_request: 7 | branches: [master] 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | steps: 13 | - uses: actions/checkout@v2 14 | 15 | - uses: purescript-contrib/setup-purescript@main 16 | with: 17 | purescript: "unstable" 18 | 19 | - uses: actions/setup-node@v2 20 | with: 21 | node-version: "14.x" 22 | 23 | - name: Install dependencies 24 | run: | 25 | npm install -g bower 26 | npm install 27 | bower install --production 28 | 29 | - name: Build source 30 | run: npm run-script build 31 | 32 | - name: Run tests 33 | run: | 34 | bower install 35 | npm run-script test --if-present 36 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-validation", 3 | "homepage": "https://github.com/purescript/purescript-validation", 4 | "license": "BSD-3-Clause", 5 | "repository": { 6 | "type": "git", 7 | "url": "https://github.com/purescript/purescript-validation.git" 8 | }, 9 | "ignore": [ 10 | "**/.*", 11 | "bower_components", 12 | "node_modules", 13 | "output", 14 | "test", 15 | "bower.json", 16 | "package.json" 17 | ], 18 | "dependencies": { 19 | "purescript-bifunctors": "^6.0.0", 20 | "purescript-control": "^6.0.0", 21 | "purescript-either": "^6.0.0", 22 | "purescript-foldable-traversable": "^6.0.0", 23 | "purescript-newtype": "^5.0.0", 24 | "purescript-prelude": "^6.0.0" 25 | }, 26 | "devDependencies": { 27 | "purescript-console": "^6.0.0", 28 | "purescript-ordered-collections": "^3.0.0", 29 | "purescript-psci-support": "^6.0.0", 30 | "purescript-strings": "^6.0.0" 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-validation 2 | 3 | [![Latest release](http://img.shields.io/github/release/purescript/purescript-validation.svg)](https://github.com/purescript/purescript-validation/releases) 4 | [![Build status](https://github.com/purescript/purescript-validation/workflows/CI/badge.svg?branch=master)](https://github.com/purescript/purescript-validation/actions?query=workflow%3ACI+branch%3Amaster) 5 | [![Pursuit](https://pursuit.purescript.org/packages/purescript-validation/badge)](https://pursuit.purescript.org/packages/purescript-validation) 6 | 7 | Applicative validation. 8 | 9 | ## Installation 10 | 11 | ``` 12 | spago install validation 13 | ``` 14 | 15 | ## Documentation 16 | 17 | Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-validation). 18 | 19 | There is also an [entire chapter in PureScript by Example](https://book.purescript.org/chapter7.html#applicative-validation-1) dedicated to describing how to use this module. 20 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2018 PureScript 2 | 3 | Redistribution and use in source and binary forms, with or without modification, 4 | are permitted provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this 7 | list of conditions and the following disclaimer. 8 | 9 | 2. Redistributions in binary form must reproduce the above copyright notice, 10 | this list of conditions and the following disclaimer in the documentation and/or 11 | other materials provided with the distribution. 12 | 13 | 3. Neither the name of the copyright holder nor the names of its contributors 14 | may be used to endorse or promote products derived from this software without 15 | specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 21 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 22 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 23 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 24 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). 4 | 5 | ## [Unreleased] 6 | 7 | Breaking changes: 8 | 9 | New features: 10 | 11 | Bugfixes: 12 | 13 | Other improvements: 14 | 15 | ## [v6.0.0](https://github.com/purescript/purescript-validation/releases/tag/v6.0.0) - 2022-04-27 16 | 17 | Breaking changes: 18 | - Update project and deps to PureScript v0.15.0 (#37 by @JordanMartinez) 19 | - Drop deprecated `unV`; use `validation` instead (#38 by @JordanMartinez) 20 | 21 | New features: 22 | 23 | Bugfixes: 24 | 25 | Other improvements: 26 | 27 | ## [v5.0.0](https://github.com/purescript/purescript-validation/releases/tag/v5.0.0) - 2021-02-26 28 | 29 | Breaking changes: 30 | - Added support for PureScript 0.14 and dropped support for all previous versions (#28) 31 | 32 | New features: 33 | 34 | Bugfixes: 35 | 36 | Other improvements: 37 | - Added detailed `Semigroup` validation examples (#17) 38 | - Added link to to Applicative Validation chapter in the PureScript book (#29) 39 | - Migrated CI to GitHub Actions and updated installation instructions to use Spago (#30) 40 | - Renamed `unV` to `validation` and deprecated `unV` (#33) 41 | - Added a changelog and pull request template (#34, #35) 42 | 43 | ## [v4.2.0](https://github.com/purescript/purescript-validation/releases/tag/v4.2.0) - 2019-01-24 44 | 45 | - Exposed constructors for `V` types 46 | 47 | ## [v4.1.0](https://github.com/purescript/purescript-validation/releases/tag/v4.1.0) - 2019-01-14 48 | 49 | - Add `andThen` for chaining validations (@colin-lamed) 50 | 51 | ## [v4.0.0](https://github.com/purescript/purescript-validation/releases/tag/v4.0.0) - 2018-05-24 52 | 53 | - Updated for PureScript 0.12 54 | - Added `toEither` functions 55 | - Removed non-law-abiding `Alternative` instance for `Semiring` validation 56 | 57 | ## [v3.2.0](https://github.com/purescript/purescript-validation/releases/tag/v3.2.0) - 2017-11-06 58 | 59 | - Added `Foldable` and `Traversable` instances 60 | 61 | ## [v3.1.0](https://github.com/purescript/purescript-validation/releases/tag/v3.1.0) - 2017-06-03 62 | 63 | - Added `Monoid` instances (@safareli) 64 | 65 | ## [v3.0.0](https://github.com/purescript/purescript-validation/releases/tag/v3.0.0) - 2017-03-25 66 | 67 | - Updated for PureScript 0.11 68 | 69 | ## [v2.0.0](https://github.com/purescript/purescript-validation/releases/tag/v2.0.0) - 2016-10-07 70 | 71 | - Updated dependencies 72 | - Added `Bifunctor` instances for the `V` types 73 | 74 | ## [v1.0.0](https://github.com/purescript/purescript-validation/releases/tag/v1.0.0) - 2016-06-01 75 | 76 | This release is intended for the PureScript 0.9.1 compiler and newer. 77 | 78 | **Note**: The v1.0.0 tag is not meant to indicate the library is “finished”, the core libraries are all being bumped to this for the 0.9 compiler release so as to use semver more correctly. 79 | 80 | ## [v0.2.1](https://github.com/purescript/purescript-validation/releases/tag/v0.2.1) - 2015-10-20 81 | 82 | - Fixed warning (@anttih) 83 | 84 | ## [v0.2.0](https://github.com/purescript/purescript-validation/releases/tag/v0.2.0) - 2015-06-30 85 | 86 | This release works with versions 0.7.\* of the PureScript compiler. It will not work with older versions. If you are using an older version, you should require an older, compatible version of this library. 87 | 88 | ## [v0.1.1](https://github.com/purescript/purescript-validation/releases/tag/v0.1.1) - 2015-03-23 89 | 90 | - Add `Data.Validation.Semiring` (@cryogenian) 91 | 92 | ## [v0.1.0](https://github.com/purescript/purescript-validation/releases/tag/v0.1.0) - 2015-03-20 93 | 94 | - Updated docs 95 | 96 | ## [v0.0.3](https://github.com/purescript/purescript-validation/releases/tag/v0.0.3) - 2014-07-26 97 | 98 | - Updated docs 99 | 100 | ## [v0.0.2](https://github.com/purescript/purescript-validation/releases/tag/v0.0.2) - 2014-04-26 101 | 102 | - Removed test-related code 103 | 104 | ## [0.0.1](https://github.com/purescript/purescript-validation/releases/tag/0.0.1) - 2014-04-25 105 | 106 | - Initial release 107 | -------------------------------------------------------------------------------- /src/Data/Validation/Semigroup.purs: -------------------------------------------------------------------------------- 1 | -- | This module defines an applicative functor for _applicative validation_. 2 | -- | 3 | -- | Applicative validation differs from monadic validation using `Either` in 4 | -- | that it allows us to collect multiple errors using a `Semigroup`, whereas 5 | -- | `Either` terminates on the first error. 6 | 7 | module Data.Validation.Semigroup 8 | ( V(..) 9 | , validation 10 | , invalid 11 | , isValid 12 | , toEither 13 | , andThen 14 | ) where 15 | 16 | import Prelude 17 | 18 | import Control.Apply (lift2) 19 | import Data.Bifunctor (class Bifunctor) 20 | import Data.Either (Either(..)) 21 | import Data.Eq (class Eq1) 22 | import Data.Foldable (class Foldable) 23 | import Data.Ord (class Ord1) 24 | import Data.Traversable (class Traversable) 25 | import Data.Newtype (class Newtype) 26 | 27 | -- | The `V` functor, used for applicative validation 28 | -- | 29 | -- | The `Applicative` instance collects multiple failures in 30 | -- | an arbitrary `Semigroup`. 31 | -- | 32 | -- | For example: 33 | -- | 34 | -- | ```purescript 35 | -- | validate :: Person -> V (Array Error) Person 36 | -- | validate person = { first: _, last: _, email: _ } 37 | -- | <$> validateName person.first 38 | -- | <*> validateName person.last 39 | -- | <*> validateEmail person.email 40 | -- | ``` 41 | newtype V err result = V (Either err result) 42 | 43 | derive instance newtypeV :: Newtype (V err result) _ 44 | 45 | -- | Takes two functions an a `V` value, if the validation failed the error is 46 | -- | applied to the first function, if the validation succeeded the inner value 47 | -- | is applied to the second function. 48 | validation :: forall err result r. (err -> r) -> (result -> r) -> V err result -> r 49 | validation f _ (V (Left err)) = f err 50 | validation _ g (V (Right result)) = g result 51 | 52 | -- | Fail with a validation error. 53 | invalid :: forall err result. err -> V err result 54 | invalid = V <<< Left 55 | 56 | -- | Test whether validation was successful or not. 57 | isValid :: forall err result. V err result -> Boolean 58 | isValid (V (Right _)) = true 59 | isValid _ = false 60 | 61 | toEither :: forall err result. V err result -> Either err result 62 | toEither (V e) = e 63 | 64 | -- | Apply a function if successful, to enable chaining of validation. 65 | -- | 66 | -- | Similar to a monadic bind, except it is inconsistent with Apply - that is, 67 | -- | where as apply accumulates failures: `apply (invalid x) (invalid y) = invalid (x <> y)`, 68 | -- | andThen has fail-fast semantics: `andThen (invalid x) (\_ -> invalid y) = invalid x` 69 | -- | (`>>=` would be expected to be consistent). 70 | andThen :: forall err a b. V err a -> (a -> V err b) -> V err b 71 | andThen v1 f = 72 | validation invalid f v1 73 | 74 | derive instance eqV :: (Eq err, Eq result) => Eq (V err result) 75 | derive instance eq1V :: Eq err => Eq1 (V err) 76 | 77 | derive instance ordV :: (Ord err, Ord result) => Ord (V err result) 78 | derive instance ord1V :: Ord err => Ord1 (V err) 79 | 80 | instance showV :: (Show err, Show result) => Show (V err result) where 81 | show = case _ of 82 | V (Left err) -> "invalid (" <> show err <> ")" 83 | V (Right result) -> "pure (" <> show result <> ")" 84 | 85 | derive newtype instance functorV :: Functor (V err) 86 | 87 | derive newtype instance bifunctorV :: Bifunctor V 88 | 89 | instance applyV :: Semigroup err => Apply (V err) where 90 | apply (V (Left err1)) (V (Left err2)) = V (Left (err1 <> err2)) 91 | apply (V (Left err)) _ = V (Left err) 92 | apply _ (V (Left err)) = V (Left err) 93 | apply (V (Right f)) (V (Right x)) = V (Right (f x)) 94 | 95 | instance applicativeV :: Semigroup err => Applicative (V err) where 96 | pure = V <<< Right 97 | 98 | instance semigroupV :: (Semigroup err, Semigroup a) => Semigroup (V err a) where 99 | append = lift2 append 100 | 101 | instance monoidV :: (Semigroup err, Monoid a) => Monoid (V err a) where 102 | mempty = pure mempty 103 | 104 | instance foldableV :: Foldable (V err) where 105 | foldMap = validation (const mempty) 106 | foldr f b = validation (const b) (flip f b) 107 | foldl f b = validation (const b) (f b) 108 | 109 | instance traversableV :: Traversable (V err) where 110 | sequence = validation (pure <<< V <<< Left) (map (V <<< Right)) 111 | traverse f = validation (pure <<< V <<< Left) (map (V <<< Right) <<< f) 112 | -------------------------------------------------------------------------------- /src/Data/Validation/Semiring.purs: -------------------------------------------------------------------------------- 1 | -- | This module defines a variant of applicative validation with 2 | -- | an `Alt` instance, for validators which support errors 3 | -- | with multiple alternatives. 4 | module Data.Validation.Semiring 5 | ( V(..) 6 | , validation 7 | , invalid 8 | , isValid 9 | , toEither 10 | , andThen 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Control.Alt (class Alt) 16 | import Control.Apply (lift2) 17 | import Control.Plus (class Plus) 18 | import Data.Bifunctor (class Bifunctor) 19 | import Data.Either (Either(..)) 20 | import Data.Eq (class Eq1) 21 | import Data.Foldable (class Foldable) 22 | import Data.Ord (class Ord1) 23 | import Data.Traversable (class Traversable) 24 | import Data.Newtype (class Newtype) 25 | 26 | -- | The `V` functor, used for alternative validation 27 | -- | 28 | -- | The `Alternative` instance collects multiple failures in 29 | -- | an arbitrary `Semiring`. 30 | -- | 31 | -- | For example: 32 | -- | 33 | -- | ```purescript 34 | -- | import Data.Semiring.Free 35 | -- | 36 | -- | validate r :: Person -> V (Free Error) Person 37 | -- | validate person = { first: _, last: _, contact: _} 38 | -- | <$> validateName person.first 39 | -- | <*> validateName person.last 40 | -- | <*> (validateEmail person.contact <|> validatePhone person.contact) 41 | -- | ``` 42 | newtype V err result = V (Either err result) 43 | 44 | derive instance newtypeV :: Newtype (V err result) _ 45 | 46 | -- | Takes two functions an a `V` value, if the validation failed the error is 47 | -- | applied to the first function, if the validation succeeded the inner value 48 | -- | is applied to the second function. 49 | validation :: forall err result r. (err -> r) -> (result -> r) -> V err result -> r 50 | validation f _ (V (Left err)) = f err 51 | validation _ g (V (Right result)) = g result 52 | 53 | -- | Fail with a validation error. 54 | invalid :: forall err result. err -> V err result 55 | invalid = V <<< Left 56 | 57 | -- | Test whether validation was successful or not. 58 | isValid :: forall err result. V err result -> Boolean 59 | isValid (V (Right _)) = true 60 | isValid _ = false 61 | 62 | toEither :: forall err result. V err result -> Either err result 63 | toEither (V e) = e 64 | 65 | -- | Apply a function if successful, to enable chaining of validation. 66 | -- | 67 | -- | Similar to a monadic bind, except it is inconsistent with Apply - that is, 68 | -- | where as `apply (V err a) (V err a)` accumulates failures, 69 | -- | `(V err a) ``andThen`` (\a -> V err a)` has fail-fast semantics 70 | -- | (`>>=` would be expected to be consistent). 71 | andThen :: forall err a b. V err a -> (a -> V err b) -> V err b 72 | andThen v1 f = 73 | validation invalid f v1 74 | 75 | derive instance eqV :: (Eq err, Eq result) => Eq (V err result) 76 | derive instance eq1V :: Eq err => Eq1 (V err) 77 | 78 | derive instance ordV :: (Ord err, Ord result) => Ord (V err result) 79 | derive instance ord1V :: Ord err => Ord1 (V err) 80 | 81 | instance showV :: (Show err, Show result) => Show (V err result) where 82 | show = case _ of 83 | V (Left err) -> "invalid (" <> show err <> ")" 84 | V (Right result) -> "pure (" <> show result <> ")" 85 | 86 | derive newtype instance functorV :: Functor (V err) 87 | 88 | derive newtype instance bifunctorV :: Bifunctor V 89 | 90 | instance applyV :: Semiring err => Apply (V err) where 91 | apply (V (Left err1)) (V (Left err2)) = V (Left (err1 * err2)) 92 | apply (V (Left err)) _ = V (Left err) 93 | apply _ (V (Left err)) = V (Left err) 94 | apply (V (Right f)) (V (Right x)) = V (Right (f x)) 95 | 96 | instance applicativeV :: Semiring err => Applicative (V err) where 97 | pure = V <<< Right 98 | 99 | instance semigroupV :: (Semiring err, Semigroup a) => Semigroup (V err a) where 100 | append = lift2 append 101 | 102 | instance monoidV :: (Semiring err, Monoid a) => Monoid (V err a) where 103 | mempty = pure mempty 104 | 105 | instance altV :: Semiring err => Alt (V err) where 106 | alt (V (Left err1)) (V (Left err2)) = V (Left (err1 + err2)) 107 | alt (V (Left _)) a = a 108 | alt (V (Right a)) _ = V (Right a) 109 | 110 | instance plusV :: Semiring err => Plus (V err) where 111 | empty = V (Left zero) 112 | 113 | instance foldableV :: Foldable (V err) where 114 | foldMap = validation (const mempty) 115 | foldr f b = validation (const b) (flip f b) 116 | foldl f b = validation (const b) (f b) 117 | 118 | instance traversableV :: Traversable (V err) where 119 | sequence = validation (pure <<< V <<< Left) (map (V <<< Right)) 120 | traverse f = validation (pure <<< V <<< Left) (map (V <<< Right) <<< f) 121 | -------------------------------------------------------------------------------- /examples/Semigroup.purs: -------------------------------------------------------------------------------- 1 | module Semigroup where 2 | 3 | import Prelude 4 | 5 | import Effect (Effect) 6 | import Effect.Console (logShow) 7 | import Data.Array.NonEmpty (NonEmptyArray) 8 | import Data.Array.NonEmpty as NonEmpty 9 | import Data.Bifunctor (bimap) 10 | import Data.Generic.Rep (class Generic) 11 | import Data.Generic.Rep.Eq (genericEq) 12 | import Data.Generic.Rep.Ord (genericCompare) 13 | import Data.Generic.Rep.Show (genericShow) 14 | import Data.Map (Map) 15 | import Data.Map as Map 16 | import Data.Newtype (class Newtype, over2) 17 | import Data.String (length, null, toLower, toUpper) 18 | import Data.Validation.Semigroup (V, invalid) 19 | 20 | -- | `UnvalidatedFormData` represents the raw data we might receive from a form 21 | -- | before any validation has been performed. 22 | -- | 23 | -- | Note that both the `username` and `password` fields in this record are 24 | -- | simple `String` types. 25 | type UnvalidatedFormData = 26 | { username :: String 27 | , password :: String 28 | } 29 | 30 | -- | `Username` is a wrapper around `String` that allows us to distinguish a 31 | -- | field containing a valid username from any other potential `String`s. 32 | newtype Username = Username String 33 | 34 | -- | `Password` is a wrapper around `String` that allows us to distinguish a 35 | -- | field containing a valid password from any other potential `String`s. 36 | newtype Password = Password String 37 | 38 | -- | `ValidatedFormData` represents the valid data from a form that is produced 39 | -- | as a result of our validation process. 40 | -- | 41 | -- | Note that the `username` and `password` fields that were simple `String`s 42 | -- | in `UnvalidatedFormData` are now `Username` and `Password`, respectively. 43 | type ValidatedFormData = 44 | { username :: Username 45 | , password :: Password 46 | } 47 | 48 | toString :: ValidatedFormData -> String 49 | toString { username: (Username u)} = "{ username: '" <> u <> "', password: }" 50 | 51 | -- | `ValidationError` represents the potential errors we might encounter during 52 | -- | the validation process. 53 | data ValidationError 54 | = FieldIsEmpty 55 | | FieldIsTooShort 56 | | FieldIsAllLower 57 | | FieldIsAllUpper 58 | 59 | -- | Generically derive a `Show` instance for `ValidationError` so that we may 60 | -- | print these errors to the console later. 61 | derive instance genericValidationError :: Generic ValidationError _ 62 | instance showValidationError :: Show ValidationError where 63 | show = genericShow 64 | 65 | -- | A note on `Data.Validation.Semigroup`'s `V`: 66 | -- | 67 | -- | `V` is a sum type with an `Invalid` side that collects the errors 68 | -- | encountered during the validation process, and a `Valid` side that holds 69 | -- | the result of the successful validation. 70 | 71 | -- | This function validates that an input `String` is not empty. 72 | -- | 73 | -- | If the input is empty, it returns a `FieldIsEmpty` error on the `Invalid` 74 | -- | side of `V`. 75 | -- | 76 | -- | Otherwise, it just returns the input on the `Valid` side of `V`. 77 | validateNonEmpty :: String -> V (NonEmptyArray ValidationError) String 78 | validateNonEmpty input 79 | | null input = invalid $ NonEmpty.singleton FieldIsEmpty 80 | | otherwise = pure input 81 | 82 | -- | This function validates that an input `String` is at greater than or equal 83 | -- | to the given `validLength`. 84 | -- | 85 | -- | If the input is less than `validLength` characters long, it returns a 86 | -- | `FieldIsTooShort` error on the `Invalid` side of `V`. 87 | -- | 88 | -- | Otherwise, it just returns the input on the `Valid` side of `V`. 89 | validateMinimumLength :: Int -> String -> V (NonEmptyArray ValidationError) String 90 | validateMinimumLength validLength input 91 | | length input <= validLength = invalid (NonEmpty.singleton FieldIsTooShort) 92 | | otherwise = pure input 93 | 94 | -- | This function validates that an input `String` uses some mix of upper- and 95 | -- | lower-case characters (i.e. is mixed case). 96 | -- | 97 | -- | If the input isn't mixed case, it returns a `FieldIsAllUpper` or 98 | -- | `FieldIsAllLower` error on the `Invalid` side of `V`, depending on whether 99 | -- | the field was entirely upper- or lower-case, respectively. 100 | -- | 101 | -- | Otherwise, it just returns the input on the `Valid` side of `V`. 102 | validateMixedCase :: String -> V (NonEmptyArray ValidationError) String 103 | validateMixedCase input 104 | | toLower input == input = invalid (NonEmpty.singleton FieldIsAllLower) 105 | | toUpper input == input = invalid (NonEmpty.singleton FieldIsAllUpper) 106 | | otherwise = pure input 107 | 108 | -- | `InvalidField` represents the fields of some form that have failed 109 | -- | validation 110 | -- | 111 | -- | It is used as a key for the `Map` that associates `NonEmptyArray`s of 112 | -- | `ValidationError`s with the field that was invalid. 113 | data InvalidField 114 | = InvalidUsername 115 | | InvalidPassword 116 | 117 | -- | Generically derive a `Show` instance for `InvalidField` so that we may 118 | -- | print these errors to the console later. 119 | derive instance genericInvalidField :: Generic InvalidField _ 120 | instance showInvalidField :: Show InvalidField where 121 | show = genericShow 122 | 123 | -- | Generically derive an `Eq` instance for `InvalidField` so that we may 124 | -- | generically derive an `Ord` instance, so that it may be used as a key in a 125 | -- | `Map`. 126 | instance eqInvalidField :: Eq InvalidField where 127 | eq = genericEq 128 | 129 | -- | Generically derive an `Ord` instance for `InvalidField` so that we may 130 | -- | use it as a key in a `Map`. 131 | instance ordInvalidField :: Ord InvalidField where 132 | compare = genericCompare 133 | 134 | -- | `FormValidationErrors` represents all `ValidationError`s associated with 135 | -- | a particular `ValidationField` that was invalid. 136 | newtype FormValidationErrors = 137 | FormValidationErrors (Map InvalidField (NonEmptyArray ValidationError)) 138 | 139 | -- | Derive a `Newtype` isntance for `FormValidationErrors` so that we may use 140 | -- | generic functions that can operate over it as if it were a plain 141 | -- | `Map InvalidField (NonEmptyArray ValidationError)`. 142 | derive instance newtypeFormValidationErrors :: Newtype FormValidationErrors _ 143 | 144 | -- | Derive a `Semigroup` instance for `FormValidationErrors` that combines 145 | -- | errors using the `Map.unionWith` operation, so as to avoid returning 146 | -- | duplicate entries when fields fail with overlapping errors. 147 | instance semigroupFormValidationErrors :: Semigroup FormValidationErrors where 148 | append = over2 FormValidationErrors (Map.unionWith (<>)) 149 | 150 | -- | Generically derive a `Show` instance for `FormValidationError` so that we 151 | -- | may print these errors to the console later. 152 | derive instance genericFormValidationError :: Generic FormValidationErrors _ 153 | instance showFormValidationErrors :: Show FormValidationErrors where 154 | show = genericShow 155 | 156 | -- | This function validates that an input string conforms to our requirements 157 | -- | for a valid username. Namely, we require that the input be non-empty and at 158 | -- | least 4 characters long. 159 | -- | 160 | -- | If the input doesn't conform to these requirements, the failures 161 | -- | encountered during validation will be collected on the `Invalid` side of 162 | -- | `V`, tagged with a `BadUsername` to identify the part of the form that 163 | -- | failed validation, and wrapped in an `Array` so that additional errors may 164 | -- | be collected along with it. 165 | -- | 166 | -- | Otherwise, it returns the input wrapped in the `Username` newtype to 167 | -- | distinguish it from a normal, unvalidated `String`. 168 | validateUsername :: String -> V FormValidationErrors Username 169 | validateUsername input = 170 | bimap (FormValidationErrors <<< Map.singleton InvalidUsername) Username 171 | $ validateNonEmpty input 172 | *> validateMinimumLength 4 input 173 | 174 | -- | This function validates that an input string conforms to our requirements 175 | -- | for a valid password. Namely, we require that the input be non-empty, at 176 | -- | least 6 characters long, and contains both upper- and lower-case 177 | -- | characters. 178 | -- | 179 | -- | If the input doesn't conform to these requirements, the failures 180 | -- | encountered during validation will be collected on the `Invalid` side of 181 | -- | `V`, tagged with a `BadPassword` to identify the part of the form that 182 | -- | failed validation, and wrapped in an `Array` so that additional errors may 183 | -- | be collected along with it. 184 | -- | 185 | -- | Otherwise, it returns the input wrapped in the `Password` newtype to 186 | -- | distinguish it from a normal, unvalidated `String`. 187 | validatePassword :: String -> V FormValidationErrors Password 188 | validatePassword input = 189 | bimap (FormValidationErrors <<< Map.singleton InvalidPassword) Password 190 | $ validateNonEmpty input 191 | *> validateMinimumLength 6 input 192 | *> validateMixedCase input 193 | 194 | -- | This function validates that an `UnvalidatedFormData` record contains both 195 | -- | a valid username and a valid password, per the requirements specified in 196 | -- | our `validateUsername` and `validatePassword` functions above. 197 | -- | 198 | -- | If the form doesn't conform to these requirements, the failures encountered 199 | -- | during any and all of the validation steps above will be collected on the 200 | -- | `Invalid` side of `V`. 201 | -- | 202 | -- | Otherwise, it returns the validated fields in the `ValidatedFormData` 203 | -- | record specified above. 204 | validateForm 205 | :: UnvalidatedFormData 206 | -> V FormValidationErrors ValidatedFormData 207 | validateForm {username, password} = {username: _, password: _} 208 | <$> validateUsername username 209 | <*> validatePassword password 210 | 211 | -- | This is a form that will fail validation, since both fields are empty 212 | -- | strings. 213 | emptyUsernameAndPassword :: UnvalidatedFormData 214 | emptyUsernameAndPassword = {username: "", password: ""} 215 | 216 | -- | This is a form that will fail validation, since both fields are too short. 217 | shortUsernameAndPassword :: UnvalidatedFormData 218 | shortUsernameAndPassword = {username: "foo", password: "bar"} 219 | 220 | -- | This is a form that will fail validation, since the password lowercase. 221 | lowerCasePassword :: UnvalidatedFormData 222 | lowerCasePassword = {username: "alice", password: "foobarbaz"} 223 | 224 | -- | This is a form that will fail validation, since the password uppercase. 225 | upperCasePassword :: UnvalidatedFormData 226 | upperCasePassword = {username: "alice", password: "FOOBARBAZ"} 227 | 228 | -- | This is a form that will pass validation, as it conforms to all the 229 | -- | requirements outlined in the validation functions above. 230 | goodForm :: UnvalidatedFormData 231 | goodForm = {username: "alice", password: "FooBarBaz"} 232 | 233 | -- | Run through all of the example forms and print the validation results to 234 | -- | the console. 235 | -- | 236 | -- | We'll cheat a little here and use `unsafeStringify` to get a `Show`able 237 | -- | version of our `ValidatedFormData` record. 238 | main :: Effect Unit 239 | main = do 240 | printValidation $ validateForm emptyUsernameAndPassword 241 | -- > invalid ((FormValidationErrors (fromFoldable [(Tuple InvalidUsername (NonEmptyArray [FieldIsEmpty,FieldIsTooShort])),(Tuple InvalidPassword (NonEmptyArray [FieldIsEmpty,FieldIsTooShort,FieldIsAllLower]))]))) 242 | 243 | printValidation $ validateForm shortUsernameAndPassword 244 | -- > invalid ((FormValidationErrors (fromFoldable [(Tuple InvalidUsername (NonEmptyArray [FieldIsTooShort])),(Tuple InvalidPassword (NonEmptyArray [FieldIsTooShort,FieldIsAllLower]))]))) 245 | 246 | printValidation $ validateForm lowerCasePassword 247 | -- > invalid ((FormValidationErrors (fromFoldable [(Tuple InvalidPassword (NonEmptyArray [FieldIsAllLower]))]))) 248 | 249 | printValidation $ validateForm upperCasePassword 250 | -- > invalid ((FormValidationErrors (fromFoldable [(Tuple InvalidPassword (NonEmptyArray [FieldIsAllUpper]))]))) 251 | 252 | printValidation $ validateForm goodForm 253 | -- > pure ("{\"username\":\"alice\",\"password\":\"FooBarBaz\"}") 254 | 255 | where 256 | printValidation = logShow <<< (map toString) 257 | --------------------------------------------------------------------------------