hw-json 1.2.0.1 → 1.2.0.2
raw patch · 4 files changed
+171/−24 lines, 4 filesdep +aesondep +scientificdep ~hw-json-standard-cursorPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: aeson, scientific
Dependency ranges changed: hw-json-standard-cursor
API changes (from Hackage documentation)
- HaskellWorks.Data.Json.Internal.Slurp: slurpText :: ByteString -> Text
+ HaskellWorks.Data.Json.Internal.Slurp: slurpText :: ByteString -> Either Text Text
Files
- hw-json.cabal +9/−2
- src/HaskellWorks/Data/Json/Internal/Slurp.hs +10/−20
- src/HaskellWorks/Data/Json/LightJson.hs +1/−2
- test/HaskellWorks/Data/Json/LightJsonSpec.hs +151/−0
hw-json.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-json-version: 1.2.0.1+version: 1.2.0.2 synopsis: Memory efficient JSON parser description: Memory efficient JSON parser. Please see README.md category: Data@@ -39,6 +39,7 @@ common base { build-depends: base >= 4 && < 5 } +common aeson { build-depends: aeson >= 1.4.3.0 && < 1.5 } common ansi-wl-pprint { build-depends: ansi-wl-pprint >= 0.6.8.2 && < 0.7 } common array { build-depends: array >= 0.5 && < 0.6 } common attoparsec { build-depends: attoparsec >= 0.13 && < 0.14 }@@ -55,7 +56,7 @@ common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1.0.4 && < 0.2 } common hw-json-simd { build-depends: hw-json-simd >= 0.1.0.2 && < 0.2 } common hw-json-simple-cursor { build-depends: hw-json-simple-cursor >= 0.1.0.1 && < 0.2 }-common hw-json-standard-cursor { build-depends: hw-json-standard-cursor >= 0.1.0.1 && < 0.2 }+common hw-json-standard-cursor { build-depends: hw-json-standard-cursor >= 0.1.1.0 && < 0.2 } common hw-mquery { build-depends: hw-mquery >= 0.2.0.0 && < 0.3 } common hw-parser { build-depends: hw-parser >= 0.1 && < 0.2 } common hw-prim { build-depends: hw-prim >= 0.6.2.28 && < 0.7 }@@ -65,6 +66,7 @@ common lens { build-depends: lens >= 4 && < 5 } common mmap { build-depends: mmap >= 0.5 && < 0.6 } common optparse-applicative { build-depends: optparse-applicative >= 0.14 && < 0.15 }+common scientific { build-depends: scientific >= 0.3.6.2 && < 0.4 } common text { build-depends: text >= 1.2 && < 1.3 } common transformers { build-depends: transformers >= 0.4 && < 0.6 } common vector { build-depends: vector >= 0.12 && < 0.13 }@@ -83,6 +85,7 @@ library import: base, config+ , aeson , ansi-wl-pprint , attoparsec , bits-extra@@ -160,6 +163,7 @@ test-suite hw-json-test import: base, config+ , aeson , attoparsec , bytestring , hedgehog@@ -172,6 +176,8 @@ , hw-prim , hw-rankselect , hw-rankselect-base+ , scientific+ , text , transformers , vector type: exitcode-stdio-1.0@@ -181,6 +187,7 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-tools: hspec-discover other-modules:+ HaskellWorks.Data.Json.LightJsonSpec HaskellWorks.Data.Json.Simple.CursorSpec HaskellWorks.Data.Json.Standard.CursorSpec HaskellWorks.Data.Json.Standard.GenCursorTest
src/HaskellWorks/Data/Json/Internal/Slurp.hs view
@@ -13,10 +13,12 @@ import HaskellWorks.Data.Json.Standard.Cursor.Internal.Word8 import Prelude hiding (drop) -import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BSC-import qualified Data.List as L-import qualified Data.Text as T+import qualified Data.Aeson.Parser.Internal as AP+import qualified Data.Attoparsec.ByteString as PBS+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.List as L+import qualified Data.Text as T data JsonState = Escaped@@ -25,22 +27,10 @@ | InNumber | InIdent -slurpText :: BS.ByteString -> Text-slurpText bs = T.pack $ L.unfoldr genString (InJson, BSC.unpack bs) -- TODO optimise- where genString :: (JsonState, String) -> Maybe (Char, (JsonState, String))- genString (InJson, ds) = case ds of- (e:es) | e == '"' -> genString (InString , es)- (_:es) -> genString (InJson , es)- _ -> Nothing- genString (InString, ds) = case ds of- (e:es) | e == '\\' -> genString (Escaped , es)- (e:_ ) | e == '"' -> Nothing- (e:es) -> Just (e, (InString , es))- _ -> Nothing- genString (Escaped, ds) = case ds of- (_:es) -> Just ('.', (InString , es))- _ -> Nothing- genString (_, _) = Nothing+slurpText :: BS.ByteString -> Either Text Text+slurpText bs = case PBS.parseOnly AP.jstring bs of+ Right t -> Right t+ Left e -> Left (T.pack e) slurpNumber :: BS.ByteString -> BS.ByteString slurpNumber bs = let (!cs, _) = BS.unfoldrN (BS.length bs) genNumber (InJson, bs) in cs
src/HaskellWorks/Data/Json/LightJson.hs view
@@ -31,7 +31,6 @@ import HaskellWorks.Data.TreeCursor import HaskellWorks.Data.Uncons import Prelude hiding (drop)-import Prelude hiding (drop) import Text.PrettyPrint.ANSI.Leijen import qualified Data.ByteString as BS@@ -126,7 +125,7 @@ instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => LightJsonAt (GenericCursor BS.ByteString v w) where lightJsonAt k = case uncons remainder of Just (!c, _) | isLeadingDigit2 c -> LightJsonNumber (slurpNumber remainder)- Just (!c, _) | isQuotDbl c -> LightJsonString (slurpText remainder)+ Just (!c, _) | isQuotDbl c -> either LightJsonError LightJsonString (slurpText remainder) Just (!c, _) | isChar_t c -> LightJsonBool True Just (!c, _) | isChar_f c -> LightJsonBool False Just (!c, _) | isChar_n c -> LightJsonNull
+ test/HaskellWorks/Data/Json/LightJsonSpec.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module HaskellWorks.Data.Json.LightJsonSpec (spec) where++import Control.Monad+import Data.Text+import HaskellWorks.Data.BalancedParens.BalancedParens+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Json.DecodeError+import HaskellWorks.Data.Json.LightJson+import HaskellWorks.Data.Json.Standard.Cursor.Generic+import HaskellWorks.Data.Json.Value+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.Aeson.Parser.Internal as AP+import qualified Data.Attoparsec.ByteString as PBS+import qualified Data.ByteString as BS+import qualified Data.Scientific as S+import qualified Data.Text as T+import qualified HaskellWorks.Data.Json.Standard.Cursor.Fast as FAST+import qualified HaskellWorks.Data.Json.Standard.Cursor.Slow as SLOW+import qualified HaskellWorks.Data.TreeCursor as TC++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-}++fc = TC.firstChild+ns = TC.nextSibling++spec :: Spec+spec = describe "HaskellWorks.Data.Json.LightJsonSpec" $ do+ genSpec "DVS.Vector Word64" SLOW.fromString+ genSpec "CsPoppy" FAST.fromString++jsonValueVia :: forall t u.+ ( BalancedParens u+ , Rank0 u+ , Rank1 u+ , Select1 t+ , TestBit u)+ => Maybe (GenericCursor BS.ByteString t u)+ -> Either DecodeError JsonValue+jsonValueVia mk = case mk of+ Just k -> case lightJsonAt k of+ LightJsonString t -> Right (JsonString t)+ LightJsonNumber bs -> case PBS.parseOnly AP.scientific bs of+ Right s -> Right (JsonNumber (S.toRealFloat s))+ Left msg -> Left (DecodeError msg)+ LightJsonObject ps -> fmap JsonObject (traverse fields ps)+ LightJsonArray cs -> fmap JsonArray (traverse elements cs)+ LightJsonBool v -> Right (JsonBool v)+ LightJsonNull -> Right JsonNull+ LightJsonError msg -> Left (DecodeError (T.unpack msg))+ Nothing -> Left (DecodeError "No such element")+ where fields :: (Text, GenericCursor BS.ByteString t u) -> Either DecodeError (Text, JsonValue)+ fields (f, c) = (f,) <$> jsonValueVia (Just c)+ elements :: GenericCursor BS.ByteString t u -> Either DecodeError JsonValue+ elements c = jsonValueVia (Just c)++genSpec :: forall t u.+ ( Eq t+ , Show t+ , Select1 t+ , Eq u+ , Show u+ , Rank0 u+ , Rank1 u+ , BalancedParens u+ , TestBit u)+ => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith ()+genSpec t makeCursor = do+ describe ("Json cursor of type " ++ t) $ do+ let forJson s f = describe ("of value " ++ show s) (f (makeCursor s))+ forJson "{}" $ \cursor -> do+ it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonObject [])+ forJson " {}" $ \cursor -> do+ it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonObject [])+ forJson "1234" $ \cursor -> do+ it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonNumber 1234)+ forJson "\"Hello\"" $ \cursor -> do+ it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonString "Hello")+ forJson "[]" $ \cursor -> do+ it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonArray [])+ forJson "true" $ \cursor -> do+ it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonBool True)+ forJson "false" $ \cursor -> do+ it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonBool False)+ forJson "null" $ \cursor -> do+ it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right JsonNull+ forJson "[null]" $ \cursor -> do+ it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonArray [JsonNull])+ it "should have correct value" $ requireTest $ jsonValueVia (fc cursor) === Right JsonNull+ forJson "[null, {\"field\": 1}]" $ \cursor -> do+ it "cursor can navigate to second child of array" $ requireTest $ do+ jsonValueVia ((fc >=> ns) cursor) === Right ( JsonObject [("field", JsonNumber 1)] )+ jsonValueVia (Just cursor) === Right (JsonArray [JsonNull, JsonObject [("field", JsonNumber 1)]])+ describe "For empty json array" $ do+ let cursor = makeCursor "[]"+ it "can navigate down and forwards" $ requireTest $ do+ jsonValueVia (Just cursor) === Right (JsonArray [])+ describe "For empty json array" $ do+ let cursor = makeCursor "[null]"+ it "can navigate down and forwards" $ requireTest $ do+ jsonValueVia (Just cursor) === Right (JsonArray [JsonNull])+ describe "For sample Json" $ do+ let cursor = makeCursor "{ \+ \ \"widget\": { \+ \ \"debug\": \"on\", \+ \ \"window\": { \+ \ \"name\": \"main_window\", \+ \ \"dimensions\": [500, 600.01e-02, true, false, null] \+ \ } \+ \ } \+ \}" :: GenericCursor BS.ByteString t u+ it "can navigate down and forwards" $ requireTest $ do+ let array = JsonArray [JsonNumber 500, JsonNumber 600.01e-02, JsonBool True, JsonBool False, JsonNull] :: JsonValue+ let object1 = JsonObject ([("name", JsonString "main_window"), ("dimensions", array)]) :: JsonValue+ let object2 = JsonObject ([("debug", JsonString "on"), ("window", object1)]) :: JsonValue+ let object3 = JsonObject ([("widget", object2)]) :: JsonValue+ jsonValueVia (Just cursor) === Right object3+ jsonValueVia ((fc ) cursor) === Right (JsonString "widget" )+ jsonValueVia ((fc >=> ns ) cursor) === Right (object2 )+ jsonValueVia ((fc >=> ns >=> fc ) cursor) === Right (JsonString "debug" )+ jsonValueVia ((fc >=> ns >=> fc >=> ns ) cursor) === Right (JsonString "on" )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns ) cursor) === Right (JsonString "window" )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns ) cursor) === Right (object1 )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc ) cursor) === Right (JsonString "name" )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns ) cursor) === Right (JsonString "main_window" )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns ) cursor) === Right (JsonString "dimensions" )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns ) cursor) === Right (array )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc ) cursor) === Right (JsonNumber 500 )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns ) cursor) === Right (JsonNumber 600.01e-02 )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns ) cursor) === Right (JsonBool True )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns ) cursor) === Right (JsonBool False )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ns) cursor) === Right JsonNull