version 0.1.00.1.0

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