summaryrefslogtreecommitdiff
path: root/Utility/Directory.hs
diff options
context:
space:
mode:
authorJoey Hess2014-05-14 19:41:05 -0400
committerJoey Hess2014-05-14 19:41:05 -0400
commit7115d1ec162b4059b3e8e8f84bd8d5898c1db025 (patch)
tree42c1cce54e890e1d56484794ab33129132d8fee2 /Utility/Directory.hs
parentffe371a9d42cded461236e972a24a142419d7fc4 (diff)
moved source code to src
This is to work around OSX's brain-damange regarding filename case insensitivity. Avoided moving config.hs, because it's a config file. Put in a symlink to make build work.
Diffstat (limited to 'Utility/Directory.hs')
-rw-r--r--Utility/Directory.hs135
1 files changed, 0 insertions, 135 deletions
diff --git a/Utility/Directory.hs b/Utility/Directory.hs
deleted file mode 100644
index d92327c0..00000000
--- a/Utility/Directory.hs
+++ /dev/null
@@ -1,135 +0,0 @@
-{- directory manipulation
- -
- - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
- -
- - License: BSD-2-clause
- -}
-
-{-# LANGUAGE CPP #-}
-
-module Utility.Directory where
-
-import System.IO.Error
-import System.Directory
-import Control.Exception (throw)
-import Control.Monad
-import Control.Monad.IfElse
-import System.FilePath
-import Control.Applicative
-import System.IO.Unsafe (unsafeInterleaveIO)
-
-import Utility.PosixFiles
-import Utility.SafeCommand
-import Utility.Tmp
-import Utility.Exception
-import Utility.Monad
-import Utility.Applicative
-
-dirCruft :: FilePath -> Bool
-dirCruft "." = True
-dirCruft ".." = True
-dirCruft _ = False
-
-{- Lists the contents of a directory.
- - Unlike getDirectoryContents, paths are not relative to the directory. -}
-dirContents :: FilePath -> IO [FilePath]
-dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d
-
-{- Gets files in a directory, and then its subdirectories, recursively,
- - and lazily.
- -
- - Does not follow symlinks to other subdirectories.
- -
- - When the directory does not exist, no exception is thrown,
- - instead, [] is returned. -}
-dirContentsRecursive :: FilePath -> IO [FilePath]
-dirContentsRecursive = dirContentsRecursiveSkipping (const False) True
-
-{- Skips directories whose basenames match the skipdir. -}
-dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath]
-dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir]
- where
- go [] = return []
- go (dir:dirs)
- | skipdir (takeFileName dir) = go dirs
- | otherwise = unsafeInterleaveIO $ do
- (files, dirs') <- collect [] []
- =<< catchDefaultIO [] (dirContents dir)
- files' <- go (dirs' ++ dirs)
- return (files ++ files')
- collect files dirs' [] = return (reverse files, reverse dirs')
- collect files dirs' (entry:entries)
- | dirCruft entry = collect files dirs' entries
- | otherwise = do
- let skip = collect (entry:files) dirs' entries
- let recurse = collect files (entry:dirs') entries
- ms <- catchMaybeIO $ getSymbolicLinkStatus entry
- case ms of
- (Just s)
- | isDirectory s -> recurse
- | isSymbolicLink s && followsubdirsymlinks ->
- ifM (doesDirectoryExist entry)
- ( recurse
- , skip
- )
- _ -> skip
-
-{- Gets the directory tree from a point, recursively and lazily,
- - with leaf directories **first**, skipping any whose basenames
- - match the skipdir. Does not follow symlinks. -}
-dirTreeRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
-dirTreeRecursiveSkipping skipdir topdir = go [] [topdir]
- where
- go c [] = return c
- go c (dir:dirs)
- | skipdir (takeFileName dir) = go c dirs
- | otherwise = unsafeInterleaveIO $ do
- subdirs <- go c
- =<< filterM (isDirectory <$$> getSymbolicLinkStatus)
- =<< catchDefaultIO [] (dirContents dir)
- go (subdirs++[dir]) dirs
-
-{- Moves one filename to another.
- - First tries a rename, but falls back to moving across devices if needed. -}
-moveFile :: FilePath -> FilePath -> IO ()
-moveFile src dest = tryIO (rename src dest) >>= onrename
- where
- onrename (Right _) = noop
- onrename (Left e)
- | isPermissionError e = rethrow
- | isDoesNotExistError e = rethrow
- | otherwise = do
- -- copyFile is likely not as optimised as
- -- the mv command, so we'll use the latter.
- -- But, mv will move into a directory if
- -- dest is one, which is not desired.
- whenM (isdir dest) rethrow
- viaTmp mv dest undefined
- where
- rethrow = throw e
- mv tmp _ = do
- ok <- boolSystem "mv" [Param "-f", Param src, Param tmp]
- unless ok $ do
- -- delete any partial
- _ <- tryIO $ removeFile tmp
- rethrow
-
- isdir f = do
- r <- tryIO $ getFileStatus f
- case r of
- (Left _) -> return False
- (Right s) -> return $ isDirectory s
-
-{- Removes a file, which may or may not exist, and does not have to
- - be a regular file.
- -
- - Note that an exception is thrown if the file exists but
- - cannot be removed. -}
-nukeFile :: FilePath -> IO ()
-nukeFile file = void $ tryWhenExists go
- where
-#ifndef mingw32_HOST_OS
- go = removeLink file
-#else
- go = removeFile file
-#endif