menshen (empty) → 0.0.0
raw patch · 6 files changed
+443/−0 lines, 6 filesdep +QuickCheckdep +basedep +hspecsetup-changed
Dependencies added: QuickCheck, base, hspec, menshen, regex-tdfa, scientific, text
Files
- LICENSE +30/−0
- README.md +32/−0
- Setup.hs +2/−0
- menshen.cabal +55/−0
- src/Data/Menshen.hs +240/−0
- test/Spec.hs +84/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Daniel YU (c) 2019++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 of Daniel YU nor the names of other+ 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 AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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.
+ README.md view
@@ -0,0 +1,32 @@+# menshen++[](https://hackage.haskell.org/package/menshen)+[](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"+++```+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ menshen.cabal view
@@ -0,0 +1,55 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: 06c81eb80414f486ca7ea81d1eae4d2fb856614b4503aa07890f9404e9dda98a++name: menshen+version: 0.0.0+synopsis: Data Validation+description: Data Validation inspired by JSR305+category: Web+homepage: https://github.com/leptonyu/menshen#readme+author: Daniel YU+maintainer: leptonyu@gmail.com+copyright: (c) Daniel YU+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md++library+ exposed-modules:+ Data.Menshen+ other-modules:+ Paths_menshen+ hs-source-dirs:+ src+ ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures+ build-depends:+ base >=4.7 && <5+ , regex-tdfa >=1.2.3.1 && <1.3+ , scientific >=0.3.6.2 && <0.4+ , text >=1.2.3.1 && <1.3+ default-language: Haskell2010++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_menshen+ hs-source-dirs:+ test+ ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures+ build-depends:+ QuickCheck+ , base >=4.7 && <5+ , hspec ==2.*+ , menshen+ , regex-tdfa >=1.2.3.1 && <1.3+ , scientific >=0.3.6.2 && <0.4+ , text >=1.2.3.1 && <1.3+ default-language: Haskell2010
+ src/Data/Menshen.hs view
@@ -0,0 +1,240 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Data.Menshen(+ HasValid(..)+ , Validator+ , HasValidSize+ , size+ , notEmpty+ , notBlank+ , notNull+ , assertNull+ , assertTrue+ , assertFalse+ , positive+ , positiveOrZero+ , negative+ , negativeOrZero+ , minInt+ , maxInt+ , minDecimal+ , maxDecimal+ , pattern+ , email+ , (&)+ , (=~)+ , ValidationException(..)+ , HasI18n(..)+ ) where++import Data.Scientific+import qualified Data.Text as TS+import qualified Data.Text.Lazy as TL+import Data.Word+import Text.Regex.TDFA+#if __GLASGOW_HASKELL__ > 708+import Data.Function ((&))+#else+infixl 1 &+(&) :: a -> (a -> b) -> b+x & f = f x+#endif+++class HasI18n a where+ toI18n :: a -> String++data ValidationException+ = ShouldBeFalse+ | ShouldBeTrue+ | ShouldNull+ | ShouldNotNull+ | InvalidSize Word64 Word64+ | InvalidPositive+ | InvalidPositiveOrZero+ | InvalidNegative+ | InvalidNegativeOrZero+ | InvalidMax Integer+ | InvalidMin Integer+ | InvalidEmail+ | InvalidNotBlank+ | InvalidNotEmpty+ | InvalidPast+ | InvalidFuture+ | InvalidPastOrPresent+ | InvalidFutureOrPresent+ | InvalidDecimalMax Scientific+ | InvalidDecimalMin Scientific+ | InvalidDigits Word8 Word8+ | InvalidPattern String+ deriving Show++instance HasI18n ValidationException where+ toI18n ShouldBeTrue = "must be true"+ toI18n ShouldBeFalse = "must be false"+ toI18n ShouldNull = "must be null"+ toI18n ShouldNotNull = "must not be null"+ toI18n (InvalidSize a b) = "size must be between " ++ show a ++ " and " ++ show b+ toI18n InvalidPositive = "must be greater than 0"+ toI18n InvalidPositiveOrZero = "must be greater than or equal to 0"+ toI18n InvalidNegative = "must be less than 0"+ toI18n InvalidNegativeOrZero = "must be less than or equal to 0"+ toI18n InvalidEmail = "must be a well-formed email address"+ toI18n InvalidNotBlank = "must not be blank"+ toI18n InvalidNotEmpty = "must not be empty"+ toI18n InvalidPast = "must be a past date"+ toI18n InvalidFuture = "must be a future date"+ toI18n InvalidPastOrPresent = "must be a date in the past or in the present"+ toI18n InvalidFutureOrPresent = "must be a date in the present or in the future"+ toI18n (InvalidMax n) = "must be less than or equal to " ++ show n+ toI18n (InvalidMin n) = "must be greater than or equal to " ++ show n+ toI18n (InvalidDecimalMax d) = "must be less than " ++ show d+ toI18n (InvalidDecimalMin d) = "must be greater than " ++ show d+ toI18n (InvalidDigits i f) = "numeric value out of bounds (<" ++ show i ++ " digits>.<" ++ show f ++ " digits> expected)"+ toI18n (InvalidPattern r) = "must match " ++ r++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++type Validator a = forall m. HasValid m => m a -> m a++class HasValidSize a where+ size :: (Word64, Word64) -> Validator a+ size (x,y) = \ma -> do+ a <- ma+ let la = getLength a+ if la < x || la > y+ then invalid $ InvalidSize x y+ else return a+ notEmpty :: Validator a+ notEmpty = \ma -> do+ a <- ma+ if getLength a == 0+ then invalid InvalidNotEmpty+ else return a+ notBlank :: Validator a+ notBlank = \ma -> do+ a <- ma+ if getLength a == 0+ then invalid InvalidNotBlank+ else return a+ getLength :: a -> Word64+ {-# MINIMAL getLength #-}++instance HasValidSize TS.Text where+ getLength = fromIntegral . TS.length++instance HasValidSize TL.Text where+ getLength = fromIntegral . TL.length++instance HasValidSize [a] where+ getLength = fromIntegral . length++pattern :: RegexLike Regex a => String -> Validator a+pattern p = \ma -> do+ a <- ma+ if a =~ p then return a+ else invalid $ InvalidPattern p++emailPattern :: String+emailPattern = "^[A-Z0-9a-z._%+-]+@[A-Za-z0-9.-]+\\.[A-Za-z]{2,64}$"++email :: RegexLike Regex a => Validator a+email = \ma -> do+ a <- ma+ if a =~ emailPattern then return a+ else invalid InvalidEmail++positive :: (Eq a, Num a) => Validator a+positive = \ma -> do+ a <- ma+ if a /= 0 && abs a - a == 0+ then return a+ else invalid InvalidPositive++positiveOrZero :: (Eq a, Num a) => Validator a+positiveOrZero = \ma -> do+ a <- ma+ if abs a - a == 0+ then return a+ else invalid InvalidPositiveOrZero++negative :: (Eq a, Num a) => Validator a+negative = \ma -> do+ a <- ma+ if a /= 0 && abs a + a == 0+ then return a+ else invalid InvalidNegative++negativeOrZero :: (Eq a, Num a) => Validator a+negativeOrZero = \ma -> do+ a <- ma+ if abs a + a == 0+ then return a+ else invalid InvalidNegativeOrZero++assertTrue :: Validator Bool+assertTrue = \ma -> do+ a <- ma+ if a then return a+ else invalid ShouldBeTrue++assertFalse :: Validator Bool+assertFalse = \ma -> do+ a <- ma+ if not a then return a+ else invalid ShouldBeFalse++notNull :: Validator (Maybe a)+notNull = \ma -> do+ a <- ma+ case a of+ Just _ -> return a+ _ -> invalid ShouldNotNull++assertNull :: Validator (Maybe a)+assertNull = \ma -> do+ a <- ma+ case a of+ Just _ -> invalid ShouldNull+ _ -> return a++maxInt :: (Ord a, 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+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+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+minDecimal m = \ma -> do+ a <- ma+ if a < m+ then invalid (InvalidDecimalMin $ fromFloatDigits m)+ else return a
+ test/Spec.hs view
@@ -0,0 +1,84 @@+module Main where++import Data.Either+import Data.Int+import Data.Menshen+import Data.Word+import Test.Hspec+import Test.QuickCheck++main = hspec spec++spec :: Spec+spec = do+ describe "Data.Menshen" specProperty++intValue :: Either String Int+intValue = Right 10++strValue :: Either String String+strValue = Right "x@xxx.xx"++true :: Either String Bool+true = Right True++false :: Either String Bool+false = Right False++nullValue :: Either String (Maybe Int)+nullValue = Right Nothing++notNullValue :: Either String (Maybe Int)+notNullValue = Right (Just 1)++specProperty = do+ context "bool" $ do+ it "true" $ do+ (true & assertTrue) `shouldBe` true+ (true & assertFalse) `shouldSatisfy` isLeft+ it "false" $ do+ (false & assertFalse) `shouldBe` false+ (false & assertTrue) `shouldSatisfy` isLeft+ context "int" $ do+ it "minInt" $ do+ (intValue & minInt 10) `shouldBe` intValue+ (intValue & minInt 11) `shouldSatisfy` isLeft+ it "maxInt" $ do+ (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+ it "randomWord" $ property $ \a ->+ let b = Right a :: Either String Word8+ 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+ 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+ context "string" $ do+ it "size" $ do+ (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+ it "notBlank" $ do+ (strValue & notBlank) `shouldBe` strValue+ (strValue & notEmpty) `shouldBe` strValue+ context "null" $ do+ it "null" $ do+ (nullValue & assertNull) `shouldBe` nullValue+ (nullValue & notNull) `shouldSatisfy` isLeft+ it "notNull" $ do+ (notNullValue & notNull) `shouldBe` notNullValue+ (notNullValue & assertNull) `shouldSatisfy` isLeft+++