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

-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.Directory.ByteString
-- 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)
--
-- String-based POSIX directory support
--
-----------------------------------------------------------------------------



-- hack copied from System.Posix.Files

{-# LINE 25 "libraries/unix/System/Posix/Directory/ByteString.hsc" #-}

module System.Posix.Directory.ByteString (
   -- * Creating and removing directories
   createDirectory, removeDirectory,

   -- * Reading directories
   DirStream,
   openDirStream,
   readDirStream,
   readDirStreamMaybe,
   rewindDirStream,
   closeDirStream,
   DirStreamOffset,

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

{-# LINE 41 "libraries/unix/System/Posix/Directory/ByteString.hsc" #-}

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

{-# LINE 44 "libraries/unix/System/Posix/Directory/ByteString.hsc" #-}

   -- * The working directory
   getWorkingDirectory,
   changeWorkingDirectory,
   changeWorkingDirectoryFd,
  ) where

import Data.Maybe
import System.Posix.Types
import Foreign
import Foreign.C

import Data.ByteString.Char8 as BC

import System.Posix.Directory.Common
import System.Posix.ByteString.FilePath

-- | @createDirectory dir mode@ calls @mkdir@ to
--   create a new directory, @dir@, with permissions based on
--  @mode@.
createDirectory :: RawFilePath -> FileMode -> IO ()
createDirectory :: RawFilePath -> FileMode -> IO ()
createDirectory RawFilePath
name FileMode
mode =
  RawFilePath -> (CString -> IO ()) -> IO ()
forall a. RawFilePath -> (CString -> IO a) -> IO a
withFilePath RawFilePath
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s ->
    String -> RawFilePath -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> RawFilePath -> IO a -> IO ()
throwErrnoPathIfMinus1Retry_ String
"createDirectory" RawFilePath
name (CString -> FileMode -> IO CInt
c_mkdir CString
s FileMode
mode)
    -- POSIX doesn't allow mkdir() to return EINTR, but it does on
    -- OS X (#5184), so we need the Retry variant here.

foreign import ccall unsafe "mkdir"
  c_mkdir :: CString -> CMode -> IO CInt

-- | @openDirStream dir@ calls @opendir@ to obtain a
--   directory stream for @dir@.
openDirStream :: RawFilePath -> IO DirStream
openDirStream :: RawFilePath -> IO DirStream
openDirStream RawFilePath
name =
  RawFilePath -> (CString -> IO DirStream) -> IO DirStream
forall a. RawFilePath -> (CString -> IO a) -> IO a
withFilePath RawFilePath
name ((CString -> IO DirStream) -> IO DirStream)
-> (CString -> IO DirStream) -> IO DirStream
forall a b. (a -> b) -> a -> b
$ \CString
s -> do
    Ptr CDir
dirp <- String -> RawFilePath -> IO (Ptr CDir) -> IO (Ptr CDir)
forall a. String -> RawFilePath -> IO (Ptr a) -> IO (Ptr a)
throwErrnoPathIfNullRetry String
"openDirStream" RawFilePath
name (IO (Ptr CDir) -> IO (Ptr CDir)) -> IO (Ptr CDir) -> IO (Ptr CDir)
forall a b. (a -> b) -> a -> b
$ CString -> IO (Ptr CDir)
c_opendir CString
s
    DirStream -> IO DirStream
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CDir -> DirStream
DirStream Ptr CDir
dirp)

foreign import capi unsafe "HsUnix.h opendir"
   c_opendir :: CString  -> IO (Ptr CDir)

-- | @readDirStream dp@ calls @readdir@ to obtain the
--   next directory entry (@struct dirent@) for the open directory
--   stream @dp@, and returns the @d_name@ member of that
--  structure.
--
--  Note that this function returns an empty filepath if the end of the
--  directory stream is reached. For a safer alternative use
--  'readDirStreamMaybe'.
readDirStream :: DirStream -> IO RawFilePath
readDirStream :: DirStream -> IO RawFilePath
readDirStream = (Maybe RawFilePath -> RawFilePath)
-> IO (Maybe RawFilePath) -> IO RawFilePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RawFilePath -> Maybe RawFilePath -> RawFilePath
forall a. a -> Maybe a -> a
fromMaybe RawFilePath
BC.empty) (IO (Maybe RawFilePath) -> IO RawFilePath)
-> (DirStream -> IO (Maybe RawFilePath))
-> DirStream
-> IO RawFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirStream -> IO (Maybe RawFilePath)
readDirStreamMaybe

-- | @readDirStreamMaybe dp@ calls @readdir@ to obtain the
--   next directory entry (@struct dirent@) for the open directory
--   stream @dp@. It returns the @d_name@ member of that
--  structure wrapped in a @Just d_name@ if an entry was read and @Nothing@ if
--  the end of the directory stream was reached.
readDirStreamMaybe :: DirStream -> IO (Maybe RawFilePath)
readDirStreamMaybe :: DirStream -> IO (Maybe RawFilePath)
readDirStreamMaybe (DirStream Ptr CDir
dirp) =
  (Ptr (Ptr CDirent) -> IO (Maybe RawFilePath))
-> IO (Maybe RawFilePath)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr CDirent) -> IO (Maybe RawFilePath))
 -> IO (Maybe RawFilePath))
-> (Ptr (Ptr CDirent) -> IO (Maybe RawFilePath))
-> IO (Maybe RawFilePath)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CDirent)
ptr_dEnt  -> Ptr (Ptr CDirent) -> IO (Maybe RawFilePath)
loop Ptr (Ptr CDirent)
ptr_dEnt
 where
  loop :: Ptr (Ptr CDirent) -> IO (Maybe RawFilePath)
