Skip to content

Commit 2d59487

Browse files
bergmarkbergmark
authored
Merge pull request #778 from phadej/aeson-these
aeson <-> these swap
2 parents e1cf3a6 + eb4ed73 commit 2d59487

File tree

9 files changed

+130
-2
lines changed

9 files changed

+130
-2
lines changed

‎.travis.yml

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -120,6 +120,8 @@ install:
120120
- if [ $HCNUMVER -ge 80200 ] ; then echo 'package aeson-examples' >> cabal.project ; fi
121121
- "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
122122
- |
123+
echo "packages: https://oleg.fi/these-1.1.tar.gz" >> cabal.project
124+
echo "packages: https://oleg.fi/quickcheck-instances-0.3.23.tar.gz" >> cabal.project
123125
- "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(aeson|aeson-examples|attoparsec-iso8601)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
124126
- cat cabal.project || true
125127
- cat cabal.project.local || true
@@ -157,6 +159,8 @@ script:
157159
- if [ $HCNUMVER -ge 80200 ] ; then echo 'package aeson-examples' >> cabal.project ; fi
158160
- "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
159161
- |
162+
echo "packages: https://oleg.fi/these-1.1.tar.gz" >> cabal.project
163+
echo "packages: https://oleg.fi/quickcheck-instances-0.3.23.tar.gz" >> cabal.project
160164
- "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(aeson|aeson-examples|attoparsec-iso8601)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
161165
- cat cabal.project || true
162166
- cat cabal.project.local || true

‎Data/Aeson/Types/FromJSON.hs

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -92,6 +92,7 @@ import Data.Functor.Compose (Compose(..))
9292
import Data.Functor.Identity (Identity(..))
9393
import Data.Functor.Product (Product(..))
9494
import Data.Functor.Sum (Sum(..))
95+
import Data.Functor.These (These1 (..))
9596
import Data.Hashable (Hashable(..))
9697
import Data.Int (Int16, Int32, Int64, Int8)
9798
import Data.List.NonEmpty (NonEmpty(..))
@@ -101,6 +102,7 @@ import Data.Ratio ((%), Ratio)
101102
import Data.Scientific (Scientific, base10Exponent)
102103
import Data.Tagged (Tagged(..))
103104
import Data.Text (Text, pack, unpack)
105+
import Data.These (These (..))
104106
import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
105107
import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))
106108
import Data.Time.LocalTime.Compat (CalendarDiffTime (..))
@@ -2257,6 +2259,54 @@ instance FromJSONKey b => FromJSONKey (Tagged a b) where
22572259
fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction b)
22582260
fromJSONKeyList = (fmap . fmap) Tagged fromJSONKeyList
22592261

2262+
-------------------------------------------------------------------------------
2263+
-- these
2264+
-------------------------------------------------------------------------------
2265+
2266+
-- | @since 1.5.1.0
2267+
instance (FromJSON a, FromJSON b) => FromJSON (These a b) where
2268+
parseJSON = withObject "These a b" (p . H.toList)
2269+
where
2270+
p [("This", a), ("That", b)] = These <$> parseJSON a <*> parseJSON b
2271+
p [("That", b), ("This", a)] = These <$> parseJSON a <*> parseJSON b
2272+
p [("This", a)] = This <$> parseJSON a
2273+
p [("That", b)] = That <$> parseJSON b
2274+
p _ = fail "Expected object with 'This' and 'That' keys only"
2275+
2276+
-- | @since 1.5.1.0
2277+
instance FromJSON a => FromJSON1 (These a) where
2278+
liftParseJSON pb _ = withObject "These a b" (p . H.toList)
2279+
where
2280+
p [("This", a), ("That", b)] = These <$> parseJSON a <*> pb b
2281+
p [("That", b), ("This", a)] = These <$> parseJSON a <*> pb b
2282+
p [("This", a)] = This <$> parseJSON a
2283+
p [("That", b)] = That <$> pb b
2284+
p _ = fail "Expected object with 'This' and 'That' keys only"
2285+
2286+
-- | @since 1.5.1.0
2287+
instance FromJSON2 These where
2288+
liftParseJSON2 pa _ pb _ = withObject "These a b" (p . H.toList)
2289+
where
2290+
p [("This", a), ("That", b)] = These <$> pa a <*> pb b
2291+
p [("That", b), ("This", a)] = These <$> pa a <*> pb b
2292+
p [("This", a)] = This <$> pa a
2293+
p [("That", b)] = That <$> pb b
2294+
p _ = fail "Expected object with 'This' and 'That' keys only"
2295+
2296+
-- | @since 1.5.1.0
2297+
instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (These1 f g) where
2298+
liftParseJSON px pl = withObject "These1" (p . H.toList)
2299+
where
2300+
p [("This", a), ("That", b)] = These1 <$> liftParseJSON px pl a <*> liftParseJSON px pl b
2301+
p [("That", b), ("This", a)] = These1 <$> liftParseJSON px pl a <*> liftParseJSON px pl b
2302+
p [("This", a)] = This1 <$> liftParseJSON px pl a
2303+
p [("That", b)] = That1 <$> liftParseJSON px pl b
2304+
p _ = fail "Expected object with 'This' and 'That' keys only"
2305+
2306+
-- | @since 1.5.1.0
2307+
instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (These1 f g a) where
2308+
parseJSON = parseJSON1
2309+
22602310
-------------------------------------------------------------------------------
22612311
-- Instances for converting from map keys
22622312
-------------------------------------------------------------------------------

