hermes-json 0.2.0.1 → 0.3.0.0

raw patch · 13 files changed

+347/−346 lines, 13 filesdep +system-cxx-std-libdep −unliftiodep −unliftio-corePVP ok

version bump matches the API change (PVP)

Dependencies added: system-cxx-std-lib

Dependencies removed: unliftio, unliftio-core

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• README.md +12/−13
• hermes-json.cabal +11/−8
• src/Data/Hermes.hs +13/−11
• src/Data/Hermes/Decoder.hs +0/−1
• src/Data/Hermes/Decoder/Internal.hs +233/−0
• src/Data/Hermes/Decoder/Path.hs +1/−1
• src/Data/Hermes/Decoder/Time.hs +1/−1
• src/Data/Hermes/Decoder/Types.hs +0/−229
• src/Data/Hermes/Decoder/Value.hs +46/−51
• src/Data/Hermes/SIMDJSON/Bindings.hs +2/−2
• src/Data/Hermes/SIMDJSON/Types.hs +1/−2
• src/Data/Hermes/SIMDJSON/Wrapper.hs +20/−27

@@ -1,5 +1,12 @@ # Revision history for hermes-json +## 0.3.0.0 -- 2023-03-01++* Remove MonadIO and MonadUnliftIO instances for `Decoder`+* Remove unliftio dependency+* Support system-cxx-std-lib for GHC >= 9.4+* Fix GitHub CI badge+ ## 0.2.0.1 -- 2022-10-10  * Add support for GHC 9.4.1

