tagged-binary (empty) → 0.1.0.0

raw patch · 5 files changed

+268/−0 lines, 5 filesdep +basedep +binarydep +bytestringsetup-changed

Dependencies added: base, binary, bytestring, data-default, spoon

Files

• Data/Binary/Tagged.hs +92/−0
• Data/Binary/Tagged/Internal.hs +108/−0
• LICENSE +7/−0
• Setup.hs +2/−0
• tagged-binary.cabal +59/−0

@@ -0,0 +1,92 @@+-- |+-- Module      : Data.Binary.Tagged+-- Copyright   : (c) Justin Le 2014+-- License     : MIT+--+-- Maintainer  : justin@jle.im+-- Stability   : stable+-- Portability : portable+--+-- Provides tools for serializing and decoding data into 'ByteString'+-- tagged with information about its type.  Really, most of this should be+-- used by libraries and frameworks and abstracted over.  Typical use cases+-- are the polymorphic communication channels in distributed computing used+-- by Cloud Haskell and distributed-process --- data of any type can come+-- through the channel, and the framework can chose to ignore, queue, or+-- accept data depending on the type the data is tagged with.  Designed to+-- work with cross-platform GHC backends like ghcjs.+--+-- When decoding data, the result is polymorphic, and you should either+-- allow GHC to infer what you want somehow somewhere, or specify it+-- explicitly.+--+-- Quick example:+--+-- > > let x = encodeTagged (1 :: Int)+-- > > decodeTagged x :: Maybe Bool+-- > Nothing+-- > > decodeTagged x :: Maybe Int+-- > Just 1+--+-- Also provided here is the internal 'TagFingerprint' data type, so that+-- you can categorize, sort, and queue 'Tagged' or 'ByteString' based on+-- the types they represent.+--+-- It might be significant to note that the current 'TagFingerprint'+-- implementation is a little shaky; it's a bit tricky getting all GHC+-- platforms to agree on a meaningful 'TypeRep' serialization, and we will+-- have a better implementation eventually.  For now, it just uses string+-- name of the type as an identifier.  So for now, don't encode/decode+-- things with the same type name but exist in different modules+-- ('Data.Text.Text' or 'Data.Text.Lazy.Text', for example) through the+-- same polymorphic channel! This is a bit limiting, admittedly, but until+-- I or the backend maintainers find out a way to ensure that type+-- fingerprints match up per backend, be aware of this limitation.+--++module Data.Binary.Tagged (+    -- * Encoding and decoding tagged data+    encodeTagged    -- :: (Binary a, Typeable a) => a -> ByteString+  , decodeTagged    -- :: (Binary a, Typeable a) => ByteString -> Maybe a+  , bsFingerprint   -- :: ByteString -> Maybe TagFingerprint+    -- * Fingerprint utilities+  , TagFingerprint  -- abstract, instances: Show, Eq, Ord, Binary, Typeable, Generic, Default+  , typeFingerprint -- :: Typeable a => a -> TagFingerprint+  ) where++import Control.Spoon                 (teaspoon)+import Data.Binary+import Data.Binary.Tagged.Internal+import Data.ByteString.Lazy+import Data.Typeable.Internal++-- | Encode data into a 'ByteString' with its type data tagged.+--+-- Remember that for now, types are distinguished by their string names, so+-- two types of the same name in different modules will not have unique+-- tags.+encodeTagged :: (Binary a, Typeable a) => a -> ByteString+encodeTagged = encode . tag++-- | Decode tagged data from a 'ByteString'.  The return type is+-- polymorphic, so it'll attempt to decode it by inferred or specified+-- type.+--+--  * If the data is not decoded, @Nothing@ is returned.+--+--  * If successfully decoded data is tagged with a 'Fingerprint' not+--  matching the desired type, @Nothing@ is also returned.+--+--  * If the data is successfully decoded *and* the tagged 'Fingerprint'+--  matches the desired type, @Just x@ is returned, where @x@ is the+--  originally encoded data (with its tag stripped).+decodeTagged :: (Binary a, Typeable a) => ByteString -> Maybe a+decodeTagged bs = teaspoon =<< getTagged (decode bs)++-- | With a 'ByteString', expecting tagged data, returns the 'Fingerprint'+-- that the data is tagged with.  Returns @Nothing@ if the data is not+-- decodable as tagged data.  Might accidentally decode untagged data+-- though!+bsFingerprint :: ByteString -> Maybe TagFingerprint+bsFingerprint bs = teaspoon $ tagFingerprint (decode bs :: Tagged ())+

