digestive-functors-aeson 1.0.1 → 1.0.2

raw patch · 5 files changed

+115/−19 lines, 5 filesdep +HUnitdep +digestive-functors-aesondep +mtldep ~aesondep ~aeson-lensdep ~digestive-functorssetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, digestive-functors-aeson, mtl, test-framework, test-framework-hunit

Dependency ranges changed: aeson, aeson-lens, digestive-functors

API changes (from Hackage documentation)

Files

• Setup.hs +2/−0
• Setup.lhs +0/−7
• digestive-functors-aeson.cabal +20/−3
• src/Text/Digestive/Aeson.hs +37/−9
• test/Tests.hs +56/−0

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -1,7 +0,0 @@-#!/usr/bin/runhaskell-> module Main (main) where--> import Distribution.Simple--> main :: IO ()-> main = defaultMain

@@ -1,6 +1,6 @@ name: digestive-functors-aeson category: Web, JSON-version: 1.0.1+version: 1.0.2 license: GPL-3 license-file: LICENSE author: Oliver Charles@@ -14,6 +14,8 @@ description:   This package allows you to run a form created by digestive functors against a   JSON document that has been parsed by Aeson.+  .+  For changes, please see http://github.com/ocharles/changelog.md  source-repository head   type: git@@ -25,12 +27,27 @@     Text.Digestive.Aeson   build-depends:     aeson >= 0.6,-    aeson-lens >= 0.4.0.1,+    aeson-lens >= 0.4.1.0,     base >= 4.5 && < 4.7,-    digestive-functors >= 0.5,+    digestive-functors >= 0.5 && < 0.6,     lens >= 3.0,     safe >= 0.3.3,     text >= 0.11   hs-source-dirs: src   ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2                -fno-warn-orphans -fno-warn-unused-do-bind++test-suite tests+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Tests.hs+  build-depends:+    aeson,+    base >= 4.5 && < 4.7,+    digestive-functors >= 0.5,+    digestive-functors-aeson ==1.0.2,+    HUnit >= 1.2,+    mtl,+    test-framework >= 0.6,+    test-framework-hunit,+    text >= 0.11

@@ -2,13 +2,16 @@ {-# LANGUAGE OverloadedStrings #-} -- | Run digestive-functors forms against JSON. module Text.Digestive.Aeson-    ( digestJSON ) where+    ( digestJSON+    , jsonErrors+    ) where -import Control.Lens-import Data.Aeson (Value(..))-import Data.Aeson.Lens-import Safe-import Text.Digestive+import           Control.Lens+import           Data.Aeson (ToJSON(toJSON), Value(..), object)+import           Data.Aeson.Lens+import           Data.Maybe (fromMaybe)+import           Safe+import           Text.Digestive  import qualified Data.Text as T @@ -39,9 +42,6 @@         jsonEnv v p = return . maybe [] jsonToText $           Just v ^. pathToLens (filter (not . T.null) p) -        pathToLens = foldl (.) id . map pathElem-        pathElem p = maybe (key p) nth (readMay $ T.unpack p)-         jsonToText (String s) = [TextInput s]         jsonToText (Bool b)   = showPack b         jsonToText (Number n) = showPack n@@ -50,3 +50,31 @@         jsonToText (Array _)  = []          showPack = return . TextInput . T.pack . show+++--------------------------------------------------------------------------------+{-| Takes a 'View' and displays any errors in a hierachical format that matches+the expected input.++Example:++>     > jsonErrors myForm+>     {"person":{"name":"This field is required"}}+-}+jsonErrors :: ToJSON a => View a -> Value+jsonErrors = fromMaybe (error "Constructing error tree failed!") .+    foldl encodeError (Just $ object []) . viewErrors+  where+    encodeError json (path, message) =+      json & pathToLens path .~ Just (toJSON message)+++--------------------------------------------------------------------------------+pathToLens :: Functor f+           => [T.Text]+           -> (Maybe Value -> f (Maybe Value))+           -> Maybe Value+           -> f (Maybe Value)+pathToLens = foldl (.) id . map pathElem+  where+    pathElem p = maybe (key p) nth (readMay $ T.unpack p)

@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import           Control.Applicative+import           Control.Monad.Identity (runIdentity)+import           Data.Aeson (decode)+import           Data.Text+import           Test.Framework (Test, defaultMain, testGroup)+import           Test.Framework.Providers.HUnit (testCase)+import           Test.HUnit ((@?=))+import           Text.Digestive (Form, (.:), check, text)+import           Text.Digestive.Aeson (digestJSON, jsonErrors)++import qualified Data.Text as T++--------------------------------------------------------------------------------+tests :: [Test]+tests = [ testPokemon+        ]+++--------------------------------------------------------------------------------+data Pokemon = Pokemon { pokemonName :: Text }+  deriving (Eq, Show)+++testPokemon :: Test+testPokemon = testGroup "Pokemon tests" [ testPokemonOk, testPokemonInvalid ]+  where+    pokeForm :: Monad m => Form Text m Pokemon+    pokeForm = Pokemon <$> "name" .: nonEmptyText+      where+        nonEmptyText = check "Name cannot be empty" (not . T.null) $+                         text Nothing++    testPokemonOk = testCase "Submit pokeForm with valid data" $+        Just expected @?= (runIdentity $ snd <$> digestJSON pokeForm json)+      where+        (Just json) = decode "{\"name\":\"Pikachu\"}"+        expected = Pokemon { pokemonName = "Pikachu" }++    testPokemonInvalid =+        let (v, r) = runIdentity $ digestJSON pokeForm json+        in testGroup "Submit pokeForm with invalid data/check error view"+             [ testCase "Failed validation" $ r @?= Nothing+             , testCase "jsonErrors shows correct errors" $ jsonErrors v @?= errors+             ]+      where+        (Just json) = decode "{\"name\":\"\"}"+        (Just errors) = decode "{\"name\":\"Name cannot be empty\"}"+        expected = Pokemon { pokemonName = "Pikachu" }+++--------------------------------------------------------------------------------+main :: IO ()+main = defaultMain tests