{-# 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,11,0)
, (.:!)
#endif
#if !MIN_VERSION_aeson (0,9,0)
, eitherDecode, eitherDecode', eitherDecodeStrict, eitherDecodeStrict'
#endif
#if !MIN_VERSION_aeson (1,4,0)
, withNumber
#endif
)
import qualified Data.Aeson as Aeson
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 BS
import qualified Data.Scientific as Scientific
import Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HM
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 NE
import qualified Data.Vector as V
#endif
#if !MIN_VERSION_aeson(1,4,1)
import Data.Void (Void, absurd)
#endif
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KM
#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 String
err) = AesonException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (String -> AesonException
AesonException String
err)
eitherAesonExc (Right a
x) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
decode :: (FromJSON a, MonadThrow m) => LBS.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) => LBS.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) => BS.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) => BS.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 a
#if MIN_VERSION_aeson(2,0,0)
Object
obj .: :: Object -> Text -> Parser a
.: Text
key = Object
obj Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Text -> Key
Key.fromText Text
key
#else
obj .: key = obj Aeson..: key
#endif
(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
Object
obj .:? :: Object -> Text -> Parser (Maybe a)
.:? Text
key =
#if MIN_VERSION_aeson(2,0,0)
case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (Text -> Key
Key.fromText Text
key) Object
obj of
#else
case HM.lookup key obj of
#endif
Maybe Value
Nothing -> Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
Just 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 [String
"failed to parse field ", Text -> String
T.unpack Text
key, String
": "]
#else
parseJSON v
#endif
{-# INLINE (.:?) #-}
(.:!) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
#if MIN_VERSION_aeson(2,0,0)
Object
obj .:! :: Object -> Text -> Parser (Maybe a)
.:! Text
key = Object
obj Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:! Text -> Key
Key.fromText Text
key
#else
#if MIN_VERSION_aeson(0,11,0)
(.:!) = (Aeson..:!)
#else
obj .:! key =
#if MIN_VERSION_aeson(2,0,0)
case KM.lookup (Key.fromText key) obj of
#else
case HM.lookup key obj of
#endif
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
#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) => LBS.ByteString -> Either String a
eitherDecode = eitherDecodeWith jsonEOF fromJSON
{-# INLINE eitherDecode #-}
eitherDecodeStrict :: (FromJSON a) => BS.ByteString -> Either String a
eitherDecodeStrict = eitherDecodeStrictWith jsonEOF fromJSON
{-# INLINE eitherDecodeStrict #-}
eitherDecode' :: (FromJSON a) => LBS.ByteString -> Either String a
eitherDecode' = eitherDecodeWith jsonEOF' fromJSON
{-# INLINE eitherDecode' #-}
eitherDecodeStrict' :: (FromJSON a) => BS.ByteString -> Either String a
eitherDecodeStrict' = eitherDecodeStrictWith jsonEOF' fromJSON
{-# INLINE eitherDecodeStrict' #-}
eitherDecodeWith :: L.Parser Value -> (Value -> Result a) -> LBS.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) -> BS.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 . NE.toList
{-# INLINE toJSON #-}
#if MIN_VERSION_aeson(0,10,0)
toEncoding = toEncoding . NE.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 String
expected 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 Scientific
s
| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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
* Integer
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 (LBS.fromStrict $ TE.encodeUtf8 txt)
withEmbeddedJSON name _ v = typeMismatch name v
{-# INLINE withEmbeddedJSON #-}
#endif