menshen 0.0.0 → 0.0.1

raw patch · 4 files changed

+193/−64 lines, 4 filesdep +aesonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: aeson

API changes (from Hackage documentation)

Files

• README.md +21/−21
• menshen.cabal +3/−2
• src/Data/Menshen.hs +102/−14
• test/Spec.hs +67/−27

@@ -1,31 +1,31 @@ # menshen -[![Hackage](https://img.shields.io/badge/hackage-v0.0.0-orange.svg)](https://hackage.haskell.org/package/menshen)+[![Hackage](https://img.shields.io/badge/hackage-v0.0.1-orange.svg)](https://hackage.haskell.org/package/menshen) [![Build Status](https://travis-ci.org/leptonyu/menshen.svg?branch=master)](https://travis-ci.org/leptonyu/menshen)   ```Haskell -λ> let value :: Int -> Either String Int; value = Right-λ> value 10 & maxInt 8-Left "must be less than or equal to 8"-λ> value 10 & maxInt 10-Right 10-λ> value 10 & maxInt 10 & minInt 8-Right 10-λ> value 9 & maxInt 10 & minInt 8-Right 9-λ> value 7 & maxInt 10 & minInt 8-Left "must be greater than or equal to 8"-λ> let str :: String -> Either String String; str = Right-λ> str "xxxx@gmail.com" & email-Right "xxxx@gmail.com"-λ> str "xxxx@gmail" & email-Left "must be a well-formed email address"-λ> str "123456789" & size (6,32)-Right "123456789"-λ> str "12345" & size (6,32)-Left "size must be between 6 and 32"+{-# LANGUAGE RecordWildCards #-}+module Main where+import Data.Menshen+data Body = Body+  { name :: String+  , age  :: Int+  } deriving Show++valifyBody :: Validator Body+valifyBody = \ma -> do+  Body{..} <- ma+  Body+    <$> name ?: pattern "^[a-z]{3,6}$"+    <*> age  ?: minInt 1 . maxInt 150++makeBody :: String -> Int -> Either String Body+makeBody name age = Body{..} ?: valifyBody++main = do+  print $ makeBody "daniel" 15   ```

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 06c81eb80414f486ca7ea81d1eae4d2fb856614b4503aa07890f9404e9dda98a+-- hash: 8899e367732559bb8cbe2fc5e109b65a3d8d75f7f3abb404caffd690de0a2083  name:           menshen-version:        0.0.0+version:        0.0.1 synopsis:       Data Validation description:    Data Validation inspired by JSR305 category:       Web@@ -46,6 +46,7 @@   ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures   build-depends:       QuickCheck+    , aeson     , base >=4.7 && <5     , hspec ==2.*     , menshen

