summaryrefslogtreecommitdiff
path: root/src/Utility
diff options
context:
space:
mode:
authorJoey Hess2015-12-15 21:08:22 -0400
committerJoey Hess2015-12-15 21:08:22 -0400
commit47a2b72bed3770d3dfb26c4142479c436a11ce55 (patch)
tree3d67f32c91338193a21aadb26f0d001d5cec9670 /src/Utility
parent571318218c5598ad841cc3dff73c9fee2c7216ef (diff)
Merged Utility changes from git-annex.
Diffstat (limited to 'src/Utility')
-rw-r--r--src/Utility/Directory.hs31
-rw-r--r--src/Utility/FileMode.hs29
-rw-r--r--src/Utility/FileSystemEncoding.hs5
-rw-r--r--src/Utility/Path.hs12
-rw-r--r--src/Utility/SafeCommand.hs11
5 files changed, 59 insertions, 29 deletions
diff --git a/src/Utility/Directory.hs b/src/Utility/Directory.hs
index 7322cd85..fae33b5c 100644
--- a/src/Utility/Directory.hs
+++ b/src/Utility/Directory.hs
@@ -13,7 +13,6 @@ module Utility.Directory where
import System.IO.Error
import System.Directory
import Control.Monad
-import Control.Monad.IfElse
import System.FilePath
import Control.Applicative
import Control.Concurrent
@@ -25,10 +24,11 @@ import Prelude
import qualified System.Win32 as Win32
#else
import qualified System.Posix as Posix
+import Utility.SafeCommand
+import Control.Monad.IfElse
#endif
import Utility.PosixFiles
-import Utility.SafeCommand
import Utility.Tmp
import Utility.Exception
import Utility.Monad
@@ -107,21 +107,32 @@ moveFile src dest = tryIO (rename src dest) >>= onrename
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 ""
+ | otherwise = viaTmp mv dest ""
where
rethrow = throwM e
+
mv tmp _ = do
+ -- copyFile is likely not as optimised as
+ -- the mv command, so we'll use the command.
+ --
+ -- But, while Windows has a "mv", it does not seem very
+ -- reliable, so use copyFile there.
+#ifndef mingw32_HOST_OS
+ -- If dest is a directory, mv would move the file
+ -- into it, which is not desired.
+ whenM (isdir dest) rethrow
ok <- boolSystem "mv" [Param "-f", Param src, Param tmp]
+ let e' = e
+#else
+ r <- tryIO $ copyFile src tmp
+ let (ok, e') = case r of
+ Left err -> (False, err)
+ Right _ -> (True, e)
+#endif
unless ok $ do
-- delete any partial
_ <- tryIO $ removeFile tmp
- rethrow
+ throwM e'
isdir f = do
r <- tryIO $ getFileStatus f
diff --git a/src/Utility/FileMode.hs b/src/Utility/FileMode.hs
index fdf1b56b..efef5fa2 100644
--- a/src/Utility/FileMode.hs
+++ b/src/Utility/FileMode.hs
@@ -7,7 +7,10 @@
{-# LANGUAGE CPP #-}
-module Utility.FileMode where
+module Utility.FileMode (
+ module Utility.FileMode,
+ FileMode,
+) where
import System.IO
import Control.Monad
@@ -17,17 +20,31 @@ import Utility.PosixFiles
import System.Posix.Files
#endif
import Foreign (complement)
+import Control.Monad.IO.Class (liftIO, MonadIO)
+import Control.Monad.Catch
import Utility.Exception
{- Applies a conversion function to a file's mode. -}
modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO ()
-modifyFileMode f convert = do
+modifyFileMode f convert = void $ modifyFileMode' f convert
+
+modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode
+modifyFileMode' f convert = do
s <- getFileStatus f
let old = fileMode s
let new = convert old
when (new /= old) $
setFileMode f new
+ return old
+
+{- Runs an action after changing a file's mode, then restores the old mode. -}
+withModifiedFileMode :: FilePath -> (FileMode -> FileMode) -> IO a -> IO a
+withModifiedFileMode file convert a = bracket setup cleanup go
+ where
+ setup = modifyFileMode' file convert
+ cleanup oldmode = modifyFileMode file (const oldmode)
+ go _ = a
{- Adds the specified FileModes to the input mode, leaving the rest
- unchanged. -}
@@ -92,7 +109,7 @@ isExecutable mode = combineModes executeModes `intersectFileModes` mode /= 0
{- Runs an action without that pesky umask influencing it, unless the
- passed FileMode is the standard one. -}
-noUmask :: FileMode -> IO a -> IO a
+noUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a
#ifndef mingw32_HOST_OS
noUmask mode a
| mode == stdFileMode = a
@@ -101,12 +118,12 @@ noUmask mode a
noUmask _ a = a
#endif
-withUmask :: FileMode -> IO a -> IO a
+withUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a
#ifndef mingw32_HOST_OS
withUmask umask a = bracket setup cleanup go
where
- setup = setFileCreationMask umask
- cleanup = setFileCreationMask
+ setup = liftIO $ setFileCreationMask umask
+ cleanup = liftIO . setFileCreationMask
go _ = a
#else
withUmask _ a = a
diff --git a/src/Utility/FileSystemEncoding.hs b/src/Utility/FileSystemEncoding.hs
index 2d9691d5..67341d37 100644
--- a/src/Utility/FileSystemEncoding.hs
+++ b/src/Utility/FileSystemEncoding.hs
@@ -29,6 +29,7 @@ import System.IO.Unsafe
import qualified Data.Hash.MD5 as MD5
import Data.Word
import Data.Bits.Utils
+import Data.List
import Data.List.Utils
import qualified Data.ByteString.Lazy as L
#ifdef mingw32_HOST_OS
@@ -125,12 +126,12 @@ decodeW8 = s2w8 . _encodeFilePath
{- Like encodeW8 and decodeW8, but NULs are passed through unchanged. -}
encodeW8NUL :: [Word8] -> FilePath
-encodeW8NUL = join nul . map encodeW8 . split (s2w8 nul)
+encodeW8NUL = intercalate nul . map encodeW8 . split (s2w8 nul)
where
nul = ['\NUL']
decodeW8NUL :: FilePath -> [Word8]
-decodeW8NUL = join (s2w8 nul) . map decodeW8 . split nul
+decodeW8NUL = intercalate (s2w8 nul) . map decodeW8 . split nul
where
nul = ['\NUL']
diff --git a/src/Utility/Path.hs b/src/Utility/Path.hs
index 8e3c2bdd..f3290d8d 100644
--- a/src/Utility/Path.hs
+++ b/src/Utility/Path.hs
@@ -30,8 +30,8 @@ import qualified "MissingH" System.Path as MissingH
import Utility.Monad
import Utility.UserInfo
-{- Simplifies a path, removing any ".." or ".", and removing the trailing
- - path separator.
+{- Simplifies a path, removing any "." component, collapsing "dir/..",
+ - and removing the trailing path separator.
-
- On Windows, preserves whichever style of path separator might be used in
- the input FilePaths. This is done because some programs in Windows
@@ -50,7 +50,8 @@ simplifyPath path = dropTrailingPathSeparator $
norm c [] = reverse c
norm c (p:ps)
- | p' == ".." = norm (drop 1 c) ps
+ | p' == ".." && not (null c) && dropTrailingPathSeparator (c !! 0) /= ".." =
+ norm (drop 1 c) ps
| p' == "." = norm c ps
| otherwise = norm (p:c) ps
where
@@ -88,7 +89,7 @@ parentDir = takeDirectory . dropTrailingPathSeparator
upFrom :: FilePath -> Maybe FilePath
upFrom dir
| length dirs < 2 = Nothing
- | otherwise = Just $ joinDrive drive (join s $ init dirs)
+ | otherwise = Just $ joinDrive drive (intercalate s $ init dirs)
where
-- on Unix, the drive will be "/" when the dir is absolute, otherwise ""
(drive, path) = splitDrive dir
@@ -148,7 +149,7 @@ relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
relPathDirToFileAbs :: FilePath -> FilePath -> FilePath
relPathDirToFileAbs from to
| takeDrive from /= takeDrive to = to
- | otherwise = join s $ dotdots ++ uncommon
+ | otherwise = intercalate s $ dotdots ++ uncommon
where
s = [pathSeparator]
pfrom = split s from
@@ -287,7 +288,6 @@ fileNameLengthLimit dir = do
if l <= 0
then return 255
else return $ minimum [l, 255]
- where
#endif
{- Given a string that we'd like to use as the basis for FilePath, but that
diff --git a/src/Utility/SafeCommand.hs b/src/Utility/SafeCommand.hs
index 9102b726..5ce17a84 100644
--- a/src/Utility/SafeCommand.hs
+++ b/src/Utility/SafeCommand.hs
@@ -14,6 +14,7 @@ import Utility.Process
import Data.String.Utils
import System.FilePath
import Data.Char
+import Data.List
import Control.Applicative
import Prelude
@@ -85,7 +86,7 @@ shellEscape :: String -> String
shellEscape f = "'" ++ escaped ++ "'"
where
-- replace ' with '"'"'
- escaped = join "'\"'\"'" $ split "'" f
+ escaped = intercalate "'\"'\"'" $ split "'" f
-- | Unescapes a set of shellEscaped words or filenames.
shellUnEscape :: String -> [String]
@@ -105,10 +106,10 @@ shellUnEscape s = word : shellUnEscape rest
| otherwise = inquote q (w++[c]) cs
-- | For quickcheck.
-prop_idempotent_shellEscape :: String -> Bool
-prop_idempotent_shellEscape s = [s] == (shellUnEscape . shellEscape) s
-prop_idempotent_shellEscape_multiword :: [String] -> Bool
-prop_idempotent_shellEscape_multiword s = s == (shellUnEscape . unwords . map shellEscape) s
+prop_isomorphic_shellEscape :: String -> Bool
+prop_isomorphic_shellEscape s = [s] == (shellUnEscape . shellEscape) s
+prop_isomorphic_shellEscape_multiword :: [String] -> Bool
+prop_isomorphic_shellEscape_multiword s = s == (shellUnEscape . unwords . map shellEscape) s
-- | Segments a list of filenames into groups that are all below the maximum
-- command-line length limit.