From accfdfa900a0d92c7cbe860cd71cafaa196f35f6 Mon Sep 17 00:00:00 2001 From: Joe Kachmar Date: Wed, 6 Dec 2017 00:33:05 -0500 Subject: [PATCH 1/8] Adds complete Semigroup validation example --- examples/semigroup/.gitignore | 7 + examples/semigroup/bower.json | 11 ++ examples/semigroup/src/Main.purs | 218 +++++++++++++++++++++++++++++++ 3 files changed, 236 insertions(+) create mode 100644 examples/semigroup/.gitignore create mode 100644 examples/semigroup/bower.json create mode 100644 examples/semigroup/src/Main.purs diff --git a/examples/semigroup/.gitignore b/examples/semigroup/.gitignore new file mode 100644 index 0000000..1552ee9 --- /dev/null +++ b/examples/semigroup/.gitignore @@ -0,0 +1,7 @@ +/.* +!/.gitignore +!/.travis.yml +package-lock.json +/bower_components/ +/node_modules/ +/output/ diff --git a/examples/semigroup/bower.json b/examples/semigroup/bower.json new file mode 100644 index 0000000..afe29f4 --- /dev/null +++ b/examples/semigroup/bower.json @@ -0,0 +1,11 @@ +{ + "name": "validation-semigroup", + "private": true, + "dependencies": { + "purescript-prelude": "^3.1.1", + "purescript-console": "^3.0.0", + "purescript-validation": "^3.2.0", + "purescript-strings": "^3.3.2", + "purescript-generics-rep": "^5.4.0" + } +} diff --git a/examples/semigroup/src/Main.purs b/examples/semigroup/src/Main.purs new file mode 100644 index 0000000..b934945 --- /dev/null +++ b/examples/semigroup/src/Main.purs @@ -0,0 +1,218 @@ +module Main where + +import Prelude + +import Control.Monad.Eff (Eff) +import Control.Monad.Eff.Console (CONSOLE, logShow) +import Data.Array (singleton) +import Data.Bifunctor (bimap) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.String (length, null, toLower, toUpper) +import Data.Validation.Semigroup (V, invalid) +import Global.Unsafe (unsafeStringify) + +-- | `UnvalidatedFormData` represents the raw data we might receive from a form +-- | before any validation has been performed. +-- | +-- | Note that both the `username` and `password` fields in this record are +-- | simple `String` types. +type UnvalidatedFormData = + { username :: String + , password :: String + } + +-- | `Username` is a wrapper around `String` that allows us to distinguish a +-- | field containing a valid username from any other potential `String`s. +newtype Username = Username String + +-- | `Password` is a wrapper around `String` that allows us to distinguish a +-- | field containing a valid password from any other potential `String`s. +newtype Password = Password String + +-- | `ValidatedFormData` represents the valid data from a form that is produced +-- | as a result of our validation process. +-- | +-- | Note that the `username` and `password` fields that were simple `String`s +-- | in `UnvalidatedFormData` are now `Username` and `Password`, respectively. +type ValidatedFormData = + { username :: Username + , password :: Password + } + +-- | `ValidationError` represents the potential errors we might encounter during +-- | the validation process. +data ValidationError + = FieldIsEmpty + | FieldIsTooShort + | FieldIsAllLower + | FieldIsAllUpper + +-- | Generically derive a `Show` instance for `ValidationError` so that we may +-- | print these errors to the console later. +derive instance genericValidationError :: Generic ValidationError _ +instance showValidationError :: Show ValidationError where + show = genericShow + +-- | `ValidationErrors` is a helpful type alias for an `Array` of the errors +-- | we might encounter during the validation process. +type ValidationErrors = Array ValidationError + +-- | A note on `Data.Validation.Semigroup`'s `V`: +-- | +-- | `V` is a sum type with an `Invalid` side that collects the errors +-- | encountered during the validation process, and a `Valid` side that holds +-- | the result of the successful validation. + +-- | This function validates that an input `String` is not empty. +-- | +-- | If the input is empty, it returns a `FieldIsEmpty` error on the `Invalid` +-- | side of `V`. +-- | +-- | Otherwise, it just returns the input on the `Valid` side of `V`. +validateNonEmpty :: String -> V ValidationErrors String +validateNonEmpty input + | null input = invalid [FieldIsEmpty] + | otherwise = pure input + +-- | This function validates that an input `String` is at greater than or equal +-- | to the given `validLength`. +-- | +-- | If the input is less than `validLength` characters long, it returns a +-- | `FieldIsTooShort` error on the `Invalid` side of `V`. +-- | +-- | Otherwise, it just returns the input on the `Valid` side of `V`. +validateMinimumLength :: Int -> String -> V ValidationErrors String +validateMinimumLength validLength input + | length input <= validLength = invalid [FieldIsTooShort] + | otherwise = pure input + +-- | This function validates that an input `String` uses some mix of upper- and +-- | lower-case characters (i.e. is mixed case). +-- | +-- | If the input isn't mixed case, it returns a `FieldIsAllUpper` or +-- | `FieldIsAllLower` error on the `Invalid` side of `V`, depending on whether +-- | the field was entirely upper- or lower-case, respectively. +-- | +-- | Otherwise, it just returns the input on the `Valid` side of `V`. +validateMixedCase :: String -> V ValidationErrors String +validateMixedCase input + | toLower input == input = invalid [FieldIsAllLower] + | toUpper input == input = invalid [FieldIsAllUpper] + | otherwise = pure input + +-- | `FormValidationError` represents the errors we might encounter while +-- | attempting to validate the username and password fields of our form. +-- | +-- | The `BadUsername` and `BadPassword` branches help us distinguish which +-- | part of the form failed validation. +data FormValidationError + = BadUsername ValidationErrors + | BadPassword ValidationErrors + +-- | Generically derive a `Show` instance for `FormValidationError` so that we +-- | may print these errors to the console later. +derive instance genericFormValidationError :: Generic FormValidationError _ +instance showFormValidationError :: Show FormValidationError where + show = genericShow + +-- | Much like `ValidationErrors`, `FormValidationErrors` is a helpful alias +-- | for an `Array` of errors specific to the validation of our form fields. +type FormValidationErrors = Array FormValidationError + +-- | This function validates that an input string conforms to our requirements +-- | for a valid username. Namely, we require that the input be non-empty and at +-- | least 4 characters long. +-- | +-- | If the input doesn't conform to these requirements, the failures +-- | encountered during validation will be collected on the `Invalid` side of +-- | `V`, tagged with a `BadUsername` to identify the part of the form that +-- | failed validation, and wrapped in an `Array` so that additional errors may +-- | be collected along with it. +-- | +-- | Otherwise, it returns the input wrapped in the `Username` newtype to +-- | distinguish it from a normal, unvalidated `String`. +validateUsername :: String -> V FormValidationErrors Username +validateUsername input = bimap (singleton <<< BadUsername) Username + $ validateNonEmpty input + *> validateMinimumLength 4 input + +-- | This function validates that an input string conforms to our requirements +-- | for a valid password. Namely, we require that the input be non-empty, at +-- | least 6 characters long, and contains both upper- and lower-case +-- | characters. +-- | +-- | If the input doesn't conform to these requirements, the failures +-- | encountered during validation will be collected on the `Invalid` side of +-- | `V`, tagged with a `BadPassword` to identify the part of the form that +-- | failed validation, and wrapped in an `Array` so that additional errors may +-- | be collected along with it. +-- | +-- | Otherwise, it returns the input wrapped in the `Password` newtype to +-- | distinguish it from a normal, unvalidated `String`. +validatePassword :: String -> V FormValidationErrors Password +validatePassword input = bimap (singleton <<< BadPassword) Password + $ validateNonEmpty input + *> validateMinimumLength 6 input + *> validateMixedCase input + +-- | This function validates that an `UnvalidatedFormData` record contains both +-- | a valid username and a valid password, per the requirements specified in +-- | our `validateUsername` and `validatePassword` functions above. +-- | +-- | If the form doesn't conform to these requirements, the failures encountered +-- | during any and all of the validation steps above will be collected on the +-- | `Invalid` side of `V`. +-- | +-- | Otherwise, it returns the validated fields in the `ValidatedFormData` +-- | record specified above. +validateForm :: UnvalidatedFormData -> V FormValidationErrors ValidatedFormData +validateForm {username, password} = {username: _, password: _} + <$> validateUsername username + <*> validatePassword password + +-- | This is a form that will fail validation, since both fields are empty +-- | strings. +emptyUsernameAndPassword :: UnvalidatedFormData +emptyUsernameAndPassword = {username: "", password: ""} + +-- | This is a form that will fail validation, since both fields are too short. +shortUsernameAndPassword :: UnvalidatedFormData +shortUsernameAndPassword = {username: "foo", password: "bar"} + +-- | This is a form that will fail validation, since the password lowercase. +lowerCasePassword :: UnvalidatedFormData +lowerCasePassword = {username: "alice", password: "foobarbaz"} + +-- | This is a form that will fail validation, since the password uppercase. +upperCasePassword :: UnvalidatedFormData +upperCasePassword = {username: "alice", password: "FOOBARBAZ"} + +-- | This is a form that will pass validation, as it conforms to all the +-- | requirements outlined in the validation functions above. +goodForm :: UnvalidatedFormData +goodForm = {username: "alice", password: "FooBarBaz"} + +-- | Run through all of the example forms and print the validation results to +-- | the console. +-- | +-- | We'll cheat a little here and use `unsafeStringify` to get a `Show`able +-- | version of oru `ValidatedFormData` record. +main :: forall e. Eff (console :: CONSOLE | e) Unit +main = do + printValidation $ validateForm emptyUsernameAndPassword + -- > (Invalid [(BadUsername [FieldIsEmpty,FieldIsTooShort]),(BadPassword [FieldIsEmpty,FieldIsTooShort,FieldIsAllLower])]) + + printValidation $ validateForm shortUsernameAndPassword + -- > (Invalid [(BadUsername [FieldIsTooShort]),(BadPassword [FieldIsTooShort,FieldIsAllLower])]) + + printValidation $ validateForm lowerCasePassword + -- > (Invalid [(BadPassword [FieldIsAllLower])]) + + printValidation $ validateForm upperCasePassword + -- > (Invalid [(BadPassword [FieldIsAllUpper])]) + + printValidation $ validateForm goodForm + -- > (Valid "{\"username\":\"alice\",\"password\":\"FooBarBaz\"}") + where + printValidation = logShow <<< (map unsafeStringify) From 69ffc739954f09c39ea9d202d2f00b60c0862fd3 Mon Sep 17 00:00:00 2001 From: Joe Kachmar Date: Wed, 6 Dec 2017 01:03:10 -0500 Subject: [PATCH 2/8] Adds README for the Semigroup example --- examples/semigroup/README.md | 11 +++++++++++ 1 file changed, 11 insertions(+) create mode 100644 examples/semigroup/README.md diff --git a/examples/semigroup/README.md b/examples/semigroup/README.md new file mode 100644 index 0000000..2de5afe --- /dev/null +++ b/examples/semigroup/README.md @@ -0,0 +1,11 @@ +## Semigroup Validation +This example illustrates how this library can be used to perform validation with +the `Data.Semigroup.Validation` module. + +### Building and Running +From this directory: +``` +$ bower install +$ pulp build +$ pulp run +``` From 3b79cf01e85291b5f95cf857eb9776800186d5e6 Mon Sep 17 00:00:00 2001 From: Joe Kachmar Date: Sat, 24 Feb 2018 17:27:49 -0500 Subject: [PATCH 3/8] Adds a Semiring validation example. --- examples/semiring/.gitignore | 7 + examples/semiring/README.md | 11 ++ examples/semiring/bower.json | 12 ++ examples/semiring/src/Main.purs | 300 ++++++++++++++++++++++++++++++++ 4 files changed, 330 insertions(+) create mode 100644 examples/semiring/.gitignore create mode 100644 examples/semiring/README.md create mode 100644 examples/semiring/bower.json create mode 100644 examples/semiring/src/Main.purs diff --git a/examples/semiring/.gitignore b/examples/semiring/.gitignore new file mode 100644 index 0000000..1552ee9 --- /dev/null +++ b/examples/semiring/.gitignore @@ -0,0 +1,7 @@ +/.* +!/.gitignore +!/.travis.yml +package-lock.json +/bower_components/ +/node_modules/ +/output/ diff --git a/examples/semiring/README.md b/examples/semiring/README.md new file mode 100644 index 0000000..7597bf8 --- /dev/null +++ b/examples/semiring/README.md @@ -0,0 +1,11 @@ +## Semiring Validation +This example illustrates how this library can be used to perform validation +with the `Data.Semiring.Validation` module. + +### Building and Running +From this directory: +``` +$ bower install +$ pulp build +$ pulp run +``` diff --git a/examples/semiring/bower.json b/examples/semiring/bower.json new file mode 100644 index 0000000..1b535fb --- /dev/null +++ b/examples/semiring/bower.json @@ -0,0 +1,12 @@ +{ + "name": "validation-semigroup", + "private": true, + "dependencies": { + "purescript-prelude": "^3.1.1", + "purescript-console": "^3.0.0", + "purescript-validation": "^3.2.0", + "purescript-strings": "^3.3.2", + "purescript-generics-rep": "^5.4.0", + "purescript-semirings": "^4.0.0" + } +} diff --git a/examples/semiring/src/Main.purs b/examples/semiring/src/Main.purs new file mode 100644 index 0000000..13dc4d9 --- /dev/null +++ b/examples/semiring/src/Main.purs @@ -0,0 +1,300 @@ +module Main where + +import Prelude + +import Control.Alt ((<|>)) +import Control.Monad.Eff (Eff) +import Control.Monad.Eff.Console (CONSOLE, logShow) +import Data.Semiring.Free (Free, free) +import Data.Bifunctor (bimap) +import Data.Either (fromRight) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.String.Regex (Regex, regex, test) +import Data.String.Regex.Flags (noFlags) +import Data.String (length, null, toLower, toUpper) +import Data.Validation.Semiring (V, invalid) +import Global.Unsafe (unsafeStringify) +import Partial.Unsafe (unsafePartial) + +-- | `UnvalidatedFormData` represents the raw data we might receive from a form +-- | before any validation has been performed. +-- | +-- | Note that both the `login` and `password` fields in this record are simple +-- | `String` types. +type UnvalidatedFormData = + { loginIdent :: String + , password :: String + } + +-- | `LoginIdent` is a sum type representing the potential ways a user can +-- | identify themselves for login. +-- | +-- | For the sake of example here, a user can either identify themselves by +-- | their email address or username. +data LoginIdent + = EmailAddress String + | Username String + +-- | `Password` is a wrapper around `String` that allows us to distinguish a +-- | field containing a valid password from any other potential `String`s. +newtype Password = Password String + +-- | `ValidatedFormData` represents the valid data from a form that is produced +-- | as a result of our validation process. +-- | +-- | Note that the `username` and `password` fields that were simple `String`s +-- | in `UnvalidatedFormData` are now `Username` and `Password`, respectively. +type ValidatedFormData = + { loginIdent :: LoginIdent + , password :: Password + } + +-- | `ValidationError` represents the potential errors we might encounter during +-- | the validation process. +data ValidationError + = FieldIsEmpty + | FieldIsTooShort + | FieldIsAllLower + | FieldIsAllUpper + | FieldIsInvalidEmail + +-- | Generically derive a `Show` instance for `ValidationError` so that we may +-- | print these errors to the console later. +derive instance genericValidationError :: Generic ValidationError _ +instance showValidationError :: Show ValidationError where + show = genericShow + +-- | `ValidationErrors` is a helpful type alias for `Free` Semiring of the +-- | errors we might encounter during the validation process. +type ValidationErrors = Free ValidationError + +-- | A note on `Data.Validation.Semiring`'s `V`: +-- | +-- | `V` is a sum type with an `Invalid` side that collects the errors +-- | encountered during the validation process, and a `Valid` side that holds +-- | the result of the successful validation. + +-- | This function validates that an input `String` is not empty. +-- | +-- | If the input is empty, it returns a `FieldIsEmpty` error on the `Invalid` +-- | side of `V`. +-- | +-- | Otherwise, it just returns the input on the `Valid` side of `V`. +validateNonEmpty :: String -> V ValidationErrors String +validateNonEmpty input + | null input = invalid (free FieldIsEmpty) + | otherwise = pure input + +-- | This function validates that an input `String` is at greater than or equal +-- | to the given `validLength`. +-- | +-- | If the input is less than `validLength` characters long, it returns a +-- | `FieldIsTooShort` error on the `Invalid` side of `V`. +-- | +-- | Otherwise, it just returns the input on the `Valid` side of `V`. +validateMinimumLength :: Int -> String -> V ValidationErrors String +validateMinimumLength validLength input + | length input <= validLength = invalid (free FieldIsTooShort) + | otherwise = pure input + +-- | This function validates that an input `String` uses some mix of upper- and +-- | lower-case characters (i.e. is mixed case). +-- | +-- | If the input isn't mixed case, it returns a `FieldIsAllUpper` or +-- | `FieldIsAllLower` error on the `Invalid` side of `V`, depending on whether +-- | the field was entirely upper- or lower-case, respectively. +-- | +-- | Otherwise, it just returns the input on the `Valid` side of `V`. +validateMixedCase :: String -> V ValidationErrors String +validateMixedCase input + | toLower input == input = invalid (free FieldIsAllLower) + | toUpper input == input = invalid (free FieldIsAllUpper) + | otherwise = pure input + +-- | This function validates that an input `String` is a valid email address +-- | by checking it against a regular expression. +-- | +-- | If the input isn't a valid email address, it returns a +-- | `FieldIsInvalidEmail` error on the `Invalid` side of `V`. +-- | +-- | Otherwise, it just returns the input on the `Valid` side of `V`. +validateEmailRegex :: String -> V ValidationErrors String +validateEmailRegex email + | test emailRegex email = pure email + | otherwise = invalid (free FieldIsInvalidEmail) + +-- | A regular expression that validates email addresses. +emailRegex :: Regex +emailRegex = + unsafeRegexFromString "^\\w+([.-]?\\w+)*@\\w+([.-]?\\w+)*(\\.\\w{2,3})+$" + where + -- | Unsafely construct a regular expression from a pattern string. + -- | + -- | This will fail at runtime with an error if the pattern string is + -- | invalid. + unsafeRegexFromString :: String -> Regex + unsafeRegexFromString str = + let mkRegex = regex str noFlags + in unsafePartial (fromRight mkRegex) + +-- | `FormValidationError` represents the errors we might encounter while +-- | attempting to validate the username and password fields of our form. +-- | +-- | The `BadUsername` and `BadPassword` branches help us distinguish which +-- | part of the form failed validation. +data FormValidationError + = BadEmailAddress ValidationErrors + | BadUsername ValidationErrors + | BadPassword ValidationErrors + +-- | Generically derive a `Show` instance for `FormValidationError` so that we +-- | may print these errors to the console later. +derive instance genericFormValidationError :: Generic FormValidationError _ +instance showFormValidationError :: Show FormValidationError where + show = genericShow + +-- | Much like `ValidationErrors`, `FormValidationErrors` is a helpful alias +-- | for a `Free` Semiring of errors specific to the validation of our form +-- | fields. +type FormValidationErrors = Free FormValidationError + +-- | This function validates that an input string conforms to our requirements +-- | for a valid email address. Namely, we require that the input be non-empty +-- | and pass testing against the `emailRegex` defined above. +-- | +-- | If the input doesn't conform to these requirements, the failures +-- | encountered during validation will be collected on the `Invalid` side of +-- | `V`, tagged with a `BadEmailAddress` to identify the part of the form that +-- | failed validation, and wrapped in a `Free` Semiring so that additional +-- | errors may be collected along with it. +-- | +-- | Otherwise, it returns the input wrapped in the `EmailAddress` constructor +-- | for the `LoginIdent` data type to distinguish it from either a normal, +-- | unvalidated `String` or a validated `Username`. +validateEmailAddress :: String -> V FormValidationErrors LoginIdent +validateEmailAddress input = bimap (free <<< BadEmailAddress) EmailAddress + $ validateNonEmpty input + *> validateEmailRegex input + +-- | This function validates that an input string conforms to our requirements +-- | for a valid username. Namely, we require that the input be non-empty and at +-- | least 4 characters long. +-- | +-- | If the input doesn't conform to these requirements, the failures +-- | encountered during validation will be collected on the `Invalid` side of +-- | `V`, tagged with a `BadUsername` to identify the part of the form that +-- | failed validation, and wrapped in a `Free` Semiring so that additional +-- | errors may be collected along with it. +-- | +-- | Otherwise, it returns the input wrapped in the `Username` constructor for +-- | the `LoginIdent` data type to distinguish it from either a normal, +-- | unvalidated `String` or a validated `EmailAddress`. +validateUsername :: String -> V FormValidationErrors LoginIdent +validateUsername input = bimap (free <<< BadUsername) Username + $ validateNonEmpty input + *> validateMinimumLength 4 input + +-- | This function validates that an input string conforms to our requirements +-- | for a valid login identifier. Namely, we require that the input pass +-- | either the `validateEmailAddress` or `validateUsername` +-- | +-- | Of note here is the fact that we use the `(<|>)` operator from `Control.Alt` +-- | to signify alternative validation functions for the same input. +-- | +-- | This is the crux of using the `Free` Semiring in the first place, as +-- | Semiring provides a way for errors accumulated along either of these +-- | alternative validation branches to be accumulated in the data structure +-- | and returned to the user in the event that it fails. +validateLoginIdent :: String -> V FormValidationErrors LoginIdent +validateLoginIdent input = + validateEmailAddress input <|> validateUsername input + +-- | This function validates that an input string conforms to our requirements +-- | for a valid password. Namely, we require that the input be non-empty, at +-- | least 6 characters long, and contains both upper- and lower-case +-- | characters. +-- | +-- | If the input doesn't conform to these requirements, the failures +-- | encountered during validation will be collected on the `Invalid` side of +-- | `V`, tagged with a `BadPassword` to identify the part of the form that +-- | failed validation, and wrapped in a `Free` Semiring so that additional +-- | errors may be collected along with it. +-- | +-- | Otherwise, it returns the input wrapped in the `Password` newtype to +-- | distinguish it from a normal, unvalidated `String`. +validatePassword :: String -> V FormValidationErrors Password +validatePassword input = bimap (free <<< BadPassword) Password + $ validateNonEmpty input + *> validateMinimumLength 6 input + *> validateMixedCase input + +-- | This function validates that an `UnvalidatedFormData` record contains both +-- | a valid username and a valid password, per the requirements specified in +-- | our `validateUsername` and `validatePassword` functions above. +-- | +-- | If the form doesn't conform to these requirements, the failures encountered +-- | during any and all of the validation steps above will be collected on the +-- | `Invalid` side of `V`. +-- | +-- | Otherwise, it returns the validated fields in the `ValidatedFormData` +-- | record specified above. +validateForm :: UnvalidatedFormData -> V FormValidationErrors ValidatedFormData +validateForm {loginIdent, password} = {loginIdent: _, password: _} + <$> validateLoginIdent loginIdent + <*> validatePassword password + +-- | This is a form that will fail validation, since both fields are empty +-- | strings. +emptyUsernameAndPassword :: UnvalidatedFormData +emptyUsernameAndPassword = {loginIdent: "", password: ""} + +-- | This is a form that will fail validation, since both fields are too short. +shortUsernameAndPassword :: UnvalidatedFormData +shortUsernameAndPassword = {loginIdent: "foo", password: "bar"} + +-- | This is a form that will fail validation, since the password lowercase. +lowerCasePassword :: UnvalidatedFormData +lowerCasePassword = {loginIdent: "alice", password: "foobarbaz"} + +-- | This is a form that will fail validation, since the password uppercase. +upperCasePassword :: UnvalidatedFormData +upperCasePassword = {loginIdent: "alice", password: "FOOBARBAZ"} + +-- | This is a form with a username that will pass validation, as it conforms +-- | to all the requirements outlined in the validation functions above. +goodUsernameForm :: UnvalidatedFormData +goodUsernameForm = {loginIdent: "alice", password: "FooBarBaz"} + +-- | This is a form with an email address that will pass validation, as it +-- | conforms to all the requirements outlined in the validation functions +-- | above. +goodEmailAddressForm :: UnvalidatedFormData +goodEmailAddressForm = {loginIdent: "alice@example.com", password: "FooBarBaz"} + +-- | Run through all of the example forms and print the validation results to +-- | the console. +-- | +-- | We'll cheat a little here and use `unsafeStringify` to get a `Show`able +-- | version of our `ValidatedFormData` record. +main :: forall e. Eff (console :: CONSOLE | e) Unit +main = do + printValidation $ validateForm emptyUsernameAndPassword + -- > Invalid ((Free (((BadEmailAddress (Free ((FieldIsEmpty : FieldIsInvalidEmail : Nil) : Nil))) : (BadPassword (Free ((FieldIsEmpty : FieldIsTooShort : FieldIsAllLower : Nil) : Nil))) : Nil) : ((BadUsername (Free ((FieldIsEmpty : FieldIsTooShort : Nil) : Nil))) : (BadPassword (Free ((FieldIsEmpty : FieldIsTooShort : FieldIsAllLower : Nil) : Nil))) : Nil) : Nil))) + + printValidation $ validateForm shortUsernameAndPassword + -- > Invalid ((Free (((BadEmailAddress (Free ((FieldIsInvalidEmail : Nil) : Nil))) : (BadPassword (Free ((FieldIsTooShort : FieldIsAllLower : Nil) : Nil))) : Nil) : ((BadUsername (Free ((FieldIsTooShort : Nil) : Nil))) : (BadPassword (Free ((FieldIsTooShort : FieldIsAllLower : Nil) : Nil))) : Nil) : Nil))) + + printValidation $ validateForm lowerCasePassword + -- > Invalid ((Free (((BadPassword (Free ((FieldIsAllLower : Nil) : Nil))) : Nil) : Nil))) + + printValidation $ validateForm upperCasePassword + -- > Invalid ((Free (((BadPassword (Free ((FieldIsAllUpper : Nil) : Nil))) : Nil) : Nil))) + + printValidation $ validateForm goodUsernameForm + -- > Valid ("{\"loginIdent\":{\"value0\":\"alice\"},\"password\":\"FooBarBaz\"}") + + printValidation $ validateForm goodEmailAddressForm + -- > Valid ("{\"loginIdent\":{\"value0\":\"alice@example.com\"},\"password\":\"FooBarBaz\"}") + where + printValidation = logShow <<< (map unsafeStringify) From f3f3722b3032f96dcce4b7cbbc53743a0683a268 Mon Sep 17 00:00:00 2001 From: Joe Kachmar Date: Sat, 24 Feb 2018 17:38:45 -0500 Subject: [PATCH 4/8] Fixes a small typo --- examples/semigroup/src/Main.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/semigroup/src/Main.purs b/examples/semigroup/src/Main.purs index b934945..b46e519 100644 --- a/examples/semigroup/src/Main.purs +++ b/examples/semigroup/src/Main.purs @@ -197,7 +197,7 @@ goodForm = {username: "alice", password: "FooBarBaz"} -- | the console. -- | -- | We'll cheat a little here and use `unsafeStringify` to get a `Show`able --- | version of oru `ValidatedFormData` record. +-- | version of our `ValidatedFormData` record. main :: forall e. Eff (console :: CONSOLE | e) Unit main = do printValidation $ validateForm emptyUsernameAndPassword From d91775362d25a062aa824c45950121c1e3812c3b Mon Sep 17 00:00:00 2001 From: Joe Kachmar Date: Sat, 22 Jun 2019 15:16:45 -0400 Subject: [PATCH 5/8] Removes sub-projects, compiles with latest purs --- bower.json | 5 +- .../src/Main.purs => Semigroup.purs} | 8 +- examples/semigroup/.gitignore | 7 - examples/semigroup/README.md | 11 - examples/semigroup/bower.json | 11 - examples/semiring/.gitignore | 7 - examples/semiring/README.md | 11 - examples/semiring/bower.json | 12 - examples/semiring/src/Main.purs | 300 ------------------ 9 files changed, 8 insertions(+), 364 deletions(-) rename examples/{semigroup/src/Main.purs => Semigroup.purs} (98%) delete mode 100644 examples/semigroup/.gitignore delete mode 100644 examples/semigroup/README.md delete mode 100644 examples/semigroup/bower.json delete mode 100644 examples/semiring/.gitignore delete mode 100644 examples/semiring/README.md delete mode 100644 examples/semiring/bower.json delete mode 100644 examples/semiring/src/Main.purs diff --git a/bower.json b/bower.json index abde87c..ad60917 100644 --- a/bower.json +++ b/bower.json @@ -24,6 +24,9 @@ "purescript-newtype": "^3.0.0" }, "devDependencies": { - "purescript-psci-support": "^4.0.0" + "purescript-psci-support": "^4.0.0", + "purescript-console": "^4.2.0", + "purescript-generics-rep": "^6.1.0", + "purescript-strings": "^4.0.0" } } diff --git a/examples/semigroup/src/Main.purs b/examples/Semigroup.purs similarity index 98% rename from examples/semigroup/src/Main.purs rename to examples/Semigroup.purs index b46e519..d31d94f 100644 --- a/examples/semigroup/src/Main.purs +++ b/examples/Semigroup.purs @@ -1,9 +1,9 @@ -module Main where +module Semigroup where import Prelude -import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Console (CONSOLE, logShow) +import Effect (Effect) +import Effect.Console (logShow) import Data.Array (singleton) import Data.Bifunctor (bimap) import Data.Generic.Rep (class Generic) @@ -198,7 +198,7 @@ goodForm = {username: "alice", password: "FooBarBaz"} -- | -- | We'll cheat a little here and use `unsafeStringify` to get a `Show`able -- | version of our `ValidatedFormData` record. -main :: forall e. Eff (console :: CONSOLE | e) Unit +main :: Effect Unit main = do printValidation $ validateForm emptyUsernameAndPassword -- > (Invalid [(BadUsername [FieldIsEmpty,FieldIsTooShort]),(BadPassword [FieldIsEmpty,FieldIsTooShort,FieldIsAllLower])]) diff --git a/examples/semigroup/.gitignore b/examples/semigroup/.gitignore deleted file mode 100644 index 1552ee9..0000000 --- a/examples/semigroup/.gitignore +++ /dev/null @@ -1,7 +0,0 @@ -/.* -!/.gitignore -!/.travis.yml -package-lock.json -/bower_components/ -/node_modules/ -/output/ diff --git a/examples/semigroup/README.md b/examples/semigroup/README.md deleted file mode 100644 index 2de5afe..0000000 --- a/examples/semigroup/README.md +++ /dev/null @@ -1,11 +0,0 @@ -## Semigroup Validation -This example illustrates how this library can be used to perform validation with -the `Data.Semigroup.Validation` module. - -### Building and Running -From this directory: -``` -$ bower install -$ pulp build -$ pulp run -``` diff --git a/examples/semigroup/bower.json b/examples/semigroup/bower.json deleted file mode 100644 index afe29f4..0000000 --- a/examples/semigroup/bower.json +++ /dev/null @@ -1,11 +0,0 @@ -{ - "name": "validation-semigroup", - "private": true, - "dependencies": { - "purescript-prelude": "^3.1.1", - "purescript-console": "^3.0.0", - "purescript-validation": "^3.2.0", - "purescript-strings": "^3.3.2", - "purescript-generics-rep": "^5.4.0" - } -} diff --git a/examples/semiring/.gitignore b/examples/semiring/.gitignore deleted file mode 100644 index 1552ee9..0000000 --- a/examples/semiring/.gitignore +++ /dev/null @@ -1,7 +0,0 @@ -/.* -!/.gitignore -!/.travis.yml -package-lock.json -/bower_components/ -/node_modules/ -/output/ diff --git a/examples/semiring/README.md b/examples/semiring/README.md deleted file mode 100644 index 7597bf8..0000000 --- a/examples/semiring/README.md +++ /dev/null @@ -1,11 +0,0 @@ -## Semiring Validation -This example illustrates how this library can be used to perform validation -with the `Data.Semiring.Validation` module. - -### Building and Running -From this directory: -``` -$ bower install -$ pulp build -$ pulp run -``` diff --git a/examples/semiring/bower.json b/examples/semiring/bower.json deleted file mode 100644 index 1b535fb..0000000 --- a/examples/semiring/bower.json +++ /dev/null @@ -1,12 +0,0 @@ -{ - "name": "validation-semigroup", - "private": true, - "dependencies": { - "purescript-prelude": "^3.1.1", - "purescript-console": "^3.0.0", - "purescript-validation": "^3.2.0", - "purescript-strings": "^3.3.2", - "purescript-generics-rep": "^5.4.0", - "purescript-semirings": "^4.0.0" - } -} diff --git a/examples/semiring/src/Main.purs b/examples/semiring/src/Main.purs deleted file mode 100644 index 13dc4d9..0000000 --- a/examples/semiring/src/Main.purs +++ /dev/null @@ -1,300 +0,0 @@ -module Main where - -import Prelude - -import Control.Alt ((<|>)) -import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Console (CONSOLE, logShow) -import Data.Semiring.Free (Free, free) -import Data.Bifunctor (bimap) -import Data.Either (fromRight) -import Data.Generic.Rep (class Generic) -import Data.Generic.Rep.Show (genericShow) -import Data.String.Regex (Regex, regex, test) -import Data.String.Regex.Flags (noFlags) -import Data.String (length, null, toLower, toUpper) -import Data.Validation.Semiring (V, invalid) -import Global.Unsafe (unsafeStringify) -import Partial.Unsafe (unsafePartial) - --- | `UnvalidatedFormData` represents the raw data we might receive from a form --- | before any validation has been performed. --- | --- | Note that both the `login` and `password` fields in this record are simple --- | `String` types. -type UnvalidatedFormData = - { loginIdent :: String - , password :: String - } - --- | `LoginIdent` is a sum type representing the potential ways a user can --- | identify themselves for login. --- | --- | For the sake of example here, a user can either identify themselves by --- | their email address or username. -data LoginIdent - = EmailAddress String - | Username String - --- | `Password` is a wrapper around `String` that allows us to distinguish a --- | field containing a valid password from any other potential `String`s. -newtype Password = Password String - --- | `ValidatedFormData` represents the valid data from a form that is produced --- | as a result of our validation process. --- | --- | Note that the `username` and `password` fields that were simple `String`s --- | in `UnvalidatedFormData` are now `Username` and `Password`, respectively. -type ValidatedFormData = - { loginIdent :: LoginIdent - , password :: Password - } - --- | `ValidationError` represents the potential errors we might encounter during --- | the validation process. -data ValidationError - = FieldIsEmpty - | FieldIsTooShort - | FieldIsAllLower - | FieldIsAllUpper - | FieldIsInvalidEmail - --- | Generically derive a `Show` instance for `ValidationError` so that we may --- | print these errors to the console later. -derive instance genericValidationError :: Generic ValidationError _ -instance showValidationError :: Show ValidationError where - show = genericShow - --- | `ValidationErrors` is a helpful type alias for `Free` Semiring of the --- | errors we might encounter during the validation process. -type ValidationErrors = Free ValidationError - --- | A note on `Data.Validation.Semiring`'s `V`: --- | --- | `V` is a sum type with an `Invalid` side that collects the errors --- | encountered during the validation process, and a `Valid` side that holds --- | the result of the successful validation. - --- | This function validates that an input `String` is not empty. --- | --- | If the input is empty, it returns a `FieldIsEmpty` error on the `Invalid` --- | side of `V`. --- | --- | Otherwise, it just returns the input on the `Valid` side of `V`. -validateNonEmpty :: String -> V ValidationErrors String -validateNonEmpty input - | null input = invalid (free FieldIsEmpty) - | otherwise = pure input - --- | This function validates that an input `String` is at greater than or equal --- | to the given `validLength`. --- | --- | If the input is less than `validLength` characters long, it returns a --- | `FieldIsTooShort` error on the `Invalid` side of `V`. --- | --- | Otherwise, it just returns the input on the `Valid` side of `V`. -validateMinimumLength :: Int -> String -> V ValidationErrors String -validateMinimumLength validLength input - | length input <= validLength = invalid (free FieldIsTooShort) - | otherwise = pure input - --- | This function validates that an input `String` uses some mix of upper- and --- | lower-case characters (i.e. is mixed case). --- | --- | If the input isn't mixed case, it returns a `FieldIsAllUpper` or --- | `FieldIsAllLower` error on the `Invalid` side of `V`, depending on whether --- | the field was entirely upper- or lower-case, respectively. --- | --- | Otherwise, it just returns the input on the `Valid` side of `V`. -validateMixedCase :: String -> V ValidationErrors String -validateMixedCase input - | toLower input == input = invalid (free FieldIsAllLower) - | toUpper input == input = invalid (free FieldIsAllUpper) - | otherwise = pure input - --- | This function validates that an input `String` is a valid email address --- | by checking it against a regular expression. --- | --- | If the input isn't a valid email address, it returns a --- | `FieldIsInvalidEmail` error on the `Invalid` side of `V`. --- | --- | Otherwise, it just returns the input on the `Valid` side of `V`. -validateEmailRegex :: String -> V ValidationErrors String -validateEmailRegex email - | test emailRegex email = pure email - | otherwise = invalid (free FieldIsInvalidEmail) - --- | A regular expression that validates email addresses. -emailRegex :: Regex -emailRegex = - unsafeRegexFromString "^\\w+([.-]?\\w+)*@\\w+([.-]?\\w+)*(\\.\\w{2,3})+$" - where - -- | Unsafely construct a regular expression from a pattern string. - -- | - -- | This will fail at runtime with an error if the pattern string is - -- | invalid. - unsafeRegexFromString :: String -> Regex - unsafeRegexFromString str = - let mkRegex = regex str noFlags - in unsafePartial (fromRight mkRegex) - --- | `FormValidationError` represents the errors we might encounter while --- | attempting to validate the username and password fields of our form. --- | --- | The `BadUsername` and `BadPassword` branches help us distinguish which --- | part of the form failed validation. -data FormValidationError - = BadEmailAddress ValidationErrors - | BadUsername ValidationErrors - | BadPassword ValidationErrors - --- | Generically derive a `Show` instance for `FormValidationError` so that we --- | may print these errors to the console later. -derive instance genericFormValidationError :: Generic FormValidationError _ -instance showFormValidationError :: Show FormValidationError where - show = genericShow - --- | Much like `ValidationErrors`, `FormValidationErrors` is a helpful alias --- | for a `Free` Semiring of errors specific to the validation of our form --- | fields. -type FormValidationErrors = Free FormValidationError - --- | This function validates that an input string conforms to our requirements --- | for a valid email address. Namely, we require that the input be non-empty --- | and pass testing against the `emailRegex` defined above. --- | --- | If the input doesn't conform to these requirements, the failures --- | encountered during validation will be collected on the `Invalid` side of --- | `V`, tagged with a `BadEmailAddress` to identify the part of the form that --- | failed validation, and wrapped in a `Free` Semiring so that additional --- | errors may be collected along with it. --- | --- | Otherwise, it returns the input wrapped in the `EmailAddress` constructor --- | for the `LoginIdent` data type to distinguish it from either a normal, --- | unvalidated `String` or a validated `Username`. -validateEmailAddress :: String -> V FormValidationErrors LoginIdent -validateEmailAddress input = bimap (free <<< BadEmailAddress) EmailAddress - $ validateNonEmpty input - *> validateEmailRegex input - --- | This function validates that an input string conforms to our requirements --- | for a valid username. Namely, we require that the input be non-empty and at --- | least 4 characters long. --- | --- | If the input doesn't conform to these requirements, the failures --- | encountered during validation will be collected on the `Invalid` side of --- | `V`, tagged with a `BadUsername` to identify the part of the form that --- | failed validation, and wrapped in a `Free` Semiring so that additional --- | errors may be collected along with it. --- | --- | Otherwise, it returns the input wrapped in the `Username` constructor for --- | the `LoginIdent` data type to distinguish it from either a normal, --- | unvalidated `String` or a validated `EmailAddress`. -validateUsername :: String -> V FormValidationErrors LoginIdent -validateUsername input = bimap (free <<< BadUsername) Username - $ validateNonEmpty input - *> validateMinimumLength 4 input - --- | This function validates that an input string conforms to our requirements --- | for a valid login identifier. Namely, we require that the input pass --- | either the `validateEmailAddress` or `validateUsername` --- | --- | Of note here is the fact that we use the `(<|>)` operator from `Control.Alt` --- | to signify alternative validation functions for the same input. --- | --- | This is the crux of using the `Free` Semiring in the first place, as --- | Semiring provides a way for errors accumulated along either of these --- | alternative validation branches to be accumulated in the data structure --- | and returned to the user in the event that it fails. -validateLoginIdent :: String -> V FormValidationErrors LoginIdent -validateLoginIdent input = - validateEmailAddress input <|> validateUsername input - --- | This function validates that an input string conforms to our requirements --- | for a valid password. Namely, we require that the input be non-empty, at --- | least 6 characters long, and contains both upper- and lower-case --- | characters. --- | --- | If the input doesn't conform to these requirements, the failures --- | encountered during validation will be collected on the `Invalid` side of --- | `V`, tagged with a `BadPassword` to identify the part of the form that --- | failed validation, and wrapped in a `Free` Semiring so that additional --- | errors may be collected along with it. --- | --- | Otherwise, it returns the input wrapped in the `Password` newtype to --- | distinguish it from a normal, unvalidated `String`. -validatePassword :: String -> V FormValidationErrors Password -validatePassword input = bimap (free <<< BadPassword) Password - $ validateNonEmpty input - *> validateMinimumLength 6 input - *> validateMixedCase input - --- | This function validates that an `UnvalidatedFormData` record contains both --- | a valid username and a valid password, per the requirements specified in --- | our `validateUsername` and `validatePassword` functions above. --- | --- | If the form doesn't conform to these requirements, the failures encountered --- | during any and all of the validation steps above will be collected on the --- | `Invalid` side of `V`. --- | --- | Otherwise, it returns the validated fields in the `ValidatedFormData` --- | record specified above. -validateForm :: UnvalidatedFormData -> V FormValidationErrors ValidatedFormData -validateForm {loginIdent, password} = {loginIdent: _, password: _} - <$> validateLoginIdent loginIdent - <*> validatePassword password - --- | This is a form that will fail validation, since both fields are empty --- | strings. -emptyUsernameAndPassword :: UnvalidatedFormData -emptyUsernameAndPassword = {loginIdent: "", password: ""} - --- | This is a form that will fail validation, since both fields are too short. -shortUsernameAndPassword :: UnvalidatedFormData -shortUsernameAndPassword = {loginIdent: "foo", password: "bar"} - --- | This is a form that will fail validation, since the password lowercase. -lowerCasePassword :: UnvalidatedFormData -lowerCasePassword = {loginIdent: "alice", password: "foobarbaz"} - --- | This is a form that will fail validation, since the password uppercase. -upperCasePassword :: UnvalidatedFormData -upperCasePassword = {loginIdent: "alice", password: "FOOBARBAZ"} - --- | This is a form with a username that will pass validation, as it conforms --- | to all the requirements outlined in the validation functions above. -goodUsernameForm :: UnvalidatedFormData -goodUsernameForm = {loginIdent: "alice", password: "FooBarBaz"} - --- | This is a form with an email address that will pass validation, as it --- | conforms to all the requirements outlined in the validation functions --- | above. -goodEmailAddressForm :: UnvalidatedFormData -goodEmailAddressForm = {loginIdent: "alice@example.com", password: "FooBarBaz"} - --- | Run through all of the example forms and print the validation results to --- | the console. --- | --- | We'll cheat a little here and use `unsafeStringify` to get a `Show`able --- | version of our `ValidatedFormData` record. -main :: forall e. Eff (console :: CONSOLE | e) Unit -main = do - printValidation $ validateForm emptyUsernameAndPassword - -- > Invalid ((Free (((BadEmailAddress (Free ((FieldIsEmpty : FieldIsInvalidEmail : Nil) : Nil))) : (BadPassword (Free ((FieldIsEmpty : FieldIsTooShort : FieldIsAllLower : Nil) : Nil))) : Nil) : ((BadUsername (Free ((FieldIsEmpty : FieldIsTooShort : Nil) : Nil))) : (BadPassword (Free ((FieldIsEmpty : FieldIsTooShort : FieldIsAllLower : Nil) : Nil))) : Nil) : Nil))) - - printValidation $ validateForm shortUsernameAndPassword - -- > Invalid ((Free (((BadEmailAddress (Free ((FieldIsInvalidEmail : Nil) : Nil))) : (BadPassword (Free ((FieldIsTooShort : FieldIsAllLower : Nil) : Nil))) : Nil) : ((BadUsername (Free ((FieldIsTooShort : Nil) : Nil))) : (BadPassword (Free ((FieldIsTooShort : FieldIsAllLower : Nil) : Nil))) : Nil) : Nil))) - - printValidation $ validateForm lowerCasePassword - -- > Invalid ((Free (((BadPassword (Free ((FieldIsAllLower : Nil) : Nil))) : Nil) : Nil))) - - printValidation $ validateForm upperCasePassword - -- > Invalid ((Free (((BadPassword (Free ((FieldIsAllUpper : Nil) : Nil))) : Nil) : Nil))) - - printValidation $ validateForm goodUsernameForm - -- > Valid ("{\"loginIdent\":{\"value0\":\"alice\"},\"password\":\"FooBarBaz\"}") - - printValidation $ validateForm goodEmailAddressForm - -- > Valid ("{\"loginIdent\":{\"value0\":\"alice@example.com\"},\"password\":\"FooBarBaz\"}") - where - printValidation = logShow <<< (map unsafeStringify) From 0b28436fef4c42d6fbb9101e4f0d3f47a63adbf8 Mon Sep 17 00:00:00 2001 From: Joe Kachmar Date: Mon, 24 Jun 2019 09:46:40 -0400 Subject: [PATCH 6/8] Uses NonEmptyArray and Harry's Map suggestion --- bower.json | 1 + examples/Semigroup.purs | 107 ++++++++++++++++++++++++++-------------- 2 files changed, 70 insertions(+), 38 deletions(-) diff --git a/bower.json b/bower.json index ad60917..ca88ce1 100644 --- a/bower.json +++ b/bower.json @@ -27,6 +27,7 @@ "purescript-psci-support": "^4.0.0", "purescript-console": "^4.2.0", "purescript-generics-rep": "^6.1.0", + "purescript-ordered-collections": "^1.6.0", "purescript-strings": "^4.0.0" } } diff --git a/examples/Semigroup.purs b/examples/Semigroup.purs index d31d94f..67f6af6 100644 --- a/examples/Semigroup.purs +++ b/examples/Semigroup.purs @@ -4,10 +4,15 @@ import Prelude import Effect (Effect) import Effect.Console (logShow) -import Data.Array (singleton) +import Data.Array.NonEmpty (NonEmptyArray) +import Data.Array.NonEmpty as NonEmpty import Data.Bifunctor (bimap) import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Eq (genericEq) +import Data.Generic.Rep.Ord (genericCompare) import Data.Generic.Rep.Show (genericShow) +import Data.Map (Map) +import Data.Map as Map import Data.String (length, null, toLower, toUpper) import Data.Validation.Semigroup (V, invalid) import Global.Unsafe (unsafeStringify) @@ -54,10 +59,6 @@ derive instance genericValidationError :: Generic ValidationError _ instance showValidationError :: Show ValidationError where show = genericShow --- | `ValidationErrors` is a helpful type alias for an `Array` of the errors --- | we might encounter during the validation process. -type ValidationErrors = Array ValidationError - -- | A note on `Data.Validation.Semigroup`'s `V`: -- | -- | `V` is a sum type with an `Invalid` side that collects the errors @@ -70,9 +71,9 @@ type ValidationErrors = Array ValidationError -- | side of `V`. -- | -- | Otherwise, it just returns the input on the `Valid` side of `V`. -validateNonEmpty :: String -> V ValidationErrors String +validateNonEmpty :: String -> V (NonEmptyArray ValidationError) String validateNonEmpty input - | null input = invalid [FieldIsEmpty] + | null input = invalid $ NonEmpty.singleton FieldIsEmpty | otherwise = pure input -- | This function validates that an input `String` is at greater than or equal @@ -82,9 +83,9 @@ validateNonEmpty input -- | `FieldIsTooShort` error on the `Invalid` side of `V`. -- | -- | Otherwise, it just returns the input on the `Valid` side of `V`. -validateMinimumLength :: Int -> String -> V ValidationErrors String +validateMinimumLength :: Int -> String -> V (NonEmptyArray ValidationError) String validateMinimumLength validLength input - | length input <= validLength = invalid [FieldIsTooShort] + | length input <= validLength = invalid (NonEmpty.singleton FieldIsTooShort) | otherwise = pure input -- | This function validates that an input `String` uses some mix of upper- and @@ -95,31 +96,56 @@ validateMinimumLength validLength input -- | the field was entirely upper- or lower-case, respectively. -- | -- | Otherwise, it just returns the input on the `Valid` side of `V`. -validateMixedCase :: String -> V ValidationErrors String +validateMixedCase :: String -> V (NonEmptyArray ValidationError) String validateMixedCase input - | toLower input == input = invalid [FieldIsAllLower] - | toUpper input == input = invalid [FieldIsAllUpper] + | toLower input == input = invalid (NonEmpty.singleton FieldIsAllLower) + | toUpper input == input = invalid (NonEmpty.singleton FieldIsAllUpper) | otherwise = pure input --- | `FormValidationError` represents the errors we might encounter while --- | attempting to validate the username and password fields of our form. +-- | `InvalidField` represents the fields of some form that have failed +-- | validation -- | --- | The `BadUsername` and `BadPassword` branches help us distinguish which --- | part of the form failed validation. -data FormValidationError - = BadUsername ValidationErrors - | BadPassword ValidationErrors +-- | It is used as a key for the `Map` that associates `NonEmptyArray`s of +-- | `ValidationError`s with the field that was invalid. +data InvalidField + = InvalidUsername + | InvalidPassword + +-- | Generically derive a `Show` instance for `InvalidField` so that we may +-- | print these errors to the console later. +derive instance genericInvalidField :: Generic InvalidField _ +instance showInvalidField :: Show InvalidField where + show = genericShow + +-- | Generically derive an `Eq` instance for `InvalidField` so that we may +-- | generically derive an `Ord` instance, so that it may be used as a key in a +-- | `Map`. +instance eqInvalidField :: Eq InvalidField where + eq = genericEq + +-- | Generically derive an `Ord` instance for `InvalidField` so that we may +-- | use it as a key in a `Map`. +instance ordInvalidField :: Ord InvalidField where + compare = genericCompare + +-- | `FormValidationErrors` represents all `ValidationError`s associated with +-- | a particular `ValidationField` that was invalid. +newtype FormValidationErrors = + FormValidationErrors (Map InvalidField (NonEmptyArray ValidationError)) + +-- | Provide a `Semigroup` instance for `FormValidationErrors` that combines +-- | errors using the `Map.unionWith` operation, so as to avoid returning +-- | duplicate entries when fields fail with overlapping errors. +instance semigroupFormValidationErrors :: Semigroup FormValidationErrors where + append (FormValidationErrors errs1) (FormValidationErrors errs2) = + FormValidationErrors $ Map.unionWith (<>) errs1 errs2 -- | Generically derive a `Show` instance for `FormValidationError` so that we -- | may print these errors to the console later. -derive instance genericFormValidationError :: Generic FormValidationError _ -instance showFormValidationError :: Show FormValidationError where +derive instance genericFormValidationError :: Generic FormValidationErrors _ +instance showFormValidationErrors :: Show FormValidationErrors where show = genericShow --- | Much like `ValidationErrors`, `FormValidationErrors` is a helpful alias --- | for an `Array` of errors specific to the validation of our form fields. -type FormValidationErrors = Array FormValidationError - -- | This function validates that an input string conforms to our requirements -- | for a valid username. Namely, we require that the input be non-empty and at -- | least 4 characters long. @@ -133,9 +159,10 @@ type FormValidationErrors = Array FormValidationError -- | Otherwise, it returns the input wrapped in the `Username` newtype to -- | distinguish it from a normal, unvalidated `String`. validateUsername :: String -> V FormValidationErrors Username -validateUsername input = bimap (singleton <<< BadUsername) Username - $ validateNonEmpty input - *> validateMinimumLength 4 input +validateUsername input = + bimap (FormValidationErrors <<< Map.singleton InvalidUsername) Username + $ validateNonEmpty input + *> validateMinimumLength 4 input -- | This function validates that an input string conforms to our requirements -- | for a valid password. Namely, we require that the input be non-empty, at @@ -151,10 +178,11 @@ validateUsername input = bimap (singleton <<< BadUsername) Username -- | Otherwise, it returns the input wrapped in the `Password` newtype to -- | distinguish it from a normal, unvalidated `String`. validatePassword :: String -> V FormValidationErrors Password -validatePassword input = bimap (singleton <<< BadPassword) Password - $ validateNonEmpty input - *> validateMinimumLength 6 input - *> validateMixedCase input +validatePassword input = + bimap (FormValidationErrors <<< Map.singleton InvalidPassword) Password + $ validateNonEmpty input + *> validateMinimumLength 6 input + *> validateMixedCase input -- | This function validates that an `UnvalidatedFormData` record contains both -- | a valid username and a valid password, per the requirements specified in @@ -166,7 +194,9 @@ validatePassword input = bimap (singleton <<< BadPassword) Password -- | -- | Otherwise, it returns the validated fields in the `ValidatedFormData` -- | record specified above. -validateForm :: UnvalidatedFormData -> V FormValidationErrors ValidatedFormData +validateForm + :: UnvalidatedFormData + -> V FormValidationErrors ValidatedFormData validateForm {username, password} = {username: _, password: _} <$> validateUsername username <*> validatePassword password @@ -201,18 +231,19 @@ goodForm = {username: "alice", password: "FooBarBaz"} main :: Effect Unit main = do printValidation $ validateForm emptyUsernameAndPassword - -- > (Invalid [(BadUsername [FieldIsEmpty,FieldIsTooShort]),(BadPassword [FieldIsEmpty,FieldIsTooShort,FieldIsAllLower])]) + -- > invalid ((FormValidationErrors (fromFoldable [(Tuple InvalidUsername (NonEmptyArray [FieldIsEmpty,FieldIsTooShort])),(Tuple InvalidPassword (NonEmptyArray [FieldIsEmpty,FieldIsTooShort,FieldIsAllLower]))]))) printValidation $ validateForm shortUsernameAndPassword - -- > (Invalid [(BadUsername [FieldIsTooShort]),(BadPassword [FieldIsTooShort,FieldIsAllLower])]) + -- > invalid ((FormValidationErrors (fromFoldable [(Tuple InvalidUsername (NonEmptyArray [FieldIsTooShort])),(Tuple InvalidPassword (NonEmptyArray [FieldIsTooShort,FieldIsAllLower]))]))) printValidation $ validateForm lowerCasePassword - -- > (Invalid [(BadPassword [FieldIsAllLower])]) + -- > invalid ((FormValidationErrors (fromFoldable [(Tuple InvalidPassword (NonEmptyArray [FieldIsAllLower]))]))) printValidation $ validateForm upperCasePassword - -- > (Invalid [(BadPassword [FieldIsAllUpper])]) + -- > invalid ((FormValidationErrors (fromFoldable [(Tuple InvalidPassword (NonEmptyArray [FieldIsAllUpper]))]))) printValidation $ validateForm goodForm - -- > (Valid "{\"username\":\"alice\",\"password\":\"FooBarBaz\"}") + -- > pure ("{\"username\":\"alice\",\"password\":\"FooBarBaz\"}") + where printValidation = logShow <<< (map unsafeStringify) From f0e0d1c95dee2ee7220b57c4f8b538c14e7a5e1f Mon Sep 17 00:00:00 2001 From: Joe Kachmar Date: Mon, 24 Jun 2019 09:50:48 -0400 Subject: [PATCH 7/8] Uses newtype derivation --- examples/Semigroup.purs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/examples/Semigroup.purs b/examples/Semigroup.purs index 67f6af6..3d283c1 100644 --- a/examples/Semigroup.purs +++ b/examples/Semigroup.purs @@ -13,6 +13,7 @@ import Data.Generic.Rep.Ord (genericCompare) import Data.Generic.Rep.Show (genericShow) import Data.Map (Map) import Data.Map as Map +import Data.Newtype (class Newtype, over2) import Data.String (length, null, toLower, toUpper) import Data.Validation.Semigroup (V, invalid) import Global.Unsafe (unsafeStringify) @@ -133,12 +134,16 @@ instance ordInvalidField :: Ord InvalidField where newtype FormValidationErrors = FormValidationErrors (Map InvalidField (NonEmptyArray ValidationError)) --- | Provide a `Semigroup` instance for `FormValidationErrors` that combines +-- | Derive a `Newtype` isntance for `FormValidationErrors` so that we may use +-- | generic functions that can operate over it as if it were a plain +-- | `Map InvalidField (NonEmptyArray ValidationError)`. +derive instance newtypeFormValidationErrors :: Newtype FormValidationErrors _ + +-- | Derive a `Semigroup` instance for `FormValidationErrors` that combines -- | errors using the `Map.unionWith` operation, so as to avoid returning -- | duplicate entries when fields fail with overlapping errors. instance semigroupFormValidationErrors :: Semigroup FormValidationErrors where - append (FormValidationErrors errs1) (FormValidationErrors errs2) = - FormValidationErrors $ Map.unionWith (<>) errs1 errs2 + append = over2 FormValidationErrors (Map.unionWith (<>)) -- | Generically derive a `Show` instance for `FormValidationError` so that we -- | may print these errors to the console later. From 839e1df09a87348ee1e3c48657212cb92a9ad22d Mon Sep 17 00:00:00 2001 From: Joe Kachmar Date: Wed, 31 Jul 2019 20:14:40 -0400 Subject: [PATCH 8/8] Adds example builds to CI --- .travis.yml | 1 + package.json | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 27b95cd..9eeed2a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -14,6 +14,7 @@ install: - bower install script: - npm run -s build + - npm run -s build:example after_success: - >- test $TRAVIS_TAG && diff --git a/package.json b/package.json index 01da16a..558a079 100644 --- a/package.json +++ b/package.json @@ -2,7 +2,8 @@ "private": true, "scripts": { "clean": "rimraf output && rimraf .pulp-cache", - "build": "pulp build -- --censor-lib --strict" + "build": "pulp build -- --censor-lib --strict", + "build:example": "pulp build --include examples" }, "devDependencies": { "pulp": "^12.2.0",