validators (empty) → 0.0.1
raw patch · 10 files changed
+626/−0 lines, 10 filesdep +Globdep +basedep +containers
Dependencies added: Glob, base, containers, doctest, hspec, text, validators
Files
- CHANGELOG.md +12/−0
- LICENSE +21/−0
- README.md +87/−0
- lib/Data/Validation.hs +92/−0
- lib/Data/Validator.hs +266/−0
- tests/Data/ValidationSpec.hs +32/−0
- tests/Data/ValidatorSpec.hs +28/−0
- tests/doctest.hs +9/−0
- tests/test.hs +2/−0
- validators.cabal +77/−0
+ CHANGELOG.md view
@@ -0,0 +1,12 @@++# Changelog++All notable changes to this project will be documented in this file.+`validators` uses [PVP versioning](https://pvp.haskell.org/).+The CHANGELOG is available on [Github](https://github.com/luc-tielen/validators.git/CHANGELOG.md).+++## [0.0.1] - 2019-10-23+### Added++- Initial version of the library
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License++Copyright (c) 2019 Luc Tielen++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ README.md view
@@ -0,0 +1,87 @@++# Validators++[](https://circleci.com/gh/luc-tielen/validators)++A library for validating input data in Haskell, inspired partly by [elm-validate](https://github.com/rtfeldman/elm-validate/).+++## Concepts++### Validator++The library provides a `Validator` datatype for checking assertions+on input data. A validator is parametrized by 2 type variables:++1. `err`: the type of error a validator can return,+2. `subject`: the type being inspected/validated.++Execute validators by using the `validate` function:++```haskell+data Error = TooSmall | TooBig++>>> let validator = assert (> 10) [TooSmall]+>>> validate validator 11 -- Success 11+>>> validate validator 4 -- Failure [TooSmall]+```++Validators return a `Validation` type as result, which can be+further chained or checked for the final result. This is explained in+the [Validation](#Validation) section.++Validators can also be combined using the `Semigroup` instance,+resulting in a validator that accumulates errors from both sub-validators:++```haskell+>>> let validator = maxSize 3 [TooBig] <> minSize 2 [TooSmall]+>>> validate validator [1, 2, 3] -- Success [1,2,3]+>>> validate validator [1, 2, 3, 4] -- Failure [TooBig]+>>> validate validator [1] -- Failure [TooSmall]+```++The library provides helper functions for commonly used validation checks.+See the docs for a complete overview which validators are available.+++### Validation++Once a `Validator` has been executed, it will return a `Validation` data type.+This value will contain either all accumulated errors found during the checking+of assertions, or the given input value.++Validations are composed using their `Applicative` instance. This can be useful+for example when validating product types. Like with `Validator`, this will also+accumulate all encountered errors.++The following is an example for validating a `Person` data type:++```haskell+data PersonError = MissingName | InvalidAge++type Name = String+type Age = Int+data Person = Person Name Age++>>> let nameValidator = ifEmpty [MissingName]+>>> let ageValidator = assert (> 0) [InvalidAge]+>>> Person <$> validate nameValidator "" <*> validate ageValidator (subtract 1) -- Failure [MissingName, InvalidAge]+>>> Person <$> validate nameValidator "Alice" <*> validate ageValidator (subtract 1) -- Failure [InvalidAge]+>>> Person <$> validate nameValidator "Alice" <*> validate ageValidator 25 -- Success (Person "Alice" 25)+```+++## Developing++The easiest way to start developing is by using [Nix](https://nixos.org/nix/download.html).++```bash+$ git clone git@github.com:luc-tielen/validators.git+$ cd validators+$ nix-shell+$ cabal new-configure # run inside the nix-shell+$ cabal new-build # run inside the nix-shell+```++The most often used commands are also provided by a [Makefile](https://github.com/luc-tielen/validators/blob/master/Makefile).+
+ lib/Data/Validation.hs view
@@ -0,0 +1,92 @@+-- | This module defines the 'Validation' data type.+--+-- Most functionality is the same as in the+-- <http://hackage.haskell.org/package/validation-1.1 validation> library,+-- but the module doesn't provide certain typeclass instances that require+-- a dependency on the lens library.+module Data.Validation+ ( Validation (..),+ toEither,+ fromEither,+ )+where++import Data.Bifoldable+import Data.Bifunctor+import Data.Bitraversable++-- | A 'Validation' is very similar to 'Either' in that it contains a value of type /e/ or /a/.+-- In contrast to Either however, Validation accumulates all errors it comes+-- across in it's 'Applicative' instance.+--+-- A complete example where Validation is used can be found+-- <https://github.com/luc-tielen/validators.git here>.+data Validation err a+ = Failure !err+ | Success !a+ deriving (Eq, Show, Ord)++instance Functor (Validation err) where+ fmap _ (Failure err) = Failure err+ fmap f (Success a) = Success (f a)+ {-# INLINE fmap #-}++instance Bifunctor Validation where+ bimap f _ (Failure e) = Failure (f e)+ bimap _ g (Success a) = Success (g a)+ {-# INLINE bimap #-}++instance Foldable (Validation err) where+ foldMap f (Success a) = f a+ foldMap _ _ = mempty+ {-# INLINE foldMap #-}++instance Bifoldable Validation where+ bifoldMap f _ (Failure e) = f e+ bifoldMap _ g (Success a) = g a+ {-# INLINE bifoldMap #-}++instance Traversable (Validation err) where+ traverse f (Success a) = Success <$> f a+ traverse _ (Failure e) = pure (Failure e)+ {-# INLINE traverse #-}++instance Bitraversable Validation where+ bitraverse _ g (Success a) = Success <$> g a+ bitraverse f _ (Failure e) = Failure <$> f e+ {-# INLINE bitraverse #-}++instance Semigroup err => Applicative (Validation err) where++ Failure e1 <*> Failure e2 = Failure (e1 <> e2)+ Failure e1 <*> _ = Failure e1+ _ <*> Failure e2 = Failure e2+ Success f <*> Success a = Success (f a)+ {-# INLINE (<*>) #-}++ pure = Success+ {-# INLINE pure #-}++-- | Conversion function from 'Validation' to 'Either'.+--+-- >>> toEither (Failure 1)+-- Left 1+-- >>> toEither (Success True)+-- Right True+toEither :: Validation err a -> Either err a+toEither v = case v of+ Failure e -> Left e+ Success a -> Right a+{-# INLINE toEither #-}++-- | Conversion function from 'Either' to 'Validation'.+--+-- >>> fromEither (Left 1)+-- Failure 1+-- >>> fromEither (Right True)+-- Success True+fromEither :: Either err a -> Validation err a+fromEither e = case e of+ Left a -> Failure a+ Right b -> Success b+{-# INLINE fromEither #-}
+ lib/Data/Validator.hs view
@@ -0,0 +1,266 @@+{-# LANGUAGE FlexibleInstances #-}++-- | This module defines the 'Validator' data type and helper functions+-- for creating various validators.+module Data.Validator+ ( Validator,+ validate,+ assert,+ refute,+ ifNothing,+ ifLeft,+ HasSize (..),+ ifEmpty,+ minSize,+ maxSize,+ IsOnlyWhiteSpace (..),+ ifBlank,+ )+where++import Data.Either (isRight)+import Data.Functor.Contravariant+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe (isJust)+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import Data.Set (Set)+import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import Data.Validation++-- | Helper data type resembling the result of a 'Validator' assertion.+--+-- There are only 2 possible results:+-- 1. Ok: the validator assertion succeeded.+-- 2. Err: the validator assertion failed.+--+-- Only used internally in the 'Validator' type to keep track of accumulated errors.+data Result err = Ok | Err !err+ deriving (Eq, Show)++instance Semigroup err => Semigroup (Result err) where+ Ok <> Ok = Ok+ Err e1 <> Err e2 = Err $ e1 <> e2+ Err e1 <> _ = Err e1+ _ <> Err e2 = Err e2+ {-# INLINE (<>) #-}++instance Monoid err => Monoid (Result err) where+ mempty = Ok+ {-# INLINE mempty #-}++-- | Datatype for checking if a validation holds for a subject.+--+-- - __subject__ can be any data type for which assertions need to be checked.+-- - __err__ can be any type representing an error, but it will only be possible to+-- combine validators if the error type has a Semigroup instance.+--+-- Execute a validator by passing it to the 'validate' function.+--+-- A Validator is both a 'Semigroup' and a 'Monoid', making it possible to combine+-- smaller validators into larger validators. A combined validator will accumulate+-- errors from all of it's sub-validators.+newtype Validator err subject = Validator (subject -> Result err)++instance Semigroup err => Semigroup (Validator err subject) where+ Validator v1 <> Validator v2 = Validator $ v1 <> v2+ {-# INLINE (<>) #-}++instance Monoid err => Monoid (Validator err subject) where+ mempty = Validator mempty+ {-# INLINE mempty #-}++instance Contravariant (Validator err) where+ contramap f (Validator g) = Validator (g . f)+ {-# INLINE contramap #-}++-- | Runs a validator on a subject.+--+-- The result is a 'Validation' containing all accumulated errors,+-- or the subject wrapped in a 'Success' value.+validate :: Validator err subject -> subject -> Validation err subject+validate (Validator f) a = case f a of+ Err e -> Failure e+ Ok -> Success a+{-# INLINE validate #-}++-- | Creates a validator that will return an error if the given predicate doesn't hold.+--+-- Since any predicate can be provided for checking if the subject satisfies+-- certain conditions, this can be used to build your own custom validators.+--+-- Usage:+--+-- >>> let validator = assert (> 10) ["too small"]+-- >>> validate validator 11+-- Success 11+--+-- >>> validate validator 1+-- Failure ["too small"]+assert :: (subject -> Bool) -> err -> Validator err subject+assert p err = Validator $ \subject -> if p subject then Ok else Err err+{-# INLINE assert #-}++-- | Creates a validator that will return an error if the given predicate holds.+--+-- Since any predicate can be provided for checking if the subject satisfies+-- certain conditions, this can be used to build your own custom validators.+--+-- Usage:+--+-- >>> let validator = refute (> 10) ["too big"]+-- >>> validate validator 11+-- Failure ["too big"]+--+-- >>> validate validator 1+-- Success 1+refute :: (subject -> Bool) -> err -> Validator err subject+refute p = assert (not . p)+{-# INLINE refute #-}++-- | Returns an error if a 'Maybe' is 'Nothing'.+--+-- Usage:+--+-- >>> let validator = ifNothing ["Found nothing."]+-- >>> validate validator Nothing+-- Failure ["Found nothing."]+--+-- >>> validate validator (Just "Bob")+-- Success (Just "Bob")+ifNothing :: err -> Validator err (Maybe a)+ifNothing = assert isJust+{-# INLINE ifNothing #-}++-- | Returns an error if an 'Either' contains a 'Left'.+--+-- Usage:+--+-- >>> let validator = ifLeft ["Found left."]+-- >>> validate validator (Left 123)+-- Failure ["Found left."]+--+-- >>> validate validator (Right 456)+-- Success (Right 456)+ifLeft :: err -> Validator err (Either a b)+ifLeft = assert isRight+{-# INLINE ifLeft #-}++-- | Helper typeclass for checking if a value is empty.+class HasSize a where++ size :: a -> Int++ isEmpty :: a -> Bool+ isEmpty = (== 0) . size++instance HasSize [a] where++ size = length+ {-# INLINE size #-}++ isEmpty = null+ {-# INLINE isEmpty #-}++instance HasSize (Map k v) where++ size = Map.size+ {-# INLINE size #-}++ isEmpty = Map.null+ {-# INLINE isEmpty #-}++instance HasSize (Set a) where++ size = Set.size+ {-# INLINE size #-}++ isEmpty = Set.null+ {-# INLINE isEmpty #-}++instance HasSize (Seq a) where++ size = Seq.length+ {-# INLINE size #-}++ isEmpty = Seq.null+ {-# INLINE isEmpty #-}++-- | Returns an error if the function returns an "empty" value.+--+-- Usage:+--+-- >>> let validator = ifEmpty ["Empty."]+-- >>> validate validator []+-- Failure ["Empty."]+--+-- >>> validate validator [1, 2, 3]+-- Success [1,2,3]+-- >>> validate validator (Map.fromList [('a', 1), ('b', 2)])+-- Success (fromList [('a',1),('b',2)])+ifEmpty :: HasSize subject => err -> Validator err subject+ifEmpty = refute isEmpty+{-# INLINE ifEmpty #-}++-- | Returns an error if the value has a size smaller than required.+--+-- Usage:+--+-- >>> let validator = minSize 3 ["Too small."]+-- >>> validate validator []+-- Failure ["Too small."]+-- >>> validate validator [1, 2]+-- Failure ["Too small."]+--+-- >>> validate validator [1, 2, 3]+-- Success [1,2,3]+minSize :: HasSize subject => Int -> err -> Validator err subject+minSize x = refute ((< x) . size)+{-# INLINE minSize #-}++-- | Returns an error if the value has a size smaller than required.+--+-- Usage:+--+-- >>> let validator = maxSize 3 ["Too big."]+-- >>> validate validator [1, 2, 3, 4]+-- Failure ["Too big."]+--+-- >>> validate validator [1, 2, 3]+-- Success [1,2,3]+maxSize :: HasSize subject => Int -> err -> Validator err subject+maxSize x = refute ((> x) . size)+{-# INLINE maxSize #-}++-- | Helper typeclass for checking if a value contains only whitespace characters.+class IsOnlyWhiteSpace a where+ isOnlyWhiteSpace :: a -> Bool++instance IsOnlyWhiteSpace String where+ isOnlyWhiteSpace = null . words+ {-# INLINE isOnlyWhiteSpace #-}++instance IsOnlyWhiteSpace TL.Text where+ isOnlyWhiteSpace = null . TL.words+ {-# INLINE isOnlyWhiteSpace #-}++instance IsOnlyWhiteSpace T.Text where+ isOnlyWhiteSpace = null . T.words+ {-# INLINE isOnlyWhiteSpace #-}++-- | Returns an error if the function returns a value containing only whitespace.+--+-- Usage:+--+-- >>> let validator = ifBlank ["Only whitespace."]+-- >>> validate validator " \t \n \r "+-- Failure ["Only whitespace."]+--+-- >>> validate validator "not empty"+-- Success "not empty"+ifBlank :: IsOnlyWhiteSpace subject => err -> Validator err subject+ifBlank = refute isOnlyWhiteSpace+{-# INLINE ifBlank #-}
+ tests/Data/ValidationSpec.hs view
@@ -0,0 +1,32 @@+module Data.ValidationSpec (module Data.ValidationSpec) where++import Control.Arrow ((>>>))+import Data.Validation+import Data.Validator+import Test.Hspec++(==>) :: (Eq a, Show a) => a -> a -> IO ()+(==>) = shouldBe++infixr 0 ==>++type Name = String++type Age = Int++data Person = Person Name Age+ deriving (Eq, Show)++spec :: Spec+spec = describe "Running validations" $ parallel $ do+ it "can combine validations into bigger validations" $ do+ let nameValidator = assert (length >>> (> 0)) ["name can't be empty"]+ ageValidator =+ assert (> 0) ["age must be > 0"]+ <> assert (< 120) ["age must be < 120"]+ runTest name age =+ Person <$> validate nameValidator name <*> validate ageValidator age+ runTest "" 0 ==> Failure ["name can't be empty", "age must be > 0"]+ runTest "" 10 ==> Failure ["name can't be empty"]+ runTest "Alice" 0 ==> Failure ["age must be > 0"]+ runTest "Alice" 25 ==> Success $ Person "Alice" 25
+ tests/Data/ValidatorSpec.hs view
@@ -0,0 +1,28 @@+module Data.ValidatorSpec (module Data.ValidatorSpec) where++import Data.Validation+import Data.Validator+import Test.Hspec++(==>) :: (Eq a, Show a) => a -> a -> IO ()+(==>) = shouldBe++infixr 0 ==>++data Error = TooSmall | TooBig | WrongNumber+ deriving (Eq, Show)++spec :: Spec+spec = describe "Validators" $ parallel $ do+ describe "Running validators" $ parallel $ do+ it "can run single validation on a subject" $ do+ let validator = assert (> 10) [TooSmall]+ validate validator 11 ==> Success 11+ validate validator 1 ==> Failure [TooSmall]+ it "can run multiple validations on a subject" $ do+ let validator =+ assert (< 10) [TooBig]+ <> assert (== 7) [WrongNumber]+ validate validator 7 ==> Success 7+ validate validator 6 ==> Failure [WrongNumber]+ validate validator 11 ==> Failure [TooBig, WrongNumber]
+ tests/doctest.hs view
@@ -0,0 +1,9 @@+module Main (main) where++import System.FilePath.Glob (glob)+import Test.DocTest (doctest)++main :: IO ()+main = do+ sourceFiles <- glob "lib/**/*.hs"+ doctest sourceFiles
+ tests/test.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
+ validators.cabal view
@@ -0,0 +1,77 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 04bfc615274aa1d27d3d495bc899783d55c2f99bf0866b6d33027777be15861e++name: validators+version: 0.0.1+synopsis: Composable validations for your Haskell data types+description: Composable validations for your Haskell data types.+category: Data+homepage: https://github.com/luc-tielen/validators#README.md+author: Luc Tielen+maintainer: luc.tielen@gmail.com+copyright: 2019 Luc Tielen+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ CHANGELOG.md+ LICENSE++library+ exposed-modules:+ Data.Validation+ Data.Validator+ other-modules:+ Paths_validators+ hs-source-dirs:+ lib+ ghc-options: -Wall -Weverything -Wno-implicit-prelude -Wno-missing-import-lists -optP-Wno-nonportable-include-path -fhide-source-paths -fno-show-valid-hole-fits -fno-sort-valid-hole-fits+ build-depends:+ base >=4.12 && <5+ , containers ==0.*+ , text ==1.*+ default-language: Haskell2010++test-suite validators-doctest+ type: exitcode-stdio-1.0+ main-is: doctest.hs+ other-modules:+ Data.ValidationSpec+ Data.ValidatorSpec+ Paths_validators+ hs-source-dirs:+ tests+ ghc-options: -Wall -Weverything -Wno-implicit-prelude -Wno-missing-import-lists -optP-Wno-nonportable-include-path -fhide-source-paths -fno-show-valid-hole-fits -fno-sort-valid-hole-fits -threaded+ build-depends:+ Glob >=0.10.0 && <1+ , base >=4.12 && <5+ , containers ==0.*+ , doctest >=0.16.1 && <1+ , hspec >=2.6.1 && <3.0.0+ , text ==1.*+ , validators+ default-language: Haskell2010++test-suite validators-test+ type: exitcode-stdio-1.0+ main-is: test.hs+ other-modules:+ Data.ValidationSpec+ Data.ValidatorSpec+ Paths_validators+ hs-source-dirs:+ tests+ ghc-options: -Wall -Weverything -Wno-implicit-prelude -Wno-missing-import-lists -optP-Wno-nonportable-include-path -fhide-source-paths -fno-show-valid-hole-fits -fno-sort-valid-hole-fits+ build-depends:+ base >=4.12 && <5+ , containers ==0.*+ , hspec >=2.6.1 && <3.0.0+ , text ==1.*+ , validators+ default-language: Haskell2010