module Data.Aeson.Compat (
decode,
decode',
decodeStrict,
decodeStrict',
AesonException(..),
eitherDecode, eitherDecode', eitherDecodeStrict, eitherDecodeStrict',
(.:?), (.:!),
module Data.Aeson,
) 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 (0,9,0)
import Data.Aeson.Parser (value, value')
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
import Data.Aeson.Types hiding ((.:?))
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 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.Aeson.Compat.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
newtype AesonException = AesonException String
deriving (Show, Typeable)
instance Exception AesonException
eitherAesonExc :: (MonadThrow m) => Either String a -> m a
eitherAesonExc (Left err) = throwM (AesonException err)
eitherAesonExc (Right x) = return x
decode :: (FromJSON a, MonadThrow m) => L.ByteString -> m a
decode = eitherAesonExc . eitherDecode
decode' :: (FromJSON a, MonadThrow m) => L.ByteString -> m a
decode' = eitherAesonExc . eitherDecode'
decodeStrict :: (FromJSON a, MonadThrow m) => B.ByteString -> m a
decodeStrict = eitherAesonExc . eitherDecodeStrict
decodeStrict' :: (FromJSON a, MonadThrow m) => B.ByteString -> m a
decodeStrict' = eitherAesonExc . eitherDecodeStrict'
(.:?) :: (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 $ parseJSON v
where
addKeyName = mappend $ mconcat ["failed to parse field ", T.unpack key, ": "]
#else
parseJSON v
#endif
#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
#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
eitherDecodeStrict :: (FromJSON a) => B.ByteString -> Either String a
eitherDecodeStrict = eitherDecodeStrictWith jsonEOF fromJSON
eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a
eitherDecode' = eitherDecodeWith jsonEOF' fromJSON
eitherDecodeStrict' :: (FromJSON a) => B.ByteString -> Either String a
eitherDecodeStrict' = eitherDecodeStrictWith jsonEOF' fromJSON
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
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
#endif
#if !MIN_VERSION_aeson(0,10,0)
instance FromJSON Day where
parseJSON = withText "Day" (CompatTime.run CompatTime.day)
instance FromJSON LocalTime where
parseJSON = withText "LocalTime" (CompatTime.run 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
#if MIN_VERSION_aeson(0,10,0)
toEncoding = Encoding . E.number . realToFrac
#endif
instance FromJSON NominalDiffTime where
parseJSON = withScientific "NominalDiffTime" $ pure . realToFrac
#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
#if MIN_VERSION_aeson(0,10,0)
toEncoding = toEncoding . toInteger
#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
#if MIN_VERSION_aeson(0,10,0)
toEncoding = toEncoding . showVersion
#endif
instance FromJSON Version where
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
instance FromJSON (Proxy a) where
parseJSON Null = pure Proxy
parseJSON v = typeMismatch "Proxy" v
instance ToJSON b => ToJSON (Tagged a b) where
toJSON (Tagged x) = toJSON x
#if MIN_VERSION_aeson(0,10,0)
toEncoding (Tagged x) = toEncoding x
#endif
instance FromJSON b => FromJSON (Tagged a b) where
parseJSON = fmap Tagged . parseJSON
instance ToJSON a => ToJSON (Const a b) where
toJSON (Const x) = toJSON x
#if MIN_VERSION_aeson(0,10,0)
toEncoding (Const x) = toEncoding x
#endif
instance FromJSON a => FromJSON (Const a b) where
parseJSON = fmap Const . parseJSON
instance (ToJSON a) => ToJSON (NonEmpty a) where
toJSON = toJSON . NonEmpty.toList
#if MIN_VERSION_aeson(0,10,0)
toEncoding = toEncoding . NonEmpty.toList
#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