{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.IO.BufferedIO
-- Copyright   :  (c) The University of Glasgow 2008
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  cvs-ghc@haskell.org
-- Stability   :  internal
-- Portability :  non-portable (GHC Extensions)
--
-- Class of buffered IO devices
--
-----------------------------------------------------------------------------

module GHC.IO.BufferedIO (
        BufferedIO(..),
        readBuf, readBufNonBlocking, writeBuf, writeBufNonBlocking
    ) where

import GHC.Base
import GHC.Ptr
import Data.Word
import GHC.Num
import GHC.IO.Device as IODevice
import GHC.IO.Device as RawIO
import GHC.IO.Buffer

-- | The purpose of 'BufferedIO' is to provide a common interface for I/O
-- devices that can read and write data through a buffer.  Devices that
-- implement 'BufferedIO' include ordinary files, memory-mapped files,
-- and bytestrings.  The underlying device implementing a 'System.IO.Handle'
-- must provide 'BufferedIO'.
--
class BufferedIO dev where
  -- | allocate a new buffer.  The size of the buffer is at the
  -- discretion of the device; e.g. for a memory-mapped file the
  -- buffer will probably cover the entire file.
  newBuffer         :: dev -> BufferState -> IO (Buffer Word8)

  -- | reads bytes into the buffer, blocking if there are no bytes
  -- available.  Returns the number of bytes read (zero indicates
  -- end-of-file), and the new buffer.
  fillReadBuffer    :: dev -> Buffer Word8 -> IO (Int, Buffer Word8)

  -- | reads bytes into the buffer without blocking.  Returns the
  -- number of bytes read (Nothing indicates end-of-file), and the new
  -- buffer.
  fillReadBuffer0   :: dev -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)

  -- | Prepares an empty write buffer.  This lets the device decide
  -- how to set up a write buffer: the buffer may need to point to a
  -- specific location in memory, for example.  This is typically used
  -- by the client when switching from reading to writing on a
  -- buffered read/write device.
  --
  -- There is no corresponding operation for read buffers, because before
  -- reading the client will always call 'fillReadBuffer'.
  emptyWriteBuffer  :: dev -> Buffer Word8 -> IO (Buffer Word8)
  emptyWriteBuffer dev
_dev Buffer Word8
buf
    = forall (m :: * -> *) a. Monad m => a -> m a
return Buffer Word8
buf{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0, bufState :: BufferState
bufState = BufferState
WriteBuffer }

  -- | Flush all the data from the supplied write buffer out to the device.
  -- The returned buffer should be empty, and ready for writing.
  flushWriteBuffer  :: dev -> Buffer Word8 -> IO (Buffer Word8)

  -- | Flush data from the supplied write buffer out to the device
  -- without blocking.  Returns the number of bytes written and the
  -- remaining buffer.
  flushWriteBuffer0 :: dev -> Buffer Word8 -> IO (Int, Buffer Word8)

-- for an I/O device, these operations will perform reading/writing
-- to/from the device.

-- for a memory-mapped file, the buffer will be the whole file in
-- memory.  fillReadBuffer sets the pointers to encompass the whole
-- file, and flushWriteBuffer needs to do no I/O.  A memory-mapped
-- file has to maintain its own file pointer.

-- for a bytestring, again the buffer should match the bytestring in
-- memory.

-- ---------------------------------------------------------------------------
-- Low-level read/write to/from buffers

-- These operations make it easy to implement an instance of 'BufferedIO'
-- for an object that supports 'RawIO'.

readBuf :: RawIO dev => dev -> Buffer Word8 -> IO (Int, Buffer Word8)
readBuf :: forall dev.
RawIO dev =>
dev -> Buffer Word8 -> IO (Int, Buffer Word8)
readBuf dev
dev Buffer Word8
bbuf = do
  let bytes :: Int
bytes = forall e. Buffer e -> Int
bufferAvailable Buffer Word8
bbuf
  let offset :: Word64
offset = forall e. Buffer e -> Word64
bufferOffset Buffer Word8
bbuf
  Int
res <- forall e a. Buffer e -> (Ptr e -> IO a) -> IO a
withBuffer Buffer Word8
bbuf forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
             forall a. RawIO a => a -> Ptr Word8 -> Word64 -> Int -> IO Int
RawIO.read dev
dev (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall e. Buffer e -> Int
bufR Buffer Word8
bbuf) Word64
offset Int
bytes
  let bbuf' :: Buffer Word8
