binary-tagged-0.1.4.1/0000755000000000000000000000000013002125632012550 5ustar0000000000000000binary-tagged-0.1.4.1/binary-tagged.cabal0000644000000000000000000001001513002125632016246 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.14.1. -- -- see: https://github.com/sol/hpack name: binary-tagged version: 0.1.4.1 synopsis: Tagged binary serialisation. description: Check category: Web homepage: https://github.com/phadej/binary-tagged#readme bug-reports: https://github.com/phadej/binary-tagged/issues author: Oleg Grenrus maintainer: Oleg Grenrus license: BSD3 license-file: LICENSE tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.1 build-type: Simple cabal-version: >= 1.10 extra-source-files: CHANGELOG.md README.md source-repository head type: git location: https://github.com/phadej/binary-tagged library hs-source-dirs: src ghc-options: -Wall build-depends: base >=4.7 && <4.10 , aeson >=0.8 && <1.1 , array >=0.5 && <0.6 , base16-bytestring >=0.1.1.6 && <0.2 , binary >=0.7 && <0.9 , bytestring >=0.10 && <0.11 , containers >=0.5 && <0.6 , generics-sop >=0.1 && <0.3 , hashable >=1.2 && <1.3 , nats >=1 && <1.2 , scientific >=0.3 && <0.4 , SHA >=1.6 && <1.7 , semigroups >=0.16 && <0.19 , tagged >=0.7 && <0.9 , text >=1.2 && <1.3 , time >=1.4 && <1.7 , unordered-containers >=0.2 && <0.3 , vector >=0.10 && <0.12 exposed-modules: Data.Binary.Tagged default-language: Haskell2010 test-suite binary-tagged-test type: exitcode-stdio-1.0 main-is: Tests.hs hs-source-dirs: test ghc-options: -Wall build-depends: base >=4.7 && <4.10 , aeson >=0.8 && <1.1 , array >=0.5 && <0.6 , base16-bytestring >=0.1.1.6 && <0.2 , binary >=0.7 && <0.9 , bytestring >=0.10 && <0.11 , containers >=0.5 && <0.6 , generics-sop >=0.1 && <0.3 , hashable >=1.2 && <1.3 , nats >=1 && <1.2 , scientific >=0.3 && <0.4 , SHA >=1.6 && <1.7 , semigroups >=0.16 && <0.19 , tagged >=0.7 && <0.9 , text >=1.2 && <1.3 , time >=1.4 && <1.7 , unordered-containers >=0.2 && <0.3 , vector >=0.10 && <0.12 , binary-tagged , binary-orphans >=0.1.1 , bifunctors , quickcheck-instances , tasty , tasty-quickcheck other-modules: Generators Rec1 Rec2 default-language: Haskell2010 benchmark binary-tagged-bench type: exitcode-stdio-1.0 main-is: Bench.hs hs-source-dirs: bench ghc-options: -Wall build-depends: base >=4.7 && <4.10 , aeson >=0.8 && <1.1 , array >=0.5 && <0.6 , base16-bytestring >=0.1.1.6 && <0.2 , binary >=0.7 && <0.9 , bytestring >=0.10 && <0.11 , containers >=0.5 && <0.6 , generics-sop >=0.1 && <0.3 , hashable >=1.2 && <1.3 , nats >=1 && <1.2 , scientific >=0.3 && <0.4 , SHA >=1.6 && <1.7 , semigroups >=0.16 && <0.19 , tagged >=0.7 && <0.9 , text >=1.2 && <1.3 , time >=1.4 && <1.7 , unordered-containers >=0.2 && <0.3 , vector >=0.10 && <0.12 , binary-tagged , binary-orphans >=0.1.1 , deepseq , criterion default-language: Haskell2010 binary-tagged-0.1.4.1/CHANGELOG.md0000644000000000000000000000115313002125632014361 0ustar0000000000000000- 0.1.4.1 (2016-09-20) - Print mismatching hashes in base16 encoding - 0.1.4.0 (2016-04-12) - Add semigroups types - Add Natural - 0.1.3.1 (2016-02-10) - Support GHC 8.0 - 0.1.3.0 (2015-10-24) - Support `generics-sop-0.2` - 0.1.2.0 (2015-10-06) - Add tuple `HasSemanticVersion` instances - Add instances for - `()` - `Float` - `Double` - Version` - `Fixed` - `Ordering` - Fix `Interleave` & `SumUpTo`, introduce `Div2` - 0.1.1.0 - Add instances - `Ratio` - `Word` - `HasSemanticVersion` for primitive types binary-tagged-0.1.4.1/LICENSE0000644000000000000000000000276213002125632013564 0ustar0000000000000000Copyright (c) 2015, Oleg Grenrus 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 Oleg Grenrus 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. binary-tagged-0.1.4.1/README.md0000644000000000000000000000260113002125632014026 0ustar0000000000000000# binary-tagged [![Build Status](https://travis-ci.org/phadej/binary-tagged.svg?branch=master)](https://travis-ci.org/phadej/binary-tagged) [![Hackage](https://img.shields.io/hackage/v/binary-tagged.svg)](http://hackage.haskell.org/package/binary-tagged) [![Stackage LTS 2](http://stackage.org/package/binary-tagged/badge/lts-2)](http://stackage.org/lts-2/package/binary-tagged) [![Stackage LTS 3](http://stackage.org/package/binary-tagged/badge/lts-3)](http://stackage.org/lts-3/package/binary-tagged) [![Stackage Nightly](http://stackage.org/package/binary-tagged/badge/nightly)](http://stackage.org/nightly/package/binary-tagged) Structurally tag binary serialisation stream. Say you have: ```hs data Record = Record { _recordFields :: HM.HashMap Text (Integer, ByteString) , _recordEnabled :: Bool } deriving (Eq, Show, Generic) instance Binary Record instance HasStructuralInfo Record instance HasSemanticVersion Record ``` then you can serialise and deserialise `Record` values with a structure tag by simply ```hs encodeTaggedFile "cachefile" record decodeTaggedFile "cachefile" :: IO Record ``` If structure of `Record` changes in between, deserialisation will fail early. The overhead is next to non-observable, see [a simple benchmark](https://github.com/phadej/binary-tagged/blob/master/bench/Bench.hs) and the [results](https://rawgit.com/phadej/binary-tagged/master/bench.html). binary-tagged-0.1.4.1/Setup.hs0000644000000000000000000000005613002125632014205 0ustar0000000000000000import Distribution.Simple main = defaultMain binary-tagged-0.1.4.1/bench/0000755000000000000000000000000013002125632013627 5ustar0000000000000000binary-tagged-0.1.4.1/bench/Bench.hs0000644000000000000000000000260413002125632015204 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} module Main (main) where import Control.DeepSeq import Data.ByteString.Lazy as LBS import Data.Binary.Orphans import Data.Binary.Tagged import Criterion.Main import qualified Data.HashMap.Strict as HM import Data.Text as T import GHC.Generics data Field = Field { _fieldName :: Text , _fieldValue :: Int } deriving (Eq, Show, Generic) instance Binary Field instance NFData Field instance HasStructuralInfo Field data Record = Record { _recordFields :: HM.HashMap Text Field , _recordEnabled :: Bool } deriving (Eq, Show, Generic) instance Binary Record instance NFData Record instance HasStructuralInfo Record instance HasSemanticVersion Record record :: Record record = Record fields enabled where fields = HM.fromList (fmap mkField [1..1000]) mkField i = let name = T.pack (show i) in (name, Field name i) enabled = True encodedRecord :: LBS.ByteString encodedRecord = encode record taggedEncodedRecord :: LBS.ByteString taggedEncodedRecord = taggedEncode record main :: IO () main = defaultMain [ bgroup "encode" [ bench "Binary" $ nf encode record , bench "Tagged" $ nf taggedEncode record ] , bgroup "decode" [ bench "Binary" $ nf (decode :: LBS.ByteString -> Record) encodedRecord , bench "Tagged" $ nf (taggedDecode :: LBS.ByteString -> Record) taggedEncodedRecord ] ] binary-tagged-0.1.4.1/src/0000755000000000000000000000000013002125632013337 5ustar0000000000000000binary-tagged-0.1.4.1/src/Data/0000755000000000000000000000000013002125632014210 5ustar0000000000000000binary-tagged-0.1.4.1/src/Data/Binary/0000755000000000000000000000000013002125632015434 5ustar0000000000000000binary-tagged-0.1.4.1/src/Data/Binary/Tagged.hs0000644000000000000000000007620213002125632017172 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -- We need this for Interleave {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Binary.Tagged -- Copyright : (C) 2015 Oleg Grenrus -- License : BSD3 -- Maintainer : Oleg Grenrus -- -- Structurally tag binary serialisation stream. -- -- Say you have: -- -- > data Record = Record -- > { _recordFields :: HM.HashMap Text (Integer, ByteString) -- > , _recordEnabled :: Bool -- > } -- > deriving (Eq, Show, Generic) -- > -- > instance Binary Record -- > instance HasStructuralInfo Record -- > instance HasSemanticVersion Record -- -- then you can serialise and deserialise @Record@ values with a structure tag by simply -- -- > encodeTaggedFile "cachefile" record -- > decodeTaggedFile "cachefile" :: IO Record -- -- If structure of @Record@ changes in between, deserialisation will fail early. module Data.Binary.Tagged ( -- * Data BinaryTagged(..), BinaryTagged', binaryTag, binaryTag', binaryUntag, binaryUntag', StructuralInfo(..), -- * Serialisation taggedEncode, taggedDecode, taggedDecodeOrFail, -- * IO functions for serialisation taggedEncodeFile, taggedDecodeFile, taggedDecodeFileOrFail, -- * Class HasStructuralInfo(..), HasSemanticVersion(..), Version, -- ** Type level calculations Interleave, SumUpTo, Div2, -- * Generic derivation -- ** GHC ghcStructuralInfo, ghcNominalType, ghcStructuralInfo1, -- ** SOP sopStructuralInfo, sopNominalType, sopStructuralInfo1, -- ** SOP direct sopStructuralInfoS, sopNominalTypeS, sopStructuralInfo1S, -- * Hash structuralInfoSha1Digest, structuralInfoSha1ByteStringDigest, ) where import Control.Applicative import Control.Monad import Data.Binary import Data.Binary.Get (ByteOffset) import Data.ByteString as BS import Data.ByteString.Lazy as LBS import qualified Data.ByteString.Base16.Lazy as Base16 import Data.Digest.Pure.SHA import Data.Monoid ((<>)) import Data.Proxy import Generics.SOP as SOP import Generics.SOP.GGP as SOP #if MIN_VERSION_generics_sop(0,2,0) import Generics.SOP.Constraint as SOP #endif #if !MIN_VERSION_base(4,8,0) import Data.Foldable (Foldable) import Data.Traversable (Traversable) #endif import qualified GHC.Generics as GHC import GHC.TypeLits -- Instances import Data.Int import qualified Data.Array.IArray as Array import qualified Data.Array.Unboxed as Array import qualified Data.Fixed as Fixed import qualified Data.HashMap.Lazy as HML import qualified Data.HashSet as HS import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Monoid as Monoid import qualified Data.Ratio as Ratio import qualified Data.Semigroup as Semigroup import qualified Data.Sequence as Seq import qualified Data.Set as Set import qualified Data.Text as S import qualified Data.Text.Lazy as L import qualified Data.Time as Time import qualified Data.Vector as V import qualified Data.Vector.Storable as S import qualified Data.Vector.Unboxed as U import qualified Data.Version as Version import qualified Numeric.Natural as Natural #ifdef MIN_VERSION_aeson import qualified Data.Aeson as Aeson #endif -- | 'Binary' serialisable class, which tries to be less error-prone to data structure changes. -- -- Values are serialised with header consisting of version @v@ and hash of 'structuralInfo'. newtype BinaryTagged (v :: k) a = BinaryTagged { unBinaryTagged :: a } deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable, GHC.Generic, GHC.Generic1) -- TODO: Derive Enum, Bounded, Typeable, Data, Hashable, NFData, Numeric classes? type BinaryTagged' a = BinaryTagged (SemanticVersion a) a binaryTag :: Proxy v -> a -> BinaryTagged v a binaryTag _ = BinaryTagged binaryTag' :: HasSemanticVersion a => a -> BinaryTagged' a binaryTag' = BinaryTagged binaryUntag :: Proxy v -> BinaryTagged v a -> a binaryUntag _ = unBinaryTagged binaryUntag' :: HasSemanticVersion a => BinaryTagged' a -> a binaryUntag' = unBinaryTagged -- | Tagged version of 'encode' taggedEncode :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => a -> LBS.ByteString taggedEncode = encode . binaryTag (Proxy :: Proxy (SemanticVersion a)) -- | Tagged version of 'decode' taggedDecode :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => LBS.ByteString -> a taggedDecode = binaryUntag (Proxy :: Proxy (SemanticVersion a)) . decode -- | Tagged version of 'decodeOrFail' taggedDecodeOrFail :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => LBS.ByteString -> Either (LBS.ByteString, ByteOffset, String) (LBS.ByteString, ByteOffset, a) taggedDecodeOrFail = fmap3 (binaryUntag (Proxy :: Proxy (SemanticVersion a))) . decodeOrFail where fmap3 f = fmap (\(a, b, c) -> (a, b, f c)) -- | Tagged version of 'encodeFile' taggedEncodeFile :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => FilePath -> a -> IO () taggedEncodeFile filepath = encodeFile filepath . binaryTag (Proxy :: Proxy (SemanticVersion a)) -- | Tagged version of 'decodeFile' taggedDecodeFile :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => FilePath -> IO a taggedDecodeFile = fmap (binaryUntag (Proxy :: Proxy (SemanticVersion a))) . decodeFile -- | Tagged version of 'decodeFileOrFail' taggedDecodeFileOrFail :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => FilePath -> IO (Either (ByteOffset, String) a) taggedDecodeFileOrFail = (fmap . fmap) (binaryUntag (Proxy :: Proxy (SemanticVersion a))) . decodeFileOrFail instance Applicative (BinaryTagged v) where pure = return (<*>) = ap instance Monad (BinaryTagged v) where return = BinaryTagged BinaryTagged m >>= k = k m instance Monoid.Monoid a => Monoid.Monoid (BinaryTagged v a) where mempty = pure Monoid.mempty mappend = liftA2 Monoid.mappend -- | Type the semantic version is serialised with. type Version = Word32 -- | Version and structure hash are prepended to serialised stream instance (Binary a, HasStructuralInfo a, KnownNat v) => Binary (BinaryTagged v a) where put (BinaryTagged x) = put ver' >> put hash' >> put x where proxyV = Proxy :: Proxy v proxyA = Proxy :: Proxy a ver' = fromIntegral (natVal proxyV) :: Version hash' = structuralInfoSha1ByteStringDigest . structuralInfo $ proxyA get = do ver <- get if ver == ver' then do hash <- get if hash == hash' then fmap BinaryTagged get else fail $ "Non matching structure hashes: got" <> show (Base16.encode hash) <> "; expected: " <> show (Base16.encode hash') else fail $ "Non matching versions: got " <> show ver <> "; expected: " <> show ver' where proxyV = Proxy :: Proxy v proxyA = Proxy :: Proxy a ver' = fromIntegral (natVal proxyV) :: Version hash' = bytestringDigest . structuralInfoSha1Digest . structuralInfo $ proxyA -- | Data type structure, with (some) nominal information. data StructuralInfo = NominalType String | NominalNewtype String StructuralInfo | StructuralInfo String [[StructuralInfo]] deriving (Eq, Ord, Show, GHC.Generic) instance Binary StructuralInfo -- | Type class providing `StructuralInfo` for each data type. -- -- For regular non-recursive ADTs 'HasStructuralInfo' can be derived generically. -- -- > data Record = Record { a :: Int, b :: Bool, c :: [Char] } deriving (Generic) -- > instance hasStructuralInfo Record -- -- For stable types, you can provide only type name -- -- > instance HasStructuralInfo Int where structuralInfo = ghcNominalType -- infer name from Generic information -- > instance HasStructuralInfo Integer where structuralInfo _ = NominalType "Integer" -- -- Recursive type story is a bit sad atm. If the type structure is stable, you can do: -- -- > instance HasStructuralInfo a => HasStructuralInfo [a] where structuralInfo = ghcStructuralInfo1 class HasStructuralInfo a where structuralInfo :: Proxy a -> StructuralInfo default structuralInfo :: ( GHC.Generic a , All2 HasStructuralInfo (GCode a) , GDatatypeInfo a #if MIN_VERSION_generics_sop(0,2,0) , SListI2 (GCode a) #else , SingI (GCode a) #endif ) => Proxy a -> StructuralInfo structuralInfo = ghcStructuralInfo -- | A helper type family for 'encodeTaggedFile' and 'decodeTaggedFile'. -- -- The default definition is @'SemanticVersion' a = 0@ class KnownNat (SemanticVersion a) => HasSemanticVersion (a :: *) where type SemanticVersion a :: Nat type SemanticVersion a = 0 instance HasStructuralInfo StructuralInfo instance HasSemanticVersion StructuralInfo structuralInfoSha1Digest :: StructuralInfo -> Digest SHA1State structuralInfoSha1Digest = sha1 . encode structuralInfoSha1ByteStringDigest :: StructuralInfo -> LBS.ByteString structuralInfoSha1ByteStringDigest = bytestringDigest . structuralInfoSha1Digest ------------------------------------------------------------------------------- -- Generics ------------------------------------------------------------------------------- ghcStructuralInfo :: ( GHC.Generic a , All2 HasStructuralInfo (GCode a) , GDatatypeInfo a #if MIN_VERSION_generics_sop(0,2,0) , SListI2 (GCode a) #else , SingI (GCode a) #endif ) => Proxy a -> StructuralInfo ghcStructuralInfo proxy = sopStructuralInfoS (gdatatypeInfo proxy) ghcNominalType :: (GHC.Generic a, GDatatypeInfo a) => Proxy a -> StructuralInfo ghcNominalType proxy = sopNominalTypeS (gdatatypeInfo proxy) ghcStructuralInfo1 :: forall f a. (GHC.Generic1 f, GDatatypeInfo (f a), HasStructuralInfo a) => Proxy (f a) -> StructuralInfo ghcStructuralInfo1 proxy = sopStructuralInfo1S (structuralInfo (Proxy :: Proxy a)) (gdatatypeInfo proxy) -- SOP derivation sopStructuralInfo :: forall a. (Generic a, HasDatatypeInfo a, All2 HasStructuralInfo (Code a)) => Proxy a -> StructuralInfo sopStructuralInfo proxy = sopStructuralInfoS (datatypeInfo proxy) sopStructuralInfoS :: forall xss. ( All2 HasStructuralInfo xss #if MIN_VERSION_generics_sop(0,2,0) , SListI2 xss #else , SingI xss #endif ) => DatatypeInfo xss -> StructuralInfo sopStructuralInfoS di@(Newtype _ _ ci) = NominalNewtype (datatypeName di) (sopNominalNewtype ci) sopStructuralInfoS di@(ADT _ _ _) = StructuralInfo (datatypeName di) (sopNominalAdtPOP (hpure Proxy :: POP Proxy xss)) sopNominalNewtype :: forall x. HasStructuralInfo x => ConstructorInfo '[x] -> StructuralInfo sopNominalNewtype _ = structuralInfo (Proxy :: Proxy x) sopNominalAdtPOP :: (All2 HasStructuralInfo xss) => POP Proxy xss -> [[StructuralInfo]] sopNominalAdtPOP (POP np2) = sopNominalAdt np2 sopNominalAdt :: (All2 HasStructuralInfo xss) => NP (NP Proxy) xss -> [[StructuralInfo]] sopNominalAdt Nil = [] sopNominalAdt (p :* ps) = sopStructuralInfoP p : sopNominalAdt ps sopStructuralInfoP :: (All HasStructuralInfo xs) => NP Proxy xs -> [StructuralInfo] sopStructuralInfoP Nil = [] sopStructuralInfoP (proxy :* rest) = structuralInfo proxy : sopStructuralInfoP rest sopNominalType :: forall a. (Generic a, HasDatatypeInfo a) => Proxy a -> StructuralInfo sopNominalType proxy = sopNominalTypeS (datatypeInfo proxy) sopNominalTypeS :: DatatypeInfo xss -> StructuralInfo sopNominalTypeS di = NominalType (datatypeName di) sopStructuralInfo1 :: forall f a. (Generic (f a), HasDatatypeInfo (f a), HasStructuralInfo a) => Proxy (f a) -> StructuralInfo sopStructuralInfo1 proxy = sopStructuralInfo1S (structuralInfo (Proxy :: Proxy a)) (datatypeInfo proxy) sopStructuralInfo1S :: StructuralInfo -> DatatypeInfo xss -> StructuralInfo sopStructuralInfo1S nsop di = NominalNewtype (datatypeName di) nsop ------------------------------------------------------------------------------- -- SOP helpers ------------------------------------------------------------------------------- datatypeName :: DatatypeInfo xss -> DatatypeName datatypeName (Newtype _ d _) = d datatypeName (ADT _ d _) = d -- | Interleaving -- -- > 3 | 9 . . . . -- > 2 | 5 8 . . . -- > 1 | 2 4 7 11 . -- > 0 | 0 1 3 6 10 -- > ----------------- -- > 0 1 2 3 4 -- -- This can be calculated by @f x y = sum ([0..x+y]) + y@ type Interleave (n :: Nat) (m :: Nat) = SumUpTo (n + m) + m type SumUpTo (n :: Nat) = Div2 (n * (n + 1)) type family Div2 (n :: Nat) :: Nat where Div2 0 = 0 Div2 1 = 0 Div2 n = 1 + Div2 (n - 2) ------------------------------------------------------------------------------- -- Instances ------------------------------------------------------------------------------- instance HasStructuralInfo Bool where structuralInfo = ghcNominalType instance HasStructuralInfo Char where structuralInfo _ = NominalType "Char" instance HasStructuralInfo Int where structuralInfo _ = NominalType "Int" instance HasStructuralInfo Word where structuralInfo _ = NominalType "Word" instance HasStructuralInfo Integer where structuralInfo _ = NominalType "Integer" instance HasStructuralInfo Int8 where structuralInfo _ = NominalType "Int8" instance HasStructuralInfo Int16 where structuralInfo _ = NominalType "Int16" instance HasStructuralInfo Int32 where structuralInfo _ = NominalType "Int32" instance HasStructuralInfo Int64 where structuralInfo _ = NominalType "Int64" instance HasStructuralInfo Word8 where structuralInfo _ = NominalType "Word8" instance HasStructuralInfo Word16 where structuralInfo _ = NominalType "Word16" instance HasStructuralInfo Word32 where structuralInfo _ = NominalType "Word32" instance HasStructuralInfo Word64 where structuralInfo _ = NominalType "Word64" instance HasSemanticVersion Bool instance HasSemanticVersion Char instance HasSemanticVersion Int instance HasSemanticVersion Word instance HasSemanticVersion Integer instance HasSemanticVersion Int8 instance HasSemanticVersion Int16 instance HasSemanticVersion Int32 instance HasSemanticVersion Int64 instance HasSemanticVersion Word8 instance HasSemanticVersion Word16 instance HasSemanticVersion Word32 instance HasSemanticVersion Word64 -- | /Since binary-tagged-0.1.3.0/ instance HasStructuralInfo Ordering where structuralInfo = ghcNominalType -- | /Since binary-tagged-0.1.3.0/ instance HasSemanticVersion Ordering -- | /Since binary-tagged-0.1.3.0/ instance HasStructuralInfo Float where structuralInfo _ = NominalType "Float" -- | /Since binary-tagged-0.1.3.0/ instance HasStructuralInfo Double where structuralInfo _ = NominalType "Double" -- | /Since binary-tagged-0.1.3.0/ instance HasSemanticVersion Float -- | /Since binary-tagged-0.1.3.0/ instance HasSemanticVersion Double ------------------------------------------------------------------------------- -- Recursive types: List, NonEmpty ------------------------------------------------------------------------------- instance HasStructuralInfo a => HasStructuralInfo [a] where structuralInfo = ghcStructuralInfo1 instance HasSemanticVersion a => HasSemanticVersion [a] where type SemanticVersion [a] = SemanticVersion a instance HasStructuralInfo a => HasStructuralInfo (NE.NonEmpty a) where structuralInfo = ghcStructuralInfo1 instance HasSemanticVersion a => HasSemanticVersion (NE.NonEmpty a) where type SemanticVersion (NE.NonEmpty a) = SemanticVersion a ------------------------------------------------------------------------------- -- Basic types ------------------------------------------------------------------------------- instance HasStructuralInfo a => HasStructuralInfo (Maybe a) instance HasSemanticVersion a => HasSemanticVersion (Maybe a) where type SemanticVersion (Maybe a) = SemanticVersion a instance HasStructuralInfo a => HasStructuralInfo (Ratio.Ratio a) where structuralInfo _ = NominalNewtype "Ratio" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (Ratio.Ratio a) where type SemanticVersion (Ratio.Ratio a) = SemanticVersion a instance (HasStructuralInfo a, HasStructuralInfo b) => HasStructuralInfo (Either a b) instance (HasSemanticVersion a, HasSemanticVersion b, KnownNat (SemanticVersion (Either a b))) => HasSemanticVersion (Either a b) where type SemanticVersion (Either a b) = Interleave (SemanticVersion a) (SemanticVersion b) ------------------------------------------------------------------------------- -- tuples ------------------------------------------------------------------------------- instance (HasStructuralInfo a, HasStructuralInfo b) => HasStructuralInfo (a, b) instance (HasStructuralInfo a, HasStructuralInfo b, HasStructuralInfo c) => HasStructuralInfo (a, b, c) instance (HasStructuralInfo a, HasStructuralInfo b, HasStructuralInfo c, HasStructuralInfo d) => HasStructuralInfo (a, b, c, d) instance (HasSemanticVersion a ,HasSemanticVersion b ,KnownNat (SemanticVersion (a, b))) => HasSemanticVersion (a, b) where type SemanticVersion (a, b) = Interleave (SemanticVersion a) (SemanticVersion b) -- | /Since binary-tagged-0.1.3.0/ instance (HasSemanticVersion a ,HasSemanticVersion b ,HasSemanticVersion c ,KnownNat (SemanticVersion (a, b, c))) => HasSemanticVersion (a, b, c) where type SemanticVersion (a, b, c) = Interleave (SemanticVersion a) (SemanticVersion (b, c)) -- | /Since binary-tagged-0.1.3.0/ instance (HasSemanticVersion a ,HasSemanticVersion b ,HasSemanticVersion c ,HasSemanticVersion d ,KnownNat (SemanticVersion (a, b, c, d))) => HasSemanticVersion (a, b, c, d) where type SemanticVersion (a, b, c, d) = Interleave (SemanticVersion a) (SemanticVersion (b, c, d)) ------------------------------------------------------------------------------- -- Unit ------------------------------------------------------------------------------- -- | /Since binary-tagged-0.1.3.0/ instance HasStructuralInfo () where structuralInfo _ = NominalType "()" -- | /Since binary-tagged-0.1.3.0/ instance HasSemanticVersion () ------------------------------------------------------------------------------- -- Data.Fixed ------------------------------------------------------------------------------- -- | /Since binary-tagged-0.1.3.0/ instance HasStructuralInfo a => HasStructuralInfo (Fixed.Fixed a) where structuralInfo _ = StructuralInfo "Fixed" [[ structuralInfo (Proxy :: Proxy a) ]] instance HasStructuralInfo Fixed.E0 where structuralInfo _ = NominalType "E0" instance HasStructuralInfo Fixed.E1 where structuralInfo _ = NominalType "E1" instance HasStructuralInfo Fixed.E2 where structuralInfo _ = NominalType "E2" instance HasStructuralInfo Fixed.E3 where structuralInfo _ = NominalType "E3" instance HasStructuralInfo Fixed.E6 where structuralInfo _ = NominalType "E6" instance HasStructuralInfo Fixed.E9 where structuralInfo _ = NominalType "E9" instance HasStructuralInfo Fixed.E12 where structuralInfo _ = NominalType "E12" -- | /Since binary-tagged-0.1.3.0/ instance HasSemanticVersion (Fixed.Fixed a) ------------------------------------------------------------------------------- -- Data.Version ------------------------------------------------------------------------------- -- | /Since binary-tagged-0.1.3.0/ instance HasStructuralInfo Version.Version where structuralInfo _ = StructuralInfo "Version" [[ structuralInfo (Proxy :: Proxy [Int]) , structuralInfo (Proxy :: Proxy [String]) ]] -- Version has no Generic instance :( -- | /Since binary-tagged-0.1.3.0/ instance HasSemanticVersion Version.Version ------------------------------------------------------------------------------- -- Data.Monoid ------------------------------------------------------------------------------- instance HasStructuralInfo a => HasStructuralInfo (Monoid.Sum a) instance HasSemanticVersion a => HasSemanticVersion (Monoid.Sum a) where type SemanticVersion (Monoid.Sum a) = SemanticVersion a instance HasStructuralInfo a => HasStructuralInfo (Monoid.Product a) instance HasSemanticVersion a => HasSemanticVersion (Monoid.Product a) where type SemanticVersion (Monoid.Product a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Monoid.Dual a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Monoid.Dual a) where type SemanticVersion (Monoid.Dual a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Monoid.First a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Monoid.First a) where type SemanticVersion (Monoid.First a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Monoid.Last a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Monoid.Last a) where type SemanticVersion (Monoid.Last a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo Monoid.All -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion Monoid.All -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo Monoid.Any -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion Monoid.Any ------------------------------------------------------------------------------- -- semigroups ------------------------------------------------------------------------------- -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Semigroup.Min a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Semigroup.Min a) where type SemanticVersion (Semigroup.Min a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Semigroup.Max a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Semigroup.Max a) where type SemanticVersion (Semigroup.Max a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Semigroup.First a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Semigroup.First a) where type SemanticVersion (Semigroup.First a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Semigroup.Last a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Semigroup.Last a) where type SemanticVersion (Semigroup.Last a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Semigroup.WrappedMonoid a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Semigroup.WrappedMonoid a) where type SemanticVersion (Semigroup.WrappedMonoid a) = SemanticVersion a -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo a => HasStructuralInfo (Semigroup.Option a) -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion a => HasSemanticVersion (Semigroup.Option a) where type SemanticVersion (Semigroup.Option a) = SemanticVersion a ------------------------------------------------------------------------------- -- bytestring ------------------------------------------------------------------------------- instance HasStructuralInfo BS.ByteString where structuralInfo _ = NominalType "ByteString.Strict" instance HasStructuralInfo LBS.ByteString where structuralInfo _ = NominalType "ByteString.Lazy" instance HasSemanticVersion BS.ByteString instance HasSemanticVersion LBS.ByteString ------------------------------------------------------------------------------- -- nats ------------------------------------------------------------------------------- -- | /Since binary-tagged-0.1.4.0/ instance HasStructuralInfo Natural.Natural where structuralInfo _ = NominalType "Numeric.Natural" -- | /Since binary-tagged-0.1.4.0/ instance HasSemanticVersion Natural.Natural ------------------------------------------------------------------------------- -- text ------------------------------------------------------------------------------- instance HasStructuralInfo S.Text where structuralInfo _ = NominalType "Text.Strict" instance HasStructuralInfo L.Text where structuralInfo _ = NominalType "Text.Lazy" instance HasSemanticVersion S.Text instance HasSemanticVersion L.Text ------------------------------------------------------------------------------- -- containers ------------------------------------------------------------------------------- instance HasStructuralInfo a => HasStructuralInfo (IntMap.IntMap a) where structuralInfo _ = NominalNewtype "IntMap" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (IntMap.IntMap a) where type SemanticVersion (IntMap.IntMap a) = SemanticVersion a instance HasStructuralInfo IntSet.IntSet where structuralInfo _ = NominalType "IntSet" instance HasSemanticVersion IntSet.IntSet instance (HasStructuralInfo k, HasStructuralInfo v) => HasStructuralInfo (Map.Map k v) where structuralInfo _ = StructuralInfo "Map" [[ structuralInfo (Proxy :: Proxy k), structuralInfo (Proxy :: Proxy v) ]] instance (HasSemanticVersion k, HasSemanticVersion v, KnownNat (SemanticVersion (Map.Map k v))) => HasSemanticVersion (Map.Map k v) where type SemanticVersion (Map.Map k v) = Interleave (SemanticVersion k) (SemanticVersion v) instance HasStructuralInfo a => HasStructuralInfo (Seq.Seq a) where structuralInfo _ = NominalNewtype "Seq" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (Seq.Seq a) where type SemanticVersion (Seq.Seq a) = SemanticVersion a instance HasStructuralInfo a => HasStructuralInfo (Set.Set a) where structuralInfo _ = NominalNewtype "Set" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (Set.Set a) where type SemanticVersion (Set.Set a) = SemanticVersion a ------------------------------------------------------------------------------- -- unordered-containers ------------------------------------------------------------------------------- instance (HasStructuralInfo k, HasStructuralInfo v) => HasStructuralInfo (HML.HashMap k v) where structuralInfo _ = StructuralInfo "HashMap" [[ structuralInfo (Proxy :: Proxy k), structuralInfo (Proxy :: Proxy v) ]] instance (HasSemanticVersion k, HasSemanticVersion v, KnownNat (SemanticVersion (HML.HashMap k v))) => HasSemanticVersion (HML.HashMap k v) where type SemanticVersion (HML.HashMap k v) = Interleave (SemanticVersion k) (SemanticVersion v) instance HasStructuralInfo a => HasStructuralInfo (HS.HashSet a) where structuralInfo _ = NominalNewtype "HashSet" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (HS.HashSet a) where type SemanticVersion (HS.HashSet a) = SemanticVersion a ------------------------------------------------------------------------------- -- array ------------------------------------------------------------------------------- instance (HasStructuralInfo i, HasStructuralInfo e) => HasStructuralInfo (Array.Array i e) where structuralInfo _ = StructuralInfo "Array" [[ structuralInfo (Proxy :: Proxy i), structuralInfo (Proxy :: Proxy e) ]] instance (HasSemanticVersion i, HasSemanticVersion e, KnownNat (SemanticVersion (Array.Array i e))) => HasSemanticVersion (Array.Array i e) where type SemanticVersion (Array.Array i e) = Interleave (SemanticVersion i) (SemanticVersion e) instance (HasStructuralInfo i, HasStructuralInfo e) => HasStructuralInfo (Array.UArray i e) where structuralInfo _ = StructuralInfo "UArray" [[ structuralInfo (Proxy :: Proxy i), structuralInfo (Proxy :: Proxy e) ]] instance (HasSemanticVersion i, HasSemanticVersion e, KnownNat (SemanticVersion (Array.UArray i e))) => HasSemanticVersion (Array.UArray i e) where type SemanticVersion (Array.UArray i e) = Interleave (SemanticVersion i) (SemanticVersion e) ------------------------------------------------------------------------------- -- vector ------------------------------------------------------------------------------- instance HasStructuralInfo a => HasStructuralInfo (V.Vector a) where structuralInfo _ = NominalNewtype "Vector" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (V.Vector a) where type SemanticVersion (V.Vector a) = SemanticVersion a instance HasStructuralInfo a => HasStructuralInfo (U.Vector a) where structuralInfo _ = NominalNewtype "Vector.Unboxed" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (U.Vector a) where type SemanticVersion (U.Vector a) = SemanticVersion a instance HasStructuralInfo a => HasStructuralInfo (S.Vector a) where structuralInfo _ = NominalNewtype "Vector.Storable" $ structuralInfo (Proxy :: Proxy a) instance HasSemanticVersion a => HasSemanticVersion (S.Vector a) where type SemanticVersion (S.Vector a) = SemanticVersion a ------------------------------------------------------------------------------- -- time ------------------------------------------------------------------------------- instance HasStructuralInfo Time.UTCTime where structuralInfo _ = NominalType "UTCTime" instance HasStructuralInfo Time.DiffTime where structuralInfo _ = NominalType "DiffTime" instance HasStructuralInfo Time.UniversalTime where structuralInfo _ = NominalType "UniversalTime" instance HasStructuralInfo Time.NominalDiffTime where structuralInfo _ = NominalType "NominalDiffTime" instance HasStructuralInfo Time.Day where structuralInfo _ = NominalType "Day" instance HasStructuralInfo Time.TimeZone where structuralInfo _ = NominalType "TimeZone" instance HasStructuralInfo Time.TimeOfDay where structuralInfo _ = NominalType "TimeOfDay" instance HasStructuralInfo Time.LocalTime where structuralInfo _ = NominalType "LocalTime" instance HasSemanticVersion Time.UTCTime instance HasSemanticVersion Time.DiffTime instance HasSemanticVersion Time.UniversalTime instance HasSemanticVersion Time.NominalDiffTime instance HasSemanticVersion Time.Day instance HasSemanticVersion Time.TimeZone instance HasSemanticVersion Time.TimeOfDay instance HasSemanticVersion Time.LocalTime ------------------------------------------------------------------------------- -- aeson ------------------------------------------------------------------------------- #ifdef MIN_VERSION_aeson -- TODO: derive sop instance HasStructuralInfo Aeson.Value where structuralInfo _ = NominalType "Aeson.Value" instance HasSemanticVersion Aeson.Value #endif binary-tagged-0.1.4.1/test/0000755000000000000000000000000013002125632013527 5ustar0000000000000000binary-tagged-0.1.4.1/test/Generators.hs0000644000000000000000000000036513002125632016200 0ustar0000000000000000module Generators where import Data.Monoid import Test.Tasty.QuickCheck arbitrarySum :: Arbitrary a => Gen (Sum a) arbitrarySum = fmap Sum arbitrary arbitraryProduct :: Arbitrary a => Gen (Product a) arbitraryProduct = fmap Product arbitrary binary-tagged-0.1.4.1/test/Rec1.hs0000644000000000000000000000100413002125632014650 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} module Rec1 where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import Data.Binary.Orphans import Data.Binary.Tagged import Data.Monoid import GHC.Generics import Test.Tasty.QuickCheck import Generators data Rec = Rec (Sum Int) (Product Int) deriving (Eq, Show, Generic) instance Binary Rec instance HasStructuralInfo Rec instance HasSemanticVersion Rec instance Arbitrary Rec where arbitrary = Rec <$> arbitrarySum <*> arbitraryProduct binary-tagged-0.1.4.1/test/Rec2.hs0000644000000000000000000000100413002125632014651 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} module Rec2 where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import Data.Binary.Orphans import Data.Binary.Tagged import Data.Monoid import GHC.Generics import Test.Tasty.QuickCheck import Generators data Rec = Rec (Product Int) (Sum Int) deriving (Eq, Show, Generic) instance Binary Rec instance HasStructuralInfo Rec instance HasSemanticVersion Rec instance Arbitrary Rec where arbitrary = Rec <$> arbitraryProduct <*> arbitrarySum binary-tagged-0.1.4.1/test/Tests.hs0000644000000000000000000000577613002125632015204 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main (main) where import Data.Bifunctor import Data.Binary import Data.Binary.Tagged import Data.Either import Data.Monoid import Data.Proxy import Test.Tasty import Test.Tasty.QuickCheck import qualified Rec1 import qualified Rec2 main :: IO () main = defaultMain $ testGroup "Tests" [ roundtrips , wrongRoundtrips , failedRoundtrips , testProperty "Interleave" interleaveProp ] -- | We actually check that this compiles. interleaveProp :: Property interleaveProp = property $ once $ lhs === rhs where lhs :: Proxy 7 lhs = Proxy rhs :: Proxy (Interleave 2 1) rhs = Proxy instance Arbitrary a => Arbitrary (BinaryTagged v a) where arbitrary = fmap BinaryTagged arbitrary proxyRec1 :: Proxy Rec1.Rec proxyRec1 = Proxy proxyRec1Ver0 :: Proxy (BinaryTagged 0 Rec1.Rec) proxyRec1Ver0 = Proxy proxyRec1Ver1 :: Proxy (BinaryTagged 1 Rec1.Rec) proxyRec1Ver1 = Proxy proxyRec2 :: Proxy Rec2.Rec proxyRec2 = Proxy proxyRec2Ver0 :: Proxy (BinaryTagged 0 Rec2.Rec) proxyRec2Ver0 = Proxy proxyRec2Ver1 :: Proxy (BinaryTagged 1 Rec2.Rec) proxyRec2Ver1 = Proxy eqRec1Rec2 :: Rec1.Rec -> Rec2.Rec -> Bool eqRec1Rec2 (Rec1.Rec (Sum a) (Product b)) (Rec2.Rec (Product a') (Sum b')) = a == a' && b == b' roundtrips :: TestTree roundtrips = testGroup "Roundtrip" [ testProperty "Rec1" $ roundtrip proxyRec1 , testProperty "BinaryTagged 0 Rec1" $ roundtrip proxyRec1Ver0 , testProperty "BinaryTagged 1 Rec1" $ roundtrip proxyRec1Ver1 , testProperty "Rec2" $ roundtrip proxyRec2 , testProperty "BinaryTagged 0 Rec2" $ roundtrip proxyRec2Ver0 , testProperty "BinaryTagged 1 Rec2" $ roundtrip proxyRec2Ver1 ] wrongRoundtrips :: TestTree wrongRoundtrips = testGroup "Decode successful, data invalid" [ testProperty "Rec1 -> Rec2" $ wrongRoundtrip eqRec1Rec2 , testProperty "Rec2 -> Rec1" $ wrongRoundtrip eqRec1Rec2 ] failedRoundtrips :: TestTree failedRoundtrips = testGroup "Failed roundtrips" [ testProperty "Different version" $ failedRoundtrip proxyRec1Ver0 proxyRec1Ver1 , testProperty "Different structure" $ failedRoundtrip proxyRec1Ver0 proxyRec2Ver0 ] roundtrip :: (Eq a, Show a, Arbitrary a, Binary a) => Proxy a -> a -> Property roundtrip _ x = x === decode (encode x) wrongRoundtrip :: (Arbitrary a, Binary a, Binary b) => (a -> b -> Bool) -> a -> Property wrongRoundtrip eq x = property $ eq x $ decode (encode x) trdOf3 :: (a, b, c) -> c trdOf3 (_, _, c) = c isLeftProperty :: (Show a, Show b) => Either a b -> Property isLeftProperty x = counterexample ("not isLeft: " <> show x) (isLeft x) failedRoundtrip :: forall a b. (Arbitrary a, Binary a, Binary b, Show b) => Proxy a -> Proxy b -> a -> Property failedRoundtrip _ _ x = let x' = bimap trdOf3 trdOf3 $ decodeOrFail (encode x) :: Either String b in isLeftProperty x'