{-# 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 (
-- lower-level stuff
  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





----------------------------------------------------------
-- dodgy stuff

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

-- Posix doesn't export DirStream, so to re-use that type we need to use
-- unsafeCoerce.  It's just a newtype, so this is a legitimate usage.
-- ugly trick.
unpackDirStream :: DirStream -> Ptr CDir
unpackDirStream :: DirStream -> Ptr CDir
unpackDirStream = DirStream -> Ptr CDir
forall a b. a -> b
unsafeCoerce

-- the __hscore_* functions are defined in the unix package.  We can import them and let
-- the linker figure it out.
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

----------------------------------------------------------
-- less dodgy but still lower-level


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)