X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FDirectory.hs;h=e179c93c6b0fa9d579d464d3dcee3d9db85243de;hb=3602419d95b3b8d807a5c7cb6d151ecc9166be86;hp=3ed120c972f3caff649b51e66bf0bb044a35eed4;hpb=c6d4830abce544d290e5887a18e909a401709996;p=haskell-directory.git

diff --git a/System/Directory.hs b/System/Directory.hs
index 3ed120c..e179c93 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -21,7 +21,9 @@ module System.Directory
 
     -- * Actions on directories
       createDirectory		-- :: FilePath -> IO ()
+#ifndef __NHC__
     , createDirectoryIfMissing  -- :: Bool -> FilePath -> IO ()
+#endif
     , removeDirectory		-- :: FilePath -> IO ()
     , removeDirectoryRecursive  -- :: FilePath -> IO ()
     , renameDirectory		-- :: FilePath -> FilePath -> IO ()
@@ -53,13 +55,16 @@ module System.Directory
 
     -- $permissions
 
-    , Permissions(
-	Permissions,
-	readable,		-- :: Permissions -> Bool
-	writable,		-- :: Permissions -> Bool
-	executable,		-- :: Permissions -> Bool
-	searchable		-- :: Permissions -> Bool
-      )
+    , Permissions
+    , emptyPermissions
+    , readable          -- :: Permissions -> Bool
+    , writable          -- :: Permissions -> Bool
+    , executable        -- :: Permissions -> Bool
+    , searchable        -- :: Permissions -> Bool
+    , setOwnerReadable
+    , setOwnerWritable
+    , setOwnerExecutable
+    , setOwnerSearchable
 
     , getPermissions            -- :: FilePath -> IO Permissions
     , setPermissions	        -- :: FilePath -> Permissions -> IO ()
@@ -82,9 +87,9 @@ import Control.Monad           ( when, unless )
 import Control.Exception.Base
 
 #ifdef __NHC__
-import Directory hiding ( getDirectoryContents
-                        , doesDirectoryExist, doesFileExist
-                        , getModificationTime )
+import Directory -- hiding ( getDirectoryContents
+                 --        , doesDirectoryExist, doesFileExist
+                 --        , getModificationTime )
 import System (system)
 #endif /* __NHC__ */
 
@@ -159,6 +164,26 @@ data Permissions
     executable, searchable :: Bool 
    } deriving (Eq, Ord, Read, Show)
 
