exinst-cereal (empty) → 0.7

raw patch · 7 files changed

+448/−0 lines, 7 filesdep +QuickCheckdep +basedep +binarysetup-changed

Dependencies added: QuickCheck, base, binary, bytestring, cereal, constraints, exinst, exinst-cereal, singletons, tasty, tasty-quickcheck

Files

CHANGELOG.md +4/−0
LICENSE.txt +30/−0
README.md +5/−0
Setup.hs +2/−0
exinst-cereal.cabal +46/−0
lib/Exinst/Cereal.hs +154/−0
tests/Main.hs +207/−0

+ CHANGELOG.md view

@@ -0,0 +1,4 @@+# Version 0.7++* This library exports the `Data.Serialize.Serialize` instances previously+  exported from `exinst-0.6`.

+ LICENSE.txt view

@@ -0,0 +1,30 @@+Copyright (c) 2015-2018, Renzo Carbonara++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Renzo Carbonara nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,5 @@+# exinst-cereal++See the [BSD3 LICENSE](https://github.com/k0001/exinst/blob/master/exinst/exinst-cereal/LICENSE.txt)+file to learn about the legal terms and conditions for this library.+

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ exinst-cereal.cabal view

@@ -0,0 +1,46 @@+name:                exinst-cereal+version:             0.7+author:              Renzo Carbonara+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:            Dependent pairs and their instances.+homepage:            https://github.com/k0001/exinst+bug-reports:         https://github.com/k0001/exinst/issues+++library+  hs-source-dirs: lib+  default-language: Haskell2010+  exposed-modules: Exinst.Cereal+  build-depends:+      base >=4.9 && <5.0+    , cereal+    , 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:+     base+   , binary+   , bytestring+   , cereal+   , exinst+   , exinst-cereal+   , QuickCheck+   , tasty+   , tasty-quickcheck+  ghcjs-options: -Wall -O0+  ghc-options: -Wall -O0

+ lib/Exinst/Cereal.hs view

