{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.Hermes.Decoder.Internal
  ( DecoderM(..)
  , DecoderPrimM(..)
  , HermesEnv(..)
  , HermesException(..)
  , DocumentError(..)
  , Path(..)
  , Decoder(..)
  , asks
  , local
  , decodeEither
  , decodeEitherIO
  , mkHermesEnv
  , mkHermesEnv_
  , withHermesEnv
  , withHermesEnv_
  , typePrefix
  , handleErrorCode
  , parseByteString
  , parseByteStringIO
  , liftIO
  , withRunInIO
  ) where

import           Control.Applicative (Alternative(..))
import           Control.DeepSeq (NFData(..))
import           Control.Exception (Exception, catch, throwIO, try)
import           Control.Monad.Primitive (PrimMonad(..))
import           Control.Monad.Trans.Class (lift)
import           Control.Monad.Trans.Reader (ReaderT(..))
import qualified Data.ByteString as BS
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Foreign.C as F
import qualified Foreign.ForeignPtr as F
import           GHC.Generics (Generic)
import qualified System.IO.Unsafe as Unsafe

import           Data.Hermes.SIMDJSON.Bindings (getDocumentValueImpl, getErrorMessageImpl)
import           Data.Hermes.SIMDJSON.Types
  ( Document(..)
  , Parser(..)
  , SIMDDocument
  , SIMDErrorCode(..)
  , SIMDParser
  , Value(..)
  )
import           Data.Hermes.SIMDJSON.Wrapper

-- | DecoderM 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 DecoderM a = DecoderM { forall a. DecoderM a -> ReaderT HermesEnv IO a
runDecoderM :: ReaderT HermesEnv IO a }
  deriving newtype (forall a b. a -> DecoderM b -> DecoderM a
forall a b. (a -> b) -> DecoderM a -> DecoderM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> DecoderM b -> DecoderM a
$c<$ :: forall a b. a -> DecoderM b -> DecoderM a
fmap :: forall a b. (a -> b) -> DecoderM a -> DecoderM b
$cfmap :: forall a b. (a -> b) -> DecoderM a -> DecoderM b
Functor, Functor DecoderM
forall a. a -> DecoderM a
forall a b. DecoderM a -> DecoderM b -> DecoderM a
forall a b. DecoderM a -> DecoderM b -> DecoderM b
forall a b. DecoderM (a -> b) -> DecoderM a -> DecoderM b
forall a b c.
(a -> b -> c) -> DecoderM a -> DecoderM b -> DecoderM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. DecoderM a -> DecoderM b -> DecoderM a
$c<* :: forall a b. DecoderM a -> DecoderM b -> DecoderM a
*> :: forall a b. DecoderM a -> DecoderM b -> DecoderM b
$c*> :: forall a b. DecoderM a -> DecoderM b -> DecoderM b
liftA2 :: forall a b c.
(a -> b -> c) -> DecoderM a -> DecoderM b -> DecoderM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> DecoderM a -> DecoderM b -> DecoderM c
<*> :: forall a b. DecoderM (a -> b) -> DecoderM a -> DecoderM b
$c<*> :: forall a b. DecoderM (a -> b) -> DecoderM a -> DecoderM b
pure :: forall a. a -> DecoderM a
$cpure :: forall a. a -> DecoderM a
Applicative, Applicative DecoderM
forall a. a -> DecoderM a
forall a b. DecoderM a -> DecoderM b -> DecoderM b
forall a b. DecoderM a -> (a -> DecoderM b) -> DecoderM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> DecoderM a
$creturn :: forall a. a -> DecoderM a
>> :: forall a b. DecoderM a -> DecoderM b -> DecoderM b
$c>> :: forall a b. DecoderM a -> DecoderM b -> DecoderM b
>>= :: forall a b. DecoderM a -> (a -> DecoderM b) -> DecoderM b
$c>>= :: forall a b. DecoderM a -> (a -> DecoderM b) -> DecoderM b
Monad)

instance Alternative DecoderM where
  empty :: forall a. DecoderM a
empty = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unspecified error"
  {-# INLINE (<|>) #-}
  DecoderM a
ad <|> :: forall a. DecoderM a -> DecoderM a -> DecoderM a
<|> DecoderM a
bd = forall b. ((forall a. DecoderM a -> IO a) -> IO b) -> DecoderM b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. DecoderM a -> IO a
u -> forall a. DecoderM a -> IO a
u DecoderM a
ad forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(HermesException
_err :: HermesException) -> forall a. DecoderM a -> IO a
u DecoderM a
bd)

instance MonadFail DecoderM where
  {-# INLINE fail #-}
  fail :: forall a. String -> DecoderM a
fail = forall a. Text -> DecoderM a
throwHermes forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

newtype DecoderPrimM a = DecoderPrimM { forall a. DecoderPrimM a -> DecoderM a
runDecoderPrimM :: DecoderM a }
  deriving newtype (forall a b. a -> DecoderPrimM b -> DecoderPrimM a
forall a b. (a -> b) -> DecoderPrimM a -> DecoderPrimM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> DecoderPrimM b -> DecoderPrimM a
$c<$ :: forall a b. a -> DecoderPrimM b -> DecoderPrimM a
fmap :: forall a b. (a -> b) -> DecoderPrimM a -> DecoderPrimM b
$cfmap :: forall a b. (a -> b) -> DecoderPrimM a -> DecoderPrimM b
Functor, Functor DecoderPrimM
forall a. a -> DecoderPrimM a
forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM a
forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM b
forall a b.
DecoderPrimM (a -> b) -> DecoderPrimM a -> DecoderPrimM b
forall a b c.
(a -> b -> c) -> DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM a
$c<* :: forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM a
*> :: forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM b
$c*> :: forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM b
liftA2 :: forall a b c.
(a -> b -> c) -> DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM c
<*> :: forall a b.
DecoderPrimM (a -> b) -> DecoderPrimM a -> DecoderPrimM b
$c<*> :: forall a b.
DecoderPrimM (a -> b) -> DecoderPrimM a -> DecoderPrimM b
pure :: forall a. a -> DecoderPrimM a
$cpure :: forall a. a -> DecoderPrimM a
Applicative, Applicative DecoderPrimM
forall a. a -> DecoderPrimM a
forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM b
forall a b.
DecoderPrimM a -> (a -> DecoderPrimM b) -> DecoderPrimM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> DecoderPrimM a
$creturn :: forall a. a -> DecoderPrimM a
>> :: forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM b
$c>> :: forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM b
>>= :: forall a b.
DecoderPrimM a -> (a -> DecoderPrimM b) -> DecoderPrimM b
$c>>= :: forall a b.
DecoderPrimM a -> (a -> DecoderPrimM b) -> DecoderPrimM b
Monad)

instance PrimMonad DecoderPrimM where
  type PrimState DecoderPrimM = PrimState (ReaderT HermesEnv IO)
  primitive :: forall a.
(State# (PrimState DecoderPrimM)
 -> (# State# (PrimState DecoderPrimM), a #))
-> DecoderPrimM a
primitive = forall a. DecoderM a -> DecoderPrimM a
DecoderPrimM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ReaderT HermesEnv IO a -> DecoderM a
DecoderM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
  {-# INLINE primitive #-}

-- | Contains foreign references to the allocated simdjson::parser and
-- simdjson::document. Also maintains state for error reporting that is updated
-- when an object field or array value is entered.
data HermesEnv =
  HermesEnv
    { HermesEnv -> ForeignPtr SIMDParser
hParser   :: !(F.ForeignPtr SIMDParser)
    , HermesEnv -> ForeignPtr SIMDDocument
hDocument :: !(F.ForeignPtr SIMDDocument)
    , HermesEnv -> [Path]
hPath     :: ![Path]
    } deriving (HermesEnv -> HermesEnv -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HermesEnv -> HermesEnv -> Bool
$c/= :: HermesEnv -> HermesEnv -> Bool
== :: HermesEnv -> HermesEnv -> Bool
$c== :: HermesEnv -> HermesEnv -> Bool
Eq, forall x. Rep HermesEnv x -> HermesEnv
forall x. HermesEnv -> Rep HermesEnv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HermesEnv x -> HermesEnv
$cfrom :: forall x. HermesEnv -> Rep HermesEnv x
Generic)

instance NFData HermesEnv where
  rnf :: HermesEnv -> ()
rnf HermesEnv{[Path]
ForeignPtr SIMDDocument
ForeignPtr SIMDParser
hPath :: [Path]
hDocument :: ForeignPtr SIMDDocument
hParser :: ForeignPtr SIMDParser
hPath :: HermesEnv -> [Path]
hDocument :: HermesEnv -> ForeignPtr SIMDDocument
hParser :: HermesEnv -> ForeignPtr SIMDParser
..} = forall a. NFData a => a -> ()
rnf [Path]
hPath seq :: forall a b. a -> b -> b
`seq` ()

data Path =
    Key !Text
  | Idx !Int
  | Pointer !Text
  deriving (Path -> Path -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> String
$cshow :: Path -> String
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show, forall x. Rep Path x -> Path
forall x. Path -> Rep Path x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Path x -> Path
$cfrom :: forall x. Path -> Rep Path x
Generic)

instance NFData Path

newtype Decoder a = Decoder { forall a. Decoder a -> Value -> DecoderM a
runDecoder :: Value -> DecoderM a }

instance Functor Decoder where
  {-# INLINE fmap #-}
  fmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
fmap a -> b
f Decoder a
d = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder a
d Value
val

instance Applicative Decoder where
  {-# INLINE pure #-}
  pure :: forall a. a -> Decoder a
pure a
a = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
  {-# INLINE (<*>) #-}
  (Decoder Value -> DecoderM (a -> b)
f) <*> :: forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
<*> (Decoder Value -> DecoderM a
e) = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> Value -> DecoderM (a -> b)
f Value
val forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> DecoderM a
e Value
val

instance Monad Decoder where
  {-# INLINE return #-}
  return :: forall a. a -> Decoder a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE (>>=) #-}
  (Decoder Value -> DecoderM a
d) >>= :: forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
>>= a -> Decoder b
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> do
    a
x <- Value -> DecoderM a
d Value
val
    forall a. Decoder a -> Value -> DecoderM a
runDecoder (a -> Decoder b
f a
x) Value
val

instance Alternative Decoder where
  {-# INLINE (<|>) #-}
  (Decoder Value -> DecoderM a
a) <|> :: forall a. Decoder a -> Decoder a -> Decoder a
<|> (Decoder Value -> DecoderM a
b) = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> Value -> DecoderM a
a Value
val forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> DecoderM a
b Value
val
  {-# INLINE empty #-}
  empty :: forall a. Decoder a
empty = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall (f :: * -> *) a. Alternative f => f a
empty

instance MonadFail Decoder where
  {-# INLINE fail #-}
  fail :: forall a. String -> Decoder a
fail String
e = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e

-- | Decode a strict `ByteString` using the simdjson::ondemand bindings.
-- Creates simdjson instances on each decode.
decodeEither :: Decoder a -> BS.ByteString -> Either HermesException a
decodeEither :: forall a. Decoder a -> ByteString -> Either HermesException a
decodeEither Decoder a
d ByteString
bs = forall a. IO a -> a
Unsafe.unsafeDupablePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ forall a. Decoder a -> ByteString -> IO a
decodeEitherIO Decoder a
d ByteString
bs
{-# NOINLINE decodeEither #-}

-- | Decode a strict `ByteString` using the simdjson::ondemand bindings.
-- Creates simdjson instances on each decode. Runs in IO instead of discharging it.
decodeEitherIO :: Decoder a -> BS.ByteString -> IO a
decodeEitherIO :: forall a. Decoder a -> ByteString -> IO a
decodeEitherIO Decoder a
d ByteString
bs = forall a. (HermesEnv -> IO a) -> IO a
withHermesEnv_ forall a b. (a -> b) -> a -> b
$ \HermesEnv
hEnv -> forall a. HermesEnv -> Decoder a -> ByteString -> IO a
parseByteStringIO HermesEnv
hEnv Decoder a
d ByteString
bs

-- Given a HermesEnv, decode a strict ByteString.
parseByteString :: HermesEnv -> Decoder a -> BS.ByteString -> Either HermesException a
parseByteString :: forall a.
HermesEnv -> Decoder a -> ByteString -> Either HermesException a
parseByteString HermesEnv
hEnv Decoder a
d ByteString
bs = forall a. IO a -> a
Unsafe.unsafeDupablePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ forall a. HermesEnv -> Decoder a -> ByteString -> IO a
parseByteStringIO HermesEnv
hEnv Decoder a
d ByteString
bs
{-# NOINLINE parseByteString #-}

-- Given a HermesEnv, decode a strict ByteString in IO.
parseByteStringIO :: HermesEnv -> Decoder a -> BS.ByteString -> IO a
parseByteStringIO :: forall a. HermesEnv -> Decoder a -> ByteString -> IO a
parseByteStringIO HermesEnv
hEnv Decoder a
d ByteString
bs =
  forall a. (Value -> IO a) -> IO a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
valPtr ->
    forall a. ByteString -> (InputBuffer -> IO a) -> IO a
withInputBuffer ByteString
bs forall a b. (a -> b) -> a -> b
$ \InputBuffer
inputPtr -> do
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr (HermesEnv -> ForeignPtr SIMDParser
hParser HermesEnv
hEnv) forall a b. (a -> b) -> a -> b
$ \Ptr SIMDParser
parserPtr ->
        forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr (HermesEnv -> ForeignPtr SIMDDocument
hDocument HermesEnv
hEnv) forall a b. (a -> b) -> a -> b
$ \Ptr SIMDDocument
docPtr -> do
          CInt
err <- Parser -> InputBuffer -> Document -> Value -> IO CInt
getDocumentValueImpl (Ptr SIMDParser -> Parser
Parser Ptr SIMDParser
parserPtr) InputBuffer
inputPtr (Ptr SIMDDocument -> Document
Document Ptr SIMDDocument
docPtr) Value
valPtr
          forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT HermesEnv
hEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DecoderM a -> ReaderT HermesEnv IO a
runDecoderM forall a b. (a -> b) -> a -> b
$ do
            Text -> CInt -> DecoderM ()
handleErrorCode Text
"" CInt
err
            forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder a
d Value
valPtr

-- | 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.
-- 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 :: Maybe Int -> IO HermesEnv
mkHermesEnv Maybe Int
mCapacity = do
  ForeignPtr SIMDParser
parser   <- Maybe Int -> IO (ForeignPtr SIMDParser)
mkSIMDParser Maybe Int
mCapacity
  ForeignPtr SIMDDocument
document <- IO (ForeignPtr SIMDDocument)
mkSIMDDocument
  forall (f :: * -> *) a. Applicative f => a -> f a
pure HermesEnv
    { hParser :: ForeignPtr SIMDParser
hParser   = ForeignPtr SIMDParser
parser
    , hDocument :: ForeignPtr SIMDDocument
hDocument = ForeignPtr SIMDDocument
document
    , hPath :: [Path]
hPath     = []
    }

mkHermesEnv_ :: IO HermesEnv
mkHermesEnv_ :: IO HermesEnv
mkHermesEnv_ = Maybe Int -> IO HermesEnv
mkHermesEnv forall a. Maybe a
Nothing

withHermesEnv :: Maybe Int -> (HermesEnv -> IO a) -> IO a
withHermesEnv :: forall a. Maybe Int -> (HermesEnv -> IO a) -> IO a
withHermesEnv Maybe Int
mCapacity HermesEnv -> IO a
f = Maybe Int -> IO HermesEnv
mkHermesEnv Maybe Int
mCapacity forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HermesEnv -> IO a
f

withHermesEnv_ :: (HermesEnv -> IO a) -> IO a
withHermesEnv_ :: forall a. (HermesEnv -> IO a) -> IO a
withHermesEnv_ = forall a. Maybe Int -> (HermesEnv -> IO a) -> IO a
withHermesEnv forall a. Maybe a
Nothing

-- | 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 (HermesException -> HermesException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HermesException -> HermesException -> Bool
$c/= :: HermesException -> HermesException -> Bool
== :: HermesException -> HermesException -> Bool
$c== :: HermesException -> HermesException -> Bool
Eq, Int -> HermesException -> ShowS
[HermesException] -> ShowS
HermesException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HermesException] -> ShowS
$cshowList :: [HermesException] -> ShowS
show :: HermesException -> String
$cshow :: HermesException -> String
showsPrec :: Int -> HermesException -> ShowS
$cshowsPrec :: Int -> HermesException -> ShowS
Show, forall x. Rep HermesException x -> HermesException
forall x. HermesException -> Rep HermesException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HermesException x -> HermesException
$cfrom :: forall x. HermesException -> Rep HermesException x
Generic)

instance Exception HermesException
instance NFData HermesException

-- | Record containing all pertinent information for troubleshooting an exception.
data DocumentError =
  DocumentError
    { DocumentError -> Text
path     :: !Text
    -- ^ The path to the current element determined by the decoder.
    -- Formatted in the JSON Pointer standard per RFC 6901.
    , DocumentError -> Text
errorMsg :: !Text
    -- ^ An error message.
    }
    deriving stock (DocumentError -> DocumentError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentError -> DocumentError -> Bool
$c/= :: DocumentError -> DocumentError -> Bool
== :: DocumentError -> DocumentError -> Bool
$c== :: DocumentError -> DocumentError -> Bool
Eq, Int -> DocumentError -> ShowS
[DocumentError] -> ShowS
DocumentError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentError] -> ShowS
$cshowList :: [DocumentError] -> ShowS
show :: DocumentError -> String
$cshow :: DocumentError -> String
showsPrec :: Int -> DocumentError -> ShowS
$cshowsPrec :: Int -> DocumentError -> ShowS
Show, forall x. Rep DocumentError x -> DocumentError
forall x. DocumentError -> Rep DocumentError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DocumentError x -> DocumentError
$cfrom :: forall x. DocumentError -> Rep DocumentError x
Generic)

instance NFData DocumentError

typePrefix :: Text -> Text
typePrefix :: Text -> Text
typePrefix Text
typ = Text
"Error while getting value of type " forall a. Semigroup a => a -> a -> a
<> Text
typ forall a. Semigroup a => a -> a -> a
<> Text
". "
{-# INLINE typePrefix #-}

-- | Re-throw an exception caught from the simdjson library.
throwSIMD :: Text -> DecoderM a
throwSIMD :: forall a. Text -> DecoderM a
throwSIMD Text
msg = do
  Text
pth <- [Path] -> Text
formatPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (HermesEnv -> a) -> DecoderM a
asks HermesEnv -> [Path]
hPath
  forall a. IO a -> DecoderM a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentError -> HermesException
SIMDException forall a b. (a -> b) -> a -> b
$ Text -> Text -> DocumentError
DocumentError Text
pth Text
msg

-- | Throw an IO exception in the `Decoder` context.
throwHermes :: Text -> DecoderM a
throwHermes :: forall a. Text -> DecoderM a
throwHermes Text
msg = do
  Text
pth <- [Path] -> Text
formatPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (HermesEnv -> a) -> DecoderM a
asks HermesEnv -> [Path]
hPath
  forall a. IO a -> DecoderM a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentError -> HermesException
InternalException forall a b. (a -> b) -> a -> b
$ Text -> Text -> DocumentError
DocumentError Text
pth Text
msg

-- | Format path using JSON Pointer spec: https://www.rfc-editor.org/rfc/rfc6901
formatPath :: [Path] -> Text
formatPath :: [Path] -> Text
formatPath [Path]
dl =
  case [Path]
els of
    [] -> Text
""
    [Path]
xs -> [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path -> Text
escapeKey [Path]
xs
  where
    els :: [Path]
els                   = forall a. [a] -> [a]
reverse [Path]
dl
    escapeKey :: Path -> Text
escapeKey (Key Text
txt)   = Text
"/" forall a. Semigroup a => a -> a -> a
<> (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escChar Text
txt
    escapeKey (Idx Int
int)   = Text
"/" forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
int)
    escapeKey (Pointer Text
p) = Text
p
    escChar :: Char -> Text
escChar Char
'/'           = Text
"~1"
    escChar Char
'~'           = Text
"~0"
    escChar Char
x             = Char -> Text
T.singleton Char
x

handleErrorCode :: Text -> F.CInt -> DecoderM ()
handleErrorCode :: Text -> CInt -> DecoderM ()
handleErrorCode Text
pre CInt
errInt = do
  let errCode :: SIMDErrorCode
errCode = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
errInt
  if SIMDErrorCode
errCode forall a. Eq a => a -> a -> Bool
== SIMDErrorCode
SUCCESS
  then forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  else do
    String
errStr <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ CString -> IO String
F.peekCString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CInt -> IO CString
getErrorMessageImpl CInt
errInt
    forall a. Text -> DecoderM a
throwSIMD forall a b. (a -> b) -> a -> b
$ Text
pre forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
errStr
{-# INLINE handleErrorCode #-}

withRunInIO :: ((forall a. DecoderM a -> IO a) -> IO b) -> DecoderM b
withRunInIO :: forall b. ((forall a. DecoderM a -> IO a) -> IO b) -> DecoderM b
withRunInIO (forall a. DecoderM a -> IO a) -> IO b
inner =
  forall a. ReaderT HermesEnv IO a -> DecoderM a
DecoderM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \HermesEnv
r ->
    (forall a. DecoderM a -> IO a) -> IO b
inner (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT HermesEnv
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DecoderM a -> ReaderT HermesEnv IO a
runDecoderM)
{-# INLINE withRunInIO #-}

liftIO :: IO a -> DecoderM a
liftIO :: forall a. IO a -> DecoderM a
liftIO = forall a. ReaderT HermesEnv IO a -> DecoderM a
DecoderM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
{-# INLINE liftIO #-}

asks :: (HermesEnv -> a) -> DecoderM a
asks :: forall a. (HermesEnv -> a) -> DecoderM a
asks HermesEnv -> a
f = forall a. ReaderT HermesEnv IO a -> DecoderM a
DecoderM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. HermesEnv -> a
f
{-# INLINE asks #-}

local :: (HermesEnv -> HermesEnv) -> DecoderM a -> DecoderM a
local :: forall a. (HermesEnv -> HermesEnv) -> DecoderM a -> DecoderM a
local HermesEnv -> HermesEnv
f (DecoderM ReaderT HermesEnv IO a
m) = forall a. ReaderT HermesEnv IO a -> DecoderM a
DecoderM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT HermesEnv IO a
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. HermesEnv -> HermesEnv
f
{-# INLINE local #-}