    {-# LANGUAGE DeriveDataTypeable #-}

    -- |
    -- Module: Data.Knob
    -- Copyright: 2011 John Millikin
    -- License: MIT
    --
    -- Maintainer: n@monade.li
    -- Portability: GHC only
    --
    -- Create memory-backed 'IO.Handle's, referencing virtual files. This is
    -- mostly useful for testing 'IO.Handle'-based APIs without having to
    -- interact with the filesystem.
    --
    -- > import Data.ByteString (pack)
    -- > import Data.Knob
    -- > import System.IO
    -- >
    -- > main = do
    -- >     knob <- newKnob (pack [])
    -- >     h <- newFileHandle knob "test.txt" WriteMode
    -- >     hPutStrLn h "Hello world!"
    -- >     hClose h
    -- >     bytes <- Data.Knob.getContents knob
    -- >     putStrLn ("Wrote bytes: " ++ show bytes)
    module Data.Knob
      ( Knob
      , newKnob
      , Data.Knob.getContents
      , setContents

      , newFileHandle
      , withFileHandle

      , Device
      , newDevice
      ) where

    import qualified Control.Concurrent.MVar as MVar
    import           Control.Exception (bracket, throwIO)
    import           Control.Monad (when)
    import           Control.Monad.IO.Class (MonadIO, liftIO)
    import qualified Data.ByteString
    import           Data.ByteString (ByteString)
    import           Data.ByteString.Unsafe (unsafeUseAsCStringLen)
    import           Data.Typeable (Typeable)
    import qualified Foreign
    import qualified GHC.IO.Buffer as IO
    import qualified GHC.IO.BufferedIO as IO
    import qualified GHC.IO.Device as IO
    import qualified GHC.IO.Exception as IO
    import qualified GHC.IO.Handle as IO
    import qualified System.IO as IO
    import Data.Maybe (fromMaybe)

    -- | A knob is a basic virtual file, which contains a byte buffer. A knob can
    -- have multiple 'IO.Handle's open to it, each of which behaves like a standard
    -- file handle.
    --
    -- Use 'Data.Knob.getContents' and 'setContents' to inspect and modify the knob's
    -- byte buffer.
    newtype Knob = Knob (MVar.MVar ByteString)

    checkOffset :: Integer -> IO ()
    checkOffset :: Integer -> IO ()
    checkOffset Integer
    off = Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int
    forall a. Bounded a => a
    maxBound :: Int) Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    off) (IOException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO IOException
    err) where
      err :: IOException
    err = Maybe Handle
    -> IOErrorType
    -> String
    -> String
    -> Maybe CInt
    -> Maybe String
    -> IOException
    IO.IOError Maybe Handle
    forall a. Maybe a
    Nothing IOErrorType
    IO.InvalidArgument String
    "" String
    "offset > (maxBound :: Int)" Maybe CInt
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing

    newKnob :: MonadIO m => ByteString -> m Knob
    newKnob :: forall (m :: * -> *). MonadIO m => ByteString -> m Knob
    newKnob ByteString
    bytes = do
      var <- IO (MVar ByteString) -> m (MVar ByteString)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (ByteString -> IO (MVar ByteString)
    forall a. a -> IO (MVar a)
    MVar.newMVar ByteString
    bytes)
      return (Knob var)

    getContents :: MonadIO m => Knob -> m ByteString
    getContents :: forall (m :: * -> *). MonadIO m => Knob -> m ByteString
    getContents (Knob MVar ByteString
    var) = IO ByteString -> m ByteString
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (MVar ByteString -> IO ByteString
    forall a. MVar a -> IO a
    MVar.readMVar MVar ByteString
    var)

    setContents :: MonadIO m => Knob -> ByteString -> m ()
    setContents :: forall (m :: * -> *). MonadIO m => Knob -> ByteString -> m ()
    setContents (Knob MVar ByteString
    var) ByteString
    bytes = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (MVar ByteString -> (ByteString -> IO ByteString) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    MVar.modifyMVar_ MVar ByteString
    var (\ByteString
    _ -> ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    bytes))

    -- | Create a new 'IO.Handle' pointing to a 'Knob'. This handle behaves like
    -- a file-backed handle for most purposes.
    newFileHandle :: MonadIO m
                  => Knob
                  -> String -- ^ Filename shown in error messages
                  -> IO.IOMode -> m IO.Handle
    newFileHandle :: forall (m :: * -> *).
    MonadIO m =>
    Knob -> String -> IOMode -> m Handle
    newFileHandle Knob
    knob String
    name IOMode
    mode = IO Handle -> m Handle
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
    forall a b. (a -> b) -> a -> b
    $ do
      device <- Knob -> IOMode -> IO Device
    forall (m :: * -> *). MonadIO m => Knob -> IOMode -> m Device
    newDevice Knob
    knob IOMode
    mode
      IO.mkFileHandle device name mode Nothing IO.noNewlineTranslation

    -- | See 'newFileHandle'.
    withFileHandle :: MonadIO m
                   => Knob
                   -> String -- ^ Filename shown in error messages.
                   -> IO.IOMode -> (IO.Handle -> IO a) -> m a
    withFileHandle :: forall (m :: * -> *) a.
    MonadIO m =>
    Knob -> String -> IOMode -> (Handle -> IO a) -> m a
    withFileHandle Knob
    knob String
    name IOMode
    mode Handle -> IO a
    io = IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Handle -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket (Knob -> String -> IOMode -> IO Handle
    forall (m :: * -> *).
    MonadIO m =>
    Knob -> String -> IOMode -> m Handle
    newFileHandle Knob
    knob String
    name IOMode
    mode) Handle -> IO ()
    IO.hClose Handle -> IO a
    io)

    -- | An IO device backed by a 'Knob'. You shouldn't usually use this type directly;
    -- use 'newFileHandle' or 'withFileHandle' instead.
    data Device = Device IO.IOMode (MVar.MVar ByteString) (MVar.MVar Int)
      deriving (Typeable)

    newDevice :: MonadIO m => Knob -> IO.IOMode -> m Device
    newDevice :: forall (m :: * -> *). MonadIO m => Knob -> IOMode -> m Device
    newDevice (Knob MVar ByteString
    var) IOMode
    mode = IO Device -> m Device
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Device -> m Device) -> IO Device -> m Device
    forall a b. (a -> b) -> a -> b
    $ do
      startPosition <- MVar ByteString -> (ByteString -> IO Int) -> IO Int
    forall a b. MVar a -> (a -> IO b) -> IO b
    MVar.withMVar MVar ByteString
    var ((ByteString -> IO Int) -> IO Int)
    -> (ByteString -> IO Int) -> IO Int
    forall a b. (a -> b) -> a -> b
    $ \ByteString
    bytes -> Int -> IO Int
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> IO Int) -> Int -> IO Int
    forall a b. (a -> b) -> a -> b
    $ case IOMode
    mode of
        IOMode
    IO.AppendMode -> ByteString -> Int
    Data.ByteString.length ByteString
    bytes
        IOMode
    _ -> Int
    0
      posVar <- MVar.newMVar startPosition
      pure $ Device mode var posVar

    instance IO.IODevice Device where
      ready :: Device -> Bool -> Int -> IO Bool
    ready Device
    _ Bool
    _ Int
    _ = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      close :: Device -> IO ()
    close Device
    _ = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      isTerminal :: Device -> IO Bool
    isTerminal Device
    _ = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
      isSeekable :: Device -> IO Bool
    isSeekable Device
    _ = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

      seek :: Device -> SeekMode -> Integer -> IO Integer
    seek (Device IOMode
    _ MVar ByteString
    _ MVar Int
    var) SeekMode
    IO.AbsoluteSeek Integer
    off = do
        Integer -> IO ()
    checkOffset Integer
    off
        MVar Int -> (Int -> IO (Int, Integer)) -> IO Integer
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    MVar.modifyMVar MVar Int
    var (\Int
    _ -> (Int, Integer) -> IO (Int, Integer)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    off, Integer
    off))

      seek (Device IOMode
    _ MVar ByteString
    _ MVar Int
    var) SeekMode
    IO.RelativeSeek Integer
    off = do
        MVar Int -> (Int -> IO (Int, Integer)) -> IO Integer
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    MVar.modifyMVar MVar Int
    var (\Int
    old_off -> do
          let new_off :: Integer
    new_off = Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    old_off Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    off
          Integer -> IO ()
    checkOffset Integer
    new_off
          (Int, Integer) -> IO (Int, Integer)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    new_off, Integer
    new_off))

      seek dev :: Device
    dev@(Device IOMode
    _ MVar ByteString
    _ MVar Int
    off_var) SeekMode
    IO.SeekFromEnd Integer
    off = do
        MVar Int -> (Int -> IO (Int, Integer)) -> IO Integer
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    MVar.modifyMVar MVar Int
    off_var (\Int
    _ -> do
          size <- Device -> IO Integer
    forall a. IODevice a => a -> IO Integer
    IO.getSize Device
    dev
          let new_off = Integer
    size Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    off
          checkOffset new_off
          return (fromInteger new_off, new_off))

      tell :: Device -> IO Integer
    tell (Device IOMode
    _ MVar ByteString
    _ MVar Int
    var) = (Int -> Integer) -> IO Int -> IO Integer
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (MVar Int -> IO Int
    forall a. MVar a -> IO a
    MVar.readMVar MVar Int
    var)
      getSize :: Device -> IO Integer
    getSize (Device IOMode
    _ MVar ByteString
    var MVar Int
    _) = do
        bytes <- MVar ByteString -> IO ByteString
    forall a. MVar a -> IO a
    MVar.readMVar MVar ByteString
    var
        return (toInteger (Data.ByteString.length bytes))
      setSize :: Device -> Integer -> IO ()
    setSize = Device -> Integer -> IO ()
    setDeviceSize
      devType :: Device -> IO IODeviceType
    devType Device
    _ = IODeviceType -> IO IODeviceType
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return IODeviceType
    IO.RegularFile

    setDeviceSize :: Device -> Integer -> IO ()
    setDeviceSize :: Device -> Integer -> IO ()
    setDeviceSize (Device IOMode
    mode MVar ByteString
    bytes_var MVar Int
    _) Integer
    size = IO ()
    checkSize IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    setBytes where
      intSize :: Int
      intSize :: Int
    intSize = Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    size

      checkSize :: IO ()
    checkSize = Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Integer
    size Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int
    forall a. Bounded a => a
    maxBound :: Int)) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        IOException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (Maybe Handle
    -> IOErrorType
    -> String
    -> String
    -> Maybe CInt
    -> Maybe String
    -> IOException
    IO.IOError Maybe Handle
    forall a. Maybe a
    Nothing IOErrorType
    IO.InvalidArgument String
    "" String
    "size > (maxBound :: Int)" Maybe CInt
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing)

      setBytes :: IO ()
    setBytes = MVar ByteString -> (ByteString -> IO ByteString) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    MVar.modifyMVar_ MVar ByteString
    bytes_var ((ByteString -> IO ByteString) -> IO ())
    -> (ByteString -> IO ByteString) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ByteString
    bytes -> case IOMode
    mode of
        IOMode
    IO.ReadMode -> IOException -> IO ByteString
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (Maybe Handle
    -> IOErrorType
    -> String
    -> String
    -> Maybe CInt
    -> Maybe String
    -> IOException
    IO.IOError Maybe Handle
    forall a. Maybe a
    Nothing IOErrorType
    IO.IllegalOperation String
    "" String
    "handle in ReadMode" Maybe CInt
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing)
        IOMode
    IO.WriteMode -> ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Word8 -> ByteString
    Data.ByteString.replicate Int
    intSize Word8
    0)
        IOMode
    IO.ReadWriteMode -> ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> ByteString
    clip ByteString
    bytes)
        IOMode
    IO.AppendMode -> ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> ByteString
    clip ByteString
    bytes)

      clip :: ByteString -> ByteString
    clip ByteString
    bytes = case Int
    intSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - ByteString -> Int
    Data.ByteString.length ByteString
    bytes of
        Int
    padLen | Int
    padLen Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 -> ByteString -> ByteString -> ByteString
    Data.ByteString.append ByteString
    bytes (Int -> Word8 -> ByteString
    Data.ByteString.replicate Int
    padLen Word8
    0)
        Int
    _ -> Int -> ByteString -> ByteString
    Data.ByteString.take Int
    intSize ByteString
    bytes

    {- What about non-POSIX environment? -}
    instance IO.RawIO Device where
      read :: Device -> Ptr Word8 -> Word64 -> Int -> IO Int
    read (Device IOMode
    _ MVar ByteString
    bytes_var MVar Int
    pos_var) Ptr Word8
    ptr Word64
    _ Int
    bufSize = do
        MVar ByteString -> (ByteString -> IO Int) -> IO Int
    forall a b. MVar a -> (a -> IO b) -> IO b
    MVar.withMVar MVar ByteString
    bytes_var ((ByteString -> IO Int) -> IO Int)
    -> (ByteString -> IO Int) -> IO Int
    forall a b. (a -> b) -> a -> b
    $ \ByteString
    bytes -> do
          MVar Int -> (Int -> IO (Int, Int)) -> IO Int
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    MVar.modifyMVar MVar Int
    pos_var ((Int -> IO (Int, Int)) -> IO Int)
    -> (Int -> IO (Int, Int)) -> IO Int
    forall a b. (a -> b) -> a -> b
    $ \Int
    pos -> do
            if Int
    pos Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= ByteString -> Int
    Data.ByteString.length ByteString
    bytes
              then (Int, Int) -> IO (Int, Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    pos, Int
    0)
              else do
                let chunk :: ByteString
    chunk = Int -> ByteString -> ByteString
    Data.ByteString.take Int
    bufSize (Int -> ByteString -> ByteString
    Data.ByteString.drop Int
    pos ByteString
    bytes)
                ByteString -> (CStringLen -> IO (Int, Int)) -> IO (Int, Int)
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    unsafeUseAsCStringLen ByteString
    chunk ((CStringLen -> IO (Int, Int)) -> IO (Int, Int))
    -> (CStringLen -> IO (Int, Int)) -> IO (Int, Int)
    forall a b. (a -> b) -> a -> b
    $ \(Ptr CChar
    chunkPtr, Int
    chunkLen) -> do
                  Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
    Foreign.copyArray Ptr Word8
    ptr (Ptr CChar -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    Foreign.castPtr Ptr CChar
    chunkPtr) Int
    chunkLen
                  (Int, Int) -> IO (Int, Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    pos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    chunkLen, Int
    chunkLen)

      write :: Device -> Ptr Word8 -> Word64 -> Int -> IO ()
    write (Device IOMode
    _ MVar ByteString
    bytes_var MVar Int
    pos_var) Ptr Word8
    ptr Word64
    _ Int
    bufSize = do
        MVar ByteString -> (ByteString -> IO ByteString) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    MVar.modifyMVar_ MVar ByteString
    bytes_var ((ByteString -> IO ByteString) -> IO ())
    -> (ByteString -> IO ByteString) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ByteString
    bytes -> do
          MVar Int -> (Int -> IO (Int, ByteString)) -> IO ByteString
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    MVar.modifyMVar MVar Int
    pos_var ((Int -> IO (Int, ByteString)) -> IO ByteString)
    -> (Int -> IO (Int, ByteString)) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \Int
    pos -> do
            let (ByteString
    before, ByteString
    after) = Int -> ByteString -> (ByteString, ByteString)
    Data.ByteString.splitAt Int
    pos ByteString
    bytes
            let padding :: ByteString
    padding = Int -> Word8 -> ByteString
    Data.ByteString.replicate (Int
    pos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - ByteString -> Int
    Data.ByteString.length ByteString
    before) Word8
    0

            bufBytes <- CStringLen -> IO ByteString
    Data.ByteString.packCStringLen (Ptr Word8 -> Ptr CChar
    forall a b. Ptr a -> Ptr b
    Foreign.castPtr Ptr Word8
    ptr, Int
    bufSize)
            let newBytes = [ByteString] -> ByteString
    Data.ByteString.concat [ByteString
    before, ByteString
    padding, ByteString
    bufBytes, Int -> ByteString -> ByteString
    Data.ByteString.drop Int
    bufSize ByteString
    after]
            return (pos + bufSize, newBytes)
        () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

      readNonBlocking :: Device -> Ptr Word8 -> Word64 -> Int -> IO (Maybe Int)
    readNonBlocking Device
    dev Ptr Word8
    buf Word64
    off Int
    size = Device -> Ptr Word8 -> Word64 -> Int -> IO Int
    forall a. RawIO a => a -> Ptr Word8 -> Word64 -> Int -> IO Int
    IO.read Device
    dev Ptr Word8
    buf Word64
    off Int
    size IO Int -> (Int -> IO (Maybe Int)) -> IO (Maybe Int)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Int
    cnt -> if Int
    cnt Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
        then Maybe Int -> IO (Maybe Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Int
    forall a. Maybe a
    Nothing
        else Maybe Int -> IO (Maybe Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
    forall a b. (a -> b) -> a -> b
    $ Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    cnt
      writeNonBlocking :: Device -> Ptr Word8 -> Word64 -> Int -> IO Int
    writeNonBlocking Device
    dev Ptr Word8
    buf Word64
    off Int
    cnt = Device -> Ptr Word8 -> Word64 -> Int -> IO ()
    forall a. RawIO a => a -> Ptr Word8 -> Word64 -> Int -> IO ()
    IO.write Device
    dev Ptr Word8
    buf Word64
    off Int
    cnt IO () -> IO Int -> IO Int
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> IO Int
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    cnt

    instance IO.BufferedIO Device where
      newBuffer :: Device -> BufferState -> IO (Buffer Word8)
    newBuffer Device
    _ = Int -> BufferState -> IO (Buffer Word8)
    IO.newByteBuffer Int
    4096

      fillReadBuffer :: Device -> Buffer Word8 -> IO (Int, Buffer Word8)
    fillReadBuffer Device
    dev Buffer Word8
    buf = do
        (numRead, newBuf) <- Device -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
    forall dev.
    BufferedIO dev =>
    dev -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
    IO.fillReadBuffer0 Device
    dev Buffer Word8
    buf
        return (fromMaybe 0 numRead, newBuf)

      fillReadBuffer0 :: Device -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
    fillReadBuffer0 (Device IOMode
    _ MVar ByteString
    bytes_var MVar Int
    pos_var) Buffer Word8
    buf = do
        MVar ByteString
    -> (ByteString -> IO (Maybe Int, Buffer Word8))
    -> IO (Maybe Int, Buffer Word8)
    forall a b. MVar a -> (a -> IO b) -> IO b
    MVar.withMVar MVar ByteString
    bytes_var ((ByteString -> IO (Maybe Int, Buffer Word8))
     -> IO (Maybe Int, Buffer Word8))
    -> (ByteString -> IO (Maybe Int, Buffer Word8))
    -> IO (Maybe Int, Buffer Word8)
    forall a b. (a -> b) -> a -> b
    $ \ByteString
    bytes -> do
          MVar Int
    -> (Int -> IO (Int, (Maybe Int, Buffer Word8)))
    -> IO (Maybe Int, Buffer Word8)
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    MVar.modifyMVar MVar Int
    pos_var ((Int -> IO (Int, (Maybe Int, Buffer Word8)))
     -> IO (Maybe Int, Buffer Word8))
    -> (Int -> IO (Int, (Maybe Int, Buffer Word8)))
    -> IO (Maybe Int, Buffer Word8)
    forall a b. (a -> b) -> a -> b
    $ \Int
    pos -> do
            if Int
    pos Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= ByteString -> Int
    Data.ByteString.length ByteString
    bytes
              then (Int, (Maybe Int, Buffer Word8))
    -> IO (Int, (Maybe Int, Buffer Word8))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    pos, (Maybe Int
    forall a. Maybe a
    Nothing, Buffer Word8
    buf))
              else do
                let chunk :: ByteString
    chunk = Int -> ByteString -> ByteString
    Data.ByteString.take (Buffer Word8 -> Int
    forall e. Buffer e -> Int
    IO.bufSize Buffer Word8
    buf) (Int -> ByteString -> ByteString
    Data.ByteString.drop Int
    pos ByteString
    bytes)
                ByteString
    -> (CStringLen -> IO (Int, (Maybe Int, Buffer Word8)))
    -> IO (Int, (Maybe Int, Buffer Word8))
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    unsafeUseAsCStringLen ByteString
    chunk ((CStringLen -> IO (Int, (Maybe Int, Buffer Word8)))
     -> IO (Int, (Maybe Int, Buffer Word8)))
    -> (CStringLen -> IO (Int, (Maybe Int, Buffer Word8)))
    -> IO (Int, (Maybe Int, Buffer Word8))
    forall a b. (a -> b) -> a -> b
    $ \(Ptr CChar
    chunkPtr, Int
    chunkLen) -> do
                  ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    Foreign.withForeignPtr (Buffer Word8 -> ForeignPtr Word8
    forall e. Buffer e -> RawBuffer e
    IO.bufRaw Buffer Word8
    buf) ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ptr -> do
                    Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
    Foreign.copyArray Ptr Word8
    ptr (Ptr CChar -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    Foreign.castPtr Ptr CChar
    chunkPtr) Int
    chunkLen
                  (Int, (Maybe Int, Buffer Word8))
    -> IO (Int, (Maybe Int, Buffer Word8))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    pos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    chunkLen, (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    chunkLen, (Buffer Word8
    buf { IO.bufL = 0, IO.bufR = chunkLen })))

      flushWriteBuffer :: Device -> Buffer Word8 -> IO (Buffer Word8)
    flushWriteBuffer (Device IOMode
    _ MVar ByteString
    bytes_var MVar Int
    pos_var) Buffer Word8
    buf = do
        MVar ByteString -> (ByteString -> IO ByteString) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    MVar.modifyMVar_ MVar ByteString
    bytes_var ((ByteString -> IO ByteString) -> IO ())
    -> (ByteString -> IO ByteString) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ByteString
    bytes -> do
          MVar Int -> (Int -> IO (Int, ByteString)) -> IO ByteString
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    MVar.modifyMVar MVar Int
    pos_var ((Int -> IO (Int, ByteString)) -> IO ByteString)
    -> (Int -> IO (Int, ByteString)) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \Int
    pos -> do
            let (ByteString
    before, ByteString
    after) = Int -> ByteString -> (ByteString, ByteString)
    Data.ByteString.splitAt Int
    pos ByteString
    bytes
            let padding :: ByteString
    padding = Int -> Word8 -> ByteString
    Data.ByteString.replicate (Int
    pos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - ByteString -> Int
    Data.ByteString.length ByteString
    before) Word8
    0

            let bufStart :: Ptr a -> Ptr b
    bufStart Ptr a
    ptr = Ptr (ZonkAny 0) -> Ptr b
    forall a b. Ptr a -> Ptr b
    Foreign.castPtr (Ptr a -> Int -> Ptr (ZonkAny 0)
    forall a b. Ptr a -> Int -> Ptr b
    Foreign.plusPtr Ptr a
    ptr (Buffer Word8 -> Int
    forall e. Buffer e -> Int
    IO.bufL Buffer Word8
    buf))
            let bufLen :: Int
    bufLen = Buffer Word8 -> Int
    forall e. Buffer e -> Int
    IO.bufR Buffer Word8
    buf Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Buffer Word8 -> Int
    forall e. Buffer e -> Int
    IO.bufL Buffer Word8
    buf
            bufBytes <- ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    Foreign.withForeignPtr (Buffer Word8 -> ForeignPtr Word8
    forall e. Buffer e -> RawBuffer e
    IO.bufRaw Buffer Word8
    buf) (\Ptr Word8
    ptr ->
              CStringLen -> IO ByteString
    Data.ByteString.packCStringLen (Ptr Word8 -> Ptr CChar
    forall a b. Ptr a -> Ptr b
    bufStart Ptr Word8
    ptr, Int
    bufLen))
            let newBytes = [ByteString] -> ByteString
    Data.ByteString.concat [ByteString
    before, ByteString
    padding, ByteString
    bufBytes, Int -> ByteString -> ByteString
    Data.ByteString.drop Int
    bufLen ByteString
    after]
            return (pos + bufLen, newBytes)
        Buffer Word8 -> IO (Buffer Word8)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Buffer Word8
    buf { IO.bufL = 0, IO.bufR = 0 })

      flushWriteBuffer0 :: Device -> Buffer Word8 -> IO (Int, Buffer Word8)
    flushWriteBuffer0 Device
    dev Buffer Word8
    buf = do
        newBuf <- Device -> Buffer Word8 -> IO (Buffer Word8)
    forall dev.
    BufferedIO dev =>
    dev -> Buffer Word8 -> IO (Buffer Word8)
    IO.flushWriteBuffer Device
    dev Buffer Word8
    buf
        return (IO.bufR buf - IO.bufL buf, newBuf)