binary-io (empty) → 0.0.1

raw patch · 7 files changed

+539/−0 lines, 7 filesdep +basedep +binarydep +binary-iosetup-changed

Dependencies added: base, binary, binary-io, bytestring, hspec, process

Files

• ChangeLog.md +5/−0
• LICENSE +27/−0
• Setup.hs +2/−0
• binary-io.cabal +89/−0
• lib/Data/Binary/IO.hs +249/−0
• test/Data/Binary/IOSpec.hs +159/−0
• test/Main.hs +8/−0

@@ -0,0 +1,5 @@+# binary-io++## 1.0.0++* Inception

@@ -0,0 +1,27 @@+Copyright (c) Ole Krüger++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 the author nor the+  names of its 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 AUTHORS 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,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,89 @@+cabal-version:+  >= 1.10++name:+  binary-io++version:+  0.0.1++category:+  Data, Parsing, IO++synopsis:+  Read and write values of types that implement Binary from and to Handles++description:+  Read and write values of types that implement Binary from and to Handles+  .+  See module "Data.Binary.IO".++author:+  Ole Krüger <haskell-binary-io@vprsm.de>++maintainer:+  Ole Krüger <haskell-binary-io@vprsm.de>++homepage:+  https://github.com/vapourismo/binary-io++license:+  BSD3++license-file:+  LICENSE++extra-source-files:+  ChangeLog.md++build-type:+  Simple++source-repository head+  type: git+  location: git://github.com/vapourismo/binary-io.git++library+  default-language:+    Haskell2010++  ghc-options:+    -Wall -Wextra -Wno-name-shadowing++  build-depends:+    base == 4.*,+    bytestring,+    binary >= 0.7.2++  hs-source-dirs:+    lib++  exposed-modules:+    Data.Binary.IO++test-suite binary-io-tests+  type:+    exitcode-stdio-1.0++  default-language:+    Haskell2010++  ghc-options:+    -Wall -Wextra -Wno-name-shadowing++  build-depends:+    base,+    binary,+    binary-io,+    bytestring,+    process,+    hspec++  hs-source-dirs:+    test++  other-modules:+    Data.Binary.IOSpec++  main-is:+    Main.hs

