exinst-aeson 0.2 → 0.7

raw patch · 7 files changed

+412/−191 lines, 7 filesdep +QuickCheckdep +bytestringdep +exinst-aesondep ~aesondep ~basedep ~constraintsPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, bytestring, exinst-aeson, tasty, tasty-quickcheck

Dependency ranges changed: aeson, base, constraints, exinst, singletons

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−19
• LICENSE.txt +1/−1
• README.md +6/−2
• exinst-aeson.cabal +28/−11
• lib/Exinst/Aeson.hs +186/−0
• src/lib/Exinst/Instances/Aeson.hs +0/−158
• tests/Main.hs +188/−0

@@ -1,20 +1,4 @@-# Version 0.2--* Depend on `singletons-2.2`, which means `KProxy` is gone.---# Version 0.1.0.2--* Relax upper bound on `aeson`, `base`, `singletons`, `constraints`.---# Version 0.1.0.1--* Relax upper bound on `singletons` dependency.--* Relax upper bound on `aeson` dependency.---# Version 0.1+# Version 0.7 -* Initial release.+* This library exports the `ToJSON` and `FromJSON` instances previously+  exported from `exinst-0.6`.

@@ -1,4 +1,4 @@-Copyright (c) 2015-2016, Renzo Carbonara+Copyright (c) 2015-2018, Renzo Carbonara  All rights reserved. 

@@ -1,2 +1,6 @@-See the README file in the @exinst@ package for more general documentation:-https://hackage.haskell.org/package/exinst#readme+# exinst-aeson++See the [BSD3 LICENSE](https://github.com/k0001/exinst/blob/master/exinst/exinst-aeson/LICENSE.txt)+file to learn about the legal terms and conditions for this library.++

@@ -1,28 +1,45 @@ name:                exinst-aeson-version:             0.2+version:             0.7 author:              Renzo Carbonara-maintainer:          renzoλcarbonara.com.ar-copyright:           Renzo Carbonara 2015-2016+maintainer:          renλren!zone+copyright:           Renzo Carbonara 2015-2018 license:             BSD3 license-file:        LICENSE.txt extra-source-files:  README.md CHANGELOG.md category:            Data build-type:          Simple cabal-version:       >=1.18-synopsis:            Derive instances for the `aeson` library for your existential types.+synopsis:            Dependent pairs and their instances. homepage:            https://github.com/k0001/exinst bug-reports:         https://github.com/k0001/exinst/issues + library-  hs-source-dirs: src/lib+  hs-source-dirs: lib   default-language: Haskell2010-  exposed-modules:-      Exinst.Instances.Aeson+  exposed-modules: Exinst.Aeson   build-depends:-      aeson >=0.8 && <1.1+      aeson     , base >=4.9 && <5.0-    , constraints >=0.4 && <0.9-    , exinst >=0.2 && <0.3-    , singletons >=2.2 && <2.3+    , constraints+    , exinst >= 0.7+    , singletons   ghcjs-options: -Wall -O3   ghc-options: -Wall -O2++test-suite tests+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  hs-source-dirs: tests+  main-is: Main.hs+  build-depends:+     aeson+   , base+   , bytestring+   , exinst+   , exinst-aeson+   , QuickCheck+   , tasty+   , tasty-quickcheck+  ghcjs-options: -Wall -O0+  ghc-options: -Wall -O0

