diff --git a/benchmark/CriterionOverview.hs b/benchmark/CriterionOverview.hs --- a/benchmark/CriterionOverview.hs +++ b/benchmark/CriterionOverview.hs @@ -23,6 +23,10 @@ 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 @@ -32,7 +36,11 @@ main :: IO () main = do - evaluate (value `deepseq` ()) + evaluate (value `deepseq` ()) + evaluate (value_encodedBinary `deepseq` ()) + evaluate (value_encodedTyped `deepseq` ()) + evaluate (encodeTypedEncoder `seq` ()) + defaultMain [ bgroup "encode" bench_encode , bgroup "decode" bench_decode , bgroup "encode+decode" bench_both @@ -58,9 +66,7 @@ bench_encode_typed :: Benchmark bench_encode_typed = bench d (nf f value) where d = "Typed with " ++ show mode - f = encodeTyped mode - - + f = encodeTypedEncoder 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.0.1 +version: 0.2.1.0 synopsis: Type-safe binary serialization Description: `Binary` serialization tagged with type information, allowing for @@ -15,7 +15,7 @@ longer message lengths to include the necessary information. . * Serialization computationally almost as efficient as "Data.Binary" when - precaching type representations; decoding however is slower. + 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. . @@ -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 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 @@ -3,6 +3,9 @@ -- -- For usage information, see the "Data.Binary.Typed.Tutorial" module. +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_HADDOCK show-extensions #-} + module Data.Binary.Typed ( -- * Core functions @@ -36,7 +39,7 @@ import qualified Data.ByteString.Lazy as BSL -import Data.Typeable (Typeable, typeOf) +import Data.Typeable (Typeable, typeRep, Proxy(..)) import Data.Binary import Data.Binary.Get (ByteOffset) @@ -90,13 +93,14 @@ -- information related calculations in advance and shares the results between -- future invocations of it, making it much more efficient to serialize many -- values of the same type. -encodeTyped :: (Typeable a, Binary a) +encodeTyped :: forall a. + (Typeable a, Binary a) => TypeFormat -> a -> BSL.ByteString -encodeTyped format = \x -> - let ty = preserialize (makeTypeInformation format (typeOf x)) - in encode (Typed ty x) +encodeTyped format = \x -> encode (Typed typeInfo x) + where typeInfo = preserialize (makeTypeInformation format typerep) + typerep = typeRep (Proxy :: Proxy a) @@ -108,7 +112,7 @@ encodeTypedLike (Typed ty _) = encodeTyped (getFormat ty) {-# DEPRECATED encodeTypedLike - "'encodeTyped' now caches automatically for all types" #-} + "'encodeTyped' now caches automatically for all types. Will be removed in 0.3." #-} @@ -124,6 +128,7 @@ -- -- (Descriptive) runtime error -- 'unsafeDecodeTyped' encoded :: ('Char', 'Int', 'Double') -- @ +-- unsafeDecodeTyped :: (Typeable a, Binary a) => BSL.ByteString -> a @@ -137,6 +142,7 @@ -- * Typed cousin of 'Data.Binary.decodeOrFail'. -- -- * Like 'decodeTyped', but with additional data. +-- decodeTypedOrFail :: (Typeable a, Binary a) => BSL.ByteString -> Either (BSL.ByteString, ByteOffset, String) @@ -159,6 +165,7 @@ -- -- 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 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,4 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} +{-# OPTIONS_HADDOCK show-extensions #-} @@ -56,11 +57,11 @@ -- recipient can do consistency checks. See 'TypeFormat' for more detailed -- information on the fields. data TypeInformation = Untyped' - | Hashed32' Hash32 - | Hashed64' Hash64 - | Shown' Hash32 String - | Full' TypeRep - | Cached' BSL.ByteString + | Hashed32' Hash32 + | Hashed64' Hash64 + | Shown' Hash32 String + | Full' TypeRep + | Cached' BSL.ByteString deriving (Eq, Ord, Show, Generic) instance Binary TypeInformation @@ -73,12 +74,12 @@ -- well-formed. In the public API, this is safe to do, since only well-typed -- 'Typed' values can be created in the first place. getFormat :: TypeInformation -> TypeFormat -getFormat (Untyped' {}) = Untyped -getFormat (Hashed32' {}) = Hashed32 -getFormat (Hashed64' {}) = Hashed64 -getFormat (Shown' {}) = Shown -getFormat (Full' {}) = Full -getFormat (Cached' bs) = getFormat (decode bs) +getFormat (Untyped' {}) = Untyped +getFormat (Hashed32' {}) = Hashed32 +getFormat (Hashed64' {}) = Hashed64 +getFormat (Shown' {}) = Shown +getFormat (Full' {}) = Full +getFormat (Cached' bs) = getFormat (decode bs) @@ -105,7 +106,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)) @@ -137,15 +138,15 @@ -- Used to make 'Data.Binary.Typed.encodeTyped' more efficient; the source -- there also makes a good usage example. preserialize :: TypeInformation -> TypeInformation -preserialize x@(Cached' _) = x -preserialize x@(Untyped' ) = x -preserialize x@(Hashed32' _) = x -preserialize x@(Hashed64' _) = x +preserialize x@(Cached' {}) = x +preserialize x@(Untyped' {}) = x +preserialize x@(Hashed32' {}) = x +preserialize x@(Hashed64' {}) = x -- Explicit cases for Shown' and Full' so exhaustiveness can be checked when -- new constructors are added. (The default pattern of just "x" would do right -- now as well, but not provide that.) -preserialize x@(Shown' _ _) = preserialize' x -preserialize x@(Full' _) = preserialize' x +preserialize x@(Shown' {}) = preserialize' x +preserialize x@(Full' {}) = preserialize' x @@ -168,6 +169,10 @@ -- -- * 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 -- | Compare types by their hash values (using the MurmurHash2 @@ -182,6 +187,8 @@ -- -- * 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. @@ -190,6 +197,8 @@ -- -- * Hash collisions are even less likely to occur than with -- 'Hashed32'. + -- + -- * Computational cost similar to 'Hashed32'. | Hashed64 -- | Compare 'String' representation of types, obtained by calling @@ -247,11 +256,11 @@ -- a 'Ty.TypeRep'. makeTypeInformation :: TypeFormat -> Ty.TypeRep -> TypeInformation makeTypeInformation format ty = case format of - Untyped -> Untyped' - Hashed32 -> Hashed32' (hashType32 ty) - Hashed64 -> Hashed64' (hashType64 ty) - Shown -> Shown' (hashType32 ty) (show ty) - Full -> Full' (stripTypeRep ty) + Untyped -> Untyped' + Hashed32 -> Hashed32' (hashType32 ty) + Hashed64 -> Hashed64' (hashType64 ty) + Shown -> Shown' (hashType32 ty) (show ty) + Full -> Full' (stripTypeRep ty) @@ -276,9 +285,9 @@ 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) - Full' full | exFull /= full -> Left (fullError full) - Hashed32' hash32 | exHash32 /= hash32 -> Left (hashError exHash32 hash32) - Hashed64' hash64 | exHash64 /= hash64 -> Left (hashError exHash64 hash64) + Full' full | exFull /= full -> Left (fullError full) + Hashed32' hash32 | exHash32 /= hash32 -> Left (hashError exHash32 hash32) + Hashed64' hash64 | exHash64 /= hash64 -> Left (hashError exHash64 hash64) Shown' hash32 str | (exHash32, exShow) /= (hash32, str) -> Left (shownError hash32 str) _no_type_error -> Right ty 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 @@ -117,21 +117,30 @@ -- The core definitions in "Data.Binary.Typed" are: -- -- * 'Typed' (the main type) +-- -- * 'typed' (construct 'Typed' values) +-- -- * 'TypeFormat' (a helper type for 'typed') +-- -- * 'erase' (deconstruct 'Typed' vales) -- -- In addition to those, a couple of useful helper functions with more efficient -- implementation than what the core definitions could offer: -- -- * 'mapTyped' (change values contained in 'Typed's) +-- -- * 'reValue' (change value, but don't recompute type representation) +-- -- * 'reType' (change type representation, but keep value) +-- -- * 'preserialize' (compute serialized type representation and cache it, useful as an optimization) -- -- Lastly, there are a number of encoding/decoding functions: -- -- * 'encodeTyped' (pack in 'Typed' and then 'encode', but more efficient) +-- -- * 'decodeTyped' (decode 'Typed' 'Data.ByteString.Lazy.ByteString' to @'Either' 'String' a@) +-- -- * 'decodeTypedOrFail' (like 'decodeTyped', but with more meta information) +-- -- * 'unsafeDecodeTyped' (which throws a runtime error on type mismatch)