summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormrkkrp <>2016-07-23 11:09:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-07-23 11:09:00 (GMT)
commit4667fbb301ec44746affcc4c799eb70e1a7abc71 (patch)
tree12f594b93066a0f0298f38685be935992316f08f
version 0.1.00.1.0
-rw-r--r--CHANGELOG.md3
-rw-r--r--Data/Check.hs178
-rw-r--r--LICENSE.md28
-rw-r--r--README.md45
-rw-r--r--Setup.hs6
-rw-r--r--data-check.cabal82
-rw-r--r--tests/Main.hs120
7 files changed, 462 insertions, 0 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..c32ecf4
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,3 @@
+## Data Check 0.1.0
+
+* Initial release.
diff --git a/Data/Check.hs b/Data/Check.hs
new file mode 100644
index 0000000..cbc1e59
--- /dev/null
+++ b/Data/Check.hs
@@ -0,0 +1,178 @@
+-- |
+-- Module : Data.Check
+-- Copyright : © 2016 Mark Karpov
+-- License : BSD 3 clause
+--
+-- Maintainer : Mark Karpov <markkarpov@openmailbox.org>
+-- Stability : experimental
+-- Portability : portable
+--
+-- This module provides generalized approach to checking and verification of
+-- data, it's useful, for example, for validation of fields on web forms.
+--
+-- Typically, there are a number of transformations and checks you may want
+-- to perform on a particular type of data, such as text. Thus, it makes
+-- sense to create all those transformations and checks once and then
+-- combine them to get more complex validators that may vary on per-field
+-- basis.
+--
+-- Certainly, if we can normalize and validate, we should normalize first.
+-- However, if we have many normalizing operations, we need a way to specify
+-- in which order they should be performed, or result can be unpredictable.
+--
+-- To specify order in which transformations are performed, 'normalizer' and
+-- 'normalizerM' functions take a “priority” argument, which is just a
+-- 'Natural' number. The bigger the number, the later the function will be
+-- applied, so the transformation with priority 0 will always run first.
+--
+-- This method applies to validators just as well. It's possible to create a
+-- vocabulary of validators that can be mixed together and the result will
+-- be always deterministic.
+--
+-- To support more real-world use cases, every check can be performed inside
+-- of a monad, allowing to query a database for example.
+--
+-- One last thing to note is that every normalizer and every validator
+-- should have a unique priority number. Normalizers (and validators) with
+-- the same priority will overwrite each other. This is by design. Note that
+-- normalizer won't override validator with the same priority though, their
+-- priority-spaces are separate.
+
+{-# LANGUAGE GADTs #-}
+
+module Data.Check
+ ( -- * Normalizers
+ normalizer
+ , normalizerM
+ -- * Validators
+ , validator
+ , validatorM
+ -- * Checkers
+ , Checker
+ , runChecker
+ , runCheckerM )
+where
+
+import Control.Monad
+import Data.Functor.Identity
+import Data.Semigroup
+import Data.Set (Set)
+import Numeric.Natural
+import qualified Data.Set as S
+
+----------------------------------------------------------------------------
+-- Normalizers
+
+-- | @'Normalizer' m a@ is a normalizer that works on values of type @a@ in
+-- monad @m@.
+
+data Normalizer m a where
+ Normalizer :: Monad m => Natural -> (a -> m a) -> Normalizer m a
+
+instance Eq (Normalizer m a) where
+ (Normalizer x _) == (Normalizer y _) = x == y
+
+instance Ord (Normalizer m a) where
+ (Normalizer x _) `compare` (Normalizer y _) = x `compare` y
+
+-- | Create a normalizing 'Checker'. Every normalizer has a priority — the
+-- bigger the number, the later the normalizer runs. Every normalizer you
+-- use should have a unique priority number.
+
+normalizer :: Monad m
+ => Natural -- ^ Priority
+ -> (a -> a) -- ^ Normalizing transformation
+ -> Checker m e a -- ^ Normalizing 'Checker'
+normalizer n f = normalizerM n (return . f)
+
+-- | The same as 'normalizer', but allows to perform normalization inside of
+-- a monad.
+
+normalizerM :: Monad m
+ => Natural -- ^ Priority
+ -> (a -> m a) -- ^ Normalizing transformation
+ -> Checker m e a -- ^ Normalizing 'Checker'
+normalizerM n f = Checker (S.singleton $ Normalizer n f) S.empty
+
+----------------------------------------------------------------------------
+-- Validators
+
+-- | @'Validator' m e a@ is a validator that checks values of type @a@,
+-- works in @m@ monad, and can return @e@ messages on failure.
+
+data Validator m e a where
+ Validator :: Natural -> (a -> m (Maybe e)) -> Validator m e a
+
+instance Eq (Validator m e a) where
+ (Validator x _) == (Validator y _) = x == y
+
+instance Ord (Validator m e a) where
+ (Validator x _) `compare` (Validator y _) = x `compare` y
+
+-- | Create a validating 'Checker'. Every validator has a priority — the
+-- bigger the number, the later the validation step runs. Every validator
+-- you use should have a unique priority number.
+
+validator :: Monad m
+ => Natural -- ^ Priority
+ -> (a -> Maybe e) -- ^ 'Nothing' if everything is OK
+ -> Checker m e a -- ^ Validating 'Checker'
+validator n f = validatorM n (return . f)
+
+-- | The same as 'validator', but allows to perform normalization inside of
+-- a monad.
+
+validatorM :: Monad m
+ => Natural -- ^ Priority
+ -> (a -> m (Maybe e)) -- ^ 'Nothing' if everything is OK
+ -> Checker m e a -- ^ Validating 'Checker'
+validatorM n f = Checker S.empty (S.singleton $ Validator n f)
+
+----------------------------------------------------------------------------
+-- Checkers
+
+-- | @'Checker' m e a@ is a checker that checks value of type @a@, can
+-- perform the check in @m@ monad, returning @e@ message when check fails.
+--
+-- 'Checker' is a 'Semigroup' and 'Monoid' — this is how you combine
+-- different checkers and build more complex ones.
+
+data Checker m e a where
+ Checker :: Monad m
+ => Set (Normalizer m a)
+ -> Set (Validator m e a)
+ -> Checker m e a
+
+instance Semigroup (Checker m e a) where
+ (Checker ns vs) <> (Checker ns' vs') = Checker (S.union ns ns') (S.union vs vs')
+
+instance Monad m => Monoid (Checker m e a) where
+ mempty = Checker S.empty S.empty
+ mappend = (<>)
+
+-- | Run a 'Checker' on given value. This is version for cases when all
+-- transformations and validations are pure.
+
+runChecker
+ :: Checker Identity e a -- ^ The 'Checker' to run
+ -> a -- ^ Value to check
+ -> Either e a -- ^ Result, 'Right' on success, 'Left' on failure
+runChecker c x = runIdentity (runCheckerM c x)
+
+-- | Version of 'runChecker' that can run transformations and checks in any
+-- monad.
+
+runCheckerM :: Monad m
+ => Checker m e a -- ^ The 'Checker' to run
+ -> a -- ^ Value to check
+ -> m (Either e a) -- ^ Result, 'Right' on success, 'Left' on failure
+runCheckerM (Checker ns vs) = n >=> \a -> maybe (Right a) Left <$> v a
+ where
+ n = appEndo (foldMap (Endo . nf) . S.toDescList $ ns) . return
+ nf (Normalizer _ f) = (>>= f)
+ v a = appEndo (foldMap (Endo . vf a) . S.toDescList $ vs) (return Nothing)
+ vf a (Validator _ f) m = do
+ x <- m
+ case x of
+ Nothing -> f a
+ Just e -> return (Just e)
diff --git a/LICENSE.md b/LICENSE.md
new file mode 100644
index 0000000..ae71695
--- /dev/null
+++ b/LICENSE.md
@@ -0,0 +1,28 @@
+Copyright © 2016 Mark Karpov
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+* Neither the name Mark Karpov nor the names of contributors may be used to
+ endorse or promote products derived from this software without specific
+ prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS
+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
+NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..4347a6e
--- /dev/null
+++ b/README.md
@@ -0,0 +1,45 @@
+# Data Check
+
+[![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause)
+[![Hackage](https://img.shields.io/hackage/v/data-check.svg?style=flat)](https://hackage.haskell.org/package/data-check)
+[![Stackage Nightly](http://stackage.org/package/data-check/badge/nightly)](http://stackage.org/nightly/package/data-check)
+[![Stackage LTS](http://stackage.org/package/data-check/badge/lts)](http://stackage.org/lts/package/data-check)
+[![Build Status](https://travis-ci.org/mrkkrp/data-check.svg?branch=master)](https://travis-ci.org/mrkkrp/data-check)
+[![Coverage Status](https://coveralls.io/repos/mrkkrp/data-check/badge.svg?branch=master&service=github)](https://coveralls.io/github/mrkkrp/data-check?branch=master)
+
+This is a library that implements generalized approach to checking and
+verification of data, it's useful, for example, for validation of fields on
+web forms.
+
+Typically, there are a number of transformations and checks you may want to
+perform on a particular type of data, such as text. Thus, it makes sense to
+create all those transformations and checks once and then combine them to
+get more complex validators that may vary on per-field basis.
+
+Certainly, if we can normalize and validate, we should normalize first.
+However, if we have many normalizing operations, we need a way to specify in
+which order they should be performed, or result can be unpredictable.
+
+To specify order in which transformations are performed, `normalizer` and
+`normalizerM` functions take a “priority” argument, which is just a
+`Natural` number. The bigger the number, the later the function will be
+applied, so the transformation with priority 0 will always run first.
+
+This method applies to validators just as well. It's possible to create a
+vocabulary of validators that can be mixed together and the result will
+be always deterministic.
+
+To support more real-world use cases, every check can be performed inside of
+a monad, allowing to query a database for example.
+
+One last thing to note is that every normalizer and every validator should
+have a unique priority number. Normalizers (and validators) with the same
+priority will overwrite each other. This is by design. Note that normalizer
+won't override validator with the same priority though, their
+priority-spaces are separate.
+
+## License
+
+Copyright © 2016 Mark Karpov
+
+Distributed under BSD 3 clause license.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..6fa548c
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,6 @@
+module Main (main) where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
diff --git a/data-check.cabal b/data-check.cabal
new file mode 100644
index 0000000..2a588e6
--- /dev/null
+++ b/data-check.cabal
@@ -0,0 +1,82 @@
+--
+-- Cabal configuration for ‘data-check’ package.
+--
+-- Copyright © 2016 Mark Karpov <markkarpov@openmailbox.org>
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+-- * Redistributions of source code must retain the above copyright notice,
+-- this list of conditions and the following disclaimer.
+--
+-- * Redistributions in binary form must reproduce the above copyright
+-- notice, this list of conditions and the following disclaimer in the
+-- documentation and/or other materials provided with the distribution.
+--
+-- * Neither the name Mark Karpov nor the names of contributors may be used
+-- to endorse or promote products derived from this software without
+-- specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY
+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY
+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+name: data-check
+version: 0.1.0
+cabal-version: >= 1.10
+license: BSD3
+license-file: LICENSE.md
+author: Mark Karpov <markkarpov@openmailbox.org>
+maintainer: Mark Karpov <markkarpov@openmailbox.org>
+homepage: https://github.com/mrkkrp/data-check
+bug-reports: https://github.com/mrkkrp/data-check/issues
+category: Data, Web
+synopsis: Library for checking and normalization of data (e.g. from web forms)
+build-type: Simple
+description: Library for checking and normalization of data (e.g. from web forms).
+extra-source-files: CHANGELOG.md
+ , README.md
+
+source-repository head
+ type: git
+ location: https://github.com/mrkkrp/data-check.git
+
+flag dev
+ description: Turn on development settings.
+ manual: True
+ default: False
+
+library
+ build-depends: base >= 4.8 && < 5.0
+ , containers >= 0.5 && < 0.6
+ if !impl(ghc >= 8.0)
+ build-depends: semigroups == 0.18.*
+ exposed-modules: Data.Check
+ if flag(dev)
+ ghc-options: -Wall -Werror
+ else
+ ghc-options: -O2 -Wall
+ default-language: Haskell2010
+
+test-suite tests
+ main-is: Main.hs
+ hs-source-dirs: tests
+ type: exitcode-stdio-1.0
+ build-depends: base >= 4.7 && < 5.0
+ , QuickCheck >= 2.4 && < 3.0
+ , data-check >= 0.1.0
+ , hspec >= 2.0 && < 3.0
+ if flag(dev)
+ ghc-options: -Wall -Werror
+ else
+ ghc-options: -O2 -Wall
+ default-language: Haskell2010
diff --git a/tests/Main.hs b/tests/Main.hs
new file mode 100644
index 0000000..8255d23
--- /dev/null
+++ b/tests/Main.hs
@@ -0,0 +1,120 @@
+--
+-- Tests for the ‘data-check’ package.
+--
+-- Copyright © 2016 Mark Karpov <markkarpov@openmailbox.org>
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+-- * Redistributions of source code must retain the above copyright notice,
+-- this list of conditions and the following disclaimer.
+--
+-- * Redistributions in binary form must reproduce the above copyright
+-- notice, this list of conditions and the following disclaimer in the
+-- documentation and/or other materials provided with the distribution.
+--
+-- * Neither the name Mark Karpov nor the names of contributors may be used
+-- to endorse or promote products derived from this software without
+-- specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY
+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY
+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+{-# LANGUAGE MultiWayIf #-}
+
+module Main (main) where
+
+import Data.Check
+import Data.Monoid
+import Test.Hspec
+import Test.QuickCheck
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = do
+ context "when two normalizers have the same priority" $
+ it "the left one overrides the right one" $
+ property $ \x -> do
+ runChecker (addOneNorm <> addTwoNorm) x `shouldBe` Right (x + 1)
+ runChecker (addTwoNorm <> addOneNorm) x `shouldBe` Right (x + 2)
+ context "when two validators have the same priority" $
+ it "the left one overrides the right one" $
+ property $ \x -> do
+ runChecker (validatorTrue <> validatorFalse) x `shouldBe` Left True
+ runChecker (validatorFalse <> validatorTrue) x `shouldBe` Left False
+ context "adding mempty to the max" $
+ it "has no effect" $
+ property $ \x -> do
+ runChecker (addOneNorm <> mempty) x `shouldBe` Right (x + 1)
+ runChecker (mempty <> addOneNorm) x `shouldBe` Right (x + 1)
+ runChecker (validatorTrue <> mempty) x `shouldBe` Left True
+ runChecker (mempty <> validatorTrue) x `shouldBe` Left True
+ context "when using several normalizers" $
+ it "they are applied, and applied in order" $
+ property $ \x -> do
+ runChecker (addOneNorm <> mulThreeNorm) x
+ `shouldBe` Right (x * 3 + 1)
+ runChecker (addThreeNorm <> mulThreeNorm) x
+ `shouldBe` Right ((x + 3) * 3)
+ context "when using several validators" $
+ it "they are run, and run in order" $
+ property $ \x ->
+ runChecker (validatorGT50 <> validatorLT100) x
+ `shouldBe` if | x <= 50 -> Left False
+ | x >= 100 -> Left True
+ | otherwise -> Right x
+ context "when we have both normalizers and validators" $
+ it "normalizers are run before validators and their output is used" $
+ property $ \x ->
+ runChecker (mulThreeNorm <> validatorGT50) x
+ `shouldBe` if x * 3 > 50
+ then Right (x * 3)
+ else Left False
+ it "normalizers and validators can run inside a monad" $
+ property $ \x ->
+ runCheckerM (breakingNorm <> addOneNorm <> validatorLT100) x
+ `shouldBe` Nothing
+
+----------------------------------------------------------------------------
+-- Collection of test normazilers and validators
+
+addOneNorm :: Monad m => Checker m Bool Int
+addOneNorm = normalizer 3 (+ 1)
+
+addTwoNorm :: Monad m => Checker m Bool Int
+addTwoNorm = normalizer 3 (+ 2)
+
+mulThreeNorm :: Monad m => Checker m Bool Int
+mulThreeNorm = normalizer 2 (* 3)
+
+addThreeNorm :: Monad m => Checker m Bool Int
+addThreeNorm = normalizer 1 (+ 3)
+
+breakingNorm :: Checker Maybe Bool Int
+breakingNorm = normalizerM 0 (const Nothing)
+
+validatorTrue :: Monad m => Checker m Bool Int
+validatorTrue = validator 3 (const $ return True)
+
+validatorFalse :: Monad m => Checker m Bool Int
+validatorFalse = validator 3 (const $ return False)
+
+validatorGT50 :: Monad m => Checker m Bool Int
+validatorGT50 = validator 3 $ \x ->
+ if x > 50 then Nothing else Just False
+
+validatorLT100 :: Monad m => Checker m Bool Int
+validatorLT100 = validator 4 $ \x ->
+ if x < 100 then Nothing else Just True