From ef3214bd2856e5927eda83eeab969e421ee923ea Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 15 Dec 2015 20:46:53 -0400
Subject: merge from git-annex

---
 Common.hs                     |   3 +-
 Git/Construct.hs              |  17 +++--
 Git/Destroyer.hs              |   1 -
 Git/Filename.hs               |   4 +-
 Git/LsFiles.hs                |  66 +++++++++++++++----
 Git/LsTree.hs                 |  29 ++++++---
 Git/RefLog.hs                 |  19 +++---
 Git/Repair.hs                 |   8 ++-
 Git/Version.hs                |   2 +
 Utility/Data.hs               |   2 +
 Utility/Directory.hs          |  33 +++++++---
 Utility/DottedVersion.hs      |   2 +
 Utility/Env.hs                |   2 +
 Utility/Exception.hs          |  23 +++++--
 Utility/FileMode.hs           |  32 ++++++----
 Utility/FileSize.hs           |  35 ++++++++++
 Utility/FileSystemEncoding.hs |  25 ++++++--
 Utility/Format.hs             |   6 +-
 Utility/Metered.hs            |  22 +++++++
 Utility/Misc.hs               |  12 ++--
 Utility/Monad.hs              |   2 +
 Utility/PartialPrelude.hs     |   2 +
 Utility/Path.hs               |  14 ++--
 Utility/PosixFiles.hs         |   1 +
 Utility/Process.hs            | 144 ++++++++++++++++++++++--------------------
 Utility/Process/Shim.hs       |   3 +
 Utility/QuickCheck.hs         |   1 +
 Utility/Rsync.hs              |   3 +-
 Utility/SafeCommand.hs        | 102 ++++++++++++++++--------------
 Utility/UserInfo.hs           |   6 +-
 30 files changed, 415 insertions(+), 206 deletions(-)
 create mode 100644 Utility/FileSize.hs
 create mode 100644 Utility/Process/Shim.hs

diff --git a/Common.hs b/Common.hs
index 48aa32c..a6c5d54 100644
--- a/Common.hs
+++ b/Common.hs
@@ -30,6 +30,7 @@ import Utility.Monad as X
 import Utility.Data as X
 import Utility.Applicative as X
 import Utility.FileSystemEncoding as X
-import Utility.PosixFiles as X
+import Utility.PosixFiles as X hiding (fileSize)
+import Utility.FileSize as X
 
 import Utility.PartialPrelude as X
diff --git a/Git/Construct.hs b/Git/Construct.hs
index 5b20605..03dd29f 100644
--- a/Git/Construct.hs
+++ b/Git/Construct.hs
@@ -58,24 +58,29 @@ fromPath dir = fromAbsPath =<< absPath dir
  - specified. -}
 fromAbsPath :: FilePath -> IO Repo
 fromAbsPath dir
-	| absoluteGitPath dir = ifM (doesDirectoryExist dir') ( ret dir' , hunt )
+	| absoluteGitPath dir = hunt
 	| otherwise =
 		error $ "internal error, " ++ dir ++ " is not absolute"
   where
 	ret = pure . newFrom . LocalUnknown
-	{- Git always looks for "dir.git" in preference to
-	 - to "dir", even if dir ends in a "/". -}
 	canondir = dropTrailingPathSeparator dir
-	dir' = canondir ++ ".git"
 	{- When dir == "foo/.git", git looks for "foo/.git/.git",
 	 - and failing that, uses "foo" as the repository. -}
 	hunt
 		| (pathSeparator:".git") `isSuffixOf` canondir =
 			ifM (doesDirectoryExist $ dir </> ".git")
 				( ret dir
-				, ret $ takeDirectory canondir
+				, ret (takeDirectory canondir)
 				)