@@ -4,14 +4,14 @@ </h1> <p align="left"> <a href="https://github.com/velveteer/hermes/actions">-  <img src="https://img.shields.io/github/workflow/status/velveteer/hermes/CI?style=for-the-badge" alt="CI badge" />+  <img src="https://img.shields.io/github/actions/workflow/status/velveteer/hermes/ci.yaml?branch=master&style=for-the-badge" alt="CI badge" /> </a> <a href="https://hackage.haskell.org/package/hermes-json">   <img src="https://img.shields.io/hackage/v/hermes-json?label=hackage&style=for-the-badge" alt="Hackage badge" /> </a> </p> -A Haskell interface over the [simdjson](https://github.com/simdjson/simdjson) C++ library for decoding JSON documents. Hermes, messenger of the gods, was the maternal great-grandfather of Jason, son of Aeson. +A Haskell interface over the [simdjson](https://github.com/simdjson/simdjson) C++ library for decoding JSON documents. Hermes, messenger of the gods, was the maternal great-grandfather of Jason, son of Aeson.  ## Overview @@ -25,7 +25,7 @@  > You are working with stable JSON APIs which have a consistent layout and JSON dialect. -With this in mind, `Data.Hermes` parsers can potentially decode Haskell types faster than traditional `Data.Aeson.FromJSON` instances, especially in cases where you only need to decode a subset of the document. This is because `Data.Aeson.FromJSON` converts the entire document into a `Data.Aeson.Value`, which means memory usage increases linearly with the input size. The `simdjson::ondemand` API does not have this constraint because it iterates over the JSON string in memory without constructing an intermediate tree. This means decoders are truly lazy and you only pay for what you use.+With this in mind, `Data.Hermes` parsers can decode Haskell types faster than traditional `Data.Aeson.FromJSON` instances, especially in cases where you only need to decode a subset of the document. This is because `Data.Aeson.FromJSON` converts the entire document into a `Data.Aeson.Value`, which means memory usage increases linearly with the input size. The `simdjson::ondemand` API does not have this constraint because it iterates over the JSON string in memory without constructing an intermediate tree. This means decoders are truly lazy and you only pay for what you use.  ## Usage @@ -56,18 +56,18 @@  When decoding fails for a known reason, you will get a `Left HermesException` indicating if the error came from `simdjson` or from an internal `hermes` call. The exception contains a `DocumentError` record with some useful information, for example: ```haskell-*Main> decodeEither (withObject . atKey "hello" $ list text) "{ \"hello\": [\"world\", false] }" +*Main> decodeEither (withObject . atKey "hello" $ list text) "{ \"hello\": [\"world\", false] }" Left (SIMDException (DocumentError {path = "/hello/1", errorMsg = "Error while getting value of type text. The JSON element does not have the requested type.", docLocation = "false] }", docDebug = "json_iterator [ depth : 3, structural : 'f', offset : 21', error : No error ]"})) ```  ## Benchmarks We benchmark the following operations using both `hermes-json` and `aeson` strict ByteString decoders:-* Decode an array of 1 million 3-element arrays of doubles -* Decode a very small object into a Map -* Full decoding of a large-ish (12 MB) JSON array of objects +* Decode an array of 1 million 3-element arrays of doubles+* Decode a very small object into a Map+* Full decoding of a large-ish (12 MB) JSON array of objects * Partial decoding of Twitter status objects to highlight the on-demand benefits -### Specs +### Specs  * GHC 9.2.1 * aeson-2.0.3.0 with text-2.0@@ -93,7 +93,7 @@ | All.Partial Twitter.Aeson Lazy                      | 14210219600   | 1363261550   | 38167991   | 6912052   | 815792128   | | All.Partial Twitter.Aeson Strict                    | 11107521750   | 697866752    | 38738747   | 4728197   | 815792128   | |                                                     |-<!-- AUTO-GENERATED-CONTENT:END (BENCHES) --> +<!-- AUTO-GENERATED-CONTENT:END (BENCHES) -->  ![](https://raw.githubusercontent.com/velveteer/hermes/master/hermesbench/bench.svg) @@ -117,7 +117,7 @@ | All.Partial Twitter.Aeson Lazy                      | 14504587600   | 979839172    | 38168119   | 6898312   | 815792128   | | All.Partial Twitter.Aeson Strict                    | 11363703650   | 798733766    | 38738875   | 4741485   | 815792128   | |                                                     |-<!-- AUTO-GENERATED-CONTENT:END (BENCHES_THREADED) --> +<!-- AUTO-GENERATED-CONTENT:END (BENCHES_THREADED) -->  ![](https://raw.githubusercontent.com/velveteer/hermes/master/hermesbench/bench_threaded.svg) @@ -127,17 +127,16 @@ * Decode to `Text` instead of `String` wherever possible! * Decode to `Int` or `Double` instead of `Scientific` if you can. * Decode your object fields in order. Out of order field lookups will slightly degrade performance. If encoding with `aeson`, you can leverage `toEncoding` to enforce ordering.-* You can improve performance by holding onto your own `HermesEnv`. `decodeEither` creates and destroys the simdjson instances every time it runs, which adds a performance penalty. Beware, do _not_ share a `HermesEnv` across multiple threads.   ## Limitations -Because the On Demand API uses a forward-only iterator (except for object fields), you must be mindful to not access values out of order. In other words, you should not hold onto a `Value` to parse later since the iterator may have already moved beyond it. +Because the On Demand API uses a forward-only iterator (except for object fields), you must be mindful to not access values out of order. In other words, you should not hold onto a `Value` to parse later since the iterator may have already moved beyond it.  Because the On Demand API does not validate the entire document upon creating the iterator (besides UTF-8 validation and basic well-formed checks), it is possible to parse an invalid JSON document but not realize it until later. If you need the entire document to be validated up front then a DOM parser is a better fit for you.  > The On Demand approach is less safe than DOM: we only validate the components of the JSON document that are used and it is possible to begin ingesting an invalid document only to find out later that the document is invalid. Are you fine ingesting a large JSON document that starts with well formed JSON but ends with invalid JSON content? -This library currently cannot decode scalar documents, e.g. a single string, number, boolean, or null as a JSON document. +This library currently cannot decode scalar documents, e.g. a single string, number, boolean, or null as a JSON document.  ## Portability 

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               hermes-json-version:            0.2.0.1+version:            0.3.0.0 category:           Text, Web, JSON, FFI synopsis:           Fast JSON decoding via simdjson C++ bindings description:@@ -51,12 +51,13 @@     Data.Hermes.Decoder     Data.Hermes.Decoder.Path     Data.Hermes.Decoder.Time-    Data.Hermes.Decoder.Types     Data.Hermes.Decoder.Value     Data.Hermes.SIMDJSON     Data.Hermes.SIMDJSON.Bindings     Data.Hermes.SIMDJSON.Types     Data.Hermes.SIMDJSON.Wrapper+  other-modules:+    Data.Hermes.Decoder.Internal   build-depends:     attoparsec         >= 0.13.1 && < 0.15,     attoparsec-iso8601 >= 1.0.2.0 && < 1.0.3.0,@@ -69,9 +70,7 @@     text               >= 1.2.3.0 && < 1.3 || >= 2.0 && < 2.1,     transformers       >= 0.5.6 && < 0.6,     time               >= 1.9.3 && < 1.13,-    time-compat        >= 1.9.5 && < 1.10,-    unliftio           >= 0.2.14 && < 0.3,-    unliftio-core      >= 0.2.0 && < 0.3+    time-compat        >= 1.9.5 && < 1.10    hs-source-dirs:   src   default-language: Haskell2010@@ -91,7 +90,6 @@       -Wredundant-constraints       -Wpartial-fields       -Wmissed-specialisations-      -Wunused-packages   else     ghc-options: -Wall   cxx-sources:@@ -111,8 +109,13 @@     cbits   install-includes:     cbits/simdjson/simdjson.h-  extra-libraries:-    stdc+++  if impl(ghc >= 9.4)+    build-depends: system-cxx-std-lib == 1.0+  elif os(darwin) || os(freebsd)+    extra-libraries: c+++  else+    extra-libraries:+      stdc++  test-suite hermes-test   default-language: Haskell2010

@@ -6,10 +6,10 @@ -- when it's passed by reference across the C FFI. -- -- `decodeEither` provides the quickest way to feed the initial `Value` to your decoder.--- It does this by using `withDocumentValue` to obtain a top-level `Value` from the--- simdjson document instance. Decoding a document into a scalar from a `Value` is not--- supported by simdjson. While simdjson can cast a document directly to a scalar, this library--- currently exposes no interface for this.+-- It does this by obtaining a top-level `Value` from the simdjson document+-- instance. Decoding a document into a scalar from a `Value` is not supported+-- by simdjson. While simdjson can cast a document directly to a scalar, this+-- library currently exposes no interface for this.  module Data.Hermes   ( -- * Decoding from ByteString input@@ -17,8 +17,6 @@     -- * Decoder monad   , Decoder(runDecoder)   , HermesEnv-  , withHermesEnv-  , withInputBuffer     -- * Object field accessors     -- | Obtain an object using `withObject` that can be passed     -- to these field lookup functions.@@ -76,19 +74,23 @@   , Value   ) where +import           Control.Exception (try) import           Control.Monad.Trans.Reader (ReaderT(..), runReaderT) import           Data.ByteString (ByteString) import qualified System.IO.Unsafe as Unsafe-import           UnliftIO.Exception (try)  import           Data.Hermes.Decoder+import           Data.Hermes.Decoder.Internal+  ( Decoder(..)+  , DocumentError(..)+  , HermesEnv+  , HermesException(..)+  , withHermesEnv+  ) import           Data.Hermes.SIMDJSON.Types import           Data.Hermes.SIMDJSON.Wrapper (withInputBuffer) ---- | Construct a `HermesEnv` and use it to run a `Decoder` via the C FFI.--- There is a small performance penalty for creating and destroying the simdjson--- instances on each decode, so this is not recommended for running in tight loops.+-- | Decode a strict `ByteString` using the simdjson::ondemand bindings. decodeEither :: (Value -> Decoder a) -> ByteString -> Either HermesException a decodeEither d bs =   Unsafe.unsafePerformIO . try .  withHermesEnv $ \hEnv ->

@@ -4,5 +4,4 @@  import           Data.Hermes.Decoder.Path as Export import           Data.Hermes.Decoder.Time as Export-import           Data.Hermes.Decoder.Types as Export import           Data.Hermes.Decoder.Value as Export

@@ -0,0 +1,233 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Data.Hermes.Decoder.Internal+  ( Decoder(..)+  , HermesEnv(..)+  , HermesException(..)+  , DocumentError(..)+  , withHermesEnv+  , allocaArray+  , allocaArrayIter+  , allocaObject+  , allocaObjectIter+  , allocaValue+  , typePrefix+  , handleErrorCode+  , withParserPointer+  , withDocumentPointer+  , liftIO+  , withRunInIO+  ) where++import           Control.Applicative (Alternative(..))+import           Control.DeepSeq (NFData)+import           Control.Exception (Exception, bracket, catch, throwIO)+import           Control.Monad.Reader (MonadReader, asks)+import           Control.Monad.Trans.Class (lift)+import           Control.Monad.Trans.Reader (ReaderT(..))+import           Data.Text (Text)+import qualified Data.Text as T+import qualified Foreign.C as F+import qualified Foreign.ForeignPtr as F+import qualified Foreign.Marshal.Alloc as F+import qualified Foreign.Ptr as F+import           GHC.Generics (Generic)++import           Data.Hermes.SIMDJSON.Bindings (getErrorMessageImpl)+import           Data.Hermes.SIMDJSON.Types+  ( Array(..)+  , ArrayIter(..)+  , Document(..)+  , Object(..)+  , ObjectIter(..)+  , Parser(..)+  , SIMDDocument+  , SIMDErrorCode(..)+  , SIMDParser+  , Value(..)+  )+import           Data.Hermes.SIMDJSON.Wrapper++-- | A Decoder is some context around the IO needed by the C FFI to allocate local memory.+-- Users have no access to the underlying IO, since this could allow decoders to launch nukes.+-- Using `Data.Hermes.decodeEither` discharges the IO and returns us to purity,+-- since we know decoding a document is referentially transparent.+newtype Decoder a = Decoder { runDecoder :: ReaderT HermesEnv IO a }+  deriving newtype+    ( Functor+    , Applicative+    , Monad+    , MonadReader HermesEnv+    )++instance Alternative Decoder where+  empty = fail "Unspecified error"+  ad <|> bd = withRunInIO $ \u -> u ad `catch` (\(_err :: HermesException) -> u bd)++instance MonadFail Decoder where+  {-# INLINE fail #-}+  fail = throwHermes . T.pack++-- | Contains foreign references to the allocated simdjson::parser+-- and simdjson::document. Also maintains a path string that is updated+-- when an object field or array value is entered and which is displayed in errors.+data HermesEnv =+  HermesEnv+    { hParser   :: !(F.ForeignPtr SIMDParser)+    , hDocument :: !(F.ForeignPtr SIMDDocument)+    , hPath     :: !Text+    }++-- | Make a new HermesEnv. This allocates foreign references to+-- a simdjson::ondemand::parser and a simdjson::ondemand::document.+-- The optional capacity argument sets the max capacity in bytes for the+-- simdjson::ondemand::parser, which defaults to 4GB.+mkHermesEnv :: Maybe Int -> IO HermesEnv+mkHermesEnv mCapacity = do+  parser   <- mkSIMDParser mCapacity+  document <- mkSIMDDocument+  pure HermesEnv+    { hParser   = parser+    , hDocument = document+    , hPath     = ""+    }++-- | Shortcut for constructing a default `HermesEnv`.+mkHermesEnv_ :: IO HermesEnv+mkHermesEnv_ = mkHermesEnv Nothing++-- | Internal finalizer for simdjson instances.+cleanupHermesEnv :: HermesEnv -> IO ()+cleanupHermesEnv hEnv = do+  F.finalizeForeignPtr (hDocument hEnv)+  F.finalizeForeignPtr (hParser hEnv)++-- | Run an action in IO that is passed a `HermesEnv`.+withHermesEnv :: (HermesEnv -> IO a) -> IO a+withHermesEnv = bracket acquire release+  where+    acquire = mkHermesEnv_+    release = cleanupHermesEnv++-- | The library can throw exceptions from simdjson in addition to+-- its own exceptions.+data HermesException =+    SIMDException DocumentError+    -- ^ An exception thrown from the simdjson library.+  | InternalException DocumentError+    -- ^ An exception thrown from an internal library function.+  deriving stock (Eq, Show, Generic)++instance Exception HermesException+instance NFData HermesException++-- | Record containing all pertinent information for troubleshooting an exception.+data DocumentError =+  DocumentError+    { path        :: !Text+    -- ^ The path to the current element determined by the decoder.+    -- Formatted in the JSON Pointer standard per RFC 6901.+    , errorMsg    :: !Text+    -- ^ An error message.+    , docLocation :: !Text+    -- ^ Truncated location of the simdjson document iterator.+    , docDebug    :: !Text+    -- ^ Debug information from simdjson::document.+    }+    deriving stock (Eq, Show, Generic)++instance NFData DocumentError++mkDocumentError :: Text -> Text -> Text -> Text -> DocumentError+mkDocumentError pth msg locStr debugStr = DocumentError pth msg (T.take 20 locStr) debugStr++typePrefix :: Text -> Text+typePrefix typ = "Error while getting value of type " <> typ <> ". "++-- | Re-throw an exception caught from the simdjson library.+throwSIMD :: SIMDErrorCode -> Text -> Decoder a+throwSIMD errCode msg = do+  pth <- asks hPath+  if errCode `elem`+    [ EMPTY+    , INSUFFICIENT_PADDING+    , SCALAR_DOCUMENT_AS_VALUE+    , UTF8_ERROR+    , UNCLOSED_STRING+    , UNESCAPED_CHARS+    ]+  then+    liftIO . throwIO . SIMDException $+      mkDocumentError pth msg "" ""+  else do+    withDocumentPointer $ \docPtr -> do+      (locTxt, debugTxt) <- liftIO $ getDocumentInfo docPtr+      liftIO . throwIO . SIMDException $+        mkDocumentError pth msg locTxt debugTxt++-- | Throw an IO exception in the `Decoder` context.+throwHermes :: Text -> Decoder a+throwHermes msg = do+  pth <- asks hPath+  liftIO . throwIO . InternalException $+    mkDocumentError pth msg "" ""++handleErrorCode :: Text -> F.CInt -> Decoder ()+handleErrorCode pre errInt = do+  let errCode = toEnum $ fromIntegral errInt+  if errCode == SUCCESS+  then pure ()+  else do+    errStr <- liftIO $ F.peekCString =<< getErrorMessageImpl errInt+    throwSIMD errCode $ pre <> T.pack errStr+{-# INLINE handleErrorCode #-}++withParserPointer :: (Parser -> Decoder a) -> Decoder a+withParserPointer f =+  asks hParser >>= \parserFPtr -> withRunInIO $ \u -> F.withForeignPtr parserFPtr $ u . f . Parser+{-# INLINE withParserPointer #-}++withDocumentPointer :: (Document -> Decoder a) -> Decoder a+withDocumentPointer f =+  asks hDocument >>= \docFPtr -> withRunInIO $ \u -> F.withForeignPtr docFPtr $ u . f . Document+{-# INLINE withDocumentPointer #-}++allocaValue :: (Value -> Decoder a) -> Decoder a+allocaValue f = allocaBytes 24 $ \val -> f (Value val)+{-# INLINE allocaValue #-}++allocaObject :: (Object -> Decoder a) -> Decoder a+allocaObject f = allocaBytes 24 $ \objPtr -> f (Object objPtr)+{-# INLINE allocaObject #-}++allocaArray :: (Array -> Decoder a) -> Decoder a+allocaArray f = allocaBytes 24 $ \arr -> f (Array arr)+{-# INLINE allocaArray #-}++allocaArrayIter :: (ArrayIter -> Decoder a) -> Decoder a+allocaArrayIter f = allocaBytes 24 $ \iter -> f (ArrayIter iter)+{-# INLINE allocaArrayIter #-}++allocaObjectIter :: (ObjectIter -> Decoder a) -> Decoder a+allocaObjectIter f = allocaBytes 24 $ \iter -> f (ObjectIter iter)+{-# INLINE allocaObjectIter #-}++allocaBytes :: Int -> (F.Ptr a -> Decoder b) -> Decoder b+allocaBytes size action = withRunInIO (\u -> F.allocaBytes size (u . action))+{-# INLINE allocaBytes #-}++withRunInIO :: ((forall a. Decoder a -> IO a) -> IO b) -> Decoder b+withRunInIO inner =+  Decoder . ReaderT $ \r ->+    inner (flip runReaderT r . runDecoder)+{-# INLINE withRunInIO #-}++liftIO :: IO a -> Decoder a+liftIO = Decoder . lift+{-# INLINE liftIO #-}

@@ -10,7 +10,7 @@ import           Data.Text (Text) import qualified Data.Text as T -import           Data.Hermes.Decoder.Types (Decoder, HermesEnv(hPath))+import           Data.Hermes.Decoder.Internal (Decoder, HermesEnv(hPath))  withPath :: Text -> Decoder a -> Decoder a withPath key =

@@ -19,7 +19,7 @@ import qualified Data.Time.Calendar.Quarter.Compat as Time import qualified Data.Time.LocalTime as Local -import           Data.Hermes.Decoder.Types (Decoder)+import           Data.Hermes.Decoder.Internal (Decoder) import           Data.Hermes.Decoder.Value (withText) import           Data.Hermes.SIMDJSON 

@@ -1,229 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables #-}---- | `Decoder` is the monad used for decoding JSON with simdjson via the FFI.--- This module contains helpers for working with the `Decoder` context.--module Data.Hermes.Decoder.Types-  ( Decoder(runDecoder)-  , HermesEnv(..)-  , HermesException(..)-  , DocumentError(path, errorMsg, docLocation, docDebug)-  , allocaValue-  , allocaArray-  , allocaArrayIter-  , allocaObject-  , allocaObjectIter-  , handleErrorCode-  , typePrefix-  , withDocumentPointer-  , withParserPointer-  , withHermesEnv-  ) where--import           Control.Applicative (Alternative(..))-import           Control.DeepSeq (NFData)-import           Control.Monad.IO.Class (MonadIO, liftIO)-import           Control.Monad.IO.Unlift (MonadUnliftIO)-import           Control.Monad.Reader (MonadReader, asks)-import           Control.Monad.Trans.Reader (ReaderT)-import           Data.Text (Text)-import qualified Data.Text as T-import           GHC.Generics (Generic)-import           UnliftIO.Exception (Exception, bracket, catch, throwIO)-import           UnliftIO.Foreign-  ( CInt-  , ForeignPtr-  , allocaBytes-  , finalizeForeignPtr-  , peekCString-  , withForeignPtr-  )--import           Data.Hermes.SIMDJSON.Bindings (getErrorMessageImpl)-import           Data.Hermes.SIMDJSON.Types-  ( Array(..)-  , ArrayIter(..)-  , Document(..)-  , Object(..)-  , ObjectIter(..)-  , Parser(..)-  , SIMDDocument-  , SIMDErrorCode(..)-  , SIMDParser-  , Value(..)-  )-import           Data.Hermes.SIMDJSON.Wrapper---- | A Decoder is some context around the IO needed by the C FFI to allocate local memory.--- Users shouldn't need to deal with the underlying IO except in advanced use cases.--- Using `Data.Hermes.decodeEither` discharges the IO and returns us to purity,--- since we know decoding a document is referentially transparent.-newtype Decoder a = Decoder { runDecoder :: ReaderT HermesEnv IO a }-  deriving newtype-    ( Functor-    , Applicative-    , Monad-    , MonadIO-    , MonadReader HermesEnv-    , MonadUnliftIO-    )--instance Alternative Decoder where-  empty = fail "Unspecified error"-  ad <|> bd = ad `catch` (\(_err :: HermesException) -> bd)--instance MonadFail Decoder where-  {-# INLINE fail #-}-  fail = throwHermes . T.pack---- | Contains foreign references to the allocated simdjson::parser--- and simdjson::document. Also maintains a path string that is updated--- when an object field or array value is entered and which is displayed in errors.-data HermesEnv =-  HermesEnv-    { hParser   :: !(ForeignPtr SIMDParser)-    , hDocument :: !(ForeignPtr SIMDDocument)-    , hPath     :: !Text-    }---- | Make a new HermesEnv. This allocates foreign references to--- a simdjson::ondemand::parser and a simdjson::ondemand::document.--- The optional capacity argument sets the max capacity in bytes for the--- simdjson::ondemand::parser, which defaults to 4GB.-mkHermesEnv :: Maybe Int -> IO HermesEnv-mkHermesEnv mCapacity = do-  parser   <- mkSIMDParser mCapacity-  document <- mkSIMDDocument-  pure HermesEnv-    { hParser   = parser-    , hDocument = document-    , hPath     = ""-    }---- | Shortcut for constructing a default `HermesEnv`.-mkHermesEnv_ :: IO HermesEnv-mkHermesEnv_ = mkHermesEnv Nothing---- | Internal finalizer for simdjson instances.-cleanupHermesEnv :: HermesEnv -> IO ()-cleanupHermesEnv hEnv = do-  finalizeForeignPtr (hDocument hEnv)-  finalizeForeignPtr (hParser hEnv)---- | Run an action that is passed a `HermesEnv`.--- The simdjson instances are created and destroyed using the `bracket` function.-withHermesEnv :: MonadUnliftIO m => (HermesEnv -> m a) -> m a-withHermesEnv = bracket acquire release-  where-    acquire = liftIO mkHermesEnv_-    release = liftIO . cleanupHermesEnv---- | The library can throw exceptions from simdjson in addition to--- its own exceptions.-data HermesException =-    SIMDException DocumentError-    -- ^ An exception thrown from the simdjson library.-  | InternalException DocumentError-    -- ^ An exception thrown from an internal library function.-  deriving stock (Eq, Show, Generic)--instance Exception HermesException-instance NFData HermesException---- | Record containing all pertinent information for troubleshooting an exception.-data DocumentError =-  DocumentError-    { path        :: !Text-    -- ^ The path to the current element determined by the decoder.-    -- Formatted in the JSON Pointer standard per RFC 6901.-    , errorMsg    :: !Text-    -- ^ An error message.-    , docLocation :: !Text-    -- ^ Truncated location of the simdjson document iterator.-    , docDebug    :: !Text-    -- ^ Debug information from simdjson::document.-    }-    deriving stock (Eq, Show, Generic)--instance NFData DocumentError--mkDocumentError :: Text -> Text -> Text -> Text -> DocumentError-mkDocumentError pth msg locStr debugStr = DocumentError pth msg (T.take 20 locStr) debugStr--typePrefix :: Text -> Text-typePrefix typ = "Error while getting value of type " <> typ <> ". "---- | Re-throw an exception caught from the simdjson library.-throwSIMD :: SIMDErrorCode -> Text -> Decoder a-throwSIMD errCode msg = do-  pth <- asks hPath-  if errCode `elem`-    [ EMPTY-    , INSUFFICIENT_PADDING-    , SCALAR_DOCUMENT_AS_VALUE-    , UTF8_ERROR-    , UNCLOSED_STRING-    , UNESCAPED_CHARS-    ]-  then-    liftIO . throwIO . SIMDException $-      mkDocumentError pth msg "" ""-  else do-    withDocumentPointer $ \docPtr -> do-      (locTxt, debugTxt) <- liftIO $ getDocumentInfo docPtr-      liftIO . throwIO . SIMDException $-        mkDocumentError pth msg locTxt debugTxt---- | Throw an IO exception in the `Decoder` context.-throwHermes :: Text -> Decoder a-throwHermes msg = do-  pth <- asks hPath-  liftIO . throwIO . InternalException $-    mkDocumentError pth msg "" ""---- Foreign helpers--handleErrorCode :: Text -> CInt -> Decoder ()-handleErrorCode pre errInt = do-  let errCode = toEnum $ fromIntegral errInt-  if errCode == SUCCESS-  then pure ()-  else do-    errStr <- peekCString =<< liftIO (getErrorMessageImpl errInt)-    throwSIMD errCode $ pre <> T.pack errStr-{-# INLINE handleErrorCode #-}--withParserPointer :: (Parser -> Decoder a) -> Decoder a-withParserPointer f =-  asks hParser >>= \parserFPtr -> withForeignPtr parserFPtr $ f . Parser-{-# INLINE withParserPointer #-}--withDocumentPointer :: (Document -> Decoder a) -> Decoder a-withDocumentPointer f =-  asks hDocument >>= \docFPtr -> withForeignPtr docFPtr $ f . Document-{-# INLINE withDocumentPointer #-}--allocaValue :: (Value -> Decoder a) -> Decoder a-allocaValue f = allocaBytes 24 $ \val -> f (Value val)-{-# INLINE allocaValue #-}--allocaObject :: (Object -> Decoder a) -> Decoder a-allocaObject f = allocaBytes 24 $ \objPtr -> f (Object objPtr)-{-# INLINE allocaObject #-}--allocaArray :: (Array -> Decoder a) -> Decoder a-allocaArray f = allocaBytes 24 $ \arr -> f (Array arr)-{-# INLINE allocaArray #-}--allocaArrayIter :: (ArrayIter -> Decoder a) -> Decoder a-allocaArrayIter f = allocaBytes 24 $ \iter -> f (ArrayIter iter)-{-# INLINE allocaArrayIter #-}--allocaObjectIter :: (ObjectIter -> Decoder a) -> Decoder a-allocaObjectIter f = allocaBytes 24 $ \iter -> f (ObjectIter iter)-{-# INLINE allocaObjectIter #-}

@@ -33,8 +33,6 @@   ) where  import           Control.Monad ((>=>))-import           Control.Monad.IO.Class (liftIO)-import           Control.Monad.IO.Unlift (withRunInIO) import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.ByteString.Char8 as AC (scientific) import qualified Data.ByteString as BS@@ -47,19 +45,16 @@ import qualified Data.Text.Encoding as T #if MIN_VERSION_text(2,0,0) import qualified Data.Text.Foreign as T+import qualified Foreign.Ptr as F #endif-import           UnliftIO.Foreign-  ( CStringLen-  , alloca-  , peek-  , peekArray-  , peekCStringLen-  , toBool-  )-import qualified UnliftIO.Foreign as Foreign+import qualified Foreign.C.String as F+import qualified Foreign.Marshal.Alloc as F+import qualified Foreign.Marshal.Array as F+import qualified Foreign.Marshal.Utils as F+import qualified Foreign.Storable as F +import           Data.Hermes.Decoder.Internal import           Data.Hermes.Decoder.Path-import           Data.Hermes.Decoder.Types import           Data.Hermes.SIMDJSON  -- | Parse the given input into a document iterator, get its@@ -106,20 +101,19 @@ -- accumulate key-value tuples into a list. iterateOverFields :: (Text -> Decoder a) -> (Value -> Decoder b) -> ObjectIter -> Decoder [(a, b)] iterateOverFields fk fv iterPtr = withRunInIO $ \runInIO ->-  alloca $ \lenPtr ->-  alloca $ \keyPtr -> runInIO $+  F.alloca $ \lenPtr ->+  F.alloca $ \keyPtr -> runInIO $   allocaValue $ \valPtr ->   go DList.empty keyPtr lenPtr valPtr   where-    {-# INLINE go #-}     go !acc keyPtr lenPtr valPtr = do-      isOver <- fmap toBool . liftIO $ objectIterIsDoneImpl iterPtr+      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 $ peek lenPtr-          kStr <- liftIO $ peek keyPtr+          kLen <- fmap fromIntegral . liftIO $ F.peek lenPtr+          kStr <- liftIO $ F.peek keyPtr           keyTxt <- parseTextFromCStrLen (kStr, kLen)           withPath (dot keyTxt) $ do             k <- fk keyTxt@@ -161,10 +155,10 @@  getInt :: Value -> Decoder Int getInt valPtr = withRunInIO $ \run ->-  alloca $ \ptr -> run $ do+  F.alloca $ \ptr -> run $ do     err <- liftIO $ getIntImpl valPtr ptr     handleErrorCode (typePrefix "int") err-    liftIO $ peek ptr+    liftIO $ F.peek ptr {-# INLINE getInt #-}  -- | Helper to work with an Int parsed from a Value.@@ -173,10 +167,10 @@  getDouble :: Value -> Decoder Double getDouble valPtr = withRunInIO $ \run ->-  alloca $ \ptr -> run $ do+  F.alloca $ \ptr -> run $ do     err <- liftIO $ getDoubleImpl valPtr ptr     handleErrorCode (typePrefix "double") err-    liftIO $ peek ptr+    liftIO $ F.peek ptr {-# INLINE getDouble #-}  -- | Helper to work with a Double parsed from a Value.@@ -193,29 +187,29 @@  getBool :: Value -> Decoder Bool getBool valPtr = withRunInIO $ \run ->-  alloca $ \ptr -> run $ do+  F.alloca $ \ptr -> run $ do     err <- liftIO $ getBoolImpl valPtr ptr     handleErrorCode (typePrefix "bool") err-    fmap toBool . liftIO $ peek ptr+    fmap F.toBool . liftIO $ F.peek ptr {-# INLINE getBool #-}  -- | Helper to work with a Bool parsed from a Value. withBool :: (Bool -> Decoder a) -> Value -> Decoder a withBool f = getBool >=> f -withCStringLen :: Text -> (CStringLen -> Decoder a) -> Value -> Decoder a+withCStringLen :: Text -> (F.CStringLen -> Decoder a) -> Value -> Decoder a withCStringLen lbl f valPtr = withRunInIO $ \run ->-  alloca $ \strPtr ->-  alloca $ \lenPtr -> run $ do+  F.alloca $ \strPtr ->+  F.alloca $ \lenPtr -> run $ do     err <- liftIO $ getStringImpl valPtr strPtr lenPtr     handleErrorCode (typePrefix lbl) err-    len <- fmap fromIntegral . liftIO $ peek lenPtr-    str <- liftIO $ peek strPtr+    len <- fmap fromIntegral . liftIO $ F.peek lenPtr+    str <- liftIO $ F.peek strPtr     f (str, len) {-# INLINE withCStringLen #-}  getString :: Value -> Decoder String-getString = withCStringLen "string" (liftIO . peekCStringLen)+getString = withCStringLen "string" (liftIO . F.peekCStringLen) {-# INLINE getString #-}  getText :: Value -> Decoder Text@@ -223,12 +217,12 @@ {-# INLINE getText #-}  #if MIN_VERSION_text(2,0,0)-parseTextFromCStrLen :: CStringLen -> Decoder Text-parseTextFromCStrLen (cstr, len) = liftIO $ T.fromPtr (Foreign.castPtr cstr) (fromIntegral len)+parseTextFromCStrLen :: F.CStringLen -> Decoder Text+parseTextFromCStrLen (cstr, len) = liftIO $ T.fromPtr (F.castPtr cstr) (fromIntegral len) {-# INLINE parseTextFromCStrLen #-} #else -parseTextFromCStrLen :: CStringLen -> Decoder Text+parseTextFromCStrLen :: F.CStringLen -> Decoder Text parseTextFromCStrLen cstr = do   bs <- liftIO $ Unsafe.unsafePackCStringLen cstr   case A.parseOnly asciiTextAtto bs of@@ -250,11 +244,11 @@  getRawByteString :: Value -> Decoder BS.ByteString getRawByteString valPtr = withRunInIO $ \run ->-  alloca $ \strPtr ->-  alloca $ \lenPtr -> run $ do+  F.alloca $ \strPtr ->+  F.alloca $ \lenPtr -> run $ do     liftIO $ getRawJSONTokenImpl valPtr strPtr lenPtr-    len <- fmap fromIntegral . liftIO $ peek lenPtr-    str <- liftIO $ peek strPtr+    len <- fmap fromIntegral . liftIO $ F.peek lenPtr+    str <- liftIO $ F.peek strPtr     liftIO $ Unsafe.unsafePackCStringLen (str, len) {-# INLINE getRawByteString #-} @@ -273,7 +267,7 @@  -- | Returns True if the Value is null. isNull :: Value -> Decoder Bool-isNull valPtr = fmap toBool . liftIO $ isNullImpl valPtr+isNull valPtr = fmap F.toBool . liftIO $ isNullImpl valPtr {-# INLINE isNull #-}  -- | Helper to work with an Array and its length parsed from a Value.@@ -281,10 +275,10 @@ withArrayLen f val =   allocaArray $ \arrPtr ->   withRunInIO $ \run ->-  alloca $ \outLen -> run $ do+  F.alloca $ \outLen -> run $ do     err <- liftIO $ getArrayLenFromValueImpl val arrPtr outLen     handleErrorCode (typePrefix "array") err-    len <- fmap fromIntegral . liftIO $ peek outLen+    len <- fmap fromIntegral . liftIO $ F.peek outLen     f (arrPtr, len) {-# INLINE withArrayLen #-} @@ -292,20 +286,22 @@ listOfInt :: Value -> Decoder [Int] listOfInt =   withArrayLen $ \(arrPtr, len) ->-  Foreign.allocaArray len $ \out -> do-    err <- liftIO $ intArrayImpl arrPtr out-    handleErrorCode "Error decoding array of ints." err-    liftIO $ peekArray len out+  withRunInIO $ \run ->+  F.allocaArray len $ \out -> do+    err <- intArrayImpl arrPtr out+    run $ handleErrorCode "Error decoding array of ints." err+    F.peekArray len out {-# RULES "list int/listOfInt" list int = listOfInt #-}  -- | Is more efficient by looping in C++ instead of Haskell. listOfDouble :: Value -> Decoder [Double] listOfDouble =   withArrayLen $ \(arrPtr, len) ->-  Foreign.allocaArray len $ \out -> do-    err <- liftIO $ doubleArrayImpl arrPtr out-    handleErrorCode "Error decoding array of doubles." err-    liftIO $ peekArray len out+  withRunInIO $ \run ->+  F.allocaArray len $ \out -> do+    err <- doubleArrayImpl arrPtr out+    run $ handleErrorCode "Error decoding array of doubles." err+    F.peekArray len out {-# RULES "list double/listOfDouble" list double = listOfDouble #-}  -- | Helper to work with an Array parsed from a Value.@@ -331,9 +327,8 @@ iterateOverArray f iterPtr =   allocaValue $ \valPtr -> go (0 :: Int) DList.empty valPtr   where-    {-# INLINE go #-}     go !n !acc valPtr = do-      isOver <- fmap toBool . liftIO $ arrayIterIsDoneImpl iterPtr+      isOver <- fmap F.toBool . liftIO $ arrayIterIsDoneImpl iterPtr       if not isOver         then withPathIndex n $ do           err <- liftIO $ arrayIterGetCurrentImpl iterPtr valPtr@@ -406,7 +401,7 @@ bool :: Value -> Decoder Bool bool = getBool --- | Parse a JSON number into an unsigned Haskell Int.+-- | Parse a JSON number into a signed Haskell Int. int :: Value -> Decoder Int int = getInt {-# INLINE[2] int #-}

@@ -35,7 +35,8 @@   , toDebugStringImpl   ) where -import           UnliftIO.Foreign (CBool(..), CInt(..), CSize(..), CString, FunPtr, Ptr)+import           Foreign.C (CBool(..), CInt(..), CSize(..), CString)+import           Foreign.Ptr (FunPtr, Ptr)  import           Data.Hermes.SIMDJSON.Types @@ -138,4 +139,3 @@  foreign import ccall unsafe "get_raw_json_token" getRawJSONTokenImpl   :: Value -> Ptr CString -> Ptr CSize -> IO ()-

