streaming-binary 0.1.0.0 → 0.2.0.0

raw patch · 3 files changed

+21/−5 lines, 3 files

Files

• src/Streaming/Binary.hs +13/−4
• streaming-binary.cabal +1/−1
• test/Streaming/BinarySpec.hs +7/−0

@@ -17,21 +17,30 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -module Streaming.Binary (decoded) where+module Streaming.Binary (decode, decoded) where  import qualified Data.Binary.Get as Binary-import Data.Binary (Binary, get)+import Data.Binary (Binary(..)) import qualified Data.ByteString.Streaming as Q import Data.ByteString.Streaming (ByteString) import Data.Int (Int64) import Streaming import qualified Streaming.Prelude as S -_decode+decode   :: (Binary a, Monad m)   => ByteString m r   -> m (ByteString m r, Int64, Either String a)-_decode = undefined -- TODO implement this.+decode = go 0 (Binary.runGetIncremental get)+  where+    go !total (Binary.Fail leftover nconsumed err) p = do+        return (Q.chunk leftover >> p, total + nconsumed, Left err)+    go !total (Binary.Done leftover nconsumed x) p = do+        return (Q.chunk leftover >> p, total + nconsumed, Right x)+    go !total (Binary.Partial k) p = do+      Q.nextChunk p >>= \case+        Left res -> go total (k Nothing) (return res)+        Right (bs, p') -> go total (k (Just bs)) p'  decoded   :: (Binary a, Monad m)

@@ -1,5 +1,5 @@ name: streaming-binary-version: 0.1.0.0+version: 0.2.0.0 synopsis: Streaming interface to binary. homepage: https://github.com/mboes/streaming-binary#readme license: BSD3

@@ -15,6 +15,13 @@ spec = do     let input n = Q.fromLazy $ runPut $ replicateM_ n $ put (42 :: Int)     describe "decoded" $ do+      it "fails on empty inputs" $ do+        (_, _, output) <- decode @Int (input 0)+        output `shouldBe` Left "not enough bytes"+      it "decodes single integers" $ do+        (_, _, output) <- decode @Int (input 1)+        output `shouldBe` Right 42+    describe "decoded" $ do       it "succeeds on empty inputs" $ do         output <- void (decoded @Int (input 0)) & S.toList_         output `shouldBe` []