-		| otherwise = ret dir
+		| otherwise = ifM (doesDirectoryExist dir)
+			( ret dir
+			-- git falls back to dir.git when dir doesn't
+			-- exist, as long as dir didn't end with a
+			-- path separator
+			, if dir == canondir
+				then ret (dir ++ ".git")
+				else ret dir
+			)
 
 {- Remote Repo constructor. Throws exception on invalid url.
  -
diff --git a/Git/Destroyer.hs b/Git/Destroyer.hs
index 2ac4dae..e923796 100644
--- a/Git/Destroyer.hs
+++ b/Git/Destroyer.hs
@@ -21,7 +21,6 @@ import Utility.Tmp
 
 import qualified Data.ByteString as B
 import Data.Word
-import System.PosixCompat.Types
 
 {- Ways to damange a git repository. -}
 data Damage
diff --git a/Git/Filename.hs b/Git/Filename.hs
index 382eb8d..ee84d48 100644
--- a/Git/Filename.hs
+++ b/Git/Filename.hs
@@ -24,5 +24,5 @@ encode :: FilePath -> String
 encode s = "\"" ++ encode_c s ++ "\""
 
 {- for quickcheck -}
-prop_idempotent_deencode :: String -> Bool
-prop_idempotent_deencode s = s == decode (encode s)
+prop_isomorphic_deencode :: String -> Bool
+prop_isomorphic_deencode s = s == decode (encode s)
diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs
index e80c1b2..f945838 100644
--- a/Git/LsFiles.hs
+++ b/Git/LsFiles.hs
@@ -35,14 +35,23 @@ import System.Posix.Types
 
 {- Scans for files that are checked into git at the specified locations. -}
 inRepo :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-inRepo l = pipeNullSplit $ Params "ls-files --cached -z --" : map File l
+inRepo l = pipeNullSplit $ 
+	Param "ls-files" :
+	Param "--cached" :
+	Param "-z" :
+	Param "--" :
+	map File l
 
 {- Scans for files at the specified locations that are not checked into git. -}
 notInRepo :: Bool -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 notInRepo include_ignored l repo = pipeNullSplit params repo
   where
-	params = [Params "ls-files --others"] ++ exclude ++
-		[Params "-z --"] ++ map File l
+	params = concat
+		[ [ Param "ls-files", Param "--others"]
+		, exclude
+		, [ Param "-z", Param "--" ]
+		, map File l
+		]
 	exclude
 		| include_ignored = []
 		| otherwise = [Param "--exclude-standard"]
@@ -50,28 +59,51 @@ notInRepo include_ignored l repo = pipeNullSplit params repo
 {- Finds all files in the specified locations, whether checked into git or
  - not. -}
 allFiles :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-allFiles l = pipeNullSplit $ Params "ls-files --cached --others -z --" : map File l
+allFiles l = pipeNullSplit $
+	Param "ls-files" :
+	Param "--cached" :
+	Param "--others" :
+	Param "-z" :
+	Param "--" :
+	map File l
 
 {- Returns a list of files in the specified locations that have been
  - deleted. -}
 deleted :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 deleted l repo = pipeNullSplit params repo
   where
-	params = [Params "ls-files --deleted -z --"] ++ map File l
+	params =
+		Param "ls-files" :
+		Param "--deleted" :
+		Param "-z" :
+		Param "--" :
+		map File l
 
 {- Returns a list of files in the specified locations that have been
  - modified. -}
 modified :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 modified l repo = pipeNullSplit params repo
   where
-	params = [Params "ls-files --modified -z --"] ++ map File l
+	params = 
+		Param "ls-files" :
+		Param "--modified" :
+		Param "-z" :
+		Param "--" :
+		map File l
 
 {- Files that have been modified or are not checked into git (and are not
  - ignored). -}
 modifiedOthers :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 modifiedOthers l repo = pipeNullSplit params repo
   where
-	params = [Params "ls-files --modified --others --exclude-standard -z --"] ++ map File l
+	params = 
+		Param "ls-files" :
+		Param "--modified" :
+		Param "--others" :
+		Param "--exclude-standard" :
+		Param "-z" :
+		Param "--" :
+		map File l
 
 {- Returns a list of all files that are staged for commit. -}
 staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
@@ -85,7 +117,7 @@ stagedNotDeleted = staged' [Param "--diff-filter=ACMRT"]
 staged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 staged' ps l = pipeNullSplit $ prefix ++ ps ++ suffix
   where
-	prefix = [Params "diff --cached --name-only -z"]
+	prefix = [Param "diff", Param "--cached", Param "--name-only", Param "-z"]
 	suffix = Param "--" : map File l
 
 type StagedDetails = (FilePath, Maybe Sha, Maybe FileMode)
@@ -93,7 +125,7 @@ type StagedDetails = (FilePath, Maybe Sha, Maybe FileMode)
 {- Returns details about files that are staged in the index,
  - as well as files not yet in git. Skips ignored files. -}
 stagedOthersDetails :: [FilePath] -> Repo -> IO ([StagedDetails], IO Bool)
-stagedOthersDetails = stagedDetails' [Params "--others --exclude-standard"]
+stagedOthersDetails = stagedDetails' [Param "--others", Param "--exclude-standard"]
 
 {- Returns details about all files that are staged in the index. -}
 stagedDetails :: [FilePath] -> Repo -> IO ([StagedDetails], IO Bool)
@@ -106,7 +138,7 @@ stagedDetails' ps l repo = do
 	(ls, cleanup) <- pipeNullSplit params repo
 	return (map parse ls, cleanup)
   where
-	params = Params "ls-files --stage -z" : ps ++ 
+	params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++ 
 		Param "--" : map File l
 	parse s
 		| null file = (s, Nothing, Nothing)
@@ -135,7 +167,12 @@ typeChanged' ps l repo = do
 	currdir <- getCurrentDirectory
 	return (map (\f -> relPathDirToFileAbs currdir $ top </> f) fs, cleanup)
   where
-	prefix = [Params "diff --name-only --diff-filter=T -z"]
+	prefix = 
+		[ Param "diff"
+		, Param "--name-only"
+		, Param "--diff-filter=T"
+		, Param "-z"
+		]
 	suffix = Param "--" : (if null l then [File "."] else map File l)
 
 {- A item in conflict has two possible values.
@@ -166,7 +203,12 @@ unmerged l repo = do
 	(fs, cleanup) <- pipeNullSplit params repo
 	return (reduceUnmerged [] $ catMaybes $ map parseUnmerged fs, cleanup)
   where
-	params = Params "ls-files --unmerged -z --" : map File l
+	params = 
+		Param "ls-files" :
+		Param "--unmerged" :
+		Param "-z" :
+		Param "--" :
+		map File l
 
 data InternalUnmerged = InternalUnmerged
 	{ isus :: Bool
diff --git a/Git/LsTree.hs b/Git/LsTree.hs
index 7ef9518..1ed6247 100644
--- a/Git/LsTree.hs
+++ b/Git/LsTree.hs
@@ -13,10 +13,6 @@ module Git.LsTree (
 	parseLsTree
 ) where
 
-import Numeric
-import Control.Applicative
-import System.Posix.Types
-
 import Common
 import Git
 import Git.Command
@@ -24,6 +20,9 @@ import Git.Sha
 import Git.FilePath
 import qualified Git.Filename
 
+import Numeric
+import System.Posix.Types
+
 data TreeItem = TreeItem
 	{ mode :: FileMode
 	, typeobj :: String
@@ -35,16 +34,30 @@ data TreeItem = TreeItem
  - with lazy output. -}
 lsTree :: Ref -> Repo -> IO [TreeItem]
 lsTree t repo = map parseLsTree
-	<$> pipeNullSplitZombie (lsTreeParams t) repo
+	<$> pipeNullSplitZombie (lsTreeParams t []) repo
 
-lsTreeParams :: Ref -> [CommandParam]
-lsTreeParams t = [ Params "ls-tree --full-tree -z -r --", File $ fromRef t ]
+lsTreeParams :: Ref -> [CommandParam] -> [CommandParam]
+lsTreeParams r ps =
+	[ Param "ls-tree"
+	, Param "--full-tree"
+	, Param "-z"
+	, Param "-r"
+	] ++ ps ++
+	[ Param "--"
+	, File $ fromRef r
+	]
 
 {- Lists specified files in a tree. -}
 lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem]
 lsTreeFiles t fs repo = map parseLsTree <$> pipeNullSplitStrict ps repo
   where
-	ps = [Params "ls-tree --full-tree -z --", File $ fromRef t] ++ map File fs
+	ps =
+		[ Param "ls-tree"
+		, Param "--full-tree"
+		, Param "-z"
+		, Param "--"
+		, File $ fromRef t
+		] ++ map File fs
 
 {- Parses a line of ls-tree output.
  - (The --long format is not currently supported.) -}
diff --git a/Git/RefLog.hs b/Git/RefLog.hs
index 7c20047..57f35e9 100644
--- a/Git/RefLog.hs
+++ b/Git/RefLog.hs
@@ -14,14 +14,17 @@ import Git.Sha
 
 {- Gets the reflog for a given branch. -}
 get :: Branch -> Repo -> IO [Sha]
-get = get' []
+get b = getMulti [b]
 
-get' :: [CommandParam] -> Branch -> Repo -> IO [Sha]
-get' ps b = mapMaybe extractSha . lines <$$> pipeReadStrict ps'
+{- Gets reflogs for multiple branches. -}
+getMulti :: [Branch] -> Repo -> IO [Sha]
+getMulti bs = get' (map (Param . fromRef) bs)
+
+get' :: [CommandParam] -> Repo -> IO [Sha]
+get' ps = mapMaybe extractSha . lines <$$> pipeReadStrict ps'
   where
-	ps' = 
-		[ Param "log"
-		, Param "-g"
-		, Param "--format=%H"
-		, Param (fromRef b)
+	ps' = catMaybes
+		[ Just $ Param "log"
+		, Just $ Param "-g"
+		, Just $ Param "--format=%H"
 		] ++ ps
diff --git a/Git/Repair.hs b/Git/Repair.hs
index 2557e3b..b441f13 100644
--- a/Git/Repair.hs
+++ b/Git/Repair.hs
@@ -99,7 +99,7 @@ retrieveMissingObjects :: FsckResults -> Maybe FilePath -> Repo -> IO FsckResult
 retrieveMissingObjects missing referencerepo r
 	| not (foundBroken missing) = return missing
 	| otherwise = withTmpDir "tmprepo" $ \tmpdir -> do
-		unlessM (boolSystem "git" [Params "init", File tmpdir]) $
+		unlessM (boolSystem "git" [Param "init", File tmpdir]) $
 			error $ "failed to create temp repository in " ++ tmpdir
 		tmpr <- Config.read =<< Construct.fromAbsPath tmpdir
 		stillmissing <- pullremotes tmpr (remotes r) fetchrefstags missing
@@ -140,7 +140,9 @@ retrieveMissingObjects missing referencerepo r
 		ps' = 
 			[ Param "fetch"
 			, Param fetchurl
-			, Params "--force --update-head-ok --quiet"
+			, Param "--force"
+			, Param "--update-head-ok"
+			, Param "--quiet"
 			] ++ ps
 		fetchr' = fetchr { gitGlobalOpts = gitGlobalOpts fetchr ++ nogc }
 		nogc = [ Param "-c", Param "gc.auto=0" ]
@@ -339,7 +341,7 @@ verifyTree :: MissingObjects -> Sha -> Repo -> IO Bool
 verifyTree missing treesha r
 	| S.member treesha missing = return False
 	| otherwise = do
-		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams treesha) r
+		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams treesha []) r
 		let objshas = map (extractSha . LsTree.sha . LsTree.parseLsTree) ls
 		if any isNothing objshas || any (`S.member` missing) (catMaybes objshas)
 			then do
diff --git a/Git/Version.hs b/Git/Version.hs
index ecd1244..19ff945 100644
--- a/Git/Version.hs
+++ b/Git/Version.hs
@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
 module Git.Version (
 	installed,
 	older,
diff --git a/Utility/Data.hs b/Utility/Data.hs
index 5ecd218..27c0a82 100644
--- a/Utility/Data.hs
+++ b/Utility/Data.hs
@@ -5,6 +5,8 @@
  - License: BSD-2-clause
  -}
 
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
 module Utility.Data where
 
 {- First item in the list that is not Nothing. -}
diff --git a/Utility/Directory.hs b/Utility/Directory.hs
index 2e037fd..fae33b5 100644
--- a/Utility/Directory.hs
+++ b/Utility/Directory.hs
@@ -6,27 +6,29 @@
  -}
 
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 
 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
 import System.IO.Unsafe (unsafeInterleaveIO)
 import Data.Maybe
