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

-- | Parse the given input into a document iterator, get its
-- Value, which is either a JSON object or an array, and run the given
-- action on that Value.
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

-- | 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.
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

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

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

-- | Execute a function on each Field in an ObjectIter and
-- accumulate key-value tuples into a list.
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 #-}

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

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

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

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

-- | Helper to work with the raw ByteString of the JSON token parsed from the given Value.
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 #-}

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

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

-- | Returns True if the Value is null.
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 #-}

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

-- | Is more efficient by looping in C++ instead of Haskell.
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 #-}

-- | Is more efficient by looping in C++ instead of Haskell.
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 #-}

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

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

-- | Execute a function on each Value in an ArrayIter and
-- accumulate the results into a list.
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

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

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

-- | 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 -> (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

-- | Parse a homogenous JSON array into a Haskell list.
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 #-}

-- | 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.
  -> (Value -> Decoder v)
  -- ^ Decoder for the field value.
  -> 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

-- | Transforms a parser to return Nothing when the value is null.
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

-- | Parse only a single character.
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"

-- | Parse a JSON string into a Haskell String.
-- For best performance you should use `text` instead.
string :: Value -> Decoder String
string :: Value -> Decoder String
string = Value -> Decoder String
getString

-- | Parse a JSON string into Haskell Text.
text :: Value -> Decoder Text
text :: Value -> Decoder Text
text = Value -> Decoder Text
getText

-- | Parse a JSON boolean into a Haskell Bool.
bool :: Value -> Decoder Bool
bool :: Value -> Decoder Bool
bool = Value -> Decoder Bool
getBool

-- | Parse a JSON number into an unsigned Haskell Int.
int :: Value -> Decoder Int
int :: Value -> Decoder Int
int = Value -> Decoder Int
getInt
{-# INLINE[2] int #-}

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

-- | Parse a Scientific from a Value.
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