‎Data/Aeson/Types/ToJSON.hs

Lines changed: 53 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -76,6 +76,7 @@ import Data.Functor.Contravariant (Contravariant (..))
7676
import Data.Functor.Identity (Identity(..))
7777
import Data.Functor.Product (Product(..))
7878
import Data.Functor.Sum (Sum(..))
79+
import Data.Functor.These (These1 (..))
7980
import Data.Int (Int16, Int32, Int64, Int8)
8081
import Data.List (intersperse)
8182
import Data.List.NonEmpty (NonEmpty(..))
@@ -84,6 +85,7 @@ import Data.Ratio (Ratio, denominator, numerator)
8485
import Data.Scientific (Scientific)
8586
import Data.Tagged (Tagged(..))
8687
import Data.Text (Text, pack)
88+
import Data.These (These (..))
8789
import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
8890
import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))
8991
import Data.Time.LocalTime.Compat (CalendarDiffTime (..))
@@ -2284,6 +2286,57 @@ instance ToJSONKey b => ToJSONKey (Tagged a b) where
22842286
toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
22852287
toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
22862288

2289+
-------------------------------------------------------------------------------
2290+
-- these
2291+
-------------------------------------------------------------------------------
2292+
2293+
-- | @since 1.5.1.0
2294+
instance (ToJSON a, ToJSON b) => ToJSON (These a b) where
2295+
toJSON (This a) = object [ "This" .= a ]
2296+
toJSON (That b) = object [ "That" .= b ]
2297+
toJSON (These a b) = object [ "This" .= a, "That" .= b ]
2298+
2299+
toEncoding (This a) = E.pairs $ "This" .= a
2300+
toEncoding (That b) = E.pairs $ "That" .= b
2301+
toEncoding (These a b) = E.pairs $ "This" .= a <> "That" .= b
2302+
2303+
-- | @since 1.5.1.0
2304+
instance ToJSON2 These where
2305+
liftToJSON2 toa _ _tob _ (This a) = object [ "This" .= toa a ]
2306+
liftToJSON2 _toa _ tob _ (That b) = object [ "That" .= tob b ]
2307+
liftToJSON2 toa _ tob _ (These a b) = object [ "This" .= toa a, "That" .= tob b ]
2308+
2309+
liftToEncoding2 toa _ _tob _ (This a) = E.pairs $ E.pair "This" (toa a)
2310+
liftToEncoding2 _toa _ tob _ (That b) = E.pairs $ E.pair "That" (tob b)
2311+
liftToEncoding2 toa _ tob _ (These a b) = E.pairs $ E.pair "This" (toa a) <> E.pair "That" (tob b)
2312+
2313+
-- | @since 1.5.1.0
2314+
instance ToJSON a => ToJSON1 (These a) where
2315+
liftToJSON _tob _ (This a) = object [ "This" .= a ]
2316+
liftToJSON tob _ (That b) = object [ "That" .= tob b ]
2317+
liftToJSON tob _ (These a b) = object [ "This" .= a, "That" .= tob b ]
2318+
2319+
liftToEncoding _tob _ (This a) = E.pairs $ "This" .= a
2320+
liftToEncoding tob _ (That b) = E.pairs $ E.pair "That" (tob b)
2321+
liftToEncoding tob _ (These a b) = E.pairs $ "This" .= a <> E.pair "That" (tob b)
2322+
2323+
-- | @since 1.5.1.0
2324+
instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (These1 f g) where
2325+
liftToJSON tx tl (This1 a) = object [ "This" .= liftToJSON tx tl a ]
2326+
liftToJSON tx tl (That1 b) = object [ "That" .= liftToJSON tx tl b ]
2327+
liftToJSON tx tl (These1 a b) = object [ "This" .= liftToJSON tx tl a, "That" .= liftToJSON tx tl b ]
2328+
2329+
liftToEncoding tx tl (This1 a) = E.pairs $ E.pair "This" (liftToEncoding tx tl a)
2330+
liftToEncoding tx tl (That1 b) = E.pairs $ E.pair "That" (liftToEncoding tx tl b)
2331+
liftToEncoding tx tl (These1 a b) = E.pairs $
2332+
pair "This" (liftToEncoding tx tl a) `mappend`
2333+
pair "That" (liftToEncoding tx tl b)
2334+
2335+
-- | @since 1.5.1.0
2336+
instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (These1 f g a) where
2337+
toJSON = toJSON1
2338+
toEncoding = toEncoding1
2339+
22872340
-------------------------------------------------------------------------------
22882341
-- Instances for converting t map keys
22892342
-------------------------------------------------------------------------------

