81f8fb5 · typeable/aeson

git.iko.soy/typeable/aeson

Merge pull request #288 from phadej/dot-colon-qmark

Add (.:!) and partially revert d0414be92ee6bf5b4c057978955b89d111767dab

commit81f8fb55d9dfba6501359cc585f9371974a778c0 authorBryan O'Sullivan <bos@serpentine.com> dateFri 15 Jan 2016, 11:22 (11 years ago) parent4429b86 0d335f1

7 files changed+58−12

compare with master

unifiedsplit

Data/Aeson.hs+1 Data/Aeson/TH.hs+2−2 Data/Aeson/Types.hs+1 Data/Aeson/Types/Generic.hs+3−3 Data/Aeson/Types/Instances.hs+16−4 aeson.cabal+1 tests/UnitTests.hs+34−3

Data/Aeson.hs+1

@@ -78,6 +78,7 @@ module Data.Aeson

7878 , foldable

7979 , (.:)

8080 , (.:?)

81+ , (.:!)

8182 , (.!=)

8283 , object

8384 -- * Parsing

Data/Aeson/TH.hs+2−2

@@ -101,7 +101,7 @@ import Data.Aeson.Types ( Value(..), Parser

101101 , defaultTaggedObject

102102 )

103103import Data.Aeson.Types.Internal (Encoding(..))

104−import Control.Monad ( join, liftM2, return, mapM, fail )

104+import Control.Monad ( liftM2, return, mapM, fail )

105105import Data.Bool ( Bool(False, True), otherwise, (&&), not )

106106import Data.Either ( Either(Left, Right) )

107107import Data.Eq ( (==) )

@@ -960,7 +960,7 @@ instance OVERLAPPABLE_ (FromJSON a) => LookupField a where

960960 Just v -> parseJSON v

961961

962962instance (FromJSON a) => LookupField (Maybe a) where

963− lookupField _ _ obj key = join <$> obj .:? key

963+ lookupField _ _ = (.:?)

964964

965965unknownFieldFail :: String -> String -> String -> Parser fail

966966unknownFieldFail tName rec key =

Data/Aeson/Types.hs+1

@@ -55,6 +55,7 @@ module Data.Aeson.Types

5555 , foldable

5656 , (.:)

5757 , (.:?)

58+ , (.:!)

5859 , (.!=)

5960 , object

6061

Data/Aeson/Types/Generic.hs+3−3

@@ -22,7 +22,7 @@

2222module Data.Aeson.Types.Generic ( ) where

2323

2424import Control.Applicative ((<|>))

25−import Control.Monad ((<=<), join)

25+import Control.Monad ((<=<))

2626import Control.Monad.ST (ST)

2727import Data.Aeson.Encode.Builder (emptyArray_)

2828import Data.Aeson.Encode.Functions (builder)

@@ -665,8 +665,8 @@ instance (Selector s, GFromJSON a) => FromRecord (S1 s a) where

665665

666666instance OVERLAPPING_ (Selector s, FromJSON a) =>

667667 FromRecord (S1 s (K1 i (Maybe a))) where

668− parseRecord _ (Just lab) obj = (M1 . K1) . join <$> obj .:? lab

669− parseRecord opts Nothing obj = (M1 . K1) . join <$> obj .:? pack label

668+ parseRecord _ (Just lab) obj = (M1 . K1) <$> obj .:? lab

669+ parseRecord opts Nothing obj = (M1 . K1) <$> obj .:? pack label

670670 where

671671 label = fieldLabelModifier opts $

672672 selName (undefined :: t s (K1 i (Maybe a)) p)

Data/Aeson/Types/Instances.hs+16−4

@@ -52,6 +52,7 @@ module Data.Aeson.Types.Instances

5252 , ifromJSON

5353 , (.:)

5454 , (.:?)

55+ , (.:!)

5556 , (.!=)

5657 , tuple

5758 , (>*<)

@@ -1593,7 +1594,7 @@ ifromJSON = iparse parseJSON

15931594--

15941595-- This accessor is appropriate if the key and value /must/ be present

15951596-- in an object for it to be valid. If the key and value are

1596−-- optional, use '(.:?)' instead.

1597+-- optional, use '.:?' instead.

15971598(.:) :: (FromJSON a) => Object -> Text -> Parser a

15981599obj .: key = case H.lookup key obj of

15991600 Nothing -> fail $ "key " ++ show key ++ " not present"

@@ -1609,23 +1610,34 @@ obj .: key = case H.lookup key obj of

16091610--

16101611-- This accessor is most useful if the key and value can be absent

16111612-- from an object without affecting its validity. If the key and

1612−-- value are mandatory, use '(.:)' instead.

1613+-- value are mandatory, use '.:' instead.

16131614(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)

16141615obj .:? key = case H.lookup key obj of

16151616 Nothing -> pure Nothing

16161617 Just v -> modifyFailure addKeyName

1617− $ Just <$> parseJSON v <?> Key key

1618+ $ parseJSON v <?> Key key

16181619 where

