{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# 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
#if MIN_VERSION_text(2,0,0)
import qualified Data.Text.Foreign as T
#endif
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 :: forall a. (Value -> Decoder a) -> InputBuffer -> Decoder a
withDocumentValue Value -> Decoder a
f InputBuffer
inputPtr =
forall a. (Value -> Decoder a) -> Decoder a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
valPtr ->
forall a. (Parser -> Decoder a) -> Decoder a
withParserPointer forall a b. (a -> b) -> a -> b
$ \Parser
parserPtr ->
forall a. (Document -> Decoder a) -> Decoder a
withDocumentPointer forall a b. (a -> b) -> a -> b
$ \Document
docPtr -> do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 :: forall a. Text -> (Value -> Decoder a) -> Decoder a
atPointer Text
jptr Value -> Decoder a
f =
forall a. (Document -> Decoder a) -> Decoder a
withDocumentPointer forall a b. (a -> b) -> a -> b
$ \Document
docPtr ->
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
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. Decoder a -> IO a
run forall a b. (a -> b) -> a -> b
$
forall a. (Value -> Decoder a) -> Decoder a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
vPtr -> forall a. Text -> Decoder a -> Decoder a
withPath Text
jptr forall a b. (a -> b) -> a -> b
$ do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CString -> Int -> Document -> Value -> IO CInt
atPointerImpl CString
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 :: forall a. (Object -> Decoder a) -> Value -> Decoder a
withObject Object -> Decoder a
f Value
valPtr = forall a. (Object -> Decoder a) -> Decoder a
allocaObject forall a b. (a -> b) -> a -> b
$ \Object
oPtr -> do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 :: forall a. (ObjectIter -> Decoder a) -> Value -> Decoder a
withObjectIter ObjectIter -> Decoder a
f Value
valPtr = forall a. (ObjectIter -> Decoder a) -> Decoder a
allocaObjectIter forall a b. (a -> b) -> a -> b
$ \ObjectIter
iterPtr -> do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 :: forall a b.
(Text -> Decoder a)
-> (Value -> Decoder b) -> ObjectIter -> Decoder [(a, b)]
iterateOverFields Text -> Decoder a
fk Value -> Decoder b
fv ObjectIter
iterPtr = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
runInIO ->
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CSize
lenPtr ->
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CString
keyPtr -> forall a. Decoder a -> IO a
runInIO forall a b. (a -> b) -> a -> b
$
forall a. (Value -> Decoder a) -> Decoder a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
valPtr ->
DList (a, b)
-> Ptr CString -> Ptr CSize -> Value -> Decoder [(a, b)]
go forall a. DList a
DList.empty Ptr CString
keyPtr Ptr CSize
lenPtr Value
valPtr
where
{-# INLINE go #-}
go :: DList (a, b)
-> Ptr CString -> Ptr CSize -> Value -> Decoder [(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
toBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m 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 (m :: * -> *) a. MonadIO m => IO a -> m 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 -> Decoder ()
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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
lenPtr
CString
kStr <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr CString
keyPtr
Text
keyTxt <- CStringLen -> Decoder Text
parseTextFromCStrLen (CString
kStr, Int
kLen)
forall a. Text -> Decoder a -> Decoder a
withPath (Text -> Text
dot Text
keyTxt) forall a b. (a -> b) -> a -> b
$ do
a
k <- Text -> Decoder a
fk Text
keyTxt
b
v <- Value -> Decoder b
fv Value
valPtr
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ObjectIter -> IO ()
objectIterMoveNextImpl ObjectIter
iterPtr
forall a. Text -> Decoder a -> Decoder a
removePath (Text -> Text
dot Text
keyTxt) forall a b. (a -> b) -> a -> b
$
DList (a, b)
-> Ptr CString -> Ptr CSize -> Value -> Decoder [(a, b)]
go (DList (a, b)
acc forall a. Semigroup a => a -> a -> a
<> forall a. a -> DList a
DList.singleton (a
k, b
v)) 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
withUnorderedField :: (Value -> Decoder a) -> Object -> Text -> Decoder a
withUnorderedField :: forall a. (Value -> Decoder a) -> Object -> Text -> Decoder a
withUnorderedField Value -> Decoder a
f Object
objPtr Text
key = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. Decoder 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. Decoder a -> IO a
run forall a b. (a -> b) -> a -> b
$
forall a. (Value -> Decoder a) -> Decoder a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
vPtr -> forall a. Text -> Decoder a -> Decoder a
withPath (Text -> Text
dot Text
key) forall a b. (a -> b) -> a -> b
$ do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m 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 -> Decoder ()
handleErrorCode Text
"" CInt
err
Value -> Decoder a
f Value
vPtr
{-# INLINE withUnorderedField #-}
withUnorderedOptionalField :: (Value -> Decoder a) -> Object -> Text -> Decoder (Maybe a)
withUnorderedOptionalField :: forall a.
(Value -> Decoder a) -> Object -> Text -> Decoder (Maybe a)
withUnorderedOptionalField Value -> Decoder a
f Object
objPtr Text
key = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. Decoder 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. Decoder a -> IO a
run forall a b. (a -> b) -> a -> b
$
forall a. (Value -> Decoder a) -> Decoder a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
vPtr -> forall a. Text -> Decoder a -> Decoder a
withPath (Text -> Text
dot Text
key) forall a b. (a -> b) -> a -> b
$ do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m 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
<$> Value -> 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 -> Decoder ()
handleErrorCode Text
"" CInt
err
{-# INLINE withUnorderedOptionalField #-}
withField :: (Value -> Decoder a) -> Object -> Text -> Decoder a
withField :: forall a. (Value -> Decoder a) -> Object -> Text -> Decoder a
withField Value -> Decoder a
f Object
objPtr Text
key = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. Decoder 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. Decoder a -> IO a
run forall a b. (a -> b) -> a -> b
$
forall a. (Value -> Decoder a) -> Decoder a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
vPtr -> forall a. Text -> Decoder a -> Decoder a
withPath (Text -> Text
dot Text
key) forall a b. (a -> b) -> a -> b
$ do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Object -> CString -> Int -> Value -> IO CInt
findFieldImpl Object
objPtr CString
cstr Int
len Value
vPtr
Text -> CInt -> 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 (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int
ptr -> forall a. Decoder a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr Int
ptr
{-# INLINE getInt #-}
withInt :: (Int -> Decoder a) -> Value -> Decoder a
withInt :: forall a. (Int -> Decoder a) -> Value -> Decoder a
withInt Int -> Decoder a
f = Value -> Decoder Int
getInt 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 (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Double
ptr -> forall a. Decoder a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr Double
ptr
{-# INLINE getDouble #-}
withDouble :: (Double -> Decoder a) -> Value -> Decoder a
withDouble :: forall a. (Double -> Decoder a) -> Value -> Decoder a
withDouble Double -> Decoder a
f = Value -> Decoder Double
getDouble 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
= 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 #-}
getBool :: Value -> Decoder Bool
getBool :: Value -> Decoder Bool
getBool Value
valPtr = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CBool
ptr -> forall a. Decoder a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Num a) => a -> Bool
toBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr CBool
ptr
{-# INLINE getBool #-}
withBool :: (Bool -> Decoder a) -> Value -> Decoder a
withBool :: forall a. (Bool -> Decoder a) -> Value -> Decoder a
withBool Bool -> Decoder a
f = Value -> Decoder Bool
getBool 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 :: forall a. Text -> (CStringLen -> Decoder a) -> Value -> Decoder a
withCStringLen Text
lbl CStringLen -> Decoder a
f Value
valPtr = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CString
strPtr ->
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CSize
lenPtr -> forall a. Decoder a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m 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 -> Decoder ()
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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
lenPtr
CString
str <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr CString
strPtr
CStringLen -> Decoder a
f (CString
str, Int
len)
{-# INLINE withCStringLen #-}
getString :: Value -> Decoder String
getString :: Value -> Decoder String
getString = forall a. Text -> (CStringLen -> Decoder a) -> Value -> Decoder a
withCStringLen Text
"string" (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => CStringLen -> m String
peekCStringLen)
{-# INLINE getString #-}
getText :: Value -> Decoder Text
getText :: Value -> Decoder Text
getText = forall a. Text -> (CStringLen -> Decoder a) -> Value -> Decoder a
withCStringLen Text
"text" CStringLen -> Decoder Text
parseTextFromCStrLen
{-# INLINE getText #-}
#if MIN_VERSION_text(2,0,0)
parseTextFromCStrLen :: CStringLen -> Decoder Text
parseTextFromCStrLen (cstr, len) = liftIO $ T.fromPtr (Foreign.castPtr cstr) (fromIntegral len)
{-# INLINE parseTextFromCStrLen #-}
#else
parseTextFromCStrLen :: CStringLen -> Decoder Text
parseTextFromCStrLen :: CStringLen -> Decoder Text
parseTextFromCStrLen CStringLen
cstr = do
ByteString
bs <- forall (m :: * -> *) a. MonadIO m => IO a -> m 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 -> Decoder BS.ByteString
getRawByteString :: Value -> Decoder ByteString
getRawByteString Value
valPtr = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CString
strPtr ->
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CSize
lenPtr -> forall a. Decoder a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
lenPtr
CString
str <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr CString
strPtr
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ByteString
Unsafe.unsafePackCStringLen (CString
str, Int
len)
{-# INLINE getRawByteString #-}
withRawByteString :: (BS.ByteString -> Decoder a) -> Value -> Decoder a
withRawByteString :: forall a. (ByteString -> Decoder a) -> Value -> Decoder a
withRawByteString ByteString -> Decoder a
f = Value -> Decoder ByteString
getRawByteString 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 :: forall a. (String -> Decoder a) -> Value -> Decoder a
withString String -> Decoder a
f = Value -> Decoder String
getString 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 :: forall a. (Text -> Decoder a) -> Value -> Decoder a
withText Text -> Decoder a
f = Value -> Decoder Text
getText 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Num a) => a -> Bool
toBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Value -> IO CBool
isNullImpl Value
valPtr
{-# INLINE isNull #-}
withArrayLen :: ((Array, Int) -> Decoder a) -> Value -> Decoder a
withArrayLen :: forall a. ((Array, Int) -> Decoder a) -> Value -> Decoder a
withArrayLen (Array, Int) -> Decoder a
f Value
val =
forall a. (Array -> Decoder a) -> Decoder a
allocaArray forall a b. (a -> b) -> a -> b
$ \Array
arrPtr ->
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. Decoder a -> IO a
run ->
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CSize
outLen -> forall a. Decoder a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 <- 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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 =
forall a. ((Array, Int) -> Decoder a) -> Value -> Decoder a
withArrayLen forall a b. (a -> b) -> a -> b
$ \(Array
arrPtr, Int
len) ->
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
Int -> (Ptr a -> m b) -> m b
Foreign.allocaArray Int
len forall a b. (a -> b) -> a -> b
$ \Ptr Int
out -> do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 =
forall a. ((Array, Int) -> Decoder a) -> Value -> Decoder a
withArrayLen forall a b. (a -> b) -> a -> b
$ \(Array
arrPtr, Int
len) ->
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
Int -> (Ptr a -> m b) -> m b
Foreign.allocaArray Int
len forall a b. (a -> b) -> a -> b
$ \Ptr Double
out -> do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 :: forall a. (Array -> Decoder a) -> Value -> Decoder a
withArray Array -> Decoder a
f Value
val =
forall a. (Array -> Decoder a) -> Decoder a
allocaArray forall a b. (a -> b) -> a -> b
$ \Array
arrPtr -> do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 :: forall a. (ArrayIter -> Decoder a) -> Value -> Decoder a
withArrayIter ArrayIter -> Decoder a
f Value
valPtr =
forall a. (ArrayIter -> Decoder a) -> Decoder a
allocaArrayIter forall a b. (a -> b) -> a -> b
$ \ArrayIter
iterPtr -> do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 :: forall a. (Value -> Decoder a) -> ArrayIter -> Decoder [a]
iterateOverArray Value -> Decoder a
f ArrayIter
iterPtr =
forall a. (Value -> Decoder a) -> Decoder a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
valPtr -> Int -> DList a -> Value -> Decoder [a]
go (Int
0 :: Int) 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 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Num a) => a -> Bool
toBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ArrayIter -> IO CBool
arrayIterIsDoneImpl ArrayIter
iterPtr
if Bool -> Bool
not Bool
isOver
then forall a. Int -> Decoder a -> Decoder a
withPathIndex Int
n forall a b. (a -> b) -> a -> b
$ do
CInt
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ArrayIter -> IO ()
arrayIterMoveNextImpl ArrayIter
iterPtr
Int -> DList a -> Value -> Decoder [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
result) 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
atKey :: Text -> (Value -> Decoder a) -> Object -> Decoder a
atKey :: forall a. Text -> (Value -> Decoder a) -> Object -> Decoder a
atKey Text
key Value -> Decoder a
parser Object
obj = 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 :: forall a.
Text -> (Value -> Decoder a) -> Object -> Decoder (Maybe a)
atKeyOptional Text
key Value -> Decoder a
parser Object
obj = 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 :: forall a. Text -> (Value -> Decoder a) -> Object -> Decoder a
atKeyStrict Text
key Value -> Decoder a
parser Object
obj = 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 :: forall a. (Value -> Decoder a) -> Value -> Decoder [a]
list Value -> Decoder a
f = forall a. (ArrayIter -> Decoder a) -> Value -> Decoder a
withArrayIter forall a b. (a -> b) -> a -> b
$ 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 :: forall k v.
(Text -> Decoder k)
-> (Value -> Decoder v) -> Value -> Decoder [(k, v)]
objectAsKeyValues Text -> Decoder k
kf Value -> Decoder v
vf = forall a. (ObjectIter -> Decoder a) -> Value -> Decoder a
withObjectIter forall a b. (a -> b) -> a -> b
$ 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 :: forall a. (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 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
<$> Value -> Decoder a
parser Value
val
char :: Value -> Decoder Char
char :: Value -> Decoder Char
char = Value -> Decoder 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"
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 = forall a. (ByteString -> Decoder a) -> Value -> Decoder a
withRawByteString ByteString -> Decoder Scientific
parseScientific