-
Notifications
You must be signed in to change notification settings - Fork 4
/
FileIO.hs
37 lines (32 loc) · 1.05 KB
/
FileIO.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
import Control.Concurrent.MVar
import Control.Exception
import Data.IORef
import Foreign.C.Error (throwErrnoIfMinus1Retry_)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Storable
import System.Directory
import System.Event
import System.IO
import System.Posix.IO
import System.Posix.Internals (c_close, c_read, c_write)
import System.Posix.Types (Fd(..))
readCallback :: MVar () -> IORef Int -> Int -> Fd -> Event -> IO ()
readCallback done counter count (Fd fd) evt = do
c <- atomicModifyIORef counter $ \x -> (x+1,x)
if c == count
then c_close fd >> putMVar done ()
else alloca $ \p -> do
throwErrnoIfMinus1Retry_ "read" $ c_read fd p 1
print =<< peek p
main = do
let numBytes = 4
bracket (openBinaryTempFile "." "FileIO.dat")
(\(path, h) -> hClose h >> removeFile path) $ \(path,h) -> do
hPutStr h (take numBytes ['a'..])
hSeek h AbsoluteSeek 0
mgr <- new
done <- newEmptyMVar
count <- newIORef 0
fd <- handleToFd h
registerFd mgr (readCallback done count numBytes) fd evtRead
takeMVar done