{-# OPTIONS_GHC -cpp #-} module System.Posix.Files where import Foreign.Marshal.Alloc ( allocaBytes ) import Foreign.C.Error ( throwErrnoIfMinus1Retry ) import Foreign.C.String ( withCString ) import Foreign.C.Types ( CTime, CInt ) import Foreign.Ptr ( Ptr ) import System.Posix.Internals ( FDType, CStat, c_fstat, lstat, sizeof_stat, statGetType, st_mode, st_size, st_mtime, s_isreg, s_isdir, s_isfifo, ) import System.Posix.Types ( Fd(..), CMode, EpochTime, FileMode ) import Data.Bits ( (.|.) ) #if mingw32_HOST_OS import Data.Int ( Int64 ) #else import System.Posix.Types ( FileOffset ) #endif ##if mingw32_HOST_OS type FileOffset = Int64 ##endif data FileStatus = FileStatus { fst_type :: FDType, fst_mode :: CMode, fst_mtime :: CTime, fst_size :: FileOffset } getFdStatus :: Fd -> IO FileStatus getFdStatus (Fd fd) = do do_stat (c_fstat fd) do_stat :: (Ptr CStat -> IO CInt) -> IO FileStatus do_stat stat_func = do allocaBytes sizeof_stat $ \p -> do throwErrnoIfMinus1Retry "do_stat" $ stat_func p tp <- statGetType p mode <- st_mode p mtime <- st_mtime p size <- st_size p return (FileStatus tp mode mtime (fromIntegral size)) isNamedPipe :: FileStatus -> Bool isNamedPipe = s_isfifo . fst_mode isDirectory :: FileStatus -> Bool isDirectory = s_isdir . fst_mode isRegularFile :: FileStatus -> Bool isRegularFile = s_isreg . fst_mode isSymbolicLink :: FileStatus -> Bool isSymbolicLink = const False linkCount :: FileStatus -> Int linkCount _ = 1 modificationTime :: FileStatus -> EpochTime modificationTime = fst_mtime fileSize :: FileStatus -> FileOffset fileSize = fst_size fileMode :: () -> () fileMode _ = () getFileStatus :: FilePath -> IO () getFileStatus _ = return () setFileMode :: FilePath -> () -> IO () setFileMode _ _ = return () #include stdFileMode :: FileMode stdFileMode = (#const S_IRUSR) .|. (#const S_IWUSR) getSymbolicLinkStatus :: FilePath -> IO FileStatus getSymbolicLinkStatus fp = do_stat (\p -> (fp `withCString` (`lstat` p))) -- Dummy implementation of createLink. createLink :: FilePath -> FilePath -> IO () createLink _ _ = fail "Dummy create link error should be caught."