{-# 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
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
objectAsKeyValues
:: (Text -> Decoder k)
-> Decoder v
-> 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 #-}
objectAsMap
:: Ord k
=> (Text -> Decoder k)
-> Decoder v
-> 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 #-}
objectAsMapExcluding
:: Ord k
=> [Text]
-> (Text -> Decoder k)
-> Decoder v
-> 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)
-> Decoder v
-> (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 #-}
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 #-}
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 #-}
string :: Decoder String
string :: Decoder [Char]
string = forall a. (Value -> DecoderM a) -> Decoder a
Decoder Value -> DecoderM [Char]
getString
{-# INLINE string #-}
text :: Decoder Text
text :: Decoder Text
text = forall a. (Value -> DecoderM a) -> Decoder a
Decoder Value -> DecoderM Text
getText
{-# INLINE text #-}
bool :: Decoder Bool
bool :: Decoder Bool
bool = forall a. (Value -> DecoderM a) -> Decoder a
Decoder Value -> DecoderM Bool
getBool
{-# INLINE bool #-}
int :: Decoder Int
int :: Decoder Int
int = forall a. (Value -> DecoderM a) -> Decoder a
Decoder Value -> DecoderM Int
getInt
{-# INLINE[2] int #-}
uint :: Decoder Word
uint :: Decoder Word
uint = forall a. (Value -> DecoderM a) -> Decoder a
Decoder Value -> DecoderM Word
getUInt
{-# INLINE uint #-}
double :: Decoder Double
double :: Decoder Double
double = forall a. (Value -> DecoderM a) -> Decoder a
Decoder Value -> DecoderM Double
getDouble
{-# INLINE[2] double #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}