aeson-extra 0.3.1.1 → 0.3.2.0
raw patch · 6 files changed
+117/−10 lines, 6 filesdep +attoparsecdep ~these
Dependencies added: attoparsec
Dependency ranges changed: these
Files
- CHANGELOG.md +4/−0
- aeson-extra.cabal +4/−2
- src/Data/Aeson/Extra.hs +3/−0
- src/Data/Aeson/Extra/Merge.hs +6/−6
- src/Data/Aeson/Extra/Stream.hs +64/−0
- test/Tests.hs +36/−2
CHANGELOG.md view
@@ -1,3 +1,7 @@+# 0.3.2.0++- Add `Data.Aeson.Extra.Stream` with `streamDecode`+ # 0.3.1.1 (2016-02-09) - Support aeson-0.11
aeson-extra.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: aeson-extra-version: 0.3.1.1+version: 0.3.2.0 synopsis: Extra goodies for aeson description: Package provides extra funcitonality on top of @aeson@ and @aeson-compat@ category: Web@@ -33,6 +33,7 @@ base >=4.6 && <4.10 , aeson >=0.7.0.6 && <0.12 , aeson-compat >=0.3.0.0 && <0.4+ , attoparsec >=0.11.3.4 && <0.14 , base-compat >=0.6.0 && <0.10 , bytestring >=0.10 && <0.11 , containers >=0.5 && <0.6@@ -54,6 +55,7 @@ Data.Aeson.Extra.Foldable Data.Aeson.Extra.Map Data.Aeson.Extra.Merge+ Data.Aeson.Extra.Stream Data.Aeson.Extra.Time Data.Aeson.Extra.TH @@ -83,7 +85,7 @@ , scientific >=0.3 && <0.4 , template-haskell >=2.8 && <2.11 , text >=1.2 && <1.3- , these >=0.6.2.0 && <0.7+ , these >=0.6.2.0 && <0.8 , time >=1.4.2 && <1.7 , time-parsers >=0.1.0.0 && <0.2 , unordered-containers >=0.2 && <0.3
src/Data/Aeson/Extra.hs view
@@ -38,6 +38,8 @@ ArrayF, -- * Merge merge,+ -- * Stream+ streamDecode, -- * Template Haskell mkValue, mkValue',@@ -57,6 +59,7 @@ import Data.Aeson.Extra.Foldable import Data.Aeson.Extra.Map import Data.Aeson.Extra.Merge+import Data.Aeson.Extra.Stream import Data.Aeson.Extra.Time import Data.Aeson.Extra.TH
src/Data/Aeson/Extra/Merge.hs view
@@ -7,12 +7,12 @@ -- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi> -- module Data.Aeson.Extra.Merge (- merge,- mergeA,- ValueF(..),- ObjectF,- ArrayF,- ) where+ merge,+ mergeA,+ ValueF(..),+ ObjectF,+ ArrayF,+ ) where import Prelude () import Prelude.Compat
+ src/Data/Aeson/Extra/Stream.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE ScopedTypeVariables #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.Aeson.Extra.Stream+-- Copyright : (C) 2015-2016 Oleg Grenrus+-- License : BSD3+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module Data.Aeson.Extra.Stream (+ streamDecode,+ ) where++import Prelude ()+import Prelude.Compat++import Control.Applicative ((<|>), many)+import Data.Aeson.Compat (FromJSON, Result (..), Value, fromJSON)+import Data.Aeson.Parser (value)++import qualified Data.ByteString.Lazy as LBS+import qualified Data.Attoparsec.ByteString.Char8 as A8+import qualified Data.Attoparsec.ByteString.Lazy as A++streamParse :: LBS.ByteString -> ([Value], Maybe String)+streamParse = start+ where+ start bs = case A.parse (lexemeChar '[') bs of+ A.Done bs' _ -> first bs'+ A.Fail _ _ err -> ([], Just err)+ first bs = case A.parse (lexemeChar ']') bs of+ A.Done _ _ -> ([], Nothing)+ A.Fail _ _ _ -> go bs+ go bs = case A.parse valueEnd bs of+ A.Done _ (r, False) -> ([r], Nothing)+ A.Done bs' (r, True) -> case go bs' of+ ~(rs, end) -> (r:rs, end)+ A.Fail _ _ err -> ([], Just err)+ valueEnd = do+ v <- value+ c <- True <$ lexemeChar ',' <|> False <$ lexemeChar ']'+ return (v, c)+ lexemeChar c = many A8.space *> A8.char c <* many A8.space++-- | Lazyly parse 'LBS.ByteString' with top-level JSON array.+--+-- /Note:/ inspecting result's second field will force the list!+--+-- @+-- let ~(values, err) = 'streamDecode' bs+-- traverse_ processValue values+-- maybe (pure ()) printError err+-- @+--+-- @since 0.3.2.0+streamDecode :: forall a. FromJSON a => LBS.ByteString -> ([a], Maybe String)+streamDecode bs = go values+ where+ (values, err) = streamParse bs+ go :: [Value] -> ([a], Maybe String)+ go [] = ([], err)+ go (v:vs) = case fromJSON v of+ Error err' -> ([], Just err')+ Success x -> case go vs of+ ~(xs, err') -> (x:xs, err')
test/Tests.hs view
@@ -47,7 +47,8 @@ , utctimeTests , zonedtimeTests , timeTHTests- , mergeTests + , mergeTests+ , streamTests ] ------------------------------------------------------------------------------@@ -143,6 +144,39 @@ in prop ] +-------------------------------------------------------------------------------+-- Stream+-------------------------------------------------------------------------------++streamTests :: TestTree+streamTests = testGroup "stream"+ [ streamDecodeTests+ ]+ where+ streamDecodeTests = testGroup "decode" $+ map (uncurry validTestCase) valids +++ [ testCase "ws: empty" $ streamDecode " [ ] " @?= ([] :: [Int], Nothing)+ , testCase "ws: singleton" $ streamDecode " [ 1 ]" @?= ([1] :: [Int], Nothing)+ , testCase "ws: many" $ streamDecode " [ 1 , 2, 3 ] " @?= ([1,2,3] :: [Int], Nothing)+ -- Errors:+ , testCase "error begin" $ streamDecode' "," @?= ([] :: [Int], True)+ , testCase "parses first" $ streamDecode' "[1,2,3[" @?= ([1,2] :: [Int], True)+ , testCase "error begin" $ streamDecode' "[1,2,'a']" @?= ([1,2] :: [Int], True)+ ]++ validTestCase name value =+ testCase ("valid " ++ name) $ streamDecode (encode value) @?= (value, Nothing)++ streamDecode' = fmap isJust . streamDecode++ valids :: [(String, [Int])]+ valids =+ [ (,) "empty" []+ , (,) "singleton" [1]+ , (,) "many" [1..200]+ ]++ ------------------------------------------------------------------------------ -- Comparison (.:?) and (.:!) ------------------------------------------------------------------------------@@ -235,7 +269,7 @@ where f (These x y) = r x y f (This x) = x f (That x) = x- + mergeTests :: TestTree mergeTests = testGroup "Lodash merge examples" $ map f examples where