{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-}

module Data.Hermes.Decoder.Value
  ( atKey
  , atKeyOptional
  , atKeyStrict
  , atPointer
  , bool
  , char
  , double
  , int
  , uint
  , getType
  , list
  , nullable
  , object
  , objectAsKeyValues
  , objectAsMap
  , objectAsMapExcluding
  , parseScientific
  , scientific
  , string
  , text
  , listOfDouble
  , listOfInt
  , isNull
  , vector
  , withBool
  , withDouble
  , withInt
  , withObjectAsMap
  , withRawByteString
  , withRawText
  , withScientific
  , withString
  , withText
  , withType
  , withVector
  ) where

import           Control.Monad ((>=>))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as Unsafe
import qualified Data.DList as DList
import           Data.Map (Map)
import qualified Data.Map.Strict as M
import qualified Data.Scientific as Sci
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Foreign as T
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Foreign.C.String as F
import qualified Foreign.ForeignPtr 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.Ptr as F
import qualified Foreign.Storable as F

import           Data.Hermes.Decoder.Internal
import           Data.Hermes.Decoder.Internal.Scientific
import           Data.Hermes.Decoder.Path
import           Data.Hermes.SIMDJSON

-- | Decode a value at the particular JSON pointer following RFC 6901.
-- Be careful where you use this because it rewinds the document on each
-- successive call.
--
-- > decodeEither (atPointer "/statuses/99" decodeObject) input
atPointer :: Text -> Decoder a -> Decoder a
atPointer :: forall a. Text -> Decoder a -> Decoder a
atPointer Text
jptr (Decoder Value -> DecoderM a
f) = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
_ -> do
  ForeignPtr SIMDDocument
doc <- forall a. (HermesEnv -> a) -> DecoderM a
asks HermesEnv -> ForeignPtr SIMDDocument
hDocument
  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
run ->
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr SIMDDocument
doc forall a b. (a -> b) -> a -> b
$ \Ptr SIMDDocument
docPtr ->
      forall a. ByteString -> (CStringLen -> IO a) -> IO a
Unsafe.unsafeUseAsCStringLen (Text -> ByteString
T.encodeUtf8 Text
jptr) forall a b. (a -> b) -> a -> b
$ \(CString
cstr, Int
len) ->
        forall a. (Value -> IO a) -> IO a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
vPtr -> forall a. DecoderM a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Text -> DecoderM a -> DecoderM a
withPointer Text
jptr forall a b. (a -> b) -> a -> b
$ do
          CInt
err <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ CString -> Int -> Document -> Value -> IO CInt
atPointerImpl CString
cstr Int
len (Ptr SIMDDocument -> Document
Document Ptr SIMDDocument
docPtr) Value
vPtr
          Text -> CInt -> DecoderM ()
handleErrorCode Text
"" CInt
err
          Value -> DecoderM a
