digestive-functors-aeson 1.1.6 → 1.1.7
raw patch · 3 files changed
+53/−21 lines, 3 filesdep +scientific
Dependencies added: scientific
Files
- digestive-functors-aeson.cabal +2/−1
- src/Text/Digestive/Aeson.hs +7/−6
- test/Tests.hs +44/−14
digestive-functors-aeson.cabal view
@@ -1,6 +1,6 @@ name: digestive-functors-aeson category: Web, JSON-version: 1.1.6+version: 1.1.7 license: GPL-3 license-file: LICENSE author: Oliver Charles@@ -51,6 +51,7 @@ digestive-functors >= 0.6, HUnit >= 1.2, mtl,+ scientific >= 0.2.0.1, tasty >= 0.1, tasty-hunit >= 0.1, text >= 0.11
src/Text/Digestive/Aeson.hs view
@@ -52,12 +52,13 @@ _ -> return [ TextInput "" ] | otherwise = return . maybe [] jsonToText $ join (Just v ^? pathToLens p) - jsonToText (String s) = [TextInput s]- jsonToText (Bool b) = showPack b- jsonToText (Number n) = showPack n- jsonToText Null = []- jsonToText (Object _) = []- jsonToText (Array _) = []+ jsonToText (String s) = [TextInput s]+ jsonToText (Bool True) = [TextInput "on"]+ jsonToText (Bool False) = [TextInput "off"]+ jsonToText (Number n) = showPack n+ jsonToText Null = []+ jsonToText (Object _) = []+ jsonToText (Array _) = [] showPack = return . TextInput . T.pack . show
test/Tests.hs view
@@ -2,25 +2,28 @@ module Main where import Control.Applicative-import Control.Monad.Identity (runIdentity)+import Control.Monad.Identity (Identity, runIdentity) import Data.Aeson (decode) import Data.ByteString.Lazy.Char8 ()+import Data.Ratio (denominator, numerator)+import Data.Scientific (Scientific) import Data.Text (Text) import Test.HUnit ((@?=))-import Text.Digestive (Form, (.:), check, text, listOf)-import Text.Digestive.Aeson (digestJSON, jsonErrors) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (testCase)+import Text.Digestive (Form, (.:), Result(..), bool, check, text, listOf, stringRead, validate)+import Text.Digestive.Aeson (digestJSON, jsonErrors) import qualified Data.Text as T ---------------------------------------------------------------------------------data Pokemon = Pokemon { pokemonName :: Text }+data Pokemon = Pokemon { pokemonName :: Text, pokemonNumber :: Int } deriving (Eq, Show) pokeForm :: Monad m => Form Text m Pokemon pokeForm = Pokemon <$> "name" .: nonEmptyText+ <*> "number" .: parseInteger where nonEmptyText = check "Name cannot be empty" (not . T.null) $ text Nothing@@ -37,8 +40,8 @@ testPokemonOk = testCase "Submit pokeForm with valid data" $ (runIdentity $ snd <$> digestJSON pokeForm json) @?= Just expected where- (Just json) = decode "{\"name\":\"Pikachu\"}"- expected = Pokemon { pokemonName = "Pikachu" }+ (Just json) = decode "{\"name\":\"Pikachu\", \"number\":\"25\"}"+ expected = Pokemon { pokemonName = "Pikachu", pokemonNumber = 25 } testPokemonInvalid = let (v, r) = runIdentity $ digestJSON pokeForm json@@ -47,9 +50,9 @@ , testCase "jsonErrors shows correct errors" $ jsonErrors v @?= errors ] where- (Just json) = decode "{\"name\":\"\"}"+ (Just json) = decode "{\"name\":\"\", \"number\":\"25\"}" (Just errors) = decode "{\"name\":\"Name cannot be empty\"}"- expected = Pokemon { pokemonName = "Pikachu" }+ expected = Pokemon { pokemonName = "Pikachu", pokemonNumber = 25 } --------------------------------------------------------------------------------@@ -67,16 +70,20 @@ testPokedexSingle = testCase "Valid pokedex with one pokemon" $ (runIdentity $ snd <$> digestJSON pokedexForm json) @?= Just expected where- (Just json) = decode "{\"pokemon\":[{\"name\": \"Pikachu\"}]}"- expected = Pokedex [Pokemon { pokemonName = "Pikachu" }]+ (Just json) = decode "{\"pokemon\":[{\"name\": \"Pikachu\",\"number\":25}]}"+ expected = Pokedex [Pokemon { pokemonName = "Pikachu", pokemonNumber = 25 }] testPokedexMany = testCase "Valid pokedex with many pokemon" $ (runIdentity $ snd <$> digestJSON pokedexForm json) @?= Just expected where- (Just json) = decode "{\"pokemon\":[{\"name\": \"Pikachu\"}, {\"name\":\"Clefable\"}, {\"name\":\"Gengar\"}]}"- expected = Pokedex [ Pokemon { pokemonName = "Pikachu" }- , Pokemon { pokemonName = "Clefable" }- , Pokemon { pokemonName = "Gengar" }+ (Just json) = decode "{\"pokemon\":[\+ \ {\"name\": \"Pikachu\", \"number\": 25},\+ \ {\"name\":\"Clefable\", \"number\": 36},\+ \ {\"name\":\"Gengar\", \"number\": 94}\+ \]}"+ expected = Pokedex [ Pokemon { pokemonName = "Pikachu", pokemonNumber = 25 }+ , Pokemon { pokemonName = "Clefable", pokemonNumber = 36 }+ , Pokemon { pokemonName = "Gengar", pokemonNumber = 94 } ] testPokedexFailHead =@@ -109,9 +116,32 @@ --------------------------------------------------------------------------------+testBool :: TestTree+testBool = testCase "Booleans work" $ do+ let (Just json) = decode "{\"a\": true, \"b\": false}"+ parser :: Form () Identity (Bool, Bool)+ parser = (,) <$> "a" .: bool Nothing <*> "b" .: bool (Just True)+ (runIdentity $ snd <$> digestJSON parser json)+ @?= Just (True, False)+++-------------------------------------------------------------------------------- main :: IO () main = defaultMain $ testGroup "Tests" [ testPokemon , testPokedex , testTopLevelLists+ , testBool ] +--------------------------------------------------------------------------------+validateInteger :: Num a => Scientific -> Result Text a+validateInteger x =+ let xRat = toRational x+ in if denominator xRat /= 1+ then Error "Number must be an integer"+ else return (fromInteger $ numerator xRat)++--------------------------------------------------------------------------------+parseInteger :: (Monad m, Num a) => Form Text m a+parseInteger =+ validate validateInteger (stringRead "Could not parse number" Nothing)