msgpack-arbitrary 0.1.1 → 0.1.2

raw patch · 2 files changed

+83/−1 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• msgpack-arbitrary.cabal +2/−1
• src/Test/MessagePack/Parser.hs +81/−0

@@ -1,5 +1,5 @@ name:                 msgpack-arbitrary-version:              0.1.1+version:              0.1.2 synopsis:             A Haskell implementation of MessagePack. homepage:             http://msgpack.org/ license:              BSD3@@ -32,6 +32,7 @@   exposed-modules:       Data.MessagePack.Arbitrary       Test.MessagePack.Generate+      Test.MessagePack.Parser       Test.QuickCheck.Instances.MessagePack   build-depends:       base                      < 5

@@ -0,0 +1,81 @@+{-# LANGUAGE Safe #-}+-- | A MessagePack parser.+--+-- Example usage:+--   $ echo -ne "\x94\x01\xa1\x32\xa1\x33\xa4\x50\x6f\x6f\x66" | ./msgpack-parser+-- or+--   $ echo 'ObjectArray [ObjectInt 97, ObjectStr "test",  ObjectBool True]' | ./msgpack-parser+--+-- This tool performs two symmetrical functions:+--   1. It can decode binary data representing a+--      Data.MessagePack.Object into a human-readable string.+--   2. It can do the reverse: encode a human-readable string into+--      a binary representation of Data.MessagePack.Object.+--+-- No flags are required as it automatically detects which of these+-- two functions it should perform.  This is done by first assuming+-- the input is human readable.  If it fails to parse it, it then+-- considers it as binary data.+--+-- Therefore, given a valid input, the tool has the following property+--   $ ./msgpack-parser < input.bin | ./msgpack-parser+-- will output back the contents of input.bin.+--+-- In case the input is impossible to parse, nothing is output.+--+-- Known bugs:+--   - If no input is given, the tool exits with+--     "Data.Binary.Get.runGet at position 0: not enough bytes"+--   - The tool does not check that all the input is parsed.+--     Therefore, "abc" is interpreted as just "ObjectInt 97".+--+module Test.MessagePack.Parser (parse) where++import           Control.Applicative        ((<|>))+import qualified Data.ByteString.Lazy       as L+import qualified Data.ByteString.Lazy.Char8 as L8+import           Data.Int                   (Int64)+import           Data.Maybe                 (fromMaybe)+import           Data.MessagePack.Types     (Object)+import           Data.Time.Clock            (diffUTCTime, getCurrentTime)+import           System.IO                  (hPutStr, hPutStrLn, stderr)+import           Text.Read                  (readMaybe)+++display :: Int64 -> Object -> String+display len | len > 10 * 1024 = const $ show len <> " bytes (too large to display)"+display _   = show+++parseBidirectional+    :: (Object -> L.ByteString)+    -> (L.ByteString -> Maybe Object)+    -> L.ByteString+    -> L.ByteString+parseBidirectional pack unpack str = fromMaybe L.empty $+    pack <$> readMaybe (L8.unpack str)+    <|>+    L8.pack . flip (++) "\n" . display (L.length str) <$> unpack str+++showSpeed :: Int64 -> Double -> String+showSpeed size time =+    show (fromIntegral size / (1024 * 1024) / time) <> " MiB/s"+++parse :: (Object -> L.ByteString) -> (L.ByteString -> Maybe Object) -> IO ()+parse pack unpack = do+    start <- getCurrentTime+    packed <- L.getContents+    hPutStr stderr $ "Read " <> show (L.length packed) <> " bytes"+    readTime <- getCurrentTime+    hPutStrLn stderr $ " in " <> show (diffUTCTime readTime start)++    let parsed = parseBidirectional pack unpack packed+    hPutStr stderr $ "Parsed into " <> show (L.length parsed) <> " bytes"+    unpackTime <- getCurrentTime+    hPutStrLn stderr $ " in " <> show (diffUTCTime unpackTime readTime)++    hPutStrLn stderr $ "Unpacking speed: " <> showSpeed (L.length packed) (realToFrac (diffUTCTime unpackTime readTime))++    L.putStr parsed