{-# 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

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

-- | Helper to work with an Object parsed from a Value.
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 #-}

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

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

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

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

-- | Helper to work with a String parsed from a Value.
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 #-}

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

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

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

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

-- | Helper to work with an Array parsed from a Value.
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 #-}

-- | Find an object field by key, where an exception is thrown
-- if the key is missing.
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 #-}

-- | Find an object field by key, where Nothing is returned
-- if the key is missing.
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 #-}

-- | Uses find_field, which means if you access a field out-of-order
-- this will throw an exception. It also cannot support optional fields.
atKeyStrict :: Text -> Decoder a -> 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 #-}

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

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

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

-- | Parse an object into a homogenous list of key-value tuples.
objectAsKeyValues
  :: (Text -> Decoder k)
  -- ^ Parses a Text key in the Decoder monad. JSON keys are always text.
  -> Decoder v
  -- ^ Decoder for the field value.
  -> Decoder [(k, v)]
objectAsKeyValues :: forall k v. (Text -> Decoder k) -> Decoder v -> Decoder [(k, v)]
objectAsKeyValues Text -> Decoder k
kf Decoder v
vf = forall a. (ObjectIter -> DecoderM a) -> Decoder a
withObjectIter forall a b. (a -> b) -> a -> b
$ forall a b.
(Text -> Decoder a) -> Decoder b -> ObjectIter -> DecoderM [(a, b)]
iterateOverFields Text -> Decoder k
kf Decoder v
vf
{-# INLINE objectAsKeyValues #-}

-- | Parse an object into a strict `Map`.
objectAsMap
  :: Ord k
  => (Text -> Decoder k)
  -- ^ Parses a Text key in the Decoder monad. JSON keys are always text.
  -> Decoder v
  -- ^ Decoder for the field value.
  -> Decoder (Map k v)
objectAsMap :: forall k v.
Ord k =>
(Text -> Decoder k) -> Decoder v -> Decoder (Map k v)
objectAsMap Text -> Decoder k
kf Decoder v
vf = forall a. (ObjectIter -> DecoderM a) -> Decoder a
withObjectIter forall a b. (a -> b) -> a -> b
$ forall a b.
Ord a =>
(Text -> Decoder a)
-> Decoder b -> ObjectIter -> DecoderM (Map a b)
iterateOverFieldsMap Text -> Decoder k
kf Decoder v
vf
{-# INLINE objectAsMap #-}

withObjectAsMap
  :: Ord k
  => (Text -> Decoder k)
  -- ^ Parses a Text key in the Decoder monad. JSON keys are always text.
  -> Decoder v
  -- ^ Decoder for the field value.
  -> (Map k v -> Decoder a)
  -> Decoder a
withObjectAsMap :: forall k v a.
Ord k =>
(Text -> Decoder k)
-> Decoder v -> (Map k v -> Decoder a) -> Decoder a
withObjectAsMap Text -> Decoder k
kf Decoder v
vf Map k v -> Decoder a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> forall a. Decoder a -> Value -> DecoderM a
runDecoder (forall k v.
Ord k =>
(Text -> Decoder k) -> Decoder v -> Decoder (Map k v)
objectAsMap Text -> Decoder k
kf Decoder v
vf) Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Map k v
m -> forall a. Decoder a -> Value -> DecoderM a
runDecoder (Map k v -> Decoder a
f Map k v
m) Value
val
{-# INLINE withObjectAsMap #-}

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

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

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

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

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

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

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

-- | Parse a Scientific from a Value.
scientific :: Decoder Sci.Scientific
scientific :: Decoder Scientific
scientific = forall a. (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 #-}

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

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

-- | Parse a Scientific using attoparsec's ByteString.Char8 parser.
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 #-}

-- Internal Functions

-- | Helper to work with an ArrayIter started from a Value assumed to be an Array.
withArrayIter :: (ArrayIter -> DecoderM a) -> Decoder a
withArrayIter :: forall a. (ArrayIter -> DecoderM a) -> Decoder a
withArrayIter ArrayIter -> DecoderM a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
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 #-}

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

-- | Helper to work with an ArrayIter and its length.
withArrayLenIter :: (ArrayIter -> Int -> DecoderM a) -> Decoder a
withArrayLenIter :: forall a. (ArrayIter -> Int -> DecoderM a) -> Decoder a
withArrayLenIter ArrayIter -> Int -> DecoderM a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
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 #-}

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

-- | Helper to work with an ObjectIter started from a Value assumed to be an Object.
withObjectIter :: (ObjectIter -> DecoderM a) -> Decoder a
withObjectIter :: forall a. (ObjectIter -> DecoderM a) -> Decoder a
withObjectIter ObjectIter -> DecoderM a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
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 #-}

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

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

withUnorderedField :: 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 #-}

-- | Helper to work with an Array and its length parsed from a Value.
withArrayLen :: ((Array, Int) -> DecoderM a) -> Decoder a
withArrayLen :: forall a. ((Array, Int) -> DecoderM a) -> Decoder a
withArrayLen (Array, Int) -> DecoderM a
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
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 #-}