{-# 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. 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
  MVar ByteString
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)
  Knob -> m Knob
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MVar ByteString -> Knob
Knob MVar ByteString
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
device <- Knob -> IOMode -> IO Device
forall (m :: * -> *). MonadIO m => Knob -> IOMode -> m Device
newDevice Knob
knob IOMode
mode
  Device
-> String
-> IOMode
-> Maybe TextEncoding
-> NewlineMode
-> IO Handle
forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> String
-> IOMode
-> Maybe TextEncoding
-> NewlineMode
-> IO Handle
IO.mkFileHandle Device
device String
name IOMode
mode Maybe TextEncoding
forall a. Maybe a
Nothing NewlineMode
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
  Int
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
  MVar Int
posVar <- Int -> IO (MVar Int)
forall a. a -> IO (MVar a)
MVar.newMVar Int
startPosition
  Device -> IO Device
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Device -> IO Device) -> Device -> IO Device
forall a b. (a -> b) -> a -> b
$ IOMode -> MVar ByteString -> MVar Int -> Device
Device IOMode
mode MVar ByteString
var MVar Int
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
      Integer
size <- Device -> IO Integer
forall a. IODevice a => a -> IO Integer
IO.getSize Device
dev
      let new_off :: Integer
new_off = Integer
size 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))

  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
    ByteString
bytes <- MVar ByteString -> IO ByteString
forall a. MVar a -> IO a
MVar.readMVar MVar ByteString
var
    Integer -> IO Integer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (ByteString -> Int
Data.ByteString.length ByteString
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. 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. 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

        ByteString
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
newBytes = [ByteString] -> ByteString
Data.ByteString.concat [ByteString
before, ByteString
padding, ByteString
bufBytes, Int -> ByteString -> ByteString
Data.ByteString.drop Int
bufSize ByteString
after]
        (Int, ByteString) -> IO (Int, ByteString)
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
bufSize, ByteString
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
    (Maybe Int
numRead, Buffer Word8
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
    (Int, Buffer Word8) -> IO (Int, Buffer Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
numRead, Buffer Word8
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 Any -> Ptr b
forall a b. Ptr a -> Ptr b
Foreign.castPtr (Ptr a -> Int -> Ptr Any
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
        ByteString
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
newBytes = [ByteString] -> ByteString
Data.ByteString.concat [ByteString
before, ByteString
padding, ByteString
bufBytes, Int -> ByteString -> ByteString
Data.ByteString.drop Int
bufLen ByteString
after]
        (Int, ByteString) -> IO (Int, ByteString)
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
bufLen, ByteString
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
    Buffer Word8
newBuf <- Device -> Buffer Word8 -> IO (Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Buffer Word8)
IO.flushWriteBuffer Device
dev Buffer Word8
buf
    (Int, Buffer Word8) -> IO (Int, Buffer Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (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, Buffer Word8
newBuf)