diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /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 --- /dev/null +++ b/Data/Check.hs @@ -0,0 +1,178 @@ +-- | +-- Module : Data.Check +-- Copyright : © 2016 Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- 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 --- /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 --- /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 --- /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 --- /dev/null +++ b/data-check.cabal @@ -0,0 +1,82 @@ +-- +-- Cabal configuration for ‘data-check’ package. +-- +-- Copyright © 2016 Mark Karpov +-- +-- 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 +maintainer: Mark Karpov +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 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,120 @@ +-- +-- Tests for the ‘data-check’ package. +-- +-- Copyright © 2016 Mark Karpov +-- +-- 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