f Value
vPtr
{-# INLINE atPointer #-}

-- | Enter an `Object` to begin parsing its fields.
object :: FieldsDecoder a -> Decoder a
object :: forall a. FieldsDecoder a -> Decoder a
object FieldsDecoder a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \(Value Ptr JSONValue
valPtr) ->
  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
run ->
    forall a. (Value -> IO a) -> IO a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
vPtr -> do
      CInt
err <- Value -> IO CInt
getObjectFromValueImpl (Ptr JSONValue -> Value
Value Ptr JSONValue
valPtr)
      forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
        Text -> CInt -> DecoderM ()
handleErrorCode (Text -> Text
typePrefix Text
"object") CInt
err
        forall a. Decoder a -> Value -> DecoderM a
runDecoder (forall a. FieldsDecoder a -> Object -> Decoder a
runFieldsDecoder FieldsDecoder a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr JSONObject -> Object
Object forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
F.castPtr Ptr JSONValue
valPtr) Value
vPtr
{-# INLINE object #-}

-- | Helper to work with an Int parsed from a Value.
withInt :: (Int -> Decoder a) -> Decoder a
withInt :: forall a. (Int -> Decoder a) -> Decoder a
withInt Int -> Decoder a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> Value -> DecoderM Int
getInt Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
i -> forall a. Decoder a -> Value -> DecoderM a
runDecoder (Int -> Decoder a
f Int
i) Value
val
{-# INLINE withInt #-}

-- | Helper to work with a Double parsed from a Value.
withDouble :: (Double -> Decoder a) -> Decoder a
withDouble :: forall a. (Double -> Decoder a) -> Decoder a
withDouble Double -> Decoder a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> Value -> DecoderM Double
getDouble Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Double
d -> forall a. Decoder a -> Value -> DecoderM a
runDecoder (Double -> Decoder a
f Double
d) Value
val
{-# INLINE withDouble #-}

-- | Helper to work with a Bool parsed from a Value.
withBool :: (Bool -> Decoder a) -> Decoder a
withBool :: forall a. (Bool -> Decoder a) -> Decoder a
withBool Bool -> Decoder a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> Value -> DecoderM Bool
getBool Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> forall a. Decoder a -> Value -> DecoderM a
runDecoder (Bool -> Decoder a
f Bool
b) Value
val
{-# INLINE withBool #-}

-- | Helper to work with the raw ByteString of the JSON token parsed from the given Value.
withRawByteString :: (BS.ByteString -> Decoder a) -> Decoder a
withRawByteString :: forall a. (ByteString -> Decoder a) -> Decoder a
withRawByteString ByteString -> Decoder a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> Value -> DecoderM ByteString
getRawByteString Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
b -> forall a. Decoder a -> Value -> DecoderM a
runDecoder (ByteString -> Decoder a
f ByteString
b) Value
val
{-# INLINE withRawByteString #-}

-- | Helper to work with the raw ByteString of the JSON token parsed from the given Value.
withRawText :: (Text -> Decoder a) -> Decoder a
withRawText :: forall a. (Text -> Decoder a) -> Decoder a
withRawText Text -> Decoder a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> Value -> DecoderM Text
getRawText Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
b -> forall a. Decoder a -> Value -> DecoderM a
runDecoder (Text -> Decoder a
f Text
b) Value
val
{-# INLINE withRawText #-}

-- | Helper to work with a String parsed from a Value.
withString :: (String -> Decoder a) -> Decoder a
withString :: forall a. ([Char] -> Decoder a) -> Decoder a
withString [Char] -> Decoder a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> Value -> DecoderM [Char]
getString Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
s -> forall a. Decoder a -> Value -> DecoderM a
runDecoder ([Char] -> Decoder a
f [Char]
s) Value
val
{-# INLINE withString #-}

-- | Helper to work with a Text parsed from a Value.
withText :: (Text -> Decoder a) -> Decoder a
withText :: forall a. (Text -> Decoder a) -> Decoder a
withText Text -> Decoder a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> Value -> DecoderM Text
getText Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
t -> forall a. Decoder a -> Value -> DecoderM a
runDecoder (Text -> Decoder a
f Text
t) Value
val
{-# INLINE withText #-}

-- | Returns True if the Value is null.
isNull :: Decoder Bool
isNull :: Decoder Bool
isNull = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
valPtr ->
  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
run ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CBool
ptr -> do
      CInt
err <- Value -> Ptr CBool -> IO CInt
isNullImpl Value
valPtr Ptr CBool
ptr
      forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
        Text -> CInt -> DecoderM ()
handleErrorCode Text
"" CInt
err
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Num a) => a -> Bool
F.toBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr CBool
ptr
{-# INLINE isNull #-}

-- | Is more efficient by looping in C++ instead of Haskell.
listOfInt :: Decoder [Int]
listOfInt :: Decoder [Int]
listOfInt =
  forall a. ((Array, Int) -> DecoderM a) -> Decoder a
withArrayLen forall a b. (a -> b) -> a -> b
$ \(Array
arrPtr, Int
len) ->
    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
run ->
      forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
F.allocaArray Int
len forall a b. (a -> b) -> a -> b
$ \Ptr Int
out -> do
        CInt
err <- Array -> Ptr Int -> IO CInt
intArrayImpl Array
arrPtr Ptr Int
out
        forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ Text -> CInt -> DecoderM ()
handleErrorCode Text
"Error decoding array of ints." CInt
err
        forall a. Storable a => Int -> Ptr a -> IO [a]
F.peekArray Int
len Ptr Int
out
{-# RULES "list int/listOfInt" list int = listOfInt #-}

-- | Is more efficient by looping in C++ instead of Haskell.
listOfDouble :: Decoder [Double]
listOfDouble :: Decoder [Double]
listOfDouble =
  forall a. ((Array, Int) -> DecoderM a) -> Decoder a
withArrayLen forall a b. (a -> b) -> a -> b
$ \(Array
arrPtr, Int
len) ->
    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
run ->
      forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
F.allocaArray Int
len forall a b. (a -> b) -> a -> b
$ \Ptr Double
out -> do
        CInt
err <- Array -> Ptr Double -> IO CInt
doubleArrayImpl Array
arrPtr Ptr Double
out
        forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ Text -> CInt -> DecoderM ()
handleErrorCode Text
"Error decoding array of doubles." CInt
err
        forall a. Storable a => Int -> Ptr a -> IO [a]
F.peekArray Int
len Ptr Double
out
{-# RULES "list double/listOfDouble" list double = listOfDouble #-}

-- | Find an object field by key, where an exception is thrown
-- if the key is missing.
atKey :: Text -> Decoder a -> FieldsDecoder a
atKey :: forall a. Text -> Decoder a -> FieldsDecoder a
atKey Text
key Decoder a
parser =
  forall a. (Object -> Decoder a) -> FieldsDecoder a
FieldsDecoder forall a b. (a -> b) -> a -> b
$ \Object
obj -> forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> forall a. Value -> Decoder a -> Object -> Text -> DecoderM a
withUnorderedField Value
val Decoder a
parser Object
obj Text
key
{-# INLINE atKey #-}

-- | Find an object field by key, where Nothing is returned
-- if the key is missing.
atKeyOptional :: Text -> Decoder a -> FieldsDecoder (Maybe a)
atKeyOptional :: forall a. Text -> Decoder a -> FieldsDecoder (Maybe a)
atKeyOptional Text
key Decoder a
parser =
  forall a. (Object -> Decoder a) -> FieldsDecoder a
FieldsDecoder forall a b. (a -> b) -> a -> b
$ \Object
obj -> forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> forall a.
Value -> Decoder a -> Object -> Text -> DecoderM (Maybe a)
withUnorderedOptionalField Value
val Decoder a
parser Object
obj Text
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 -> FieldsDecoder a
atKeyStrict :: forall a. Text -> Decoder a -> FieldsDecoder a
atKeyStrict Text
key Decoder a
parser =
  forall a. (Object -> Decoder a) -> FieldsDecoder a
FieldsDecoder forall a b. (a -> b) -> a -> b
$ \Object
obj -> forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> forall a. Value -> Decoder a -> Object -> Text -> DecoderM a
withField Value
val Decoder a
parser Object
obj Text
key
{-# INLINE atKeyStrict #-}

-- | Parse a homogenous JSON array into a Haskell list.
list :: Decoder a -> Decoder [a]
list :: forall a. Decoder a -> Decoder [a]
list Decoder a
f = forall a. (ArrayIter -> DecoderM a) -> Decoder a
withArrayIter forall a b. (a -> b) -> a -> b
$ forall a. Decoder a -> ArrayIter -> DecoderM [a]
iterateOverArray Decoder a
f
{-# INLINE[2] list #-}

-- | Parse a homogenous JSON array into a generic `Vector`.
vector :: G.Vector v a => Decoder a -> Decoder (v a)
vector :: forall (v :: * -> *) a. Vector v a => Decoder a -> Decoder (v a)
vector Decoder a
f = forall a. (ArrayIter -> Int -> DecoderM a) -> Decoder a
withArrayLenIter forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a.
Vector v a =>
Decoder a -> ArrayIter -> Int -> DecoderM (v a)
iterateOverArrayLen Decoder a
f
{-# INLINE vector #-}

withVector :: G.Vector v a => Decoder a -> (v a -> Decoder a) -> Decoder a
withVector :: forall (v :: * -> *) a.
Vector v a =>
Decoder a -> (v a -> Decoder a) -> Decoder a
withVector Decoder a
inner v a -> Decoder a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> forall a. Decoder a -> Value -> DecoderM a
runDecoder (forall (v :: * -> *) a. Vector v a => Decoder a -> Decoder (v a)
vector Decoder a
inner) Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \v a
v -> forall a. Decoder a -> Value -> DecoderM a
runDecoder (v a -> Decoder a
f v a
v) Value
val
{-# INLINE withVector #-}

-- | Parse an object into a homogenous list of key-value tuples.
objectAsKeyValues
  :: (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)]
objectAsKeyValues :: forall k v. (Text -> Decoder k) -> Decoder v -> Decoder [(k, v)]
objectAsKeyValues Text -> Decoder k
kf Decoder v
vf = forall a. (ObjectIter -> DecoderM a) -> Decoder a
withObjectIter forall a b. (a -> b) -> a -> b
$ forall a b.
(Text -> Decoder a) -> Decoder b -> ObjectIter -> DecoderM [(a, b)]
iterateOverFields Text -> Decoder k
kf Decoder v
vf
{-# INLINE objectAsKeyValues #-}

-- | Parse an object into a strict `Map`.
objectAsMap
  :: Ord k
  => (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)
objectAsMap :: forall k v.
Ord k =>
(Text -> Decoder k) -> Decoder v -> Decoder (Map k v)
objectAsMap Text -> Decoder k
kf Decoder v
vf = forall a. (ObjectIter -> DecoderM a) -> Decoder a
withObjectIter forall a b. (a -> b) -> a -> b
$ forall a b.
Ord a =>
(Text -> Decoder a)
-> Decoder b -> ObjectIter -> DecoderM (Map a b)
iterateOverFieldsMap Text -> Decoder k
kf Decoder v
vf
{-# INLINE objectAsMap #-}

-- | Parse an object into a strict `Map`.
-- Skips any fields in the given list, which adds a slight performance penalty.
objectAsMapExcluding
  :: Ord k
  => [Text]
  -- ^ List of field names to exclude.
  -> (Text -> Decoder k)
  -- ^ Parses a Text key in the Decoder monad. JSON keys are always text.
  -> Decoder v
  -- ^ Decoder for the field value.
  -> Decoder (Map k v)
objectAsMapExcluding :: forall k v.
Ord k =>
[Text] -> (Text -> Decoder k) -> Decoder v -> Decoder (Map k v)
objectAsMapExcluding [Text]
fields Text -> Decoder k
kf Decoder v
vf =
  forall a. (ObjectIter -> DecoderM a) -> Decoder a
withObjectIter forall a b. (a -> b) -> a -> b
$ forall a b.
Ord a =>
[Text]
-> (Text -> Decoder a)
-> Decoder b
-> ObjectIter
-> DecoderM (Map a b)
iterateOverFieldsMapExcluding [Text]
fields Text -> Decoder k
kf Decoder v
vf
{-# INLINE objectAsMapExcluding #-}

withObjectAsMap
  :: Ord k
  => (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 -> Decoder a)
  -> Decoder a
withObjectAsMap :: forall k v a.
Ord k =>
(Text -> Decoder k)
-> Decoder v -> (Map k v -> Decoder a) -> Decoder a
withObjectAsMap Text -> Decoder k
kf Decoder v
vf Map k v -> Decoder a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> forall a. Decoder a -> Value -> DecoderM a
runDecoder (forall k v.
Ord k =>
(Text -> Decoder k) -> Decoder v -> Decoder (Map k v)
objectAsMap Text -> Decoder k
kf Decoder v
vf) Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Map k v
m -> forall a. Decoder a -> Value -> DecoderM a
runDecoder (Map k v -> Decoder a
f Map k v
m) Value
val
{-# INLINE withObjectAsMap #-}

-- | Transforms a parser to return Nothing when the value is null.
nullable :: Decoder a -> Decoder (Maybe a)
nullable :: forall a. Decoder a -> Decoder (Maybe a)
nullable Decoder a
parser = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> do
  Bool
nil <- forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder Bool
isNull Value
val
  if Bool
nil
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder a
parser Value
val
{-# INLINE nullable #-}

-- | Parse only a single character.
char :: Decoder Char
char :: Decoder Char
char = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ Value -> DecoderM Text
getText forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall {f :: * -> *}. MonadFail f => Text -> f Char
justOne
  where
    justOne :: Text -> f Char
justOne Text
txt =
      case Text -> Maybe (Char, Text)
T.uncons Text
txt of
        Just (Char
c, Text
"") ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
        Maybe (Char, Text)
_ ->
          forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Expected a single character"
{-# INLINE char #-}

-- | Parse a JSON string into a Haskell String.
-- For best performance you should use `text` instead.
string :: Decoder String
string :: Decoder [Char]
string = forall a. (Value -> DecoderM a) -> Decoder a
Decoder Value -> DecoderM [Char]
getString
{-# INLINE string #-}

-- | Parse a JSON string into Haskell Text.
text :: Decoder Text
text :: Decoder Text
text = forall a. (Value -> DecoderM a) -> Decoder a
Decoder Value -> DecoderM Text
getText
{-# INLINE text #-}

-- | Parse a JSON boolean into a Haskell Bool.
bool :: Decoder Bool
bool :: Decoder Bool
bool = forall a. (Value -> DecoderM a) -> Decoder a
Decoder Value -> DecoderM Bool
getBool
{-# INLINE bool #-}

-- | Parse a JSON number into a signed Haskell Int.
int :: Decoder Int
int :: Decoder Int
int = forall a. (Value -> DecoderM a) -> Decoder a
Decoder Value -> DecoderM Int
getInt
{-# INLINE[2] int #-}

-- | Parse a JSON number into an unsigned Haskell Int (Word).
uint :: Decoder Word
uint :: Decoder Word
uint = forall a. (Value -> DecoderM a) -> Decoder a
Decoder Value -> DecoderM Word
getUInt
{-# INLINE uint #-}

-- | Parse a JSON number into a Haskell Double.
double :: Decoder Double
double :: Decoder Double
double = forall a. (Value -> DecoderM a) -> Decoder a
Decoder Value -> DecoderM Double
getDouble
{-# INLINE[2] double #-}

-- | Parse a Scientific from a Value.
scientific :: Decoder Sci.Scientific
scientific :: Decoder Scientific
scientific = forall a. (Text -> Decoder a) -> Decoder a
withRawText Text -> Decoder Scientific
parseScientific
{-# INLINE scientific #-}

withScientific :: (Sci.Scientific -> Decoder a) -> Decoder a
withScientific :: forall a. (Scientific -> Decoder a) -> Decoder a
withScientific Scientific -> Decoder a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder Scientific
scientific Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Scientific
sci -> forall a. Decoder a -> Value -> DecoderM a
runDecoder (Scientific -> Decoder a
f Scientific
sci) Value
val
{-# INLINE withScientific #-}

-- | Parse a Scientific from UTF-8 text.
parseScientific :: Text -> Decoder Sci.Scientific
parseScientific :: Text -> Decoder Scientific
parseScientific = forall r. (Scientific -> Text -> r) -> ([Char] -> r) -> Text -> r
scanScientific
    (\Scientific
sci Text
rest -> if Text -> Bool
T.null Text
rest then forall (m :: * -> *) a. Monad m => a -> m a
return Scientific
sci else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Expecting end-of-input, got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Int -> Text -> Text
T.take Int
10 Text
rest))
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail
{-# INLINE parseScientific #-}

-- | Get the simdjson type of the Value.
getType :: Decoder ValueType
getType :: Decoder ValueType
getType =
  forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
valPtr ->
    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
run ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ptr -> do
        CInt
err <- Value -> Ptr CInt -> IO CInt
getTypeImpl Value
valPtr Ptr CInt
ptr
        forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
          Text -> CInt -> DecoderM ()
handleErrorCode Text
"" CInt
err
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr CInt
ptr
{-# INLINE getType #-}

withType :: (ValueType -> Decoder a) -> Decoder a
withType :: forall a. (ValueType -> Decoder a) -> Decoder a
withType ValueType -> Decoder a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder ValueType
getType Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ValueType
ty -> forall a. Decoder a -> Value -> DecoderM a
runDecoder (ValueType -> Decoder a
f ValueType
ty) Value
val
{-# INLINE withType #-}

-- Internal Functions

-- | Helper to work with an ArrayIter started from a Value assumed to be an Array.
withArrayIter :: (ArrayIter -> DecoderM a) -> Decoder a
withArrayIter :: forall a. (ArrayIter -> DecoderM a) -> Decoder a
withArrayIter ArrayIter -> DecoderM a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \(Value Ptr JSONValue
valPtr) ->
  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
run -> do
    CInt
err <- Value -> IO CInt
getArrayIterFromValueImpl (Ptr JSONValue -> Value
Value Ptr JSONValue
valPtr)
    forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
      Text -> CInt -> DecoderM ()
handleErrorCode (Text -> Text
typePrefix Text
"array") CInt
err
      ArrayIter -> DecoderM a
f (Ptr JSONArrayIter -> ArrayIter
ArrayIter forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
F.castPtr Ptr JSONValue
valPtr)
{-# INLINE withArrayIter #-}

-- | Execute a function on each Value in an ArrayIter and
-- accumulate the results into a list.
iterateOverArray :: Decoder a -> ArrayIter -> DecoderM [a]
iterateOverArray :: forall a. Decoder a -> ArrayIter -> DecoderM [a]
iterateOverArray Decoder a
f ArrayIter
iterPtr =
  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
run ->
    forall a. (Value -> IO a) -> IO a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
valPtr -> forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ Int -> DList a -> Value -> DecoderM [a]
go (Int
0 :: Int) forall a. DList a
DList.empty Value
valPtr
  where
    go :: Int -> DList a -> Value -> DecoderM [a]
go !Int
n DList a
acc Value
valPtr = do
      Bool
isOver <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Num a) => a -> Bool
F.toBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ArrayIter -> IO CBool
arrayIterIsDoneImpl ArrayIter
iterPtr
      if Bool -> Bool
not Bool
isOver
        then do
          a
r <- forall a. Int -> DecoderM a -> DecoderM a
withIndex Int
n forall a b. (a -> b) -> a -> b
$ do
            CInt
err <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ArrayIter -> Value -> IO CInt
arrayIterGetCurrentImpl ArrayIter
iterPtr Value
valPtr
            Text -> CInt -> DecoderM ()
handleErrorCode Text
"" CInt
err
            a
result <- forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder a
f Value
valPtr
            forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ArrayIter -> IO ()
arrayIterMoveNextImpl ArrayIter
iterPtr
            forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
          Int -> DList a -> Value -> DecoderM [a]
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) (DList a
acc forall a. Semigroup a => a -> a -> a
<> forall a. a -> DList a
DList.singleton a
r) Value
valPtr
        else
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. DList a -> [a]
DList.toList DList a
acc
{-# INLINE iterateOverArray #-}

-- | Helper to work with an ArrayIter and its length.
withArrayLenIter :: (ArrayIter -> Int -> DecoderM a) -> Decoder a
withArrayLenIter :: forall a. (ArrayIter -> Int -> DecoderM a) -> Decoder a
withArrayLenIter ArrayIter -> Int -> DecoderM a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \(Value Ptr JSONValue
valPtr) ->
  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
run -> do
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CSize
outLen -> do
      CInt
err <- Value -> Ptr CSize -> IO CInt
getArrayIterLenFromValueImpl (Ptr JSONValue -> Value
Value Ptr JSONValue
valPtr) Ptr CSize
outLen
      Int
len <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr CSize
outLen
      forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
        Text -> CInt -> DecoderM ()
handleErrorCode Text
"" CInt
err
        ArrayIter -> Int -> DecoderM a
f (Ptr JSONArrayIter -> ArrayIter
ArrayIter forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
F.castPtr Ptr JSONValue
valPtr) Int
len
{-# INLINE withArrayLenIter #-}

-- | Execute a function on each Value in an ArrayIter and
-- accumulate the results into a generic `Vector`.
iterateOverArrayLen :: G.Vector v a => Decoder a -> ArrayIter -> Int -> DecoderM (v a)
iterateOverArrayLen :: forall (v :: * -> *) a.
Vector v a =>
Decoder a -> ArrayIter -> Int -> DecoderM (v a)
iterateOverArrayLen Decoder a
f ArrayIter
iterPtr Int
len =
  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
run ->
    forall a. (Value -> IO a) -> IO a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
valPtr -> do
      Mutable v RealWorld a
v <- forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
GM.new Int
len
      Mutable v RealWorld a
_ <- forall a. DecoderM a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DecoderPrimM a -> DecoderM a
runDecoderPrimM forall a b. (a -> b) -> a -> b
$ forall {v :: * -> * -> *}.
MVector v a =>
Int -> v RealWorld a -> Value -> DecoderPrimM (v RealWorld a)
go (Int
0 :: Int) Mutable v RealWorld a
v Value
valPtr
      forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
G.unsafeFreeze Mutable v RealWorld a
v
  where
    go :: Int -> v RealWorld a -> Value -> DecoderPrimM (v RealWorld a)
go !Int
n v RealWorld a
acc Value
valPtr = do
      Bool
isOver <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Num a) => a -> Bool
F.toBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DecoderM a -> DecoderPrimM a
DecoderPrimM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ArrayIter -> IO CBool
arrayIterIsDoneImpl ArrayIter
iterPtr
      if Bool -> Bool
not Bool
isOver
        then do
          ()
_ <- forall a. DecoderM a -> DecoderPrimM a
DecoderPrimM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> DecoderM a -> DecoderM a
withIndex Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DecoderPrimM a -> DecoderM a
runDecoderPrimM forall a b. (a -> b) -> a -> b
$ do
            CInt
err <- forall a. DecoderM a -> DecoderPrimM a
DecoderPrimM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ArrayIter -> Value -> IO CInt
arrayIterGetCurrentImpl ArrayIter
iterPtr Value
valPtr
            forall a. DecoderM a -> DecoderPrimM a
DecoderPrimM forall a b. (a -> b) -> a -> b
$ Text -> CInt -> DecoderM ()
handleErrorCode Text
"" CInt
err
            !a
result <- forall a. DecoderM a -> DecoderPrimM a
DecoderPrimM forall a b. (a -> b) -> a -> b
$ forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder a
f Value
valPtr
            forall a. DecoderM a -> DecoderPrimM a
DecoderPrimM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ArrayIter -> IO ()
arrayIterMoveNextImpl ArrayIter
iterPtr
            forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
GM.unsafeWrite v RealWorld a
acc Int
n a
result
          Int -> v RealWorld a -> Value -> DecoderPrimM (v RealWorld a)
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) v RealWorld a
acc Value
valPtr
        else
          forall (f :: * -> *) a. Applicative f => a -> f a
pure v RealWorld a
acc
{-# INLINE iterateOverArrayLen #-}

-- | Helper to work with an ObjectIter started from a Value assumed to be an Object.
withObjectIter :: (ObjectIter -> DecoderM a) -> Decoder a
withObjectIter :: forall a. (ObjectIter -> DecoderM a) -> Decoder a
withObjectIter ObjectIter -> DecoderM a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \(Value Ptr JSONValue
valPtr) ->
  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
run -> do
    CInt
err <- Value -> IO CInt
getObjectIterFromValueImpl (Ptr JSONValue -> Value
Value Ptr JSONValue
valPtr)
    forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
      Text -> CInt -> DecoderM ()
handleErrorCode (Text -> Text
typePrefix Text
"object") CInt
err
      ObjectIter -> DecoderM a
f (Ptr JSONObjectIter -> ObjectIter
ObjectIter forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
F.castPtr Ptr JSONValue
valPtr)
{-# INLINE withObjectIter #-}

-- | Execute a function on each Field in an ObjectIter and accumulate into a `Map`.
iterateOverFieldsMap
  :: Ord a
  => (Text -> Decoder a)
  -> Decoder b
  -> ObjectIter
  -> DecoderM (Map a b)
iterateOverFieldsMap :: forall a b.
Ord a =>
(Text -> Decoder a)
-> Decoder b -> ObjectIter -> DecoderM (Map a b)
iterateOverFieldsMap Text -> Decoder a
fk Decoder b
fv ObjectIter
iterPtr =
  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
run ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CSize
lenPtr ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CString
keyPtr ->
        forall a. (Value -> IO a) -> IO a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
valPtr -> forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ Map a b -> Ptr CString -> Ptr CSize -> Value -> DecoderM (Map a b)
go forall k a. Map k a
M.empty Ptr CString
keyPtr Ptr CSize
lenPtr Value
valPtr
  where
    go :: Map a b -> Ptr CString -> Ptr CSize -> Value -> DecoderM (Map a b)
go !Map a b
acc Ptr CString
keyPtr Ptr CSize
lenPtr Value
valPtr = do
      Bool
isOver <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Num a) => a -> Bool
F.toBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ObjectIter -> IO CBool
objectIterIsDoneImpl ObjectIter
iterPtr
      if Bool -> Bool
not Bool
isOver
        then do
          CInt
err <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ObjectIter -> Ptr CString -> Ptr CSize -> Value -> IO CInt
objectIterGetCurrentImpl ObjectIter
iterPtr Ptr CString
keyPtr Ptr CSize
lenPtr Value
valPtr
          Text -> CInt -> DecoderM ()
handleErrorCode Text
"" CInt
err
          Int
kLen <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr CSize
lenPtr
          CString
kStr <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr CString
keyPtr
          Text
keyTxt <- CStringLen -> DecoderM Text
parseTextFromCStrLen (CString
kStr, Int
kLen)
          (a
k, b
v)
            <-
              forall a. Text -> DecoderM a -> DecoderM a
withKey Text
keyTxt forall a b. (a -> b) -> a -> b
$ do
                a
k <- forall a. Decoder a -> Value -> DecoderM a
runDecoder (Text -> Decoder a
fk Text
keyTxt) Value
valPtr
                b
v <- forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder b
fv Value
valPtr
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
k, b
v)
          forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ObjectIter -> IO ()
objectIterMoveNextImpl ObjectIter
iterPtr
          Map a b -> Ptr CString -> Ptr CSize -> Value -> DecoderM (Map a b)
go (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
k b
v Map a b
acc) Ptr CString
keyPtr Ptr CSize
lenPtr Value
valPtr
        else
          forall (f :: * -> *) a. Applicative f => a -> f a
pure Map a b
acc
{-# INLINE iterateOverFieldsMap #-}

iterateOverFieldsMapExcluding
  :: Ord a
  => [Text]
  -> (Text -> Decoder a)
  -> Decoder b
  -> ObjectIter
  -> DecoderM (Map a b)
iterateOverFieldsMapExcluding :: forall a b.
Ord a =>
[Text]
-> (Text -> Decoder a)
-> Decoder b
-> ObjectIter
-> DecoderM (Map a b)
iterateOverFieldsMapExcluding [Text]
fields Text -> Decoder a
fk Decoder b
fv ObjectIter
iterPtr =
  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
run ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CSize
lenPtr ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CString
keyPtr ->
        forall a. (Value -> IO a) -> IO a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
valPtr -> forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ Map a b -> Ptr CString -> Ptr CSize -> Value -> DecoderM (Map a b)
go forall k a. Map k a
M.empty Ptr CString
keyPtr Ptr CSize
lenPtr Value
valPtr
  where
    go :: Map a b -> Ptr CString -> Ptr CSize -> Value -> DecoderM (Map a b)
go !Map a b
acc Ptr CString
keyPtr Ptr CSize
lenPtr Value
valPtr = do
      Bool
isOver <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Num a) => a -> Bool
F.toBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ObjectIter -> IO CBool
objectIterIsDoneImpl ObjectIter
iterPtr
      if Bool -> Bool
not Bool
isOver
        then do
          CInt
err <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ObjectIter -> Ptr CString -> Ptr CSize -> Value -> IO CInt
objectIterGetCurrentImpl ObjectIter
iterPtr Ptr CString
keyPtr Ptr CSize
lenPtr Value
valPtr
          Text -> CInt -> DecoderM ()
handleErrorCode Text
"" CInt
err
          Int
kLen <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr CSize
lenPtr
          CString
kStr <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr CString
keyPtr
          Text
keyTxt <- CStringLen -> DecoderM Text
parseTextFromCStrLen (CString
kStr, Int
kLen)
          if Text
keyTxt forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
fields
            then do
              forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ObjectIter -> IO ()
objectIterMoveNextImpl ObjectIter
iterPtr
              Map a b -> Ptr CString -> Ptr CSize -> Value -> DecoderM (Map a b)
go Map a b
acc Ptr CString
keyPtr Ptr CSize
lenPtr Value
valPtr
            else do
              (a
k, b
v)
                <-
                  forall a. Text -> DecoderM a -> DecoderM a
withKey Text
keyTxt forall a b. (a -> b) -> a -> b
$ do
                    a
k <- forall a. Decoder a -> Value -> DecoderM a
runDecoder (Text -> Decoder a
fk Text
keyTxt) Value
valPtr
                    b
v <- forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder b
fv Value
valPtr
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
k, b
v)
              forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ObjectIter -> IO ()
objectIterMoveNextImpl ObjectIter
iterPtr
              Map a b -> Ptr CString -> Ptr CSize -> Value -> DecoderM (Map a b)
go (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
k b
v Map a b
acc) Ptr CString
keyPtr Ptr CSize
lenPtr Value
valPtr
        else
          forall (f :: * -> *) a. Applicative f => a -> f a
pure Map a b
acc
{-# INLINE iterateOverFieldsMapExcluding #-}

-- | Execute a function on each Field in an ObjectIter and
-- accumulate key-value tuples into a list.
iterateOverFields
  :: (Text -> Decoder a)
  -> Decoder b
  -> ObjectIter
  -> DecoderM [(a, b)]
iterateOverFields :: forall a b.
(Text -> Decoder a) -> Decoder b -> ObjectIter -> DecoderM [(a, b)]
iterateOverFields Text -> Decoder a
fk Decoder b
fv ObjectIter
iterPtr =
  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
run ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CSize
lenPtr ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CString
keyPtr ->
        forall a. (Value -> IO a) -> IO a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
valPtr -> forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ DList (a, b)
-> Ptr CString -> Ptr CSize -> Value -> DecoderM [(a, b)]
go forall a. DList a
DList.empty Ptr CString
keyPtr Ptr CSize
lenPtr Value
valPtr
  where
    go :: DList (a, b)
-> Ptr CString -> Ptr CSize -> Value -> DecoderM [(a, b)]
go DList (a, b)
acc Ptr CString
keyPtr Ptr CSize
lenPtr Value
valPtr = do
      Bool
isOver <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Num a) => a -> Bool
F.toBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ObjectIter -> IO CBool
objectIterIsDoneImpl ObjectIter
iterPtr
      if Bool -> Bool
not Bool
isOver
        then do
          CInt
err <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ObjectIter -> Ptr CString -> Ptr CSize -> Value -> IO CInt
objectIterGetCurrentImpl ObjectIter
iterPtr Ptr CString
keyPtr Ptr CSize
lenPtr Value
valPtr
          Text -> CInt -> DecoderM ()
handleErrorCode Text
"" CInt
err
          Int
kLen <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr CSize
lenPtr
          CString
kStr <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr CString
keyPtr
          Text
keyTxt <- CStringLen -> DecoderM Text
parseTextFromCStrLen (CString
kStr, Int
kLen)
          (a, b)
kv <-
            forall a. Text -> DecoderM a -> DecoderM a
withKey Text
keyTxt forall a b. (a -> b) -> a -> b
$ do
              a
k <- forall a. Decoder a -> Value -> DecoderM a
runDecoder (Text -> Decoder a
fk Text
keyTxt) Value
valPtr
              b
v <- forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder b
fv Value
valPtr
              forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
k, b
v)
          forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ ObjectIter -> IO ()
objectIterMoveNextImpl ObjectIter
iterPtr
          DList (a, b)
-> Ptr CString -> Ptr CSize -> Value -> DecoderM [(a, b)]
go (DList (a, b)
acc forall a. Semigroup a => a -> a -> a
<> forall a. a -> DList a
DList.singleton (a, b)
kv) Ptr CString
keyPtr Ptr CSize
lenPtr Value
valPtr
        else
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. DList a -> [a]
DList.toList DList (a, b)
acc
{-# INLINE iterateOverFields #-}

withUnorderedField :: Value -> Decoder a -> Object -> Text -> DecoderM a
withUnorderedField :: forall a. Value -> Decoder a -> Object -> Text -> DecoderM a
withUnorderedField Value
vPtr Decoder a
f Object
objPtr Text
key =
  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
run ->
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
Unsafe.unsafeUseAsCStringLen (Text -> ByteString
T.encodeUtf8 Text
key) forall a b. (a -> b) -> a -> b
$ \(CString
cstr, Int
len) ->
      forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ forall a. Text -> DecoderM a -> DecoderM a
withKey Text
key forall a b. (a -> b) -> a -> b
$ do
        CInt
err <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ Object -> CString -> Int -> Value -> IO CInt
findFieldUnorderedImpl Object
objPtr CString
cstr Int
len Value
vPtr
        Text -> CInt -> DecoderM ()
handleErrorCode Text
"" CInt
err
        forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder a
f Value
vPtr
{-# INLINE withUnorderedField #-}

withUnorderedOptionalField :: Value -> Decoder a -> Object -> Text -> DecoderM (Maybe a)
withUnorderedOptionalField :: forall a.
Value -> Decoder a -> Object -> Text -> DecoderM (Maybe a)
withUnorderedOptionalField Value
vPtr Decoder a
f Object
objPtr Text
key =
  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
run ->
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
Unsafe.unsafeUseAsCStringLen (Text -> ByteString
T.encodeUtf8 Text
key) forall a b. (a -> b) -> a -> b
$ \(CString
cstr, Int
len) ->
      forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ forall a. Text -> DecoderM a -> DecoderM a
withKey Text
key forall a b. (a -> b) -> a -> b
$ do
        CInt
err <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ Object -> CString -> Int -> Value -> IO CInt
findFieldUnorderedImpl Object
objPtr CString
cstr Int
len Value
vPtr
        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
err
        if | SIMDErrorCode
errCode forall a. Eq a => a -> a -> Bool
== SIMDErrorCode
SUCCESS       -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder a
f Value
vPtr
           | SIMDErrorCode
errCode forall a. Eq a => a -> a -> Bool
== SIMDErrorCode
NO_SUCH_FIELD -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
           | Bool
otherwise                -> forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> CInt -> DecoderM ()
handleErrorCode Text
"" CInt
err
{-# INLINE withUnorderedOptionalField #-}

withField :: Value -> Decoder a -> Object -> Text -> DecoderM a
withField :: forall a. Value -> Decoder a -> Object -> Text -> DecoderM a
withField Value
vPtr Decoder a
f Object
objPtr Text
key =
  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
run ->
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
Unsafe.unsafeUseAsCStringLen (Text -> ByteString
T.encodeUtf8 Text
key) forall a b. (a -> b) -> a -> b
$ \(CString
cstr, Int
len) ->
      forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ forall a. Text -> DecoderM a -> DecoderM a
withKey Text
key forall a b. (a -> b) -> a -> b
$ do
        CInt
err <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ Object -> CString -> Int -> Value -> IO CInt
findFieldImpl Object
objPtr CString
cstr Int
len Value
vPtr
        Text -> CInt -> DecoderM ()
handleErrorCode Text
"" CInt
err
        forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder a
f Value
vPtr
{-# INLINE withField #-}

getInt :: Value -> DecoderM Int
getInt :: Value -> DecoderM Int
getInt Value
valPtr =
  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
run ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int
ptr -> forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
      CInt
err <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ Value -> Ptr Int -> IO CInt
getIntImpl Value
valPtr Ptr Int
ptr
      Text -> CInt -> DecoderM ()
handleErrorCode (Text -> Text
typePrefix Text
"int") CInt
err
      forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr Int
ptr
{-# INLINE getInt #-}

getUInt :: Value -> DecoderM Word
getUInt :: Value -> DecoderM Word
getUInt Value
valPtr =
  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
run ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word
ptr -> forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
      CInt
err <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ Value -> Ptr Word -> IO CInt
getUIntImpl Value
valPtr Ptr Word
ptr
      Text -> CInt -> DecoderM ()
handleErrorCode (Text -> Text
typePrefix Text
"unsigned int") CInt
err
      forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr Word
ptr
{-# INLINE getUInt #-}

getDouble :: Value -> DecoderM Double
getDouble :: Value -> DecoderM Double
getDouble Value
valPtr =
  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
run ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr Double
ptr -> forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
      CInt
err <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ Value -> Ptr Double -> IO CInt
getDoubleImpl Value
valPtr Ptr Double
ptr
      Text -> CInt -> DecoderM ()
handleErrorCode (Text -> Text
typePrefix Text
"double") CInt
err
      forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr Double
ptr
{-# INLINE getDouble #-}

getBool :: Value -> DecoderM Bool
getBool :: Value -> DecoderM Bool
getBool Value
valPtr =
  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
run ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CBool
ptr -> forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
      CInt
err <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ Value -> Ptr CBool -> IO CInt
getBoolImpl Value
valPtr Ptr CBool
ptr
      Text -> CInt -> DecoderM ()
handleErrorCode (Text -> Text
typePrefix Text
"bool") CInt
err
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Num a) => a -> Bool
F.toBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr CBool
ptr
{-# INLINE getBool #-}

withCStringLen :: Text -> (F.CStringLen -> DecoderM a) -> Value -> DecoderM a
withCStringLen :: forall a. Text -> (CStringLen -> DecoderM a) -> Value -> DecoderM a
withCStringLen Text
lbl CStringLen -> DecoderM a
f Value
valPtr =
  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
run ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CString
strPtr ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CSize
lenPtr -> forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
        CInt
err <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ Value -> Ptr CString -> Ptr CSize -> IO CInt
getStringImpl Value
valPtr Ptr CString
strPtr Ptr CSize
lenPtr
        Text -> CInt -> DecoderM ()
handleErrorCode (Text -> Text
typePrefix Text
lbl) CInt
err
        Int
len <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr CSize
lenPtr
        CString
str <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr CString
strPtr
        CStringLen -> DecoderM a
f (CString
str, Int
len)
{-# INLINE withCStringLen #-}

getString :: Value -> DecoderM String
getString :: Value -> DecoderM [Char]
getString = forall a. Text -> (CStringLen -> DecoderM a) -> Value -> DecoderM a
withCStringLen Text
"string" (forall a. IO a -> DecoderM a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. CStringLen -> IO [Char]
F.peekCStringLen)
{-# INLINE getString #-}

getText :: Value -> DecoderM Text
getText :: Value -> DecoderM Text
getText = forall a. Text -> (CStringLen -> DecoderM a) -> Value -> DecoderM a
withCStringLen Text
"text" CStringLen -> DecoderM Text
parseTextFromCStrLen
{-# INLINE getText #-}

parseTextFromCStrLen :: F.CStringLen -> DecoderM Text
parseTextFromCStrLen :: CStringLen -> DecoderM Text
parseTextFromCStrLen (CString
cstr, Int
len) = forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> I8 -> IO Text
T.fromPtr (forall a b. Ptr a -> Ptr b
F.castPtr CString
cstr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
{-# INLINE parseTextFromCStrLen #-}

getRawByteString :: Value -> DecoderM BS.ByteString
getRawByteString :: Value -> DecoderM ByteString
getRawByteString Value
valPtr =
  forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CString
strPtr ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CSize
lenPtr -> do
        Value -> Ptr CString -> Ptr CSize -> IO ()
getRawJSONTokenImpl Value
valPtr Ptr CString
strPtr Ptr CSize
lenPtr
        Int
len <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr CSize
lenPtr
        CString
str <- forall a. Storable a => Ptr a -> IO a
F.peek Ptr CString
strPtr
        CStringLen -> IO ByteString
Unsafe.unsafePackCStringLen (CString
str, Int
len)
{-# INLINE getRawByteString #-}

getRawText :: Value -> DecoderM Text
getRawText :: Value -> DecoderM Text
getRawText Value
valPtr =
  forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CString
strPtr ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CSize
lenPtr -> do
        Value -> Ptr CString -> Ptr CSize -> IO ()
getRawJSONTokenImpl Value
valPtr Ptr CString
strPtr Ptr CSize
lenPtr
        I8
len <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr CSize
lenPtr
        CString
str <- forall a. Storable a => Ptr a -> IO a
F.peek Ptr CString
strPtr
        Ptr Word8 -> I8 -> IO Text
T.fromPtr (forall a b. Ptr a -> Ptr b
F.castPtr CString
str) I8
len
{-# INLINE getRawText #-}

-- | Helper to work with an Array and its length parsed from a Value.
withArrayLen :: ((Array, Int) -> DecoderM a) -> Decoder a
withArrayLen :: forall a. ((Array, Int) -> DecoderM a) -> Decoder a
withArrayLen (Array, Int) -> DecoderM a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \(Value Ptr JSONValue
val) ->
  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
run ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr CSize
outLen -> do
      CInt
err <- Value -> Ptr CSize -> IO CInt
getArrayLenFromValueImpl (Ptr JSONValue -> Value
Value Ptr JSONValue
val) Ptr CSize
outLen
      Int
len <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
F.peek Ptr CSize
outLen
      forall a. DecoderM a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
        Text -> CInt -> DecoderM ()
handleErrorCode (Text -> Text
typePrefix Text
"array") CInt
err
        (Array, Int) -> DecoderM a
f (Ptr JSONArray -> Array
Array forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
F.castPtr Ptr JSONValue
val, Int
len)
{-# INLINE withArrayLen #-}