IOSpec.hs

{-# LANGUAGE DeriveAnyClass #-}

module Data.Binary.IOSpec (spec) where

import Prelude hiding (read)

import Control.Exception (Exception)
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 qualified Test.Hspec as Hspec

import qualified System.IO as IO
import           System.IO.Error (ioeGetErrorString, isIllegalOperation)
import           System.Process (createPipe)

-- | 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 ()

  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