digestive-functors-aeson 1.1.3 → 1.1.4
raw patch · 2 files changed
+31/−23 lines, 2 filesdep +containersdep +lens-aesondep −aeson-lensdep ~digestive-functors
Dependencies added: containers, lens-aeson
Dependencies removed: aeson-lens
Dependency ranges changed: digestive-functors
Files
digestive-functors-aeson.cabal view
@@ -1,6 +1,6 @@ name: digestive-functors-aeson category: Web, JSON-version: 1.1.3+version: 1.1.4 license: GPL-3 license-file: LICENSE author: Oliver Charles@@ -20,17 +20,18 @@ source-repository head type: git location: git://github.com/ocharles/digestive-functors-aeson.git- tag: v1.0.0+ tag: v1.1.4 library exposed-modules: Text.Digestive.Aeson build-depends: aeson >= 0.6,- aeson-lens >= 0.5.0.0, base >= 4.5 && < 4.7,- digestive-functors >= 0.6,+ containers >= 0.5,+ digestive-functors >= 0.7 && < 0.8, lens >= 3.0,+ lens-aeson >= 0.1.2, safe >= 0.3.3, text >= 0.11, vector >= 0.10
src/Text/Digestive/Aeson.hs view
@@ -1,19 +1,23 @@ {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} -- | Run digestive-functors forms against JSON. module Text.Digestive.Aeson ( digestJSON , jsonErrors ) where -import Control.Lens-import Data.Aeson (ToJSON(toJSON), Value(..), object)-import Data.Aeson.Lens-import Data.Maybe (fromMaybe)-import Safe-import Text.Digestive-import Text.Digestive.Form.List (unparseIndices)+import Control.Lens+import Control.Lens.Aeson+import Control.Monad (join)+import Data.Aeson (ToJSON(toJSON), Value(..), object)+import Data.Maybe (fromMaybe)+import Data.Monoid (mempty)+import Safe (readMay)+import Text.Digestive+import Text.Digestive.Form.List (unparseIndices) +import qualified Data.IntMap.Strict as IntMap import qualified Data.Text as T import qualified Data.Vector as V @@ -39,14 +43,14 @@ -- only part of this document, you need to transform this value -- first. You may find the @aeson-lens@ package useful for this. -> m (View v, Maybe a)-digestJSON f json = postForm "" f (jsonEnv json)+digestJSON f json = postForm "" f (const (return (jsonEnv json))) where jsonEnv :: Monad m => Value -> Env m jsonEnv v p- | head (reverse p) == "indices" = case Just v ^. pathToLens (init p) of+ | last p == "indices" = case join (Just v ^? pathToLens (init p)) of Just (Array a) -> return $ return . TextInput $ unparseIndices [0 .. (pred $ V.length a)] _ -> return [ TextInput "" ]- | otherwise = return . maybe [] jsonToText $ Just v ^. pathToLens p+ | otherwise = return . maybe [] jsonToText $ join (Just v ^? pathToLens p) jsonToText (String s) = [TextInput s] jsonToText (Bool b) = showPack b@@ -68,19 +72,22 @@ > {"person":{"name":"This field is required"}} -} jsonErrors :: ToJSON a => View a -> Value-jsonErrors = fromMaybe (error "Constructing error tree failed!") .- foldl encodeError (Just $ object []) . viewErrors+jsonErrors v =+ fromMaybe (error "Unable to construct error response")+ (foldl encodeError Nothing (viewErrors v)) where encodeError json (path, message) =- json & pathToLens path .~ Just (toJSON message)+ json & pathToLens path . non Null .~ toJSON message ---------------------------------------------------------------------------------pathToLens :: Functor f- => [T.Text]- -> (Maybe Value -> f (Maybe Value))- -> Maybe Value- -> f (Maybe Value)+pathToLens :: [T.Text] -> Traversal' (Maybe Value) (Maybe Value) pathToLens = foldl (.) id . map pathElem . filter (not . T.null) where- pathElem p = maybe (key p) nth (readMay $ T.unpack p)+ pathElem p = maybe (non (object []) . _Object . at p)+ (\n -> non (Array mempty) . _Array . iso toMap fromMap . at n)+ (readMay $ T.unpack p)+ toMap = V.ifoldl' (\m i a -> IntMap.insert i a m) IntMap.empty+ fromMap m = V.fromList [ IntMap.findWithDefault Null x m+ | x <- [0 .. fst (IntMap.findMax m)]+ ]