binary-io 0.1.0 → 0.2.0

raw patch · 4 files changed

+213/−83 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• binary-io.cabal +3/−3
• lib/Data/Binary/IO.hs +98/−24
• test/Data/Binary/IOSpec.hs +103/−56

@@ -1,5 +1,14 @@ # binary-io +## 0.2.0++* Add newPipe function that can create a connected Reader and Writer+* Make Reader more resilient against exceptions that may happen in the provided Get operation++## 0.1.1++* Add functions to create a Reader, Writer or Duplex without a Handle+ ## 0.1.0  * Remove continuation parameter to 'runGet' and 'readWith'

@@ -5,16 +5,16 @@   binary-io  version:-  0.1.0+  0.2.0  category:   Data, Parsing, IO  synopsis:-  Read and write values of types that implement Binary from and to Handles+  Read and write values of types that implement Binary  description:-  Read and write values of types that implement Binary from and to Handles+  Read and write values of types that implement Binary   .   See module "Data.Binary.IO". 

@@ -7,14 +7,20 @@    , Reader   , newReader+  , newReaderWith      -- * Writers   , Writer   , newWriter+  , newWriterWith +    -- * Pipe+  , newPipe+     -- * Duplex-  , Duplex+  , Duplex (..)   , newDuplex+  , newDuplexWith      -- * Classes   , CanGet (..)@@ -27,16 +33,21 @@  import Prelude hiding (read) +import qualified Control.Concurrent.Chan as Chan+import           Control.Concurrent.MVar (MVar, modifyMVar, newMVar)+import qualified Control.Concurrent.MVar as MVar import qualified Control.Exception as Exception-import           Control.Monad (join)+import           Control.Monad (unless, void) import           Data.Bifunctor (bimap) import qualified Data.Binary as Binary import qualified Data.Binary.Get as Binary.Get import qualified Data.Binary.Put as Binary.Put import qualified Data.ByteString as ByteString.Strict import qualified Data.ByteString.Lazy as ByteString-import           Data.IORef (IORef, atomicModifyIORef, newIORef)+import           Data.ByteString.Lazy.Internal (ByteString (Chunk, Empty)) import           System.IO (Handle, hSetBinaryMode)+import           System.IO.Unsafe (unsafeInterleaveIO)+import qualified System.Mem.Weak as Weak  -- * Reader @@ -90,18 +101,17 @@   hSetBinaryMode handle True   StationaryReader <$> ByteString.hGetContents handle +newStationaryReaderWith :: IO ByteString.Strict.ByteString -> IO StationaryReader+newStationaryReaderWith get =+  StationaryReader <$> mkStream get+ -- | @since 0.0.1-newtype Reader = Reader (IORef StationaryReader)+newtype Reader = Reader (MVar StationaryReader)  runReader :: Reader -> Binary.Get a -> IO a runReader (Reader readerVar) getter =-  -- We use 'atomicModifyIORef' which does not force the 'StationaryReader' to WHNF. Forcing the-  -- 'StationaryReader' might block indefinitely because it will try to read more from the-  -- underlying 'Handle'.-  join $ atomicModifyIORef readerVar $ \posReader ->-    case runStationaryReader posReader getter of-      Left error   -> (posReader, Exception.throwIO error)-      Right result -> pure <$> result+  modifyMVar readerVar $ \posReader ->+    either Exception.throwIO pure (runStationaryReader posReader getter)  -- | Create a new reader. --@@ -124,16 +134,26 @@   -> IO Reader newReader handle = do   posReader <- newStationaryReader handle-  Reader <$> newIORef posReader+  Reader <$> newMVar posReader +-- | This function works very similar to 'newReader' except no 'Handle' is involved.+--+-- @since 0.1.1+newReaderWith+  :: IO ByteString.Strict.ByteString -- ^ Chunk producer+  -> IO Reader+newReaderWith get = do+  posReader <- newStationaryReaderWith get+  Reader <$> newMVar posReader+ -- * Writer  -- | @since 0.0.1-newtype Writer = Writer Handle+newtype Writer = Writer (ByteString.Strict.ByteString -> IO ())  runWriter :: Writer -> Binary.Put -> IO ()-runWriter (Writer handle) putter =-  writeBytesAtomically handle (Binary.Put.runPut putter)+runWriter (Writer write) putter =+  write (ByteString.toStrict (Binary.Put.runPut putter))  -- | Create a writer. --@@ -144,8 +164,44 @@ newWriter   :: Handle -- ^ Handle that will be written to   -> Writer-newWriter = Writer+newWriter handle =+  Writer (ByteString.Strict.hPut handle) +-- | Create a writer using a function that handles the output chunks.+--+-- @since 0.1.1+newWriterWith+  :: (ByteString.Strict.ByteString -> IO ()) -- ^ Chunk handler+  -> Writer+newWriterWith =+  Writer++-- * Pipe++-- | Create a connected pair of 'Reader' and 'Writer'.+--+-- @since 0.2.0+newPipe :: IO (Reader, Writer)+newPipe = do+  chan <- Chan.newChan+  mvar <- MVar.newMVar chan++  Weak.addFinalizer chan (void (MVar.tryTakeMVar mvar))++  let+    read = do+      mbChan <- MVar.tryReadMVar mvar+      maybe (pure ByteString.Strict.empty) Chan.readChan mbChan++    write msg =+      unless (ByteString.Strict.null msg) $+        Chan.writeChan chan msg++  reader <- newReaderWith read+  let writer = newWriterWith write++  pure (reader, writer)+ -- * Duplex  -- | Pair of 'Reader' and 'Writer'@@ -166,6 +222,16 @@ newDuplex handle =   Duplex (newWriter handle) <$> newReader handle +-- | Combines 'newReaderWith' and 'newWriterWith'.+--+-- @since 0.1.1+newDuplexWith+  :: IO ByteString.Strict.ByteString+  -> (ByteString.Strict.ByteString -> IO ())+  -> IO Duplex+newDuplexWith get push =+  Duplex (newWriterWith push) <$> newReaderWith get+ -- * Classes  -- | @r@ can execute 'Binary.Get' operations@@ -193,7 +259,8 @@     -> IO ()  instance CanPut Handle where-  runPut handle putter = writeBytesAtomically handle (Binary.Put.runPut putter)+  runPut handle putter =+    ByteString.Strict.hPut handle (ByteString.toStrict (Binary.Put.runPut putter))  instance CanPut Writer where   runPut = runWriter@@ -224,10 +291,17 @@  -- * Utilities --- | Write contents of the given lazy byte string all at once.-writeBytesAtomically-  :: Handle -- ^ Handle to write to-  -> ByteString.ByteString -- ^ Bytes to be written-  -> IO ()-writeBytesAtomically handle payload =-  ByteString.Strict.hPut handle (ByteString.toStrict payload)+-- | Construct a lazy 'ByteString.ByteString' from a function that retrieves chunks.+-- Returning an empty chunk indicates the end of the stream.+mkStream :: IO ByteString.Strict.ByteString -> IO ByteString.ByteString+mkStream get =+  readLazily+  where+    read = do+      chunk <- get+      if ByteString.Strict.null chunk then+        pure Empty+      else+        Chunk chunk <$> readLazily++    readLazily = unsafeInterleaveIO read

