streamly-binary (empty) → 1.0.0.0

raw patch · 7 files changed

+249/−0 lines, 7 filesdep +QuickCheckdep +basedep +binarysetup-changed

Dependencies added: QuickCheck, base, binary, bytestring, hspec, streamly, streamly-binary

Files

• CHANGELOG.md +5/−0
• LICENSE +30/−0
• README.md +9/−0
• Setup.hs +2/−0
• src/Streamly/Binary.hs +68/−0
• streamly-binary.cabal +43/−0
• test/Spec.hs +92/−0

@@ -0,0 +1,5 @@+# Revision history for streamly-binary++## 1.0.0.0 – 2020-07-10++* First version

@@ -0,0 +1,30 @@+Copyright (c) 2020, G. Eyaeb++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of G. Eyaeb nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,9 @@+# streamly-binary++Support for encoding/decoding using [binary](https://hackage.haskell.org/package/binary) in [streamly](https://hackage.haskell.org/package/streamly) streams.++## Contribute++Project is hosted at [https://sr.ht/~geyaeb/streamly-binary/](https://sr.ht/~geyaeb/streamly-binary/) . The homepage provides links to [Mercurial repository](https://hg.sr.ht/~geyaeb/streamly-binary), [mailing list](https://lists.sr.ht/~geyaeb/streamly-binary) and [ticket tracker](https://todo.sr.ht/~geyaeb/streamly-binary).++Patches, suggestions, questions and general discussions can be sent to the [mailing list](https://lists.sr.ht/~geyaeb/streamly-binary). Detailed information about sending patches by email can be found at [https://man.sr.ht/hg.sr.ht/email.md](https://man.sr.ht/hg.sr.ht/email.md).

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