@@ -0,0 +1,186 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | This module exports 'Ae.FromJSON' and 'Ae.ToJSON' instances for 'Some1',+-- 'Some2', 'Some3' and 'Some4' from "Exinst", provided situable+-- 'Dict1', 'Dict2', 'Dict3' and 'Dict4' instances are available.+--+-- See the README file in the @exinst@ package for more general documentation:+-- https://hackage.haskell.org/package/exinst#readme+module Exinst.Aeson () where++import qualified Data.Aeson as Ae+import Data.Constraint+import Data.Kind (Type)+import Data.Singletons+import Exinst+import Prelude++--------------------------------------------------------------------------------++instance forall (f :: k1 -> Type)+  . ( SingKind k1+    , Ae.ToJSON (Demote k1)+    , Dict1 Ae.ToJSON f+    ) => Ae.ToJSON (Some1 f)+  where+    {-# INLINABLE toJSON #-}+    toJSON = \some1x -> withSome1Sing some1x $ \sa1 (x :: f a1) ->+       case dict1 sa1 :: Dict (Ae.ToJSON (f a1)) of+          Dict -> Ae.toJSON (fromSing sa1, x)++instance forall (f :: k2 -> k1 -> Type)+  . ( SingKind k2+    , SingKind k1+    , Ae.ToJSON (Demote k2)+    , Ae.ToJSON (Demote k1)+    , Dict2 Ae.ToJSON f+    ) => Ae.ToJSON (Some2 f)+  where+    {-# INLINABLE toJSON #-}+    toJSON = \some2x -> withSome2Sing some2x $ \sa2 sa1 (x :: f a2 a1) ->+       case dict2 sa2 sa1 :: Dict (Ae.ToJSON (f a2 a1)) of+          Dict -> Ae.toJSON ((fromSing sa2, fromSing sa1), x)++instance forall (f :: k3 -> k2 -> k1 -> Type)+  . ( SingKind k3+    , SingKind k2+    , SingKind k1+    , Ae.ToJSON (Demote k3)+    , Ae.ToJSON (Demote k2)+    , Ae.ToJSON (Demote k1)+    , Dict3 Ae.ToJSON f+    ) => Ae.ToJSON (Some3 f)+  where+    {-# INLINABLE toJSON #-}+    toJSON = \some3x -> withSome3Sing some3x $ \sa3 sa2 sa1 (x :: f a3 a2 a1) ->+       case dict3 sa3 sa2 sa1 :: Dict (Ae.ToJSON (f a3 a2 a1)) of+          Dict -> Ae.toJSON ((fromSing sa3, fromSing sa2, fromSing sa1), x)++instance forall (f :: k4 -> k3 -> k2 -> k1 -> Type)+  . ( SingKind k4+    , SingKind k3+    , SingKind k2+    , SingKind k1+    , Ae.ToJSON (Demote k4)+    , Ae.ToJSON (Demote k3)+    , Ae.ToJSON (Demote k2)+    , Ae.ToJSON (Demote k1)+    , Dict4 Ae.ToJSON f+    ) => Ae.ToJSON (Some4 f)+  where+    {-# INLINABLE toJSON #-}+    toJSON = \some4x -> withSome4Sing some4x $ \sa4 sa3 sa2 sa1 (x :: f a4 a3 a2 a1) ->+       case dict4 sa4 sa3 sa2 sa1 :: Dict (Ae.ToJSON (f a4 a3 a2 a1)) of+          Dict -> Ae.toJSON ((fromSing sa4, fromSing sa3, fromSing sa2, fromSing sa1), x)++--------------------------------------------------------------------------------++instance forall (f :: k1 -> Type)+  . ( SingKind k1+    , Ae.FromJSON (Demote k1)+    , Dict1 Ae.FromJSON f+    ) => Ae.FromJSON (Some1 f)+  where+    {-# INLINABLE parseJSON #-}+    parseJSON = \v -> do+      (rsa1, v') <- Ae.parseJSON v+      withSomeSing rsa1 $ \(sa1 :: Sing (a1 :: k1)) ->+         case dict1 sa1 :: Dict (Ae.FromJSON (f a1)) of+            Dict -> do+               x :: f a1 <- Ae.parseJSON v'+               pure (Some1 sa1 x)++instance forall (f :: k2 -> k1 -> Type)+  . ( SingKind k2+    , SingKind k1+    , Ae.FromJSON (Demote k2)+    , Ae.FromJSON (Demote k1)+    , Dict2 Ae.FromJSON f+    ) => Ae.FromJSON (Some2 f)+  where+    {-# INLINABLE parseJSON #-}+    parseJSON = \v -> do+      ((rsa2, rsa1), v') <- Ae.parseJSON v+      withSomeSing rsa2 $ \(sa2 :: Sing (a2 :: k2)) ->+         withSomeSing rsa1 $ \(sa1 :: Sing (a1 :: k1)) ->+            case dict2 sa2 sa1 :: Dict (Ae.FromJSON (f a2 a1)) of+               Dict -> do+                  x :: f a2 a1 <- Ae.parseJSON v'+                  pure (Some2 sa2 sa1 x)++instance forall (f :: k3 -> k2 -> k1 -> Type)+  . ( SingKind k3+    , SingKind k2+    , SingKind k1+    , Ae.FromJSON (Demote k3)+    , Ae.FromJSON (Demote k2)+    , Ae.FromJSON (Demote k1)+    , Dict3 Ae.FromJSON f+    ) => Ae.FromJSON (Some3 f)+  where+    {-# INLINABLE parseJSON #-}+    parseJSON = \v -> do+      ((rsa3, rsa2, rsa1), v') <- Ae.parseJSON v+      withSomeSing rsa3 $ \(sa3 :: Sing (a3 :: k3)) ->+         withSomeSing rsa2 $ \(sa2 :: Sing (a2 :: k2)) ->+            withSomeSing rsa1 $ \(sa1 :: Sing (a1 :: k1)) ->+               case dict3 sa3 sa2 sa1 :: Dict (Ae.FromJSON (f a3 a2 a1)) of+                  Dict -> do+                     x :: f a3 a2 a1 <- Ae.parseJSON v'+                     pure (Some3 sa3 sa2 sa1 x)++instance forall (f :: k4 -> k3 -> k2 -> k1 -> Type)+  . ( SingKind k4+    , SingKind k3+    , SingKind k2+    , SingKind k1+    , Ae.FromJSON (Demote k4)+    , Ae.FromJSON (Demote k3)+    , Ae.FromJSON (Demote k2)+    , Ae.FromJSON (Demote k1)+    , Dict4 Ae.FromJSON f+    ) => Ae.FromJSON (Some4 f)+  where+    {-# INLINABLE parseJSON #-}+    parseJSON = \v -> do+      ((rsa4, rsa3, rsa2, rsa1), v') <- Ae.parseJSON v+      withSomeSing rsa4 $ \(sa4 :: Sing (a4 :: k4)) ->+         withSomeSing rsa3 $ \(sa3 :: Sing (a3 :: k3)) ->+            withSomeSing rsa2 $ \(sa2 :: Sing (a2 :: k2)) ->+               withSomeSing rsa1 $ \(sa1 :: Sing (a1 :: k1)) ->+                  case dict4 sa4 sa3 sa2 sa1 :: Dict (Ae.FromJSON (f a4 a3 a2 a1)) of+                     Dict -> do+                        x :: f a4 a3 a2 a1 <- Ae.parseJSON v'+                        pure (Some4 sa4 sa3 sa2 sa1 x)++--------------------------------------------------------------------------------++instance (Ae.FromJSON (l a1), Ae.FromJSON (r a1)) => Ae.FromJSON (S1 l r a1)+instance (Ae.FromJSON (l a2 a1), Ae.FromJSON (r a2 a1)) => Ae.FromJSON (S2 l r a2 a1)+instance (Ae.FromJSON (l a3 a2 a1), Ae.FromJSON (r a3 a2 a1)) => Ae.FromJSON (S3 l r a3 a2 a1)+instance (Ae.FromJSON (l a4 a3 a2 a1), Ae.FromJSON (r a4 a3 a2 a1)) => Ae.FromJSON (S4 l r a4 a3 a2 a1)++instance (Ae.ToJSON (l a1), Ae.ToJSON (r a1)) => Ae.ToJSON (S1 l r a1)+instance (Ae.ToJSON (l a2 a1), Ae.ToJSON (r a2 a1)) => Ae.ToJSON (S2 l r a2 a1)+instance (Ae.ToJSON (l a3 a2 a1), Ae.ToJSON (r a3 a2 a1)) => Ae.ToJSON (S3 l r a3 a2 a1)+instance (Ae.ToJSON (l a4 a3 a2 a1), Ae.ToJSON (r a4 a3 a2 a1)) => Ae.ToJSON (S4 l r a4 a3 a2 a1)++--------------------------------------------------------------------------------++instance (Ae.FromJSON (l a1), Ae.FromJSON (r a1)) => Ae.FromJSON (P1 l r a1)+instance (Ae.FromJSON (l a2 a1), Ae.FromJSON (r a2 a1)) => Ae.FromJSON (P2 l r a2 a1)+instance (Ae.FromJSON (l a3 a2 a1), Ae.FromJSON (r a3 a2 a1)) => Ae.FromJSON (P3 l r a3 a2 a1)+instance (Ae.FromJSON (l a4 a3 a2 a1), Ae.FromJSON (r a4 a3 a2 a1)) => Ae.FromJSON (P4 l r a4 a3 a2 a1)++instance (Ae.ToJSON (l a1), Ae.ToJSON (r a1)) => Ae.ToJSON (P1 l r a1)+instance (Ae.ToJSON (l a2 a1), Ae.ToJSON (r a2 a1)) => Ae.ToJSON (P2 l r a2 a1)+instance (Ae.ToJSON (l a3 a2 a1), Ae.ToJSON (r a3 a2 a1)) => Ae.ToJSON (P3 l r a3 a2 a1)+instance (Ae.ToJSON (l a4 a3 a2 a1), Ae.ToJSON (r a4 a3 a2 a1)) => Ae.ToJSON (P4 l r a4 a3 a2 a1)++

