digestive-functors 0.7.0.0 → 0.7.1.0
raw patch · 6 files changed
+189/−2 lines, 6 filesdep ~text
Dependency ranges changed: text
Files
- CHANGELOG +5/−0
- digestive-functors.cabal +5/−2
- src/Text/Digestive/Form.hs +94/−0
- src/Text/Digestive/Form/Internal.hs +12/−0
- tests/Text/Digestive/Tests/Fixtures.hs +53/−0
- tests/Text/Digestive/View/Tests.hs +20/−0
+ CHANGELOG view
@@ -0,0 +1,5 @@+- 0.7.1.0+ * Add `validateOptional` function+ * Add `condition` functions to allow composing multiple independent+ validation functions+ * Bump `text` dependency to allow `text-1.1`
digestive-functors.cabal view
@@ -1,5 +1,5 @@ Name: digestive-functors-Version: 0.7.0.0+Version: 0.7.1.0 Synopsis: A practical formlet library Description:@@ -41,6 +41,9 @@ Build-type: Simple Cabal-version: >= 1.8 +Extra-source-files:+ CHANGELOG+ Library Hs-source-dirs: src Ghc-options: -Wall -fwarn-tabs@@ -63,7 +66,7 @@ containers >= 0.3 && < 0.6, mtl >= 1.1.0.0 && < 3, old-locale >= 1.0 && < 1.1,- text >= 0.10 && < 1.1,+ text >= 0.10 && < 1.2, time >= 1.4 && < 1.5 Test-suite digestive-functors-tests
src/Text/Digestive/Form.hs view
@@ -46,7 +46,9 @@ , check , checkM , validate+ , validateOptional , validateM+ , conditions , disable -- * Lifting forms@@ -234,11 +236,103 @@ validate :: Monad m => (a -> Result v b) -> Form v m a -> Form v m b validate = validateM . (return .) +--------------------------------------------------------------------------------+-- | Same as 'validate', but works with forms of the form:+--+-- > Form v m (Maybe a)+-- +-- .+--+-- Example: taking the first character of an optional input string+--+-- > head' :: String -> Result String Char+-- > head' [] = Error "Is empty"+-- > head' (x : _) = Success x+-- >+-- > char :: Monad m => Form m String (Maybe Char)+-- > char = validateOptional head' (optionalString Nothing)+validateOptional :: Monad m => (a -> Result v b) -> Form v m (Maybe a) -> Form v m (Maybe b)+validateOptional f = validate (forOptional f) -------------------------------------------------------------------------------- -- | Version of 'validate' which allows monadic validations validateM :: Monad m => (a -> m (Result v b)) -> Form v m a -> Form v m b validateM = transform++--------------------------------------------------------------------------------+-- | Allows for the composition of independent validation functions.+--+-- For example, let's validate an even integer between 0 and 100:+-- +-- > form :: Monad m => Form Text m FormData+-- > ... -- some fields+-- > <*> "smallEvenInteger" .: validate (notEmpty >=> integer >=> even >=> greaterThan 0 >=> lessThanOrEq 100) (text Nothing)+-- > ... -- more fields+--+-- where+--+-- > notEmpty :: IsString v => Text -> Result v Text+-- > integer :: (Integral a, IsString v) => Text -> Result v a+-- > greaterThan 0 :: (Num a, Ord a, Show a) => a -> Result Text a+-- > lessThanOrEq 0 :: (Num a, Ord a, Show a) => a -> Result Text a+-- > even :: Integer -> Result Text Integer+--+-- .+--+-- This will validate our smallEvenInteger correctly, but there is a problem. +-- If a user enters an odd number greater than 100, only+--+-- > "number must be even"+--+--+-- will be returned. It would make for a better user experience if +--+-- > ["number must be even", "number must be less than 100"]+--+-- was returned instead. This can be accomplished by rewriting our form to be: +--+-- > form :: Monad m => Form [Text] m FormData+-- > ... -- some fields+-- > <*> "smallEvenInteger" .: validate (notEmpty >=> integer >=> conditions [even, greaterThan 0, lessThanOrEq 100]) (text Nothing)+-- > ... -- more fields+--+-- .+--+-- If we want to collapse our list of errors into a single 'Text', we can do something like:+-- +-- > form :: Monad m => Form Text m FormData+-- > ... -- some fields+-- > <*> "smallEvenInteger" .: validate (notEmpty >=> integer >=> commaSeperated . conditions [even, greaterThan 0, lessThanOrEq 100]) (text Nothing)+-- > ... -- more fields+--+-- where+--+-- > commaSeperated :: (Result [Text] a) -> (Result Text a)+--+-- .+conditions :: [(a -> Result e b)] -- ^ Any 'Success' result of a validation function is provably guaranteed to be discarded. Only 'Error' results are used.+ -> a -- ^ If all validation functions pass, parameter will be re-wrapped with a 'Success'.+ -> (Result [e] a) -- ^ List of errors is guaranteed to be in the same order as inputed validations functions. So,+ --+ -- > conditions [even, greaterThan 0] -1+ --+ -- is specified to return + --+ -- > Error ["must be even", "must be greater than 0"]+ --+ -- and not+ --+ -- > Error ["must be greater than 0", "must be even"]+ --+ -- .+conditions fs x = result+ where+ result = case (foldr errorCond [] fs) of+ [] -> Success x+ es -> Error es+ errorCond f es = case (f x) of+ Success _ -> es+ Error e -> e:es --------------------------------------------------------------------------------
src/Text/Digestive/Form/Internal.hs view
@@ -25,6 +25,7 @@ , queryField , eval , formMapView+ , forOptional -- * Debugging , debugFormPaths@@ -381,6 +382,17 @@ formMapView f (List d is) = List (fmap (formMapView f) d) (formMapView f is) formMapView f (Metadata m x) = Metadata m $ formMapView f x ++--------------------------------------------------------------------------------+-- | Combinator that lifts input and output of valiation function used by 'validate'+-- to from (a -> Result v b) to (Maybe a -> Result v (Maybe b)).+forOptional :: (a -> Result v b) -> Maybe a -> Result v (Maybe b)+forOptional f x = case (x) of+ Nothing -> Success Nothing+ Just x' -> case (f x') of+ Success x'' -> Success (Just x'')+ Error x'' -> Error x''+ -------------------------------------------------------------------------------- -- | Utility: bind for 'Result' inside another monad
tests/Text/Digestive/Tests/Fixtures.hs view
@@ -7,6 +7,10 @@ , Type (..) , Pokemon (..) , pokemonForm+ , ValidateOptionalData (..)+ , validateOptionalForm+ , IndependentValidationsData (..)+ , independentValidationsForm , Ball (..) , ballForm , Catch (..)@@ -31,9 +35,11 @@ -------------------------------------------------------------------------------- import Control.Applicative ((<$>), (<*>))+import Control.Monad ((>=>)) import Control.Monad.Reader (Reader, ask, runReader) import Data.Text (Text) import qualified Data.Text as T+import qualified Text.Read as TR --------------------------------------------------------------------------------@@ -111,6 +117,53 @@ ballForm = choice [(Poke, "Poke"), (Great, "Great"), (Ultra, "Ultra"), (Master, "Master")] Nothing+++--------------------------------------------------------------------------------+data ValidateOptionalData = ValidateOptionalData+ { firstValidateOptionalField :: Maybe Integer+ } deriving (Eq, Show)+++--------------------------------------------------------------------------------+validateOptionalForm :: Monad m => Form Text m ValidateOptionalData+validateOptionalForm = ValidateOptionalData+ <$> "first_field" .: validateOptional (integer >=> even >=> greaterThan 0) (optionalString Nothing)+ where+ integer s = case (TR.readEither s) of+ Right n -> Success n+ Left _ -> Error "not an integer"+ even n + | n `mod` 2 == 0 = Success n+ | otherwise = Error "input must be even"+ greaterThan x n+ | n > x = Success n+ | otherwise = Error "input is too small"+++--------------------------------------------------------------------------------+data IndependentValidationsData = IndependentValidationsData+ { firstIndependentValidationField :: Integer+ } deriving (Eq, Show)+++--------------------------------------------------------------------------------+independentValidationsForm :: Monad m => Form [Text] m IndependentValidationsData+independentValidationsForm = IndependentValidationsData+ <$> "first_field" .: validate (notEmpty >=> integer >=> conditions [even, greaterThan 10]) (string Nothing)+ where + notEmpty x = if (null x)+ then Error ["is empty"]+ else Success x+ integer s = case (TR.readEither s) of+ Right n -> Success n+ Left _ -> Error ["not an integer"]+ even n + | n `mod` 2 == 0 = Success n+ | otherwise = Error "input must be even"+ greaterThan x n+ | n > x = Success n+ | otherwise = Error "input is too small" --------------------------------------------------------------------------------
tests/Text/Digestive/View/Tests.hs view
@@ -52,6 +52,26 @@ snd $ runIdentity $ postForm "f" floatForm $ testEnv [("f.f", "4.323")] + , testCase "validateOptional validated successfully" $ (@=?)+ (Just (ValidateOptionalData (Just 8))) $+ snd $ runIdentity $ postForm "f" validateOptionalForm $ testEnv+ [("f.first_field", "8")]++ , testCase "validateOptional allows nothing" $ (@=?)+ (Just (ValidateOptionalData Nothing)) $+ snd $ runIdentity $ postForm "f" validateOptionalForm $ testEnv+ [("f.first_field", "")]++ , testCase "validateOptional fails for invalid data" $ (@=?)+ ["input must be even"] $+ childErrors "" $ fst $ runIdentity $ postForm "f" validateOptionalForm $ testEnv+ [("f.first_field", "9")]++ , testCase "conditions allows for multiple independent failing validations" $ (@=?)+ [["input must be even", "input is too small"]] $+ childErrors "" $ fst $ runIdentity $ postForm "f" independentValidationsForm $ testEnv+ [("f.first_field", "9")]+ , testCase "Failing checkM" $ (@=?) ["This pokemon will not obey you!"] $ childErrors "" $ fst $ runTrainerM $ postForm "f" pokemonForm $ testEnv