{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-}
module Data.Hermes.Decoder.Value
( atKey
, atKeyOptional
, atKeyStrict
, atPointer
, bool
, char
, double
, int
, getType
, list
, nullable
, objectAsKeyValues
, objectAsMap
, parseScientific
, scientific
, string
, text
, listOfDouble
, listOfInt
, isNull
, vector
, withArray
, withBool
, withDouble
, withInt
, withObject
, withObjectAsMap
, withRawByteString
, withScientific
, withString
, withText
, withType
, withVector
) where
import Control.Monad ((>=>))
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.ByteString.Char8 as AC (scientific)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Unsafe as Unsafe
import Data.Map (Map)
import qualified Data.Map.Strict as M
import qualified Data.DList as DList
import qualified Data.Scientific as Sci
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
#if MIN_VERSION_text(2,0,0)
import qualified Data.Text.Foreign as T
import qualified Foreign.Ptr as F
#endif
import 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.Storable as F
import Data.Hermes.Decoder.Internal
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 #-}
withObject :: (Object -> Decoder a) -> Decoder a
withObject :: forall a. (Object -> Decoder a) -> Decoder a
withObject Object -> Decoder a
f = 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. (Object -> IO a) -> IO a
allocaObject forall a b. (a -> b) -> a -> b
$ \Object
oPtr -> do
CInt
err <- Value -> Object -> IO CInt
getObjectFromValueImpl Value
valPtr Object
oPtr
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 (Object -> Decoder a
f Object
oPtr) Value
valPtr
{-# INLINE withObject #-}
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 #-}
withString :: (String -> Decoder a) -> Decoder a
withString :: forall a. (String -> Decoder a) -> Decoder a
withString String -> Decoder a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> Value -> DecoderM String
getString Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
s -> forall a. Decoder a -> Value -> DecoderM a
runDecoder (String -> Decoder a
f String
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 #-}
withArray :: (Array -> Decoder a) -> Decoder a
withArray :: forall a. (Array -> Decoder a) -> Decoder a
withArray Array -> Decoder a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
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. (Array -> IO a) -> IO a
allocaArray forall a b. (a -> b) -> a -> b
$ \Array
arrPtr -> do
CInt
err <- Value -> Array -> IO CInt
getArrayFromValueImpl Value
val Array
arrPtr
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
forall a. Decoder a -> Value -> DecoderM a
runDecoder (Array -> Decoder a
f Array
arrPtr) Value
val
{-# INLINE withArray #-}
atKey :: Text -> Decoder a -> Object -> Decoder a
atKey :: forall a. Text -> Decoder a -> Object -> Decoder a
atKey Text
key Decoder a
parser Object
obj = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. Decoder a -> Object -> Text -> DecoderM a
withUnorderedField Decoder a
parser Object
obj Text
key
{-# INLINE atKey #-}
atKeyOptional :: Text -> Decoder a -> Object -> Decoder (Maybe a)
atKeyOptional :: forall a. Text -> Decoder a -> Object -> Decoder (Maybe a)
atKeyOptional Text
key Decoder a
parser Object
obj = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. Decoder a -> Object -> Text -> DecoderM (Maybe a)
withUnorderedOptionalField Decoder a
parser Object
obj Text
key
{-# INLINE atKeyOptional #-}
atKeyStrict :: Text -> Decoder a -> Object -> Decoder a
atKeyStrict :: forall a. Text -> Decoder a -> Object -> Decoder a
atKeyStrict Text
key Decoder a
parser Object
obj = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. Decoder a -> Object -> Text -> DecoderM a
withField 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 #-}
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 => String -> m a
fail String
"Expected a single character"
{-# INLINE char #-}
string :: Decoder String
string :: Decoder String
string = forall a. (Value -> DecoderM a) -> Decoder a
Decoder Value -> DecoderM String
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 #-}
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. (ByteString -> Decoder a) -> Decoder a
withRawByteString ByteString -> 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 #-}
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 #-}
parseScientific :: BS.ByteString -> Decoder Sci.Scientific
parseScientific :: ByteString -> Decoder Scientific
parseScientific
= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to parse Scientific: " forall a. Semigroup a => a -> a -> a
<> String
err) forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser ByteString Scientific
AC.scientific forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
A.endOfInput)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSC.strip
{-# INLINE parseScientific #-}
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
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. (ArrayIter -> IO a) -> IO a
allocaArrayIter forall a b. (a -> b) -> a -> b
$ \ArrayIter
iterPtr -> do
CInt
err <- Value -> ArrayIter -> IO CInt
getArrayIterFromValueImpl Value
valPtr ArrayIter
iterPtr
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 ArrayIter
iterPtr
{-# 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
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. (ArrayIter -> IO a) -> IO a
allocaArrayIter forall a b. (a -> b) -> a -> b
$ \ArrayIter
iterPtr ->
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 -> ArrayIter -> Ptr CSize -> IO CInt
getArrayIterLenFromValueImpl Value
valPtr ArrayIter
iterPtr 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 ArrayIter
iterPtr 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
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. (ObjectIter -> IO a) -> IO a
allocaObjectIter forall a b. (a -> b) -> a -> b
$ \ObjectIter
iterPtr -> do
CInt
err <- Value -> ObjectIter -> IO CInt
getObjectIterFromValueImpl Value
valPtr ObjectIter
iterPtr
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 ObjectIter
iterPtr
{-# 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 #-}
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 :: Decoder a -> Object -> Text -> DecoderM a
withUnorderedField :: forall a. Decoder a -> Object -> Text -> DecoderM a
withUnorderedField 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. (Value -> IO a) -> IO a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
vPtr -> 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 :: Decoder a -> Object -> Text -> DecoderM (Maybe a)
withUnorderedOptionalField :: forall a. Decoder a -> Object -> Text -> DecoderM (Maybe a)
withUnorderedOptionalField 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. (Value -> IO a) -> IO a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
vPtr -> 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 :: Decoder a -> Object -> Text -> DecoderM a
withField :: forall a. Decoder a -> Object -> Text -> DecoderM a
withField 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. (Value -> IO a) -> IO a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
val -> 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
val
Text -> CInt -> DecoderM ()
handleErrorCode Text
"" CInt
err
forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder a
f Value
val
{-# 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 #-}
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 String
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 String
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 #-}
#if MIN_VERSION_text(2,0,0)
parseTextFromCStrLen :: F.CStringLen -> DecoderM Text
parseTextFromCStrLen (cstr, len) = liftIO $ T.fromPtr (F.castPtr cstr) (fromIntegral len)
{-# INLINE parseTextFromCStrLen #-}
#else
parseTextFromCStrLen :: F.CStringLen -> DecoderM Text
parseTextFromCStrLen :: CStringLen -> DecoderM Text
parseTextFromCStrLen CStringLen
cstr = do
ByteString
bs <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ByteString
Unsafe.unsafePackCStringLen CStringLen
cstr
case forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser (Maybe Text)
asciiTextAtto ByteString
bs of
Left String
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Could not parse text: " forall a. Semigroup a => a -> a -> a
<> String
err
Right Maybe Text
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! ByteString -> Text
T.decodeUtf8 ByteString
bs
Right (Just Text
r) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Text
r
{-# INLINE parseTextFromCStrLen #-}
asciiTextAtto :: A.Parser (Maybe Text)
asciiTextAtto :: Parser (Maybe Text)
asciiTextAtto = do
ByteString
s <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile (\Word8
w -> Word8
w forall a. Eq a => a -> a -> Bool
/= Word8
92 Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
0x20 Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
< Word8
0x80)
let txt :: Text
txt = ByteString -> Text
T.decodeLatin1 ByteString
s
Maybe Word8
mw <- Parser (Maybe Word8)
A.peekWord8
case Maybe Word8
mw of
Maybe Word8
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
txt
Maybe Word8
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
{-# INLINE asciiTextAtto #-}
#endif
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 #-}
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
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. (Array -> IO a) -> IO a
allocaArray forall a b. (a -> b) -> a -> b
$ \Array
arrPtr ->
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 -> Array -> Ptr CSize -> IO CInt
getArrayLenFromValueImpl Value
val Array
arrPtr 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 (Array
arrPtr, Int
len)
{-# INLINE withArrayLen #-}