@@ -0,0 +1,108 @@+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE DeriveDataTypeable #-}++-- |+-- Module      : Data.Binary.Tagged.Internal+-- Copyright   : (c) Justin Le 2014+-- License     : MIT+--+-- Maintainer  : justin@jle.im+-- Stability   : stable+-- Portability : portable+--+-- Internals for the library, exported in case you should need it.+-- Usually, the parts you would need should be re-exported in+-- 'Data.Binary.Tagged'.+--++module Data.Binary.Tagged.Internal (+    -- * Data types+    Tagged          -- abstract, instances: Show, Eq, Binary, Typeable, Generic+  , TagFingerprint  -- abstract, instances: Show, Eq, Ord, Binary, Typeable, Generic, Default+    -- * Tagging and extracting data+  , tag             -- :: Typeable a => a -> Tagged a+  , getTagged       -- :: Typeable a => Tagged a -> Maybe a+  , tagMatched      -- :: Typeable a => Tagged a -> Bool+    -- * 'TagFingerprint' utilities+  , typeFingerprint -- :: Typeable a => a -> TagFingerprint+  , tagFingerprint  -- :: Tagged a -> TagFingerprint+  ) where++import Data.Binary+import Data.Default+import Data.ByteString.Lazy+import Data.ByteString.Lazy.Char8 as LC+import Data.Maybe             (isJust)+import Data.Typeable.Internal+import GHC.Generics+++-- | A data type tupling together data with a 'TagFingerprint',+-- representing data tagged with its type.  You really should never have to+-- use this type; it's best to interface directly with data using+-- 'encodeTagged', 'decodeTagged', etc.  Use 'tag' to tag data and+-- 'extractTagged' to extract data from valid tagged data.+data Tagged a = Tagged !TagFingerprint a+                deriving (Show, Eq, Generic, Typeable)++-- | A data type representing a fingerprint for a 'Typeable' type.+-- Ideally, this would be 'Data.Typeable.Internal''s own 'Fingerprint'+-- types; however, for some reason, the fingerprints for the same data type+-- from the same modules differ between different GHC backends.  So for+-- now, it is just a 'ByteString' representation of the name of the type.+-- This is literally a bad idea, and so two types with the same name but+-- from different modules will share a non-unique 'TagFingerprint'.+-- Hopefully in the future when I find out a way to fix this or the GHC+-- backend maintainers find a way to provide consistent type fingerprints,+-- this will be fixed.+--+-- This type is mostly used for the ability to categorized Tagged items+-- by their type.+--+-- There is a 'Default' instance, because the constructor is hidden.  For+-- now, it is just an empty 'ByteString', but when fingerprinting works for+-- real, think of it as a way to generate a fingerprint that will most+-- likely not be matched by any type, in case the need ever comes up.+newtype TagFingerprint = TagFP ByteString+                         deriving (Show, Typeable, Generic, Eq, Ord)++instance Binary a => Binary (Tagged a)+instance Binary TagFingerprint++instance Default TagFingerprint where+  def = TagFP empty++-- | Wrap data inside a 'Tagged' tuple.+tag :: Typeable a => a -> Tagged a+tag x = Tagged (typeFingerprint x) x++-- | Compute the 'Fingerprint' representing a type.  It is non-strict on+-- its parameter, so passing in undefined should work if you want to just+-- get the 'Fingerprint' of a specific type without having data of that+-- type on hand:+--+-- > typeFingerprint (undefined :: Int)+--+typeFingerprint :: Typeable a => a -> TagFingerprint+typeFingerprint = TagFP . LC.pack . show . typeOf++-- | Extract data out of a 'Tagged', but only the type of the data matches+-- the type represented by the fingerprint.  It is polymorphic on its+-- output and meant to be used when decoding a 'Tagged' item with a desired+-- type.+getTagged :: Typeable a => Tagged a -> Maybe a+getTagged (Tagged tfp x) | tfp == xfp = Just x+                         | otherwise  = Nothing+  where+    xfp = typeFingerprint x++-- | Check if the type inside the 'Tagged' matches the fingerprint.+tagMatched :: Typeable a => Tagged a -> Bool+tagMatched = isJust . getTagged++-- | Extract the 'Fingerprint' out of a 'Tagged'.  Mostly used so that you+-- can categorize and associate Tagged items; to check if a 'Tagged' is+-- of a desired typed, 'getTagged' and 'tagMatched' might be more useful.+tagFingerprint :: Tagged a -> TagFingerprint+tagFingerprint (Tagged fp _) = fp+

@@ -0,0 +1,7 @@+Copyright (c) 2014 Justin Le++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,59 @@+name:                tagged-binary+version:             0.1.0.0+synopsis:            Provides tools for serializing data tagged with type+                     information.+description:         Very minimal library providing tools for serializing and+                     decoding data into 'ByteString' tagged with information+                     about its type, inspired by Cloud Haskell and+                     distributed-process.+                     .+                     Intended for use by libraries and frameworks in+                     distributed contexts, such as distributed computation+                     between native servers and communication between native+                     servers and ghcjs/various front-ends, for behavior+                     similar to the polymorphic communication channels of+                     Cloud Haskell and distributed-process; servers can send+                     tagged data, and clients can choose to selectively+                     accept, ignore or queue incoming messages depending on+                     their types.+                     .+                     For basic encoding, decoding and categorization, only+                     'Data.Binary.Tagged' should be necessary.+                     'Data.Binary.Tagged.Internal' is exported in case you+                     need it.+                     .+                     Quick example:+                     .+                     > > let x = encodeTagged (1 :: Int)+                     > > decodeTagged x :: Maybe Bool+                     > Nothing+                     > > decodeTagged x :: Maybe Int+                     > Just 1++license:             MIT+license-file:        LICENSE+author:              Justin Le <justin@jle.im>+maintainer:          Justin Le <justin@jle.im>+copyright:           Copyright (c) Justin Le 2014+category:            Data, Serialization +build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++source-repository head+  type:     git+  location: https://github.com/mstksg/tagged-binary++library+  exposed-modules:     Data.Binary.Tagged+                     , Data.Binary.Tagged.Internal+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base >=4.6 && <5+                     , binary >=0.7.1.0 && <0.8+                     , bytestring >=0.10.4.0 && <0.11+                     , data-default >=0.5.3 && <0.6+                     , spoon >=0.3.1 && <0.4+  -- hs-source-dirs:      +  default-language:    Haskell2010+  ghc-options:         -Wall