@@ -1,158 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UndecidableInstances #-}--{-# OPTIONS_GHC -fno-warn-orphans #-}---- | This module exports 'Ae.FromJSON' and 'Ae.ToJSON' instances for 'Some1',--- 'Some2', 'Some3' and 'Some4' from "Exinst.Singletons", provided situable--- 'Dict1', 'Dict2', 'Dict3' and 'Dict4' instances are available.------ See the README file in the @exinst@ package for more general documentation:--- https://hackage.haskell.org/package/exinst#readme-module Exinst.Instances.Aeson () where--import qualified Data.Aeson as Ae-import           Data.Constraint-import           Data.Singletons-import           Exinst.Singletons-import           Prelude------------------------------------------------------------------------------------instance forall (f1 :: k1 -> *)-  . ( SingKind k1-    , Ae.ToJSON (DemoteRep k1)-    , Dict1 Ae.ToJSON f1-    ) => Ae.ToJSON (Some1 f1)-  where-    {-# INLINABLE toJSON #-}-    toJSON = \some1x -> withSome1Sing some1x $ \sa1 (x :: f1 a1) ->-       case dict1 sa1 :: Dict (Ae.ToJSON (f1 a1)) of-          Dict -> Ae.toJSON (fromSing sa1, x)--instance forall (f2 :: k2 -> k1 -> *)-  . ( SingKind k2-    , SingKind k1-    , Ae.ToJSON (DemoteRep k2)-    , Ae.ToJSON (DemoteRep k1)-    , Dict2 Ae.ToJSON f2-    ) => Ae.ToJSON (Some2 f2)-  where-    {-# INLINABLE toJSON #-}-    toJSON = \some2x -> withSome2Sing some2x $ \sa2 sa1 (x :: f2 a2 a1) ->-       case dict2 sa2 sa1 :: Dict (Ae.ToJSON (f2 a2 a1)) of-          Dict -> Ae.toJSON ((fromSing sa2, fromSing sa1), x)--instance forall (f3 :: k3 -> k2 -> k1 -> *)-  . ( SingKind k3-    , SingKind k2-    , SingKind k1-    , Ae.ToJSON (DemoteRep k3)-    , Ae.ToJSON (DemoteRep k2)-    , Ae.ToJSON (DemoteRep k1)-    , Dict3 Ae.ToJSON f3-    ) => Ae.ToJSON (Some3 f3)-  where-    {-# INLINABLE toJSON #-}-    toJSON = \some3x -> withSome3Sing some3x $ \sa3 sa2 sa1 (x :: f3 a3 a2 a1) ->-       case dict3 sa3 sa2 sa1 :: Dict (Ae.ToJSON (f3 a3 a2 a1)) of-          Dict -> Ae.toJSON ((fromSing sa3, fromSing sa2, fromSing sa1), x)--instance forall (f4 :: k4 -> k3 -> k2 -> k1 -> *)-  . ( SingKind k4-    , SingKind k3-    , SingKind k2-    , SingKind k1-    , Ae.ToJSON (DemoteRep k4)-    , Ae.ToJSON (DemoteRep k3)-    , Ae.ToJSON (DemoteRep k2)-    , Ae.ToJSON (DemoteRep k1)-    , Dict4 Ae.ToJSON f4-    ) => Ae.ToJSON (Some4 f4)-  where-    {-# INLINABLE toJSON #-}-    toJSON = \some4x -> withSome4Sing some4x $ \sa4 sa3 sa2 sa1 (x :: f4 a4 a3 a2 a1) ->-       case dict4 sa4 sa3 sa2 sa1 :: Dict (Ae.ToJSON (f4 a4 a3 a2 a1)) of-          Dict -> Ae.toJSON ((fromSing sa4, fromSing sa3, fromSing sa2, fromSing sa1), x)------------------------------------------------------------------------------------instance forall (f1 :: k1 -> *)-  . ( SingKind k1-    , Ae.FromJSON (DemoteRep k1)-    , Dict1 Ae.FromJSON f1-    ) => Ae.FromJSON (Some1 f1)-  where-    {-# INLINABLE parseJSON #-}-    parseJSON = \v -> do-      (rsa1, v') <- Ae.parseJSON v-      withSomeSing rsa1 $ \(sa1 :: Sing (a1 :: k1)) -> withSingI sa1 $-         case dict1 sa1 :: Dict (Ae.FromJSON (f1 a1)) of-            Dict -> do-               x :: f1 a1 <- Ae.parseJSON v'-               return (some1 x)--instance forall (f2 :: k2 -> k1 -> *)-  . ( SingKind k2-    , SingKind k1-    , Ae.FromJSON (DemoteRep k2)-    , Ae.FromJSON (DemoteRep k1)-    , Dict2 Ae.FromJSON f2-    ) => Ae.FromJSON (Some2 f2)-  where-    {-# INLINABLE parseJSON #-}-    parseJSON = \v -> do-      ((rsa2, rsa1), v') <- Ae.parseJSON v-      withSomeSing rsa2 $ \(sa2 :: Sing (a2 :: k2)) -> withSingI sa2 $-         withSomeSing rsa1 $ \(sa1 :: Sing (a1 :: k1)) -> withSingI sa1 $-            case dict2 sa2 sa1 :: Dict (Ae.FromJSON (f2 a2 a1)) of-               Dict -> do-                  x :: f2 a2 a1 <- Ae.parseJSON v'-                  return (some2 x)--instance forall (f3 :: k3 -> k2 -> k1 -> *)-  . ( SingKind k3-    , SingKind k2-    , SingKind k1-    , Ae.FromJSON (DemoteRep k3)-    , Ae.FromJSON (DemoteRep k2)-    , Ae.FromJSON (DemoteRep k1)-    , Dict3 Ae.FromJSON f3-    ) => Ae.FromJSON (Some3 f3)-  where-    {-# INLINABLE parseJSON #-}-    parseJSON = \v -> do-      ((rsa3, rsa2, rsa1), v') <- Ae.parseJSON v-      withSomeSing rsa3 $ \(sa3 :: Sing (a3 :: k3)) -> withSingI sa3 $-         withSomeSing rsa2 $ \(sa2 :: Sing (a2 :: k2)) -> withSingI sa2 $-            withSomeSing rsa1 $ \(sa1 :: Sing (a1 :: k1)) -> withSingI sa1 $-               case dict3 sa3 sa2 sa1 :: Dict (Ae.FromJSON (f3 a3 a2 a1)) of-                  Dict -> do-                     x :: f3 a3 a2 a1 <- Ae.parseJSON v'-                     return (some3 x)--instance forall (f4 :: k4 -> k3 -> k2 -> k1 -> *)-  . ( SingKind k4-    , SingKind k3-    , SingKind k2-    , SingKind k1-    , Ae.FromJSON (DemoteRep k4)-    , Ae.FromJSON (DemoteRep k3)-    , Ae.FromJSON (DemoteRep k2)-    , Ae.FromJSON (DemoteRep k1)-    , Dict4 Ae.FromJSON f4-    ) => Ae.FromJSON (Some4 f4)-  where-    {-# INLINABLE parseJSON #-}-    parseJSON = \v -> do-      ((rsa4, rsa3, rsa2, rsa1), v') <- Ae.parseJSON v-      withSomeSing rsa4 $ \(sa4 :: Sing (a4 :: k4)) -> withSingI sa4 $-         withSomeSing rsa3 $ \(sa3 :: Sing (a3 :: k3)) -> withSingI sa3 $-            withSomeSing rsa2 $ \(sa2 :: Sing (a2 :: k2)) -> withSingI sa2 $-               withSomeSing rsa1 $ \(sa1 :: Sing (a1 :: k1)) -> withSingI sa1 $-                  case dict4 sa4 sa3 sa2 sa1 :: Dict (Ae.FromJSON (f4 a4 a3 a2 a1)) of-                     Dict -> do-                        x :: f4 a4 a3 a2 a1 <- Ae.parseJSON v'-                        return (some4 x)

