diff --git a/benchmark/CriterionOverview.hs b/benchmark/CriterionOverview.hs --- a/benchmark/CriterionOverview.hs +++ b/benchmark/CriterionOverview.hs @@ -23,10 +23,6 @@ value = Right (Left ("Lorem ipsum dolor sit amet, consectetur adipiscing elit.\ \ Nam vitae lacinia tellus. Maecenas posuere.")) --- | Pre-define encoding function so sharing can work properly -encodeTypedEncoder :: Complicated -> ByteString -encodeTypedEncoder = encodeTyped mode - -- Precalcualte encoded values for decoding benchmark value_encodedBinary, value_encodedTyped :: ByteString value_encodedBinary = encode value @@ -39,7 +35,6 @@ evaluate (value `deepseq` ()) evaluate (value_encodedBinary `deepseq` ()) evaluate (value_encodedTyped `deepseq` ()) - evaluate (encodeTypedEncoder `seq` ()) defaultMain [ bgroup "encode" bench_encode , bgroup "decode" bench_decode @@ -66,7 +61,7 @@ bench_encode_typed :: Benchmark bench_encode_typed = bench d (nf f value) where d = "Typed with " ++ show mode - f = encodeTypedEncoder + f = encodeTyped mode diff --git a/binary-typed.cabal b/binary-typed.cabal --- a/binary-typed.cabal +++ b/binary-typed.cabal @@ -1,5 +1,5 @@ name: binary-typed -version: 0.2.2 +version: 0.2.3 synopsis: Type-safe binary serialization Description: `Binary` serialization tagged with type information, allowing for @@ -14,10 +14,10 @@ * Error messages can provide details on type errors at the cost of longer message lengths to include the necessary information. . - * Serialization computationally almost as efficient as "Data.Binary" when - sharing type representations; decoding however is slower. - These values obviously depend a lot on the involved data and its type; - an example benchmark is shown in the picture below. + * Very small performance overhead compared to using standard `Binary` due + to caching when using hashed type information. Since shown and full + types are not cached, decoding them has a significant performance hit + (ballpark: factor of two). . * No depencency on @Internal@ modules of other libraries, and a very small dependency footprint in general. @@ -28,7 +28,7 @@ type @Either (Char, Int) (Either String (Maybe Integer))@ benchmarked using the @Hashed64@ type representation: . - <> + <> . homepage: https://github.com/quchen/binary-typed @@ -43,6 +43,7 @@ cabal-version: >= 1.10 tested-with: GHC == 7.8.2 extra-source-files: doc/*.png + , changelog.md source-repository head type: git @@ -56,7 +57,7 @@ ghc-options: -Wall hs-source-dirs: src other-extensions: GADTs, DeriveGeneric - build-depends: base >= 4.6 && < 5 + build-depends: base >= 4.7 && < 5 , binary >= 0.7 , bytestring >= 0.9 , murmur-hash >= 0.1 diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,53 @@ +`binary-typed` changelog +======================== + +## 0.1 + +### 0.1.0.0 + +Initial release. + +### 0.1.0.1 + +- Add testsuite to compare generated message lengths with vanilla `Binary` and + the various different typed serializations. +- The .cabal file is hopefully fixed so that Hackage is able to build the docs + automatically. + + + +## 0.2 + +### 0.2.0.0 + +- Add `Hashed32` type representation with 32 bit, more suitable for short data + than the previous `Hashed`, which was implicitly 64 bit long. `Hashed64` is + also available in case the longer hash is needed. +- Type representations are now automatically cached by `encodeTyped`. If this + data is long enough, it is even serialized in advance as well. + +### 0.2.0.1 + +- Fix whitespace in docs to make the docs build properly on Hackage, which + presumably has an older Haddock version + +### 0.2.1.0 + +- Fix sharing not working at all (bad `encodeTyped` implementation) +- Pre-calculate certain functions in the benchmarks so they can be properly + shared among invocations + +### 0.2.2 + +- Add `Hashed5` type representation that has no size overhead compared to + `Untyped` +- Add script to upload documentation to Hackage, since with the use of the new + `Typeable` GHC 7.6.3, which Hackage currently runs, cannot build the docs + itself. + +### 0.2.3 + +- Decoding now caches as well for `Hashed*` representations. This saves + recalculating the `TypeRep` of the expected type, which previously was the + bottleneck. Both encoding and decoding speeds are now very close to untyped + `Binary`. diff --git a/doc/bench-overview.png b/doc/bench-overview.png Binary files a/doc/bench-overview.png and b/doc/bench-overview.png differ diff --git a/src/Data/Binary/Typed.hs b/src/Data/Binary/Typed.hs --- a/src/Data/Binary/Typed.hs +++ b/src/Data/Binary/Typed.hs @@ -1,10 +1,14 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_HADDOCK show-extensions #-} + + + + + -- | Defines a type-safe 'Data.Binary.Binary' instance to ensure data is -- decoded with the type it was serialized from. -- -- For usage information, see the "Data.Binary.Typed.Tutorial" module. - -{-# LANGUAGE ScopedTypeVariables #-} - module Data.Binary.Typed ( -- * Core functions @@ -48,6 +52,7 @@ + -- | Modify the value contained in a 'Typed', keeping the same sort of type -- representation. In other words, calling 'mapTyped' on something that is -- typed using 'Hashed' will yield a 'Hashed' value again. @@ -101,8 +106,10 @@ where typeInfo = preserialize (makeTypeInformation format typerep) typerep = typeRep (Proxy :: Proxy a) +{-# INLINE encodeTyped #-} + encodeTypedLike :: (Typeable a, Binary a) => Typed a @@ -115,8 +122,8 @@ --- | Decode a typed value, throwing an error at runtime on failure. --- Typed cousin of 'Data.Binary.decode'. +-- | Decode a typed value, throwing a descriptive 'error' at runtime on failure. +-- Typed cousin of 'Data.Binary.decode'. Based on 'decodeTypedOrFail'. -- -- @ -- encoded = 'encodeTyped' 'Full' ("hello", 1 :: 'Int', 2.34 :: 'Double') @@ -124,36 +131,23 @@ -- -- \ -- 'unsafeDecodeTyped' encoded :: ('String', 'Int', 'Double') -- --- -- (Descriptive) runtime error +-- -- (Descriptive) runtime 'error' -- 'unsafeDecodeTyped' encoded :: ('Char', 'Int', 'Double') -- @ --- unsafeDecodeTyped :: (Typeable a, Binary a) => BSL.ByteString -> a -unsafeDecodeTyped = erase . decode - - +unsafeDecodeTyped = \x -> case decodeTypedOrFail x of + Left (_, _, err) -> error ("unsafeDecodeTyped' failure: " ++ err) + Right (_, _, value) -> value --- | Safely decode data, yielding 'Either' an error 'String' or the value, --- along with meta-information of the consumed binary data. --- --- * Typed cousin of 'Data.Binary.decodeOrFail'. --- --- * Like 'decodeTyped', but with additional data. --- -decodeTypedOrFail :: (Typeable a, Binary a) - => BSL.ByteString - -> Either (BSL.ByteString, ByteOffset, String) - (BSL.ByteString, ByteOffset, a) -decodeTypedOrFail input = case decodeOrFail input of - Right (rest, offset, value) -> Right (rest, offset, erase value) - Left l -> Left l +{-# INLINE unsafeDecodeTyped #-} -- | Safely decode data, yielding 'Either' an error 'String' or the value. -- Equivalent to 'decodeTypedOrFail' stripped of the non-essential data. +-- Based on 'decodeTypedOrFail'. -- -- @ -- encoded = 'encodeTyped' 'Full' ("hello", 1 :: 'Int', 2.34 :: 'Double') @@ -164,10 +158,45 @@ -- -- Left "Type error: expected (Char, Int, Double), got (String, Int, Double)" -- 'decodeTyped' encoded :: 'Either' 'String' ('Char', 'Int', 'Double') -- @ --- decodeTyped :: (Typeable a, Binary a) => BSL.ByteString -> Either String a -decodeTyped bs = case decodeTypedOrFail bs of - Left (_rest, _offset, err) -> Left err - Right (_rest, _offset, value) -> Right value +decodeTyped = \x -> case decodeTypedOrFail x of + Left (_, _, err) -> Left err + Right (_, _, value) -> Right value + +{-# INLINE decodeTyped #-} + + + +-- | Safely decode data, yielding 'Either' an error 'String' or the value, +-- along with meta-information of the consumed binary data. +-- +-- * Typed cousin of 'Data.Binary.decodeOrFail'. +-- +-- * Like 'decodeTyped', but with additional data. +-- +-- * Automatically caches 'Hashed5', 'Hashed32' and 'Hashed64' representations, +-- so that typechecking does not need to recalculate them on every decoding. +decodeTypedOrFail :: forall a. + (Typeable a, Binary a) + => BSL.ByteString + -> Either (BSL.ByteString, ByteOffset, String) + (BSL.ByteString, ByteOffset, a) +decodeTypedOrFail = \input -> do + (rest, offset, typed'@(Typed' ty value)) <- decodeOrFail input + let addMeta x = (rest, offset, x) + if isCached ty + then Right (addMeta value) -- cache hit, don't typecheck + else case typecheck' typed' of -- cache miss, typecheck manually + Left err -> Left (addMeta err) + Right _ -> Right (addMeta value) + + where + + exTypeRep = typeRep (Proxy :: Proxy a) + cache = map (\format -> makeTypeInformation format exTypeRep) + [Hashed5, Hashed32, Hashed64] -- List of formats to be cached + isCached = (`elem` cache) + +{-# INLINE decodeTypedOrFail #-} -- Inlining is crucial for caching to work! diff --git a/src/Data/Binary/Typed/Internal.hs b/src/Data/Binary/Typed/Internal.hs --- a/src/Data/Binary/Typed/Internal.hs +++ b/src/Data/Binary/Typed/Internal.hs @@ -1,8 +1,11 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} +{-# OPTIONS_HADDOCK show-extensions #-} + + -- | Internals, exposed mostly for potential use by testsuites and benchmarks. -- -- __Not recommended to be used from within other independent libraries.__ @@ -10,6 +13,7 @@ -- * 'Typed' Typed(..) + , Typed'(..) , TypeInformation(..) , Hash5(..) , mkHash5 @@ -20,6 +24,7 @@ , TypeFormat(..) , getFormat , typecheck + , typecheck' , erase , preserialize @@ -68,7 +73,8 @@ | Hashed64' Hash64 | Shown' Hash32 String | Full' TypeRep - | Cached' BSL.ByteString + | Cached' BSL.ByteString -- ^ Pre-serialized representation + -- of one of the other fields. deriving (Eq, Ord, Show, Generic) instance Binary TypeInformation where @@ -125,16 +131,16 @@ --- | A hash value of a 'TypeRep'. Currently a 5-bit value created using --- the MurmurHash2 algorithm. +-- | A 5-bit hash value. -- -- Since 'TypeInformation' needs 3 bit to store the sort of the -- 'TypeInformation', the remaining 5 bit per 'Word8' can be used to store a -- hash value at no additional space cost. For this reason, it is important that --- the three rightmost bits of any 'Hashed5' are set to zero. +-- the three rightmost bits of any 'Hashed5' are set to zero, i.e. @('.&.' 7)@ +-- is 'id' on the contained 'Word8'. -- -- This type intentionally doesn't have a 'Binary' instance, since its --- serialization is part of the 'TypeInformation' 'Binary' class exclusively. +-- serialization is part of the 'TypeInformation' 'Binary' instance exclusively. newtype Hash5 = Hash5 Word8 deriving (Eq, Ord, Show) @@ -146,16 +152,14 @@ --- | A hash value of a 'TypeRep'. Currently a 32-bit value created using --- the MurmurHash2 algorithm. +-- | A 32-bit hash value. newtype Hash32 = Hash32 Word32 deriving (Eq, Ord, Show, Generic) instance Binary Hash32 --- | A hash value of a 'TypeRep'. Currently a 64-bit value created using --- the MurmurHash2 algorithm. +-- | A 64-bit hash value. newtype Hash64 = Hash64 Word64 deriving (Eq, Ord, Show, Generic) instance Binary Hash64 @@ -169,7 +173,7 @@ -- construction of ill-typed 'Typed' data. Use the 'typed' smart -- constructor unless you really need 'Typed'. --- | \"typed \ \\" +-- | "typed \ \" instance Show a => Show (Typed a) where show (Typed ty x) = printf "typed %s (%s)" (show (getFormat ty)) @@ -179,13 +183,36 @@ -- confidence (depending on with what 'TypeFormat' the 'Typed' was -- constructed). instance (Binary a, Typeable a) => Binary (Typed a) where - get = do (ty, value) <- get + get = do -- Explicitly get both values instead of a (ty,value) tuple + -- in case Binary changes in the future. This ensures caching + -- in 'decodeTyped' can rely on the two values coming in + -- in this particular way. + ty <- get + value <- get either fail return (typecheck (Typed ty value)) -- NB: 'fail' is safe in Get Monad - put (Typed ty value) = put (ty, value) + put (Typed ty value) = put ty >> put value +-- | Like 'Typed', but the type information is not checked. Useful to read type +-- and value, and do the typechecking externally, as required by the caching +-- of 'Data.Binary.Typed.decodeTyped'. Using 'typecheck'', this can be promoted +-- to a proper 'Typed' value. +data Typed' a = Typed' TypeInformation a + +-- | "Typed' \ \" +instance Show a => Show (Typed' a) where + show (Typed' ty x) = printf "Typed' %s (%s)" + (show (getFormat ty)) + (show x) + +instance (Binary a) => Binary (Typed' a) where + get = liftA2 Typed' get get + put (Typed' ty value) = put ty >> put value + + + -- | Sometimes it can be beneficial to serialize the type information in -- advance, so that the maybe costly serialization step does not have to be -- repeated on every invocation of 'encode'. Preserialization comes at a price @@ -231,12 +258,11 @@ -- | Include no type information. -- - -- * Requires one byte more compared to using 'Binary' directly - -- (to tag the data as untyped, required for the decoding step). - -- - -- * Encoding and decoding require negligible amount of additional - -- computational cost compared to direct (intrinsically untyped) - -- 'Binary'. + -- * Requires one byte more compared to using 'Binary' directly + -- (to tag the data as untyped, required for the decoding step). + -- * Encoding and decoding require negligible amount of additional + -- computational cost compared to direct (intrinsically untyped) + -- 'Binary'. Untyped -- | Like 'Hashed32', but uses a 5-bit hash value. @@ -244,8 +270,7 @@ -- * Requires the same amount of space as 'Untyped', i.e. the only -- overhead compared to it is the computational cost to calculate -- the hash, which is almost identical to the one of 'Hashed32'. - -- - -- * Collisions occur with a probability of 1/2^5 = 1/32. For this + -- * Collisions occur with a probability of 1\/2^5 = 1\/32. For this -- reason, this format is only recommended when minimal data size -- is top priority. -- @@ -257,23 +282,18 @@ -- * Requires five bytes more compared to using 'Binary' directly for -- the type information (one to tag as 'Hashed32', four for the -- hash value) - -- -- * Subject to false positive due to hash collisions, although in -- practice this should almost never happen. - -- -- * Type errors cannot tell the provided type ("Expected X, received -- type with hash H") - -- -- * Computational cost similar to 'Hashed64'. | Hashed32 -- | Like 'Hashed32', but uses a 64-bit hash value. -- -- * Requires nine bytes more compared to using 'Binary'. - -- -- * Hash collisions are even less likely to occur than with -- 'Hashed32'. - -- -- * Computational cost similar to 'Hashed32'. | Hashed64 @@ -284,10 +304,8 @@ -- -- * Data size larger than 'Hashed32', but usually smaller than -- 'Full'. - -- -- * Both the hash and the shown type must match to satisfy the -- typechecker. - -- -- * Useful type errors ("expected X, received Y"). All types are -- shown unqualified though, making @Foo.X@ and @Bar.X@ look -- identical in error messages. Remember this when you get a @@ -296,9 +314,9 @@ -- | Compare the full representation of a data type. -- - -- * More verbose than 'Hashed' and 'Shown'. As a rule of thumb, - -- transmitted data is roughly the same as 'Shown', but all names - -- are fully qualified (package, module, type name). + -- * More verbose than 'Shown'. As a rule of thumb, transmitted data is + -- roughly the same as 'Shown', but all names are fully qualified + -- (package, module, type name). -- * Correct comparison (no false positives). An semi-exception here -- is when types change between package versions: -- @package-1.0 Foo.X@ and @package-1.1 Foo.X@ count as the same @@ -319,7 +337,7 @@ -- -- @ -- value = 'typed' 'Full' ("hello", 1 :: 'Int', 2.34 :: 'Double') --- encded = 'encode' value +-- encoded = 'encode' value -- @ -- -- The decode site can now verify whether decoding happens with the right type. @@ -329,7 +347,7 @@ -- | Create the 'TypeInformation' to be stored inside a 'Typed' value from --- a 'Ty.TypeRep'. +-- a 'Ty.TypeRep'. makeTypeInformation :: TypeFormat -> Ty.TypeRep -> TypeInformation makeTypeInformation format ty = case format of Untyped -> Untyped' @@ -358,7 +376,7 @@ -- | Typecheck a 'Typed'. Returns the (well-typed) input, or an error message --- if the types don't work out. +-- if the types don't work out. typecheck :: Typeable a => Typed a -> Either String (Typed a) typecheck ty@(Typed typeInformation x) = case typeInformation of Cached' cache -> decode' cache >>= \ty' -> typecheck (Typed ty' x) @@ -394,6 +412,12 @@ decode' bs = case decodeOrFail bs of Left (_,_,err) -> Left ("Cache error! " ++ err) Right (_,_,val) -> Right val + + + +-- | Typecheck a 'Typed\'' value so it can be used as a safe 'Typed' value. +typecheck' :: Typeable a => Typed' a -> Either String (Typed a) +typecheck' (Typed' ty value) = typecheck (Typed ty value) diff --git a/src/Data/Binary/Typed/Tutorial.hs b/src/Data/Binary/Typed/Tutorial.hs --- a/src/Data/Binary/Typed/Tutorial.hs +++ b/src/Data/Binary/Typed/Tutorial.hs @@ -77,9 +77,8 @@ -- encoding can be used, with minimal overhead compared to using 'Binary' -- directly. -- --- For convenience, this module exports a couple of convenience functions that --- have the type-mangling baked in already. The above example could have been --- written as +-- This module exports a couple of convenience functions that have the +-- type-mangling baked in already. The above example could have been written as -- -- @ -- test3 = let val = 10 :: 'Int'