1{-# LANGUAGE Trustworthy #-}
2{-# LANGUAGE NoImplicitPrelude #-}
3{-# OPTIONS_GHC -funbox-strict-fields #-}
4
5-----------------------------------------------------------------------------
6-- |
7-- Module      :  GHC.IO.BufferedIO
8-- Copyright   :  (c) The University of Glasgow 2008
9-- License     :  see libraries/base/LICENSE
10--
11-- Maintainer  :  cvs-ghc@haskell.org
12-- Stability   :  internal
13-- Portability :  non-portable (GHC Extensions)
14--
15-- Class of buffered IO devices
16--
17-----------------------------------------------------------------------------
18
19module GHC.IO.BufferedIO (
20        BufferedIO(..),
21        readBuf, readBufNonBlocking, writeBuf, writeBufNonBlocking
22    ) where
23
24import GHC.Base
25import GHC.Ptr
26import Data.Word
27import GHC.Num
28import GHC.IO.Device as IODevice
29import GHC.IO.Device as RawIO
30import GHC.IO.Buffer
31
32-- | The purpose of 'BufferedIO' is to provide a common interface for I/O
33-- devices that can read and write data through a buffer.  Devices that
34-- implement 'BufferedIO' include ordinary files, memory-mapped files,
35-- and bytestrings.  The underlying device implementing a 'System.IO.Handle'
36-- must provide 'BufferedIO'.
37--
38class BufferedIO dev where
39  -- | allocate a new buffer.  The size of the buffer is at the
40  -- discretion of the device; e.g. for a memory-mapped file the
41  -- buffer will probably cover the entire file.
42  newBuffer         :: dev -> BufferState -> IO (Buffer Word8)
43
44  -- | reads bytes into the buffer, blocking if there are no bytes
45  -- available.  Returns the number of bytes read (zero indicates
46  -- end-of-file), and the new buffer.
47  fillReadBuffer    :: dev -> Buffer Word8 -> IO (Int, Buffer Word8)
48
49  -- | reads bytes into the buffer without blocking.  Returns the
50  -- number of bytes read (Nothing indicates end-of-file), and the new
51  -- buffer.
52  fillReadBuffer0   :: dev -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
53
54  -- | Prepares an empty write buffer.  This lets the device decide
55  -- how to set up a write buffer: the buffer may need to point to a
56  -- specific location in memory, for example.  This is typically used
57  -- by the client when switching from reading to writing on a
58  -- buffered read/write device.
59  --
60  -- There is no corresponding operation for read buffers, because before
61  -- reading the client will always call 'fillReadBuffer'.
62  emptyWriteBuffer  :: dev -> Buffer Word8 -> IO (Buffer Word8)
63  emptyWriteBuffer _dev buf
64    = return buf{ bufL=0, bufR=0, bufState = WriteBuffer }
65
66  -- | Flush all the data from the supplied write buffer out to the device.
67  -- The returned buffer should be empty, and ready for writing.
68  flushWriteBuffer  :: dev -> Buffer Word8 -> IO (Buffer Word8)
69
70  -- | Flush data from the supplied write buffer out to the device
71  -- without blocking.  Returns the number of bytes written and the
72  -- remaining buffer.
73  flushWriteBuffer0 :: dev -> Buffer Word8 -> IO (Int, Buffer Word8)
74
75-- for an I/O device, these operations will perform reading/writing
76-- to/from the device.
77
78-- for a memory-mapped file, the buffer will be the whole file in
79-- memory.  fillReadBuffer sets the pointers to encompass the whole
80-- file, and flushWriteBuffer needs to do no I/O.  A memory-mapped
81-- file has to maintain its own file pointer.
82
83-- for a bytestring, again the buffer should match the bytestring in
84-- memory.
85
86-- ---------------------------------------------------------------------------
87-- Low-level read/write to/from buffers
88
89-- These operations make it easy to implement an instance of 'BufferedIO'
90-- for an object that supports 'RawIO'.
91
92readBuf :: RawIO dev => dev -> Buffer Word8 -> IO (Int, Buffer Word8)
93readBuf dev bbuf = do
94  let bytes = bufferAvailable bbuf
95  res <- withBuffer bbuf $ \ptr ->
96             RawIO.read dev (ptr `plusPtr` bufR bbuf) bytes
97  return (res, bbuf{ bufR = bufR bbuf + res })
98         -- zero indicates end of file
99
100readBufNonBlocking :: RawIO dev => dev -> Buffer Word8
101                     -> IO (Maybe Int,   -- Nothing ==> end of file
102                                         -- Just n  ==> n bytes were read (n>=0)
103                            Buffer Word8)
104readBufNonBlocking dev bbuf = do
105  let bytes = bufferAvailable bbuf
106  res <- withBuffer bbuf $ \ptr ->
107           IODevice.readNonBlocking dev (ptr `plusPtr` bufR bbuf) bytes
108  case res of
109     Nothing -> return (Nothing, bbuf)
110     Just n  -> return (Just n, bbuf{ bufR = bufR bbuf + n })
111
112writeBuf :: RawIO dev => dev -> Buffer Word8 -> IO (Buffer Word8)
113writeBuf dev bbuf = do
114  let bytes = bufferElems bbuf
115  withBuffer bbuf $ \ptr ->
116      IODevice.write dev (ptr `plusPtr` bufL bbuf) bytes
117  return bbuf{ bufL=0, bufR=0 }
118
119-- XXX ToDo
120writeBufNonBlocking :: RawIO dev => dev -> Buffer Word8 -> IO (Int, Buffer Word8)
121writeBufNonBlocking dev bbuf = do
122  let bytes = bufferElems bbuf
123  res <- withBuffer bbuf $ \ptr ->
124            IODevice.writeNonBlocking dev (ptr `plusPtr` bufL bbuf) bytes
125  return (res, bufferAdjustL (bufL bbuf + res) bbuf)
126
127