ref: be01052e02dd12c38b19e05a5346c3dbb09e98dd
dir: /lib/System/Directory.hs/
module System.Directory(
removeFile,
doesFileExist,
doesDirectoryExist,
getDirectoryContents,
listDirectory,
setCurrentDirectory,
getCurrentDirectory,
withCurrentDirectory,
createDirectory,
createDirectoryIfMissing,
copyFile,
getHomeDirectory,
) where
import Prelude(); import MiniPrelude
import Control.Exception(bracket)
import Control.Monad(when)
import Foreign.C.String
import Foreign.Marshal.Alloc
import Foreign.Ptr
import System.IO
import System.Environment
data DIR
data Dirent
foreign import ccall "unlink" c_unlink :: CString -> IO Int
foreign import ccall "opendir" c_opendir :: CString -> IO (Ptr DIR)
foreign import ccall "closedir" c_closedir :: Ptr DIR -> IO Int
foreign import ccall "readdir" c_readdir :: Ptr DIR -> IO (Ptr Dirent)
foreign import ccall "c_d_name" c_d_name :: Ptr Dirent -> IO CString
foreign import ccall "chdir" c_chdir :: CString -> IO Int
foreign import ccall "mkdir" c_mkdir :: CString -> Int -> IO Int
foreign import ccall "getcwd" c_getcwd :: CString -> Int -> IO CString
removeFile :: FilePath -> IO ()
removeFile fn = do
r <- withCAString fn c_unlink
when (r /= 0) $
error "removeFile failed"
doesFileExist :: FilePath -> IO Bool
doesFileExist fn = do
mh <- openFileM fn ReadMode
case mh of
Nothing -> return False
Just h -> do { hClose h; return True }
doesDirectoryExist :: FilePath -> IO Bool
doesDirectoryExist fn = withCAString fn $ \ cfn -> do
dp <- c_opendir cfn
return False
if dp == nullPtr then
return False
else do
c_closedir dp
return True
getDirectoryContents :: FilePath -> IO [String]
getDirectoryContents fn = withCAString fn $ \ cfn -> do
dp <- c_opendir cfn
when (dp == nullPtr) $
error $ "getDirectoryContents: cannot open " ++ fn
let loop r = do
de <- c_readdir dp
if de == nullPtr then do
c_closedir dp
return $ reverse r
else do
sp <- c_d_name de
s <- peekCAString sp
loop (s:r)
loop []
listDirectory :: FilePath -> IO [String]
listDirectory d = filter (\ n -> n /= "." && n /= "..") <$> getDirectoryContents d
setCurrentDirectory :: FilePath -> IO ()
setCurrentDirectory d = do
r <- withCAString d c_chdir
when (r /= 0) $
error $ "setCurrentDirectory failed: " ++ d
getCurrentDirectory :: IO FilePath
getCurrentDirectory = do
let len = 10000
allocaBytes len $ \ p -> do
cwd <- c_getcwd p len -- can return NULL if buffer to small
when (cwd == nullPtr) $
error "getCurrentDirectory"
peekCAString cwd
withCurrentDirectory :: FilePath -> IO a -> IO a
withCurrentDirectory dir io =
bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do
setCurrentDirectory dir
io
createDirectory :: FilePath -> IO ()
createDirectory d = do
r <- withCAString d $ \ s -> c_mkdir s 0o775 -- rwxrwxr-x
when (r /= 0) $
error $ "Cannot create directory " ++ show d
createDirectoryIfMissing :: Bool -> FilePath -> IO ()
createDirectoryIfMissing False d = do
_ <- withCAString d $ \ s -> c_mkdir s 0o775 -- rwxrwxr-x
return ()
createDirectoryIfMissing True d = do
let ds = scanl1 (\ x y -> x ++ "/" ++ y) . split [] $ d
split r [] = [r]
split r ('/':cs) = r : split [] cs
split r (c:cs) = split (r ++ [c]) cs
mapM_ (createDirectoryIfMissing False) ds
-- XXX does not copy flags
copyFile :: FilePath -> FilePath -> IO ()
copyFile src dst = do
hsrc <- openBinaryFile src ReadMode
hdst <- openBinaryFile dst WriteMode
file <- hGetContents hsrc -- this also closes the file
hPutStr hdst file
hClose hdst
getHomeDirectory :: IO FilePath
getHomeDirectory =
if _isWindows then do
user <- getEnv "USERNAME"
return $ "C:/Users/" ++ user -- it's a guess
else
getEnv "HOME"