+import Prelude
 
 #ifdef mingw32_HOST_OS
 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
@@ -105,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/Utility/DottedVersion.hs b/Utility/DottedVersion.hs
index 67e40ff..ebf4c0b 100644
--- a/Utility/DottedVersion.hs
+++ b/Utility/DottedVersion.hs
@@ -5,6 +5,8 @@
  - License: BSD-2-clause
  -}
 
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
 module Utility.DottedVersion where
 
 import Common
diff --git a/Utility/Env.hs b/Utility/Env.hs
index fdf06d8..c56f4ec 100644
--- a/Utility/Env.hs
+++ b/Utility/Env.hs
@@ -6,6 +6,7 @@
  -}
 
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Env where
 
@@ -13,6 +14,7 @@ module Utility.Env where
 import Utility.Exception
 import Control.Applicative
 import Data.Maybe
+import Prelude
 import qualified System.Environment as E
 import qualified System.SetEnv
 #else
diff --git a/Utility/Exception.hs b/Utility/Exception.hs
index ab47ae9..8b110ae 100644
--- a/Utility/Exception.hs
+++ b/Utility/Exception.hs
@@ -1,11 +1,12 @@
 {- Simple IO exception handling (and some more)
  -
- - Copyright 2011-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2015 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
 
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Exception (
 	module X,
@@ -19,6 +20,8 @@ module Utility.Exception (
 	catchNonAsync,
 	tryNonAsync,
 	tryWhenExists,
+	catchIOErrorType,
+	IOErrorType(..)
 ) where
 
 import Control.Monad.Catch as X hiding (Handler)
@@ -26,7 +29,9 @@ import qualified Control.Monad.Catch as M
 import Control.Exception (IOException, AsyncException)
 import Control.Monad
 import Control.Monad.IO.Class (liftIO, MonadIO)
-import System.IO.Error (isDoesNotExistError)
+import System.IO.Error (isDoesNotExistError, ioeGetErrorType)
+import GHC.IO.Exception (IOErrorType(..))
+
 import Utility.Data
 
 {- Catches IO errors and returns a Bool -}
@@ -35,10 +40,7 @@ catchBoolIO = catchDefaultIO False
 
 {- Catches IO errors and returns a Maybe -}
 catchMaybeIO :: MonadCatch m => m a -> m (Maybe a)
-catchMaybeIO a = do
-	catchDefaultIO Nothing $ do
-		v <- a
-		return (Just v)
+catchMaybeIO a = catchDefaultIO Nothing $ a >>= (return . Just)
 
 {- Catches IO errors and returns a default value. -}
 catchDefaultIO :: MonadCatch m => a -> m a -> m a
@@ -86,3 +88,12 @@ tryWhenExists :: MonadCatch m => m a -> m (Maybe a)
 tryWhenExists a = do
 	v <- tryJust (guard . isDoesNotExistError) a
 	return (eitherToMaybe v)
+
+{- Catches only IO exceptions of a particular type.
+ - Ie, use HardwareFault to catch disk IO errors. -}
+catchIOErrorType :: MonadCatch m => IOErrorType -> (IOException -> m a) -> m a -> m a
+catchIOErrorType errtype onmatchingerr a = catchIO a onlymatching
+  where
+	onlymatching e
+		| ioeGetErrorType e == errtype = onmatchingerr e
+		| otherwise = throwM e
diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs
index 201b845..efef5fa 100644
--- a/Utility/FileMode.hs
+++ b/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,12 +20,15 @@ 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 = void $ modifyFileMode' f convert
+
 modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode
 modifyFileMode' f convert = do
 	s <- getFileStatus f
@@ -32,6 +38,14 @@ modifyFileMode' f convert = do
 		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. -}
 addModes :: [FileMode] -> FileMode -> FileMode
@@ -41,14 +55,6 @@ addModes ms m = combineModes (m:ms)
 removeModes :: [FileMode] -> FileMode -> FileMode
 removeModes ms m = m `intersectFileModes` complement (combineModes ms)
 
-{- 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
-
 writeModes :: [FileMode]
 writeModes = [ownerWriteMode, groupWriteMode, otherWriteMode]
 
@@ -103,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
@@ -112,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/Utility/FileSize.hs b/Utility/FileSize.hs
new file mode 100644
index 0000000..1055754
--- /dev/null
+++ b/Utility/FileSize.hs
@@ -0,0 +1,35 @@
+{- File size.
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Utility.FileSize where
+
+import System.PosixCompat.Files
+#ifdef mingw32_HOST_OS
+import Control.Exception (bracket)
+import System.IO
+#endif
+
+{- Gets the size of a file.
+ -
+ - This is better than using fileSize, because on Windows that returns a
+ - FileOffset which maxes out at 2 gb.
+ - See https://github.com/jystic/unix-compat/issues/16
+ -}
+getFileSize :: FilePath -> IO Integer
+#ifndef mingw32_HOST_OS
+getFileSize f = fmap (fromIntegral . fileSize) (getFileStatus f)
+#else
+getFileSize f = bracket (openFile f ReadMode) hClose hFileSize
+#endif
+
+{- Gets the size of the file, when its FileStatus is already known. -}
+getFileSize' :: FilePath -> FileStatus -> IO Integer
+#ifndef mingw32_HOST_OS
+getFileSize' _ s = return $ fromIntegral $ fileSize s
+#else
+getFileSize' f _ = getFileSize f
+#endif
diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs
index 139b74f..67341d3 100644
--- a/Utility/FileSystemEncoding.hs
+++ b/Utility/FileSystemEncoding.hs
@@ -6,12 +6,14 @@
  -}
 
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.FileSystemEncoding (
 	fileEncoding,
 	withFilePath,
 	md5FilePath,
 	decodeBS,
+	encodeBS,
 	decodeW8,
 	encodeW8,
 	encodeW8NUL,
@@ -27,12 +29,15 @@ 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
 import qualified Data.ByteString.Lazy.UTF8 as L8
 #endif
 
+import Utility.Exception
+
 {- Sets a Handle to use the filesystem encoding. This causes data
  - written or read from it to be encoded/decoded the same
  - as ghc 7.4 does to filenames etc. This special encoding
@@ -66,12 +71,16 @@ withFilePath fp f = Encoding.getFileSystemEncoding
  - only allows doing this conversion with CStrings, and the CString buffer
  - is allocated, used, and deallocated within the call, with no side
  - effects.
+ -
+ - If the FilePath contains a value that is not legal in the filesystem
+ - encoding, rather than thowing an exception, it will be returned as-is.
  -}
 {-# NOINLINE _encodeFilePath #-}
 _encodeFilePath :: FilePath -> String
 _encodeFilePath fp = unsafePerformIO $ do
 	enc <- Encoding.getFileSystemEncoding
-	GHC.withCString enc fp $ GHC.peekCString Encoding.char8
+	GHC.withCString enc fp (GHC.peekCString Encoding.char8)
+		`catchNonAsync` (\_ -> return fp)
 
 {- Encodes a FilePath into a Md5.Str, applying the filesystem encoding. -}
 md5FilePath :: FilePath -> MD5.Str
@@ -80,13 +89,21 @@ md5FilePath = MD5.Str . _encodeFilePath
 {- Decodes a ByteString into a FilePath, applying the filesystem encoding. -}
 decodeBS :: L.ByteString -> FilePath
 #ifndef mingw32_HOST_OS
-decodeBS = encodeW8 . L.unpack
+decodeBS = encodeW8NUL . L.unpack
 #else
 {- On Windows, we assume that the ByteString is utf-8, since Windows
  - only uses unicode for filenames. -}
 decodeBS = L8.toString
 #endif
 
+{- Encodes a FilePath into a ByteString, applying the filesystem encoding. -}
+encodeBS :: FilePath -> L.ByteString
+#ifndef mingw32_HOST_OS
+encodeBS = L.pack . decodeW8NUL
+#else
+encodeBS = L8.fromString
+#endif
+
 {- Converts a [Word8] to a FilePath, encoding using the filesystem encoding.
  -
  - w82c produces a String, which may contain Chars that are invalid
@@ -109,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/Utility/Format.hs b/Utility/Format.hs
index 0a6f6ce..7844963 100644
--- a/Utility/Format.hs
+++ b/Utility/Format.hs
@@ -11,7 +11,7 @@ module Utility.Format (
 	format,
 	decode_c,
 	encode_c,
-	prop_idempotent_deencode
+	prop_isomorphic_deencode
 ) where
 
 import Text.Printf (printf)
@@ -174,5 +174,5 @@ encode_c' p = concatMap echar
 	showoctal i = '\\' : printf "%03o" i
 
 {- for quickcheck -}
-prop_idempotent_deencode :: String -> Bool
-prop_idempotent_deencode s = s == decode_c (encode_c s)
+prop_isomorphic_deencode :: String -> Bool
+prop_isomorphic_deencode s = s == decode_c (encode_c s)
diff --git a/Utility/Metered.hs b/Utility/Metered.hs
index c34e931..da83fd8 100644
--- a/Utility/Metered.hs
+++ b/Utility/Metered.hs
@@ -18,7 +18,9 @@ import Foreign.Storable (Storable(sizeOf))
 import System.Posix.Types
 import Data.Int
 import Data.Bits.Utils
+import Control.Concurrent
 import Control.Concurrent.Async
+import Control.Monad.IO.Class (MonadIO)
 
 {- An action that can be run repeatedly, updating it on the bytes processed.
  -
@@ -29,6 +31,9 @@ type MeterUpdate = (BytesProcessed -> IO ())
 nullMeterUpdate :: MeterUpdate
 nullMeterUpdate _ = return ()
 
+combineMeterUpdate :: MeterUpdate -> MeterUpdate -> MeterUpdate
+combineMeterUpdate a b = \n -> a n >> b n
+
 {- Total number of bytes processed so far. -}
 newtype BytesProcessed = BytesProcessed Integer
 	deriving (Eq, Ord, Show)
@@ -146,6 +151,23 @@ defaultChunkSize = 32 * k - chunkOverhead
 	k = 1024
 	chunkOverhead = 2 * sizeOf (1 :: Int) -- GHC specific
 
+{- Runs an action, watching a file as it grows and updating the meter. -}
+watchFileSize :: (MonadIO m, MonadMask m) => FilePath -> MeterUpdate -> m a -> m a
+watchFileSize f p a = bracket 
+	(liftIO $ forkIO $ watcher zeroBytesProcessed)
+	(liftIO . void . tryIO . killThread)
+	(const a)
+  where
+	watcher oldsz = do
+		v <- catchMaybeIO $ toBytesProcessed <$> getFileSize f
+		newsz <- case v of
+			Just sz | sz /= oldsz -> do
+				p sz
+				return sz
+			_ -> return oldsz
+		threadDelay 500000 -- 0.5 seconds
+		watcher newsz
+
 data OutputHandler = OutputHandler
 	{ quietMode :: Bool
 	, stderrHandler :: String -> IO ()
diff --git a/Utility/Misc.hs b/Utility/Misc.hs
index e4eccac..ebb4257 100644
--- a/Utility/Misc.hs
+++ b/Utility/Misc.hs
@@ -6,23 +6,25 @@
  -}
 
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Misc where
 
+import Utility.FileSystemEncoding
+import Utility.Monad
+
 import System.IO
 import Control.Monad
 import Foreign
 import Data.Char
 import Data.List
-import Control.Applicative
 import System.Exit
 #ifndef mingw32_HOST_OS
 import System.Posix.Process (getAnyProcessStatus)
 import Utility.Exception
 #endif
-
-import Utility.FileSystemEncoding
-import Utility.Monad
+import Control.Applicative
+import Prelude
 
 {- A version of hgetContents that is not lazy. Ensures file is 
  - all read before it gets closed. -}
@@ -134,7 +136,7 @@ hGetSomeString h sz = do
  - if this reap gets there first. -}
 reapZombies :: IO ()
 #ifndef mingw32_HOST_OS
-reapZombies = do
+reapZombies =
 	-- throws an exception when there are no child processes
 	catchDefaultIO Nothing (getAnyProcessStatus False True)
 		>>= maybe (return ()) (const reapZombies)
diff --git a/Utility/Monad.hs b/Utility/Monad.hs
index 878e0da..ac75104 100644
--- a/Utility/Monad.hs
+++ b/Utility/Monad.hs
@@ -5,6 +5,8 @@
  - License: BSD-2-clause
  -}
 
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
 module Utility.Monad where
 
 import Data.Maybe
diff --git a/Utility/PartialPrelude.hs b/Utility/PartialPrelude.hs
index 6efa093..5579556 100644
--- a/Utility/PartialPrelude.hs
+++ b/Utility/PartialPrelude.hs
@@ -5,6 +5,8 @@
  - them being accidentially used.
  -}
 
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
 module Utility.PartialPrelude where
 
 import qualified Data.Maybe
diff --git a/Utility/Path.hs b/Utility/Path.hs
index 9f0737f..f3290d8 100644
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -6,6 +6,7 @@
  -}
 
 {-# LANGUAGE PackageImports, CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Path where
 
@@ -16,6 +17,7 @@ import Data.List
 import Data.Maybe
 import Data.Char
 import Control.Applicative
+import Prelude
 
 #ifdef mingw32_HOST_OS
 import qualified System.FilePath.Posix as Posix
@@ -28,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
@@ -48,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
@@ -86,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
@@ -146,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
@@ -285,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/Utility/PosixFiles.hs b/Utility/PosixFiles.hs
index 5a94ead..4550beb 100644
--- a/Utility/PosixFiles.hs
+++ b/Utility/PosixFiles.hs
@@ -8,6 +8,7 @@
  -}
 
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.PosixFiles (
 	module X,
diff --git a/Utility/Process.hs b/Utility/Process.hs
index cbbe8a8..c669996 100644
--- a/Utility/Process.hs
+++ b/Utility/Process.hs
@@ -1,12 +1,13 @@
 {- System.Process enhancements, including additional ways of running
  - processes, and logging.
  -
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2015 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
 
 {-# LANGUAGE CPP, Rank2Types #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Process (
 	module X,
@@ -30,6 +31,7 @@ module Utility.Process (
 	withQuietOutput,
 	feedWithQuietOutput,
 	createProcess,
+	waitForProcess,
 	startInteractiveProcess,
 	stdinHandle,
 	stdoutHandle,
@@ -39,9 +41,12 @@ module Utility.Process (
 	devNull,
 ) where
 
-import qualified System.Process
-import qualified System.Process as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess)
-import System.Process hiding (createProcess, readProcess)
+import qualified Utility.Process.Shim
+import qualified Utility.Process.Shim as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess)
+import Utility.Process.Shim hiding (createProcess, readProcess, waitForProcess)
+import Utility.Misc
+import Utility.Exception
+
 import System.Exit
 import System.IO
 import System.Log.Logger
@@ -54,17 +59,15 @@ import qualified System.Posix.IO
 import Control.Applicative
 #endif
 import Data.Maybe
-
-import Utility.Misc
-import Utility.Exception
+import Prelude
 
 type CreateProcessRunner = forall a. CreateProcess -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO a) -> IO a
 
 data StdHandle = StdinHandle | StdoutHandle | StderrHandle
 	deriving (Eq)
 
-{- Normally, when reading from a process, it does not need to be fed any
- - standard input. -}
+-- | Normally, when reading from a process, it does not need to be fed any
+-- standard input.
 readProcess :: FilePath	-> [String] -> IO String
 readProcess cmd args = readProcessEnv cmd args Nothing
 
@@ -82,9 +85,8 @@ readProcess' p = withHandle StdoutHandle createProcessSuccess p $ \h -> do
 	hClose h
 	return output
 
-{- Runs an action to write to a process on its stdin, 
- - returns its output, and also allows specifying the environment.
- -}
+-- | Runs an action to write to a process on its stdin, 
+-- returns its output, and also allows specifying the environment.
 writeReadProcessEnv
 	:: FilePath
 	-> [String]
@@ -124,8 +126,8 @@ writeReadProcessEnv cmd args environ writestdin adjusthandle = do
 		, env = environ
 		}
 
-{- Waits for a ProcessHandle, and throws an IOError if the process
- - did not exit successfully. -}
+-- | Waits for a ProcessHandle, and throws an IOError if the process
+-- did not exit successfully.
 forceSuccessProcess :: CreateProcess -> ProcessHandle -> IO ()
 forceSuccessProcess p pid = do
 	code <- waitForProcess pid
@@ -133,10 +135,10 @@ forceSuccessProcess p pid = do
 		ExitSuccess -> return ()
 		ExitFailure n -> fail $ showCmd p ++ " exited " ++ show n
 
-{- Waits for a ProcessHandle and returns True if it exited successfully.
- - Note that using this with createProcessChecked will throw away
- - the Bool, and is only useful to ignore the exit code of a process,
- - while still waiting for it. -}
+-- | Waits for a ProcessHandle and returns True if it exited successfully.
+-- Note that using this with createProcessChecked will throw away
+-- the Bool, and is only useful to ignore the exit code of a process,
+-- while still waiting for it. -}
 checkSuccessProcess :: ProcessHandle -> IO Bool
 checkSuccessProcess pid = do
 	code <- waitForProcess pid
@@ -147,13 +149,13 @@ ignoreFailureProcess pid = do
 	void $ waitForProcess pid
 	return True
 
-{- Runs createProcess, then an action on its handles, and then
- - forceSuccessProcess. -}
+-- | Runs createProcess, then an action on its handles, and then
+-- forceSuccessProcess.
 createProcessSuccess :: CreateProcessRunner
 createProcessSuccess p a = createProcessChecked (forceSuccessProcess p) p a
 
-{- Runs createProcess, then an action on its handles, and then
- - a checker action on its exit code, which must wait for the process. -}
+-- | Runs createProcess, then an action on its handles, and then
+-- a checker action on its exit code, which must wait for the process.
 createProcessChecked :: (ProcessHandle -> IO b) -> CreateProcessRunner
 createProcessChecked checker p a = do
 	t@(_, _, _, pid) <- createProcess p
@@ -161,31 +163,30 @@ createProcessChecked checker p a = do
 	_ <- checker pid
 	either E.throw return r
 
-{- Leaves the process running, suitable for lazy streaming.
- - Note: Zombies will result, and must be waited on. -}
+-- | Leaves the process running, suitable for lazy streaming.
+-- Note: Zombies will result, and must be waited on.
 createBackgroundProcess :: CreateProcessRunner
 createBackgroundProcess p a = a =<< createProcess p
 
-{- Runs a process, optionally feeding it some input, and
- - returns a transcript combining its stdout and stderr, and
- - whether it succeeded or failed. -}
+-- | Runs a process, optionally feeding it some input, and
+-- returns a transcript combining its stdout and stderr, and
+-- whether it succeeded or failed.
 processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
-processTranscript cmd opts input = processTranscript' cmd opts Nothing input
+processTranscript = processTranscript' id
 
-processTranscript' :: String -> [String] -> Maybe [(String, String)] -> (Maybe String) -> IO (String, Bool)
-processTranscript' cmd opts environ input = do
+processTranscript' :: (CreateProcess -> CreateProcess) -> String -> [String] -> Maybe String -> IO (String, Bool)
+processTranscript' modproc cmd opts input = do
 #ifndef mingw32_HOST_OS
 {- This implementation interleves stdout and stderr in exactly the order
  - the process writes them. -}
 	(readf, writef) <- System.Posix.IO.createPipe
 	readh <- System.Posix.IO.fdToHandle readf
 	writeh <- System.Posix.IO.fdToHandle writef
-	p@(_, _, _, pid) <- createProcess $
+	p@(_, _, _, pid) <- createProcess $ modproc $
 		(proc cmd opts)
 			{ std_in = if isJust input then CreatePipe else Inherit
 			, std_out = UseHandle writeh
 			, std_err = UseHandle writeh
-			, env = environ
 			}
 	hClose writeh
 
@@ -197,12 +198,11 @@ processTranscript' cmd opts environ input = do
 	return (transcript, ok)
 #else
 {- This implementation for Windows puts stderr after stdout. -}
-	p@(_, _, _, pid) <- createProcess $
+	p@(_, _, _, pid) <- createProcess $ modproc $
 		(proc cmd opts)
 			{ std_in = if isJust input then CreatePipe else Inherit
 			, std_out = CreatePipe
 			, std_err = CreatePipe
-			, env = environ
 			}
 
 	getout <- mkreader (stdoutHandle p)
@@ -232,9 +232,9 @@ processTranscript' cmd opts environ input = do
 		hClose inh
 	writeinput Nothing _ = return ()
 
-{- Runs a CreateProcessRunner, on a CreateProcess structure, that
- - is adjusted to pipe only from/to a single StdHandle, and passes
- - the resulting Handle to an action. -}
+-- | Runs a CreateProcessRunner, on a CreateProcess structure, that
+-- is adjusted to pipe only from/to a single StdHandle, and passes
+-- the resulting Handle to an action.
 withHandle
 	:: StdHandle
 	-> CreateProcessRunner
@@ -256,7 +256,7 @@ withHandle h creator p a = creator p' $ a . select
 		| h == StderrHandle =
 			(stderrHandle, base { std_err = CreatePipe })
 
-{- Like withHandle, but passes (stdin, stdout) handles to the action. -}
+-- | Like withHandle, but passes (stdin, stdout) handles to the action.
 withIOHandles
 	:: CreateProcessRunner
 	-> CreateProcess
@@ -270,7 +270,7 @@ withIOHandles creator p a = creator p' $ a . ioHandles
 		, std_err = Inherit
 		}
 
