aeson-compat-0.3.9/0000755000000000000000000000000013352150471012300 5ustar0000000000000000aeson-compat-0.3.9/CHANGELOG.md0000644000000000000000000000204413352150471014111 0ustar0000000000000000# 0.3.9 - Add `ToJSON/FromJSON Void` # 0.3.8 - Re-implement `withNumber` - Add `withEmbeddedJSON` # 0.3.7 - Use `attoparsec-iso8601` time parsers. - Don't export `GToJSON` etc. members. # 0.3.6 - Fix accidental removal of `AesonException` export # 0.3.5.2 - Support QuickCheck-2.9.1 # 0.3.5.1 - Fix `(.=)` export regression introduced by 0.3.5.0 # 0.3.5.0 - Use explicit export list. Now we are sure we don't break interface. - `value`, `value'` and `Parser` are exported from `Data.Aeson.Compat` # 0.3.4.0 - Add `NominalDiffTime` instances # 0.3.3.0 - Enable `PolyKinds` to generalize `Proxy`, `Tagged`, and `Const` instances. # 0.3.2.0 - Introduce instances from `aeson-0.11.1.0`: `Const`, `Tagged`, `Proxy` and `NonEmpty` - Fix bug with `Natural` instance, `aeson-0.11.1.0` and `base <=4.7` # 0.3.1.0 - `aeson-0.11` support - GHC 8.0.1 support - Add `ToJSON` `Day` and `LocalTime` instances - *NOTE* this instances are broken in `aeson-0.10.0.0` - Add `Natural`, `Ordering` and `Version` instances # 0.3.0.0 Split out `aeson-extra` aeson-compat-0.3.9/LICENSE0000644000000000000000000000276213352150471013314 0ustar0000000000000000Copyright (c) 2015, Oleg Grenrus All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Oleg Grenrus nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. aeson-compat-0.3.9/Setup.hs0000644000000000000000000000005613352150471013735 0ustar0000000000000000import Distribution.Simple main = defaultMain aeson-compat-0.3.9/aeson-compat.cabal0000644000000000000000000000520613352150471015655 0ustar0000000000000000name: aeson-compat version: 0.3.9 synopsis: Compatibility layer for aeson description: Compatibility layer for @aeson@ category: Web homepage: https://github.com/phadej/aeson-compat#readme bug-reports: https://github.com/phadej/aeson-compat/issues author: Oleg Grenrus maintainer: Oleg Grenrus license: BSD3 license-file: LICENSE build-type: Simple cabal-version: >= 1.10 tested-with: GHC ==7.6.3 || ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.1 extra-source-files: CHANGELOG.md README.md source-repository head type: git location: https://github.com/phadej/aeson-compat library hs-source-dirs: src ghc-options: -Wall build-depends: base >=4.6 && <4.13 , base-compat >=0.6.0 && <0.11 , aeson >=0.7.0.6 && <1.5 , attoparsec >=0.12 && <0.14 , attoparsec-iso8601 >=1.0.0.0 && <1.1 , bytestring >=0.10 && <0.11 , containers >=0.5 && <0.7 , exceptions >=0.8 && <0.11 , hashable >=1.2 && <1.3 , scientific >=0.3 && <0.4 , text >=1.2 && <1.3 , time >=1.4.0.1 && <1.9 , time-locale-compat >=0.1.0.1 && <0.2 , unordered-containers >=0.2 && <0.3 , vector >=0.10 && <0.13 , tagged >=0.7.3 && <0.9 if !impl(ghc >= 8.0) build-depends: semigroups >=0.18.5 && <0.19 if !impl(ghc >= 7.10) build-depends: nats >=1.1.2 && <1.2, void >=0.7.2 && <0.8 exposed-modules: Data.Aeson.Compat default-language: Haskell2010 test-suite aeson-compat-test type: exitcode-stdio-1.0 main-is: Tests.hs hs-source-dirs: test ghc-options: -Wall build-depends: base , base-compat , aeson , attoparsec , bytestring , containers , exceptions , hashable , scientific , text , time , time-locale-compat , unordered-containers , vector , tagged , aeson-compat , base-orphans >=0.4.5 && <0.9 , tasty >=0.10 && <1.2 , tasty-hunit >=0.9 && <0.11 , tasty-quickcheck >=0.8 && <0.11 , QuickCheck >=2.10 && <2.13 , quickcheck-instances >=0.3.16 && <0.4 if !impl(ghc >= 8.0) build-depends: semigroups if !impl(ghc >= 7.10) build-depends: nats, void default-language: Haskell2010 aeson-compat-0.3.9/README.md0000644000000000000000000000112213352150471013553 0ustar0000000000000000# aeson-compat [![Build Status](https://travis-ci.org/phadej/aeson-compat.svg?branch=master)](https://travis-ci.org/phadej/aeson-compat) [![Hackage](https://img.shields.io/hackage/v/aeson-compat.svg)](http://hackage.haskell.org/package/aeson-compat) [![Stackage LTS 3](http://stackage.org/package/monad-http/badge/lts-3)](http://stackage.org/lts-3/package/aeson-compat) [![Stackage Nightly](http://stackage.org/package/monad-http/badge/nightly)](http://stackage.org/nightly/package/aeson-compat) The package provides compatibility layer for [`aeson`](http://hackage.haskell.org/package/aeson)aeson-compat-0.3.9/src/0000755000000000000000000000000013352150471013067 5ustar0000000000000000aeson-compat-0.3.9/src/Data/0000755000000000000000000000000013352150471013740 5ustar0000000000000000aeson-compat-0.3.9/src/Data/Aeson/0000755000000000000000000000000013352150471015005 5ustar0000000000000000aeson-compat-0.3.9/src/Data/Aeson/Compat.hs0000644000000000000000000003460013352150471016567 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Aeson.Compat -- Copyright : (C) 2015 Oleg Grenrus -- License : BSD3 -- Maintainer : Oleg Grenrus -- -- Compatibility notices -- -- * 'decode' etc. work as in @aeson >=0.9@ -- * but it is generalised to work in any 'MonadThrow' (that is extra) -- * '.:?' works as in @aeson <0.10 || >=0.11@ -- * '.:!' works as in @aeson <0.10 || >=0.11@ and as '.:?' did in @aeson ==0.10.*@ -- * Orphan instances 'FromJSON' 'Day' and 'FromJSON' 'LocalTime' for @aeson <0.10@ -- * 'Encoding' related functionality is not added. It's present only with @aeson >=0.10@ -- module Data.Aeson.Compat ( -- * Encoding and decoding -- ** Direct encoding decode, decode', AesonException(..), eitherDecode, eitherDecode', encode, -- ** Variants for strict bytestrings decodeStrict, decodeStrict', eitherDecodeStrict, eitherDecodeStrict', -- * Core JSON types Value(..), #if MIN_VERSION_aeson(0,10,0) Encoding, fromEncoding, #endif Array, Object, -- * Convenience types DotNetTime(..), -- * Type conversion FromJSON(..), Result(..), fromJSON, ToJSON(..), #if MIN_VERSION_aeson(0,10,0) KeyValue(..), #else (.=), #endif -- ** Generic JSON classes and options GFromJSON, GToJSON, #if MIN_VERSION_aeson(0,11,0) -- GToEncoding is introduced in 0.11.0.0 GToEncoding, #endif genericToJSON, #if MIN_VERSION_aeson(0,10,0) genericToEncoding, #endif genericParseJSON, defaultOptions, -- * Inspecting @'Value's@ withObject, withText, withArray, withNumber, withScientific, withBool, withEmbeddedJSON, -- * Constructors and accessors #if MIN_VERSION_aeson(0,10,0) Series, pairs, foldable, #endif (.:), (.:?), (.:!), (.!=), object, -- * Parsing 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 (..)) -- | Exception thrown by 'decode' - family of functions in this module. 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 -- | Like original 'Data.Aeson.decode' but in arbitrary 'MonadThrow'. -- -- Parse a top-level JSON value, i.e. also strings, numbers etc. decode :: (FromJSON a, MonadThrow m) => L.ByteString -> m a decode = eitherAesonExc . eitherDecode -- | Like original 'Data.Aeson.decode'' but in arbitrary 'MonadThrow'. decode' :: (FromJSON a, MonadThrow m) => L.ByteString -> m a decode' = eitherAesonExc . eitherDecode' -- | Like original 'Data.Aeson.decodeStrict' but in arbitrary 'MonadThrow'. decodeStrict :: (FromJSON a, MonadThrow m) => B.ByteString -> m a decodeStrict = eitherAesonExc . eitherDecodeStrict -- | Like original 'Data.Aeson.decodeStrict'' but in arbitrary 'MonadThrow'. decodeStrict' :: (FromJSON a, MonadThrow m) => B.ByteString -> m a decodeStrict' = eitherAesonExc . eitherDecodeStrict' -- | Retrieve the value associated with the given key of an 'Object'. -- The result is 'Nothing' if the key is not present, or 'empty' if -- the value cannot be converted to the desired type. -- -- This accessor is most useful if the key and value can be absent -- from an object without affecting its validity. If the key and -- value are mandatory, use '.:' instead. -- -- This operator is consistent in @aeson >=0.7 && <0.11@ (.:?) :: (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 -- Key key where addKeyName = mappend $ mconcat ["failed to parse field ", T.unpack key, ": "] #else parseJSON v #endif {-# INLINE (.:?) #-} #if !MIN_VERSION_aeson(0,11,0) -- | Like '.:?', but the resulting parser will fail, -- if the key is present but is 'Null'. (.:!) :: (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 -- Key key 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) -- From Parser.Internal -- | Parse a top-level JSON value followed by optional whitespace and -- end-of-input. See also: 'json'. jsonEOF :: A.Parser Value jsonEOF = value <* A.skipSpace <* A.endOfInput -- | Parse a top-level JSON value followed by optional whitespace and -- end-of-input. See also: 'json''. jsonEOF' :: A.Parser Value jsonEOF' = value' <* A.skipSpace <* A.endOfInput -- | Like 'decode' but returns an error message when decoding fails. eitherDecode :: (FromJSON a) => L.ByteString -> Either String a eitherDecode = eitherDecodeWith jsonEOF fromJSON {-# INLINE eitherDecode #-} -- | Like 'decodeStrict' but returns an error message when decoding fails. eitherDecodeStrict :: (FromJSON a) => B.ByteString -> Either String a eitherDecodeStrict = eitherDecodeStrictWith jsonEOF fromJSON {-# INLINE eitherDecodeStrict #-} -- | Like 'decode'' but returns an error message when decoding fails. eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a eitherDecode' = eitherDecodeWith jsonEOF' fromJSON {-# INLINE eitherDecode' #-} -- | Like 'decodeStrict'' but returns an error message when decoding fails. 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 ----------------------------------------------------------------------- -- Instances in aeson-0.10 ----------------------------------------------------------------------- #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 -- | /WARNING:/ Only parse lengths of time from trusted input -- since an attacker could easily fill up the memory of the target -- system by specifying a scientific number with a big exponent like -- @1e1000000000@. instance FromJSON NominalDiffTime where parseJSON = withScientific "NominalDiffTime" $ pure . realToFrac {-# INLINE parseJSON #-} #endif ----------------------------------------------------------------------- -- Instances in aeson-0.11 ----------------------------------------------------------------------- #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 #-} -- No 'toEncoding', default is good enough 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 ------------------------------------------------------------------------------- -- with* ------------------------------------------------------------------------------- -- | @'withNumber' expected f value@ applies @f@ to the 'Number' when @value@ -- is a 'Number' and fails using @'typeMismatch' expected@ otherwise. withNumber :: String -> (Number -> Parser a) -> Value -> Parser a withNumber expected f = withScientific expected (f . scientificToNumber) {-# INLINE withNumber #-} {-# DEPRECATED withNumber "Use withScientific instead" #-} scientificToNumber :: Scientific.Scientific -> Number scientificToNumber s | e < 0 || e > 1024 = D $ Scientific.toRealFloat s | otherwise = I $ c * 10 ^ e where e = Scientific.base10Exponent s c = Scientific.coefficient s {-# INLINE scientificToNumber #-} #if !MIN_VERSION_aeson(1,2,3) -- | Decode a nested JSON-encoded string. 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 aeson-compat-0.3.9/test/0000755000000000000000000000000013352150471013257 5ustar0000000000000000aeson-compat-0.3.9/test/Tests.hs0000644000000000000000000000721713352150471014724 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Main (main, ex) where import Prelude () import Prelude.Compat import Control.Applicative (Const) import Data.List.NonEmpty (NonEmpty) import Data.Proxy (Proxy (..)) import Data.Tagged (Tagged) import Data.Text (Text) import Data.Time (Day, LocalTime, NominalDiffTime) import Data.Version (Version) import Numeric.Natural (Natural) import Data.Orphans () import Test.QuickCheck.Instances () import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck import Data.Aeson.Compat main :: IO () main = defaultMain $ testGroup "Tests" [ dotColonMark , testGroup "Roundtrip" [ testProperty "Day" $ roundtripBroken10 (undefined :: Day) , testProperty "LocalTime" $ roundtripBroken10 (undefined :: LocalTime) , testProperty "Version" $ roundtrip (undefined :: Version) , testProperty "Ordering" $ roundtrip (undefined :: Ordering) , testProperty "Natural" $ roundtrip (undefined :: Natural) , testProperty "Const" $ roundtrip (undefined :: Const Int Int) , testProperty "Proxy" $ roundtrip (undefined :: Proxy Int) , testProperty "Tagged" $ roundtrip (undefined :: Tagged Int Int) , testProperty "NonEmpty" $ roundtrip (undefined :: NonEmpty Int) , testProperty "NominalDiffTime" $ roundtrip (undefined :: NominalDiffTime) ] ] ------------------------------------------------------------------------------ -- Comparison (.:?) and (.:!) ------------------------------------------------------------------------------ newtype T1 = T1 (Maybe Int) deriving (Eq, Show) newtype T2 = T2 (Maybe Int) deriving (Eq, Show) newtype T3 = T3 (Maybe Int) deriving (Eq, Show) instance FromJSON T1 where parseJSON = fmap T1 . withObject "T1" (.: "value") instance FromJSON T2 where parseJSON = fmap T2 . withObject "T2" (.:? "value") instance FromJSON T3 where parseJSON = fmap T3 . withObject "T3" (.:! "value") dotColonMark :: TestTree dotColonMark = testGroup "Operators" $ fmap t [ assertEqual ".: not-present" Nothing (decode ex1 :: Maybe T1) , assertEqual ".: 42" (Just (T1 (Just 42))) (decode ex2 :: Maybe T1) , assertEqual ".: null" (Just (T1 Nothing)) (decode ex3 :: Maybe T1) , assertEqual ".:? not-present" (Just (T2 (Nothing))) (decode ex1 :: Maybe T2) , assertEqual ".:? 42" (Just (T2 (Just 42))) (decode ex2 :: Maybe T2) , assertEqual ".:? null" (Just (T2 Nothing)) (decode ex3 :: Maybe T2) , assertEqual ".:! not-present" (Just (T3 (Nothing))) (decode ex1 :: Maybe T3) , assertEqual ".:! 42" (Just (T3 (Just 42))) (decode ex2 :: Maybe T3) , assertEqual ".:! null" Nothing (decode ex3 :: Maybe T3) ] where ex1 = "{}" ex2 = "{\"value\": 42 }" ex3 = "{\"value\": null }" t = testCase "-" roundtrip :: (Arbitrary a, Eq a, Show a, ToJSON a, FromJSON a) => a -> a -> Property roundtrip _ x = Right x === (eitherDecode . encode $ x) roundtripBroken10 :: (Arbitrary a, Eq a, Show a, ToJSON a, FromJSON a) => a -> a -> Property #if MIN_VERSION_aeson(0,10,0) && !MIN_VERSION_aeson(0,11,0) roundtripBroken10 _ x = property $ case eitherDecode . encode $ x of Right y -> False && x == y -- x and y of the same type! Left _ -> True #else roundtripBroken10 = roundtrip #endif ------------------------------------------------------------------------------- -- tests that symbols are exported ------------------------------------------------------------------------------- ex :: (Text, Value) ex = "foo" .= True