exinst 0.3 → 0.3.0.1
raw patch · 5 files changed
+160/−48 lines, 5 filesdep +binarydep +bytestringdep +cerealdep −generic-randomdep ~bytesPVP ok
version bump matches the API change (PVP)
Dependencies added: binary, bytestring, cereal
Dependencies removed: generic-random
Dependency ranges changed: bytes
API changes (from Hackage documentation)
Files
- CHANGELOG.md +11/−0
- exinst.cabal +7/−5
- src/lib/Exinst.hs +3/−6
- src/lib/Exinst/Instances/Bytes.hs +57/−0
- tests/Main.hs +82/−37
CHANGELOG.md view
@@ -1,3 +1,14 @@+# Version 0.3.0.1++* Removed dependency on `generic-random`.++* Correctly deal with cabal flags for `deepseq` and `hashable`.++* Add `binary`'s `Data.Binary.Binary` and `cereal`'s `Data.Serialize.Serialize`+ instances for `Some{1,2,3,4}`. These instances are compatible with each other+ and rely on the `Data.Bytes.Serial` instances.++ # Version 0.3 * BREAKING: Renamed module `Exinst.Singletons` to `Exinst`.
exinst.cabal view
@@ -1,5 +1,5 @@ name: exinst-version: 0.3+version: 0.3.0.1 author: Renzo Carbonara maintainer: renzoλcarbonara.com.ar copyright: Renzo Carbonara 2015-2017@@ -9,7 +9,7 @@ category: Data build-type: Simple cabal-version: >=1.18-synopsis: Derive instances for your existential types.+synopsis: Recover instances for your existential types. homepage: https://github.com/k0001/exinst bug-reports: https://github.com/k0001/exinst/issues @@ -34,7 +34,7 @@ build-depends: aeson other-modules: Exinst.Instances.Aeson if flag(bytes)- build-depends: bytes >=0.15 && <0.16+ build-depends: bytes >=0.15, binary, cereal other-modules: Exinst.Instances.Bytes if flag(deepseq) build-depends: deepseq@@ -55,11 +55,13 @@ build-depends: aeson , base+ , binary , bytes+ , bytestring+ , cereal , constraints , deepseq , exinst- , generic-random >=0.4 , hashable , profunctors , QuickCheck@@ -74,7 +76,7 @@ default: True manual: True flag bytes- description: Provide instances for @bytes@+ description: Provide instances for @bytes@, @binary@ and @cereal@. default: True manual: True flag deepseq
src/lib/Exinst.hs view
@@ -53,6 +53,7 @@ import Data.Constraint (Constraint, Dict(Dict)) import Exinst.Internal+import Exinst.Instances.Base () #ifdef VERSION_aeson import Exinst.Instances.Aeson ()@@ -62,15 +63,11 @@ import Exinst.Instances.Bytes () #endif -#ifdef VERSION_bytes-import Exinst.Instances.Base ()-#endif--#ifdef VERSION_bytes+#ifdef VERSION_deepseq import Exinst.Instances.DeepSeq () #endif -#ifdef VERSION_bytes+#ifdef VERSION_hashable import Exinst.Instances.Hashable () #endif
src/lib/Exinst/Instances/Bytes.hs view
@@ -14,6 +14,8 @@ module Exinst.Instances.Bytes () where import qualified Data.Bytes.Serial as By+import qualified Data.Binary as Bin+import qualified Data.Serialize as Cer import Data.Constraint import Data.Singletons import Prelude@@ -116,3 +118,58 @@ case dict4 sa4 sa3 sa2 sa1 :: Dict (By.Serial (f4 a4 a3 a2 a1)) of Dict -> do x :: f4 a4 a3 a2 a1 <- By.deserialize return (some4 x)++--------------------------------------------------------------------------------+-- Binary++instance By.Serial (Some1 f) => Bin.Binary (Some1 f) where+ {-# INLINE put #-}+ put = By.serialize+ {-# INLINE get #-}+ get = By.deserialize++instance By.Serial (Some2 f) => Bin.Binary (Some2 f) where+ {-# INLINE put #-}+ put = By.serialize+ {-# INLINE get #-}+ get = By.deserialize++instance By.Serial (Some3 f) => Bin.Binary (Some3 f) where+ {-# INLINE put #-}+ put = By.serialize+ {-# INLINE get #-}+ get = By.deserialize++instance By.Serial (Some4 f) => Bin.Binary (Some4 f) where+ {-# INLINE put #-}+ put = By.serialize+ {-# INLINE get #-}+ get = By.deserialize++--------------------------------------------------------------------------------+-- Cereal++instance By.Serial (Some1 f) => Cer.Serialize (Some1 f) where+ {-# INLINE put #-}+ put = By.serialize+ {-# INLINE get #-}+ get = By.deserialize++instance By.Serial (Some2 f) => Cer.Serialize (Some2 f) where+ {-# INLINE put #-}+ put = By.serialize+ {-# INLINE get #-}+ get = By.deserialize++instance By.Serial (Some3 f) => Cer.Serialize (Some3 f) where+ {-# INLINE put #-}+ put = By.serialize+ {-# INLINE get #-}+ get = By.deserialize++instance By.Serial (Some4 f) => Cer.Serialize (Some4 f) where+ {-# INLINE put #-}+ put = By.serialize+ {-# INLINE get #-}+ get = By.deserialize+
tests/Main.hs view
@@ -10,13 +10,15 @@ import Control.DeepSeq (NFData(rnf)) import qualified Data.Aeson as Aeson+import qualified Data.Binary as Bin+import qualified Data.ByteString.Lazy as BSL import qualified Data.Bytes.Get as Bytes import qualified Data.Bytes.Put as Bytes import qualified Data.Bytes.Serial as Bytes+import qualified Data.Serialize as Cer import Data.Hashable (Hashable(hash)) import Data.Kind (Type) import Data.Proxy (Proxy)-import Generic.Random.Generic (genericArbitrary, uniform) import qualified GHC.Generics as G import qualified Test.Tasty as Tasty import qualified Test.Tasty.Runners as Tasty@@ -43,13 +45,16 @@ [ tt_id "Identity through GHC's Generic" id_generic , tt_id "Identity through Aeson's FromJSON/ToJSON" id_aeson , tt_id "Identity through Bytes's Serial" id_bytes+ , tt_id "Identity from Cereal's Serialize to Binary's Binary" id_cereal_to_binary+ , tt_id "Identity from Binary's Binary to Cereal's Serialize" id_binary_to_cereal , tt_nfdata ] tt_id :: String -> (forall a.- ( G.Generic a, Aeson.FromJSON a, Aeson.ToJSON a, Bytes.Serial a+ ( G.Generic a, Aeson.FromJSON a, Aeson.ToJSON a+ , Bytes.Serial a, Bin.Binary a, Cer.Serialize a ) => a -> Maybe a ) -- ^ It's easier to put all the constraints here. -> Tasty.TestTree@@ -98,11 +103,22 @@ id_bytes :: Bytes.Serial a => a -> Maybe a id_bytes = \a ->- let bs = Bytes.runPutS (Bytes.serialize a)- in case Bytes.runGetS Bytes.deserialize bs of- Left _ -> Nothing- Right a' -> Just a'+ case Bytes.runGetS Bytes.deserialize (Bytes.runPutS (Bytes.serialize a)) of+ Left _ -> Nothing+ Right a' -> Just a' +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++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+ -------------------------------------------------------------------------------- data family Foo1 :: Bool -> Type@@ -146,37 +162,66 @@ -------------------------------------------------------------------------------- -- Arbitrary instances -instance QC.Arbitrary (Foo1 'False) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo1 'True) where arbitrary = genericArbitrary uniform--instance QC.Arbitrary (Foo2 'False 'False) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo2 'False 'True) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo2 'True 'False) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo2 'True 'True) where arbitrary = genericArbitrary uniform+instance QC.Arbitrary (Foo1 'False) where+ arbitrary = QC.oneof [ pure F1, F2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo1 'True) where+ arbitrary = QC.oneof [ pure T1, T2 <$> QC.arbitrary ] -instance QC.Arbitrary (Foo3 'False 'False 'False) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo3 'False 'False 'True) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo3 'False 'True 'False) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo3 'False 'True 'True) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo3 'True 'False 'False) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo3 'True 'False 'True) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo3 'True 'True 'False) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo3 'True 'True 'True) where arbitrary = genericArbitrary uniform+instance QC.Arbitrary (Foo2 'False 'False) where+ arbitrary = QC.oneof [ pure FF1, FF2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo2 'False 'True) where+ arbitrary = QC.oneof [ pure FT1, FT2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo2 'True 'False) where+ arbitrary = QC.oneof [ pure TF1, TF2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo2 'True 'True) where+ arbitrary = QC.oneof [ pure TT1, TT2 <$> QC.arbitrary ] -instance QC.Arbitrary (Foo4 'False 'False 'False 'False) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo4 'False 'False 'False 'True) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo4 'False 'False 'True 'False) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo4 'False 'False 'True 'True) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo4 'False 'True 'False 'False) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo4 'False 'True 'False 'True) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo4 'False 'True 'True 'False) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo4 'False 'True 'True 'True) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo4 'True 'False 'False 'False) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo4 'True 'False 'False 'True) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo4 'True 'False 'True 'False) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo4 'True 'False 'True 'True) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo4 'True 'True 'False 'False) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo4 'True 'True 'False 'True) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo4 'True 'True 'True 'False) where arbitrary = genericArbitrary uniform-instance QC.Arbitrary (Foo4 'True 'True 'True 'True) where arbitrary = genericArbitrary uniform+instance QC.Arbitrary (Foo3 'False 'False 'False) where+ arbitrary = QC.oneof [ pure FFF1, FFF2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo3 'False 'False 'True) where+ arbitrary = QC.oneof [ pure FFT1, FFT2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo3 'False 'True 'False) where+ arbitrary = QC.oneof [ pure FTF1, FTF2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo3 'False 'True 'True) where+ arbitrary = QC.oneof [ pure FTT1, FTT2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo3 'True 'False 'False) where+ arbitrary = QC.oneof [ pure TFF1, TFF2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo3 'True 'False 'True) where+ arbitrary = QC.oneof [ pure TFT1, TFT2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo3 'True 'True 'False) where+ arbitrary = QC.oneof [ pure TTF1, TTF2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo3 'True 'True 'True) where+ arbitrary = QC.oneof [ pure TTT1, TTT2 <$> QC.arbitrary ] +instance QC.Arbitrary (Foo4 'False 'False 'False 'False) where+ arbitrary = QC.oneof [ pure FFFF1, FFFF2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo4 'False 'False 'False 'True) where+ arbitrary = QC.oneof [ pure FFFT1, FFFT2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo4 'False 'False 'True 'False) where+ arbitrary = QC.oneof [ pure FFTF1, FFTF2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo4 'False 'False 'True 'True) where+ arbitrary = QC.oneof [ pure FFTT1, FFTT2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo4 'False 'True 'False 'False) where+ arbitrary = QC.oneof [ pure FTFF1, FTFF2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo4 'False 'True 'False 'True) where+ arbitrary = QC.oneof [ pure FTFT1, FTFT2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo4 'False 'True 'True 'False) where+ arbitrary = QC.oneof [ pure FTTF1, FTTF2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo4 'False 'True 'True 'True) where+ arbitrary = QC.oneof [ pure FTTT1, FTTT2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo4 'True 'False 'False 'False) where+ arbitrary = QC.oneof [ pure TFFF1, TFFF2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo4 'True 'False 'False 'True) where+ arbitrary = QC.oneof [ pure TFFT1, TFFT2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo4 'True 'False 'True 'False) where+ arbitrary = QC.oneof [ pure TFTF1, TFTF2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo4 'True 'False 'True 'True) where+ arbitrary = QC.oneof [ pure TFTT1, TFTT2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo4 'True 'True 'False 'False) where+ arbitrary = QC.oneof [ pure TTFF1, TTFF2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo4 'True 'True 'False 'True) where+ arbitrary = QC.oneof [ pure TTFT1, TTFT2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo4 'True 'True 'True 'False) where+ arbitrary = QC.oneof [ pure TTTF1, TTTF2 <$> QC.arbitrary ]+instance QC.Arbitrary (Foo4 'True 'True 'True 'True) where+ arbitrary = QC.oneof [ pure TTTT1, TTTT2 <$> QC.arbitrary ]