@@ -0,0 +1,249 @@+{-# LANGUAGE DeriveAnyClass #-}++-- | Read and write values of types that implement 'Binary.Binary' from and to 'Handle's+module Data.Binary.IO+  ( -- * Readers+    ReaderError (..)++  , Reader+  , newReader++    -- * Writers+  , Writer+  , newWriter++    -- * Duplex+  , Duplex+  , newDuplex++    -- * Classes+  , CanGet (..)+  , read+  , readWith++  , CanPut (..)+  , write+  )+where++import Prelude hiding (read)++import qualified Control.Exception as Exception+import qualified Control.Concurrent.MVar as MVar++import qualified Data.ByteString.Lazy as ByteString+import qualified Data.ByteString as ByteString.Strict+import qualified Data.Binary.Get as Binary.Get+import qualified Data.Binary.Put as Binary.Put+import qualified Data.Binary as Binary++import System.IO (Handle, hSetBinaryMode)++-- * Reader++-- | An error that can occur during reading+--+-- @since 0.0.1+data ReaderError = ReaderGetError -- ^ Error from the 'Binary.Get' operation+  { readerErrorRemaining :: !ByteString.ByteString+  -- ^ Unconsumed part of the byte stream+  --+  -- @since 0.0.1++  , readerErrorOffset :: !Binary.Get.ByteOffset+  -- ^ Error location represented as an offset into the input+  --+  -- @since 0.0.1++  , readerErrorInput :: !ByteString.ByteString+  -- ^ Input to the 'Binary.Get' operation+  --+  -- @since 0.0.1++  , readerErrorMessage :: !String+  -- ^ Error message+  --+  -- @since 0.0.1+  }+  deriving (Show, Exception.Exception)++newtype StationaryReader = StationaryReader ByteString.ByteString++runStationaryReader :: StationaryReader -> Binary.Get.Get a -> IO (StationaryReader, a)+runStationaryReader (StationaryReader stream) getter =  do+  -- Evaluate the result of 'runGetOrFail' to WHNF. This should be enough because it means that+  -- the parser has decided between 'Left' and 'Right'.+  result <- Exception.evaluate (Binary.Get.runGetOrFail getter stream)+  case result of+    Left (remainingBody, offset, errorMessage) ->+      Exception.throw ReaderGetError+        { readerErrorRemaining = remainingBody+        , readerErrorOffset = offset+        , readerErrorInput = stream+        , readerErrorMessage = errorMessage+        }++    Right (tailStream, _, value) ->+      pure (StationaryReader tailStream, value)++newStationaryReader :: Handle -> IO StationaryReader+newStationaryReader handle = do+  hSetBinaryMode handle True+  StationaryReader <$> ByteString.hGetContents handle++-- | @since 0.0.1+newtype Reader = Reader (MVar.MVar StationaryReader)++runReader :: Reader -> Binary.Get a -> (a -> IO b) -> IO b+runReader (Reader readerVar) getter continue =+  MVar.modifyMVar readerVar $ \posReader -> do+    toReturn <- runStationaryReader posReader getter+    traverse continue toReturn++-- | Create a new reader.+--+-- Reading using the 'Reader' may throw 'ReaderError'.+--+-- The internal position of the 'Reader' is not advanced when it throws an exception during reading.+-- This has the consequence that if you're trying to read with the same faulty 'Binary.Get'+-- operation multiple times, you will always receive an exception. The same is true for follow-up+-- actions when using 'readWith'.+--+-- Other threads reading from the 'Handle' will interfere with read operations of the 'Reader'.+-- However, the 'Reader' itself is thread-safe and can be utilized concurrently.+--+-- Once the 'Handle' reaches EOF, it will be closed.+--+-- The given 'Handle' will be swiched to binary mode via 'hSetBinaryMode'.+--+-- @since 0.0.1+newReader+  :: Handle -- ^ Handle that will be read from+  -> IO Reader+newReader handle = do+  posReader <- newStationaryReader handle+  Reader <$> MVar.newMVar posReader++-- * Writer++-- | @since 0.0.1+newtype Writer = Writer Handle++runWriter :: Writer -> Binary.Put -> IO ()+runWriter (Writer handle) putter =+  writeBytesAtomically handle (Binary.Put.runPut putter)++-- | Create a writer.+--+-- Other threads writing to the same 'Handle' do not interfere with the resulting 'Writer'. The+-- 'Writer' may be used concurrently.+--+-- @since 0.0.1+newWriter+  :: Handle -- ^ Handle that will be written to+  -> Writer+newWriter = Writer++-- * Duplex++-- | Pair of 'Reader' and 'Writer'+--+-- @since 0.0.1+data Duplex = Duplex+  { duplexWriter :: !Writer+  , duplexReader :: !Reader+  }++-- | Create a new duplex. The 'Duplex' inherits all the properties of 'Reader' and 'Writer' when+-- created with 'newReader' and 'newWriter'.+--+-- @since 0.0.1+newDuplex+  :: Handle -- ^ Handle that will be read from and written to+  -> IO Duplex+newDuplex handle =+  Duplex (newWriter handle) <$> newReader handle++-- * Classes++-- | @r@ can execute 'Binary.Get' operations+--+-- @since 0.0.1+class CanGet r where+  runGet+    :: r -- ^ Reader / source+    -> Binary.Get a -- ^ Operation to execute+    -> (a -> IO b) -- ^ What to do with @a@+    -> IO b++instance CanGet Reader where+  runGet = runReader++instance CanGet Duplex where+  runGet = runGet . duplexReader++-- | @w@ can execute 'Binary.Put' operations+--+-- @since 0.0.1+class CanPut w where+  runPut+    :: w -- ^ Writer / target+    -> Binary.Put -- ^ Operation to execute+    -> IO ()++instance CanPut Handle where+  runPut handle putter = writeBytesAtomically handle (Binary.Put.runPut putter)++instance CanPut Writer where+  runPut = runWriter++instance CanPut Duplex where+  runPut = runPut . duplexWriter++-- | Read something from @r@.+--+-- @since 0.0.1+read+  :: (CanGet r, Binary.Binary a)+  => r -- ^ Read source+  -> IO a+read reader =+  runGet reader Binary.get pure++-- | Read something from @r@ and perform an 'IO' action with it.+--+-- If the given action throws an exception, the read is not considered successful and will not+-- advance the underlying read source.+--+-- Keep in mind, long running actions on @a@ will block other threads when they try to read the from+-- the same source @r@.+--+-- @since 0.0.1+readWith+  :: (CanGet r, Binary.Binary a)+  => r -- ^ Read source+  -> (a -> IO b) -- ^ What to do with @a@+  -> IO b+readWith reader =+  runGet reader Binary.get++-- | Write something to @w@.+--+-- @since 0.0.1+write+  :: (CanPut w, Binary.Binary a)+  => w -- ^ Write target+  -> a -- ^ Value to be written+  -> IO ()+write writer value =+  runPut writer (Binary.put value)++-- * 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)

@@ -0,0 +1,159 @@+{-# LANGUAGE DeriveAnyClass #-}++module Data.Binary.IOSpec (spec) where++import Prelude hiding (read)++import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad (join)+import Control.Exception (Exception, throw)++import Data.Typeable (typeOf)+import Data.List (isInfixOf)+import Data.Binary.IO+import Data.Binary (Binary (..))+import Data.Bifoldable (bitraverse_)++import qualified Test.Hspec as Hspec++import           System.Process (createPipe)+import qualified System.IO as IO+import           System.IO.Error (isIllegalOperation, ioeGetErrorString)++-- | Create a pipe with no buffering on read and write side.+createUnbufferedPipe :: IO (IO.Handle, IO.Handle)+createUnbufferedPipe = do+  handles <- createPipe+  join bitraverse_ (`IO.hSetBuffering` IO.NoBuffering) handles+  pure handles++-- | The 'Binary' instance of this type implements a 'get' that always fails+data BadGet++instance Binary BadGet where+  put = error "Not implemented"++  get = fail "get for BadGet will always"++data ExampleException = ExampleException+  deriving (Show, Exception)++-- | Check that a read from the 'IO.Handle' yields the given value.+shouldRead :: (Show a, Eq a, Binary a) => Reader -> a -> Hspec.Expectation+shouldRead reader expectedValue = do+  value <- read reader+  Hspec.shouldBe value expectedValue++-- | Close a handle and verify.+closeHandle :: IO.Handle -> Hspec.Expectation+closeHandle handle = do+  IO.hClose handle+  closed <- IO.hIsClosed handle+  Hspec.shouldBe closed True++spec :: Hspec.Spec+spec = Hspec.before createUnbufferedPipe $ do+  Hspec.describe "Reader" $ do+    let+      testReads value =+        Hspec.it ("reads " <> show (typeOf value)) $ \(handleRead, handleWrite) -> do+          reader <- liftIO (newReader handleRead)++          write handleWrite value+          shouldRead reader value++          write handleWrite value+          write handleWrite value++          shouldRead reader value+          shouldRead reader value++    -- Test something with 0 length+    testReads ()++    -- Test something with fixed non-zero length+    testReads (1337 :: Int)++    -- 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)++      IO.hClose handleWrite+      eof <- IO.hIsEOF handleRead+      Hspec.shouldBe eof True++      Hspec.shouldThrow (read reader :: IO String) (\ReaderGetError{} -> True)++    -- 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)++      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 <- liftIO (newReader handleRead)++      write handleWrite "Hello World"+      Hspec.shouldThrow (read reader :: IO BadGet) (\ReaderGetError{} -> True)+      "Hello World" <- read reader++      pure ()++    -- Failing continuations should not advance the stream position.+    Hspec.it "preserves the stream position when continuation fails" $ \(handleRead, handleWrite) -> do+      reader <- liftIO (newReader handleRead)++      write handleWrite "Hello World"+      Hspec.shouldThrow+        (readWith reader (\() -> throw ExampleException))+        (\ExampleException -> 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++          write writer value+          shouldRead reader value++          write writer value+          write writer value++          shouldRead reader value+          shouldRead reader value++    -- Test something with 0 length+    testWrites ()++    -- Test something with fixed non-zero length+    testWrites (1337 :: Int)++    -- Test something with variable length+    testWrites "Hello World"++    Hspec.it "throws ResourceVanished when read Handle is closed" $ \(handleRead, handleWrite) -> do+      let writer = newWriter handleWrite++      closeHandle handleRead++      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++      closeHandle handleWrite++      Hspec.shouldThrow (write writer "Hello World") isIllegalOperation

@@ -0,0 +1,8 @@+module Main (main) where++import Test.Hspec++import qualified Data.Binary.IOSpec++main :: IO ()+main = hspec Data.Binary.IOSpec.spec