@@ -0,0 +1,68 @@+{- ORMOLU_DISABLE -}+{-|+Module      : Streamly.Binary+Description : Support for encoding/decoding using @binary@ in @streamly@ streams.+Copyright   : © 2020 G. Eyaeb+License     : BSD-3-Clause+Maintainer  : geyaeb@protonmail.com+Stability   : experimental+Portability : POSIX++This module contains functions for decoding stream of bytestrings (coming, for example, from TCP connection)+to your data type using [binary](https://hackage.haskell.org/package/binary) and vice versa.+-}+{- ORMOLU_ENABLE -}+module Streamly.Binary+  ( decodeStream,+    decodeStreamGet,+    encodeStream,+    encodeStreamPut,+  )+where++import Control.Exception (Exception)+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import Streamly (SerialT)+import Streamly.Internal.Data.Pipe.Types+import Streamly.Internal.Prelude (transform)+import qualified Streamly.Prelude as S++-- | Decode stream of bytestrings given that there exists instance of 'Binary'+-- for target type. Bytestrings do not have to be aligned in any way.+decodeStream :: (Binary a, MonadFail m) => SerialT m BS.ByteString -> SerialT m a+decodeStream = decodeStreamGet get++-- | Decode stream of bytestrings using 'Get' from 'Binary'.+-- Bytestrings do not have to be aligned in any way.+decodeStreamGet :: MonadFail m => Get a -> SerialT m BS.ByteString -> SerialT m a+decodeStreamGet g = transform $ Pipe consume (produce g) (runGetIncremental g)++-- | Encode stream of elements to bytestrings given that there exists instance of 'Binary'+-- for source type. Resulting bytestrings are not guaranteed to be aligned in any way.+encodeStream :: (Binary a, MonadFail m) => SerialT m a -> SerialT m BS.ByteString+encodeStream = encodeStreamPut put++-- | Encode stream of elements using 'Put' from 'Binary'.+-- Resulting bytestrings are not guaranteed to be aligned in any way.+encodeStreamPut :: (MonadFail m) => (a -> Put) -> SerialT m a -> SerialT m BS.ByteString+encodeStreamPut p = S.concatMap (S.fromList . BL.toChunks) . S.map (runPut . p)++consume :: MonadFail m => Decoder a -> BS.ByteString -> m (Step (PipeState (Decoder a) (Decoder a)) a)+consume d@Done {} input = return $ Continue (Produce $ pushChunk d input)+consume (Partial f) input =+  if BS.null input+    then return (Continue (Consume (f Nothing)))+    else return (Continue (Produce (f (Just input))))+consume (Fail _ _ msg) _ = fail msg++produce :: MonadFail m => Get a -> Decoder a -> m (Step (PipeState (Decoder a) (Decoder a)) a)+produce g (Done unused _ output) =+  if BS.null unused+    then return $ Yield output (Consume (runGetIncremental g))+    else return $ Yield output (Produce (runGetIncremental g `pushChunk` unused))+produce _ d@(Partial _) = return $ Continue (Consume d)+produce _ (Fail _ _ msg) = fail msg

@@ -0,0 +1,43 @@+cabal-version:  >=1.10++name:                streamly-binary+version:             1.0.0.0+synopsis:            Integration of streamly and binary+description:         Support for encoding/decoding using @binary@ in @streamly@ streams.+homepage:            https://sr.ht/~geyaeb/streamly-binary/+bug-reports:         https://todo.sr.ht/~geyaeb/streamly-binary+license:             BSD3+license-file:        LICENSE+author:              G. Eyaeb+maintainer:          geyaeb@protonmail.com+copyright:           2020 G. Eyaeb+category:            Streamly, Streaming, Binary+build-type:          Simple+extra-source-files:  CHANGELOG.md, README.md++source-repository head+  type:             mercurial+  location:         https://hg.sr.ht/~geyaeb/streamly-binary++library+  exposed-modules:  Streamly.Binary+  hs-source-dirs:   src+  build-depends:    base >=4.7 && <5+                  , binary == 0.8.*+                  , bytestring == 0.10.*+                  , streamly == 0.7.*+  default-language: Haskell2010++test-suite streamly-binary-test+  type:             exitcode-stdio-1.0+  main-is:          Spec.hs+  hs-source-dirs:   test+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N+  build-depends:    QuickCheck+                  , base >=4.7 && <5+                  , binary == 0.8.*+                  , bytestring == 0.10.*+                  , hspec == 2.7.*+                  , streamly == 0.7.* +                  , streamly-binary+  default-language: Haskell2010

@@ -0,0 +1,92 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE LambdaCase #-}++import Control.Monad+import Control.Monad.IO.Class+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.ByteString as BS+import Data.Word+import Streamly hiding (parallel)+import Streamly.Binary+import qualified Streamly.Data.Fold as FL+import qualified Streamly.Prelude as S+import Test.Hspec+import Test.QuickCheck+import qualified Test.QuickCheck.Gen as Gen+import Test.QuickCheck.Monadic++-- One element of stream is one encoded Object+prop_normal :: [Object] -> Property+prop_normal objs = monadicIO do+  rt <-+    run $+      S.toList $+        decodeStream $ encodeStream $ S.fromList objs+  return $ rt === objs++-- One element of stream is one byte (represented as bytestring)+prop_single_bytes :: [Object] -> Property+prop_single_bytes objs = monadicIO do+  rt <-+    run $+      S.toList $+        decodeStream+          (encodeStream (S.fromList objs) >>= S.fromList . fmap BS.singleton . BS.unpack)+  return $ rt === objs++-- One element of stream is all encoded objects concatenated as one big bytestring+prop_one_bytestring :: [Object] -> Property+prop_one_bytestring objs = monadicIO do+  rt <-+    run $+      S.toList $+        decodeStream $+          S.yieldM (S.fold FL.mconcat $ encodeStream $ S.fromList objs)+  return $ rt === objs++main :: IO ()+main =+  hspec $+    parallel do+      describe "Binary instance" $+        it "decode . encode === id" $ property \obj ->+          obj === decode (encode (obj :: Object))+      describe "decodeStream . encodeStream === id" do+        it "stream of bytestrings" $ property prop_normal+        it "stream of bytes" $ property prop_single_bytes+        it "stream of one large bytestring" $ property prop_one_bytestring++data Object+  = ObjectNil+  | ObjectNum Word32+  | ObjectStr String+  | ObjectBin ByteString+  | ObjectMap [(Object, Object)]+  deriving (Show, Eq)++instance Arbitrary Object where+  arbitrary = Gen.sized \n ->+    Gen.oneof+      [ pure ObjectNil,+        ObjectNum <$> arbitrary,+        ObjectStr <$> arbitrary,+        ObjectBin <$> (pack <$> arbitrary),+        ObjectMap <$> Gen.resize (n `div` 4) arbitrary+      ]++instance Binary Object where+  put ObjectNil = putWord8 0+  put (ObjectNum w) = putWord8 1 >> putWord32be w+  put (ObjectStr s) = putWord8 2 >> put s+  put (ObjectBin b) = putWord8 3 >> put b+  put (ObjectMap m) = putWord8 4 >> putList m+  get =+    getWord8 >>= \case+      0 -> pure ObjectNil+      1 -> ObjectNum <$> getWord32be+      2 -> ObjectStr <$> get+      3 -> ObjectBin <$> get+      4 -> ObjectMap <$> get+      _ -> fail "unknown tag"