-{- Like withHandle, but passes (stdout, stderr) handles to the action. -}
+-- | Like withHandle, but passes (stdout, stderr) handles to the action.
 withOEHandles
 	:: CreateProcessRunner
 	-> CreateProcess
@@ -284,8 +284,8 @@ withOEHandles creator p a = creator p' $ a . oeHandles
 		, std_err = CreatePipe
 		}
 
-{- Forces the CreateProcessRunner to run quietly;
- - both stdout and stderr are discarded. -}
+-- | Forces the CreateProcessRunner to run quietly;
+-- both stdout and stderr are discarded.
 withQuietOutput
 	:: CreateProcessRunner
 	-> CreateProcess
@@ -297,8 +297,8 @@ withQuietOutput creator p = withFile devNull WriteMode $ \nullh -> do
 		}
 	creator p' $ const $ return ()
 
-{- Stdout and stderr are discarded, while the process is fed stdin
- - from the handle. -}
+-- | Stdout and stderr are discarded, while the process is fed stdin
+-- from the handle.
 feedWithQuietOutput
 	:: CreateProcessRunner
 	-> CreateProcess
@@ -319,11 +319,11 @@ devNull = "/dev/null"
 devNull = "NUL"
 #endif
 
-{- Extract a desired handle from createProcess's tuple.
- - These partial functions are safe as long as createProcess is run
- - with appropriate parameters to set up the desired handle.
- - Get it wrong and the runtime crash will always happen, so should be
- - easily noticed. -}
+-- | Extract a desired handle from createProcess's tuple.
+-- These partial functions are safe as long as createProcess is run
+-- with appropriate parameters to set up the desired handle.
+-- Get it wrong and the runtime crash will always happen, so should be
+-- easily noticed.
 type HandleExtractor = (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> Handle
 stdinHandle :: HandleExtractor
 stdinHandle (Just h, _, _, _) = h
@@ -344,31 +344,15 @@ oeHandles _ = error "expected oeHandles"
 processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle
 processHandle (_, _, _, pid) = pid
 
-{- Debugging trace for a CreateProcess. -}
-debugProcess :: CreateProcess -> IO ()
-debugProcess p = do
-	debugM "Utility.Process" $ unwords
-		[ action ++ ":"
-		, showCmd p
-		]
-  where
-	action
-		| piped (std_in p) && piped (std_out p) = "chat"
-		| piped (std_in p)                      = "feed"
-		| piped (std_out p)                     = "read"
-		| otherwise                             = "call"
-	piped Inherit = False
-	piped _ = True
-
-{- Shows the command that a CreateProcess will run. -}
+-- | Shows the command that a CreateProcess will run.
 showCmd :: CreateProcess -> String
 showCmd = go . cmdspec
   where
 	go (ShellCommand s) = s
 	go (RawCommand c ps) = c ++ " " ++ show ps
 
-{- Starts an interactive process. Unlike runInteractiveProcess in
- - System.Process, stderr is inherited. -}
+-- | Starts an interactive process. Unlike runInteractiveProcess in
+-- System.Process, stderr is inherited.
 startInteractiveProcess
 	:: FilePath
 	-> [String]
@@ -384,8 +368,30 @@ startInteractiveProcess cmd args environ = do
 	(Just from, Just to, _, pid) <- createProcess p
 	return (pid, to, from)
 
-{- Wrapper around System.Process function that does debug logging. -}
+-- | Wrapper around 'System.Process.createProcess' that does debug logging.
 createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 createProcess p = do
 	debugProcess p
-	System.Process.createProcess p
+	Utility.Process.Shim.createProcess p
+
+-- | Debugging trace for a CreateProcess.
+debugProcess :: CreateProcess -> IO ()
+debugProcess p = debugM "Utility.Process" $ unwords
+	[ action ++ ":"
+	, showCmd p
+	]
+  where
+	action
+		| piped (std_in p) && piped (std_out p) = "chat"
+		| piped (std_in p)                      = "feed"
+		| piped (std_out p)                     = "read"
+		| otherwise                             = "call"
+	piped Inherit = False
+	piped _ = True
+
+-- | Wrapper around 'System.Process.waitForProcess' that does debug logging.
+waitForProcess ::  ProcessHandle -> IO ExitCode
+waitForProcess h = do
+	r <- Utility.Process.Shim.waitForProcess h
+	debugM "Utility.Process" ("process done " ++ show r)
+	return r
diff --git a/Utility/Process/Shim.hs b/Utility/Process/Shim.hs
new file mode 100644
index 0000000..09312c7
--- /dev/null
+++ b/Utility/Process/Shim.hs
@@ -0,0 +1,3 @@
+module Utility.Process.Shim (module X) where
+
+import System.Process as X
diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs
index 54200d3..cd408dd 100644
--- a/Utility/QuickCheck.hs
+++ b/Utility/QuickCheck.hs
@@ -19,6 +19,7 @@ import System.Posix.Types
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Control.Applicative
+import Prelude
 
 instance (Arbitrary k, Arbitrary v, Eq k, Ord k) => Arbitrary (M.Map k v) where
 	arbitrary = M.fromList <$> arbitrary
diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs
index 4f4c4eb..3aaf928 100644
--- a/Utility/Rsync.hs
+++ b/Utility/Rsync.hs
@@ -44,7 +44,8 @@ rsyncServerParams =
 	-- allow resuming of transfers of big files
 	, Param "--inplace"
 	-- other options rsync normally uses in server mode
-	, Params "-e.Lsf ."
+	, Param "-e.Lsf"
+	, Param "."
 	]
 
 rsyncUseDestinationPermissions :: CommandParam
diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs
index f44112b..5ce17a8 100644
--- a/Utility/SafeCommand.hs
+++ b/Utility/SafeCommand.hs
@@ -1,84 +1,94 @@
 {- safely running shell commands
  -
- - Copyright 2010-2013 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
 
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
 module Utility.SafeCommand where
 
 import System.Exit
 import Utility.Process
 import Data.String.Utils
-import Control.Applicative
 import System.FilePath
 import Data.Char
+import Data.List
+import Control.Applicative
+import Prelude
 
-{- A type for parameters passed to a shell command. A command can
- - be passed either some Params (multiple parameters can be included,
- - whitespace-separated, or a single Param (for when parameters contain
- - whitespace), or a File.
- -}
-data CommandParam = Params String | Param String | File FilePath
+-- | Parameters that can be passed to a shell command.
+data CommandParam
+	= Param String -- ^ A parameter
+	| File FilePath -- ^ The name of a file
 	deriving (Eq, Show, Ord)
 
-{- Used to pass a list of CommandParams to a function that runs
- - a command and expects Strings. -}
+-- | Used to pass a list of CommandParams to a function that runs
+-- a command and expects Strings. -}
 toCommand :: [CommandParam] -> [String]
-toCommand = concatMap unwrap
+toCommand = map unwrap
   where
-	unwrap (Param s) = [s]
-	unwrap (Params s) = filter (not . null) (split " " s)
+	unwrap (Param s) = s
 	-- Files that start with a non-alphanumeric that is not a path
 	-- separator are modified to avoid the command interpreting them as
 	-- options or other special constructs.
 	unwrap (File s@(h:_))
-		| isAlphaNum h || h `elem` pathseps = [s]
-		| otherwise = ["./" ++ s]
-	unwrap (File s) = [s]
+		| isAlphaNum h || h `elem` pathseps = s
+		| otherwise = "./" ++ s
+	unwrap (File s) = s
 	-- '/' is explicitly included because it's an alternative
 	-- path separator on Windows.
 	pathseps = pathSeparator:"./"
 
-{- Run a system command, and returns True or False
- - if it succeeded or failed.
- -}
+-- | Run a system command, and returns True or False if it succeeded or failed.
+--
+-- This and other command running functions in this module log the commands
+-- run at debug level, using System.Log.Logger.
 boolSystem :: FilePath -> [CommandParam] -> IO Bool
-boolSystem command params = boolSystemEnv command params Nothing
+boolSystem command params = boolSystem' command params id
 
-boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
-boolSystemEnv command params environ = dispatch <$> safeSystemEnv command params environ
+boolSystem' :: FilePath -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO Bool
+boolSystem' command params mkprocess = dispatch <$> safeSystem' command params mkprocess
   where
 	dispatch ExitSuccess = True
 	dispatch _ = False
 
-{- Runs a system command, returning the exit status. -}
+boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
+boolSystemEnv command params environ = boolSystem' command params $
+	\p -> p { env = environ }
+
+-- | Runs a system command, returning the exit status.
 safeSystem :: FilePath -> [CommandParam] -> IO ExitCode
-safeSystem command params = safeSystemEnv command params Nothing
+safeSystem command params = safeSystem' command params id
 
-safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO ExitCode
-safeSystemEnv command params environ = do
-	(_, _, _, pid) <- createProcess (proc command $ toCommand params)
-		{ env = environ }
+safeSystem' :: FilePath -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO ExitCode
+safeSystem' command params mkprocess = do
+	(_, _, _, pid) <- createProcess p
 	waitForProcess pid
+  where
+	p = mkprocess $ proc command (toCommand params)
 
-{- Wraps a shell command line inside sh -c, allowing it to be run in a
- - login shell that may not support POSIX shell, eg csh. -}
+safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO ExitCode
+safeSystemEnv command params environ = safeSystem' command params $ 
+	\p -> p { env = environ }
+
+-- | Wraps a shell command line inside sh -c, allowing it to be run in a
+-- login shell that may not support POSIX shell, eg csh.
 shellWrap :: String -> String
 shellWrap cmdline = "sh -c " ++ shellEscape cmdline
 
-{- Escapes a filename or other parameter to be safely able to be exposed to
- - the shell.
- -
- - This method works for POSIX shells, as well as other shells like csh.
- -}
+-- | Escapes a filename or other parameter to be safely able to be exposed to
+-- the shell.
+--
+-- This method works for POSIX shells, as well as other shells like csh.
 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. -}
