src/win32/System/Posix/Files.hsc

   1 {-# OPTIONS_GHC -cpp #-}
   2 module System.Posix.Files where
   3
   4 import Foreign.Marshal.Alloc ( allocaBytes )
   5 import Foreign.C.Error ( throwErrnoIfMinus1Retry )
   6 import Foreign.C.String ( withCString )
   7 import Foreign.C.Types ( CTime, CInt )
   8 import Foreign.Ptr ( Ptr )
   9
  10 import System.Posix.Internals
  11           ( FDType, CStat, c_fstat, lstat,
  12             sizeof_stat, statGetType,
  13             st_mode, st_size, st_mtime,
  14             s_isreg, s_isdir, s_isfifo, )
  15 import System.Posix.Types ( Fd(..), CMode, EpochTime, FileMode )
  16
  17 import Data.Bits ( (.|.) )
  18
  19 #if mingw32_HOST_OS
  20 import Data.Int ( Int64 )
  21 #else
  22 import System.Posix.Types ( FileOffset )
  23 #endif
  24
  25 ##if mingw32_HOST_OS
  26 type FileOffset = Int64
  27 ##endif
  28
  29 data FileStatus = FileStatus {
  30     fst_type :: FDType,
  31     fst_mode :: CMode,
  32     fst_mtime :: CTime,
  33     fst_size :: FileOffset
  34  }
  35
  36 getFdStatus :: Fd -> IO FileStatus
  37 getFdStatus (Fd fd) = do
  38   do_stat (c_fstat fd)
  39
  40 do_stat :: (Ptr CStat -> IO CInt) -> IO FileStatus
  41 do_stat stat_func = do
  42   allocaBytes sizeof_stat $ \p -> do
  43     throwErrnoIfMinus1Retry "do_stat" $
  44       stat_func p
  45     tp <- statGetType p
  46     mode <- st_mode p
  47     mtime <- st_mtime p
  48     size <- st_size p
  49     return (FileStatus tp mode mtime (fromIntegral size))
  50
  51 isNamedPipe :: FileStatus -> Bool
  52 isNamedPipe = s_isfifo . fst_mode
  53
  54 isDirectory :: FileStatus -> Bool
  55 isDirectory = s_isdir . fst_mode
  56
  57 isRegularFile :: FileStatus -> Bool
  58 isRegularFile = s_isreg . fst_mode
  59
  60 isSymbolicLink :: FileStatus -> Bool
  61 isSymbolicLink = const False
  62
  63 linkCount :: FileStatus -> Int
  64 linkCount _ = 1
  65
  66 modificationTime :: FileStatus -> EpochTime
  67 modificationTime = fst_mtime
  68
  69 fileSize :: FileStatus -> FileOffset
  70 fileSize = fst_size
  71
  72 fileMode :: () -> ()
  73 fileMode _ = ()
  74
  75 getFileStatus :: FilePath -> IO ()
  76 getFileStatus _ = return ()
  77
  78 setFileMode :: FilePath -> () -> IO ()
  79 setFileMode _ _ = return ()
  80
  81 #include <sys/stat.h>
  82 stdFileMode :: FileMode
  83 stdFileMode = (#const S_IRUSR) .|. (#const S_IWUSR)
  84
  85
  86
  87 getSymbolicLinkStatus :: FilePath -> IO FileStatus
  88 getSymbolicLinkStatus fp =
  89   do_stat (\p -> (fp `withCString` (`lstat` p)))
  90
  91 -- Dummy implementation of createLink.
  92 createLink :: FilePath -> FilePath -> IO ()
  93 createLink _ _ = fail "Dummy create link error should be caught."