loop Ptr (Ptr CDirent)
ptr_dEnt = do
    IO ()
resetErrno
    CInt
r <- Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
c_readdir Ptr CDir
dirp Ptr (Ptr CDirent)
ptr_dEnt
    if (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)
         then do Ptr CDirent
dEnt <- Ptr (Ptr CDirent) -> IO (Ptr CDirent)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CDirent)
ptr_dEnt
                 if (Ptr CDirent
dEnt Ptr CDirent -> Ptr CDirent -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CDirent
forall a. Ptr a
nullPtr)
                    then Maybe RawFilePath -> IO (Maybe RawFilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RawFilePath
forall a. Maybe a
Nothing
                    else do
                     RawFilePath
entry <- (Ptr CDirent -> IO CString
d_name Ptr CDirent
dEnt IO CString -> (CString -> IO RawFilePath) -> IO RawFilePath
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO RawFilePath
peekFilePath)
                     Ptr CDirent -> IO ()
c_freeDirEnt Ptr CDirent
dEnt
                     Maybe RawFilePath -> IO (Maybe RawFilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RawFilePath -> IO (Maybe RawFilePath))
-> Maybe RawFilePath -> IO (Maybe RawFilePath)
forall a b. (a -> b) -> a -> b
$ RawFilePath -> Maybe RawFilePath
forall a. a -> Maybe a
Just RawFilePath
entry
         else do Errno
errno <- IO Errno
getErrno
                 if (Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eINTR) then Ptr (Ptr CDirent) -> IO (Maybe RawFilePath)
loop Ptr (Ptr CDirent)
ptr_dEnt else do
                 let (Errno CInt
eo) = Errno
errno
                 if (CInt
eo CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)
                    then Maybe RawFilePath -> IO (Maybe RawFilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RawFilePath
forall a. Maybe a
Nothing
                    else String -> IO (Maybe RawFilePath)
forall a. String -> IO a
throwErrno String
"readDirStream"

-- traversing directories
foreign import ccall unsafe "__hscore_readdir"
  c_readdir  :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt

foreign import ccall unsafe "__hscore_free_dirent"
  c_freeDirEnt  :: Ptr CDirent -> IO ()

foreign import ccall unsafe "__hscore_d_name"
  d_name :: Ptr CDirent -> IO CString


-- | @getWorkingDirectory@ calls @getcwd@ to obtain the name
--   of the current working directory.
getWorkingDirectory :: IO RawFilePath
getWorkingDirectory :: IO RawFilePath
getWorkingDirectory = Int -> IO RawFilePath
go (Int
4096)
{-# LINE 138 "libraries/unix/System/Posix/Directory/ByteString.hsc" #-}
  where
    go :: Int -> IO RawFilePath
go Int
bytes = do
        Maybe RawFilePath
r <- Int
-> (CString -> IO (Maybe RawFilePath)) -> IO (Maybe RawFilePath)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bytes ((CString -> IO (Maybe RawFilePath)) -> IO (Maybe RawFilePath))
-> (CString -> IO (Maybe RawFilePath)) -> IO (Maybe RawFilePath)
forall a b. (a -> b) -> a -> b
$ \CString
buf -> do
            CString
buf' <- CString -> CSize -> IO CString
c_getcwd CString
buf (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bytes)
            if CString
buf' CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr
                then do RawFilePath
s <- CString -> IO RawFilePath
peekFilePath CString
buf
                        Maybe RawFilePath -> IO (Maybe RawFilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RawFilePath -> Maybe RawFilePath
forall a. a -> Maybe a
Just RawFilePath
s)
                else do Errno
errno <- IO Errno
getErrno
                        if Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eRANGE
                            -- we use Nothing to indicate that we should
                            -- try again with a bigger buffer
                            then Maybe RawFilePath -> IO (Maybe RawFilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RawFilePath
forall a. Maybe a
Nothing
                            else String -> IO (Maybe RawFilePath)
forall a. String -> IO a
throwErrno String
"getWorkingDirectory"
        IO RawFilePath
-> (RawFilePath -> IO RawFilePath)
-> Maybe RawFilePath
-> IO RawFilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> IO RawFilePath
go (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bytes)) RawFilePath -> IO RawFilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RawFilePath
r

foreign import ccall unsafe "getcwd"
   c_getcwd   :: Ptr CChar -> CSize -> IO (Ptr CChar)

-- | @changeWorkingDirectory dir@ calls @chdir@ to change
--   the current working directory to @dir@.
changeWorkingDirectory :: RawFilePath -> IO ()
changeWorkingDirectory :: RawFilePath -> IO ()
changeWorkingDirectory RawFilePath
path =
  RawFilePath -> (CString -> IO ()) -> IO ()
forall a. RawFilePath -> (CString -> IO a) -> IO a
withFilePath RawFilePath
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s ->
     String -> RawFilePath -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> RawFilePath -> IO a -> IO ()
throwErrnoPathIfMinus1Retry_ String
"changeWorkingDirectory" RawFilePath
path (CString -> IO CInt
c_chdir CString
s)

foreign import ccall unsafe "chdir"
   c_chdir :: CString -> IO CInt

removeDirectory :: RawFilePath -> IO ()
removeDirectory :: RawFilePath -> IO ()
removeDirectory RawFilePath
path =
  RawFilePath -> (CString -> IO ()) -> IO ()
forall a. RawFilePath -> (CString -> IO a) -> IO a
withFilePath RawFilePath
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s ->
     String -> RawFilePath -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> RawFilePath -> IO a -> IO ()
throwErrnoPathIfMinus1Retry_ String
"removeDirectory" RawFilePath
path (CString -> IO CInt
c_rmdir CString
s)

foreign import ccall unsafe "rmdir"
   c_rmdir :: CString -> IO CInt