{-# 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
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 :: forall (m :: * -> *) a. MonadThrow m => Either String a -> m a
eitherAesonExc (Left String
err) = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (String -> AesonException
AesonException String
err)
eitherAesonExc (Right a
x) = forall (m :: * -> *) a. Monad m => a -> m a
return a
x
decode :: (FromJSON a, MonadThrow m) => LBS.ByteString -> m a
decode :: forall a (m :: * -> *).
(FromJSON a, MonadThrow m) =>
ByteString -> m a
decode = forall (m :: * -> *) a. MonadThrow m => Either String a -> m a
eitherAesonExc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
eitherDecode
decode' :: (FromJSON a, MonadThrow m) => LBS.ByteString -> m a
decode' :: forall a (m :: * -> *).
(FromJSON a, MonadThrow m) =>
ByteString -> m a
decode' = forall (m :: * -> *) a. MonadThrow m => Either String a -> m a
eitherAesonExc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
eitherDecode'
decodeStrict :: (FromJSON a, MonadThrow m) => BS.ByteString -> m a
decodeStrict :: forall a (m :: * -> *).
(FromJSON a, MonadThrow m) =>
ByteString -> m a
decodeStrict = forall (m :: * -> *) a. MonadThrow m => Either String a -> m a
eitherAesonExc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict
decodeStrict' :: (FromJSON a, MonadThrow m) => BS.ByteString -> m a
decodeStrict' :: forall a (m :: * -> *).
(FromJSON a, MonadThrow m) =>
ByteString -> m a
decodeStrict' = forall (m :: * -> *) a. MonadThrow m => Either String a -> m a
eitherAesonExc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict'
(.:) :: (FromJSON a) => Object -> Text -> Parser a
#if MIN_VERSION_aeson(2,0,0)
Object
obj .: :: forall a. FromJSON a => Object -> Text -> Parser a
.: Text
key = Object
obj 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 .:? :: forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
key =
#if MIN_VERSION_aeson(2,0,0)
case 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just Value
v ->
#if MIN_VERSION_aeson(0,10,0)
forall a. ShowS -> Parser a -> Parser a
modifyFailure ShowS
addKeyName forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
where
addKeyName :: ShowS
addKeyName = forall a. Monoid a => a -> a -> a
mappend forall a b. (a -> b) -> a -> b
$ 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 .:! :: forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
key = Object
obj 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 :: forall a. String -> (Number -> Parser a) -> Value -> Parser a
withNumber String
expected Number -> Parser a
f = forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
expected (Number -> Parser a
f 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 forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e forall a. Ord a => a -> a -> Bool
> Int
1024 = Double -> Number
D forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat Scientific
s
| Bool
otherwise = Integer -> Number
I forall a b. (a -> b) -> a -> b
$ Integer
c forall a. Num a => a -> a -> a
* Integer
10 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