1#if __GLASGOW_HASKELL__ >= 709
2{-# LANGUAGE Safe #-}
3#else
4{-# LANGUAGE Trustworthy #-}
5#endif
6
7-----------------------------------------------------------------------------
8-- |
9-- Module      :  System.Posix.Directory.Common
10-- Copyright   :  (c) The University of Glasgow 2002
11-- License     :  BSD-style (see the file libraries/base/LICENSE)
12--
13-- Maintainer  :  libraries@haskell.org
14-- Stability   :  provisional
15-- Portability :  non-portable (requires POSIX)
16--
17-- POSIX directory support
18--
19-----------------------------------------------------------------------------
20
21#include "HsUnix.h"
22
23module System.Posix.Directory.Common (
24       DirStream(..), CDir, CDirent, DirStreamOffset(..),
25       rewindDirStream,
26       closeDirStream,
27#ifdef HAVE_SEEKDIR
28       seekDirStream,
29#endif
30#ifdef HAVE_TELLDIR
31       tellDirStream,
32#endif
33       changeWorkingDirectoryFd,
34  ) where
35
36import System.Posix.Types
37import Foreign
38import Foreign.C
39
40newtype DirStream = DirStream (Ptr CDir)
41
42data {-# CTYPE "DIR" #-} CDir
43data {-# CTYPE "struct dirent" #-} CDirent
44
45-- | @rewindDirStream dp@ calls @rewinddir@ to reposition
46--   the directory stream @dp@ at the beginning of the directory.
47rewindDirStream :: DirStream -> IO ()
48rewindDirStream (DirStream dirp) = c_rewinddir dirp
49
50foreign import ccall unsafe "rewinddir"
51   c_rewinddir :: Ptr CDir -> IO ()
52
53-- | @closeDirStream dp@ calls @closedir@ to close
54--   the directory stream @dp@.
55closeDirStream :: DirStream -> IO ()
56closeDirStream (DirStream dirp) = do
57  throwErrnoIfMinus1Retry_ "closeDirStream" (c_closedir dirp)
58
59foreign import ccall unsafe "closedir"
60   c_closedir :: Ptr CDir -> IO CInt
61
62newtype DirStreamOffset = DirStreamOffset COff
63
64#ifdef HAVE_SEEKDIR
65seekDirStream :: DirStream -> DirStreamOffset -> IO ()
66seekDirStream (DirStream dirp) (DirStreamOffset off) =
67  c_seekdir dirp (fromIntegral off) -- TODO: check for CLong/COff overflow
68
69foreign import ccall unsafe "seekdir"
70  c_seekdir :: Ptr CDir -> CLong -> IO ()
71#endif
72
73#ifdef HAVE_TELLDIR
74tellDirStream :: DirStream -> IO DirStreamOffset
75tellDirStream (DirStream dirp) = do
76  off <- c_telldir dirp
77  return (DirStreamOffset (fromIntegral off)) -- TODO: check for overflow
78
79foreign import ccall unsafe "telldir"
80  c_telldir :: Ptr CDir -> IO CLong
81#endif
82
83changeWorkingDirectoryFd :: Fd -> IO ()
84changeWorkingDirectoryFd (Fd fd) =
85  throwErrnoIfMinus1Retry_ "changeWorkingDirectoryFd" (c_fchdir fd)
86
87foreign import ccall unsafe "fchdir"
88  c_fchdir :: CInt -> IO CInt
89