{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}
module Data.Hermes.Decoder.Value
( atKey
, atKeyOptional
, atKeyStrict
, atPointer
, bool
, char
, double
, int
, list
, nullable
, objectAsKeyValues
, scientific
, string
, text
, listOfDouble
, listOfInt
, isNull
, withArray
, withBool
, withDocumentValue
, withDouble
, withInt
, withObject
, withRawByteString
, withString
, withText
) where
import Control.Monad ((>=>))
import Control.Monad.IO.Class (liftIO)
import Control.Monad.IO.Unlift (withRunInIO)
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 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
import UnliftIO.Foreign
( CStringLen
, alloca
, peek
, peekArray
, peekCStringLen
, toBool
)
import qualified UnliftIO.Foreign as Foreign
import Data.Hermes.Decoder.Path
import Data.Hermes.Decoder.Types
import Data.Hermes.SIMDJSON
withDocumentValue :: (Value -> Decoder a) -> InputBuffer -> Decoder a
withDocumentValue :: (Value -> Decoder a) -> InputBuffer -> Decoder a
withDocumentValue Value -> Decoder a
f InputBuffer
inputPtr =
(Value -> Decoder a) -> Decoder a
forall a. (Value -> Decoder a) -> Decoder a
allocaValue ((Value -> Decoder a) -> Decoder a)
-> (Value -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Value
valPtr ->
(Parser -> Decoder a) -> Decoder a
forall a. (Parser -> Decoder a) -> Decoder a
withParserPointer ((Parser -> Decoder a) -> Decoder a)
-> (Parser -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Parser
parserPtr ->
(Document -> Decoder a) -> Decoder a
forall a. (Document -> Decoder a) -> Decoder a
withDocumentPointer ((Document -> Decoder a) -> Decoder a)
-> (Document -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Document
docPtr -> do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Parser -> InputBuffer -> Document -> Value -> IO CInt
getDocumentValueImpl Parser
parserPtr InputBuffer
inputPtr Document
docPtr Value
valPtr
Text -> CInt -> Decoder ()
handleErrorCode Text
"" CInt
err
Value -> Decoder a
f Value
valPtr
atPointer :: Text -> (Value -> Decoder a) -> Decoder a
atPointer :: Text -> (Value -> Decoder a) -> Decoder a
atPointer Text
jptr Value -> Decoder a
f =
(Document -> Decoder a) -> Decoder a
forall a. (Document -> Decoder a) -> Decoder a
withDocumentPointer ((Document -> Decoder a) -> Decoder a)
-> (Document -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Document
docPtr ->
((forall a. Decoder a -> IO a) -> IO a) -> Decoder a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. Decoder a -> IO a) -> IO a) -> Decoder a)
-> ((forall a. Decoder a -> IO a) -> IO a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
Unsafe.unsafeUseAsCStringLen (Text -> ByteString
T.encodeUtf8 Text
jptr) ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cstr, Int
len) -> Decoder a -> IO a
forall a. Decoder a -> IO a
run (Decoder a -> IO a) -> Decoder a -> IO a
forall a b. (a -> b) -> a -> b
$
(Value -> Decoder a) -> Decoder a
forall a. (Value -> Decoder a) -> Decoder a
allocaValue ((Value -> Decoder a) -> Decoder a)
-> (Value -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Value
vPtr -> Text -> Decoder a -> Decoder a
forall a. Text -> Decoder a -> Decoder a
withPath Text
jptr (Decoder a -> Decoder a) -> Decoder a -> Decoder a
forall a b. (a -> b) -> a -> b
$ do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> Int -> Document -> Value -> IO CInt
atPointerImpl Ptr CChar
cstr Int
len Document
docPtr Value
vPtr
Text -> CInt -> Decoder ()
handleErrorCode Text
"" CInt
err
Value -> Decoder a
f Value
vPtr
withObject :: (Object -> Decoder a) -> Value -> Decoder a
withObject :: (Object -> Decoder a) -> Value -> Decoder a
withObject Object -> Decoder a
f Value
valPtr = (Object -> Decoder a) -> Decoder a
forall a. (Object -> Decoder a) -> Decoder a
allocaObject ((Object -> Decoder a) -> Decoder a)
-> (Object -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Object
oPtr -> do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Value -> Object -> IO CInt
getObjectFromValueImpl Value
valPtr Object
oPtr
Text -> CInt -> Decoder ()
handleErrorCode (Text -> Text
typePrefix Text
"object") CInt
err
Object -> Decoder a
f Object
oPtr
withObjectIter :: (ObjectIter -> Decoder a) -> Value -> Decoder a
withObjectIter :: (ObjectIter -> Decoder a) -> Value -> Decoder a
withObjectIter ObjectIter -> Decoder a
f Value
valPtr = (ObjectIter -> Decoder a) -> Decoder a
forall a. (ObjectIter -> Decoder a) -> Decoder a
allocaObjectIter ((ObjectIter -> Decoder a) -> Decoder a)
-> (ObjectIter -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \ObjectIter
iterPtr -> do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Value -> ObjectIter -> IO CInt
getObjectIterFromValueImpl Value
valPtr ObjectIter
iterPtr
Text -> CInt -> Decoder ()
handleErrorCode Text
"" CInt
err
ObjectIter -> Decoder a
f ObjectIter
iterPtr
{-# INLINE withObjectIter #-}
iterateOverFields :: (Text -> Decoder a) -> (Value -> Decoder b) -> ObjectIter -> Decoder [(a, b)]
iterateOverFields :: (Text -> Decoder a)
-> (Value -> Decoder b) -> ObjectIter -> Decoder [(a, b)]
iterateOverFields Text -> Decoder a
fk Value -> Decoder b
fv ObjectIter
iterPtr = ((forall a. Decoder a -> IO a) -> IO [(a, b)]) -> Decoder [(a, b)]
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. Decoder a -> IO a) -> IO [(a, b)])
-> Decoder [(a, b)])
-> ((forall a. Decoder a -> IO a) -> IO [(a, b)])
-> Decoder [(a, b)]
forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
runInIO ->
(Ptr CSize -> IO [(a, b)]) -> IO [(a, b)]
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca ((Ptr CSize -> IO [(a, b)]) -> IO [(a, b)])
-> (Ptr CSize -> IO [(a, b)]) -> IO [(a, b)]
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
lenPtr ->
(Ptr (Ptr CChar) -> IO [(a, b)]) -> IO [(a, b)]
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca ((Ptr (Ptr CChar) -> IO [(a, b)]) -> IO [(a, b)])
-> (Ptr (Ptr CChar) -> IO [(a, b)]) -> IO [(a, b)]
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
keyPtr -> Decoder [(a, b)] -> IO [(a, b)]
forall a. Decoder a -> IO a
runInIO (Decoder [(a, b)] -> IO [(a, b)])
-> Decoder [(a, b)] -> IO [(a, b)]
forall a b. (a -> b) -> a -> b
$
(Value -> Decoder [(a, b)]) -> Decoder [(a, b)]
forall a. (Value -> Decoder a) -> Decoder a
allocaValue ((Value -> Decoder [(a, b)]) -> Decoder [(a, b)])
-> (Value -> Decoder [(a, b)]) -> Decoder [(a, b)]
forall a b. (a -> b) -> a -> b
$ \Value
valPtr ->
DList (a, b)
-> Ptr (Ptr CChar) -> Ptr CSize -> Value -> Decoder [(a, b)]
go DList (a, b)
forall a. DList a
DList.empty Ptr (Ptr CChar)
keyPtr Ptr CSize
lenPtr Value
valPtr
where
{-# INLINE go #-}
go :: DList (a, b)
-> Ptr (Ptr CChar) -> Ptr CSize -> Value -> Decoder [(a, b)]
go !DList (a, b)
acc Ptr (Ptr CChar)
keyPtr Ptr CSize
lenPtr Value
valPtr = do
Bool
isOver <- (CBool -> Bool) -> Decoder CBool -> Decoder Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Decoder CBool -> Decoder Bool)
-> (IO CBool -> Decoder CBool) -> IO CBool -> Decoder Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CBool -> Decoder CBool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CBool -> Decoder Bool) -> IO CBool -> Decoder Bool
forall a b. (a -> b) -> a -> b
$ ObjectIter -> IO CBool
objectIterIsDoneImpl ObjectIter
iterPtr
if Bool -> Bool
not Bool
isOver
then do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ ObjectIter -> Ptr (Ptr CChar) -> Ptr CSize -> Value -> IO CInt
objectIterGetCurrentImpl ObjectIter
iterPtr Ptr (Ptr CChar)
keyPtr Ptr CSize
lenPtr Value
valPtr
Text -> CInt -> Decoder ()
handleErrorCode Text
"" CInt
err
Int
kLen <- (CSize -> Int) -> Decoder CSize -> Decoder Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Decoder CSize -> Decoder Int)
-> (IO CSize -> Decoder CSize) -> IO CSize -> Decoder Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CSize -> Decoder CSize
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> Decoder Int) -> IO CSize -> Decoder Int
forall a b. (a -> b) -> a -> b
$ Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
lenPtr
Ptr CChar
kStr <- IO (Ptr CChar) -> Decoder (Ptr CChar)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr CChar) -> Decoder (Ptr CChar))
-> IO (Ptr CChar) -> Decoder (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
keyPtr
Text
keyTxt <- CStringLen -> Decoder Text
parseTextFromCStrLen (Ptr CChar
kStr, Int
kLen)
Text -> Decoder [(a, b)] -> Decoder [(a, b)]
forall a. Text -> Decoder a -> Decoder a
withPath (Text -> Text
dot Text
keyTxt) (Decoder [(a, b)] -> Decoder [(a, b)])
-> Decoder [(a, b)] -> Decoder [(a, b)]
forall a b. (a -> b) -> a -> b
$ do
a
k <- Text -> Decoder a
fk Text
keyTxt
b
v <- Value -> Decoder b
fv Value
valPtr
IO () -> Decoder ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Decoder ()) -> IO () -> Decoder ()
forall a b. (a -> b) -> a -> b
$ ObjectIter -> IO ()
objectIterMoveNextImpl ObjectIter
iterPtr
Text -> Decoder [(a, b)] -> Decoder [(a, b)]
forall a. Text -> Decoder a -> Decoder a
removePath (Text -> Text
dot Text
keyTxt) (Decoder [(a, b)] -> Decoder [(a, b)])
-> Decoder [(a, b)] -> Decoder [(a, b)]
forall a b. (a -> b) -> a -> b
$
DList (a, b)
-> Ptr (Ptr CChar) -> Ptr CSize -> Value -> Decoder [(a, b)]
go (DList (a, b)
acc DList (a, b) -> DList (a, b) -> DList (a, b)
forall a. Semigroup a => a -> a -> a
<> (a, b) -> DList (a, b)
forall a. a -> DList a
DList.singleton (a
k, b
v)) Ptr (Ptr CChar)
keyPtr Ptr CSize
lenPtr Value
valPtr
else
[(a, b)] -> Decoder [(a, b)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(a, b)] -> Decoder [(a, b)]) -> [(a, b)] -> Decoder [(a, b)]
forall a b. (a -> b) -> a -> b
$ DList (a, b) -> [(a, b)]
forall a. DList a -> [a]
DList.toList DList (a, b)
acc
withUnorderedField :: (Value -> Decoder a) -> Object -> Text -> Decoder a
withUnorderedField :: (Value -> Decoder a) -> Object -> Text -> Decoder a
withUnorderedField Value -> Decoder a
f Object
objPtr Text
key = ((forall a. Decoder a -> IO a) -> IO a) -> Decoder a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. Decoder a -> IO a) -> IO a) -> Decoder a)
-> ((forall a. Decoder a -> IO a) -> IO a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
Unsafe.unsafeUseAsCStringLen (Text -> ByteString
T.encodeUtf8 Text
key) ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cstr, Int
len) -> Decoder a -> IO a
forall a. Decoder a -> IO a
run (Decoder a -> IO a) -> Decoder a -> IO a
forall a b. (a -> b) -> a -> b
$
(Value -> Decoder a) -> Decoder a
forall a. (Value -> Decoder a) -> Decoder a
allocaValue ((Value -> Decoder a) -> Decoder a)
-> (Value -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Value
vPtr -> Text -> Decoder a -> Decoder a
forall a. Text -> Decoder a -> Decoder a
withPath (Text -> Text
dot Text
key) (Decoder a -> Decoder a) -> Decoder a -> Decoder a
forall a b. (a -> b) -> a -> b
$ do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Object -> Ptr CChar -> Int -> Value -> IO CInt
findFieldUnorderedImpl Object
objPtr Ptr CChar
cstr Int
len Value
vPtr
Text -> CInt -> Decoder ()
handleErrorCode Text
"" CInt
err
Value -> Decoder a
f Value
vPtr
{-# INLINE withUnorderedField #-}
withUnorderedOptionalField :: (Value -> Decoder a) -> Object -> Text -> Decoder (Maybe a)
withUnorderedOptionalField :: (Value -> Decoder a) -> Object -> Text -> Decoder (Maybe a)
withUnorderedOptionalField Value -> Decoder a
f Object
objPtr Text
key = ((forall a. Decoder a -> IO a) -> IO (Maybe a))
-> Decoder (Maybe a)
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. Decoder a -> IO a) -> IO (Maybe a))
-> Decoder (Maybe a))
-> ((forall a. Decoder a -> IO a) -> IO (Maybe a))
-> Decoder (Maybe a)
forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
ByteString -> (CStringLen -> IO (Maybe a)) -> IO (Maybe a)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
Unsafe.unsafeUseAsCStringLen (Text -> ByteString
T.encodeUtf8 Text
key) ((CStringLen -> IO (Maybe a)) -> IO (Maybe a))
-> (CStringLen -> IO (Maybe a)) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cstr, Int
len) -> Decoder (Maybe a) -> IO (Maybe a)
forall a. Decoder a -> IO a
run (Decoder (Maybe a) -> IO (Maybe a))
-> Decoder (Maybe a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$
(Value -> Decoder (Maybe a)) -> Decoder (Maybe a)
forall a. (Value -> Decoder a) -> Decoder a
allocaValue ((Value -> Decoder (Maybe a)) -> Decoder (Maybe a))
-> (Value -> Decoder (Maybe a)) -> Decoder (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Value
vPtr -> Text -> Decoder (Maybe a) -> Decoder (Maybe a)
forall a. Text -> Decoder a -> Decoder a
withPath (Text -> Text
dot Text
key) (Decoder (Maybe a) -> Decoder (Maybe a))
-> Decoder (Maybe a) -> Decoder (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Object -> Ptr CChar -> Int -> Value -> IO CInt
findFieldUnorderedImpl Object
objPtr Ptr CChar
cstr Int
len Value
vPtr
let errCode :: SIMDErrorCode
errCode = Int -> SIMDErrorCode
forall a. Enum a => Int -> a
toEnum (Int -> SIMDErrorCode) -> Int -> SIMDErrorCode
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
err
if | SIMDErrorCode
errCode SIMDErrorCode -> SIMDErrorCode -> Bool
forall a. Eq a => a -> a -> Bool
== SIMDErrorCode
SUCCESS -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Decoder a -> Decoder (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Decoder a
f Value
vPtr
| SIMDErrorCode
errCode SIMDErrorCode -> SIMDErrorCode -> Bool
forall a. Eq a => a -> a -> Bool
== SIMDErrorCode
NO_SUCH_FIELD -> Maybe a -> Decoder (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
| Bool
otherwise -> Maybe a
forall a. Maybe a
Nothing Maybe a -> Decoder () -> Decoder (Maybe a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> CInt -> Decoder ()
handleErrorCode Text
"" CInt
err
{-# INLINE withUnorderedOptionalField #-}
withField :: (Value -> Decoder a) -> Object -> Text -> Decoder a
withField :: (Value -> Decoder a) -> Object -> Text -> Decoder a
withField Value -> Decoder a
f Object
objPtr Text
key = ((forall a. Decoder a -> IO a) -> IO a) -> Decoder a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. Decoder a -> IO a) -> IO a) -> Decoder a)
-> ((forall a. Decoder a -> IO a) -> IO a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
Unsafe.unsafeUseAsCStringLen (Text -> ByteString
T.encodeUtf8 Text
key) ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cstr, Int
len) -> Decoder a -> IO a
forall a. Decoder a -> IO a
run (Decoder a -> IO a) -> Decoder a -> IO a
forall a b. (a -> b) -> a -> b
$
(Value -> Decoder a) -> Decoder a
forall a. (Value -> Decoder a) -> Decoder a
allocaValue ((Value -> Decoder a) -> Decoder a)
-> (Value -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Value
vPtr -> Text -> Decoder a -> Decoder a
forall a. Text -> Decoder a -> Decoder a
withPath (Text -> Text
dot Text
key) (Decoder a -> Decoder a) -> Decoder a -> Decoder a
forall a b. (a -> b) -> a -> b
$ do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Object -> Ptr CChar -> Int -> Value -> IO CInt
findFieldImpl Object
objPtr Ptr CChar
cstr Int
len Value
vPtr
Text -> CInt -> Decoder ()
handleErrorCode Text
"" CInt
err
Value -> Decoder a
f Value
vPtr
{-# INLINE withField #-}
getInt :: Value -> Decoder Int
getInt :: Value -> Decoder Int
getInt Value
valPtr = ((forall a. Decoder a -> IO a) -> IO Int) -> Decoder Int
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. Decoder a -> IO a) -> IO Int) -> Decoder Int)
-> ((forall a. Decoder a -> IO a) -> IO Int) -> Decoder Int
forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
(Ptr Int -> IO Int) -> IO Int
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca ((Ptr Int -> IO Int) -> IO Int) -> (Ptr Int -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Int
ptr -> Decoder Int -> IO Int
forall a. Decoder a -> IO a
run (Decoder Int -> IO Int) -> Decoder Int -> IO Int
forall a b. (a -> b) -> a -> b
$ do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Value -> Ptr Int -> IO CInt
getIntImpl Value
valPtr Ptr Int
ptr
Text -> CInt -> Decoder ()
handleErrorCode (Text -> Text
typePrefix Text
"int") CInt
err
IO Int -> Decoder Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> Decoder Int) -> IO Int -> Decoder Int
forall a b. (a -> b) -> a -> b
$ Ptr Int -> IO Int
forall a. Storable a => Ptr a -> IO a
peek Ptr Int
ptr
{-# INLINE getInt #-}
withInt :: (Int -> Decoder a) -> Value -> Decoder a
withInt :: (Int -> Decoder a) -> Value -> Decoder a
withInt Int -> Decoder a
f = Value -> Decoder Int
getInt (Value -> Decoder Int) -> (Int -> Decoder a) -> Value -> Decoder a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Int -> Decoder a
f
getDouble :: Value -> Decoder Double
getDouble :: Value -> Decoder Double
getDouble Value
valPtr = ((forall a. Decoder a -> IO a) -> IO Double) -> Decoder Double
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. Decoder a -> IO a) -> IO Double) -> Decoder Double)
-> ((forall a. Decoder a -> IO a) -> IO Double) -> Decoder Double
forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
(Ptr Double -> IO Double) -> IO Double
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca ((Ptr Double -> IO Double) -> IO Double)
-> (Ptr Double -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Double
ptr -> Decoder Double -> IO Double
forall a. Decoder a -> IO a
run (Decoder Double -> IO Double) -> Decoder Double -> IO Double
forall a b. (a -> b) -> a -> b
$ do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Value -> Ptr Double -> IO CInt
getDoubleImpl Value
valPtr Ptr Double
ptr
Text -> CInt -> Decoder ()
handleErrorCode (Text -> Text
typePrefix Text
"double") CInt
err
IO Double -> Decoder Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> Decoder Double) -> IO Double -> Decoder Double
forall a b. (a -> b) -> a -> b
$ Ptr Double -> IO Double
forall a. Storable a => Ptr a -> IO a
peek Ptr Double
ptr
{-# INLINE getDouble #-}
withDouble :: (Double -> Decoder a) -> Value -> Decoder a
withDouble :: (Double -> Decoder a) -> Value -> Decoder a
withDouble Double -> Decoder a
f = Value -> Decoder Double
getDouble (Value -> Decoder Double)
-> (Double -> Decoder a) -> Value -> Decoder a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Double -> Decoder a
f
parseScientific :: BS.ByteString -> Decoder Sci.Scientific
parseScientific :: ByteString -> Decoder Scientific
parseScientific
= (String -> Decoder Scientific)
-> (Scientific -> Decoder Scientific)
-> Either String Scientific
-> Decoder Scientific
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
err -> String -> Decoder Scientific
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder Scientific) -> String -> Decoder Scientific
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse Scientific: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err) Scientific -> Decoder Scientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Either String Scientific -> Decoder Scientific)
-> (ByteString -> Either String Scientific)
-> ByteString
-> Decoder Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Scientific -> ByteString -> Either String Scientific
forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser Scientific
AC.scientific Parser Scientific -> Parser ByteString () -> Parser Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput)
(ByteString -> Either String Scientific)
-> (ByteString -> ByteString)
-> ByteString
-> Either String Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSC.strip
{-# INLINE parseScientific #-}
getBool :: Value -> Decoder Bool
getBool :: Value -> Decoder Bool
getBool Value
valPtr = ((forall a. Decoder a -> IO a) -> IO Bool) -> Decoder Bool
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. Decoder a -> IO a) -> IO Bool) -> Decoder Bool)
-> ((forall a. Decoder a -> IO a) -> IO Bool) -> Decoder Bool
forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
(Ptr CBool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca ((Ptr CBool -> IO Bool) -> IO Bool)
-> (Ptr CBool -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr CBool
ptr -> Decoder Bool -> IO Bool
forall a. Decoder a -> IO a
run (Decoder Bool -> IO Bool) -> Decoder Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Value -> Ptr CBool -> IO CInt
getBoolImpl Value
valPtr Ptr CBool
ptr
Text -> CInt -> Decoder ()
handleErrorCode (Text -> Text
typePrefix Text
"bool") CInt
err
(CBool -> Bool) -> Decoder CBool -> Decoder Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Decoder CBool -> Decoder Bool)
-> (IO CBool -> Decoder CBool) -> IO CBool -> Decoder Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CBool -> Decoder CBool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CBool -> Decoder Bool) -> IO CBool -> Decoder Bool
forall a b. (a -> b) -> a -> b
$ Ptr CBool -> IO CBool
forall a. Storable a => Ptr a -> IO a
peek Ptr CBool
ptr
{-# INLINE getBool #-}
withBool :: (Bool -> Decoder a) -> Value -> Decoder a
withBool :: (Bool -> Decoder a) -> Value -> Decoder a
withBool Bool -> Decoder a
f = Value -> Decoder Bool
getBool (Value -> Decoder Bool)
-> (Bool -> Decoder a) -> Value -> Decoder a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Bool -> Decoder a
f
withCStringLen :: Text -> (CStringLen -> Decoder a) -> Value -> Decoder a
withCStringLen :: Text -> (CStringLen -> Decoder a) -> Value -> Decoder a
withCStringLen Text
lbl CStringLen -> Decoder a
f Value
valPtr = ((forall a. Decoder a -> IO a) -> IO a) -> Decoder a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. Decoder a -> IO a) -> IO a) -> Decoder a)
-> ((forall a. Decoder a -> IO a) -> IO a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
(Ptr (Ptr CChar) -> IO a) -> IO a
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca ((Ptr (Ptr CChar) -> IO a) -> IO a)
-> (Ptr (Ptr CChar) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
strPtr ->
(Ptr CSize -> IO a) -> IO a
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca ((Ptr CSize -> IO a) -> IO a) -> (Ptr CSize -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
lenPtr -> Decoder a -> IO a
forall a. Decoder a -> IO a
run (Decoder a -> IO a) -> Decoder a -> IO a
forall a b. (a -> b) -> a -> b
$ do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Value -> Ptr (Ptr CChar) -> Ptr CSize -> IO CInt
getStringImpl Value
valPtr Ptr (Ptr CChar)
strPtr Ptr CSize
lenPtr
Text -> CInt -> Decoder ()
handleErrorCode (Text -> Text
typePrefix Text
lbl) CInt
err
Int
len <- (CSize -> Int) -> Decoder CSize -> Decoder Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Decoder CSize -> Decoder Int)
-> (IO CSize -> Decoder CSize) -> IO CSize -> Decoder Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CSize -> Decoder CSize
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> Decoder Int) -> IO CSize -> Decoder Int
forall a b. (a -> b) -> a -> b
$ Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
lenPtr
Ptr CChar
str <- IO (Ptr CChar) -> Decoder (Ptr CChar)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr CChar) -> Decoder (Ptr CChar))
-> IO (Ptr CChar) -> Decoder (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
strPtr
CStringLen -> Decoder a
f (Ptr CChar
str, Int
len)
{-# INLINE withCStringLen #-}
getString :: Value -> Decoder String
getString :: Value -> Decoder String
getString = Text -> (CStringLen -> Decoder String) -> Value -> Decoder String
forall a. Text -> (CStringLen -> Decoder a) -> Value -> Decoder a
withCStringLen Text
"string" (IO String -> Decoder String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Decoder String)
-> (CStringLen -> IO String) -> CStringLen -> Decoder String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CStringLen -> IO String
forall (m :: * -> *). MonadIO m => CStringLen -> m String
peekCStringLen)
{-# INLINE getString #-}
getText :: Value -> Decoder Text
getText :: Value -> Decoder Text
getText = Text -> (CStringLen -> Decoder Text) -> Value -> Decoder Text
forall a. Text -> (CStringLen -> Decoder a) -> Value -> Decoder a
withCStringLen Text
"text" CStringLen -> Decoder Text
parseTextFromCStrLen
{-# INLINE getText #-}
parseTextFromCStrLen :: CStringLen -> Decoder Text
parseTextFromCStrLen :: CStringLen -> Decoder Text
parseTextFromCStrLen CStringLen
cstr = do
ByteString
bs <- IO ByteString -> Decoder ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Decoder ByteString)
-> IO ByteString -> Decoder ByteString
forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ByteString
Unsafe.unsafePackCStringLen CStringLen
cstr
case Parser (Maybe Text) -> ByteString -> Either String (Maybe Text)
forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser (Maybe Text)
asciiTextAtto ByteString
bs of
Left String
err -> String -> Decoder Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder Text) -> String -> Decoder Text
forall a b. (a -> b) -> a -> b
$ String
"Could not parse text: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
Right Maybe Text
Nothing -> Text -> Decoder Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Decoder Text) -> Text -> Decoder Text
forall a b. (a -> b) -> a -> b
$! ByteString -> Text
T.decodeUtf8 ByteString
bs
Right (Just Text
r) -> Text -> Decoder Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Decoder Text) -> Text -> Decoder Text
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
92 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x20 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
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 -> Maybe Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Parser (Maybe Text))
-> Maybe Text -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
txt
Maybe Word8
_ -> Maybe Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
{-# INLINE asciiTextAtto #-}
getRawByteString :: Value -> Decoder BS.ByteString
getRawByteString :: Value -> Decoder ByteString
getRawByteString Value
valPtr = ((forall a. Decoder a -> IO a) -> IO ByteString)
-> Decoder ByteString
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. Decoder a -> IO a) -> IO ByteString)
-> Decoder ByteString)
-> ((forall a. Decoder a -> IO a) -> IO ByteString)
-> Decoder ByteString
forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
(Ptr (Ptr CChar) -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca ((Ptr (Ptr CChar) -> IO ByteString) -> IO ByteString)
-> (Ptr (Ptr CChar) -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
strPtr ->
(Ptr CSize -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca ((Ptr CSize -> IO ByteString) -> IO ByteString)
-> (Ptr CSize -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
lenPtr -> Decoder ByteString -> IO ByteString
forall a. Decoder a -> IO a
run (Decoder ByteString -> IO ByteString)
-> Decoder ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
IO () -> Decoder ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Decoder ()) -> IO () -> Decoder ()
forall a b. (a -> b) -> a -> b
$ Value -> Ptr (Ptr CChar) -> Ptr CSize -> IO ()
getRawJSONTokenImpl Value
valPtr Ptr (Ptr CChar)
strPtr Ptr CSize
lenPtr
Int
len <- (CSize -> Int) -> Decoder CSize -> Decoder Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Decoder CSize -> Decoder Int)
-> (IO CSize -> Decoder CSize) -> IO CSize -> Decoder Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CSize -> Decoder CSize
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> Decoder Int) -> IO CSize -> Decoder Int
forall a b. (a -> b) -> a -> b
$ Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
lenPtr
Ptr CChar
str <- IO (Ptr CChar) -> Decoder (Ptr CChar)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr CChar) -> Decoder (Ptr CChar))
-> IO (Ptr CChar) -> Decoder (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
strPtr
IO ByteString -> Decoder ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Decoder ByteString)
-> IO ByteString -> Decoder ByteString
forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ByteString
Unsafe.unsafePackCStringLen (Ptr CChar
str, Int
len)
{-# INLINE getRawByteString #-}
withRawByteString :: (BS.ByteString -> Decoder a) -> Value -> Decoder a
withRawByteString :: (ByteString -> Decoder a) -> Value -> Decoder a
withRawByteString ByteString -> Decoder a
f = Value -> Decoder ByteString
getRawByteString (Value -> Decoder ByteString)
-> (ByteString -> Decoder a) -> Value -> Decoder a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Decoder a
f
{-# INLINE withRawByteString #-}
withString :: (String -> Decoder a) -> Value -> Decoder a
withString :: (String -> Decoder a) -> Value -> Decoder a
withString String -> Decoder a
f = Value -> Decoder String
getString (Value -> Decoder String)
-> (String -> Decoder a) -> Value -> Decoder a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> Decoder a
f
withText :: (Text -> Decoder a) -> Value -> Decoder a
withText :: (Text -> Decoder a) -> Value -> Decoder a
withText Text -> Decoder a
f = Value -> Decoder Text
getText (Value -> Decoder Text)
-> (Text -> Decoder a) -> Value -> Decoder a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Decoder a
f
isNull :: Value -> Decoder Bool
isNull :: Value -> Decoder Bool
isNull Value
valPtr = (CBool -> Bool) -> Decoder CBool -> Decoder Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Decoder CBool -> Decoder Bool)
-> (IO CBool -> Decoder CBool) -> IO CBool -> Decoder Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CBool -> Decoder CBool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CBool -> Decoder Bool) -> IO CBool -> Decoder Bool
forall a b. (a -> b) -> a -> b
$ Value -> IO CBool
isNullImpl Value
valPtr
{-# INLINE isNull #-}
withArrayLen :: ((Array, Int) -> Decoder a) -> Value -> Decoder a
withArrayLen :: ((Array, Int) -> Decoder a) -> Value -> Decoder a
withArrayLen (Array, Int) -> Decoder a
f Value
val =
(Array -> Decoder a) -> Decoder a
forall a. (Array -> Decoder a) -> Decoder a
allocaArray ((Array -> Decoder a) -> Decoder a)
-> (Array -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Array
arrPtr ->
((forall a. Decoder a -> IO a) -> IO a) -> Decoder a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. Decoder a -> IO a) -> IO a) -> Decoder a)
-> ((forall a. Decoder a -> IO a) -> IO a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
(Ptr CSize -> IO a) -> IO a
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca ((Ptr CSize -> IO a) -> IO a) -> (Ptr CSize -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
outLen -> Decoder a -> IO a
forall a. Decoder a -> IO a
run (Decoder a -> IO a) -> Decoder a -> IO a
forall a b. (a -> b) -> a -> b
$ do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Value -> Array -> Ptr CSize -> IO CInt
getArrayLenFromValueImpl Value
val Array
arrPtr Ptr CSize
outLen
Text -> CInt -> Decoder ()
handleErrorCode (Text -> Text
typePrefix Text
"array") CInt
err
Int
len <- (CSize -> Int) -> Decoder CSize -> Decoder Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Decoder CSize -> Decoder Int)
-> (IO CSize -> Decoder CSize) -> IO CSize -> Decoder Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CSize -> Decoder CSize
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> Decoder Int) -> IO CSize -> Decoder Int
forall a b. (a -> b) -> a -> b
$ Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
outLen
(Array, Int) -> Decoder a
f (Array
arrPtr, Int
len)
{-# INLINE withArrayLen #-}
listOfInt :: Value -> Decoder [Int]
listOfInt :: Value -> Decoder [Int]
listOfInt =
((Array, Int) -> Decoder [Int]) -> Value -> Decoder [Int]
forall a. ((Array, Int) -> Decoder a) -> Value -> Decoder a
withArrayLen (((Array, Int) -> Decoder [Int]) -> Value -> Decoder [Int])
-> ((Array, Int) -> Decoder [Int]) -> Value -> Decoder [Int]
forall a b. (a -> b) -> a -> b
$ \(Array
arrPtr, Int
len) ->
Int -> (Ptr Int -> Decoder [Int]) -> Decoder [Int]
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
Int -> (Ptr a -> m b) -> m b
Foreign.allocaArray Int
len ((Ptr Int -> Decoder [Int]) -> Decoder [Int])
-> (Ptr Int -> Decoder [Int]) -> Decoder [Int]
forall a b. (a -> b) -> a -> b
$ \Ptr Int
out -> do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Array -> Ptr Int -> IO CInt
intArrayImpl Array
arrPtr Ptr Int
out
Text -> CInt -> Decoder ()
handleErrorCode Text
"Error decoding array of ints." CInt
err
IO [Int] -> Decoder [Int]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Int] -> Decoder [Int]) -> IO [Int] -> Decoder [Int]
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Int -> IO [Int]
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Ptr a -> m [a]
peekArray Int
len Ptr Int
out
{-# RULES "list int/listOfInt" list int = listOfInt #-}
listOfDouble :: Value -> Decoder [Double]
listOfDouble :: Value -> Decoder [Double]
listOfDouble =
((Array, Int) -> Decoder [Double]) -> Value -> Decoder [Double]
forall a. ((Array, Int) -> Decoder a) -> Value -> Decoder a
withArrayLen (((Array, Int) -> Decoder [Double]) -> Value -> Decoder [Double])
-> ((Array, Int) -> Decoder [Double]) -> Value -> Decoder [Double]
forall a b. (a -> b) -> a -> b
$ \(Array
arrPtr, Int
len) ->
Int -> (Ptr Double -> Decoder [Double]) -> Decoder [Double]
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
Int -> (Ptr a -> m b) -> m b
Foreign.allocaArray Int
len ((Ptr Double -> Decoder [Double]) -> Decoder [Double])
-> (Ptr Double -> Decoder [Double]) -> Decoder [Double]
forall a b. (a -> b) -> a -> b
$ \Ptr Double
out -> do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Array -> Ptr Double -> IO CInt
doubleArrayImpl Array
arrPtr Ptr Double
out
Text -> CInt -> Decoder ()
handleErrorCode Text
"Error decoding array of doubles." CInt
err
IO [Double] -> Decoder [Double]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Double] -> Decoder [Double])
-> IO [Double] -> Decoder [Double]
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Double -> IO [Double]
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Ptr a -> m [a]
peekArray Int
len Ptr Double
out
{-# RULES "list double/listOfDouble" list double = listOfDouble #-}
withArray :: (Array -> Decoder a) -> Value -> Decoder a
withArray :: (Array -> Decoder a) -> Value -> Decoder a
withArray Array -> Decoder a
f Value
val =
(Array -> Decoder a) -> Decoder a
forall a. (Array -> Decoder a) -> Decoder a
allocaArray ((Array -> Decoder a) -> Decoder a)
-> (Array -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Array
arrPtr -> do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Value -> Array -> IO CInt
getArrayFromValueImpl Value
val Array
arrPtr
Text -> CInt -> Decoder ()
handleErrorCode (Text -> Text
typePrefix Text
"array") CInt
err
Array -> Decoder a
f Array
arrPtr
withArrayIter :: (ArrayIter -> Decoder a) -> Value -> Decoder a
withArrayIter :: (ArrayIter -> Decoder a) -> Value -> Decoder a
withArrayIter ArrayIter -> Decoder a
f Value
valPtr =
(ArrayIter -> Decoder a) -> Decoder a
forall a. (ArrayIter -> Decoder a) -> Decoder a
allocaArrayIter ((ArrayIter -> Decoder a) -> Decoder a)
-> (ArrayIter -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \ArrayIter
iterPtr -> do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ Value -> ArrayIter -> IO CInt
getArrayIterFromValueImpl Value
valPtr ArrayIter
iterPtr
Text -> CInt -> Decoder ()
handleErrorCode Text
"" CInt
err
ArrayIter -> Decoder a
f ArrayIter
iterPtr
{-# INLINE withArrayIter #-}
iterateOverArray :: (Value -> Decoder a) -> ArrayIter -> Decoder [a]
iterateOverArray :: (Value -> Decoder a) -> ArrayIter -> Decoder [a]
iterateOverArray Value -> Decoder a
f ArrayIter
iterPtr =
(Value -> Decoder [a]) -> Decoder [a]
forall a. (Value -> Decoder a) -> Decoder a
allocaValue ((Value -> Decoder [a]) -> Decoder [a])
-> (Value -> Decoder [a]) -> Decoder [a]
forall a b. (a -> b) -> a -> b
$ \Value
valPtr -> Int -> DList a -> Value -> Decoder [a]
go (Int
0 :: Int) DList a
forall a. DList a
DList.empty Value
valPtr
where
{-# INLINE go #-}
go :: Int -> DList a -> Value -> Decoder [a]
go !Int
n !DList a
acc Value
valPtr = do
Bool
isOver <- (CBool -> Bool) -> Decoder CBool -> Decoder Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Decoder CBool -> Decoder Bool)
-> (IO CBool -> Decoder CBool) -> IO CBool -> Decoder Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CBool -> Decoder CBool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CBool -> Decoder Bool) -> IO CBool -> Decoder Bool
forall a b. (a -> b) -> a -> b
$ ArrayIter -> IO CBool
arrayIterIsDoneImpl ArrayIter
iterPtr
if Bool -> Bool
not Bool
isOver
then Int -> Decoder [a] -> Decoder [a]
forall a. Int -> Decoder a -> Decoder a
withPathIndex Int
n (Decoder [a] -> Decoder [a]) -> Decoder [a] -> Decoder [a]
forall a b. (a -> b) -> a -> b
$ do
CInt
err <- IO CInt -> Decoder CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Decoder CInt) -> IO CInt -> Decoder CInt
forall a b. (a -> b) -> a -> b
$ ArrayIter -> Value -> IO CInt
arrayIterGetCurrentImpl ArrayIter
iterPtr Value
valPtr
Text -> CInt -> Decoder ()
handleErrorCode Text
"" CInt
err
a
result <- Value -> Decoder a
f Value
valPtr
IO () -> Decoder ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Decoder ()) -> IO () -> Decoder ()
forall a b. (a -> b) -> a -> b
$ ArrayIter -> IO ()
arrayIterMoveNextImpl ArrayIter
iterPtr
Int -> DList a -> Value -> Decoder [a]
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (DList a
acc DList a -> DList a -> DList a
forall a. Semigroup a => a -> a -> a
<> a -> DList a
forall a. a -> DList a
DList.singleton a
result) Value
valPtr
else
[a] -> Decoder [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Decoder [a]) -> [a] -> Decoder [a]
forall a b. (a -> b) -> a -> b
$ DList a -> [a]
forall a. DList a -> [a]
DList.toList DList a
acc
atKey :: Text -> (Value -> Decoder a) -> Object -> Decoder a
atKey :: Text -> (Value -> Decoder a) -> Object -> Decoder a
atKey Text
key Value -> Decoder a
parser Object
obj = (Value -> Decoder a) -> Object -> Text -> Decoder a
forall a. (Value -> Decoder a) -> Object -> Text -> Decoder a
withUnorderedField Value -> Decoder a
parser Object
obj Text
key
atKeyOptional :: Text -> (Value -> Decoder a) -> Object -> Decoder (Maybe a)
atKeyOptional :: Text -> (Value -> Decoder a) -> Object -> Decoder (Maybe a)
atKeyOptional Text
key Value -> Decoder a
parser Object
obj = (Value -> Decoder a) -> Object -> Text -> Decoder (Maybe a)
forall a.
(Value -> Decoder a) -> Object -> Text -> Decoder (Maybe a)
withUnorderedOptionalField Value -> Decoder a
parser Object
obj Text
key
atKeyStrict :: Text -> (Value -> Decoder a) -> Object -> Decoder a
atKeyStrict :: Text -> (Value -> Decoder a) -> Object -> Decoder a
atKeyStrict Text
key Value -> Decoder a
parser Object
obj = (Value -> Decoder a) -> Object -> Text -> Decoder a
forall a. (Value -> Decoder a) -> Object -> Text -> Decoder a
withField Value -> Decoder a
parser Object
obj Text
key
list :: (Value -> Decoder a) -> Value -> Decoder [a]
list :: (Value -> Decoder a) -> Value -> Decoder [a]
list Value -> Decoder a
f = (ArrayIter -> Decoder [a]) -> Value -> Decoder [a]
forall a. (ArrayIter -> Decoder a) -> Value -> Decoder a
withArrayIter ((ArrayIter -> Decoder [a]) -> Value -> Decoder [a])
-> (ArrayIter -> Decoder [a]) -> Value -> Decoder [a]
forall a b. (a -> b) -> a -> b
$ (Value -> Decoder a) -> ArrayIter -> Decoder [a]
forall a. (Value -> Decoder a) -> ArrayIter -> Decoder [a]
iterateOverArray Value -> Decoder a
f
{-# INLINE[2] list #-}
objectAsKeyValues
:: (Text -> Decoder k)
-> (Value -> Decoder v)
-> Value
-> Decoder [(k, v)]
objectAsKeyValues :: (Text -> Decoder k)
-> (Value -> Decoder v) -> Value -> Decoder [(k, v)]
objectAsKeyValues Text -> Decoder k
kf Value -> Decoder v
vf = (ObjectIter -> Decoder [(k, v)]) -> Value -> Decoder [(k, v)]
forall a. (ObjectIter -> Decoder a) -> Value -> Decoder a
withObjectIter ((ObjectIter -> Decoder [(k, v)]) -> Value -> Decoder [(k, v)])
-> (ObjectIter -> Decoder [(k, v)]) -> Value -> Decoder [(k, v)]
forall a b. (a -> b) -> a -> b
$ (Text -> Decoder k)
-> (Value -> Decoder v) -> ObjectIter -> Decoder [(k, v)]
forall a b.
(Text -> Decoder a)
-> (Value -> Decoder b) -> ObjectIter -> Decoder [(a, b)]
iterateOverFields Text -> Decoder k
kf Value -> Decoder v
vf
nullable :: (Value -> Decoder a) -> Value -> Decoder (Maybe a)
nullable :: (Value -> Decoder a) -> Value -> Decoder (Maybe a)
nullable Value -> Decoder a
parser Value
val = do
Bool
nil <- Value -> Decoder Bool
isNull Value
val
if Bool
nil
then Maybe a -> Decoder (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
else a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Decoder a -> Decoder (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Decoder a
parser Value
val
char :: Value -> Decoder Char
char :: Value -> Decoder Char
char = Value -> Decoder Text
getText (Value -> Decoder Text)
-> (Text -> Decoder Char) -> Value -> Decoder Char
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Decoder Char
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
"") ->
Char -> f Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
Maybe (Char, Text)
_ ->
String -> f Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected a single character"
string :: Value -> Decoder String
string :: Value -> Decoder String
string = Value -> Decoder String
getString
text :: Value -> Decoder Text
text :: Value -> Decoder Text
text = Value -> Decoder Text
getText
bool :: Value -> Decoder Bool
bool :: Value -> Decoder Bool
bool = Value -> Decoder Bool
getBool
int :: Value -> Decoder Int
int :: Value -> Decoder Int
int = Value -> Decoder Int
getInt
{-# INLINE[2] int #-}
double :: Value -> Decoder Double
double :: Value -> Decoder Double
double = Value -> Decoder Double
getDouble
{-# INLINE[2] double #-}
scientific :: Value -> Decoder Sci.Scientific
scientific :: Value -> Decoder Scientific
scientific = (ByteString -> Decoder Scientific) -> Value -> Decoder Scientific
forall a. (ByteString -> Decoder a) -> Value -> Decoder a
withRawByteString ByteString -> Decoder Scientific
parseScientific