hermes-json 0.6.0.0 → 0.6.1.0

raw patch · 7 files changed

+142/−13 lines, 7 filesdep ~basedep ~bytestringdep ~primitivePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring, primitive, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• README.md +4/−0
• hermes-json.cabal +5/−5
• src/Data/Hermes.hs +5/−0
• src/Data/Hermes/Decoder/Internal.hs +28/−2
• src/Data/Hermes/Decoder/Value.hs +55/−0
• tests/test.hs +31/−6

@@ -1,5 +1,19 @@ # Revision history for hermes-json +## 0.6.1.0 -- 2023-08-27++### Changed+* Bump upper bounds on dependencies++### Fixed+* Fix bug in `FieldsDecoder` `Alternative` instance that was causing seg faults+  on missing keys++### Added+* Add `liftObjectDecoder`+* Add `objectAsMapExcluding`+* Add `formatException`+ ## 0.6.0.0 -- 2023-08-22  ### Breaking Changes:

@@ -79,6 +79,10 @@ * Partial decoding of Twitter status objects to highlight the on-demand benefits * Decoding entire documents into `Data.Aeson.Value` +Please be aware that GHC does not report C-allocated memory. simdjson does actually+allocate more memory than appears here, but we still strive to keep our Haskell memory+footprint as small as possible.+ ### Specs  * GHC 9.4.6 w/ -O1

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               hermes-json-version:            0.6.0.0+version:            0.6.1.0 category:           Text, Web, JSON, FFI synopsis:           Fast JSON decoding via simdjson C++ bindings description:@@ -61,15 +61,15 @@     Data.Hermes.Decoder.Internal     Data.Hermes.Decoder.Internal.Scientific   build-depends:-    base               >= 4.13 && < 4.19,-    bytestring         >= 0.10.12 && < 0.12,+    base               >= 4.13 && < 4.20,+    bytestring         >= 0.10.12 && < 0.13,     containers         >= 0.6.5 && < 0.7,     deepseq            >= 1.4.4 && < 1.5,     dlist              >= 0.8 && < 1.1,     integer-conversion >= 0.1 && < 0.2,-    primitive          >= 0.7.0 && < 0.9,+    primitive          >= 0.7.0 && < 0.10,     scientific         >= 0.3.6 && < 0.4,-    text               >= 2.0 && < 2.1,+    text               >= 2.0 && < 2.2,     text-iso8601       >= 0.1 && < 0.2,     transformers       >= 0.5.6 && < 0.7,     time               >= 1.9.3 && < 1.13,

@@ -52,6 +52,8 @@   , nullable   , objectAsKeyValues   , objectAsMap+  , objectAsMapExcluding+  , liftObjectDecoder     -- ** Date and time     -- | Parses date and time types from Data.Time using the     -- same Text parsers as Data.Aeson via@@ -67,6 +69,7 @@     -- * Error Types   , HermesException(..)   , DocumentError(..)+  , formatException     -- * Value helpers   , getType   , isNull@@ -102,6 +105,8 @@   , HermesException(..)   , decodeEither   , decodeEitherIO+  , formatException+  , liftObjectDecoder   , mkHermesEnv   , mkHermesEnv_   , parseByteString

