diff --git a/msgpack/Data/MessagePack/Pack.hs b/msgpack/Data/MessagePack/Pack.hs index c08c52c..3134d97 100644 --- a/msgpack/Data/MessagePack/Pack.hs +++ b/msgpack/Data/MessagePack/Pack.hs @@ -19,6 +19,11 @@ module Data.MessagePack.Pack ( Packable(..), -- * Simple function to pack a Haskell value pack, + -- * Packing primitives + fromString, + fromArray, + fromPair, + fromMap, ) where import Blaze.ByteString.Builder @@ -106,24 +111,29 @@ cast :: (Storable a, Storable b) => a -> b cast v = SIU.unsafePerformIO $ with v $ peek . castPtr instance Packable String where - from = fromString encodeUtf8 B.length fromByteString + from = fromString B.length fromByteString . encodeUtf8 instance Packable B.ByteString where - from = fromString id B.length fromByteString + from = fromString B.length fromByteString instance Packable BL.ByteString where - from = fromString id (fromIntegral . BL.length) fromLazyByteString + from = fromString (fromIntegral . BL.length) fromLazyByteString instance Packable T.Text where - from = fromString T.encodeUtf8 B.length fromByteString + from = fromString B.length fromByteString . T.encodeUtf8 instance Packable TL.Text where - from = fromString TL.encodeUtf8 (fromIntegral . BL.length) fromLazyByteString + from = fromString (fromIntegral . BL.length) fromLazyByteString . TL.encodeUtf8 -fromString :: (s -> t) -> (t -> Int) -> (t -> Builder) -> s -> Builder -fromString cnv lf pf str = - let bs = cnv str in - case lf bs of +-- | @fromString lengthFun packFun array@: +-- Transforms an string-like structure (e.g. String, Text) into +-- a MessagePack string. +-- +-- `lengthFun` specifies how to obtain the length of the structure, +-- `packFun` how to pack it. +fromString :: (s -> Int) -> (s -> Builder) -> s -> Builder +fromString lf pf str = + case lf str of len | len <= 31 -> fromWord8 $ 0xA0 .|. fromIntegral len len | len < 0x10000 -> @@ -132,7 +142,7 @@ fromString cnv lf pf str = len -> fromWord8 0xDB <> fromWord32be (fromIntegral len) - <> pf bs + <> pf str instance Packable a => Packable [a] where from = fromArray length (Monoid.mconcat . map from) @@ -172,6 +182,12 @@ instance (Packable a1, Packable a2, Packable a3, Packable a4, Packable a5, Packa from = fromArray (const 9) f where f (a1, a2, a3, a4, a5, a6, a7, a8, a9) = from a1 <> from a2 <> from a3 <> from a4 <> from a5 <> from a6 <> from a7 <> from a8 <> from a9 +-- | @fromArray lengthFun packFun array@: +-- Transforms an array-like structure (e.g. tuple, list) into +-- a MessagePack array. +-- +-- `lengthFun` specifies how to obtain the length of the structure, +-- `packFun` how to pack it. fromArray :: (a -> Int) -> (a -> Builder) -> a -> Builder fromArray lf pf arr = do case lf arr of @@ -200,9 +216,16 @@ instance Packable v => Packable (IM.IntMap v) where instance (Packable k, Packable v) => Packable (HM.HashMap k v) where from = fromMap HM.size (Monoid.mconcat . map fromPair . HM.toList) +-- | Transforms tuple into a MessagePack pair. fromPair :: (Packable a, Packable b) => (a, b) -> Builder fromPair (a, b) = from a <> from b +-- | @fromMap lengthFun packFun array@: +-- Transforms an map-like structure (e.g. Map, HashMap) into +-- a MessagePack map. +-- +-- `lengthFun` specifies how to obtain the length of the structure, +-- `packFun` how to pack it. fromMap :: (a -> Int) -> (a -> Builder) -> a -> Builder fromMap lf pf m = case lf m of diff --git a/msgpack/Data/MessagePack/Unpack.hs b/msgpack/Data/MessagePack/Unpack.hs index 4a157b3..404de42 100644 --- a/msgpack/Data/MessagePack/Unpack.hs +++ b/msgpack/Data/MessagePack/Unpack.hs @@ -21,6 +21,18 @@ module Data.MessagePack.Unpack( -- * Simple function to unpack a Haskell value unpack, tryUnpack, + -- * Unpacking primitives + parseString, + parseArray, + parsePair, + parseMap, + parseUint16, + parseUint32, + parseUint64, + parseInt8, + parseInt16, + parseInt32, + parseInt64, -- * Unpack exception UnpackError(..), -- * ByteString utils @@ -58,7 +70,9 @@ class Unpackable a where -- | Deserialize a value get :: A.Parser a +-- | Things that can be converted to a strict 'B.ByteString' class IsByteString s where + -- | Convert a value to a strict 'B.ByteString' toBS :: s -> B.ByteString instance IsByteString B.ByteString where @@ -176,6 +190,9 @@ instance Unpackable T.Text where instance Unpackable TL.Text where get = parseString (\n -> return . TL.decodeUtf8With skipChar . toLBS =<< A.take n) +-- | Parses a MessagePack string into a user-specified data structure. +-- The function argument, given the size of the string encoded in the message, +-- specifies what the string shall be parsed to (e.g. a String or Text). parseString :: (Int -> A.Parser a) -> A.Parser a parseString aget = do c <- A.anyWord8 @@ -235,6 +252,9 @@ instance (Unpackable a1, Unpackable a2, Unpackable a3, Unpackable a4, Unpackable f 9 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> get >>= \a4 -> get >>= \a5 -> get >>= \a6 -> get >>= \a7 -> get >>= \a8 -> get >>= \a9 -> return (a1, a2, a3, a4, a5, a6, a7, a8, a9) f n = fail $ printf "wrong tuple size: expected 9 but got %d" n +-- | Parses a MessagePack array into a user-specified data structure. +-- The function argument, given the size of the array encoded in the message, +-- specifies what the array shall be parsed to (e.g. a List or Tuple). parseArray :: (Int -> A.Parser a) -> A.Parser a parseArray aget = do c <- A.anyWord8 @@ -263,12 +283,16 @@ instance Unpackable v => Unpackable (IM.IntMap v) where instance (Hashable k, Eq k, Unpackable k, Unpackable v) => Unpackable (HM.HashMap k v) where get = parseMap (\n -> HM.fromList <$> replicateM n parsePair) +-- | Parses a MessagePack pair into a tuple. parsePair :: (Unpackable k, Unpackable v) => A.Parser (k, v) parsePair = do a <- get b <- get return (a, b) +-- | Parses a MessagePack map into a user-specified data structure. +-- The function argument, given the size of the map encoded in the message, +-- specifies what the map shall be parsed to (e.g. a Map or HashMap). parseMap :: (Int -> A.Parser a) -> A.Parser a parseMap aget = do c <- A.anyWord8 @@ -288,12 +312,14 @@ instance Unpackable a => Unpackable (Maybe a) where [ liftM Just get , liftM (\() -> Nothing) get ] +-- | Parses a 16-bit unsigned integer from the message. parseUint16 :: A.Parser Word16 parseUint16 = do b0 <- A.anyWord8 b1 <- A.anyWord8 return $ (fromIntegral b0 `shiftL` 8) .|. fromIntegral b1 +-- | Parses a 32-bit unsigned integer from the message. parseUint32 :: A.Parser Word32 parseUint32 = do b0 <- A.anyWord8 @@ -305,6 +331,7 @@ parseUint32 = do (fromIntegral b2 `shiftL` 8) .|. fromIntegral b3 +-- | Parses a 64-bit unsigned integer from the message. parseUint64 :: A.Parser Word64 parseUint64 = do b0 <- A.anyWord8 @@ -324,14 +351,18 @@ parseUint64 = do (fromIntegral b6 `shiftL` 8) .|. fromIntegral b7 +-- | Parses a 8-bit signed integer from the message. parseInt8 :: A.Parser Int8 parseInt8 = return . fromIntegral =<< A.anyWord8 +-- | Parses a 16-bit signed integer from the message. parseInt16 :: A.Parser Int16 parseInt16 = return . fromIntegral =<< parseUint16 +-- | Parses a 32-bit signed integer from the message. parseInt32 :: A.Parser Int32 parseInt32 = return . fromIntegral =<< parseUint32 +-- | Parses a 64-bit signed integer from the message. parseInt64 :: A.Parser Int64 parseInt64 = return . fromIntegral =<< parseUint64