@@ -4,15 +4,17 @@  import Prelude hiding (read) -import Control.Exception (Exception)+import Control.Exception (Exception, throw) import Control.Monad (join)-import Control.Monad.IO.Class (MonadIO (liftIO)) -import Data.Bifoldable (bitraverse_)-import Data.Binary (Binary (..))-import Data.Binary.IO-import Data.List (isInfixOf)-import Data.Typeable (typeOf)+import           Data.Bifoldable (bitraverse_)+import           Data.Binary (Binary (..), encode)+import           Data.Binary.IO+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Lazy as ByteString.Lazy+import           Data.Foldable (for_)+import           Data.List (isInfixOf)+import           Data.Typeable (typeOf)  import qualified Test.Hspec as Hspec @@ -51,14 +53,40 @@   closed <- IO.hIsClosed handle   Hspec.shouldBe closed True +withReader :: Hspec.SpecWith (Reader, IO.Handle) -> Hspec.SpecWith a+withReader = Hspec.aroundWith $ \run _ -> do+  (handleRead, handleWrite) <- createUnbufferedPipe++  reader <- newReader handleRead+  run (reader, handleWrite)++  readerWith <- newReaderWith (ByteString.hGetSome handleRead 1024)+  run (readerWith, handleWrite)++withReaderAndWriter :: Hspec.SpecWith (Reader, Writer) -> Hspec.SpecWith a+withReaderAndWriter =+  Hspec.aroundWith $ \run _ ->+    for_ readerMakers $ \mkReader -> for_ writerMakers $ \mkWriter -> do+      (handleRead, handleWrite) <- createUnbufferedPipe++      reader <- mkReader handleRead+      let writer = mkWriter handleWrite++      run (reader, writer)+  where+    readerMakers = [newReader, \handle -> newReaderWith (ByteString.hGetSome handle 1024)]++    writerMakers = [newWriter, newWriterWith . ByteString.hPut]++withPipe :: Hspec.SpecWith (IO.Handle, IO.Handle) -> Hspec.Spec+withPipe = Hspec.before createUnbufferedPipe+ spec :: Hspec.Spec-spec = Hspec.before createUnbufferedPipe $ do+spec = do   Hspec.describe "Reader" $ do     let       testReads value =-        Hspec.it ("reads " <> show (typeOf value)) $ \(handleRead, handleWrite) -> do-          reader <- liftIO (newReader handleRead)-+        Hspec.it ("reads " <> show (typeOf value)) $ \(reader, handleWrite) -> do           write handleWrite value           shouldRead reader value @@ -68,51 +96,59 @@           shouldRead reader value           shouldRead reader value -    -- Test something with 0 length-    testReads ()+    withReader $ do+      -- Test something with 0 length+      testReads () -    -- Test something with fixed non-zero length-    testReads (1337 :: Int)+      -- Test something with fixed non-zero length+      testReads (1337 :: Int) -    -- Test something with variable length-    testReads "Hello World"+      -- Test something with variable length+      testReads "Hello World" -    -- When the read handle has reached its end, reading from it should not throw an error.-    -- However, no more input can be read therefore the underling 'Get' parser should fail.-    Hspec.it "throws ReaderGetError when Handle is EOF" $ \(handleRead, handleWrite) -> do-      reader <- liftIO (newReader handleRead)+    Hspec.it "recovers from exception in Get operation" $ do+      reader <- newReaderWith (pure (ByteString.Lazy.toStrict (encode "Hello World"))) -      IO.hClose handleWrite-      eof <- IO.hIsEOF handleRead-      Hspec.shouldBe eof True+      Hspec.shouldThrow (runGet reader (throw ExampleException)) (\ExampleException -> True) -      Hspec.shouldThrow (read reader :: IO String) (\ReaderGetError{} -> True)+      "Hello World" <- read reader -    -- Reading from a closed handle should throw. That exception needs to surface.-    Hspec.it "throws IllegalOperation when read Handle is closed" $ \(handleRead, _handleWrite) -> do-      reader <- liftIO (newReader handleRead)+      pure () -      closeHandle handleRead+    withPipe $ do+      -- When the read handle has reached its end, reading from it should not throw an error.+      -- However, no more input can be read therefore the underling 'Get' parser should fail.+      Hspec.it "throws ReaderGetError when Handle is EOF" $ \(handleRead, handleWrite) -> do+        reader <- newReader handleRead -      Hspec.shouldThrow (read reader :: IO String) isIllegalOperation+        IO.hClose handleWrite+        eof <- IO.hIsEOF handleRead+        Hspec.shouldBe eof True -    -- Failing 'Get' operations should not advance the stream position.-    Hspec.it "preserves the stream position when Get operation fails" $ \(handleRead, handleWrite) -> do-      reader <- liftIO (newReader handleRead)+        Hspec.shouldThrow (read reader :: IO String) (\ReaderGetError{} -> True) -      write handleWrite "Hello World"-      Hspec.shouldThrow (read reader :: IO BadGet) (\ReaderGetError{} -> True)-      "Hello World" <- read reader+      -- Reading from a closed handle should throw. That exception needs to surface.+      Hspec.it "throws IllegalOperation when read Handle is closed" $ \(handleRead, _handleWrite) -> do+        reader <- newReader handleRead -      pure ()+        closeHandle handleRead +        Hspec.shouldThrow (read reader :: IO String) isIllegalOperation++      -- Failing 'Get' operations should not advance the stream position.+      Hspec.it "preserves the stream position when Get operation fails" $ \(handleRead, handleWrite) -> do+        reader <- newReader handleRead++        write handleWrite "Hello World"+        Hspec.shouldThrow (read reader :: IO BadGet) (\ReaderGetError{} -> True)+        "Hello World" <- read reader++        pure ()+   Hspec.describe "Writer" $ do     let       testWrites value =-        Hspec.it ("writes " <> show (typeOf value)) $ \(handleRead, handleWrite) -> do-          let writer = newWriter handleWrite-          reader <- newReader handleRead-+        Hspec.it ("writes " <> show (typeOf value)) $ \(reader, writer) -> do           write writer value           shouldRead reader value @@ -122,26 +158,37 @@           shouldRead reader value           shouldRead reader value -    -- Test something with 0 length-    testWrites ()+    withReaderAndWriter $ do+      -- Test something with 0 length+      testWrites () -    -- Test something with fixed non-zero length-    testWrites (1337 :: Int)+      -- Test something with fixed non-zero length+      testWrites (1337 :: Int) -    -- Test something with variable length-    testWrites "Hello World"+      -- Test something with variable length+      testWrites "Hello World" -    Hspec.it "throws ResourceVanished when read Handle is closed" $ \(handleRead, handleWrite) -> do-      let writer = newWriter handleWrite+    withPipe $ do+      Hspec.it "throws ResourceVanished when read Handle is closed" $ \(handleRead, handleWrite) -> do+        let writer = newWriter handleWrite -      closeHandle handleRead+        closeHandle handleRead -      Hspec.shouldThrow (write writer "Hello World") $ \exception ->-        isInfixOf "resource vanished" (ioeGetErrorString exception)+        Hspec.shouldThrow (write writer "Hello World") $ \exception ->+          isInfixOf "resource vanished" (ioeGetErrorString exception) -    Hspec.it "throws IllegalOperation when write Handle is closed" $ \(_handleRead, handleWrite) -> do-      let writer = newWriter handleWrite+      Hspec.it "throws IllegalOperation when write Handle is closed" $ \(_handleRead, handleWrite) -> do+        let writer = newWriter handleWrite -      closeHandle handleWrite+        closeHandle handleWrite -      Hspec.shouldThrow (write writer "Hello World") isIllegalOperation+        Hspec.shouldThrow (write writer "Hello World") isIllegalOperation++  Hspec.describe "Pipe" $+    Hspec.it "is connected" $ do+      (reader, writer) <- newPipe++      write writer "Hello World"+      "Hello World" <- read reader++      pure ()