{-# LINE 1 "libraries/unix/System/Posix/Directory/Common.hsc" #-}
{-# LANGUAGE Safe, CApiFFI #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.Directory.Common
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  non-portable (requires POSIX)
--
-- POSIX directory support
--
-----------------------------------------------------------------------------



module System.Posix.Directory.Common (
       DirStream(..), CDir, CDirent, DirStreamOffset(..),
       unsafeOpenDirStreamFd,
       rewindDirStream,
       closeDirStream,

{-# LINE 25 "libraries/unix/System/Posix/Directory/Common.hsc" #-}
       seekDirStream,

{-# LINE 27 "libraries/unix/System/Posix/Directory/Common.hsc" #-}

{-# LINE 28 "libraries/unix/System/Posix/Directory/Common.hsc" #-}
       tellDirStream,

{-# LINE 30 "libraries/unix/System/Posix/Directory/Common.hsc" #-}
       changeWorkingDirectoryFd,
  ) where

import Control.Exception (mask_)
import Control.Monad (void, when)
import System.Posix.Types
import Foreign hiding (void)
import Foreign.C

newtype DirStream = DirStream (Ptr CDir)

data {-# CTYPE "DIR" #-} CDir
data {-# CTYPE "struct dirent" #-} CDirent

-- | Call @fdopendir@ to obtain a directory stream for @fd@. @fd@ must not be
-- otherwise used after this.
--
-- On success, it is owned by the returned 'DirStream', which should be closed
-- via 'closeDirStream' when no longer needed.  On error, the file descriptor
-- is automatically closed and then an exception is thrown.  There is no code
-- path in which the file descriptor remains open and yet not owned by a
-- returned 'DirStream'.
--
-- The input file descriptor must not have been used with @threadWaitRead@ or
-- @threadWaitWrite@.
unsafeOpenDirStreamFd :: Fd -> IO DirStream
unsafeOpenDirStreamFd :: Fd -> IO DirStream
unsafeOpenDirStreamFd (Fd CInt
fd) = IO DirStream -> IO DirStream
forall a. IO a -> IO a
mask_ (IO DirStream -> IO DirStream) -> IO DirStream -> IO DirStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr CDir
ptr <- CInt -> IO (Ptr CDir)
c_fdopendir CInt
fd
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr CDir
ptr Ptr CDir -> Ptr CDir -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CDir
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Errno
errno <- IO Errno
getErrno
        IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> IO CInt
c_close CInt
fd
        IOError -> IO ()
forall a. IOError -> IO a
ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
"openDirStreamFd" Errno
errno Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
    DirStream -> IO DirStream
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DirStream -> IO DirStream) -> DirStream -> IO DirStream
forall a b. (a -> b) -> a -> b
$ Ptr CDir -> DirStream
DirStream Ptr CDir
ptr

-- We need c_close here, because 'closeFd' throws exceptions on error,
-- but we want to silently close the (presumably directory) descriptor.
foreign import ccall unsafe "HsUnix.h close"
   c_close :: CInt -> IO CInt

-- NOTE: It is /critical/ to use "capi" and "dirent.h" here, because system
-- headers on e.g. macOS alias this function, and linking directly to the
-- "fdopendir" symbol in libc leads to a crash!
--
foreign import capi unsafe "dirent.h fdopendir"
    c_fdopendir :: CInt -> IO (Ptr CDir)

-- | @rewindDirStream dp@ calls @rewinddir@ to reposition
--   the directory stream @dp@ at the beginning of the directory.
rewindDirStream :: DirStream -> IO ()
rewindDirStream :: DirStream -> IO ()
rewindDirStream (DirStream Ptr CDir
dirp) = Ptr CDir -> IO ()
c_rewinddir Ptr CDir
dirp

foreign import ccall unsafe "rewinddir"
   c_rewinddir :: Ptr CDir -> IO ()

-- | @closeDirStream dp@ calls @closedir@ to close
--   the directory stream @dp@.
closeDirStream :: DirStream -> IO ()
closeDirStream :: DirStream -> IO ()
closeDirStream (DirStream Ptr CDir
dirp) = do
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"closeDirStream" (Ptr CDir -> IO CInt
c_closedir Ptr CDir
dirp)

foreign import ccall unsafe "closedir"
   c_closedir :: Ptr CDir -> IO CInt

newtype DirStreamOffset = DirStreamOffset COff


{-# LINE 96 "libraries/unix/System/Posix/Directory/Common.hsc" #-}
seekDirStream :: DirStream -> DirStreamOffset -> IO ()
seekDirStream :: DirStream -> DirStreamOffset -> IO ()
seekDirStream (DirStream Ptr CDir
dirp) (DirStreamOffset COff
off) =
  Ptr CDir -> CLong -> IO ()
c_seekdir Ptr CDir
dirp (COff -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral COff
off) -- TODO: check for CLong/COff overflow

foreign import ccall unsafe "seekdir"
  c_seekdir :: Ptr CDir -> CLong -> IO ()

{-# LINE 103 "libraries/unix/System/Posix/Directory/Common.hsc" #-}


{-# LINE 105 "libraries/unix/System/Posix/Directory/Common.hsc" #-}
tellDirStream :: DirStream -> IO DirStreamOffset
tellDirStream :: DirStream -> IO DirStreamOffset
tellDirStream (DirStream Ptr CDir
dirp) = do
  CLong
off <- Ptr CDir -> IO CLong
c_telldir Ptr CDir
dirp
  DirStreamOffset -> IO DirStreamOffset
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (COff -> DirStreamOffset
DirStreamOffset (CLong -> COff
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
off)) -- TODO: check for overflow

foreign import ccall unsafe "telldir"
  c_telldir :: Ptr CDir -> IO CLong

{-# LINE 113 "libraries/unix/System/Posix/Directory/Common.hsc" #-}

changeWorkingDirectoryFd :: Fd -> IO ()
changeWorkingDirectoryFd :: Fd -> IO ()
changeWorkingDirectoryFd (Fd CInt
fd) =
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"changeWorkingDirectoryFd" (CInt -> IO CInt
c_fchdir CInt
fd)

foreign import ccall unsafe "fchdir"
  c_fchdir :: CInt -> IO CInt