summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorphadej <>2019-05-14 11:30:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-05-14 11:30:00 (GMT)
commitb584def45ee951abcabcbac7f877c6c5c63864e7 (patch)
tree538a1ea6973eb70f66454c9b59a7d53e734fb8f0
parent6f84318d94175981febb2b2d6b0af1410aad140d (diff)
version 0.2HEAD0.2master
-rwxr-xr-xCHANGELOG.md4
-rwxr-xr-xREADME.md34
-rw-r--r--bench/Bench.hs3
-rw-r--r--binary-tagged.cabal204
-rw-r--r--src/Data/Binary/Tagged.hs129
-rw-r--r--test/Rec1.hs3
-rw-r--r--test/Rec2.hs3
-rw-r--r--test/Tests.hs13
8 files changed, 203 insertions, 190 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 5f33c5f..3041dcd 100755
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,7 @@
+- 0.2 (2019-05-14)
+ - use cryptohash-sha1,
+ types of structuralInfoSha1Digest and structuralInfoSha1Digest are changed.
+ - Use binary-instances in tests
- 0.1.5.2 (2019-05-10)
- generics-sop-0.5
- 0.1.5.1 (2018-09-24)
diff --git a/README.md b/README.md
deleted file mode 100755
index dec3215..0000000
--- a/README.md
+++ /dev/null
@@ -1,34 +0,0 @@
-# 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).
diff --git a/bench/Bench.hs b/bench/Bench.hs
index fdbf226..99a6e61 100644
--- a/bench/Bench.hs
+++ b/bench/Bench.hs
@@ -3,7 +3,8 @@ module Main (main) where
import Control.DeepSeq
import Data.ByteString.Lazy as LBS
-import Data.Binary.Orphans
+import Data.Binary
+import Data.Binary.Instances ()
import Data.Binary.Tagged
import Criterion.Main
import qualified Data.HashMap.Strict as HM
diff --git a/binary-tagged.cabal b/binary-tagged.cabal
index 21b3b33..fa577e7 100644
--- a/binary-tagged.cabal
+++ b/binary-tagged.cabal
@@ -1,141 +1,171 @@
-cabal-version: >= 1.10
-name: binary-tagged
-version: 0.1.5.2
-
-synopsis: Tagged binary serialisation.
-category: Data
-description: Check <https://github.com/phadej/binary-tagged#readme README on Github>
-
-homepage: https://github.com/phadej/binary-tagged#readme
-bug-reports: https://github.com/phadej/binary-tagged/issues
-author: Oleg Grenrus <oleg.grenrus@iki.fi>
-maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>
-license: BSD3
-license-file: LICENSE
-build-type: Simple
+cabal-version: >=1.10
+name: binary-tagged
+version: 0.2
+synopsis: Tagged binary serialisation.
+category: Data
+description:
+ 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.
+ .
+ The overhead is next to non-observable, see [a simple benchmark](https://github.com/phadej/binary-tagged/blob/master/bench/Bench.hs).
+ .
+ @
+ benchmarking encode/Binary
+ time 362.6 μs (361.2 μs .. 363.8 μs)
+ .
+ benchmarking encode/Tagged
+ time 379.2 μs (375.5 μs .. 382.2 μs)
+ .
+ benchmarking decode/Binary
+ time 366.3 μs (365.1 μs .. 368.1 μs)
+ .
+ benchmarking decode/Tagged
+ time 367.6 μs (367.0 μs .. 368.2 μs)
+ @
+homepage: https://github.com/phadej/binary-tagged#readme
+bug-reports: https://github.com/phadej/binary-tagged/issues
+author: Oleg Grenrus <oleg.grenrus@iki.fi>
+maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>
+license: BSD3
+license-file: LICENSE
+build-type: Simple
tested-with:
- GHC ==7.8.4
- || ==7.10.3
- || ==8.0.2
- || ==8.2.2
- || ==8.4.4
- || ==8.6.5
+ GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1
extra-source-files:
- CHANGELOG.md
- README.md
+ CHANGELOG.md
source-repository head
- type: git
+ type: git
location: https://github.com/phadej/binary-tagged
library
- hs-source-dirs:
- src
- ghc-options: -Wall
+ hs-source-dirs: src
+ ghc-options: -Wall
-- Libraries bundled with GHC
build-depends:
- base >=4.7.0.2 && <4.13
- , array >=0.5.0.0 && <0.6
- , binary >=0.7.1.0 && <0.10
- , bytestring >=0.10.4.0 && <0.11
- , containers >=0.5.5.1 && <0.7
- , text >=1.2.3.0 && <1.3
- , time >=1.4.2 && <1.9
+ array >=0.5.0.0 && <0.6
+ , base >=4.7.0.2 && <4.13
+ , binary >=0.7.1.0 && <0.10
+ , bytestring >=0.10.4.0 && <0.11
+ , containers >=0.5.5.1 && <0.7
+ , text >=1.2.3.0 && <1.3
+ , time >=1.4.2 && <1.9
-- other dependencies
build-depends:
- aeson >=0.8 && <1.5
- , base16-bytestring >=0.1.1.6 && <0.2
- , generics-sop >=0.3.2.0 && <0.6
- , hashable >=1.2 && <1.4
- , scientific >=0.3 && <0.4
- , SHA >=1.6 && <1.7
- , tagged >=0.7 && <0.9
- , unordered-containers >=0.2 && <0.3
- , vector >=0.10 && <0.13
-
- exposed-modules:
- Data.Binary.Tagged
+ aeson >=0.8 && <1.5
+ , base16-bytestring >=0.1.1.6 && <0.2
+ , cryptohash-sha1 >=0.11.100.1 && <0.12
+ , generics-sop >=0.3.2.0 && <0.6
+ , hashable >=1.2 && <1.4
+ , scientific >=0.3 && <0.4
+ , tagged >=0.7 && <0.9
+ , unordered-containers >=0.2 && <0.3
+ , vector >=0.10 && <0.13
+
+ exposed-modules: Data.Binary.Tagged
default-language: Haskell2010
- if !impl(ghc >= 8.0)
- build-depends:
- semigroups >=0.18.5 && <0.20
- if !impl(ghc >= 7.10)
- build-depends:
- nats >=1.1.2 && <1.2
+ if !impl(ghc >=8.0)
+ build-depends: semigroups >=0.18.5 && <0.20
+
+ if !impl(ghc >=7.10)
+ build-depends: nats >=1.1.2 && <1.2
test-suite binary-tagged-test
- type: exitcode-stdio-1.0
- main-is: Tests.hs
- hs-source-dirs:
- test
- ghc-options: -Wall
+ type: exitcode-stdio-1.0
+ main-is: Tests.hs
+ hs-source-dirs: test
+ ghc-options: -Wall
build-depends:
- base
- , aeson
+ aeson
, array
+ , base
, base16-bytestring
+ , bifunctors
, binary
+ , binary-instances >=1 && <1.1
+ , binary-tagged
, bytestring
, containers
, generics-sop
, hashable
+ , quickcheck-instances
, scientific
- , SHA
, tagged
+ , tasty
+ , tasty-quickcheck
+ , tasty-hunit
, text
, time
, unordered-containers
, vector
- , binary-tagged
- , binary-orphans
- , bifunctors
- , quickcheck-instances
- , tasty
- , tasty-quickcheck
- if !impl(ghc >= 8.0)
- build-depends:
- semigroups
- if !impl(ghc >= 7.10)
- build-depends:
- nats
+
+ if !impl(ghc >=8.0)
+ build-depends: semigroups
+
+ if !impl(ghc >=7.10)
+ build-depends: nats
+
other-modules:
- Generators
- Rec1
- Rec2
+ 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
+ type: exitcode-stdio-1.0
+ main-is: Bench.hs
+ hs-source-dirs: bench
+ ghc-options: -Wall
build-depends:
- base
- , aeson
+ aeson
, array
+ , base
, base16-bytestring
, binary
+ , binary-instances
+ , binary-tagged
, bytestring
, containers
+ , criterion
+ , deepseq
, generics-sop
, hashable
, nats
, scientific
- , SHA
, semigroups
+ , SHA
, tagged
, text
, time
, unordered-containers
, vector
- , binary-tagged
- , binary-orphans
- , deepseq
- , criterion
+
default-language: Haskell2010
diff --git a/src/Data/Binary/Tagged.hs b/src/Data/Binary/Tagged.hs
index f5729e3..afaa3c5 100644
--- a/src/Data/Binary/Tagged.hs
+++ b/src/Data/Binary/Tagged.hs
@@ -1,25 +1,25 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# 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 #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
-- We need this for Interleave
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Binary.Tagged
@@ -93,60 +93,60 @@ module Data.Binary.Tagged
import Control.Applicative
import Control.Monad
+import qualified Crypto.Hash.SHA1 as SHA1
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
+import Data.Binary.Get (ByteOffset)
+import Data.ByteString as BS
+import qualified Data.ByteString.Base16 as Base16
+import Data.ByteString.Lazy as LBS
+import Data.Monoid ((<>))
+import Data.Typeable (Typeable)
+import Generics.SOP as SOP
import Generics.SOP.Constraint as SOP
+import Generics.SOP.GGP as SOP
#if !MIN_VERSION_base(4,8,0)
-import Data.Foldable (Foldable)
-import Data.Traversable (Traversable)
+import Data.Foldable (Foldable)
+import Data.Traversable (Traversable)
#endif
-import qualified GHC.Generics as GHC
+import qualified GHC.Generics as GHC
import GHC.TypeLits
-- Instances
+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 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
+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
+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)
+ deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable, GHC.Generic, GHC.Generic1, Typeable)
-- TODO: Derive Enum, Bounded, Typeable, Data, Hashable, NFData, Numeric classes?
type BinaryTagged' a = BinaryTagged (SemanticVersion a) a
@@ -229,13 +229,13 @@ instance (Binary a, HasStructuralInfo a, KnownNat v) => Binary (BinaryTagged v a
proxyV = Proxy :: Proxy v
proxyA = Proxy :: Proxy a
ver' = fromIntegral (natVal proxyV) :: Version
- hash' = bytestringDigest . structuralInfoSha1Digest . structuralInfo $ proxyA
+ hash' = 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)
+ deriving (Eq, Ord, Show, GHC.Generic, Typeable)
instance Binary StructuralInfo
@@ -274,11 +274,12 @@ class KnownNat (SemanticVersion a) => HasSemanticVersion (a :: *) where
instance HasStructuralInfo StructuralInfo
instance HasSemanticVersion StructuralInfo
-structuralInfoSha1Digest :: StructuralInfo -> Digest SHA1State
-structuralInfoSha1Digest = sha1 . encode
+structuralInfoSha1Digest :: StructuralInfo -> BS.ByteString
+structuralInfoSha1Digest = SHA1.hashlazy . encode
-structuralInfoSha1ByteStringDigest :: StructuralInfo -> LBS.ByteString
-structuralInfoSha1ByteStringDigest = bytestringDigest . structuralInfoSha1Digest
+{-# DEPRECATED structuralInfoSha1ByteStringDigest "Use structuralInfoSha1Digest directly" #-}
+structuralInfoSha1ByteStringDigest :: StructuralInfo -> BS.ByteString
+structuralInfoSha1ByteStringDigest = structuralInfoSha1Digest
-------------------------------------------------------------------------------
-- Generics
@@ -319,8 +320,8 @@ sopNominalAdtPOP :: (All2 HasStructuralInfo xss) => POP Proxy xss -> [[Structura
sopNominalAdtPOP (POP np2) = sopNominalAdt np2
sopNominalAdt :: (All2 HasStructuralInfo xss) => NP (NP Proxy) xss -> [[StructuralInfo]]
-sopNominalAdt Nil = []
-sopNominalAdt (p :* ps) = sopStructuralInfoP p : sopNominalAdt ps
+sopNominalAdt Nil = []
+sopNominalAdt (p :* ps) = sopStructuralInfoP p : sopNominalAdt ps
sopStructuralInfoP :: (All HasStructuralInfo xs) => NP Proxy xs -> [StructuralInfo]
sopStructuralInfoP Nil = []
diff --git a/test/Rec1.hs b/test/Rec1.hs
index 717c1d3..f2cd236 100644
--- a/test/Rec1.hs
+++ b/test/Rec1.hs
@@ -6,7 +6,8 @@ module Rec1 where
import Control.Applicative
#endif
-import Data.Binary.Orphans
+import Data.Binary
+import Data.Binary.Instances ()
import Data.Binary.Tagged
import Data.Monoid
import GHC.Generics
diff --git a/test/Rec2.hs b/test/Rec2.hs
index 62dcef2..36d705e 100644
--- a/test/Rec2.hs
+++ b/test/Rec2.hs
@@ -6,7 +6,8 @@ module Rec2 where
import Control.Applicative
#endif
-import Data.Binary.Orphans
+import Data.Binary
+import Data.Binary.Instances ()
import Data.Binary.Tagged
import Data.Monoid
import GHC.Generics
diff --git a/test/Tests.hs b/test/Tests.hs
index a46a491..fd40d20 100644
--- a/test/Tests.hs
+++ b/test/Tests.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main (main) where
@@ -11,8 +11,12 @@ import Data.Either
import Data.Monoid
import Data.Proxy
import Test.Tasty
+import Test.Tasty.HUnit (testCase, (@?=))
import Test.Tasty.QuickCheck
+import qualified Data.ByteString.Base16 as Base16
+import qualified Data.ByteString.Char8 as BS8
+
import qualified Rec1
import qualified Rec2
@@ -22,6 +26,11 @@ main = defaultMain $ testGroup "Tests"
, wrongRoundtrips
, failedRoundtrips
, testProperty "Interleave" interleaveProp
+ , testCase "An example hash" $ do
+ let hash = structuralInfoSha1Digest
+ $ structuralInfo (Proxy :: Proxy [Either (Maybe Char) (Sum Int)])
+
+ Base16.encode hash @?= BS8.pack "acff3d40f6f06f87b4da8d3d3eb5682251867cc5"
]
-- | We actually check that this compiles.