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

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

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

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

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

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

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

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

-- | Parse a Scientific using attoparsec's ByteString.Char8 parser.
parseScientific :: BS.ByteString -> Decoder Sci.Scientific
parseScientific :: ByteString -> Decoder Scientific
parseScientific
  = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to parse Scientific: " forall a. Semigroup a => a -> a -> a
<> String
err) forall (f :: * -> *) a. Applicative f => a -> f a
pure
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser ByteString Scientific
AC.scientific forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
A.endOfInput)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSC.strip
{-# INLINE parseScientific #-}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | 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 = forall a. (ByteString -> Decoder a) -> Value -> Decoder a
withRawByteString ByteString -> Decoder Scientific
parseScientific