@@ -0,0 +1,154 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | This module exports 'Cer.Serialize' 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.Cereal () where++import qualified Data.Serialize as Cer+import Data.Constraint+import Data.Kind (Type)+import Data.Singletons+import Prelude++import Exinst++--------------------------------------------------------------------------------++-- | Compatible with the 'Data.Bytes.Serial.Serial' instance and+-- 'Data.Binary.Binary' instance, provided all of the 'Demote's and the fully+-- applied @f@ instances are compatible as well.+instance forall (f :: k1 -> Type).+  ( SingKind k1+  , Cer.Serialize (Demote k1)+  , Dict1 Cer.Serialize f+  ) => Cer.Serialize (Some1 f) where+  {-# INLINABLE put #-}+  put = \some1x ->+    withSome1Sing some1x $ \sa1 (x :: f a1) ->+      case dict1 sa1 :: Dict (Cer.Serialize (f a1)) of+        Dict -> do+          Cer.put (fromSing sa1)+          Cer.put x+  {-# INLINABLE get #-}+  get = do+    rsa1 <- Cer.get+    withSomeSing rsa1 $ \(sa1 :: Sing (a1 :: k1)) ->+      case dict1 sa1 :: Dict (Cer.Serialize (f a1)) of+        Dict -> do+          x :: f a1 <- Cer.get+          pure (Some1 sa1 x)++-- | Compatible with the 'Data.Bytes.Serial.Serial' instance and+-- 'Data.Binary.Binary' instance, provided all of the 'Demote's and the fully+-- applied @f@ instances are compatible as well.+instance forall (f :: k2 -> k1 -> Type).+  ( SingKind k2+  , SingKind k1+  , Cer.Serialize (Demote k2)+  , Cer.Serialize (Demote k1)+  , Dict2 Cer.Serialize f+  ) => Cer.Serialize (Some2 f) where+  {-# INLINABLE put #-}+  put = \some2x ->+    withSome2Sing some2x $ \sa2 sa1 (x :: f a2 a1) ->+      case dict2 sa2 sa1 :: Dict (Cer.Serialize (f a2 a1)) of+        Dict -> do+          Cer.put (fromSing sa2, fromSing sa1)+          Cer.put x+  {-# INLINABLE get #-}+  get = do+    (rsa2, rsa1) <- Cer.get+    withSomeSing rsa2 $ \(sa2 :: Sing (a2 :: k2)) ->+      withSomeSing rsa1 $ \(sa1 :: Sing (a1 :: k1)) ->+        case dict2 sa2 sa1 :: Dict (Cer.Serialize (f a2 a1)) of+          Dict -> do+            x :: f a2 a1 <- Cer.get+            pure (Some2 sa2 sa1 x)++-- | Compatible with the 'Data.Bytes.Serial.Serial' instance and+-- 'Data.Binary.Binary' instance, provided all of the 'Demote's and the fully+-- applied @f@ instances are compatible as well.+instance forall (f :: k3 -> k2 -> k1 -> Type).+  ( SingKind k3+  , SingKind k2+  , SingKind k1+  , Cer.Serialize (Demote k3)+  , Cer.Serialize (Demote k2)+  , Cer.Serialize (Demote k1)+  , Dict3 Cer.Serialize f+  ) => Cer.Serialize (Some3 f) where+  {-# INLINABLE put #-}+  put = \some3x ->+    withSome3Sing some3x $ \sa3 sa2 sa1 (x :: f a3 a2 a1) ->+      case dict3 sa3 sa2 sa1 :: Dict (Cer.Serialize (f a3 a2 a1)) of+        Dict -> do+          Cer.put (fromSing sa3, fromSing sa2, fromSing sa1)+          Cer.put x+  {-# INLINABLE get #-}+  get = do+    (rsa3, rsa2, rsa1) <- Cer.get+    withSomeSing rsa3 $ \(sa3 :: Sing (a3 :: k3)) ->+      withSomeSing rsa2 $ \(sa2 :: Sing (a2 :: k2)) ->+        withSomeSing rsa1 $ \(sa1 :: Sing (a1 :: k1)) ->+          case dict3 sa3 sa2 sa1 :: Dict (Cer.Serialize (f a3 a2 a1)) of+            Dict -> do+              x :: f a3 a2 a1 <- Cer.get+              pure (Some3 sa3 sa2 sa1 x)++-- | Compatible with the 'Data.Bytes.Serial.Serial' instance and+-- 'Data.Binary.Binary' instance, provided all of the 'Demote's and the fully+-- applied @f@ instances are compatible as well.+instance forall (f :: k4 -> k3 -> k2 -> k1 -> Type).+  ( SingKind k4+  , SingKind k3+  , SingKind k2+  , SingKind k1+  , Cer.Serialize (Demote k4)+  , Cer.Serialize (Demote k3)+  , Cer.Serialize (Demote k2)+  , Cer.Serialize (Demote k1)+  , Dict4 Cer.Serialize f+  ) => Cer.Serialize (Some4 f) where+  {-# INLINABLE put #-}+  put = \some4x ->+    withSome4Sing some4x $ \sa4 sa3 sa2 sa1 (x :: f a4 a3 a2 a1) ->+      case dict4 sa4 sa3 sa2 sa1 :: Dict (Cer.Serialize (f a4 a3 a2 a1)) of+        Dict -> do+          Cer.put (fromSing sa4, fromSing sa3, fromSing sa2, fromSing sa1)+          Cer.put x+  {-# INLINABLE get #-}+  get = do+    (rsa4, rsa3, rsa2, rsa1) <- Cer.get+    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 (Cer.Serialize (f a4 a3 a2 a1)) of+              Dict -> do+                x :: f a4 a3 a2 a1 <- Cer.get+                pure (Some4 sa4 sa3 sa2 sa1 x)++--------------------------------------------------------------------------------++instance (Cer.Serialize (l a1), Cer.Serialize (r a1)) => Cer.Serialize (S1 l r a1)+instance (Cer.Serialize (l a2 a1), Cer.Serialize (r a2 a1)) => Cer.Serialize (S2 l r a2 a1)+instance (Cer.Serialize (l a3 a2 a1), Cer.Serialize (r a3 a2 a1)) => Cer.Serialize (S3 l r a3 a2 a1)+instance (Cer.Serialize (l a4 a3 a2 a1), Cer.Serialize (r a4 a3 a2 a1)) => Cer.Serialize (S4 l r a4 a3 a2 a1)++--------------------------------------------------------------------------------++instance (Cer.Serialize (l a1), Cer.Serialize (r a1)) => Cer.Serialize (P1 l r a1)+instance (Cer.Serialize (l a2 a1), Cer.Serialize (r a2 a1)) => Cer.Serialize (P2 l r a2 a1)+instance (Cer.Serialize (l a3 a2 a1), Cer.Serialize (r a3 a2 a1)) => Cer.Serialize (P3 l r a3 a2 a1)+instance (Cer.Serialize (l a4 a3 a2 a1), Cer.Serialize (r a4 a3 a2 a1)) => Cer.Serialize (P4 l r a4 a3 a2 a1)+

+ tests/Main.hs view

@@ -0,0 +1,207 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++module Main where++import qualified Data.Binary as Bin+import qualified Data.ByteString.Lazy as BSL+import Data.Int (Int32)+import Data.Kind (Type)+import qualified Data.Serialize as Cer+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.Cereal ()++--------------------------------------------------------------------------------++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, Bin.Binary)+data instance X1 'True = XT1 | XT2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)++data family X2 :: Bool -> Bool -> Type+data instance X2 'False 'False = XFF1 | XFF2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X2 'False 'True = XFT1 | XFT2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X2 'True 'False = XTF1 | XTF2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X2 'True 'True = XTT1 | XTT2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)++data family X3 :: Bool -> Bool -> Bool -> Type+data instance X3 'False 'False 'False = XFFF1 | XFFF2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X3 'False 'False 'True = XFFT1 | XFFT2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X3 'False 'True 'False = XFTF1 | XFTF2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X3 'False 'True 'True = XFTT1 | XFTT2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X3 'True 'False 'False = XTFF1 | XTFF2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X3 'True 'False 'True = XTFT1 | XTFT2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X3 'True 'True 'False = XTTF1 | XTTF2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X3 'True 'True 'True = XTTT1 | XTTT2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)++data family X4 :: Bool -> Bool -> Bool -> Bool -> Type+data instance X4 'False 'False 'False 'False = XFFFF1 | XFFFF2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X4 'False 'False 'False 'True = XFFFT1 | XFFFT2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X4 'False 'False 'True 'False = XFFTF1 | XFFTF2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X4 'False 'False 'True 'True = XFFTT1 | XFFTT2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X4 'False 'True 'False 'False = XFTFF1 | XFTFF2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X4 'False 'True 'False 'True = XFTFT1 | XFTFT2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X4 'False 'True 'True 'False = XFTTF1 | XFTTF2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X4 'False 'True 'True 'True = XFTTT1 | XFTTT2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X4 'True 'False 'False 'False = XTFFF1 | XTFFF2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X4 'True 'False 'False 'True = XTFFT1 | XTFFT2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X4 'True 'False 'True 'False = XTFTF1 | XTFTF2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X4 'True 'False 'True 'True = XTFTT1 | XTFTT2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X4 'True 'True 'False 'False = XTTFF1 | XTTFF2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X4 'True 'True 'False 'True = XTTFT1 | XTTFT2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X4 'True 'True 'True 'False = XTTTF1 | XTTTF2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)+data instance X4 'True 'True 'True 'True = XTTTT1 | XTTTT2 Int32 deriving (Eq, Show, Read, G.Generic, Bin.Binary)++#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 Cereal's Serialize" id_cereal+  , tt_id "Identity from Binary's Binary to Cereal's Serialize" id_binary_to_cereal+  , tt_id "Identity from Cereal's Serialize to Binary's Binary" id_cereal_to_binary+  ]++type MegaCtx a = (Bin.Binary a, Cer.Serialize a)++tt_id+  :: String+  -> (forall a. MegaCtx 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(Cer.Serialize)+id_cereal :: Cer.Serialize a => a -> Maybe a+id_cereal = \a ->+  case Cer.decodeLazy (Cer.encodeLazy a) of+     Right a' -> Just a'+     Left _ -> Nothing++id_binary_to_cereal :: (Bin.Binary a, Cer.Serialize a) => a -> Maybe a+id_binary_to_cereal = \a ->+  case Cer.decodeLazy (Bin.encode a) of+     Right a' -> Just a'+     Left _ -> Nothing++id_cereal_to_binary :: (Bin.Binary a, Cer.Serialize a) => a -> Maybe a+id_cereal_to_binary = \a ->+   case Bin.decodeOrFail (Cer.encodeLazy a) of+      Right (z,_,a') | BSL.null z -> Just a'+      _ -> Nothing+