@@ -20,7 +20,7 @@   )   where -import           UnliftIO.Foreign (Ptr)+import           Foreign.Ptr (Ptr)  -- | A reference to an opaque simdjson::ondemand::parser. newtype Parser = Parser (Ptr SIMDParser)@@ -104,4 +104,3 @@   | OUT_OF_BOUNDS   | NUM_ERROR_CODES   deriving (Eq, Show, Bounded, Enum)-

@@ -15,18 +15,11 @@ import           Data.Maybe (fromMaybe) import           Data.Text (Text) import qualified Data.Text as T-import           UnliftIO.Exception (bracket, mask_)-import           UnliftIO.Foreign-  ( ForeignPtr-  , alloca-  , allocaBytes-  , finalizeForeignPtr-  , newForeignPtr-  , peek-  , peekCString-  , peekCStringLen-  , withForeignPtr-  )+import           Control.Exception (bracket, mask_)+import qualified Foreign.C as F+import qualified Foreign.ForeignPtr as F+import qualified Foreign.Marshal.Alloc as F+import qualified Foreign.Storable as F  import           Data.Hermes.SIMDJSON.Bindings   ( currentLocationImpl@@ -47,43 +40,43 @@   , SIMDParser   ) -mkSIMDParser :: Maybe Int -> IO (ForeignPtr SIMDParser)+mkSIMDParser :: Maybe Int -> IO (F.ForeignPtr SIMDParser) mkSIMDParser mCap = mask_ $ do   let maxCap = 4000000000; -- 4GB   ptr <- parserInit . toEnum $ fromMaybe maxCap mCap-  newForeignPtr parserDestroy ptr+  F.newForeignPtr parserDestroy ptr -mkSIMDDocument :: IO (ForeignPtr SIMDDocument)+mkSIMDDocument :: IO (F.ForeignPtr SIMDDocument) mkSIMDDocument = mask_ $ do   ptr <- makeDocumentImpl-  newForeignPtr deleteDocumentImpl ptr+  F.newForeignPtr deleteDocumentImpl ptr -mkSIMDPaddedStr :: ByteString -> IO (ForeignPtr PaddedString)+mkSIMDPaddedStr :: ByteString -> IO (F.ForeignPtr PaddedString) mkSIMDPaddedStr input = mask_ $   Unsafe.unsafeUseAsCStringLen input $ \(cstr, len) -> do     ptr <- makeInputImpl cstr (fromIntegral len)-    newForeignPtr deleteInputImpl ptr+    F.newForeignPtr deleteInputImpl ptr  -- | Construct a simdjson:padded_string from a Haskell `ByteString`, and pass--- it to a monadic action. The instance lifetime is managed by the `bracket` function.+-- it to an IO action. The instance lifetime is managed by the `bracket` function. withInputBuffer :: ByteString -> (InputBuffer -> IO a) -> IO a withInputBuffer bs f =-  bracket acquire release $ \fPtr -> withForeignPtr fPtr $ f . InputBuffer+  bracket acquire release $ \fPtr -> F.withForeignPtr fPtr $ f . InputBuffer   where-    acquire = liftIO $ mkSIMDPaddedStr bs-    release = liftIO . finalizeForeignPtr+    acquire = mkSIMDPaddedStr bs+    release = F.finalizeForeignPtr  -- | Read the document location and debug string. If the iterator is out of bounds -- then we abort reading from the iterator buffers to prevent reading garbage. getDocumentInfo :: Document -> IO (Text, Text)-getDocumentInfo docPtr = alloca $ \locStrPtr -> alloca $ \lenPtr -> do+getDocumentInfo docPtr = F.alloca $ \locStrPtr -> F.alloca $ \lenPtr -> do   err <- liftIO $ currentLocationImpl docPtr locStrPtr   let errCode = toEnum $ fromIntegral err   if errCode == OUT_OF_BOUNDS     then pure ("out of bounds", "")-    else allocaBytes 128 $ \dbStrPtr -> do-      locStr <- fmap T.pack $ peekCString =<< peek locStrPtr+    else F.allocaBytes 128 $ \dbStrPtr -> do+      locStr <- fmap T.pack $ F.peekCString =<< F.peek locStrPtr       toDebugStringImpl docPtr dbStrPtr lenPtr-      len <- fmap fromIntegral $ peek lenPtr-      debugStr <- fmap T.pack $ peekCStringLen (dbStrPtr, len)+      len <- fmap fromIntegral $ F.peek lenPtr+      debugStr <- fmap T.pack $ F.peekCStringLen (dbStrPtr, len)       pure (locStr, debugStr)