+-- | Unescapes a set of shellEscaped words or filenames.
 shellUnEscape :: String -> [String]
 shellUnEscape [] = []
 shellUnEscape s = word : shellUnEscape rest
@@ -95,19 +105,19 @@ shellUnEscape s = word : shellUnEscape rest
 		| c == q = findword w cs
 		| 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
+-- | For quickcheck.
+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. -}
+-- | Segments a list of filenames into groups that are all below the maximum
+--  command-line length limit.
 segmentXargsOrdered :: [FilePath] -> [[FilePath]]
 segmentXargsOrdered = reverse . map reverse . segmentXargsUnordered
 
-{- Not preserving data is a little faster, and streams better when
- - there are a great many filesnames. -}
+-- | Not preserving order is a little faster, and streams better when
+-- there are a great many filenames.
 segmentXargsUnordered :: [FilePath] -> [[FilePath]]
 segmentXargsUnordered l = go l [] 0 []
   where
diff --git a/Utility/UserInfo.hs b/Utility/UserInfo.hs
index 5bf8d5c..7e94caf 100644
--- a/Utility/UserInfo.hs
+++ b/Utility/UserInfo.hs
@@ -6,6 +6,7 @@
  -}
 
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.UserInfo (
 	myHomeDir,
@@ -13,12 +14,13 @@ module Utility.UserInfo (
 	myUserGecos,
 ) where
 
+import Utility.Env
+
 import System.PosixCompat
 #ifndef mingw32_HOST_OS
 import Control.Applicative
 #endif
-
-import Utility.Env
+import Prelude
 
 {- Current user's home directory.
  -
-- 
cgit v1.2.3