pipes-cborg (empty) → 0.1

raw patch · 7 files changed

+267/−0 lines, 7 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, cborg, ghc-prim, pipes, pipes-bytestring, pipes-cborg, pipes-parse, serialise, tasty, tasty-quickcheck, transformers

Files

LICENSE +30/−0
README.md +11/−0
Setup.hs +2/−0
changelog.md +3/−0
pipes-cborg.cabal +57/−0
src/Pipes/CBOR.hs +111/−0
tests/Main.hs +53/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2019, Renzo Carbonara++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 Renzo Carbonara 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.

+ README.md view

@@ -0,0 +1,11 @@+# pipes-cborg++Utilities to encode and decode binary streams using the **pipes** and+**cborg** and **serialise** libraries.++Check the source or rendered Haddocks for extensive documentation.++This code is licensed under the terms of the so called **3-clause BSD+license**. Read the file named ``LICENSE`` found in this same directory+for details.+

+ Setup.hs view

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

+ changelog.md view

@@ -0,0 +1,3 @@+# Version 0.1++* Initial version.

+ pipes-cborg.cabal view

@@ -0,0 +1,57 @@+name: pipes-cborg+version: 0.1+license: BSD3+license-file: LICENSE+copyright: Copyright (c) Renzo Carbonara 2019+author: Renzo Carbonara+maintainer: renλren.zone+stability: Experimental+homepage: https://github.com/k0001/pipes-cborg+bug-reports: https://github.com/k0001/pipes-cborg/issues+category: Pipes+build-type: Simple+synopsis: Encode and decode cborg streams using the pipes and cborg libraries.+cabal-version: >=1.8+extra-source-files: README.md changelog.md+description:+  Encode and decode binary Pipes streams using the @cborg@ library.+  .+  See the @changelog.md@ file in the source distribution to learn about any+  important changes between version.++source-repository head+    type: git+    location: git://github.com/k0001/pipes-cborg.git++library+    hs-source-dirs: src+    exposed-modules: Pipes.CBOR+    ghc-options: -Wall -O2+    ghcjs-options: -Wall -O3+    build-depends:+          base >=4.5 && <5+        , cborg+        , bytestring+        , ghc-prim+        , pipes+        , pipes-parse+        , pipes-bytestring+        , serialise+        , transformers++test-suite tests+    type: exitcode-stdio-1.0+    hs-source-dirs: tests+    main-is: Main.hs+    build-depends:+          base+        , cborg+        , bytestring+        , pipes+        , pipes-bytestring+        , pipes-cborg+        , serialise+        , QuickCheck+        , tasty+        , tasty-quickcheck+        , transformers

+ src/Pipes/CBOR.hs view

