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

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

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

import GHC.Internal.Base
import GHC.Internal.Ptr
import GHC.Internal.Word
import GHC.Internal.Num
import GHC.Internal.IO.Device as IODevice
import GHC.Internal.IO.Device as RawIO
import GHC.Internal.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
    = Buffer Word8 -> IO (Buffer Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer Word8
buf{ bufL=0, bufR=0, bufState = 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 = Buffer Word8 -> Int
forall e. Buffer e -> Int
bufferAvailable Buffer Word8
bbuf
  let offset :: Word64
offset = Buffer Word8 -> Word64
forall e. Buffer e -> Word64
bufferOffset Buffer Word8
bbuf
  res <- Buffer Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall e a. Buffer e -> (Ptr e -> IO a) -> IO a
withBuffer Buffer Word8
bbuf ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
             dev -> Ptr Word8 -> Word64 -> Int -> IO Int
forall a. RawIO a => a -> Ptr Word8 -> Word64 -> Int -> IO Int
RawIO.read dev
dev (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Buffer Word8 -> Int
forall e. Buffer e -> Int
bufR Buffer Word8
bbuf) Word64
offset Int
bytes
  let bbuf' = Int -> Buffer Word8 -> Buffer Word8
forall e. Int -> Buffer e -> Buffer e
bufferAddOffset Int
res Buffer Word8
bbuf
  return (res, bbuf'{ bufR = bufR bbuf' + 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 = Buffer Word8 -> Int
forall e. Buffer e -> Int
bufferAvailable Buffer Word8
bbuf
  let offset :: Word64
offset = Buffer Word8 -> Word64
forall e. Buffer e -> Word64
bufferOffset Buffer Word8
bbuf
  res <- Buffer Word8 -> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall e a. Buffer e -> (Ptr e -> IO a) -> IO a
withBuffer Buffer Word8
bbuf ((Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int))
-> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
           dev -> Ptr Word8 -> Word64 -> Int -> IO (Maybe Int)
forall a.
RawIO a =>
a -> Ptr Word8 -> Word64 -> Int -> IO (Maybe Int)
IODevice.readNonBlocking dev
dev (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Buffer Word8 -> Int
forall e. Buffer e -> Int
bufR Buffer Word8
bbuf) Word64
offset Int
bytes
  case res of
     Maybe Int
Nothing -> (Maybe Int, Buffer Word8) -> IO (Maybe Int, Buffer Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int
forall a. Maybe a
Nothing, Buffer Word8
bbuf)
     Just Int
n  -> do let bbuf' :: Buffer Word8
bbuf' = Int -> Buffer Word8 -> Buffer Word8
forall e. Int -> Buffer e -> Buffer e
bufferAddOffset Int
n Buffer Word8
bbuf
                   (Maybe Int, Buffer Word8) -> IO (Maybe Int, Buffer Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n, Buffer Word8
bbuf'{ bufR = bufR bbuf' + 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 = Buffer Word8 -> Int
forall e. Buffer e -> Int
bufferElems Buffer Word8
bbuf
  let offset :: Word64
offset = Buffer Word8 -> Word64
forall e. Buffer e -> Word64
bufferOffset Buffer Word8
bbuf
  Buffer Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall e a. Buffer e -> (Ptr e -> IO a) -> IO a
withBuffer Buffer Word8
bbuf ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
      dev -> Ptr Word8 -> Word64 -> Int -> IO ()
forall a. RawIO a => a -> Ptr Word8 -> Word64 -> Int -> IO ()
IODevice.write dev
dev (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Buffer Word8 -> Int
forall e. Buffer e -> Int
bufL Buffer Word8
bbuf) Word64
offset Int
bytes
  let bbuf' :: Buffer Word8
bbuf' = Int -> Buffer Word8 -> Buffer Word8
forall e. Int -> Buffer e -> Buffer e
bufferAddOffset Int
bytes Buffer Word8
bbuf
  Buffer Word8 -> IO (Buffer Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer Word8
bbuf'{ bufL=0, bufR=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 = Buffer Word8 -> Int
forall e. Buffer e -> Int
bufferElems Buffer Word8
bbuf
  let offset :: Word64
offset = Buffer Word8 -> Word64
forall e. Buffer e -> Word64
bufferOffset Buffer Word8
bbuf
  res <- Buffer Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall e a. Buffer e -> (Ptr e -> IO a) -> IO a
withBuffer Buffer Word8
bbuf ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
            dev -> Ptr Word8 -> Word64 -> Int -> IO Int
forall a. RawIO a => a -> Ptr Word8 -> Word64 -> Int -> IO Int
IODevice.writeNonBlocking dev
dev (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Buffer Word8 -> Int
forall e. Buffer e -> Int
bufL Buffer Word8
bbuf) Word64
offset Int
bytes
  let bbuf' = Int -> Buffer Word8 -> Buffer Word8
forall e. Int -> Buffer e -> Buffer e
bufferAddOffset Int
bytes Buffer Word8
bbuf
  return (res, bufferAdjustL (bufL bbuf + res) bbuf')