diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,15 @@ +- 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 diff --git a/binary-tagged.cabal b/binary-tagged.cabal --- a/binary-tagged.cabal +++ b/binary-tagged.cabal @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: binary-tagged -version: 0.1.1.0 +version: 0.1.2.0 synopsis: Tagged binary serialisation. description: Check category: Web @@ -18,6 +18,7 @@ cabal-version: >= 1.10 extra-source-files: + CHANGELOG.md README.md source-repository head @@ -33,7 +34,7 @@ , generics-sop >=0.1 && <0.2 , SHA >=1.6 && <1.7 , array >=0.5 && <0.6 - , aeson >=0.8 && <0.10 + , aeson >=0.8 && <0.11 , binary >=0.7 && <0.8 , bytestring >=0.10 && <0.11 , containers >=0.5 && <0.6 @@ -59,7 +60,7 @@ , generics-sop >=0.1 && <0.2 , SHA >=1.6 && <1.7 , array >=0.5 && <0.6 - , aeson >=0.8 && <0.10 + , aeson >=0.8 && <0.11 , binary >=0.7 && <0.8 , bytestring >=0.10 && <0.11 , containers >=0.5 && <0.6 @@ -93,7 +94,7 @@ , generics-sop >=0.1 && <0.2 , SHA >=1.6 && <1.7 , array >=0.5 && <0.6 - , aeson >=0.8 && <0.10 + , aeson >=0.8 && <0.11 , binary >=0.7 && <0.8 , bytestring >=0.10 && <0.11 , containers >=0.5 && <0.6 diff --git a/src/Data/Binary/Tagged.hs b/src/Data/Binary/Tagged.hs --- a/src/Data/Binary/Tagged.hs +++ b/src/Data/Binary/Tagged.hs @@ -72,6 +72,7 @@ -- ** Type level calculations Interleave, SumUpTo, + Div2, -- * Generic derivation -- ** GHC ghcStructuralInfo, @@ -111,25 +112,27 @@ import GHC.TypeLits -- Instances -import qualified Data.Vector as V -import qualified Data.Aeson as Aeson -import qualified Data.Monoid as Monoid import Data.Int -import qualified Data.Text as S -import qualified Data.Text.Lazy as L +import qualified Data.Aeson as Aeson 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.Map as Map +import qualified Data.Monoid as Monoid import qualified Data.Ratio as Ratio import qualified Data.Sequence as Seq import qualified Data.Set as Set -import qualified Data.HashSet as HS -import qualified Data.HashMap.Lazy as HML +import qualified Data.Text as S +import qualified Data.Text.Lazy as L import qualified Data.Time as Time -import qualified Data.Vector.Unboxed as U +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 -- | 'Binary' serialisable class, which tries to be less error-prone to data structure changes. @@ -331,7 +334,11 @@ -- -- 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) = n * (n - 1) +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 @@ -367,6 +374,24 @@ 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 instance HasStructuralInfo a => HasStructuralInfo [a] where structuralInfo = ghcStructuralInfo1 instance HasSemanticVersion a => HasSemanticVersion [a] where @@ -390,6 +415,63 @@ 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 () + +-- 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) + +-- 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 -- Monoid instance HasStructuralInfo a => HasStructuralInfo (Monoid.Sum a) diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -21,7 +21,16 @@ [ 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