Add data-fix and strict instances

ethercrow · Jul 23, 2020 · c6498c9 · c6498c9
1 parent 5e1d23a
commit c6498c9
Show file tree

Hide file tree

Showing 8 changed files with 202 additions and 4 deletions.
diff --git a/.travis.yml b/.travis.yml
@@ -8,7 +8,7 @@
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
-# version: 0.10.1
+# version: 0.10.2
 #
 version: ~> 1.0
 language: c
@@ -120,6 +120,11 @@ install:
   - if [ $HCNUMVER -ge 80200 ] ; then echo 'package aeson-examples' >> cabal.project ; fi
   - "if [ $HCNUMVER -ge 80200 ] ; then echo '  ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
   - |
+    echo "packages:"                                                                                                      >> cabal.project
+    echo "  https://hackage.haskell.org/package/quickcheck-instances-0.3.24/candidate/quickcheck-instances-0.3.24.tar.gz" >> cabal.project
+    echo ""                                                                                                               >> cabal.project
+    echo "packages:"                                                                                                      >> cabal.project
+    echo "  https://hackage.haskell.org/package/strict-0.4/candidate/strict-0.4.tar.gz"                                   >> cabal.project
   - "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"
   - cat cabal.project || true
   - cat cabal.project.local || true
@@ -157,6 +162,11 @@ script:
   - if [ $HCNUMVER -ge 80200 ] ; then echo 'package aeson-examples' >> cabal.project ; fi
   - "if [ $HCNUMVER -ge 80200 ] ; then echo '  ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
   - |
+    echo "packages:"                                                                                                      >> cabal.project
+    echo "  https://hackage.haskell.org/package/quickcheck-instances-0.3.24/candidate/quickcheck-instances-0.3.24.tar.gz" >> cabal.project
+    echo ""                                                                                                               >> cabal.project
+    echo "packages:"                                                                                                      >> cabal.project
+    echo "  https://hackage.haskell.org/package/strict-0.4/candidate/strict-0.4.tar.gz"                                   >> cabal.project
   - "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"
   - cat cabal.project || true
   - cat cabal.project.local || true
@@ -186,5 +196,5 @@ script:
   - cd $TOP || false
   - ${CABAL} v2-build $WITHCOMPILER --project-file=cabal.bench.project all
 
-# REGENDATA ("0.10.1",["--config=cabal.haskell-ci","cabal.project"])
+# REGENDATA ("0.10.2",["--config=cabal.haskell-ci","cabal.project"])
 # EOF
diff --git a/Data/Aeson/Types/FromJSON.hs b/Data/Aeson/Types/FromJSON.hs
@@ -123,6 +123,7 @@ import qualified Data.Aeson.Parser.Time as Time
 import qualified Data.Attoparsec.ByteString.Char8 as A (endOfInput, parseOnly, scientific)
 import qualified Data.ByteString.Lazy as L
 import qualified Data.DList as DList
+import qualified Data.Fix as F
 import qualified Data.HashMap.Strict as H
 import qualified Data.HashSet as HashSet
 import qualified Data.IntMap as IntMap
@@ -133,6 +134,7 @@ import qualified Data.Scientific as Scientific
 import qualified Data.Semigroup as Semigroup
 import qualified Data.Sequence as Seq
 import qualified Data.Set as Set
