1#if __GLASGOW_HASKELL__ >= 709
2{-# LANGUAGE Safe #-}
3#else
4{-# LANGUAGE Trustworthy #-}
5#endif
6-----------------------------------------------------------------------------
7-- |
8-- Module      :  System.Posix.IO
9-- Copyright   :  (c) The University of Glasgow 2002
10-- License     :  BSD-style (see the file libraries/base/LICENSE)
11--
12-- Maintainer  :  libraries@haskell.org
13-- Stability   :  provisional
14-- Portability :  non-portable (requires POSIX)
15--
16-- POSIX IO support.  These types and functions correspond to the unix
17-- functions open(2), close(2), etc.  For more portable functions
18-- which are more like fopen(3) and friends from stdio.h, see
19-- "System.IO".
20--
21-----------------------------------------------------------------------------
22
23#include "HsUnix.h"
24
25module System.Posix.IO (
26    -- * Input \/ Output
27
28    -- ** Standard file descriptors
29    stdInput, stdOutput, stdError,
30
31    -- ** Opening and closing files
32    OpenMode(..),
33    OpenFileFlags(..), defaultFileFlags,
34    openFd, createFile,
35    closeFd,
36
37    -- ** Reading\/writing data
38    -- |Programmers using the 'fdRead' and 'fdWrite' API should be aware that
39    -- EAGAIN exceptions may occur for non-blocking IO!
40
41    fdRead, fdWrite,
42    fdReadBuf, fdWriteBuf,
43
44    -- ** Seeking
45    fdSeek,
46
47    -- ** File options
48    FdOption(..),
49    queryFdOption,
50    setFdOption,
51
52    -- ** Locking
53    FileLock,
54    LockRequest(..),
55    getLock,  setLock,
56    waitToSetLock,
57
58    -- ** Pipes
59    createPipe,
60
61    -- ** Duplicating file descriptors
62    dup, dupTo,
63
64    -- ** Converting file descriptors to\/from Handles
65    handleToFd,
66    fdToHandle,
67
68  ) where
69
70import System.Posix.Types
71import System.Posix.Error
72import System.Posix.IO.Common
73import System.Posix.Internals ( withFilePath )
74
75-- |Open and optionally create this file.  See 'System.Posix.Files'
76-- for information on how to use the 'FileMode' type.
77openFd :: FilePath
78       -> OpenMode
79       -> Maybe FileMode -- ^Just x => creates the file with the given modes, Nothing => the file must exist.
80       -> OpenFileFlags
81       -> IO Fd
82openFd name how maybe_mode flags = do
83   withFilePath name $ \str -> do
84     throwErrnoPathIfMinus1Retry "openFd" name $
85       open_ str how maybe_mode flags
86
87-- |Create and open this file in WriteOnly mode.  A special case of
88-- 'openFd'.  See 'System.Posix.Files' for information on how to use
89-- the 'FileMode' type.
90
91createFile :: FilePath -> FileMode -> IO Fd
92createFile name mode
93  = openFd name WriteOnly (Just mode) defaultFileFlags{ trunc=True }
94