+emptyPermissions :: Permissions
+emptyPermissions = Permissions {
+                       readable   = False,
+                       writable   = False,
+                       executable = False,
+                       searchable = False
+                   }
+
+setOwnerReadable :: Bool -> Permissions -> Permissions
+setOwnerReadable b p = p { readable = b }
+
+setOwnerWritable :: Bool -> Permissions -> Permissions
+setOwnerWritable b p = p { writable = b }
+
+setOwnerExecutable :: Bool -> Permissions -> Permissions
+setOwnerExecutable b p = p { executable = b }
+
+setOwnerSearchable :: Bool -> Permissions -> Permissions
+setOwnerSearchable b p = p { searchable = b }
+
 {- |The 'getPermissions' operation returns the
 permissions for the file or directory.
 
@@ -201,7 +226,7 @@ getPermissions name = do
   write_ok <- Posix.fileAccess name False True  False
   exec_ok  <- Posix.fileAccess name False False True
   stat <- Posix.getFileStatus name
-  let is_dir = Posix.fileMode stat .&. Posix.directoryMode /= 0
+  let is_dir = Posix.isDirectory stat
   return (
     Permissions {
       readable   = read_ok,
@@ -329,6 +354,7 @@ copyPermissions fromFPath toFPath
 
 #endif
 
+#ifndef __NHC__
 -- | @'createDirectoryIfMissing' parents dir@ creates a new directory 
 -- @dir@ if it doesn\'t exist. If the first argument is 'True'
 -- the function will also create all parent directories if they are missing.
@@ -370,12 +396,13 @@ createDirectoryIfMissing create_parents path0
                           else throw e
 #else
               stat <- Posix.getFileStatus dir
-              if Posix.fileMode stat .&. Posix.directoryMode /= 0 
+              if Posix.isDirectory stat
                  then return ()
                  else throw e
 #endif
               ) `catch` ((\_ -> return ()) :: IOException -> IO ())
           | otherwise              -> throw e
+#endif  /* !__NHC__ */
 
 #if __GLASGOW_HASKELL__
 {- | @'removeDirectory' dir@ removes an existing directory /dir/.  The
@@ -614,7 +641,7 @@ renameFile opath npath = do
    is_dir <- isDirectory st
 #else
    stat <- Posix.getSymbolicLinkStatus opath
-   let is_dir = Posix.fileMode stat .&. Posix.directoryMode /= 0
+   let is_dir = Posix.isDirectory stat
 #endif
    if is_dir
 	then ioException (ioeSetErrorString
@@ -681,7 +708,7 @@ canonicalizePath fpath =
 #else
   withCString fpath $ \pInPath ->
   allocaBytes long_path_size $ \pOutPath ->
-    do c_realpath pInPath pOutPath
+    do throwErrnoPathIfNull "canonicalizePath" fpath $ c_realpath pInPath pOutPath
        path <- peekCString pOutPath
 #endif
        return (normalise path)
@@ -739,7 +766,7 @@ findExecutable binary =
 #endif
 
 
-#ifndef __HUGS__
+#ifdef __GLASGOW_HASKELL__
 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
 in /dir/. 
 
@@ -804,7 +831,7 @@ getDirectoryContents path =
                  -- no need to reverse, ordering is undefined
 #endif /* mingw32 */
 
-#endif /* !__HUGS__ */
+#endif /* __GLASGOW_HASKELL__ */
 
 
 {- |If the operating system has a notion of current directories,
@@ -883,7 +910,7 @@ setCurrentDirectory path =
 
 #endif /* __GLASGOW_HASKELL__ */
 
-#ifndef __HUGS__
+#ifdef __GLASGOW_HASKELL__
 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 exists and is a directory, and 'False' otherwise.
 -}
@@ -894,7 +921,7 @@ doesDirectoryExist name =
    (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
 #else
    (do stat <- Posix.getFileStatus name
-       return (Posix.fileMode stat .&. Posix.directoryMode /= 0))
+       return (Posix.isDirectory stat))
 #endif
    `catch` ((\ _ -> return False) :: IOException -> IO Bool)
 
@@ -908,7 +935,7 @@ doesFileExist name =
    (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
 #else
    (do stat <- Posix.getFileStatus name
-       return (Posix.fileMode stat .&. Posix.directoryMode == 0))
+       return (not (Posix.isDirectory stat)))
 #endif
    `catch` ((\ _ -> return False) :: IOException -> IO Bool)
 
@@ -932,12 +959,17 @@ getModificationTime name = do
  modificationTime st
 #else
   stat <- Posix.getFileStatus name
-  let realToInteger = round . realToFrac :: Real a => a -> Integer
-  return (TOD (realToInteger (Posix.modificationTime stat)) 0)
+  let mod_time :: Posix.EpochTime 
+      mod_time = Posix.modificationTime stat
+      dbl_time :: Double
+      dbl_time = realToFrac mod_time
+  return (TOD (round dbl_time) 0)
 #endif
+   -- For info
+   -- round :: (RealFrac a, Integral b => a -> b
+   -- realToFrac :: (Real a, Fractional b) => a -> b
 
-
-#endif /* !__HUGS__ */
+#endif /* __GLASGOW_HASKELL__ */
 
 #ifdef mingw32_HOST_OS
 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
@@ -959,8 +991,9 @@ withFileOrSymlinkStatus loc name f = do
 modificationTime :: Ptr CStat -> IO ClockTime
 modificationTime stat = do
     mtime <- st_mtime stat
-    let realToInteger = round . realToFrac :: Real a => a -> Integer
-    return (TOD (realToInteger (mtime :: CTime)) 0)
+    let dbl_time :: Double
+        dbl_time = realToFrac (mtime :: CTime)
+    return (TOD (round dbl_time) 0)
     
 isDirectory :: Ptr CStat -> IO Bool
 isDirectory stat = do