{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Aeson.Decoding (
decode,
eitherDecode,
throwDecode,
decodeStrict,
eitherDecodeStrict,
throwDecodeStrict,
decodeStrictText,
eitherDecodeStrictText,
throwDecodeStrictText,
toEitherValue,
unescapeText,
) where
import Control.Monad.Catch (MonadThrow (..))
import Data.Aeson.Types.Internal (AesonException (..), formatError)
import qualified Data.Aeson.Types as A
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as T
import Data.Aeson.Decoding.ByteString
import Data.Aeson.Decoding.ByteString.Lazy
import Data.Aeson.Decoding.Text
import Data.Aeson.Decoding.Conversion
import Data.Aeson.Internal.Unescape (unescapeText)
decodeStrict :: (A.FromJSON a) => BS.ByteString -> Maybe a
decodeStrict :: forall a. FromJSON a => ByteString -> Maybe a
decodeStrict ByteString
bs = forall e k a.
Result e k a -> forall r. (e -> r) -> (a -> k -> r) -> r
unResult (forall k e. Tokens k e -> Result e k Value
toResultValue (ByteString -> Tokens ByteString String
bsToTokens ByteString
bs)) (\String
_ -> forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ \Value
v ByteString
bs' -> case forall a. FromJSON a => Value -> IResult a
A.ifromJSON Value
v of
A.ISuccess a
x
| ByteString -> Bool
bsSpace ByteString
bs' -> forall a. a -> Maybe a
Just a
x
| Bool
otherwise -> forall a. Maybe a
Nothing
A.IError JSONPath
_ String
_ -> forall a. Maybe a
Nothing
eitherDecodeStrict :: (A.FromJSON a) => BS.ByteString -> Either String a
eitherDecodeStrict :: forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict ByteString
bs = forall e k a.
Result e k a -> forall r. (e -> r) -> (a -> k -> r) -> r
unResult (forall k e. Tokens k e -> Result e k Value
toResultValue (ByteString -> Tokens ByteString String
bsToTokens ByteString
bs)) forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ \Value
v ByteString
bs' -> case forall a. FromJSON a => Value -> IResult a
A.ifromJSON Value
v of
A.ISuccess a
x
| ByteString -> Bool
bsSpace ByteString
bs' -> forall a b. b -> Either a b
Right a
x
| Bool
otherwise -> forall a b. a -> Either a b
Left String
"Trailing garbage"
A.IError JSONPath
path String
msg -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ JSONPath -> String -> String
formatError JSONPath
path String
msg
throwDecodeStrict :: forall a m. (A.FromJSON a, MonadThrow m) => BS.ByteString -> m a
throwDecodeStrict :: forall a (m :: * -> *).
(FromJSON a, MonadThrow m) =>
ByteString -> m a
throwDecodeStrict ByteString
bs = forall e k a.
Result e k a -> forall r. (e -> r) -> (a -> k -> r) -> r
unResult (forall k e. Tokens k e -> Result e k Value
toResultValue (ByteString -> Tokens ByteString String
bsToTokens ByteString
bs)) (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AesonException
AesonException) forall a b. (a -> b) -> a -> b
$ \Value
v ByteString
bs' -> case forall a. FromJSON a => Value -> IResult a
A.ifromJSON Value
v of
A.ISuccess a
x
| ByteString -> Bool
bsSpace ByteString
bs' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
| Bool
otherwise -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> AesonException
AesonException String
"Trailing garbage"
A.IError JSONPath
path String
msg -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> AesonException
AesonException forall a b. (a -> b) -> a -> b
$ JSONPath -> String -> String
formatError JSONPath
path String
msg
decode :: (A.FromJSON a) => LBS.ByteString -> Maybe a
decode :: forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bs = forall e k a.
Result e k a -> forall r. (e -> r) -> (a -> k -> r) -> r
unResult (forall k e. Tokens k e -> Result e k Value
toResultValue (ByteString -> Tokens ByteString String
lbsToTokens ByteString
bs)) (\String
_ -> forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ \Value
v ByteString
bs' -> case forall a. FromJSON a => Value -> IResult a
A.ifromJSON Value
v of
A.ISuccess a
x
| ByteString -> Bool
lbsSpace ByteString
bs' -> forall a. a -> Maybe a
Just a
x
| Bool
otherwise -> forall a. Maybe a
Nothing
A.IError JSONPath
_ String
_ -> forall a. Maybe a
Nothing
eitherDecode :: (A.FromJSON a) => LBS.ByteString -> Either String a
eitherDecode :: forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs = forall e k a.
Result e k a -> forall r. (e -> r) -> (a -> k -> r) -> r
unResult (forall k e. Tokens k e -> Result e k Value
toResultValue (ByteString -> Tokens ByteString String
lbsToTokens ByteString
bs)) forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ \Value
v ByteString
bs' -> case forall a. FromJSON a => Value -> IResult a
A.ifromJSON Value
v of
A.ISuccess a
x
| ByteString -> Bool
lbsSpace ByteString
bs' -> forall a b. b -> Either a b
Right a
x
| Bool
otherwise -> forall a b. a -> Either a b
Left String
"Trailing garbage"
A.IError JSONPath
path String
msg -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ JSONPath -> String -> String
formatError JSONPath
path String
msg
throwDecode :: forall a m. (A.FromJSON a, MonadThrow m) => LBS.ByteString -> m a
throwDecode :: forall a (m :: * -> *).
(FromJSON a, MonadThrow m) =>
ByteString -> m a
throwDecode ByteString
bs = forall e k a.
Result e k a -> forall r. (e -> r) -> (a -> k -> r) -> r
unResult (forall k e. Tokens k e -> Result e k Value
toResultValue (ByteString -> Tokens ByteString String
lbsToTokens ByteString
bs)) (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AesonException
AesonException) forall a b. (a -> b) -> a -> b
$ \Value
v ByteString
bs' -> case forall a. FromJSON a => Value -> IResult a
A.ifromJSON Value
v of
A.ISuccess a
x
| ByteString -> Bool
lbsSpace ByteString
bs' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
| Bool
otherwise -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> AesonException
AesonException String
"Trailing garbage"
A.IError JSONPath
path String
msg -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> AesonException
AesonException forall a b. (a -> b) -> a -> b
$ JSONPath -> String -> String
formatError JSONPath
path String
msg
decodeStrictText :: (A.FromJSON a) => T.Text -> Maybe a
decodeStrictText :: forall a. FromJSON a => Text -> Maybe a
decodeStrictText Text
bs = forall e k a.
Result e k a -> forall r. (e -> r) -> (a -> k -> r) -> r
unResult (forall k e. Tokens k e -> Result e k Value
toResultValue (Text -> Tokens Text String
textToTokens Text
bs)) (\String
_ -> forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ \Value
v Text
bs' -> case forall a. FromJSON a => Value -> IResult a
A.ifromJSON Value
v of
A.ISuccess a
x
| Text -> Bool
textSpace Text
bs' -> forall a. a -> Maybe a
Just a
x
| Bool
otherwise -> forall a. Maybe a
Nothing
A.IError JSONPath
_ String
_ -> forall a. Maybe a
Nothing
eitherDecodeStrictText :: (A.FromJSON a) => T.Text -> Either String a
eitherDecodeStrictText :: forall a. FromJSON a => Text -> Either String a
eitherDecodeStrictText Text
bs = forall e k a.
Result e k a -> forall r. (e -> r) -> (a -> k -> r) -> r
unResult (forall k e. Tokens k e -> Result e k Value
toResultValue (Text -> Tokens Text String
textToTokens Text
bs)) forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ \Value
v Text
bs' -> case forall a. FromJSON a => Value -> IResult a
A.ifromJSON Value
v of
A.ISuccess a
x
| Text -> Bool
textSpace Text
bs' -> forall a b. b -> Either a b
Right a
x
| Bool
otherwise -> forall a b. a -> Either a b
Left String
"Trailing garbage"
A.IError JSONPath
path String
msg -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ JSONPath -> String -> String
formatError JSONPath
path String
msg
throwDecodeStrictText :: forall a m. (A.FromJSON a, MonadThrow m) => T.Text -> m a
throwDecodeStrictText :: forall a (m :: * -> *). (FromJSON a, MonadThrow m) => Text -> m a
throwDecodeStrictText Text
bs = forall e k a.
Result e k a -> forall r. (e -> r) -> (a -> k -> r) -> r
unResult (forall k e. Tokens k e -> Result e k Value
toResultValue (Text -> Tokens Text String
textToTokens Text
bs)) (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AesonException
AesonException) forall a b. (a -> b) -> a -> b
$ \Value
v Text
bs' -> case forall a. FromJSON a => Value -> IResult a
A.ifromJSON Value
v of
A.ISuccess a
x
| Text -> Bool
textSpace Text
bs' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
| Bool
otherwise -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> AesonException
AesonException String
"Trailing garbage"
A.IError JSONPath
path String
msg -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> AesonException
AesonException forall a b. (a -> b) -> a -> b
$ JSONPath -> String -> String
formatError JSONPath
path String
msg