@@ -22,6 +22,7 @@   , local   , decodeEither   , decodeEitherIO+  , formatException   , mkHermesEnv   , mkHermesEnv_   , withHermesEnv@@ -32,6 +33,7 @@   , parseByteStringIO   , liftIO   , withRunInIO+  , liftObjectDecoder   ) where  import           Control.Applicative (Alternative(..))@@ -190,7 +192,8 @@  instance Alternative FieldsDecoder where   {-# INLINE (<|>) #-}-  (FieldsDecoder a) <|> (FieldsDecoder b) = FieldsDecoder $ \obj -> a obj <|> b obj+  (FieldsDecoder a) <|> (FieldsDecoder b) = FieldsDecoder $ \obj -> Decoder $ \val ->+    runDecoder (a obj) val <|> runDecoder (b obj) val   {-# INLINE empty #-}   empty = FieldsDecoder $ const empty @@ -264,6 +267,15 @@ instance Exception HermesException instance NFData HermesException +formatException :: HermesException -> Text+formatException ex = case ex of+  SIMDException doc     -> formatDoc doc+  InternalException doc -> formatDoc doc+  where+    formatDoc err+      | T.null (path err) = "Document error: " <> errorMsg err+      | otherwise = "Error in " <> path err <> ": " <> errorMsg err+ -- | Record containing all pertinent information for troubleshooting an exception. data DocumentError =   DocumentError@@ -315,7 +327,7 @@   then pure ()   else do     errStr <- liftIO $ F.peekCString =<< getErrorMessageImpl errInt-    throwSIMD $ pre <> " " <> T.pack errStr+    throwSIMD . T.strip $ T.unwords [pre, T.pack errStr] {-# INLINE handleErrorCode #-}  withRunInIO :: ((forall a. DecoderM a -> IO a) -> IO b) -> DecoderM b@@ -335,3 +347,17 @@ local :: (HermesEnv -> HermesEnv) -> DecoderM a -> DecoderM a local f (DecoderM m) = DecoderM . ReaderT $ runReaderT m . f {-# INLINE local #-}++-- | Resets the object being iterated and runs the provided `Decoder` on the+-- object but as a `FieldsDecoder`. This is mostly a convenience for+-- re-entering an object after starting iteration, which isn't very+-- useful or performant.+--+-- > object $ (,)+-- >   <$> atKey "hello" text+-- >   <*> liftObjectDecoder (objectAsMap pure text)))+liftObjectDecoder :: Decoder a -> FieldsDecoder a+liftObjectDecoder decoder = FieldsDecoder $ \(Object obj) -> Decoder $ \_ -> do+  liftIO $ resetObjectImpl (Object obj)+  runDecoder decoder (Value $ F.castPtr obj)+{-# INLINE liftObjectDecoder #-}

@@ -19,6 +19,7 @@   , object   , objectAsKeyValues   , objectAsMap+  , objectAsMapExcluding   , parseScientific   , scientific   , string@@ -218,6 +219,21 @@ objectAsMap kf vf = withObjectIter $ iterateOverFieldsMap kf vf {-# INLINE objectAsMap #-} +-- | Parse an object into a strict `Map`.+-- Skips any fields in the given list, which adds a slight performance penalty.+objectAsMapExcluding+  :: Ord k+  => [Text]+  -- ^ List of field names to exclude.+  -> (Text -> Decoder k)+  -- ^ Parses a Text key in the Decoder monad. JSON keys are always text.+  -> Decoder v+  -- ^ Decoder for the field value.+  -> Decoder (Map k v)+objectAsMapExcluding fields kf vf =+  withObjectIter $ iterateOverFieldsMapExcluding fields kf vf+{-# INLINE objectAsMapExcluding #-}+ withObjectAsMap   :: Ord k   => (Text -> Decoder k)@@ -427,6 +443,45 @@         else           pure acc {-# INLINE iterateOverFieldsMap #-}++iterateOverFieldsMapExcluding+  :: Ord a+  => [Text]+  -> (Text -> Decoder a)+  -> Decoder b+  -> ObjectIter+  -> DecoderM (Map a b)+iterateOverFieldsMapExcluding fields fk fv iterPtr =+  withRunInIO $ \run ->+    F.alloca $ \lenPtr ->+      F.alloca $ \keyPtr ->+        allocaValue $ \valPtr -> run $ go M.empty keyPtr lenPtr valPtr+  where+    go !acc keyPtr lenPtr valPtr = do+      isOver <- fmap F.toBool . liftIO $ objectIterIsDoneImpl iterPtr+      if not isOver+        then do+          err <- liftIO $ objectIterGetCurrentImpl iterPtr keyPtr lenPtr valPtr+          handleErrorCode "" err+          kLen <- fmap fromIntegral . liftIO $ F.peek lenPtr+          kStr <- liftIO $ F.peek keyPtr+          keyTxt <- parseTextFromCStrLen (kStr, kLen)+          if keyTxt `elem` fields+            then do+              liftIO $ objectIterMoveNextImpl iterPtr+              go acc keyPtr lenPtr valPtr+            else do+              (k, v)+                <-+                  withKey keyTxt $ do+                    k <- runDecoder (fk keyTxt) valPtr+                    v <- runDecoder fv valPtr+                    pure (k, v)+              liftIO $ objectIterMoveNextImpl iterPtr+              go (M.insert k v acc) keyPtr lenPtr valPtr+        else+          pure acc+{-# INLINE iterateOverFieldsMapExcluding #-}  -- | Execute a function on each Field in an ObjectIter and -- accumulate key-value tuples into a list.

@@ -37,7 +37,7 @@ properties = testGroup "Properties" [rtProp, rtPropOptional, rtErrors, rtRecursiveDataType]  units :: TestTree-units = testGroup "Units" [altCases]+units = testGroup "Units" [altCases, objectFields]  rtRecursiveDataType :: TestTree rtRecursiveDataType = testProperty "Round Trip With Recursive Data Type" $@@ -48,21 +48,21 @@  rtProp :: TestTree rtProp = testProperty "Round Trip With Aeson.ToJSON" $-  withTests 1000 . property $ do+  property $ do     p <- forAll genPerson     dp <- roundtrip decodePerson p     p === dp  rtPropOptional :: TestTree rtPropOptional = testProperty "Round Trip With Aeson.ToJSON (Optional Keys)" $-  withTests 1000 . property $ do+  property $ do     p <- forAll genPersonOptional     dp <- roundtrip decodePersonOptional p     p === dp  rtErrors :: TestTree rtErrors = testProperty "Errors Should Not Break Referential Transparency" $-  withTests 1000 . property $ do+  property $ do     p <- forAll        $ Gen.element        [ "{"@@ -120,12 +120,18 @@         "{ \"key1\": 1, \"key2\": 2 }"       @?= Right (Map.fromList [("key1", 1), ("key2", 2)]) -  , testCase "Alternative Keys" $+  , testCase "Alternative Keys (value error)" $       decodeEither         (object $ atKey "key1" (1 <$ bool) <|> atKey "key2" int)         "{ \"key1\": 1, \"key2\": 2 }"       @?= Right 2 +  , testCase "Alternative Keys (key error)" $+      decodeEither+        (object $ atKey "nope" int <|> atKey "key2" int)+        "{ \"key1\": 1, \"key2\": 2 }"+      @?= Right 2+   , testCase "Alternative Objects" $       decodeEither         (object (atKey "key1" (2 <$ bool)) <|> object (atKey "key1" int))@@ -133,6 +139,13 @@       @?= Right 1   ] +objectFields :: TestTree+objectFields = testGroup "Object Fields"+  [ testCase "liftObjectDecoder" $+      decodeEither decodeFriendSlurp "{ \"id\": 1, \"first\": \"Bob\", \"last\": \"Kelso\" }"+    @?= Right (FriendWithMap 1 (Map.fromList [("first", "Bob"), ("last", "Kelso")]))+  ]+ data Person =   Person     { _id           :: Text@@ -336,7 +349,7 @@     1000000000000000000000000  genScientific :: Gen Scientific-genScientific = fmap Sci.fromFloatDigits $ genDouble+genScientific = fmap Sci.fromFloatDigits genDouble  newtype Peano = Peano Word16   deriving (Eq, Show)@@ -355,3 +368,15 @@     case mPeano of       Just (Peano subTree) -> Peano $ 1 + subTree       Nothing -> Peano 0++data FriendWithMap =+  FriendWithMap+    { id   :: Int+    , rest :: Map Text Text+    } deriving (Eq, Show)++decodeFriendSlurp :: Decoder FriendWithMap+decodeFriendSlurp = object $+  FriendWithMap+    <$> atKey "id" int+    <*> liftObjectDecoder (objectAsMapExcluding ["id"] pure text)