bbuf' = forall e. Int -> Buffer e -> Buffer e
bufferAddOffset Int
res Buffer Word8
bbuf
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res, Buffer Word8
bbuf'{ bufR :: Int
bufR = forall e. Buffer e -> Int
bufR Buffer Word8
bbuf' forall a. Num a => a -> a -> a
+ Int
res })
         -- zero indicates end of file

readBufNonBlocking :: RawIO dev => dev -> Buffer Word8
                     -> IO (Maybe Int,   -- Nothing ==> end of file
                                         -- Just n  ==> n bytes were read (n>=0)
                            Buffer Word8)
readBufNonBlocking :: forall dev.
RawIO dev =>
dev -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
readBufNonBlocking dev
dev Buffer Word8
bbuf = do
  let bytes :: Int
bytes = forall e. Buffer e -> Int
bufferAvailable Buffer Word8
bbuf
  let offset :: Word64
offset = forall e. Buffer e -> Word64
bufferOffset Buffer Word8
bbuf
  Maybe Int
res <- forall e a. Buffer e -> (Ptr e -> IO a) -> IO a
withBuffer Buffer Word8
bbuf forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
           forall a.
RawIO a =>
a -> Ptr Word8 -> Word64 -> Int -> IO (Maybe Int)
IODevice.readNonBlocking dev
dev (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall e. Buffer e -> Int
bufR Buffer Word8
bbuf) Word64
offset Int
bytes
  case Maybe Int
res of
     Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, Buffer Word8
bbuf)
     Just Int
n  -> do let bbuf' :: Buffer Word8
bbuf' = forall e. Int -> Buffer e -> Buffer e
bufferAddOffset Int
n Buffer Word8
bbuf
                   forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Int
n, Buffer Word8
bbuf'{ bufR :: Int
bufR = forall e. Buffer e -> Int
bufR Buffer Word8
bbuf' forall a. Num a => a -> a -> a
+ Int
n })

writeBuf :: RawIO dev => dev -> Buffer Word8 -> IO (Buffer Word8)
writeBuf :: forall dev. RawIO dev => dev -> Buffer Word8 -> IO (Buffer Word8)
writeBuf dev
dev Buffer Word8
bbuf = do
  let bytes :: Int
bytes = forall e. Buffer e -> Int
bufferElems Buffer Word8
bbuf
  let offset :: Word64
offset = forall e. Buffer e -> Word64
bufferOffset Buffer Word8
bbuf
  forall e a. Buffer e -> (Ptr e -> IO a) -> IO a
withBuffer Buffer Word8
bbuf forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
      forall a. RawIO a => a -> Ptr Word8 -> Word64 -> Int -> IO ()
IODevice.write dev
dev (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall e. Buffer e -> Int
bufL Buffer Word8
bbuf) Word64
offset Int
bytes
  let bbuf' :: Buffer Word8
bbuf' = forall e. Int -> Buffer e -> Buffer e
bufferAddOffset Int
bytes Buffer Word8
bbuf
  forall (m :: * -> *) a. Monad m => a -> m a
return Buffer Word8
bbuf'{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 }

-- XXX ToDo
writeBufNonBlocking :: RawIO dev => dev -> Buffer Word8 -> IO (Int, Buffer Word8)
writeBufNonBlocking :: forall dev.
RawIO dev =>
dev -> Buffer Word8 -> IO (Int, Buffer Word8)
writeBufNonBlocking dev
dev Buffer Word8
bbuf = do
  let bytes :: Int
bytes = forall e. Buffer e -> Int
bufferElems Buffer Word8
bbuf
  let offset :: Word64
offset = forall e. Buffer e -> Word64
bufferOffset Buffer Word8
bbuf
  Int
res <- forall e a. Buffer e -> (Ptr e -> IO a) -> IO a
withBuffer Buffer Word8
bbuf forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
            forall a. RawIO a => a -> Ptr Word8 -> Word64 -> Int -> IO Int
IODevice.writeNonBlocking dev
dev (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall e. Buffer e -> Int
bufL Buffer Word8
bbuf) Word64
offset Int
bytes
  let bbuf' :: Buffer Word8
bbuf' = forall e. Int -> Buffer e -> Buffer e
bufferAddOffset Int
bytes Buffer Word8
bbuf
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res, forall e. Int -> Buffer e -> Buffer e
bufferAdjustL (forall e. Buffer e -> Int
bufL Buffer Word8
bbuf forall a. Num a => a -> a -> a
+ Int
res) Buffer Word8
bbuf')