@@ -5,14 +5,27 @@ {-# LANGUAGE RankNTypes            #-} {-# LANGUAGE TypeOperators         #-} {-# LANGUAGE TypeSynonymInstances  #-}-+-- |+-- Module:      Data.Salak+-- Copyright:   (c) 2019 Daniel YU+-- License:     BSD3+-- Maintainer:  Daniel YU <leptonyu@gmail.com>+-- Stability:   experimental+-- Portability: portable+--+-- Data Validation inspired by JSR305+-- module Data.Menshen(+  -- * How to use this library+  -- $use++  -- * Definition     HasValid(..)   , Validator-  , HasValidSize-  , size-  , notEmpty-  , notBlank+  , ValidationException(..)+  , HasI18n(..)+  -- * Validation Functions+  , HasValidSize(..)   , notNull   , assertNull   , assertTrue@@ -27,10 +40,12 @@   , maxDecimal   , pattern   , email-  , (&)+  -- * Validation Operations+  , (?)+  , valify+  , (?:)+  -- * Reexport Functions   , (=~)-  , ValidationException(..)-  , HasI18n(..)   ) where  import           Data.Scientific@@ -46,10 +61,21 @@ x & f = f x #endif +-- | apply record validation to the value+infixl 5 ?+(?) = (&) +-- | lift value a to validation context and check if it is valid.+--+infixl 5 ?:+(?:) :: HasValid m => a -> Validator a -> m a+(?:) = valify++-- | Plan for i18n translate, now just for english. class HasI18n a where   toI18n :: a -> String +-- | Validation Error Message data ValidationException   = ShouldBeFalse   | ShouldBeTrue@@ -99,18 +125,20 @@   toI18n (InvalidDigits i f)    = "numeric value out of bounds (<" ++ show i ++ " digits>.<" ++ show f ++ " digits> expected)"   toI18n (InvalidPattern r)     = "must match " ++ r +-- | Define how invalid infomation passed to upper layer. class Monad m => HasValid m where   invalid  :: HasI18n a => a -> m b   invalid = error . toI18n -instance HasValid IO- instance HasValid (Either String) where   invalid = Left . toI18n +-- | Validator, use to define detailed validation check. type Validator a = forall m. HasValid m => m a -> m a +-- | Length checker bundle class HasValidSize a where+  -- | Size validation   size :: (Word64, Word64) -> Validator a   size (x,y) = \ma -> do     a <- ma@@ -118,18 +146,21 @@     if la < x || la > y       then invalid $ InvalidSize x y       else return a+  -- | Assert not empty   notEmpty :: Validator a   notEmpty = \ma -> do     a <- ma     if getLength a == 0       then invalid InvalidNotEmpty       else return a+  -- | Assert not blank   notBlank :: Validator a   notBlank = \ma -> do     a <- ma     if getLength a == 0       then invalid InvalidNotBlank       else return a+  -- | calculate length from value   getLength :: a -> Word64   {-# MINIMAL getLength #-} @@ -142,6 +173,7 @@ instance HasValidSize [a] where   getLength = fromIntegral . length +-- | Regular expression validation pattern :: RegexLike Regex a => String -> Validator a pattern p = \ma -> do   a <- ma@@ -151,12 +183,14 @@ emailPattern :: String emailPattern = "^[A-Z0-9a-z._%+-]+@[A-Za-z0-9.-]+\\.[A-Za-z]{2,64}$" +-- | Email validation email :: RegexLike Regex a => Validator a email = \ma -> do   a <- ma   if a =~ emailPattern then return a     else invalid InvalidEmail +-- | Positive validation positive :: (Eq a, Num a) => Validator a positive = \ma -> do   a <- ma@@ -164,6 +198,7 @@     then return a     else invalid InvalidPositive +-- | Positive or zero validation positiveOrZero :: (Eq a, Num a) => Validator a positiveOrZero = \ma -> do   a <- ma@@ -171,6 +206,7 @@     then return a     else invalid InvalidPositiveOrZero +-- | Negative validation negative :: (Eq a, Num a) => Validator a negative = \ma -> do   a <- ma@@ -178,6 +214,7 @@     then return a     else invalid InvalidNegative +-- | Negative or zero validation negativeOrZero :: (Eq a, Num a) => Validator a negativeOrZero = \ma -> do   a <- ma@@ -185,18 +222,21 @@     then return a     else invalid InvalidNegativeOrZero +-- | Assert true assertTrue :: Validator Bool assertTrue = \ma -> do   a <- ma   if a then return a     else invalid ShouldBeTrue +-- | Assert false assertFalse :: Validator Bool assertFalse = \ma -> do   a <- ma   if not a then return a     else invalid ShouldBeFalse +-- | Assert not null notNull :: Validator (Maybe a) notNull = \ma -> do   a <- ma@@ -204,6 +244,7 @@     Just _ -> return a     _      -> invalid ShouldNotNull +-- | Assert null assertNull :: Validator (Maybe a) assertNull = \ma -> do   a <- ma@@ -211,30 +252,77 @@     Just _ -> invalid ShouldNull     _      -> return a -maxInt :: (Ord a, Integral a) => a -> Validator a+-- | Maximum int validation+maxInt :: Integral a => a -> Validator a maxInt m = \ma -> do   a <- ma   if a > m     then invalid (InvalidMax $ toInteger m)     else return a -minInt :: (Ord a, Integral a) => a -> Validator a+-- | Minimum int validation+minInt :: Integral a => a -> Validator a minInt m = \ma -> do   a <- ma   if a < m     then invalid (InvalidMin $ toInteger m)     else return a -maxDecimal :: (Ord a, RealFloat a) => a -> Validator a+-- | Maximum decimal validation+maxDecimal :: RealFloat a => a -> Validator a maxDecimal m = \ma -> do   a <- ma   if a > m     then invalid (InvalidDecimalMax $ fromFloatDigits m)     else return a -minDecimal :: (Ord a, RealFloat a) => a -> Validator a+-- | Minimum int validation+minDecimal :: RealFloat a => a -> Validator a minDecimal m = \ma -> do   a <- ma   if a < m     then invalid (InvalidDecimalMin $ fromFloatDigits m)     else return a++-- | lift value a to validation context and check if it is valid.+valify :: HasValid m => a -> Validator a -> m a+valify a f = return a ? f++-- $use+--+-- This library is designed for validate haskell records, such as in configurations or web request parameters.+--+-- Usage:+--+-- > {-# LANGUAGE RecordWildCards #-}+-- > module Main where+-- > import Data.Menshen+-- > data Body = Body+-- >   { name :: String+-- >   , age  :: Int+-- >   } deriving Show+-- >+-- > valifyBody :: Validator Body+-- > valifyBody = \ma -> do+-- >   Body{..} <- ma+-- >   Body+-- >     <$> name ?: pattern "^[a-z]{3,6}$"+-- >     <*> age  ?: minInt 1 . maxInt 150+-- >+-- > makeBody :: String -> Int -> Either String Body+-- > makeBody name age = Body{..} ?: valifyBody+-- >+-- > main = do+-- >   print $ makeBody "daniel" 15+-- >+--+-- Useage in Record parsing process:+--+-- > instance HasValid Parser where+-- >   invalid = fail . toI18n+-- >+-- > instance FromJSON Body where+-- >   parseJSON = withObject "Body" $ \v -> Body+-- >     <$> v .: "name" ? pattern "^[a-z]{3,6}$"+-- >     <*> v .: "age"  ? minInt 1 . maxInt 150+-- >

@@ -1,11 +1,20 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-} module Main where +import           Data.Aeson+import           Data.Aeson.Types import           Data.Either import           Data.Int+import           Data.Maybe import           Data.Menshen import           Data.Word import           Test.Hspec import           Test.QuickCheck+#if __GLASGOW_HASKELL__ <= 708+import           Control.Applicative+#endif  main = hspec spec @@ -31,54 +40,85 @@ notNullValue :: Either String (Maybe Int) notNullValue = Right (Just 1) +data Body = Body+  { name :: String+  , age  :: Int+  } deriving (Eq, Show)++instance HasValid Parser where+  invalid = fail . toI18n++instance FromJSON Body where+  parseJSON = withObject "Body" $ \v -> Body+    <$> v .: "name" ? pattern "^[a-z]{3,6}$"+    <*> v .: "age"  ? minInt 1 . maxInt 150++valifyBody :: Validator Body+valifyBody = \ma -> do+  Body{..} <- ma+  Body+    <$> name ?: pattern "^[a-z]{3,6}$"+    <*> age  ?: minInt 1 . maxInt 150++makeBody :: String -> Int -> Either String Body+makeBody name age = Body{..} ?: valifyBody+ specProperty = do   context "bool" $ do     it "true" $ do-      (true  & assertTrue)  `shouldBe`      true-      (true  & assertFalse) `shouldSatisfy` isLeft+      (true  ? assertTrue)  `shouldBe`      true+      (true  ? assertFalse) `shouldSatisfy` isLeft     it "false" $ do-      (false & assertFalse) `shouldBe`      false-      (false & assertTrue)  `shouldSatisfy` isLeft+      (false ? assertFalse) `shouldBe`      false+      (false ? assertTrue)  `shouldSatisfy` isLeft   context "int" $ do     it "minInt" $ do-      (intValue & minInt 10) `shouldBe`      intValue-      (intValue & minInt 11) `shouldSatisfy` isLeft+      (intValue ? minInt 10) `shouldBe`      intValue+      (intValue ? minInt 11) `shouldSatisfy` isLeft     it "maxInt" $ do-      (intValue & maxInt 10) `shouldBe`      intValue-      (intValue & maxInt  9) `shouldSatisfy` isLeft+      (intValue ? maxInt 10) `shouldBe`      intValue+      (intValue ? maxInt  9) `shouldSatisfy` isLeft     it "positive" $ do-      (intValue & positive)       `shouldBe`      intValue-      (intValue & positiveOrZero) `shouldBe`      intValue-      (intValue & negative)       `shouldSatisfy` isLeft-      (intValue & negativeOrZero) `shouldSatisfy` isLeft+      (intValue ? positive)       `shouldBe`      intValue+      (intValue ? positiveOrZero) `shouldBe`      intValue+      (intValue ? negative)       `shouldSatisfy` isLeft+      (intValue ? negativeOrZero) `shouldSatisfy` isLeft     it "randomWord" $ property $ \a ->       let b = Right a :: Either String Word8-      in (b & minInt 0 & maxInt 255 & positiveOrZero) == b+      in (b ? minInt 0 ? maxInt 255 ? positiveOrZero) == b     it "randomInt-negative" $ property $ \a ->       let b = Right (negate $ abs a) :: Either String Int8-      in (b & minInt (-128) & maxInt 0 & negativeOrZero) == b+      in (b ? minInt (-128) ? maxInt 0 ? negativeOrZero) == b     it "randomInt-positive" $ property $ \a ->         let b = Right (if a == -128 then 0 else abs a) :: Either String Int8-        in (b & minInt 0 & maxInt 127 & positiveOrZero) == b+        in (b ? minInt 0 ? maxInt 127 ? positiveOrZero) == b   context "string" $ do     it "size" $ do-      (strValue & size (0,10))  `shouldBe`      strValue-      (strValue & size (10,0))  `shouldSatisfy` isLeft-      (strValue & size (10,30)) `shouldSatisfy` isLeft+      (strValue ? size (0,10))  `shouldBe`      strValue+      (strValue ? size (10,0))  `shouldSatisfy` isLeft+      (strValue ? size (10,30)) `shouldSatisfy` isLeft     it "pattern" $ do-      (strValue & pattern "^xx$") `shouldSatisfy` isLeft-      (strValue & pattern "xx")   `shouldBe`      strValue-      (strValue & email)          `shouldBe`      strValue+      (strValue ? pattern "^xx$") `shouldSatisfy` isLeft+      (strValue ? pattern "xx")   `shouldBe`      strValue+      (strValue ? email)          `shouldBe`      strValue     it "notBlank" $ do-      (strValue & notBlank)       `shouldBe`      strValue-      (strValue & notEmpty)       `shouldBe`      strValue+      (strValue ? notBlank)       `shouldBe`      strValue+      (strValue ? notEmpty)       `shouldBe`      strValue   context "null" $ do     it "null" $ do-      (nullValue & assertNull)    `shouldBe`      nullValue-      (nullValue & notNull)       `shouldSatisfy` isLeft+      (nullValue ? assertNull)    `shouldBe`      nullValue+      (nullValue ? notNull)       `shouldSatisfy` isLeft     it "notNull" $ do-      (notNullValue & notNull)    `shouldBe`      notNullValue-      (notNullValue & assertNull) `shouldSatisfy` isLeft+      (notNullValue ? notNull)    `shouldBe`      notNullValue+      (notNullValue ? assertNull) `shouldSatisfy` isLeft+  context "valify" $ do+    it "makeBody" $ do+      makeBody "daniel"  5   `shouldSatisfy` isRight+      makeBody "daniel"  200 `shouldSatisfy` isLeft+      makeBody "danielx" 5   `shouldSatisfy` isLeft+    it "makeJsonBody" $ do+      (decode "{\"name\":\"daniel\",\"age\":15}" :: Maybe Body) `shouldSatisfy` isJust+      (decode "{\"name\":\"daniel\",\"age\":-1}" :: Maybe Body) `shouldBe` Nothing