+import qualified Data.Strict as S
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.Lazy as LT
@@ -2213,6 +2215,70 @@ instance FromJSON a => FromJSON (Semigroup.Option a) where
     parseJSON = parseJSON1
     {-# INLINE parseJSON #-}
 
+-------------------------------------------------------------------------------
+-- data-fix
+-------------------------------------------------------------------------------
+
+-- | @since 1.5.3.0
+instance FromJSON1 f => FromJSON (F.Fix f) where
+    parseJSON = go where go = fmap F.Fix . liftParseJSON go parseJSONList
+
+-- | @since 1.5.3.0
+instance (FromJSON1 f, Functor f) => FromJSON (F.Mu f) where
+    parseJSON = fmap (F.unfoldMu F.unFix) . parseJSON
+
+-- | @since 1.5.3.0
+instance (FromJSON1 f, Functor f) => FromJSON (F.Nu f) where
+    parseJSON = fmap (F.unfoldNu F.unFix) . parseJSON
+
+-------------------------------------------------------------------------------
+-- strict
+-------------------------------------------------------------------------------
+
+-- | @since 1.5.3.0
+instance (FromJSON a, FromJSON b) => FromJSON (S.These a b) where
+    parseJSON = fmap S.toStrict . parseJSON
+
+-- | @since 1.5.3.0
+instance FromJSON2 S.These where
+    liftParseJSON2 pa pas pb pbs = fmap S.toStrict . liftParseJSON2 pa pas pb pbs
+
+-- | @since 1.5.3.0
+instance FromJSON a => FromJSON1 (S.These a) where
+    liftParseJSON pa pas = fmap S.toStrict . liftParseJSON pa pas
+
+-- | @since 1.5.3.0
+instance (FromJSON a, FromJSON b) => FromJSON (S.Pair a b) where
+    parseJSON = fmap S.toStrict . parseJSON
+
+-- | @since 1.5.3.0
+instance FromJSON2 S.Pair where
+    liftParseJSON2 pa pas pb pbs = fmap S.toStrict . liftParseJSON2 pa pas pb pbs
+
+-- | @since 1.5.3.0
+instance FromJSON a => FromJSON1 (S.Pair a) where
+    liftParseJSON pa pas = fmap S.toStrict . liftParseJSON pa pas
+
+-- | @since 1.5.3.0
+instance (FromJSON a, FromJSON b) => FromJSON (S.Either a b) where
+    parseJSON = fmap S.toStrict . parseJSON
+
+-- | @since 1.5.3.0
+instance FromJSON2 S.Either where
+    liftParseJSON2 pa pas pb pbs = fmap S.toStrict . liftParseJSON2 pa pas pb pbs
+
+-- | @since 1.5.3.0
+instance FromJSON a => FromJSON1 (S.Either a) where
+    liftParseJSON pa pas = fmap S.toStrict . liftParseJSON pa pas
+
+-- | @since 1.5.3.0
+instance FromJSON a => FromJSON (S.Maybe a) where
+    parseJSON = fmap S.toStrict . parseJSON
+
+-- | @since 1.5.3.0
+instance FromJSON1 S.Maybe where
+    liftParseJSON pa pas = fmap S.toStrict . liftParseJSON pa pas
+
 -------------------------------------------------------------------------------
 -- tagged
 -------------------------------------------------------------------------------

diff --git a/Data/Aeson/Types/ToJSON.hs b/Data/Aeson/Types/ToJSON.hs
@@ -103,6 +103,7 @@ import qualified Data.Aeson.Encoding as E
 import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
 import qualified Data.ByteString.Lazy as L
 import qualified Data.DList as DList
+import qualified Data.Fix as F
 import qualified Data.HashMap.Strict as H
 import qualified Data.HashSet as HashSet
 import qualified Data.IntMap as IntMap
@@ -114,6 +115,7 @@ import qualified Data.Scientific as Scientific
 import qualified Data.Semigroup as Semigroup
 import qualified Data.Sequence as Seq
 import qualified Data.Set as Set
+import qualified Data.Strict as S
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.Lazy as LT
@@ -2228,6 +2230,84 @@ instance ToJSON a => ToJSON (Semigroup.Option a) where
     toEncoding = toEncoding1
     {-# INLINE toEncoding #-}
 
+-------------------------------------------------------------------------------
+-- data-fix
+-------------------------------------------------------------------------------
+
+-- | @since 1.5.3.0
+instance ToJSON1 f => ToJSON (F.Fix f) where
+    toJSON     = go where go (F.Fix f) = liftToJSON go toJSONList f
+    toEncoding = go where go (F.Fix f) = liftToEncoding go toEncodingList f
+
+-- | @since 1.5.3.0
+instance (ToJSON1 f, Functor f) => ToJSON (F.Mu f) where
+    toJSON     = F.foldMu (liftToJSON id (listValue id))
+    toEncoding = F.foldMu (liftToEncoding id (listEncoding id))
+
+-- | @since 1.5.3.0
+instance (ToJSON1 f, Functor f) => ToJSON (F.Nu f) where
+    toJSON     = F.foldNu (liftToJSON id (listValue id))
+    toEncoding = F.foldNu (liftToEncoding id (listEncoding id))
+
+-------------------------------------------------------------------------------
+-- strict
+-------------------------------------------------------------------------------
+
+-- | @since 1.5.3.0
+instance (ToJSON a, ToJSON b) => ToJSON (S.These a b) where
+    toJSON = toJSON . S.toLazy
+    toEncoding = toEncoding . S.toLazy
+
+-- | @since 1.5.3.0
+instance ToJSON2 S.These where
+    liftToJSON2 toa toas tob tobs = liftToJSON2 toa toas tob tobs . S.toLazy
+    liftToEncoding2 toa toas tob tobs = liftToEncoding2 toa toas tob tobs . S.toLazy
+
+-- | @since 1.5.3.0
+instance ToJSON a => ToJSON1 (S.These a) where
+    liftToJSON toa tos = liftToJSON toa tos . S.toLazy
+    liftToEncoding toa tos = liftToEncoding toa tos . S.toLazy
+
+-- | @since 1.5.3.0
+instance (ToJSON a, ToJSON b) => ToJSON (S.Pair a b) where
+    toJSON = toJSON . S.toLazy
+    toEncoding = toEncoding . S.toLazy
+
+-- | @since 1.5.3.0
+instance ToJSON2 S.Pair where
+    liftToJSON2 toa toas tob tobs = liftToJSON2 toa toas tob tobs . S.toLazy
+    liftToEncoding2 toa toas tob tobs = liftToEncoding2 toa toas tob tobs . S.toLazy
+
+-- | @since 1.5.3.0
+instance ToJSON a => ToJSON1 (S.Pair a) where
+    liftToJSON toa tos = liftToJSON toa tos . S.toLazy
+    liftToEncoding toa tos = liftToEncoding toa tos . S.toLazy
+
+-- | @since 1.5.3.0
+instance (ToJSON a, ToJSON b) => ToJSON (S.Either a b) where
+    toJSON = toJSON . S.toLazy
+    toEncoding = toEncoding . S.toLazy
+
+-- | @since 1.5.3.0
+instance ToJSON2 S.Either where
+    liftToJSON2 toa toas tob tobs = liftToJSON2 toa toas tob tobs . S.toLazy
+    liftToEncoding2 toa toas tob tobs = liftToEncoding2 toa toas tob tobs . S.toLazy
+
+-- | @since 1.5.3.0
+instance ToJSON a => ToJSON1 (S.Either a) where
+    liftToJSON toa tos = liftToJSON toa tos . S.toLazy
+    liftToEncoding toa tos = liftToEncoding toa tos . S.toLazy
+
+-- | @since 1.5.3.0
+instance ToJSON a => ToJSON (S.Maybe a) where
+    toJSON = toJSON . S.toLazy
+    toEncoding = toEncoding . S.toLazy
+
+-- | @since 1.5.3.0
+instance ToJSON1 S.Maybe where
+    liftToJSON toa tos = liftToJSON toa tos . S.toLazy
+    liftToEncoding toa tos = liftToEncoding toa tos . S.toLazy
+
 -------------------------------------------------------------------------------
 -- tagged
 -------------------------------------------------------------------------------

diff --git a/aeson.cabal b/aeson.cabal
@@ -1,5 +1,5 @@
 name:            aeson
-version:         1.5.2.0
+version:         1.5.3.0
 license:         BSD3
 license-file:    LICENSE
 category:        Text, Web, JSON
@@ -136,10 +136,12 @@ library
   -- Other dependencies
   build-depends:
     attoparsec           >= 0.13.2.2 && < 0.14,
+    data-fix             >= 0.3      && < 0.4,
     dlist                >= 0.8.0.4  && < 0.9,
     hashable             >= 1.2.7.0  && < 1.4,
     primitive            >= 0.7.0.1  && < 0.8,
     scientific           >= 0.3.6.2  && < 0.4,
+    strict               >= 0.4      && < 0.5,
     tagged               >= 0.8.6    && < 0.9,
     th-abstraction       >= 0.2.8.0  && < 0.4,
     these                >= 1.1      && < 1.2,
@@ -210,6 +212,7 @@ test-suite aeson-tests
     base-orphans >= 0.5.3 && <0.9,
     base16-bytestring,
     containers,
+    data-fix,
     directory,
     dlist,
     Diff >= 0.4 && < 0.5,
@@ -218,6 +221,7 @@ test-suite aeson-tests
     ghc-prim >= 0.2,
     hashable >= 1.2.4.0,
     scientific,
+    strict,
     tagged,
     template-haskell,
     tasty,
@@ -231,7 +235,7 @@ test-suite aeson-tests
     unordered-containers,
     uuid-types,
     vector,
-    quickcheck-instances >= 0.3.23 && <0.4
+    quickcheck-instances >= 0.3.24 && <0.4
 
   if flag(bytestring-builder)
     build-depends: bytestring >= 0.9 && < 0.10.4,

diff --git a/cabal.project b/cabal.project
@@ -3,3 +3,6 @@ packages: .
 packages: attoparsec-iso8601
 packages: examples
 tests: true
+
+packages: https://hackage.haskell.org/package/quickcheck-instances-0.3.24/candidate/quickcheck-instances-0.3.24.tar.gz
+packages: https://hackage.haskell.org/package/strict-0.4/candidate/strict-0.4.tar.gz
diff --git a/changelog.md b/changelog.md
@@ -1,5 +1,9 @@
 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).
 
+### 1.5.3.0
+
+* Add instances for types in `strict` and `data-fix` packages.
+
 ### 1.5.2.0
 
 * Add `Ord Value` instance, thanks to Oleg Grenrus.

diff --git a/tests/PropertyRoundTrip.hs b/tests/PropertyRoundTrip.hs
@@ -26,6 +26,8 @@ import Types
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as LT
 import qualified Data.UUID.Types as UUID
+import qualified Data.Strict as S
+import qualified Data.Fix as F
 import PropUtils
 import PropertyRTFunctors
 
@@ -66,6 +68,13 @@ roundTripTests =
     , testProperty "Ratio Int" $ roundTripEq (undefined :: Ratio Int)
     , testProperty "UUID" $ roundTripEq UUID.nil
     , testProperty "These" $ roundTripEq (These 'x' True)
+    , testProperty "Fix" $ roundTripEq (undefined :: F.Fix (These Char))
+    , testProperty "Mu" $ roundTripEq (undefined :: F.Mu (These Char))
+    , testProperty "Nu" $ roundTripEq (undefined :: F.Nu (These Char))
+    , testProperty "Strict Pair" $ roundTripEq (undefined :: S.Pair Int Char)
+    , testProperty "Strict Either" $ roundTripEq (undefined :: S.Either Int Char)
+    , testProperty "Strict These" $ roundTripEq (undefined :: S.These Int Char)
+    , testProperty "Strict Maybe" $ roundTripEq (undefined :: S.Maybe Int)
     , roundTripFunctorsTests
     , testGroup "ghcGenerics" [
         testProperty "OneConstructor" $ roundTripEq OneConstructor

diff --git a/tests/SerializationFormatSpec.hs b/tests/SerializationFormatSpec.hs
@@ -54,6 +54,8 @@ import qualified Data.Set as Set
 import qualified Data.Tree as Tree
 import qualified Data.UUID.Types as UUID
 import qualified Data.Vector as Vector
+import qualified Data.Fix as F
+import qualified Data.Strict as S
 
 tests :: [TestTree]
 tests =
@@ -218,6 +220,26 @@ jsonExamples =
     , "{\"That\":false,\"This\":\"y\"}"
     ]
     (These 'y' False)
+
+  -- data-fix and strict
+  , ndExample "Fix Strict.These"
+    [ "{\"This\":true,\"That\":{\"That\":{\"This\":false}}}"
+    , "{\"That\":{\"That\":{\"This\":false}},\"This\":true}"
+    ]
+    (F.Fix (S.These True (F.Fix (S.That (F.Fix (S.This False))))))
+
+  -- Mu and Nu are similar.
+  , ndExample "Mu Strict.These"
+    [ "{\"This\":true,\"That\":{\"That\":{\"This\":false}}}"
+    , "{\"That\":{\"That\":{\"This\":false}},\"This\":true}"
+    ]
+    $ F.unfoldMu F.unFix $ F.Fix (S.These True (F.Fix (S.That (F.Fix (S.This False)))))
+
+  , ndExample "Nu Strict.These"
+    [ "{\"This\":true,\"That\":{\"That\":{\"This\":false}}}"
+    , "{\"That\":{\"That\":{\"This\":false}},\"This\":true}"
+    ]
+    $ F.unfoldNu F.unFix $ F.Fix (S.These True (F.Fix (S.That (F.Fix (S.This False)))))
   ]
 
 jsonEncodingExamples :: [Example]