{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Aeson.Compat (
decode,
decode',
AesonException(..),
eitherDecode,
eitherDecode',
encode,
decodeStrict,
decodeStrict',
eitherDecodeStrict,
eitherDecodeStrict',
Value(..),
#if MIN_VERSION_aeson(0,10,0)
Encoding,
fromEncoding,
#endif
Array,
Object,
DotNetTime(..),
FromJSON(..),
Result(..),
fromJSON,
ToJSON(..),
#if MIN_VERSION_aeson(0,10,0)
KeyValue(..),
#else
(.=),
#endif
GFromJSON,
GToJSON,
#if MIN_VERSION_aeson(0,11,0)
GToEncoding,
#endif
genericToJSON,
#if MIN_VERSION_aeson(0,10,0)
genericToEncoding,
#endif
genericParseJSON,
defaultOptions,
withObject,
withText,
withArray,
withNumber,
withScientific,
withBool,
withEmbeddedJSON,
#if MIN_VERSION_aeson(0,10,0)
Series,
pairs,
foldable,
#endif
(.:),
(.:?),
(.:!),
(.!=),
object,
json,
json',
value,
value',
Parser,
) where
import Prelude ()
import Prelude.Compat
import Data.Aeson hiding
((.:?), decode, decode', decodeStrict, decodeStrict'
#if !MIN_VERSION_aeson (0,9,0)
, eitherDecode, eitherDecode', eitherDecodeStrict, eitherDecodeStrict'
#endif
#if !MIN_VERSION_aeson (1,4,0)
, withNumber
#endif
)
import Data.Aeson.Parser (value, value')
#if !MIN_VERSION_aeson (0,9,0)
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.ByteString.Char8 as A (skipSpace)
import qualified Data.Attoparsec.Lazy as L
#endif
import Control.Monad.Catch (MonadThrow (..), Exception)
import Data.Aeson.Types (Parser, modifyFailure, typeMismatch, defaultOptions)
import Data.ByteString as B
import qualified Data.Scientific as Scientific
import Data.ByteString.Lazy as L
import qualified Data.HashMap.Strict as H
import Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Typeable (Typeable)
#if !MIN_VERSION_aeson(0,10,0)
import Data.Time (Day, LocalTime, formatTime, NominalDiffTime)
import Data.Time.Locale.Compat (defaultTimeLocale)
import qualified Data.Attoparsec.Text as Atto
import qualified Data.Attoparsec.Time as CompatTime
#endif
#if !(MIN_VERSION_aeson(0,11,0) && MIN_VERSION_base(4,8,0))
import Numeric.Natural (Natural)
#endif
#if !MIN_VERSION_aeson(0,11,0)
import Data.Version (Version, showVersion, parseVersion)
import Text.ParserCombinators.ReadP (readP_to_S)
#endif
#if !MIN_VERSION_aeson(0,11,1)
import Control.Applicative (Const (..))
import Data.List.NonEmpty (NonEmpty (..))
import Data.Proxy (Proxy (..))
import Data.Tagged (Tagged (..))
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Vector as V
#endif
#if !MIN_VERSION_aeson(1,4,1)
import Data.Void (Void, absurd)
#endif
import Data.Attoparsec.Number (Number (..))
newtype AesonException = AesonException String
deriving (Int -> AesonException -> ShowS
[AesonException] -> ShowS
AesonException -> String
(Int -> AesonException -> ShowS)
-> (AesonException -> String)
-> ([AesonException] -> ShowS)
-> Show AesonException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AesonException] -> ShowS
$cshowList :: [AesonException] -> ShowS
show :: AesonException -> String
$cshow :: AesonException -> String
showsPrec :: Int -> AesonException -> ShowS
$cshowsPrec :: Int -> AesonException -> ShowS
Show, Typeable)
instance Exception AesonException
eitherAesonExc :: (MonadThrow m) => Either String a -> m a
eitherAesonExc :: Either String a -> m a
eitherAesonExc (Left err :: String
err) = AesonException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (String -> AesonException
AesonException String
err)
eitherAesonExc (Right x :: a
x) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
decode :: (FromJSON a, MonadThrow m) => L.ByteString -> m a
decode :: ByteString -> m a
decode = Either String a -> m a
forall (m :: * -> *) a. MonadThrow m => Either String a -> m a
eitherAesonExc (Either String a -> m a)
-> (ByteString -> Either String a) -> ByteString -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode
decode' :: (FromJSON a, MonadThrow m) => L.ByteString -> m a
decode' :: ByteString -> m a
decode' = Either String a -> m a
forall (m :: * -> *) a. MonadThrow m => Either String a -> m a
eitherAesonExc (Either String a -> m a)
-> (ByteString -> Either String a) -> ByteString -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode'
decodeStrict :: (FromJSON a, MonadThrow m) => B.ByteString -> m a
decodeStrict :: ByteString -> m a
decodeStrict = Either String a -> m a
forall (m :: * -> *) a. MonadThrow m => Either String a -> m a
eitherAesonExc (Either String a -> m a)
-> (ByteString -> Either String a) -> ByteString -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict
decodeStrict' :: (FromJSON a, MonadThrow m) => B.ByteString -> m a
decodeStrict' :: ByteString -> m a
decodeStrict' = Either String a -> m a
forall (m :: * -> *) a. MonadThrow m => Either String a -> m a
eitherAesonExc (Either String a -> m a)
-> (ByteString -> Either String a) -> ByteString -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict'
(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
obj :: Object
obj .:? :: Object -> Text -> Parser (Maybe a)
.:? key :: Text
key = case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
key Object
obj of
Nothing -> Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
Just v :: Value
v ->
#if MIN_VERSION_aeson(0,10,0)
ShowS -> Parser (Maybe a) -> Parser (Maybe a)
forall a. ShowS -> Parser a -> Parser a
modifyFailure ShowS
addKeyName (Parser (Maybe a) -> Parser (Maybe a))
-> Parser (Maybe a) -> Parser (Maybe a)
forall a b. (a -> b) -> a -> b
$ Value -> Parser (Maybe a)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
where
addKeyName :: ShowS
addKeyName = String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat ["failed to parse field ", Text -> String
T.unpack Text
key, ": "]
#else
parseJSON v
#endif
{-# INLINE (.:?) #-}
#if !MIN_VERSION_aeson(0,11,0)
(.:!) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
obj .:! key = case H.lookup key obj of
Nothing -> pure Nothing
Just v ->
#if MIN_VERSION_aeson(0,10,0)
modifyFailure addKeyName $ Just <$> parseJSON v
where
addKeyName = mappend $ mconcat ["failed to parse field ", T.unpack key, ": "]
#else
Just <$> parseJSON v
#endif
{-# INLINE (.:!) #-}
#endif
#if !MIN_VERSION_aeson(0,9,0)
jsonEOF :: A.Parser Value
jsonEOF = value <* A.skipSpace <* A.endOfInput
jsonEOF' :: A.Parser Value
jsonEOF' = value' <* A.skipSpace <* A.endOfInput
eitherDecode :: (FromJSON a) => L.ByteString -> Either String a
eitherDecode = eitherDecodeWith jsonEOF fromJSON
{-# INLINE eitherDecode #-}
eitherDecodeStrict :: (FromJSON a) => B.ByteString -> Either String a
eitherDecodeStrict = eitherDecodeStrictWith jsonEOF fromJSON
{-# INLINE eitherDecodeStrict #-}
eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a
eitherDecode' = eitherDecodeWith jsonEOF' fromJSON
{-# INLINE eitherDecode' #-}
eitherDecodeStrict' :: (FromJSON a) => B.ByteString -> Either String a
eitherDecodeStrict' = eitherDecodeStrictWith jsonEOF' fromJSON
{-# INLINE eitherDecodeStrict' #-}
eitherDecodeWith :: L.Parser Value -> (Value -> Result a) -> L.ByteString
-> Either String a
eitherDecodeWith p to s =
case L.parse p s of
L.Done _ v -> case to v of
Success a -> Right a
Error msg -> Left msg
L.Fail _ _ msg -> Left msg
{-# INLINE eitherDecodeWith #-}
eitherDecodeStrictWith :: A.Parser Value -> (Value -> Result a) -> B.ByteString
-> Either String a
eitherDecodeStrictWith p to s =
case either Error to (A.parseOnly p s) of
Success a -> Right a
Error msg -> Left msg
{-# INLINE eitherDecodeStrictWith #-}
#endif
#if !MIN_VERSION_aeson(0,10,0)
attoRun :: Atto.Parser a -> Text -> Parser a
attoRun p t = case Atto.parseOnly (p <* Atto.endOfInput) t of
Left err -> fail $ "could not parse date: " ++ err
Right r -> return r
instance FromJSON Day where
parseJSON = withText "Day" (attoRun CompatTime.day)
instance FromJSON LocalTime where
parseJSON = withText "LocalTime" (attoRun CompatTime.localTime)
instance ToJSON Day where
toJSON = toJSON . T.pack . formatTime defaultTimeLocale "%F"
instance ToJSON LocalTime where
toJSON = toJSON . T.pack . formatTime defaultTimeLocale "%FT%T%Q"
instance ToJSON NominalDiffTime where
toJSON = Number . realToFrac
{-# INLINE toJSON #-}
#if MIN_VERSION_aeson(0,10,0)
toEncoding = Encoding . E.number . realToFrac
{-# INLINE toEncoding #-}
#endif
instance FromJSON NominalDiffTime where
parseJSON = withScientific "NominalDiffTime" $ pure . realToFrac
{-# INLINE parseJSON #-}
#endif
#if !(MIN_VERSION_aeson(0,11,1))
#if !(MIN_VERSION_aeson(0,11,0) && MIN_VERSION_base(4,8,0))
instance ToJSON Natural where
toJSON = toJSON . toInteger
{-# INLINE toJSON #-}
#if MIN_VERSION_aeson(0,10,0)
toEncoding = toEncoding . toInteger
{-# INLINE toEncoding #-}
#endif
instance FromJSON Natural where
parseJSON = withScientific "Natural" $ \s ->
if Scientific.coefficient s < 0
then fail $ "Expected a Natural number but got the negative number: " ++ show s
else pure $ truncate s
#endif
#endif
#if !MIN_VERSION_aeson(0,11,0)
instance ToJSON Version where
toJSON = toJSON . showVersion
{-# INLINE toJSON #-}
#if MIN_VERSION_aeson(0,10,0)
toEncoding = toEncoding . showVersion
{-# INLINE toEncoding #-}
#endif
instance FromJSON Version where
{-# INLINE parseJSON #-}
parseJSON = withText "Version" $ go . readP_to_S parseVersion . T.unpack
where
go [(v,[])] = return v
go (_ : xs) = go xs
go _ = fail $ "could not parse Version"
instance ToJSON Ordering where
toJSON = toJSON . orderingToText
#if MIN_VERSION_aeson(0,10,0)
toEncoding = toEncoding . orderingToText
#endif
orderingToText :: Ordering -> T.Text
orderingToText o = case o of
LT -> "LT"
EQ -> "EQ"
GT -> "GT"
instance FromJSON Ordering where
parseJSON = withText "Ordering" $ \s ->
case s of
"LT" -> return LT
"EQ" -> return EQ
"GT" -> return GT
_ -> fail "Parsing Ordering value failed: expected \"LT\", \"EQ\", or \"GT\""
#endif
#if !MIN_VERSION_aeson(0,11,1)
instance ToJSON (Proxy a) where
toJSON _ = Null
{-# INLINE toJSON #-}
instance FromJSON (Proxy a) where
{-# INLINE parseJSON #-}
parseJSON Null = pure Proxy
parseJSON v = typeMismatch "Proxy" v
instance ToJSON b => ToJSON (Tagged a b) where
toJSON (Tagged x) = toJSON x
{-# INLINE toJSON #-}
#if MIN_VERSION_aeson(0,10,0)
toEncoding (Tagged x) = toEncoding x
{-# INLINE toEncoding #-}
#endif
instance FromJSON b => FromJSON (Tagged a b) where
{-# INLINE parseJSON #-}
parseJSON = fmap Tagged . parseJSON
instance ToJSON a => ToJSON (Const a b) where
toJSON (Const x) = toJSON x
{-# INLINE toJSON #-}
#if MIN_VERSION_aeson(0,10,0)
toEncoding (Const x) = toEncoding x
{-# INLINE toEncoding #-}
#endif
instance FromJSON a => FromJSON (Const a b) where
{-# INLINE parseJSON #-}
parseJSON = fmap Const . parseJSON
instance (ToJSON a) => ToJSON (NonEmpty a) where
toJSON = toJSON . NonEmpty.toList
{-# INLINE toJSON #-}
#if MIN_VERSION_aeson(0,10,0)
toEncoding = toEncoding . NonEmpty.toList
{-# INLINE toEncoding #-}
#endif
instance (FromJSON a) => FromJSON (NonEmpty a) where
parseJSON = withArray "NonEmpty a" $
(>>= ne) . traverse parseJSON . V.toList
where
ne [] = fail "Expected a NonEmpty but got an empty list"
ne (x:xs) = pure (x :| xs)
#endif
#if !MIN_VERSION_aeson(1,4,1)
instance ToJSON Void where
toJSON = absurd
{-# INLINE toJSON #-}
#if MIN_VERSION_aeson(0,10,0)
toEncoding = absurd
{-# INLINE toEncoding #-}
#endif
instance FromJSON Void where
parseJSON _ = fail "Cannot parse Void"
{-# INLINE parseJSON #-}
#endif
withNumber :: String -> (Number -> Parser a) -> Value -> Parser a
withNumber :: String -> (Number -> Parser a) -> Value -> Parser a
withNumber expected :: String
expected f :: Number -> Parser a
f = String -> (Scientific -> Parser a) -> Value -> Parser a
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
expected (Number -> Parser a
f (Number -> Parser a)
-> (Scientific -> Number) -> Scientific -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Number
scientificToNumber)
{-# INLINE withNumber #-}
{-# DEPRECATED withNumber "Use withScientific instead" #-}
scientificToNumber :: Scientific.Scientific -> Number
scientificToNumber :: Scientific -> Number
scientificToNumber s :: Scientific
s
| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1024 = Double -> Number
D (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Scientific -> Double
forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat Scientific
s
| Bool
otherwise = Integer -> Number
I (Integer -> Number) -> Integer -> Number
forall a b. (a -> b) -> a -> b
$ Integer
c Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e
where
e :: Int
e = Scientific -> Int
Scientific.base10Exponent Scientific
s
c :: Integer
c = Scientific -> Integer
Scientific.coefficient Scientific
s
{-# INLINE scientificToNumber #-}
#if !MIN_VERSION_aeson(1,2,3)
withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a
withEmbeddedJSON _ innerParser (String txt) =
either fail innerParser $ eitherDecode (L.fromStrict $ TE.encodeUtf8 txt)
withEmbeddedJSON name _ v = typeMismatch name v
{-# INLINE withEmbeddedJSON #-}
#endif