@@ -0,0 +1,111 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | [pipes](https://hackage.haskell.org/package/pipes) utilities for encoding+-- and decoding values as byte streams in CBOR format using the+-- [cborg](https://hackage.haskell.org/package/cborg) library.++module Pipes.CBOR (+  -- * Encoding+    serialise+  , encode+  -- * Decoding+  , deserialise+  , decode+  ) where++import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.ST (stToIO)+import qualified Control.Monad.Trans.State.Strict as S+import qualified Codec.CBOR.Decoding as CBOR (Decoder)+import qualified Codec.CBOR.Encoding as CBOR (Encoding)+import qualified Codec.CBOR.Read as CBOR+  (IDecode(..), ByteOffset, DeserialiseFailure, deserialiseIncremental)+import qualified Codec.CBOR.Write as CBOR (toLazyByteString)+import qualified Codec.Serialise as Ser+import qualified Data.ByteString as B+import qualified Pipes as P+import qualified Pipes.ByteString as Pb+import qualified Pipes.Parse as Pp++--------------------------------------------------------------------------------++-- | Renders @x@ to a byte stream using its 'Ser.Serialise' instance.+serialise+ :: (Ser.Serialise x, Monad m)+ => x -- ^+ -> P.Producer' B.ByteString m ()+serialise = encode . Ser.encode+{-# INLINE serialise #-}++-- | Renders an 'CBOR.Encoding' to a byte stream.+encode+  :: Monad m+  => CBOR.Encoding -- ^+  -> P.Producer' B.ByteString m ()+encode = Pb.fromLazy . CBOR.toLazyByteString+{-# INLINE encode #-}++--------------------------------------------------------------------------------++-- | Parses @x@ from a byte stream using its 'Ser.Serialise' instance.+--+-- Also returns the number of bytes consumed in order to to decode the value.+--+-- Implementation note: No, ideally this function shouldn't run in 'IO'. But+-- unfortunately, the underlying 'CBOR.deserialiseIncremental' and its use of+-- 'Control.Monad.ST.ST', which becomes both covariant and contravariant in+-- 'Pp.Parser', make removing the 'IO' tricky. The only 'IO' this function+-- performs is 'stToIO'.+deserialise+  :: (MonadIO m, Ser.Serialise a)+  => Pp.Parser B.ByteString m (Either CBOR.DeserialiseFailure (CBOR.ByteOffset, a)) -- ^+deserialise = decode Ser.decode+{-# INLINE deserialise #-}++-- | Parses @x“ from a byte stream using the given 'CBOR.Decoder'.+--+-- Also returns the number of bytes consumed in order to to decode the value.+--+-- Implementation note: No, ideally this function shouldn't run in 'IO'. But+-- unfortunately, the underlying 'CBOR.deserialiseIncremental' and its use of+-- 'Control.Monad.ST.ST', which becomes both covariant and contravariant in+-- 'Pp.Parser', make removing the 'IO' tricky. The only 'IO' this function+-- performs is 'stToIO'.+decode+  :: MonadIO m+  => (forall s. CBOR.Decoder s x)+  -> Pp.Parser B.ByteString m (Either CBOR.DeserialiseFailure (CBOR.ByteOffset, x)) -- ^+decode dec = S.StateT (go id (CBOR.deserialiseIncremental dec))+  where+    go diffP m = \p0 -> do+      idec <- liftIO (stToIO m)+      case idec of+         CBOR.Fail _ _ err -> pure (Left err, diffP p0)+         CBOR.Done bs off a -> pure (Right (off, a), P.yield bs >> p0)+         CBOR.Partial k -> do+            x <- nextSkipEmpty p0+            case x of+               Left e -> go diffP (k Nothing) (pure e)+               Right (bs, p1) -> go (diffP . (P.yield bs >>)) (k (Just bs)) p1+{-# INLINABLE decode #-}++--------------------------------------------------------------------------------++-- | Like 'P.next', except it skips leading 'B.null' chunks.+nextSkipEmpty+  :: Monad m+  => P.Producer B.ByteString m r+  -> m (Either r (B.ByteString, P.Producer B.ByteString m r))+nextSkipEmpty = go+  where+    go p0 = do+      x <- P.next p0+      case x of+         Left _ -> pure x+         Right (a, p1)+          | B.null a -> go p1+          | otherwise -> pure x+{-# INLINABLE nextSkipEmpty #-}+

+ tests/Main.hs view

@@ -0,0 +1,53 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import qualified Test.Tasty as Tasty+import qualified Test.Tasty.Runners as Tasty+import qualified Test.Tasty.QuickCheck as QC++import Control.Monad+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.State.Strict (runStateT)+import qualified Codec.CBOR.Read as CBOR+  (ByteOffset, deserialiseFromBytesWithSize)+import qualified Codec.Serialise as Ser+import qualified Data.ByteString.Lazy as BL+import qualified Pipes as P+import qualified Pipes.CBOR as Pc+import qualified Pipes.ByteString as Pb+import qualified Pipes.Prelude as P++--------------------------------------------------------------------------------++main :: IO ()+main =  Tasty.defaultMainWithIngredients+  [ Tasty.consoleTestReporter+  , Tasty.listingTests+  ] tests+++tests :: Tasty.TestTree+tests = Tasty.testGroup "root"+  [ testPipesCborg+  ]++-- Just an arbitrary type that can be generated by QuickCheck+type FunnyType = (String, (Double, (Int, (Maybe Int, Either Bool Int))))++testPipesCborg :: Tasty.TestTree+testPipesCborg = Tasty.testGroup "pipes-cborg"+  [ QC.testProperty "Pipes.CBOR.serialaise ~ Codec.Serialise.serialise" $ do+      QC.forAll QC.arbitrary $ \(x :: FunnyType) ->+         Ser.serialise x == BL.fromChunks (P.toList (Pc.serialise x))++  , QC.testProperty "Pipes.CBOR.deserialise ~ Codec.Serialise.deserialise" $ do+      QC.forAll QC.arbitrary $ \(x :: FunnyType) -> QC.ioProperty $ do+         let bl :: BL.ByteString = Ser.serialise x+             o1s :: Either Ser.DeserialiseFailure+                           (BL.ByteString, CBOR.ByteOffset, FunnyType)+             o1s = CBOR.deserialiseFromBytesWithSize Ser.decode bl+         (o2,p2) <- runStateT (Pc.decode Ser.decode) (Pb.fromLazy bl)+         s2 <- BL.fromChunks <$> P.toListM p2+         pure (o1s QC.=== fmap (\(a,b) -> (s2,a,b)) o2)+  ]