@@ -0,0 +1,188 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++module Main where++import qualified Data.Aeson as Aeson+import Data.Int (Int32)+import Data.Kind (Type)+import qualified GHC.Generics as G+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.Runners as Tasty+import Test.Tasty.QuickCheck ((===))+import qualified Test.Tasty.QuickCheck as QC++import Exinst+import Exinst.Aeson ()++--------------------------------------------------------------------------------++main :: IO ()+main = Tasty.defaultMainWithIngredients+  [ Tasty.consoleTestReporter+  , Tasty.listingTests+  ] tt++--------------------------------------------------------------------------------++data family X1 :: Bool -> Type+data instance X1 'False = XF1 | XF2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X1 'True = XT1 | XT2 Int32 deriving (Eq, Show, Read, G.Generic)++data family X2 :: Bool -> Bool -> Type+data instance X2 'False 'False = XFF1 | XFF2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X2 'False 'True = XFT1 | XFT2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X2 'True 'False = XTF1 | XTF2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X2 'True 'True = XTT1 | XTT2 Int32 deriving (Eq, Show, Read, G.Generic)++data family X3 :: Bool -> Bool -> Bool -> Type+data instance X3 'False 'False 'False = XFFF1 | XFFF2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X3 'False 'False 'True = XFFT1 | XFFT2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X3 'False 'True 'False = XFTF1 | XFTF2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X3 'False 'True 'True = XFTT1 | XFTT2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X3 'True 'False 'False = XTFF1 | XTFF2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X3 'True 'False 'True = XTFT1 | XTFT2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X3 'True 'True 'False = XTTF1 | XTTF2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X3 'True 'True 'True = XTTT1 | XTTT2 Int32 deriving (Eq, Show, Read, G.Generic)++data family X4 :: Bool -> Bool -> Bool -> Bool -> Type+data instance X4 'False 'False 'False 'False = XFFFF1 | XFFFF2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X4 'False 'False 'False 'True = XFFFT1 | XFFFT2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X4 'False 'False 'True 'False = XFFTF1 | XFFTF2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X4 'False 'False 'True 'True = XFFTT1 | XFFTT2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X4 'False 'True 'False 'False = XFTFF1 | XFTFF2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X4 'False 'True 'False 'True = XFTFT1 | XFTFT2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X4 'False 'True 'True 'False = XFTTF1 | XFTTF2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X4 'False 'True 'True 'True = XFTTT1 | XFTTT2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X4 'True 'False 'False 'False = XTFFF1 | XTFFF2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X4 'True 'False 'False 'True = XTFFT1 | XTFFT2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X4 'True 'False 'True 'False = XTFTF1 | XTFTF2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X4 'True 'False 'True 'True = XTFTT1 | XTFTT2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X4 'True 'True 'False 'False = XTTFF1 | XTTFF2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X4 'True 'True 'False 'True = XTTFT1 | XTTFT2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X4 'True 'True 'True 'False = XTTTF1 | XTTTF2 Int32 deriving (Eq, Show, Read, G.Generic)+data instance X4 'True 'True 'True 'True = XTTTT1 | XTTTT2 Int32 deriving (Eq, Show, Read, G.Generic)++#define INSTANCETRON(c) \+  instance c (X1 'False); \+  instance c (X1 'True); \+  instance c (X2 'False 'False); \+  instance c (X2 'False 'True); \+  instance c (X2 'True 'False); \+  instance c (X2 'True 'True); \+  instance c (X3 'False 'False 'False); \+  instance c (X3 'False 'False 'True); \+  instance c (X3 'False 'True 'False); \+  instance c (X3 'False 'True 'True); \+  instance c (X3 'True 'False 'False); \+  instance c (X3 'True 'False 'True); \+  instance c (X3 'True 'True 'False); \+  instance c (X3 'True 'True 'True); \+  instance c (X4 'False 'False 'False 'False); \+  instance c (X4 'False 'False 'False 'True); \+  instance c (X4 'False 'False 'True 'False); \+  instance c (X4 'False 'False 'True 'True); \+  instance c (X4 'False 'True 'False 'False); \+  instance c (X4 'False 'True 'False 'True); \+  instance c (X4 'False 'True 'True 'False); \+  instance c (X4 'False 'True 'True 'True); \+  instance c (X4 'True 'False 'False 'False); \+  instance c (X4 'True 'False 'False 'True); \+  instance c (X4 'True 'False 'True 'False); \+  instance c (X4 'True 'False 'True 'True); \+  instance c (X4 'True 'True 'False 'False); \+  instance c (X4 'True 'True 'False 'True); \+  instance c (X4 'True 'True 'True 'False); \+  instance c (X4 'True 'True 'True 'True)++--------------------------------------------------------------------------------+-- Arbitrary instances++instance QC.Arbitrary (X1 'False) where arbitrary = QC.oneof [ pure XF1, fmap XF2 QC.arbitrary ]+instance QC.Arbitrary (X1 'True) where arbitrary = QC.oneof [ pure XT1, fmap XT2 QC.arbitrary ]++instance QC.Arbitrary (X2 'False 'False) where arbitrary = QC.oneof [ pure XFF1, fmap XFF2 QC.arbitrary ]+instance QC.Arbitrary (X2 'False 'True) where arbitrary = QC.oneof [ pure XFT1, fmap XFT2 QC.arbitrary ]+instance QC.Arbitrary (X2 'True 'False) where arbitrary = QC.oneof [ pure XTF1, fmap XTF2 QC.arbitrary ]+instance QC.Arbitrary (X2 'True 'True) where arbitrary = QC.oneof [ pure XTT1, fmap XTT2 QC.arbitrary ]++instance QC.Arbitrary (X3 'False 'False 'False) where arbitrary = QC.oneof [ pure XFFF1, fmap XFFF2 QC.arbitrary ]+instance QC.Arbitrary (X3 'False 'False 'True) where arbitrary = QC.oneof [ pure XFFT1, fmap XFFT2 QC.arbitrary ]+instance QC.Arbitrary (X3 'False 'True 'False) where arbitrary = QC.oneof [ pure XFTF1, fmap XFTF2 QC.arbitrary ]+instance QC.Arbitrary (X3 'False 'True 'True) where arbitrary = QC.oneof [ pure XFTT1, fmap XFTT2 QC.arbitrary ]+instance QC.Arbitrary (X3 'True 'False 'False) where arbitrary = QC.oneof [ pure XTFF1, fmap XTFF2 QC.arbitrary ]+instance QC.Arbitrary (X3 'True 'False 'True) where arbitrary = QC.oneof [ pure XTFT1, fmap XTFT2 QC.arbitrary ]+instance QC.Arbitrary (X3 'True 'True 'False) where arbitrary = QC.oneof [ pure XTTF1, fmap XTTF2 QC.arbitrary ]+instance QC.Arbitrary (X3 'True 'True 'True) where arbitrary = QC.oneof [ pure XTTT1, fmap XTTT2 QC.arbitrary ]++instance QC.Arbitrary (X4 'False 'False 'False 'False) where arbitrary = QC.oneof [ pure XFFFF1, fmap XFFFF2 QC.arbitrary ]+instance QC.Arbitrary (X4 'False 'False 'False 'True) where arbitrary = QC.oneof [ pure XFFFT1, fmap XFFFT2 QC.arbitrary ]+instance QC.Arbitrary (X4 'False 'False 'True 'False) where arbitrary = QC.oneof [ pure XFFTF1, fmap XFFTF2 QC.arbitrary ]+instance QC.Arbitrary (X4 'False 'False 'True 'True) where arbitrary = QC.oneof [ pure XFFTT1, fmap XFFTT2 QC.arbitrary ]+instance QC.Arbitrary (X4 'False 'True 'False 'False) where arbitrary = QC.oneof [ pure XFTFF1, fmap XFTFF2 QC.arbitrary ]+instance QC.Arbitrary (X4 'False 'True 'False 'True) where arbitrary = QC.oneof [ pure XFTFT1, fmap XFTFT2 QC.arbitrary ]+instance QC.Arbitrary (X4 'False 'True 'True 'False) where arbitrary = QC.oneof [ pure XFTTF1, fmap XFTTF2 QC.arbitrary ]+instance QC.Arbitrary (X4 'False 'True 'True 'True) where arbitrary = QC.oneof [ pure XFTTT1, fmap XFTTT2 QC.arbitrary ]+instance QC.Arbitrary (X4 'True 'False 'False 'False) where arbitrary = QC.oneof [ pure XTFFF1, fmap XTFFF2 QC.arbitrary ]+instance QC.Arbitrary (X4 'True 'False 'False 'True) where arbitrary = QC.oneof [ pure XTFFT1, fmap XTFFT2 QC.arbitrary ]+instance QC.Arbitrary (X4 'True 'False 'True 'False) where arbitrary = QC.oneof [ pure XTFTF1, fmap XTFTF2 QC.arbitrary ]+instance QC.Arbitrary (X4 'True 'False 'True 'True) where arbitrary = QC.oneof [ pure XTFTT1, fmap XTFTT2 QC.arbitrary ]+instance QC.Arbitrary (X4 'True 'True 'False 'False) where arbitrary = QC.oneof [ pure XTTFF1, fmap XTTFF2 QC.arbitrary ]+instance QC.Arbitrary (X4 'True 'True 'False 'True) where arbitrary = QC.oneof [ pure XTTFT1, fmap XTTFT2 QC.arbitrary ]+instance QC.Arbitrary (X4 'True 'True 'True 'False) where arbitrary = QC.oneof [ pure XTTTF1, fmap XTTTF2 QC.arbitrary ]+instance QC.Arbitrary (X4 'True 'True 'True 'True) where arbitrary = QC.oneof [ pure XTTTT1, fmap XTTTT2 QC.arbitrary ]++--------------------------------------------------------------------------------++tt :: Tasty.TestTree+tt =+  Tasty.testGroup "main"+  [ tt_id "Identity through Aeson's ToJSON/FromJSON" id_aeson+  ]++tt_id+  :: String+  -> (forall a. (Aeson.FromJSON a, Aeson.ToJSON a) => a -> Maybe a)+  -- ^ It's easier to put all the constraints here in the 'MegaCtx' monster.+  -> Tasty.TestTree+tt_id = \title id' -> Tasty.testGroup title+  [ QC.testProperty "Some1 X1" $+      QC.forAll QC.arbitrary $ \(x :: Some1 X1) -> Just x === id' x+  , QC.testProperty "Some2 X2" $+      QC.forAll QC.arbitrary $ \(x :: Some2 X2) -> Just x === id' x+  , QC.testProperty "Some3 X3" $+      QC.forAll QC.arbitrary $ \(x :: Some3 X3) -> Just x === id' x+  , QC.testProperty "Some4 X4" $+      QC.forAll QC.arbitrary $ \(x :: Some4 X4) -> Just x === id' x+  , QC.testProperty "Some1 (P1 X1 X1)" $+      QC.forAll QC.arbitrary $ \(x :: Some1 (P1 X1 X1)) -> Just x === id' x+  , QC.testProperty "Some2 (P2 X2 X2)" $+      QC.forAll QC.arbitrary $ \(x :: Some2 (P2 X2 X2)) -> Just x === id' x+  , QC.testProperty "Some3 (P3 X3 X3)" $+      QC.forAll QC.arbitrary $ \(x :: Some3 (P3 X3 X3)) -> Just x === id' x+  , QC.testProperty "Some4 (P4 X4 X4)" $+      QC.forAll QC.arbitrary $ \(x :: Some4 (P4 X4 X4)) -> Just x === id' x+  , QC.testProperty "Some1 (S1 X1 X1)" $+      QC.forAll QC.arbitrary $ \(x :: Some1 (S1 X1 X1)) -> Just x === id' x+  , QC.testProperty "Some2 (S2 X2 X2)" $+      QC.forAll QC.arbitrary $ \(x :: Some2 (S2 X2 X2)) -> Just x === id' x+  , QC.testProperty "Some3 (S3 X3 X3)" $+      QC.forAll QC.arbitrary $ \(x :: Some3 (S3 X3 X3)) -> Just x === id' x+  , QC.testProperty "Some4 (S4 X4 X4)" $+      QC.forAll QC.arbitrary $ \(x :: Some4 (S4 X4 X4)) -> Just x === id' x+  ]++--------------------------------------------------------------------------------++INSTANCETRON(Aeson.ToJSON)+INSTANCETRON(Aeson.FromJSON)++id_aeson :: (Aeson.FromJSON a, Aeson.ToJSON a) => a -> Maybe a+id_aeson = Aeson.decode . Aeson.encode