‎aeson.cabal

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: aeson
2-
version: 1.5.0.0
2+
version: 1.5.1.0
33
license: BSD3
44
license-file: LICENSE
55
category: Text, Web, JSON
@@ -148,6 +148,7 @@ library
148148
hashable >= 1.2.7.0 && < 1.4,
149149
scientific >= 0.3.6.2 && < 0.4,
150150
th-abstraction >= 0.2.8.0 && < 0.4,
151+
these >= 1.1 && < 1.2,
151152
uuid-types >= 1.0.3 && < 1.1,
152153
vector >= 0.12.0.1 && < 0.13
153154

@@ -229,12 +230,13 @@ test-suite aeson-tests
229230
tasty-hunit,
230231
tasty-quickcheck,
231232
text,
233+
these,
232234
time,
233235
time-compat,
234236
unordered-containers,
235237
uuid-types,
236238
vector,
237-
quickcheck-instances >= 0.3.21 && <0.4
239+
quickcheck-instances >= 0.3.23 && <0.4
238240

239241
if flag(bytestring-builder)
240242
build-depends: bytestring >= 0.9 && < 0.10.4,

‎benchmarks/aeson-benchmarks.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@ library
2525
, template-haskell
2626
, text
2727
, th-abstraction
28+
, these
2829
, time
2930
, time-compat
3031
, transformers

‎cabal.bench.project

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,3 +2,6 @@ with-compiler: ghc
22
packages: benchmarks/
33
packages: criterion-compare-txt/
44
tests: false
5+
6+
packages: https://oleg.fi/these-1.1.tar.gz
7+
packages: https://oleg.fi/quickcheck-instances-0.3.23.tar.gz

‎cabal.project

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,3 +3,6 @@ packages: .
33
packages: attoparsec-iso8601
44
packages: examples
55
tests: true
6+
7+
packages: https://oleg.fi/these-1.1.tar.gz
8+
packages: https://oleg.fi/quickcheck-instances-0.3.23.tar.gz

‎tests/PropertyRoundTrip.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ import Data.Proxy (Proxy)
1212
import Data.Ratio (Ratio)
1313
import Data.Sequence (Seq)
1414
import Data.Tagged (Tagged)
15+
import Data.These (These (..))
1516
import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
1617
import Data.Version (Version)
1718
import Data.Time.Calendar.Compat (CalendarDiffDays, DayOfWeek)
@@ -64,6 +65,7 @@ roundTripTests =
6465
, testProperty "Rational" $ roundTripEq (undefined :: Rational)
6566
, testProperty "Ratio Int" $ roundTripEq (undefined :: Ratio Int)
6667
, testProperty "UUID" $ roundTripEq UUID.nil
68+
, testProperty "These" $ roundTripEq (These 'x' True)
6769
, roundTripFunctorsTests
6870
, testGroup "ghcGenerics" [
6971
testProperty "OneConstructor" $ roundTripEq OneConstructor

‎tests/SerializationFormatSpec.hs

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ import Data.List.NonEmpty (NonEmpty(..))
2929
import Data.Proxy (Proxy(..))
3030
import Data.Scientific (Scientific)
3131
import Data.Tagged (Tagged(..))
32+
import Data.These (These (..))
3233
import Data.Time (fromGregorian)
3334
import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))
3435
import Data.Time.LocalTime.Compat (CalendarDiffTime (..))
@@ -208,6 +209,15 @@ jsonExamples =
208209
[ "{\"months\":12,\"days\":20}", "{\"days\":20,\"months\":12}" ]
209210
(CalendarDiffDays 12 20)
210211
, example "DayOfWeek" "\"monday\"" Monday
212+
213+
-- these
214+
, example "These: This" "{\"This\":\"x\"}" (This 'x' :: These Char Bool)
215+
, example "These: That" "{\"That\":true}" (That True :: These Char Bool)
216+
, ndExample "These"
217+
[ "{\"This\":\"y\",\"That\":false}"
218+
, "{\"That\":false,\"This\":\"y\"}"
219+
]
220+
(These 'y' False)
211221
]
212222

213223
jsonEncodingExamples :: [Example]

0 commit comments

Comments
 (0)