Fix conditional pragma to work with 6.12
[packages/unix.git] / System / Posix / Directory.hsc
1 {-# LANGUAGE ForeignFunctionInterface #-}
2 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
3 #if __GLASGOW_HASKELL__ >= 701
4 {-# LANGUAGE Trustworthy #-}
5 #endif
6 -----------------------------------------------------------------------------
7 -- |
8 -- Module      :  System.Posix.Files
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 directory support
17 --
18 -----------------------------------------------------------------------------
19
20 module System.Posix.Directory (
21    -- * Creating and removing directories
22    createDirectory, removeDirectory,
23
24    -- * Reading directories
25    DirStream,
26    openDirStream,
27    readDirStream,
28    rewindDirStream,   
29    closeDirStream,
30    DirStreamOffset,
31    tellDirStream,
32    seekDirStream,
33
34    -- * The working dirctory
35    getWorkingDirectory,
36    changeWorkingDirectory,
37    changeWorkingDirectoryFd,
38   ) where
39
40 import System.IO.Error
41 import System.Posix.Error
42 import System.Posix.Types
43 import Foreign
44 import Foreign.C
45 #if __GLASGOW_HASKELL__ > 700
46 import System.Posix.Internals (withFilePath, peekFilePath)
47 #elif __GLASGOW_HASKELL__ > 611
48 import System.Posix.Internals (withFilePath)
49
50 peekFilePath :: CString -> IO FilePath
51 peekFilePath = peekCString
52 #else
53 withFilePath :: FilePath -> (CString -> IO a) -> IO a
54 withFilePath = withCString
55
56 peekFilePath :: CString -> IO FilePath
57 peekFilePath = peekCString
58 #endif
59
60 -- | @createDirectory dir mode@ calls @mkdir@ to 
61 --   create a new directory, @dir@, with permissions based on
62 --  @mode@.
63 createDirectory :: FilePath -> FileMode -> IO ()
64 createDirectory name mode =
65   withFilePath name $ \s -> 
66     throwErrnoPathIfMinus1Retry_ "createDirectory" name (c_mkdir s mode)  
67     -- POSIX doesn't allow mkdir() to return EINTR, but it does on
68     -- OS X (#5184), so we need the Retry variant here.
69
70 foreign import ccall unsafe "mkdir"
71   c_mkdir :: CString -> CMode -> IO CInt
72
73 newtype DirStream = DirStream (Ptr CDir)
74
75 -- | @openDirStream dir@ calls @opendir@ to obtain a
76 --   directory stream for @dir@.
77 openDirStream :: FilePath -> IO DirStream
78 openDirStream name =
79   withFilePath name $ \s -> do
80     dirp <- throwErrnoPathIfNullRetry "openDirStream" name $ c_opendir s
81     return (DirStream dirp)
82
83 foreign import ccall unsafe "__hsunix_opendir"
84    c_opendir :: CString  -> IO (Ptr CDir)
85
86 -- | @readDirStream dp@ calls @readdir@ to obtain the
87 --   next directory entry (@struct dirent@) for the open directory
88 --   stream @dp@, and returns the @d_name@ member of that
89 --  structure.
90 readDirStream :: DirStream -> IO FilePath
91 readDirStream (DirStream dirp) =
92   alloca $ \ptr_dEnt  -> loop ptr_dEnt
93  where
94   loop ptr_dEnt = do
95     resetErrno
96     r <- c_readdir dirp ptr_dEnt
97     if (r == 0)
98          then do dEnt <- peek ptr_dEnt
99                  if (dEnt == nullPtr)
100                     then return []
101                     else do
102                      entry <- (d_name dEnt >>= peekFilePath)
103                      c_freeDirEnt dEnt
104                      return entry
105          else do errno <- getErrno
106                  if (errno == eINTR) then loop ptr_dEnt else do
107                  let (Errno eo) = errno
108                  if (eo == 0)
109                     then return []
110                     else throwErrno "readDirStream"
111
112 type CDir       = ()
113 type CDirent    = ()
114
115 -- traversing directories
116 foreign import ccall unsafe "__hscore_readdir"
117   c_readdir  :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
118
119 foreign import ccall unsafe "__hscore_free_dirent"
120   c_freeDirEnt  :: Ptr CDirent -> IO ()
121
122 foreign import ccall unsafe "__hscore_d_name"
123   d_name :: Ptr CDirent -> IO CString
124
125 -- | @rewindDirStream dp@ calls @rewinddir@ to reposition
126 --   the directory stream @dp@ at the beginning of the directory.
127 rewindDirStream :: DirStream -> IO ()
128 rewindDirStream (DirStream dirp) = c_rewinddir dirp
129
130 foreign import ccall unsafe "rewinddir"
131    c_rewinddir :: Ptr CDir -> IO ()
132
133 -- | @closeDirStream dp@ calls @closedir@ to close
134 --   the directory stream @dp@.
135 closeDirStream :: DirStream -> IO ()
136 closeDirStream (DirStream dirp) = do
137   throwErrnoIfMinus1Retry_ "closeDirStream" (c_closedir dirp)
138
139 foreign import ccall unsafe "closedir"
140    c_closedir :: Ptr CDir -> IO CInt
141
142 newtype DirStreamOffset = DirStreamOffset COff
143
144 seekDirStream :: DirStream -> DirStreamOffset -> IO ()
145 seekDirStream (DirStream dirp) (DirStreamOffset off) =
146   c_seekdir dirp off
147
148 foreign import ccall unsafe "seekdir"
149   c_seekdir :: Ptr CDir -> COff -> IO ()
150
151 tellDirStream :: DirStream -> IO DirStreamOffset
152 tellDirStream (DirStream dirp) = do
153   off <- c_telldir dirp
154   return (DirStreamOffset off)
155
156 foreign import ccall unsafe "telldir"
157   c_telldir :: Ptr CDir -> IO COff
158
159 {-
160  Renamings of functionality provided via Directory interface,
161  kept around for b.wards compatibility and for having more POSIXy
162  names
163 -}
164
165 -- | @getWorkingDirectory@ calls @getcwd@ to obtain the name
166 --   of the current working directory.
167 getWorkingDirectory :: IO FilePath
168 getWorkingDirectory = do
169   p <- mallocBytes long_path_size
170   go p long_path_size
171   where go p bytes = do
172           p' <- c_getcwd p (fromIntegral bytes)
173           if p' /= nullPtr 
174              then do s <- peekFilePath p'
175                      free p'
176                      return s
177              else do errno <- getErrno
178                      if errno == eRANGE
179                         then do let bytes' = bytes * 2
180                                 p'' <- reallocBytes p bytes'
181                                 go p'' bytes'
182                         else throwErrno "getCurrentDirectory"
183
184 foreign import ccall unsafe "getcwd"
185    c_getcwd   :: Ptr CChar -> CSize -> IO (Ptr CChar)
186
187 foreign import ccall unsafe "__hsunix_long_path_size"
188   long_path_size :: Int
189
190 -- | @changeWorkingDirectory dir@ calls @chdir@ to change
191 --   the current working directory to @dir@.
192 changeWorkingDirectory :: FilePath -> IO ()
193 changeWorkingDirectory path =
194   modifyIOError (`ioeSetFileName` path) $
195     withFilePath path $ \s -> 
196        throwErrnoIfMinus1Retry_ "changeWorkingDirectory" (c_chdir s)
197
198 foreign import ccall unsafe "chdir"
199    c_chdir :: CString -> IO CInt
200
201 removeDirectory :: FilePath -> IO ()
202 removeDirectory path =
203   modifyIOError (`ioeSetFileName` path) $
204     withFilePath path $ \s ->
205        throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
206
207 foreign import ccall unsafe "rmdir"
208    c_rmdir :: CString -> IO CInt
209
210 changeWorkingDirectoryFd :: Fd -> IO ()
211 changeWorkingDirectoryFd (Fd fd) = 
212   throwErrnoIfMinus1Retry_ "changeWorkingDirectoryFd" (c_fchdir fd)
213
214 foreign import ccall unsafe "fchdir"
215   c_fchdir :: CInt -> IO CInt