16191620 addKeyName = (("failed to parse field " <> unpack key <> ": ") <>)

16201621{-# INLINE (.:?) #-}

16211622

1623+-- | Like '.:?', but the resulting parser will fail,

1624+-- if the key is present but is 'Null'.

1625+(.:!) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)

1626+obj .:! key = case H.lookup key obj of

1627+ Nothing -> pure Nothing

1628+ Just v -> modifyFailure addKeyName

1629+ $ Just <$> parseJSON v <?> Key key

1630+ where

1631+ addKeyName = (("failed to parse field " <> unpack key <> ": ") <>)

1632+{-# INLINE (.:!) #-}

1633+

16221634-- | Helper for use in combination with '.:?' to provide default

16231635-- values for optional JSON object fields.

16241636--

16251637-- This combinator is most useful if the key and value can be absent

16261638-- from an object without affecting its validity and we know a default

16271639-- value to assign in that case. If the key and value are mandatory,

1628−-- use '(.:)' instead.

1640+-- use '.:' instead.

16291641--

16301642-- Example usage:

16311643--

aeson.cabal+1

@@ -46,6 +46,7 @@ extra-source-files:

4646 benchmarks/Makefile

4747 benchmarks/Typed/*.hs

4848 benchmarks/json-data/*.json

49+ include/overlapping-compat.h

4950 changelog.md

5051 examples/*.cabal

5152 examples/*.hs

tests/UnitTests.hs+34−3

@@ -5,10 +5,10 @@

55module UnitTests (ioTests, tests) where

77import Control.Monad (forM)

8−import Data.Aeson (decode, eitherDecode, encode, genericToJSON, genericToEncoding)

9−import Data.Aeson.TH ( deriveJSON )

8+import Data.Aeson (decode, eitherDecode, encode, genericToJSON, genericToEncoding, FromJSON(..), withObject, (.:), (.:?), (.:!))

109import Data.Aeson.Encode (encodeToTextBuilder)

11−import Data.Aeson.Types (ToJSON(..), FromJSON, Value, camelTo, camelTo2, defaultOptions, omitNothingFields)

10+import Data.Aeson.TH (deriveJSON)

11+import Data.Aeson.Types (ToJSON(..), Value, camelTo, camelTo2, defaultOptions, omitNothingFields)

1212import Data.Char (toUpper)

1313import Data.Time (UTCTime)

1414import Data.Time.Format (parseTime)

@@ -49,6 +49,7 @@ tests = testGroup "unit" [

4949 testCase "good" $ utcTimeGood

5050 , testCase "bad" $ utcTimeBad

5151 ]

52+ , testGroup ".:, .:?, .:!" $ fmap (testCase "-") dotColonMark

5253 ]

5354

5455roundTripCamel :: String -> Assertion

@@ -161,6 +162,36 @@ utcTimeBad = do

161162 let (dec :: Maybe UTCTime) = decode . LT.encodeUtf8 $ (LT.concat ["\"", s, "\""]) in

162163 assertEqual "verify failure" Nothing dec

163164

165+------------------------------------------------------------------------------

166+-- Comparison (.:?) and (.:!)

167+------------------------------------------------------------------------------

168+

169+newtype T1 = T1 (Maybe Int) deriving (Eq, Show)

170+newtype T2 = T2 (Maybe Int) deriving (Eq, Show)

171+newtype T3 = T3 (Maybe Int) deriving (Eq, Show)

172+

173+instance FromJSON T1 where parseJSON = fmap T1 . withObject "T1" (.: "value")

174+instance FromJSON T2 where parseJSON = fmap T2 . withObject "T2" (.:? "value")

175+instance FromJSON T3 where parseJSON = fmap T3 . withObject "T3" (.:! "value")

176+

177+dotColonMark :: [Assertion]

178+dotColonMark = [

179+ assertEqual ".: not-present" Nothing (decode ex1 :: Maybe T1)

180+ , assertEqual ".: 42" (Just (T1 (Just 42))) (decode ex2 :: Maybe T1)

181+ , assertEqual ".: null" (Just (T1 Nothing)) (decode ex3 :: Maybe T1)

182+

183+ , assertEqual ".:? not-present" (Just (T2 (Nothing))) (decode ex1 :: Maybe T2)

184+ , assertEqual ".:? 42" (Just (T2 (Just 42))) (decode ex2 :: Maybe T2)

185+ , assertEqual ".:? null" (Just (T2 Nothing)) (decode ex3 :: Maybe T2)

186+

187+ , assertEqual ".:! not-present" (Just (T3 (Nothing))) (decode ex1 :: Maybe T3)

188+ , assertEqual ".:! 42" (Just (T3 (Just 42))) (decode ex2 :: Maybe T3)

189+ , assertEqual ".:! null" Nothing (decode ex3 :: Maybe T3)

190+ ]

191+ where ex1 = "{}"

192+ ex2 = "{\"value\": 42 }"

193+ ex3 = "{\"value\": null }"

194+

164195

165196------------------------------------------------------------------------------

166197-- Comparison between bytestring and text encoders