{-# LINE 1 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall #-}
module GHCup.Prelude.File.Posix.Traversals (
readDirEnt
, readDirEntPortable
, openDirStreamPortable
, closeDirStreamPortable
, unpackDirStream
, DirStreamPortable
) where
{-# LINE 31 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
import GHCup.Prelude.File.Posix.Foreign
import Unsafe.Coerce (unsafeCoerce)
import Foreign.C.Error
import Foreign.C.String
import Foreign.C.Types
import Foreign.Ptr
import Foreign.Storable
import System.Posix
import Foreign (alloca)
import System.Posix.Internals (peekFilePath)
import System.FilePath
data {-# CTYPE "DIR" #-} CDir
data {-# CTYPE "struct dirent" #-} CDirent
unpackDirStream :: DirStream -> Ptr CDir
unpackDirStream :: DirStream -> Ptr CDir
unpackDirStream = DirStream -> Ptr CDir
forall a b. a -> b
unsafeCoerce
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"
c_name :: Ptr CDirent -> IO CString
foreign import capi unsafe "dirutils.h __posixdir_d_type"
c_type :: Ptr CDirent -> IO DirType
readDirEnt :: DirStream -> IO (DirType, FilePath)
readDirEnt :: DirStream -> IO (DirType, FilePath)
readDirEnt (DirStream -> Ptr CDir
unpackDirStream -> Ptr CDir
dirp) =
(Ptr (Ptr CDirent) -> IO (DirType, FilePath))
-> IO (DirType, FilePath)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr CDirent) -> IO (DirType, FilePath))
-> IO (DirType, FilePath))
-> (Ptr (Ptr CDirent) -> IO (DirType, FilePath))
-> IO (DirType, FilePath)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CDirent)
ptr_dEnt -> Ptr (Ptr CDirent) -> IO (DirType, FilePath)
loop Ptr (Ptr CDirent)
ptr_dEnt
where
loop :: Ptr (Ptr CDirent) -> IO (DirType, FilePath)
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 (DirType, FilePath) -> IO (DirType, FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DirType
dtUnknown, FilePath
forall a. Monoid a => a
mempty)
else do
FilePath
dName <- Ptr CDirent -> IO CString
c_name Ptr CDirent
dEnt IO CString -> (CString -> IO FilePath) -> IO FilePath
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 FilePath
peekFilePath
DirType
dType <- Ptr CDirent -> IO DirType
c_type Ptr CDirent
dEnt
Ptr CDirent -> IO ()
c_freeDirEnt Ptr CDirent
dEnt
(DirType, FilePath) -> IO (DirType, FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DirType
dType, FilePath
dName)
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 (DirType, FilePath)
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 (DirType, FilePath) -> IO (DirType, FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DirType
dtUnknown, FilePath
forall a. Monoid a => a
mempty)
else FilePath -> IO (DirType, FilePath)
forall a. FilePath -> IO a
throwErrno FilePath
"readDirEnt"
newtype DirStreamPortable = DirStreamPortable (FilePath, DirStream)
openDirStreamPortable :: FilePath -> IO DirStreamPortable
openDirStreamPortable :: FilePath -> IO DirStreamPortable
openDirStreamPortable FilePath
fp = do
DirStream
dirs <- FilePath -> IO DirStream
openDirStream FilePath
fp
DirStreamPortable -> IO DirStreamPortable
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DirStreamPortable -> IO DirStreamPortable)
-> DirStreamPortable -> IO DirStreamPortable
forall a b. (a -> b) -> a -> b
$ (FilePath, DirStream) -> DirStreamPortable
DirStreamPortable (FilePath
fp, DirStream
dirs)
closeDirStreamPortable :: DirStreamPortable -> IO ()
closeDirStreamPortable :: DirStreamPortable -> IO ()
closeDirStreamPortable (DirStreamPortable (FilePath
_, DirStream
dirs)) = DirStream -> IO ()
closeDirStream DirStream
dirs
readDirEntPortable :: DirStreamPortable -> IO (DirType, FilePath)
readDirEntPortable :: DirStreamPortable -> IO (DirType, FilePath)
readDirEntPortable (DirStreamPortable (FilePath
basedir, DirStream
dirs)) = do
(DirType
dt, FilePath
fp) <- DirStream -> IO (DirType, FilePath)
readDirEnt DirStream
dirs
case (DirType
dt, FilePath
fp) of
(DirType Int
6, FilePath
_) -> (DirType, FilePath) -> IO (DirType, FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DirType
dt, FilePath
fp)
{-# LINE 121 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
(DirType 2, _) -> pure (dt, fp)
{-# LINE 122 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
(DirType 4, _) -> pure (dt, fp)
{-# LINE 123 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
(DirType 1, _) -> pure (dt, fp)
{-# LINE 124 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
(DirType 10, _) -> pure (dt, fp)
{-# LINE 125 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
(DirType 8, _) -> pure (dt, fp)
{-# LINE 126 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
(DirType 12, _) -> pure (dt, fp)
{-# LINE 127 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
(_, _)
| fp /= "" -> do
stat <- getSymbolicLinkStatus (basedir </> fp)
pure $ (, fp) $ if | isBlockDevice stat -> DirType 6
{-# LINE 131 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
| isCharacterDevice stat -> DirType 2
{-# LINE 132 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
| isDirectory stat -> DirType 4
{-# LINE 133 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
| isNamedPipe stat -> DirType 1
{-# LINE 134 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
| isSymbolicLink stat -> DirType 10
{-# LINE 135 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
| isRegularFile stat -> DirType 8
{-# LINE 136 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
| isSocket stat -> DirType 12
{-# LINE 137 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
| otherwise -> DirType 0
{-# LINE 138 "lib/GHCup/Prelude/File/Posix/Traversals.hsc" #-}
| otherwise -> pure (dt, fp)