Skip to content

Commit e3d2ff9

Browse files
bergmarkbergmark
committed
Merge remote-tracking branch 'phadej/strict-data-dix'
2 parents fd3bc06 + e1ba32f commit e3d2ff9

File tree

9 files changed

+234
-7
lines changed

9 files changed

+234
-7
lines changed

‎.travis.yml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@
88
#
99
# For more information, see https://github.com/haskell-CI/haskell-ci
1010
#
11-
# version: 0.10.1
11+
# version: 0.10.2
1212
#
1313
version: ~> 1.0
1414
language: c
@@ -186,5 +186,5 @@ script:
186186
- cd $TOP || false
187187
- ${CABAL} v2-build $WITHCOMPILER --project-file=cabal.bench.project all
188188

189-
# REGENDATA ("0.10.1",["--config=cabal.haskell-ci","cabal.project"])
189+
# REGENDATA ("0.10.2",["--config=cabal.haskell-ci","cabal.project"])
190190
# EOF

‎Data/Aeson/Types/FromJSON.hs

Lines changed: 86 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -123,6 +123,10 @@ import qualified Data.Aeson.Parser.Time as Time
123123
import qualified Data.Attoparsec.ByteString.Char8 as A (endOfInput, parseOnly, scientific)
124124
import qualified Data.ByteString.Lazy as L
125125
import qualified Data.DList as DList
126+
#if MIN_VERSION_dlist(1,0,0) && __GLASGOW_HASKELL__ >=800
127+
import qualified Data.DList.DNonEmpty as DNE
128+
#endif
129+
import qualified Data.Fix as F
126130
import qualified Data.HashMap.Strict as H
127131
import qualified Data.HashSet as HashSet
128132
import qualified Data.IntMap as IntMap
@@ -133,6 +137,7 @@ import qualified Data.Scientific as Scientific
133137
import qualified Data.Semigroup as Semigroup
134138
import qualified Data.Sequence as Seq
135139
import qualified Data.Set as Set
140+
import qualified Data.Strict as S
136141
import qualified Data.Text as T
137142
import qualified Data.Text.Encoding as T
138143
import qualified Data.Text.Lazy as LT
@@ -1753,8 +1758,24 @@ instance (FromJSON a) => FromJSON (DList.DList a) where
17531758
parseJSON = parseJSON1
17541759
{-# INLINE parseJSON #-}
17551760

1761+
#if MIN_VERSION_dlist(1,0,0) && __GLASGOW_HASKELL__ >=800
1762+
-- | @since 1.5.3.0
1763+
instance FromJSON1 DNE.DNonEmpty where
1764+
liftParseJSON p _ = withArray "DNonEmpty" $
1765+
(>>= ne) . Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList
1766+
where
1767+
ne [] = fail "parsing DNonEmpty failed, unexpected empty list"
1768+
ne (x:xs) = pure (DNE.fromNonEmpty (x :| xs))
1769+
{-# INLINE liftParseJSON #-}
1770+
1771+
-- | @since 1.5.3.0
1772+
instance (FromJSON a) => FromJSON (DNE.DNonEmpty a) where
1773+
parseJSON = parseJSON1
1774+
{-# INLINE parseJSON #-}
1775+
#endif
1776+
17561777
-------------------------------------------------------------------------------
1757-
-- tranformers - Functors
1778+
-- transformers - Functors
17581779
-------------------------------------------------------------------------------
17591780

17601781
instance FromJSON1 Identity where
@@ -2213,6 +2234,70 @@ instance FromJSON a => FromJSON (Semigroup.Option a) where
22132234
parseJSON = parseJSON1
22142235
{-# INLINE parseJSON #-}
22152236

2237+
-------------------------------------------------------------------------------
2238+
-- data-fix
2239+
-------------------------------------------------------------------------------
2240+
2241+
-- | @since 1.5.3.0
2242+
instance FromJSON1 f => FromJSON (F.Fix f) where
2243+
parseJSON = go where go = fmap F.Fix . liftParseJSON go parseJSONList
2244+
2245+
-- | @since 1.5.3.0
2246+
instance (FromJSON1 f, Functor f) => FromJSON (F.Mu f) where
2247+
parseJSON = fmap (F.unfoldMu F.unFix) . parseJSON
2248+
2249+
-- | @since 1.5.3.0
2250+
instance (FromJSON1 f, Functor f) => FromJSON (F.Nu f) where
2251+
parseJSON = fmap (F.unfoldNu F.unFix) . parseJSON
2252+
2253+
-------------------------------------------------------------------------------
2254+
-- strict
2255+
-------------------------------------------------------------------------------
2256+
2257+
-- | @since 1.5.3.0
2258+
instance (FromJSON a, FromJSON b) => FromJSON (S.These a b) where
2259+
parseJSON = fmap S.toStrict . parseJSON
2260+
2261+
-- | @since 1.5.3.0
2262+
instance FromJSON2 S.These where
2263+
liftParseJSON2 pa pas pb pbs = fmap S.toStrict . liftParseJSON2 pa pas pb pbs
2264+
2265+
-- | @since 1.5.3.0
2266+
instance FromJSON a => FromJSON1 (S.These a) where
2267+
liftParseJSON pa pas = fmap S.toStrict . liftParseJSON pa pas
2268+
2269+
-- | @since 1.5.3.0
2270+
instance (FromJSON a, FromJSON b) => FromJSON (S.Pair a b) where
2271+
parseJSON = fmap S.toStrict . parseJSON
2272+
2273+
-- | @since 1.5.3.0
2274+
instance FromJSON2 S.Pair where
2275+
liftParseJSON2 pa pas pb pbs = fmap S.toStrict . liftParseJSON2 pa pas pb pbs
2276+
2277+
-- | @since 1.5.3.0
2278+
instance FromJSON a => FromJSON1 (S.Pair a) where
2279+
liftParseJSON pa pas = fmap S.toStrict . liftParseJSON pa pas
2280+
2281+
-- | @since 1.5.3.0
2282+
instance (FromJSON a, FromJSON b) => FromJSON (S.Either a b) where
2283+
parseJSON = fmap S.toStrict . parseJSON
2284+
2285+
-- | @since 1.5.3.0
2286+
instance FromJSON2 S.Either where
2287+
liftParseJSON2 pa pas pb pbs = fmap S.toStrict . liftParseJSON2 pa pas pb pbs
2288+
2289+
-- | @since 1.5.3.0
2290+
instance FromJSON a => FromJSON1 (S.Either a) where
2291+
liftParseJSON pa pas = fmap S.toStrict . liftParseJSON pa pas
2292+
2293+
-- | @since 1.5.3.0
2294+
instance FromJSON a => FromJSON (S.Maybe a) where
2295+
parseJSON = fmap S.toStrict . parseJSON
2296+
2297+
-- | @since 1.5.3.0
2298+
instance FromJSON1 S.Maybe where
2299+
liftParseJSON pa pas = fmap S.toStrict . liftParseJSON pa pas
2300+
22162301
-------------------------------------------------------------------------------
22172302
-- tagged
22182303
-------------------------------------------------------------------------------

‎Data/Aeson/Types/ToJSON.hs

Lines changed: 101 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -103,6 +103,10 @@ import qualified Data.Aeson.Encoding as E
103103
import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
104104
import qualified Data.ByteString.Lazy as L
105105
import qualified Data.DList as DList
106+
#if MIN_VERSION_dlist(1,0,0) && __GLASGOW_HASKELL__ >=800
107+
import qualified Data.DList.DNonEmpty as DNE
108+
#endif
109+
import qualified Data.Fix as F
106110
import qualified Data.HashMap.Strict as H
107111
import qualified Data.HashSet as HashSet
108112
import qualified Data.IntMap as IntMap
@@ -114,6 +118,7 @@ import qualified Data.Scientific as Scientific
114118
import qualified Data.Semigroup as Semigroup
115119
import qualified Data.Sequence as Seq
116120
import qualified Data.Set as Set
121+
import qualified Data.Strict as S
117122
import qualified Data.Text as T
118123
import qualified Data.Text.Encoding as T
119124
import qualified Data.Text.Lazy as LT
@@ -1612,6 +1617,24 @@ instance (ToJSON a) => ToJSON (DList.DList a) where
16121617
toEncoding = toEncoding1
16131618
{-# INLINE toEncoding #-}
16141619

1620+
#if MIN_VERSION_dlist(1,0,0) && __GLASGOW_HASKELL__ >=800
1621+
-- | @since 1.5.3.0
1622+
instance ToJSON1 DNE.DNonEmpty where
1623+
liftToJSON t _ = listValue t . DNE.toList
1624+
{-# INLINE liftToJSON #-}
1625+
1626+
liftToEncoding t _ = listEncoding t . DNE.toList
1627+
{-# INLINE liftToEncoding #-}
1628+
1629+
-- | @since 1.5.3.0
1630+
instance (ToJSON a) => ToJSON (DNE.DNonEmpty a) where
1631+
toJSON = toJSON1
1632+
{-# INLINE toJSON #-}
1633+
1634+
toEncoding = toEncoding1
1635+
{-# INLINE toEncoding #-}
1636+
#endif
1637+
16151638
-------------------------------------------------------------------------------
16161639
-- transformers - Functors
16171640
-------------------------------------------------------------------------------
@@ -2228,6 +2251,84 @@ instance ToJSON a => ToJSON (Semigroup.Option a) where
22282251
toEncoding = toEncoding1
22292252
{-# INLINE toEncoding #-}
22302253

2254+
-------------------------------------------------------------------------------
2255+
-- data-fix
2256+
-------------------------------------------------------------------------------
2257+
2258+
-- | @since 1.5.3.0
2259+
instance ToJSON1 f => ToJSON (F.Fix f) where
2260+
toJSON = go where go (F.Fix f) = liftToJSON go toJSONList f
2261+
toEncoding = go where go (F.Fix f) = liftToEncoding go toEncodingList f
2262+
2263+
-- | @since 1.5.3.0
2264+
instance (ToJSON1 f, Functor f) => ToJSON (F.Mu f) where
2265+
toJSON = F.foldMu (liftToJSON id (listValue id))
2266+
toEncoding = F.foldMu (liftToEncoding id (listEncoding id))
2267+
2268+
-- | @since 1.5.3.0
2269+
instance (ToJSON1 f, Functor f) => ToJSON (F.Nu f) where
2270+
toJSON = F.foldNu (liftToJSON id (listValue id))
2271+
toEncoding = F.foldNu (liftToEncoding id (listEncoding id))
2272+
2273+
-------------------------------------------------------------------------------
2274+
-- strict
2275+
-------------------------------------------------------------------------------
2276+
2277+
-- | @since 1.5.3.0
2278+
instance (ToJSON a, ToJSON b) => ToJSON (S.These a b) where
2279+
toJSON = toJSON . S.toLazy
2280+
toEncoding = toEncoding . S.toLazy
2281+
2282+
-- | @since 1.5.3.0
2283+
instance ToJSON2 S.These where
2284+
liftToJSON2 toa toas tob tobs = liftToJSON2 toa toas tob tobs . S.toLazy
2285+
liftToEncoding2 toa toas tob tobs = liftToEncoding2 toa toas tob tobs . S.toLazy
2286+
2287+
-- | @since 1.5.3.0
2288+
instance ToJSON a => ToJSON1 (S.These a) where
2289+
liftToJSON toa tos = liftToJSON toa tos . S.toLazy
2290+
liftToEncoding toa tos = liftToEncoding toa tos . S.toLazy
2291+
2292+
-- | @since 1.5.3.0
2293+
instance (ToJSON a, ToJSON b) => ToJSON (S.Pair a b) where
2294+
toJSON = toJSON . S.toLazy
2295+
toEncoding = toEncoding . S.toLazy
2296+
2297+
-- | @since 1.5.3.0
2298+
instance ToJSON2 S.Pair where
2299+
liftToJSON2 toa toas tob tobs = liftToJSON2 toa toas tob tobs . S.toLazy
2300+
liftToEncoding2 toa toas tob tobs = liftToEncoding2 toa toas tob tobs . S.toLazy
2301+
2302+
-- | @since 1.5.3.0
2303+
instance ToJSON a => ToJSON1 (S.Pair a) where
2304+
liftToJSON toa tos = liftToJSON toa tos . S.toLazy
2305+
liftToEncoding toa tos = liftToEncoding toa tos . S.toLazy
2306+
2307+
-- | @since 1.5.3.0
2308+
instance (ToJSON a, ToJSON b) => ToJSON (S.Either a b) where
2309+
toJSON = toJSON . S.toLazy
2310+
toEncoding = toEncoding . S.toLazy
2311+
2312+
-- | @since 1.5.3.0
2313+
instance ToJSON2 S.Either where
2314+
liftToJSON2 toa toas tob tobs = liftToJSON2 toa toas tob tobs . S.toLazy
2315+
liftToEncoding2 toa toas tob tobs = liftToEncoding2 toa toas tob tobs . S.toLazy
2316+
2317+
-- | @since 1.5.3.0
2318+
instance ToJSON a => ToJSON1 (S.Either a) where
2319+
liftToJSON toa tos = liftToJSON toa tos . S.toLazy
2320+
liftToEncoding toa tos = liftToEncoding toa tos . S.toLazy
2321+
2322+
-- | @since 1.5.3.0
2323+
instance ToJSON a => ToJSON (S.Maybe a) where
2324+
toJSON = toJSON . S.toLazy
2325+
toEncoding = toEncoding . S.toLazy
2326+
2327+
-- | @since 1.5.3.0
2328+
instance ToJSON1 S.Maybe where
2329+
liftToJSON toa tos = liftToJSON toa tos . S.toLazy
2330+
liftToEncoding toa tos = liftToEncoding toa tos . S.toLazy
2331+
22312332
-------------------------------------------------------------------------------
22322333
-- tagged
22332334
-------------------------------------------------------------------------------

‎aeson.cabal

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: aeson
2-
version: 1.5.2.0
2+
version: 1.5.3.0
33
license: BSD3
44
license-file: LICENSE
55
category: Text, Web, JSON
@@ -136,10 +136,12 @@ library
136136
-- Other dependencies
137137
build-depends:
138138
attoparsec >= 0.13.2.2 && < 0.14,
139+
data-fix >= 0.3 && < 0.4,
139140
dlist >= 0.8.0.4 && < 1.1,
140141
hashable >= 1.2.7.0 && < 1.4,
141142
primitive >= 0.7.0.1 && < 0.8,
142143
scientific >= 0.3.6.2 && < 0.4,
144+
strict >= 0.4 && < 0.5,
143145
tagged >= 0.8.6 && < 0.9,
144146
th-abstraction >= 0.2.8.0 && < 0.4,
145147
these >= 1.1 && < 1.2,
@@ -210,6 +212,7 @@ test-suite aeson-tests
210212
base-orphans >= 0.5.3 && <0.9,
211213
base16-bytestring,
212214
containers,
215+
data-fix,
213216
directory,
214217
dlist,
215218
Diff >= 0.4 && < 0.5,
@@ -218,6 +221,7 @@ test-suite aeson-tests
218221
ghc-prim >= 0.2,
219222
hashable >= 1.2.4.0,
220223
scientific,
224+
strict,
221225
tagged,
222226
template-haskell,
223227
tasty,
@@ -231,7 +235,7 @@ test-suite aeson-tests
231235
unordered-containers,
232236
uuid-types,
233237
vector,
234-
quickcheck-instances >= 0.3.23 && <0.4
238+
quickcheck-instances >= 0.3.24 && <0.4
235239

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

‎benchmarks/aeson-benchmarks.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ library
99
c-sources: ../cbits/unescape_string.c
1010
build-depends:
1111
attoparsec
12+
, data-fix
1213
, base
1314
, base-compat-batteries
1415
, bytestring >=0.10.4
@@ -21,6 +22,7 @@ library
2122
, primitive
2223
, scientific
2324
, syb
25+
, strict
2426
, tagged
2527
, template-haskell
2628
, text

‎cabal.bench.project

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,5 +3,5 @@ packages: benchmarks/
33
packages: criterion-compare-txt/
44
tests: false
55

6-
packages: https://oleg.fi/these-1.1.tar.gz
7-
packages: https://oleg.fi/quickcheck-instances-0.3.23.tar.gz
6+
packages: https://hackage.haskell.org/package/quickcheck-instances-0.3.24/candidate/quickcheck-instances-0.3.24.tar.gz
7+
packages: https://hackage.haskell.org/package/strict-0.4/candidate/strict-0.4.tar.gz

‎changelog.md

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,9 @@
11
For the latest version of this document, please see [https://github.com/bos/aeson/blob/master/changelog.md](https://github.com/bos/aeson/blob/master/changelog.md).
22

3+
### 1.5.3.0
4+
5+
* Add instances for types in `strict` and `data-fix` packages.
6+
37
### 1.5.2.0
48

59
* Add `Ord Value` instance, thanks to Oleg Grenrus.

‎tests/PropertyRoundTrip.hs

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,8 @@ import Types
2626
import qualified Data.Text as T
2727
import qualified Data.Text.Lazy as LT
2828
import qualified Data.UUID.Types as UUID
29+
import qualified Data.Strict as S
30+
import qualified Data.Fix as F
2931
import PropUtils
3032
import PropertyRTFunctors
3133

@@ -66,6 +68,13 @@ roundTripTests =
6668
, testProperty "Ratio Int" $ roundTripEq (undefined :: Ratio Int)
6769
, testProperty "UUID" $ roundTripEq UUID.nil
6870
, testProperty "These" $ roundTripEq (These 'x' True)
71+
, testProperty "Fix" $ roundTripEq (undefined :: F.Fix (These Char))
72+
, testProperty "Mu" $ roundTripEq (undefined :: F.Mu (These Char))
73+
, testProperty "Nu" $ roundTripEq (undefined :: F.Nu (These Char))
74+
, testProperty "Strict Pair" $ roundTripEq (undefined :: S.Pair Int Char)
75+
, testProperty "Strict Either" $ roundTripEq (undefined :: S.Either Int Char)
76+
, testProperty "Strict These" $ roundTripEq (undefined :: S.These Int Char)
77+
, testProperty "Strict Maybe" $ roundTripEq (undefined :: S.Maybe Int)
6978
, roundTripFunctorsTests
7079
, testGroup "ghcGenerics" [
7180
testProperty "OneConstructor" $ roundTripEq OneConstructor

‎tests/SerializationFormatSpec.hs

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -54,6 +54,8 @@ import qualified Data.Set as Set
5454
import qualified Data.Tree as Tree
5555
import qualified Data.UUID.Types as UUID
5656
import qualified Data.Vector as Vector
57+
import qualified Data.Fix as F
58+
import qualified Data.Strict as S
5759

5860
tests :: [TestTree]
5961
tests =
@@ -218,6 +220,26 @@ jsonExamples =
218220
, "{\"That\":false,\"This\":\"y\"}"
219221
]
220222
(These 'y' False)
223+
224+
-- data-fix and strict
225+
, ndExample "Fix Strict.These"
226+
[ "{\"This\":true,\"That\":{\"That\":{\"This\":false}}}"
227+
, "{\"That\":{\"That\":{\"This\":false}},\"This\":true}"
228+
]
229+
(F.Fix (S.These True (F.Fix (S.That (F.Fix (S.This False))))))
230+
231+
-- Mu and Nu are similar.
232+
, ndExample "Mu Strict.These"
233+
[ "{\"This\":true,\"That\":{\"That\":{\"This\":false}}}"
234+
, "{\"That\":{\"That\":{\"This\":false}},\"This\":true}"
235+
]
236+
$ F.unfoldMu F.unFix $ F.Fix (S.These True (F.Fix (S.That (F.Fix (S.This False)))))
237+
238+
, ndExample "Nu Strict.These"
239+
[ "{\"This\":true,\"That\":{\"That\":{\"This\":false}}}"
240+
, "{\"That\":{\"That\":{\"This\":false}},\"This\":true}"
241+
]
242+
$ F.unfoldNu F.unFix $ F.Fix (S.These True (F.Fix (S.That (F.Fix (S.This False)))))
221243
]
222244

223245
jsonEncodingExamples :: [Example]

0 commit comments

Comments
 (0)