-- | Exposes functions for building JSON decoders that harness the power
-- of the simdjson::ondemand API.
--
-- A decoder is really a function from a `Value` to some Haskell type in the `Decoder` monad.
-- It looks like [Data.Aeson.parseJSON](https://hackage.haskell.org/package/aeson-2.0.2.0/docs/Data-Aeson.html#v:parseJSON), except the `Value` is opaque and can only be used
-- 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.

module Data.Hermes
  ( -- * Decoding from ByteString input
    decodeEither
    -- * Decoder monad
  , Decoder(runDecoder)
  , HermesEnv
  , withHermesEnv
  , withInputBuffer
    -- * Object field accessors
    -- | Obtain an object using `withObject` that can be passed
    -- to these field lookup functions.
  , atKey
  , atKeyOptional
  , atKeyStrict
    -- * Decoders
    -- ** JSON pointer
  , atPointer
    -- ** Values
  , bool
  , char
  , double
  , int
  , scientific
  , string
  , text
  , list
  , nullable
  , objectAsKeyValues
    -- ** Date and time
    -- | Parses date and time types from Data.Time using the
    -- same attoparsec parsers as Data.Aeson via
    -- <https://hackage.haskell.org/package/attoparsec-iso8601>.
  , day
  , month
  , quarter
  , timeOfDay
  , timeZone
  , localTime
  , utcTime
  , zonedTime
    -- * Error Types
  , HermesException(..)
  , DocumentError(..)
    -- * Value helpers
  , isNull
  , withArray
  , withBool
  , withDocumentValue
  , withDouble
  , withInt
  , withObject
  , withString
  , withText
  -- * Raw ByteString access
  , withRawByteString
    -- * simdjson Opaque Types
  , Array
  , ArrayIter
  , Document
  , InputBuffer
  , Object
  , Parser
  , Value
  ) where

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.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.
decodeEither :: (Value -> Decoder a) -> ByteString -> Either HermesException a
decodeEither :: (Value -> Decoder a) -> ByteString -> Either HermesException a
decodeEither Value -> Decoder a
d ByteString
bs =
  IO (Either HermesException a) -> Either HermesException a
forall a. IO a -> a
Unsafe.unsafePerformIO (IO (Either HermesException a) -> Either HermesException a)
-> ((HermesEnv -> IO a) -> IO (Either HermesException a))
-> (HermesEnv -> IO a)
-> Either HermesException a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (Either HermesException a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (IO a -> IO (Either HermesException a))
-> ((HermesEnv -> IO a) -> IO a)
-> (HermesEnv -> IO a)
-> IO (Either HermesException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (HermesEnv -> IO a) -> IO a
forall (m :: * -> *) a.
MonadUnliftIO m =>
(HermesEnv -> m a) -> m a
withHermesEnv ((HermesEnv -> IO a) -> Either HermesException a)
-> (HermesEnv -> IO a) -> Either HermesException a
forall a b. (a -> b) -> a -> b
$ \HermesEnv
hEnv ->
    ByteString -> (InputBuffer -> IO a) -> IO a
forall a. ByteString -> (InputBuffer -> IO a) -> IO a
withInputBuffer ByteString
bs ((InputBuffer -> IO a) -> IO a) -> (InputBuffer -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \InputBuffer
input ->
      (ReaderT HermesEnv IO a -> HermesEnv -> IO a)
-> HermesEnv -> ReaderT HermesEnv IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT HermesEnv IO a -> HermesEnv -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT HermesEnv
hEnv (ReaderT HermesEnv IO a -> IO a)
-> (Decoder a -> ReaderT HermesEnv IO a) -> Decoder a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder a -> ReaderT HermesEnv IO a
forall a. Decoder a -> ReaderT HermesEnv IO a
runDecoder (Decoder a -> IO a) -> Decoder a -> IO a
forall a b. (a -> b) -> a -> b
$ (Value -> Decoder a) -> InputBuffer -> Decoder a
forall a. (Value -> Decoder a) -> InputBuffer -> Decoder a
withDocumentValue Value -> Decoder a
d InputBuffer
input