diff --git a/CHANGELOG.md b/CHANGELOG.md index cbd9946..d9ff983 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ # Revision history for hermes-json +## 0.5.0.0 -- 2023-03-08 + +* Convert `DecoderM` callbacks to `Decoder`. This is a breaking change. +* Add useful instances for the `Decoder` monad +* Remove some redundant functions +* Adjust `vector` bounds + ## 0.4.0.0 -- 2023-03-07 * Update simdjson to 3.1.3 diff --git a/README.md b/README.md index 50f6d70..a317b14 100644 --- a/README.md +++ b/README.md @@ -90,17 +90,17 @@ We benchmark the following operations using both `hermes-json` and `aeson` stric | Name | Mean (ps) | 2*Stdev (ps) | Allocated | Copied | Peak Memory | | --------------------------------------- | ------------- | ------------ | ---------- | ---------- | ----------- | -| All.Decode.Arrays.Hermes | 267104550000 | 18274712758 | 503599934 | 439150544 | 541065216 | -| All.Decode.Arrays.Aeson | 2205838200000 | 108871466542 | 7094759154 | 2392723275 | 1166016512 | -| All.Decode.Persons.Hermes | 47153700000 | 3880584170 | 144901928 | 57032737 | 1166016512 | -| All.Decode.Persons.Aeson | 134265700000 | 7195219536 | 357269946 | 188529734 | 1166016512 | -| All.Decode.Partial Twitter.Hermes | 246448046 | 20934312 | 348540 | 3088 | 1166016512 | -| All.Decode.Partial Twitter.JsonStream | 2105484765 | 73210262 | 15261108 | 273820 | 1166016512 | -| All.Decode.Partial Twitter.Aeson | 4297434375 | 139205712 | 12547656 | 4625157 | 1166016512 | -| All.Decode.Persons (Aeson Value).Hermes | 108099550000 | 9966602188 | 303649194 | 138051155 | 1166016512 | -| All.Decode.Persons (Aeson Value).Aeson | 119240200000 | 9148201308 | 286148916 | 177027844 | 1166016512 | -| All.Decode.Twitter (Aeson Value).Hermes | 4261312500 | 149205128 | 12555922 | 4151184 | 1166016512 | -| All.Decode.Twitter (Aeson Value).Aeson | 4832229687 | 242990712 | 12539421 | 5527422 | 1166016512 | +| All.Decode.Arrays.Hermes | 267914650000 | 10610366160 | 503599934 | 439150544 | 541065216 | +| All.Decode.Arrays.Aeson | 2214928800000 | 160279563772 | 7094759111 | 2392723388 | 1166016512 | +| All.Decode.Persons.Hermes | 47338175000 | 4290343628 | 144901928 | 57032737 | 1166016512 | +| All.Decode.Persons.Aeson | 132864400000 | 9509102680 | 357269946 | 188529742 | 1166016512 | +| All.Decode.Partial Twitter.Hermes | 241083593 | 13856196 | 348540 | 3088 | 1166016512 | +| All.Decode.Partial Twitter.JsonStream | 2116192187 | 158907568 | 15259526 | 273821 | 1166016512 | +| All.Decode.Partial Twitter.Aeson | 4254060937 | 262619196 | 12538003 | 4634594 | 1166016512 | +| All.Decode.Persons (Aeson Value).Hermes | 106420425000 | 3747538126 | 303886293 | 135388183 | 1166016512 | +| All.Decode.Persons (Aeson Value).Aeson | 119489550000 | 9713032080 | 286148916 | 177027852 | 1166016512 | +| All.Decode.Twitter (Aeson Value).Hermes | 4164246875 | 240020934 | 12368752 | 4149211 | 1166016512 | +| All.Decode.Twitter (Aeson Value).Aeson | 4810817187 | 345165042 | 12539421 | 5527424 | 1166016512 | | | diff --git a/hermes-aeson/hermes-aeson.cabal b/hermes-aeson/hermes-aeson.cabal index 8a2f39c..22290e5 100644 --- a/hermes-aeson/hermes-aeson.cabal +++ b/hermes-aeson/hermes-aeson.cabal @@ -12,8 +12,8 @@ library exposed-modules: Data.Hermes.Aeson build-depends: - aeson ^>= 2.1.2.1, - base ^>= 4.16.4.0, + aeson >= 2.0.1 && < 2.2, + base >= 4.16.4.0, hermes-json hs-source-dirs: src ghc-options: -Wall -O2 @@ -26,7 +26,7 @@ test-suite test main-is: test.hs ghc-options: -Wall build-depends: - aeson >= 2.0.1 && < 2.2, + aeson, base, bytestring, hermes-aeson, diff --git a/hermes-aeson/src/Data/Hermes/Aeson.hs b/hermes-aeson/src/Data/Hermes/Aeson.hs index 344e098..851ede0 100644 --- a/hermes-aeson/src/Data/Hermes/Aeson.hs +++ b/hermes-aeson/src/Data/Hermes/Aeson.hs @@ -6,11 +6,12 @@ import qualified Data.Aeson.Key as K import qualified Data.Aeson.KeyMap as KM hValueToAeson :: H.Decoder A.Value -hValueToAeson = H.withType $ \ty -> +hValueToAeson = do + ty <- H.getType case ty of - H.VArray -> H.withVector hValueToAeson (pure . A.Array) - H.VObject -> H.withObjectAsMap (pure . K.fromText) hValueToAeson (pure . A.Object . KM.fromMap) - H.VNumber -> H.withScientific (pure . A.Number) - H.VString -> H.withText (pure . A.String) - H.VBoolean -> H.withBool (pure . A.Bool) - H.VNull -> H.withNull (\isNil -> if isNil then pure A.Null else fail "expected null") + H.VArray -> A.Array <$> H.vector hValueToAeson + H.VObject -> A.Object . KM.fromMap <$> H.objectAsMap (pure . K.fromText) hValueToAeson + H.VNumber -> A.Number <$> H.scientific + H.VString -> A.String <$> H.text + H.VBoolean -> A.Bool <$> H.bool + H.VNull -> pure A.Null diff --git a/hermes-bench/bench.csv b/hermes-bench/bench.csv index dfdaa47..c2d7add 100644 --- a/hermes-bench/bench.csv +++ b/hermes-bench/bench.csv @@ -1,12 +1,12 @@ Name,Mean (ps),2*Stdev (ps),Allocated,Copied,Peak Memory -All.Decode.Arrays.Hermes,267104550000,18274712758,503599934,439150544,541065216 -All.Decode.Arrays.Aeson,2205838200000,108871466542,7094759154,2392723275,1166016512 -All.Decode.Persons.Hermes,47153700000,3880584170,144901928,57032737,1166016512 -All.Decode.Persons.Aeson,134265700000,7195219536,357269946,188529734,1166016512 -All.Decode.Partial Twitter.Hermes,246448046,20934312,348540,3088,1166016512 -All.Decode.Partial Twitter.JsonStream,2105484765,73210262,15261108,273820,1166016512 -All.Decode.Partial Twitter.Aeson,4297434375,139205712,12547656,4625157,1166016512 -All.Decode.Persons (Aeson Value).Hermes,108099550000,9966602188,303649194,138051155,1166016512 -All.Decode.Persons (Aeson Value).Aeson,119240200000,9148201308,286148916,177027844,1166016512 -All.Decode.Twitter (Aeson Value).Hermes,4261312500,149205128,12555922,4151184,1166016512 -All.Decode.Twitter (Aeson Value).Aeson,4832229687,242990712,12539421,5527422,1166016512 +All.Decode.Arrays.Hermes,267914650000,10610366160,503599934,439150544,541065216 +All.Decode.Arrays.Aeson,2214928800000,160279563772,7094759111,2392723388,1166016512 +All.Decode.Persons.Hermes,47338175000,4290343628,144901928,57032737,1166016512 +All.Decode.Persons.Aeson,132864400000,9509102680,357269946,188529742,1166016512 +All.Decode.Partial Twitter.Hermes,241083593,13856196,348540,3088,1166016512 +All.Decode.Partial Twitter.JsonStream,2116192187,158907568,15259526,273821,1166016512 +All.Decode.Partial Twitter.Aeson,4254060937,262619196,12538003,4634594,1166016512 +All.Decode.Persons (Aeson Value).Hermes,106420425000,3747538126,303886293,135388183,1166016512 +All.Decode.Persons (Aeson Value).Aeson,119489550000,9713032080,286148916,177027852,1166016512 +All.Decode.Twitter (Aeson Value).Hermes,4164246875,240020934,12368752,4149211,1166016512 +All.Decode.Twitter (Aeson Value).Aeson,4810817187,345165042,12539421,5527424,1166016512 diff --git a/hermes-bench/bench.svg b/hermes-bench/bench.svg index 064987d..93c876b 100644 --- a/hermes-bench/bench.svg +++ b/hermes-bench/bench.svg @@ -1,105 +1,105 @@ -Decode.Arrays.Hermes 267 ms +Decode.Arrays.Hermes 268 ms -267 ms ± 18 ms - - - - +268 ms ± 11 ms + + + + Decode.Arrays.Aeson -2.206 s +2.215 s -2.206 s ± 109 ms - - - +2.215 s ± 160 ms + + + -Decode.Persons.Hermes 47.2 ms +Decode.Persons.Hermes 47.3 ms -47.2 ms ± 3.9 ms - - - - +47.3 ms ± 4.3 ms + + + + -Decode.Persons.Aeson 134 ms +Decode.Persons.Aeson 133 ms -134 ms ± 7.2 ms - - - - +133 ms ± 9.5 ms + + + + -Decode.Partial Twitter.Hermes 246 μs +Decode.Partial Twitter.Hermes 241 μs -246 μs ± 21 μs - - - - +241 μs ± 14 μs + + + + -Decode.Partial Twitter.JsonStream 2.11 ms +Decode.Partial Twitter.JsonStream 2.12 ms -2.11 ms ± 73 μs - - - - +2.12 ms ± 159 μs + + + + -Decode.Partial Twitter.Aeson 4.30 ms +Decode.Partial Twitter.Aeson 4.25 ms -4.30 ms ± 139 μs - - - - +4.25 ms ± 263 μs + + + + -Decode.Persons (Aeson Value).Hermes 108 ms +Decode.Persons (Aeson Value).Hermes 106 ms -108 ms ± 10 ms - - - - +106 ms ± 3.7 ms + + + + Decode.Persons (Aeson Value).Aeson 119 ms -119 ms ± 9.1 ms - - - - +119 ms ± 9.7 ms + + + + -Decode.Twitter (Aeson Value).Hermes 4.26 ms +Decode.Twitter (Aeson Value).Hermes 4.16 ms -4.26 ms ± 149 μs - - - - +4.16 ms ± 240 μs + + + + -Decode.Twitter (Aeson Value).Aeson 4.83 ms +Decode.Twitter (Aeson Value).Aeson 4.81 ms -4.83 ms ± 243 μs - - - - +4.81 ms ± 345 μs + + + + diff --git a/hermes-json.cabal b/hermes-json.cabal index 5420898..7af5433 100644 --- a/hermes-json.cabal +++ b/hermes-json.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hermes-json -version: 0.4.0.0 +version: 0.5.0.0 category: Text, Web, JSON, FFI synopsis: Fast JSON decoding via simdjson C++ bindings description: @@ -72,7 +72,7 @@ library transformers >= 0.5.6 && < 0.6, time >= 1.9.3 && < 1.13, time-compat >= 1.9.5 && < 1.10, - vector >= 0.13.0 && < 0.14 + vector >= 0.12.3.1 && < 0.14 hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Data/Hermes.hs b/src/Data/Hermes.hs index 57dcb38..4e5c469 100644 --- a/src/Data/Hermes.hs +++ b/src/Data/Hermes.hs @@ -69,14 +69,12 @@ module Data.Hermes , withBool , withDouble , withInt - , withNull , withObject , withObjectAsMap , withScientific , withString , withText , withType - , withTypeM , withVector -- * Raw ByteString access , withRawByteString diff --git a/src/Data/Hermes/Decoder/Internal.hs b/src/Data/Hermes/Decoder/Internal.hs index 99940d4..78576fb 100644 --- a/src/Data/Hermes/Decoder/Internal.hs +++ b/src/Data/Hermes/Decoder/Internal.hs @@ -105,6 +105,34 @@ instance NFData Path newtype Decoder a = Decoder { runDecoder :: Value -> DecoderM a } +instance Functor Decoder where + {-# INLINE fmap #-} + fmap f d = Decoder $ \val -> f <$> runDecoder d val + +instance Applicative Decoder where + {-# INLINE pure #-} + pure a = Decoder $ \_ -> pure a + {-# INLINE (<*>) #-} + (Decoder f) <*> (Decoder e) = Decoder $ \val -> f val <*> e val + +instance Monad Decoder where + {-# INLINE return #-} + return = pure + {-# INLINE (>>=) #-} + (Decoder d) >>= f = Decoder $ \val -> do + x <- d val + runDecoder (f x) val + +instance Alternative Decoder where + {-# INLINE (<|>) #-} + (Decoder a) <|> (Decoder b) = Decoder $ \val -> a val <|> b val + {-# INLINE empty #-} + empty = Decoder $ const empty + +instance MonadFail Decoder where + {-# INLINE fail #-} + fail e = Decoder $ \_ -> fail e + -- | Decode a strict `ByteString` using the simdjson::ondemand bindings. -- Creates simdjson instances on each decode. decodeEither :: Decoder a -> BS.ByteString -> Either HermesException a @@ -139,6 +167,8 @@ parseByteStringIO hEnv d bs = -- It is preferable to use `withHermesEnv` to keep foreign references in scope. -- Be careful using this, the foreign references can be finalized if the -- `HermesEnv` goes out of scope. +-- +-- Do _not_ share a `HermesEnv` across multiple threads. Each thread should get its own. mkHermesEnv :: Maybe Int -> IO HermesEnv mkHermesEnv mCapacity = do parser <- mkSIMDParser mCapacity diff --git a/src/Data/Hermes/Decoder/Time.hs b/src/Data/Hermes/Decoder/Time.hs index 9c0c545..6ee8b36 100644 --- a/src/Data/Hermes/Decoder/Time.hs +++ b/src/Data/Hermes/Decoder/Time.hs @@ -19,11 +19,11 @@ import qualified Data.Time.Calendar.Month.Compat as Time import qualified Data.Time.Calendar.Quarter.Compat as Time import qualified Data.Time.LocalTime as Local -import Data.Hermes.Decoder.Internal (DecoderM, Decoder(..)) +import Data.Hermes.Decoder.Internal (Decoder(..)) import Data.Hermes.Decoder.Value (withText) -- | Run an attoparsec text parser as a hermes decoder. -runAttoDate :: AT.Parser a -> Text -> DecoderM a +runAttoDate :: AT.Parser a -> Text -> Decoder a runAttoDate p t = case AT.parseOnly (p <* AT.endOfInput) t of Left err -> fail $ "Could not parse date: " <> err diff --git a/src/Data/Hermes/Decoder/Value.hs b/src/Data/Hermes/Decoder/Value.hs index 1140f9c..d2902bb 100644 --- a/src/Data/Hermes/Decoder/Value.hs +++ b/src/Data/Hermes/Decoder/Value.hs @@ -18,6 +18,7 @@ module Data.Hermes.Decoder.Value , nullable , objectAsKeyValues , objectAsMap + , parseScientific , scientific , string , text @@ -29,7 +30,6 @@ module Data.Hermes.Decoder.Value , withBool , withDouble , withInt - , withNull , withObject , withObjectAsMap , withRawByteString @@ -37,7 +37,6 @@ module Data.Hermes.Decoder.Value , withString , withText , withType - , withTypeM , withVector ) where @@ -89,44 +88,44 @@ atPointer jptr (Decoder f) = Decoder $ \_ -> do {-# INLINE atPointer #-} -- | Helper to work with an Object parsed from a Value. -withObject :: (Object -> DecoderM a) -> Decoder a +withObject :: (Object -> Decoder a) -> Decoder a withObject f = Decoder $ \valPtr -> withRunInIO $ \ run -> allocaObject $ \oPtr -> do err <- getObjectFromValueImpl valPtr oPtr run $ do handleErrorCode (typePrefix "object") err - f oPtr + runDecoder (f oPtr) valPtr {-# INLINE withObject #-} -- | Helper to work with an Int parsed from a Value. -withInt :: (Int -> DecoderM a) -> Decoder a -withInt f = Decoder $ getInt >=> f +withInt :: (Int -> Decoder a) -> Decoder a +withInt f = Decoder $ \val -> getInt val >>= \i -> runDecoder (f i) val {-# INLINE withInt #-} -- | Helper to work with a Double parsed from a Value. -withDouble :: (Double -> DecoderM a) -> Decoder a -withDouble f = Decoder $ getDouble >=> f +withDouble :: (Double -> Decoder a) -> Decoder a +withDouble f = Decoder $ \val -> getDouble val >>= \d -> runDecoder (f d) val {-# INLINE withDouble #-} -- | Helper to work with a Bool parsed from a Value. -withBool :: (Bool -> DecoderM a) -> Decoder a -withBool f = Decoder $ getBool >=> f +withBool :: (Bool -> Decoder a) -> Decoder a +withBool f = Decoder $ \val -> getBool val >>= \b -> runDecoder (f b) val {-# INLINE withBool #-} -- | Helper to work with the raw ByteString of the JSON token parsed from the given Value. -withRawByteString :: (BS.ByteString -> DecoderM a) -> Decoder a -withRawByteString f = Decoder $ getRawByteString >=> f +withRawByteString :: (BS.ByteString -> Decoder a) -> Decoder a +withRawByteString f = Decoder $ \val -> getRawByteString val >>= \b -> runDecoder (f b) val {-# INLINE withRawByteString #-} -- | Helper to work with a String parsed from a Value. -withString :: (String -> DecoderM a) -> Decoder a -withString f = Decoder $ getString >=> f +withString :: (String -> Decoder a) -> Decoder a +withString f = Decoder $ \val -> getString val >>= \s -> runDecoder (f s) val {-# INLINE withString #-} -- | Helper to work with a Text parsed from a Value. -withText :: (Text -> DecoderM a) -> Decoder a -withText f = Decoder $ getText >=> f +withText :: (Text -> Decoder a) -> Decoder a +withText f = Decoder $ \val -> getText val >>= \t -> runDecoder (f t) val {-# INLINE withText #-} -- | Returns True if the Value is null. @@ -163,32 +162,32 @@ listOfDouble = {-# RULES "list double/listOfDouble" list double = listOfDouble #-} -- | Helper to work with an Array parsed from a Value. -withArray :: (Array -> DecoderM a) -> Decoder a +withArray :: (Array -> Decoder a) -> Decoder a withArray f = Decoder $ \val -> withRunInIO $ \run -> allocaArray $ \arrPtr -> do err <- getArrayFromValueImpl val arrPtr run $ do handleErrorCode (typePrefix "array") err - f arrPtr + runDecoder (f arrPtr) val {-# INLINE withArray #-} -- | Find an object field by key, where an exception is thrown -- if the key is missing. -atKey :: Text -> Decoder a -> Object -> DecoderM a -atKey key parser obj = withUnorderedField parser obj key +atKey :: Text -> Decoder a -> Object -> Decoder a +atKey key parser obj = Decoder . const $ withUnorderedField parser obj key {-# INLINE atKey #-} -- | Find an object field by key, where Nothing is returned -- if the key is missing. -atKeyOptional :: Text -> Decoder a -> Object -> DecoderM (Maybe a) -atKeyOptional key parser obj = withUnorderedOptionalField parser obj key +atKeyOptional :: Text -> Decoder a -> Object -> Decoder (Maybe a) +atKeyOptional key parser obj = Decoder . const $ withUnorderedOptionalField parser obj key {-# INLINE atKeyOptional #-} -- | Uses find_field, which means if you access a field out-of-order -- this will throw an exception. It also cannot support optional fields. -atKeyStrict :: Text -> Decoder a -> Object -> DecoderM a -atKeyStrict key parser obj = withField parser obj key +atKeyStrict :: Text -> Decoder a -> Object -> Decoder a +atKeyStrict key parser obj = Decoder . const $ withField parser obj key {-# INLINE atKeyStrict #-} -- | Parse a homogenous JSON array into a Haskell list. @@ -201,14 +200,14 @@ vector :: G.Vector v a => Decoder a -> Decoder (v a) vector f = withArrayLenIter $ iterateOverArrayLen f {-# INLINE vector #-} -withVector :: G.Vector v a => Decoder a -> (v a -> DecoderM a) -> Decoder a -withVector inner f = Decoder $ runDecoder (vector inner) >=> f +withVector :: G.Vector v a => Decoder a -> (v a -> Decoder a) -> Decoder a +withVector inner f = Decoder $ \val -> runDecoder (vector inner) val >>= \v -> runDecoder (f v) val {-# INLINE withVector #-} -- | Parse an object into a homogenous list of key-value tuples. objectAsKeyValues - :: (Text -> DecoderM k) - -- ^ Parses a Text key in the DecoderM monad. JSON keys are always text. + :: (Text -> Decoder k) + -- ^ Parses a Text key in the Decoder monad. JSON keys are always text. -> Decoder v -- ^ Decoder for the field value. -> Decoder [(k, v)] @@ -218,8 +217,8 @@ objectAsKeyValues kf vf = withObjectIter $ iterateOverFields kf vf -- | Parse an object into a strict `Map`. objectAsMap :: Ord k - => (Text -> DecoderM k) - -- ^ Parses a Text key in the DecoderM monad. JSON keys are always text. + => (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) @@ -228,13 +227,13 @@ objectAsMap kf vf = withObjectIter $ iterateOverFieldsMap kf vf withObjectAsMap :: Ord k - => (Text -> DecoderM k) - -- ^ Parses a Text key in the DecoderM monad. JSON keys are always text. + => (Text -> Decoder k) + -- ^ Parses a Text key in the Decoder monad. JSON keys are always text. -> Decoder v -- ^ Decoder for the field value. - -> (Map k v -> DecoderM a) + -> (Map k v -> Decoder a) -> Decoder a -withObjectAsMap kf vf f = Decoder $ runDecoder (objectAsMap kf vf) >=> f +withObjectAsMap kf vf f = Decoder $ \val -> runDecoder (objectAsMap kf vf) val >>= \m -> runDecoder (f m) val {-# INLINE withObjectAsMap #-} -- | Transforms a parser to return Nothing when the value is null. @@ -246,14 +245,6 @@ nullable parser = Decoder $ \val -> do else Just <$> runDecoder parser val {-# INLINE nullable #-} -withNull :: (Bool -> DecoderM a) -> Decoder a -withNull f = Decoder $ \val -> do - nil <- runDecoder isNull val - if nil - then f True - else f False -{-# INLINE withNull #-} - -- | Parse only a single character. char :: Decoder Char char = Decoder $ getText >=> justOne @@ -297,8 +288,8 @@ scientific :: Decoder Sci.Scientific scientific = withRawByteString parseScientific {-# INLINE scientific #-} -withScientific :: (Sci.Scientific -> DecoderM a) -> Decoder a -withScientific f = Decoder $ runDecoder scientific >=> f +withScientific :: (Sci.Scientific -> Decoder a) -> Decoder a +withScientific f = Decoder $ \val -> runDecoder scientific val >>= \sci -> runDecoder (f sci) val {-# INLINE withScientific #-} -- | Get the simdjson type of the Value. @@ -317,9 +308,13 @@ withType :: (ValueType -> Decoder a) -> Decoder a withType f = Decoder $ \val -> runDecoder getType val >>= \ty -> runDecoder (f ty) val {-# INLINE withType #-} -withTypeM :: (ValueType -> DecoderM a) -> Decoder a -withTypeM f = Decoder $ runDecoder getType >=> f -{-# INLINE withTypeM #-} +-- | Parse a Scientific using attoparsec's ByteString.Char8 parser. +parseScientific :: BS.ByteString -> Decoder Sci.Scientific +parseScientific + = either (\err -> fail $ "Failed to parse Scientific: " <> err) pure + . A.parseOnly (AC.scientific <* A.endOfInput) + . BSC.strip +{-# INLINE parseScientific #-} -- Internal Functions @@ -398,17 +393,17 @@ iterateOverArrayLen f iterPtr len = withObjectIter :: (ObjectIter -> DecoderM a) -> Decoder a withObjectIter f = Decoder $ \valPtr -> withRunInIO $ \run -> - allocaObjectIter $ \iterPtr -> do - err <- getObjectIterFromValueImpl valPtr iterPtr - run $ do - handleErrorCode (typePrefix "object") err - f iterPtr + allocaObjectIter $ \iterPtr -> do + err <- getObjectIterFromValueImpl valPtr iterPtr + run $ do + handleErrorCode (typePrefix "object") err + f iterPtr {-# INLINE withObjectIter #-} -- | Execute a function on each Field in an ObjectIter and accumulate into a `Map`. iterateOverFieldsMap :: Ord a - => (Text -> DecoderM a) + => (Text -> Decoder a) -> Decoder b -> ObjectIter -> DecoderM (Map a b) @@ -430,7 +425,7 @@ iterateOverFieldsMap fk fv iterPtr = (k, v) <- withKey keyTxt $ do - k <- fk keyTxt + k <- runDecoder (fk keyTxt) valPtr v <- runDecoder fv valPtr pure (k, v) liftIO $ objectIterMoveNextImpl iterPtr @@ -442,7 +437,7 @@ iterateOverFieldsMap fk fv iterPtr = -- | Execute a function on each Field in an ObjectIter and -- accumulate key-value tuples into a list. iterateOverFields - :: (Text -> DecoderM a) + :: (Text -> Decoder a) -> Decoder b -> ObjectIter -> DecoderM [(a, b)] @@ -464,7 +459,7 @@ iterateOverFields fk fv iterPtr = kv <- withKey keyTxt $ do - k <- fk keyTxt + k <- runDecoder (fk keyTxt) valPtr v <- runDecoder fv valPtr pure (k, v) liftIO $ objectIterMoveNextImpl iterPtr @@ -486,23 +481,23 @@ withUnorderedField f objPtr key = withUnorderedOptionalField :: Decoder a -> Object -> Text -> DecoderM (Maybe a) withUnorderedOptionalField f objPtr key = withRunInIO $ \run -> - Unsafe.unsafeUseAsCStringLen (T.encodeUtf8 key) $ \(cstr, len) -> - allocaValue $ \vPtr -> run $ withKey key $ do - err <- liftIO $ findFieldUnorderedImpl objPtr cstr len vPtr - let errCode = toEnum $ fromIntegral err - if | errCode == SUCCESS -> Just <$> runDecoder f vPtr - | errCode == NO_SUCH_FIELD -> pure Nothing - | otherwise -> Nothing <$ handleErrorCode "" err + Unsafe.unsafeUseAsCStringLen (T.encodeUtf8 key) $ \(cstr, len) -> + allocaValue $ \vPtr -> run $ withKey key $ do + err <- liftIO $ findFieldUnorderedImpl objPtr cstr len vPtr + let errCode = toEnum $ fromIntegral err + if | errCode == SUCCESS -> Just <$> runDecoder f vPtr + | errCode == NO_SUCH_FIELD -> pure Nothing + | otherwise -> Nothing <$ handleErrorCode "" err {-# INLINE withUnorderedOptionalField #-} withField :: Decoder a -> Object -> Text -> DecoderM a withField f objPtr key = withRunInIO $ \run -> Unsafe.unsafeUseAsCStringLen (T.encodeUtf8 key) $ \(cstr, len) -> - allocaValue $ \vPtr -> run $ withKey key $ do - err <- liftIO $ findFieldImpl objPtr cstr len vPtr + allocaValue $ \val -> run $ withKey key $ do + err <- liftIO $ findFieldImpl objPtr cstr len val handleErrorCode "" err - runDecoder f vPtr + runDecoder f val {-# INLINE withField #-} getInt :: Value -> DecoderM Int @@ -523,14 +518,6 @@ getDouble valPtr = liftIO $ F.peek ptr {-# INLINE getDouble #-} --- | Parse a Scientific using attoparsec's ByteString.Char8 parser. -parseScientific :: BS.ByteString -> DecoderM Sci.Scientific -parseScientific - = either (\err -> fail $ "Failed to parse Scientific: " <> err) pure - . A.parseOnly (AC.scientific <* A.endOfInput) - . BSC.strip -{-# INLINE parseScientific #-} - getBool :: Value -> DecoderM Bool getBool valPtr = withRunInIO $ \run ->