From 9df8a6eb9405dde4464d27133c04f5ee539a85de Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 2 Jan 2020 12:34:10 -0400
Subject: merge from git-annex and relicense accordingly

Merge git library and utility from git-annex. The former is now relicensed
AGPL, so git-repair as a whole becomes AGPL.

For simplicity, I am relicensing the remainder of the code in git-repair
AGPL as well, per the header changes in this commit. While that code is
also technically available under the GPL license, as it's been released
under that license before, changes going forward will be only released by
me under the AGPL.
---
 Utility/Applicative.hs        |   6 +-
 Utility/Attoparsec.hs         |  21 +++++++
 Utility/Batch.hs              |  17 +++---
 Utility/Data.hs               |   5 +-
 Utility/Directory.hs          |  93 +----------------------------
 Utility/DottedVersion.hs      |  11 +++-
 Utility/Env.hs                |  33 +++--------
 Utility/Env/Basic.hs          |  25 ++++++++
 Utility/Env/Set.hs            |  43 ++++++++++++++
 Utility/Exception.hs          |  18 +-----
 Utility/FileMode.hs           |   3 +-
 Utility/FileSize.hs           |  12 +++-
 Utility/FileSystemEncoding.hs |  93 ++++++++++++++++++++++++-----
 Utility/Format.hs             |  10 ++--
 Utility/HumanNumber.hs        |   2 +-
 Utility/HumanTime.hs          |  12 ++--
 Utility/Metered.hs            | 135 ++++++++++++++++++++++++++++--------------
 Utility/Misc.hs               |  42 +++++++------
 Utility/Monad.hs              |  14 ++++-
 Utility/PartialPrelude.hs     |  21 +++++--
 Utility/Path.hs               |  92 +++++++++++-----------------
 Utility/PosixFiles.hs         |  42 -------------
 Utility/Process.hs            |  91 ++++------------------------
 Utility/QuickCheck.hs         |  32 +++++-----
 Utility/Rsync.hs              |  51 +++++++++++++++-
 Utility/SafeCommand.hs        |  38 ++++++++----
 Utility/Split.hs              |  11 +++-
 Utility/ThreadScheduler.hs    |  13 ++--
 Utility/Tmp.hs                |  61 +++----------------
 Utility/Tmp/Dir.hs            |  70 ++++++++++++++++++++++
 Utility/Tuple.hs              |   6 +-
 Utility/UserInfo.hs           |  17 +++---
 32 files changed, 617 insertions(+), 523 deletions(-)
 create mode 100644 Utility/Attoparsec.hs
 create mode 100644 Utility/Env/Basic.hs
 create mode 100644 Utility/Env/Set.hs
 delete mode 100644 Utility/PosixFiles.hs
 create mode 100644 Utility/Tmp/Dir.hs

(limited to 'Utility')

diff --git a/Utility/Applicative.hs b/Utility/Applicative.hs
index fce3c04..fcd6932 100644
--- a/Utility/Applicative.hs
+++ b/Utility/Applicative.hs
@@ -5,7 +5,11 @@
  - License: BSD-2-clause
  -}
 
-module Utility.Applicative where
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Applicative (
+	(<$$>),
+) where
 
 {- Like <$> , but supports one level of currying.
  - 
diff --git a/Utility/Attoparsec.hs b/Utility/Attoparsec.hs
new file mode 100644
index 0000000..bd20e8e
--- /dev/null
+++ b/Utility/Attoparsec.hs
@@ -0,0 +1,21 @@
+{- attoparsec utility functions
+ -
+ - Copyright 2019 Joey Hess <id@joeyh.name>
+ - Copyright 2007-2015 Bryan O'Sullivan
+ -
+ - License: BSD-3-clause
+ -}
+
+module Utility.Attoparsec where
+
+import qualified Data.Attoparsec.ByteString as A
+import qualified Data.ByteString as B
+
+-- | Parse and decode an unsigned octal number.
+--
+-- This parser does not accept a leading @\"0o\"@ string.
+octal :: Integral a => A.Parser a
+octal = B.foldl' step 0 `fmap` A.takeWhile1 isOctDigit
+  where
+	isOctDigit w = w >= 48 && w <= 55
+	step a w = a * 8 + fromIntegral (w - 48)
diff --git a/Utility/Batch.hs b/Utility/Batch.hs
index d96f9d3..1d66881 100644
--- a/Utility/Batch.hs
+++ b/Utility/Batch.hs
@@ -7,11 +7,18 @@
 
 {-# LANGUAGE CPP #-}
 
-module Utility.Batch where
+module Utility.Batch (
+	batch,
+	BatchCommandMaker,
+	getBatchCommandMaker,
+	toBatchCommand,
+	batchCommand,
+	batchCommandEnv,
+) where
 
 import Common
 
-#if defined(linux_HOST_OS) || defined(__ANDROID__)
+#if defined(linux_HOST_OS)
 import Control.Concurrent.Async
 import System.Posix.Process
 #endif
@@ -29,7 +36,7 @@ import qualified Control.Exception as E
  - systems, the action is simply ran.
  -}
 batch :: IO a -> IO a
-#if defined(linux_HOST_OS) || defined(__ANDROID__)
+#if defined(linux_HOST_OS)
 batch a = wait =<< batchthread
   where
 	batchthread = asyncBound $ do
@@ -51,11 +58,7 @@ getBatchCommandMaker = do
 #ifndef mingw32_HOST_OS
 	nicers <- filterM (inPath . fst)
 		[ ("nice", [])
-#ifndef __ANDROID__
-		-- Android's ionice does not allow specifying a command,
-		-- so don't use it.
 		, ("ionice", ["-c3"])
-#endif
 		, ("nocache", [])
 		]
 	return $ \(command, params) ->
diff --git a/Utility/Data.hs b/Utility/Data.hs
index 27c0a82..5510845 100644
--- a/Utility/Data.hs
+++ b/Utility/Data.hs
@@ -7,7 +7,10 @@
 
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.Data where
+module Utility.Data (
+	firstJust,
+	eitherToMaybe,
+) where
 
 {- First item in the list that is not Nothing. -}
 firstJust :: Eq a => [Maybe a] -> Maybe a
diff --git a/Utility/Directory.hs b/Utility/Directory.hs
index 895581d..e2c6a94 100644
--- a/Utility/Directory.hs
+++ b/Utility/Directory.hs
@@ -18,15 +18,11 @@ import Control.Monad
 import System.FilePath
 import System.PosixCompat.Files
 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
+#ifndef mingw32_HOST_OS
 import Utility.SafeCommand
 import Control.Monad.IfElse
 #endif
@@ -158,90 +154,3 @@ nukeFile file = void $ tryWhenExists go
 #else
 	go = removeFile file
 #endif
-
-#ifndef mingw32_HOST_OS
-data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream
-#else
-data DirectoryHandle = DirectoryHandle IsOpen Win32.HANDLE Win32.FindData (MVar ())
-#endif
-
-type IsOpen = MVar () -- full when the handle is open
-
-openDirectory :: FilePath -> IO DirectoryHandle
-openDirectory path = do
-#ifndef mingw32_HOST_OS
-	dirp <- Posix.openDirStream path
-	isopen <- newMVar ()
-	return (DirectoryHandle isopen dirp)
-#else
-	(h, fdat) <- Win32.findFirstFile (path </> "*")
-	-- Indicate that the fdat contains a filename that readDirectory
-	-- has not yet returned, by making the MVar be full.
-	-- (There's always at least a "." entry.)
-	alreadyhave <- newMVar ()
-	isopen <- newMVar ()
-	return (DirectoryHandle isopen h fdat alreadyhave)
-#endif
-
-closeDirectory :: DirectoryHandle -> IO ()
-#ifndef mingw32_HOST_OS
-closeDirectory (DirectoryHandle isopen dirp) =
-	whenOpen isopen $
-		Posix.closeDirStream dirp
-#else
-closeDirectory (DirectoryHandle isopen h _ alreadyhave) =
-	whenOpen isopen $ do
-		_ <- tryTakeMVar alreadyhave
-		Win32.findClose h
-#endif
-  where
-	whenOpen :: IsOpen -> IO () -> IO ()
-	whenOpen mv f = do
-		v <- tryTakeMVar mv
-		when (isJust v) f
-
-{- |Reads the next entry from the handle. Once the end of the directory
-is reached, returns Nothing and automatically closes the handle.
--}
-readDirectory :: DirectoryHandle -> IO (Maybe FilePath)
-#ifndef mingw32_HOST_OS
-readDirectory hdl@(DirectoryHandle _ dirp) = do
-	e <- Posix.readDirStream dirp
-	if null e
-		then do
-			closeDirectory hdl
-			return Nothing
-		else return (Just e)
-#else
-readDirectory hdl@(DirectoryHandle _ h fdat mv) = do
-	-- If the MVar is full, then the filename in fdat has
-	-- not yet been returned. Otherwise, need to find the next
-	-- file.
-	r <- tryTakeMVar mv
-	case r of
-		Just () -> getfn
-		Nothing -> do
-			more <- Win32.findNextFile h fdat
-			if more
-				then getfn
-				else do
-					closeDirectory hdl
-					return Nothing
-  where
-	getfn = do
-		filename <- Win32.getFindDataFileName fdat
-		return (Just filename)
-#endif
-
--- True only when directory exists and contains nothing.
--- Throws exception if directory does not exist.
-isDirectoryEmpty :: FilePath -> IO Bool
-isDirectoryEmpty d = bracket (openDirectory d) closeDirectory check
-  where
-	check h = do
-		v <- readDirectory h
-		case v of
-			Nothing -> return True
-			Just f
-				| not (dirCruft f) -> return False
-				| otherwise -> check h
diff --git a/Utility/DottedVersion.hs b/Utility/DottedVersion.hs
index 3198b1c..dff3717 100644
--- a/Utility/DottedVersion.hs
+++ b/Utility/DottedVersion.hs
@@ -7,7 +7,11 @@
 
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.DottedVersion where
+module Utility.DottedVersion (
+	DottedVersion,
+	fromDottedVersion,
+	normalize,
+) where
 
 import Common
 
@@ -18,7 +22,10 @@ instance Ord DottedVersion where
 	compare (DottedVersion _ x) (DottedVersion _ y) = compare x y
 
 instance Show DottedVersion where
-	show (DottedVersion s _) = s
+	show = fromDottedVersion
+
+fromDottedVersion :: DottedVersion -> String
+fromDottedVersion (DottedVersion s _) = s
 
 {- To compare dotted versions like 1.7.7 and 1.8, they are normalized to
  - a somewhat arbitrary integer representation. -}
diff --git a/Utility/Env.hs b/Utility/Env.hs
index c56f4ec..9847326 100644
--- a/Utility/Env.hs
+++ b/Utility/Env.hs
@@ -8,7 +8,14 @@
 {-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.Env where
+module Utility.Env (
+	getEnv,
+	getEnvDefault,
+	getEnvironment,
+	addEntry,
+	addEntries,
+	delEntry,
+) where
 
 #ifdef mingw32_HOST_OS
 import Utility.Exception
@@ -16,7 +23,6 @@ import Control.Applicative
 import Data.Maybe
 import Prelude
 import qualified System.Environment as E
-import qualified System.SetEnv
 #else
 import qualified System.Posix.Env as PE
 #endif
@@ -42,29 +48,6 @@ getEnvironment = PE.getEnvironment
 getEnvironment = E.getEnvironment
 #endif
 
-{- Sets an environment variable. To overwrite an existing variable,
- - overwrite must be True.
- -
- - On Windows, setting a variable to "" unsets it. -}
-setEnv :: String -> String -> Bool -> IO ()
-#ifndef mingw32_HOST_OS
-setEnv var val overwrite = PE.setEnv var val overwrite
-#else
-setEnv var val True = System.SetEnv.setEnv var val
-setEnv var val False = do
-	r <- getEnv var
-	case r of
-		Nothing -> setEnv var val True
-		Just _ -> return ()
-#endif
-
-unsetEnv :: String -> IO ()
-#ifndef mingw32_HOST_OS
-unsetEnv = PE.unsetEnv
-#else
-unsetEnv = System.SetEnv.unsetEnv
-#endif
-
 {- Adds the environment variable to the input environment. If already
  - present in the list, removes the old value.
  -
diff --git a/Utility/Env/Basic.hs b/Utility/Env/Basic.hs
new file mode 100644
index 0000000..db73827
--- /dev/null
+++ b/Utility/Env/Basic.hs
@@ -0,0 +1,25 @@
+{- portable environment variables, without any dependencies
+ -
+ - Copyright 2013 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Env.Basic (
+	getEnv,
+	getEnvDefault,
+) where
+
+import Utility.Exception
+import Control.Applicative
+import Data.Maybe
+import Prelude
+import qualified System.Environment as E
+
+getEnv :: String -> IO (Maybe String)
+getEnv = catchMaybeIO . E.getEnv
+
+getEnvDefault :: String -> String -> IO String
+getEnvDefault var fallback = fromMaybe fallback <$> getEnv var
diff --git a/Utility/Env/Set.hs b/Utility/Env/Set.hs
new file mode 100644
index 0000000..f14674c
--- /dev/null
+++ b/Utility/Env/Set.hs
@@ -0,0 +1,43 @@
+{- portable environment variables
+ -
+ - Copyright 2013 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Utility.Env.Set (
+	setEnv,
+	unsetEnv,
+) where
+
+#ifdef mingw32_HOST_OS
+import qualified System.SetEnv
+import Utility.Env
+#else
+import qualified System.Posix.Env as PE
+#endif
+
+{- Sets an environment variable. To overwrite an existing variable,
+ - overwrite must be True.
+ -
+ - On Windows, setting a variable to "" unsets it. -}
+setEnv :: String -> String -> Bool -> IO ()
+#ifndef mingw32_HOST_OS
+setEnv var val overwrite = PE.setEnv var val overwrite
+#else
+setEnv var val True = System.SetEnv.setEnv var val
+setEnv var val False = do
+	r <- getEnv var
+	case r of
+		Nothing -> setEnv var val True
+		Just _ -> return ()
+#endif
+
+unsetEnv :: String -> IO ()
+#ifndef mingw32_HOST_OS
+unsetEnv = PE.unsetEnv
+#else
+unsetEnv = System.SetEnv.unsetEnv
+#endif
diff --git a/Utility/Exception.hs b/Utility/Exception.hs
index 67c2e85..bcadb78 100644
--- a/Utility/Exception.hs
+++ b/Utility/Exception.hs
@@ -5,7 +5,7 @@
  - License: BSD-2-clause
  -}
 
-{-# LANGUAGE CPP, ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Exception (
@@ -29,11 +29,7 @@ module Utility.Exception (
 import Control.Monad.Catch as X hiding (Handler)
 import qualified Control.Monad.Catch as M
 import Control.Exception (IOException, AsyncException)
-#ifdef MIN_VERSION_GLASGOW_HASKELL
-#if MIN_VERSION_GLASGOW_HASKELL(7,10,0,0)
 import Control.Exception (SomeAsyncException)
-#endif
-#endif
 import Control.Monad
 import Control.Monad.IO.Class (liftIO, MonadIO)
 import System.IO.Error (isDoesNotExistError, ioeGetErrorType)
@@ -46,15 +42,7 @@ import Utility.Data
  - where there's a problem that the user is excpected to see in some
  - circumstances. -}
 giveup :: [Char] -> a
-#ifdef MIN_VERSION_base
-#if MIN_VERSION_base(4,9,0)
 giveup = errorWithoutStackTrace
-#else
-giveup = error
-#endif
-#else
-giveup = error
-#endif
 
 {- Catches IO errors and returns a Bool -}
 catchBoolIO :: MonadCatch m => m Bool -> m Bool
@@ -95,11 +83,7 @@ bracketIO setup cleanup = bracket (liftIO setup) (liftIO . cleanup)
 catchNonAsync :: MonadCatch m => m a -> (SomeException -> m a) -> m a
 catchNonAsync a onerr = a `catches`
 	[ M.Handler (\ (e :: AsyncException) -> throwM e)
-#ifdef MIN_VERSION_GLASGOW_HASKELL
-#if MIN_VERSION_GLASGOW_HASKELL(7,10,0,0)
 	, M.Handler (\ (e :: SomeAsyncException) -> throwM e)
-#endif
-#endif
 	, M.Handler (\ (e :: SomeException) -> onerr e)
 	]
 
diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs
index 370bcf6..7d36c55 100644
--- a/Utility/FileMode.hs
+++ b/Utility/FileMode.hs
@@ -17,7 +17,7 @@ import Control.Monad
 import System.PosixCompat.Types
 import System.PosixCompat.Files
 #ifndef mingw32_HOST_OS
-import System.Posix.Files
+import System.Posix.Files (symbolicLinkMode)
 import Control.Monad.IO.Class (liftIO)
 #endif
 import Control.Monad.IO.Class (MonadIO)
@@ -69,6 +69,7 @@ otherGroupModes :: [FileMode]
 otherGroupModes = 
 	[ groupReadMode, otherReadMode
 	, groupWriteMode, otherWriteMode
+	, groupExecuteMode, otherExecuteMode
 	]
 
 {- Removes the write bits from a file. -}
diff --git a/Utility/FileSize.hs b/Utility/FileSize.hs
index 5f89cff..8544ad4 100644
--- a/Utility/FileSize.hs
+++ b/Utility/FileSize.hs
@@ -4,8 +4,13 @@
  -}
 
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.FileSize where
+module Utility.FileSize (
+	FileSize,
+	getFileSize,
+	getFileSize',
+) where
 
 import System.PosixCompat.Files
 #ifdef mingw32_HOST_OS
@@ -28,7 +33,10 @@ getFileSize f = fmap (fromIntegral . fileSize) (getFileStatus f)
 getFileSize f = bracket (openFile f ReadMode) hClose hFileSize
 #endif
 
-{- Gets the size of the file, when its FileStatus is already known. -}
+{- Gets the size of the file, when its FileStatus is already known.
+ -
+ - On windows, uses getFileSize. Otherwise, the FileStatus contains the
+ - size, so this does not do any work. -}
 getFileSize' :: FilePath -> FileStatus -> IO FileSize
 #ifndef mingw32_HOST_OS
 getFileSize' _ s = return $ fromIntegral $ fileSize s
diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs
index 444dc4a..f9e9814 100644
--- a/Utility/FileSystemEncoding.hs
+++ b/Utility/FileSystemEncoding.hs
@@ -12,12 +12,17 @@ module Utility.FileSystemEncoding (
 	useFileSystemEncoding,
 	fileEncoding,
 	withFilePath,
+	RawFilePath,
+	fromRawFilePath,
+	toRawFilePath,
+	decodeBL,
+	encodeBL,
 	decodeBS,
 	encodeBS,
-	decodeW8,
-	encodeW8,
-	encodeW8NUL,
-	decodeW8NUL,
+	decodeBL',
+	encodeBL',
+	decodeBS',
+	encodeBS',
 	truncateFilePath,
 	s2w8,
 	w82s,
@@ -32,8 +37,10 @@ import System.IO
 import System.IO.Unsafe
 import Data.Word
 import Data.List
+import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 #ifdef mingw32_HOST_OS
+import qualified Data.ByteString.UTF8 as S8
 import qualified Data.ByteString.Lazy.UTF8 as L8
 #endif
 
@@ -103,31 +110,91 @@ _encodeFilePath fp = unsafePerformIO $ do
 		`catchNonAsync` (\_ -> return fp)
 
 {- Decodes a ByteString into a FilePath, applying the filesystem encoding. -}
-decodeBS :: L.ByteString -> FilePath
+decodeBL :: L.ByteString -> FilePath
 #ifndef mingw32_HOST_OS
-decodeBS = encodeW8NUL . L.unpack
+decodeBL = encodeW8NUL . L.unpack
 #else
 {- On Windows, we assume that the ByteString is utf-8, since Windows
  - only uses unicode for filenames. -}
-decodeBS = L8.toString
+decodeBL = L8.toString
 #endif
 
 {- Encodes a FilePath into a ByteString, applying the filesystem encoding. -}
-encodeBS :: FilePath -> L.ByteString
+encodeBL :: FilePath -> L.ByteString
 #ifndef mingw32_HOST_OS
-encodeBS = L.pack . decodeW8NUL
+encodeBL = L.pack . decodeW8NUL
 #else
-encodeBS = L8.fromString
+encodeBL = L8.fromString
 #endif
 
+decodeBS :: S.ByteString -> FilePath
+#ifndef mingw32_HOST_OS
+decodeBS = encodeW8NUL . S.unpack
+#else
+decodeBS = S8.toString
+#endif
+
+encodeBS :: FilePath -> S.ByteString
+#ifndef mingw32_HOST_OS
+encodeBS = S.pack . decodeW8NUL
+#else
+encodeBS = S8.fromString
+#endif
+
+{- Faster version that assumes the string does not contain NUL;
+ - if it does it will be truncated before the NUL. -}
+decodeBS' :: S.ByteString -> FilePath
+#ifndef mingw32_HOST_OS
+decodeBS' = encodeW8 . S.unpack
+#else
+decodeBS' = S8.toString
+#endif
+
+encodeBS' :: FilePath -> S.ByteString
+#ifndef mingw32_HOST_OS
+encodeBS' = S.pack . decodeW8
+#else
+encodeBS' = S8.fromString
+#endif
+
+decodeBL' :: L.ByteString -> FilePath
+#ifndef mingw32_HOST_OS
+decodeBL' = encodeW8 . L.unpack
+#else
+decodeBL' = L8.toString
+#endif
+
+encodeBL' :: FilePath -> L.ByteString
+#ifndef mingw32_HOST_OS
+encodeBL' = L.pack . decodeW8
+#else
+encodeBL' = L8.fromString
+#endif
+
+{- Recent versions of the unix package have this alias; defined here
+ - for backwards compatibility. -}
+type RawFilePath = S.ByteString
+
+{- Note that the RawFilePath is assumed to never contain NUL,
+ - since filename's don't. This should only be used with actual
+ - RawFilePaths not arbitrary ByteString that may contain NUL. -}
+fromRawFilePath :: RawFilePath -> FilePath
+fromRawFilePath = decodeBS'
+
+{- Note that the FilePath is assumed to never contain NUL,
+ - since filename's don't. This should only be used with actual FilePaths
+ - not arbitrary String that may contain NUL. -}
+toRawFilePath :: FilePath -> RawFilePath
+toRawFilePath = encodeBS'
+
 {- Converts a [Word8] to a FilePath, encoding using the filesystem encoding.
  -
- - w82c produces a String, which may contain Chars that are invalid
+ - w82s produces a String, which may contain Chars that are invalid
  - unicode. From there, this is really a simple matter of applying the
  - file system encoding, only complicated by GHC's interface to doing so.
  -
  - Note that the encoding stops at any NUL in the input. FilePaths
- - do not normally contain embedded NUL, but Haskell Strings may.
+ - cannot contain embedded NUL, but Haskell Strings may.
  -}
 {-# NOINLINE encodeW8 #-}
 encodeW8 :: [Word8] -> FilePath
@@ -135,8 +202,6 @@ encodeW8 w8 = unsafePerformIO $ do
 	enc <- Encoding.getFileSystemEncoding
 	GHC.withCString Encoding.char8 (w82s w8) $ GHC.peekCString enc
 
-{- Useful when you want the actual number of bytes that will be used to
- - represent the FilePath on disk. -}
 decodeW8 :: FilePath -> [Word8]
 decodeW8 = s2w8 . _encodeFilePath
 
diff --git a/Utility/Format.hs b/Utility/Format.hs
index 3670cd7..a2470fa 100644
--- a/Utility/Format.hs
+++ b/Utility/Format.hs
@@ -15,7 +15,7 @@ module Utility.Format (
 ) where
 
 import Text.Printf (printf)
-import Data.Char (isAlphaNum, isOctDigit, isHexDigit, isSpace, chr, ord)
+import Data.Char (isAlphaNum, isOctDigit, isHexDigit, isSpace, chr, ord, isAscii)
 import Data.Maybe (fromMaybe)
 import Data.Word (Word8)
 import Data.List (isPrefixOf)
@@ -176,12 +176,12 @@ encode_c' p = concatMap echar
 {- For quickcheck. 
  -
  - Encoding and then decoding roundtrips only when
- - the string does not contain high unicode, because eg, 
- - both "\12345" and "\227\128\185" are encoded to "\343\200\271".
+ - the string is ascii because eg, both "\12345" and
+ - "\227\128\185" are encoded to "\343\200\271".
  -
- - This property papers over the problem, by only testing chars < 256.
+ - This property papers over the problem, by only testing ascii.
  -}
 prop_encode_c_decode_c_roundtrip :: String -> Bool
 prop_encode_c_decode_c_roundtrip s = s' == decode_c (encode_c s')
   where
-	s' = filter (\c -> ord c < 256) s
+	s' = filter isAscii s
diff --git a/Utility/HumanNumber.hs b/Utility/HumanNumber.hs
index c3fede9..6143cef 100644
--- a/Utility/HumanNumber.hs
+++ b/Utility/HumanNumber.hs
@@ -5,7 +5,7 @@
  - License: BSD-2-clause
  -}
 
-module Utility.HumanNumber where
+module Utility.HumanNumber (showImprecise) where
 
 {- Displays a fractional value as a string with a limited number
  - of decimal digits. -}
diff --git a/Utility/HumanTime.hs b/Utility/HumanTime.hs
index fe7cf22..01fbeac 100644
--- a/Utility/HumanTime.hs
+++ b/Utility/HumanTime.hs
@@ -60,15 +60,17 @@ parseDuration = maybe parsefail (return . Duration) . go 0
 fromDuration :: Duration -> String
 fromDuration Duration { durationSeconds = d }
 	| d == 0 = "0s"
-	| otherwise = concatMap showunit $ go [] units d
+	| otherwise = concatMap showunit $ take 2 $ go [] units d
   where
-	showunit (u, n)
-		| n > 0 = show n ++ [u]
-		| otherwise = ""
+	showunit (u, n) = show n ++ [u]
 	go c [] _ = reverse c
 	go c ((u, n):us) v =
 		let (q,r) = v `quotRem` n
-		in go ((u, q):c) us r
+		in if q > 0
+			then go ((u, q):c) us r
+			else if null c
+				then go c us r
+				else reverse c
 
 units :: [(Char, Integer)]
 units = 
diff --git a/Utility/Metered.hs b/Utility/Metered.hs
index a5dda54..ec16e33 100644
--- a/Utility/Metered.hs
+++ b/Utility/Metered.hs
@@ -1,16 +1,48 @@
 {- Metered IO and actions
  -
- - Copyright 2012-2016 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2018 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
 
 {-# LANGUAGE TypeSynonymInstances, BangPatterns #-}
 
-module Utility.Metered where
+module Utility.Metered (
+	MeterUpdate,
+	nullMeterUpdate,
+	combineMeterUpdate,
+	BytesProcessed(..),
+	toBytesProcessed,
+	fromBytesProcessed,
+	addBytesProcessed,
+	zeroBytesProcessed,
+	withMeteredFile,
+	meteredWrite,
+	meteredWrite',
+	meteredWriteFile,
+	offsetMeterUpdate,
+	hGetContentsMetered,
+	hGetMetered,
+	defaultChunkSize,
+	watchFileSize,
+	OutputHandler(..),
+	ProgressParser,
+	commandMeter,
+	commandMeter',
+	demeterCommand,
+	demeterCommandEnv,
+	avoidProgress,
+	rateLimitMeterUpdate,
+	Meter,
+	mkMeter,
+	setMeterTotalSize,
+	updateMeter,
+	displayMeterHandle,
+	clearMeterHandle,
+	bandwidthMeter,
+) where
 
 import Common
-import Utility.FileSystemEncoding
 import Utility.Percentage
 import Utility.DataUnits
 import Utility.HumanTime
@@ -81,11 +113,6 @@ withMeteredFile :: FilePath -> MeterUpdate -> (L.ByteString -> IO a) -> IO a
 withMeteredFile f meterupdate a = withBinaryFile f ReadMode $ \h ->
 	hGetContentsMetered h meterupdate >>= a
 
-{- Sends the content of a file to a Handle, updating the meter as it's
- - written. -}
-streamMeteredFile :: FilePath -> MeterUpdate -> Handle -> IO ()
-streamMeteredFile f meterupdate h = withMeteredFile f meterupdate $ L.hPut h
-
 {- Writes a ByteString to a Handle, updating a meter as it's written. -}
 meteredWrite :: MeterUpdate -> Handle -> L.ByteString -> IO ()
 meteredWrite meterupdate h = void . meteredWrite' meterupdate h
@@ -211,7 +238,14 @@ type ProgressParser = String -> (Maybe BytesProcessed, String)
  - to update a meter.
  -}
 commandMeter :: ProgressParser -> OutputHandler -> MeterUpdate -> FilePath -> [CommandParam] -> IO Bool
-commandMeter progressparser oh meterupdate cmd params = 
+commandMeter progressparser oh meterupdate cmd params = do
+	ret <- commandMeter' progressparser oh meterupdate cmd params
+	return $ case ret of
+		Just ExitSuccess -> True
+		_ -> False
+
+commandMeter' :: ProgressParser -> OutputHandler -> MeterUpdate -> FilePath -> [CommandParam] -> IO (Maybe ExitCode)
+commandMeter' progressparser oh meterupdate cmd params = 
 	outputFilter cmd params Nothing
 		(feedprogress zeroBytesProcessed [])
 		handlestderr
@@ -224,7 +258,7 @@ commandMeter progressparser oh meterupdate cmd params =
 				unless (quietMode oh) $ do
 					S.hPut stdout b
 					hFlush stdout
-				let s = encodeW8 (S.unpack b)
+				let s = decodeBS b
 				let (mbytes, buf') = progressparser (buf++s)
 				case mbytes of
 					Nothing -> feedprogress prev buf' h
@@ -246,9 +280,13 @@ demeterCommand :: OutputHandler -> FilePath -> [CommandParam] -> IO Bool
 demeterCommand oh cmd params = demeterCommandEnv oh cmd params Nothing
 
 demeterCommandEnv :: OutputHandler -> FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
-demeterCommandEnv oh cmd params environ = outputFilter cmd params environ
-	(\outh -> avoidProgress True outh stdouthandler)
-	(\errh -> avoidProgress True errh $ stderrHandler oh)
+demeterCommandEnv oh cmd params environ = do
+	ret <- outputFilter cmd params environ
+		(\outh -> avoidProgress True outh stdouthandler)
+		(\errh -> avoidProgress True errh $ stderrHandler oh)
+	return $ case ret of
+		Just ExitSuccess -> True
+		_ -> False
   where
 	stdouthandler l = 
 		unless (quietMode oh) $
@@ -271,16 +309,15 @@ outputFilter
 	-> Maybe [(String, String)]
 	-> (Handle -> IO ())
 	-> (Handle -> IO ())
-	-> IO Bool
-outputFilter cmd params environ outfilter errfilter = catchBoolIO $ do
+	-> IO (Maybe ExitCode)
+outputFilter cmd params environ outfilter errfilter = catchMaybeIO $ do
 	(_, Just outh, Just errh, pid) <- createProcess p
 		{ std_out = CreatePipe
 		, std_err = CreatePipe
 		}
 	void $ async $ tryIO (outfilter outh) >> hClose outh
 	void $ async $ tryIO (errfilter errh) >> hClose errh
-	ret <- checkSuccessProcess pid
-	return ret
+	waitForProcess pid
   where
 	p = (proc cmd (toCommand params))
 		{ env = environ }
@@ -288,14 +325,14 @@ outputFilter cmd params environ outfilter errfilter = catchBoolIO $ do
 -- | Limit a meter to only update once per unit of time.
 --
 -- It's nice to display the final update to 100%, even if it comes soon
--- after a previous update. To make that happen, a total size has to be
--- provided.
-rateLimitMeterUpdate :: NominalDiffTime -> Maybe Integer -> MeterUpdate -> IO MeterUpdate
-rateLimitMeterUpdate delta totalsize meterupdate = do
+-- after a previous update. To make that happen, the Meter has to know
+-- its total size.
+rateLimitMeterUpdate :: NominalDiffTime -> Meter -> MeterUpdate -> IO MeterUpdate
+rateLimitMeterUpdate delta (Meter totalsizev _ _ _) meterupdate = do
 	lastupdate <- newMVar (toEnum 0 :: POSIXTime)
 	return $ mu lastupdate
   where
-	mu lastupdate n@(BytesProcessed i) = case totalsize of
+	mu lastupdate n@(BytesProcessed i) = readMVar totalsizev >>= \case
 		Just t | i >= t -> meterupdate n
 		_ -> do
 			now <- getPOSIXTime
@@ -306,35 +343,38 @@ rateLimitMeterUpdate delta totalsize meterupdate = do
 					meterupdate n
 				else putMVar lastupdate prev
 
-data Meter = Meter (Maybe Integer) (MVar MeterState) (MVar String) RenderMeter DisplayMeter
+data Meter = Meter (MVar (Maybe Integer)) (MVar MeterState) (MVar String) DisplayMeter
 
 type MeterState = (BytesProcessed, POSIXTime)
 
-type DisplayMeter = MVar String -> String -> IO ()
+type DisplayMeter = MVar String -> Maybe Integer -> (BytesProcessed, POSIXTime) -> (BytesProcessed, POSIXTime) -> IO ()
 
 type RenderMeter = Maybe Integer -> (BytesProcessed, POSIXTime) -> (BytesProcessed, POSIXTime) -> String
 
 -- | Make a meter. Pass the total size, if it's known.
-mkMeter :: Maybe Integer -> RenderMeter -> DisplayMeter -> IO Meter
-mkMeter totalsize rendermeter displaymeter = Meter
-	<$> pure totalsize
+mkMeter :: Maybe Integer -> DisplayMeter -> IO Meter
+mkMeter totalsize displaymeter = Meter
+	<$> newMVar totalsize
 	<*> ((\t -> newMVar (zeroBytesProcessed, t)) =<< getPOSIXTime)
 	<*> newMVar ""
-	<*> pure rendermeter
 	<*> pure displaymeter
 
+setMeterTotalSize :: Meter -> Integer -> IO ()
+setMeterTotalSize (Meter totalsizev _ _ _) = void . swapMVar totalsizev . Just
+
 -- | Updates the meter, displaying it if necessary.
-updateMeter :: Meter -> BytesProcessed -> IO ()
-updateMeter (Meter totalsize sv bv rendermeter displaymeter) new = do
+updateMeter :: Meter -> MeterUpdate
+updateMeter (Meter totalsizev sv bv displaymeter) new = do
 	now <- getPOSIXTime
 	(old, before) <- swapMVar sv (new, now)
-	when (old /= new) $
-		displaymeter bv $ 
-			rendermeter totalsize (old, before) (new, now)
+	when (old /= new) $ do
+		totalsize <- readMVar totalsizev
+		displaymeter bv totalsize (old, before) (new, now)
 
 -- | Display meter to a Handle.
-displayMeterHandle :: Handle -> DisplayMeter
-displayMeterHandle h v s = do
+displayMeterHandle :: Handle -> RenderMeter -> DisplayMeter
+displayMeterHandle h rendermeter v msize old new = do
+	let s = rendermeter msize old new
 	olds <- swapMVar v s
 	-- Avoid writing when the rendered meter has not changed.
 	when (olds /= s) $ do
@@ -344,29 +384,32 @@ displayMeterHandle h v s = do
 
 -- | Clear meter displayed by displayMeterHandle.
 clearMeterHandle :: Meter -> Handle -> IO ()
-clearMeterHandle (Meter _ _ v _ _) h = do
+clearMeterHandle (Meter _ _ v _) h = do
 	olds <- readMVar v
 	hPutStr h $ '\r' : replicate (length olds) ' ' ++ "\r"
 	hFlush h
 
 -- | Display meter in the form:
---   10%         300 KiB/s 16m40s
+--   10%  1.3MiB  300 KiB/s 16m40s
 -- or when total size is not known:
---   1.3 MiB     300 KiB/s
+--   1.3 MiB      300 KiB/s
 bandwidthMeter :: RenderMeter
 bandwidthMeter mtotalsize (BytesProcessed old, before) (BytesProcessed new, now) =
 	unwords $ catMaybes
-		[ Just percentoramount
-		-- Pad enough for max width: "xxxx.xx KiB  xxxx KiB/s"
-		, Just $ replicate (23 - length percentoramount - length rate) ' '
+		[ Just percentamount
+		-- Pad enough for max width: "100%  xxxx.xx KiB  xxxx KiB/s"
+		, Just $ replicate (29 - length percentamount - length rate) ' '
 		, Just rate
 		, estimatedcompletion
 		]
   where
-	percentoramount = case mtotalsize of
-		Just totalsize -> showPercentage 0 $
-			percentage totalsize (min new totalsize)
-		Nothing -> roughSize' memoryUnits True 2 new
+	amount = roughSize' memoryUnits True 2 new
+	percentamount = case mtotalsize of
+		Just totalsize ->
+			let p = showPercentage 0 $
+				percentage totalsize (min new totalsize)
+			in p ++ replicate (6 - length p) ' ' ++ amount
+		Nothing -> amount
 	rate = roughSize' memoryUnits True 0 bytespersecond ++ "/s"
 	bytespersecond
 		| duration == 0 = fromIntegral transferred
@@ -377,5 +420,5 @@ bandwidthMeter mtotalsize (BytesProcessed old, before) (BytesProcessed new, now)
 		Just totalsize
 			| bytespersecond > 0 -> 
 				Just $ fromDuration $ Duration $
-					totalsize `div` bytespersecond
+					(totalsize - new) `div` bytespersecond
 		_ -> Nothing
diff --git a/Utility/Misc.hs b/Utility/Misc.hs
index 2ae9928..2f1766e 100644
--- a/Utility/Misc.hs
+++ b/Utility/Misc.hs
@@ -5,10 +5,22 @@
  - License: BSD-2-clause
  -}
 
-{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.Misc where
+module Utility.Misc (
+	hGetContentsStrict,
+	readFileStrict,
+	separate,
+	firstLine,
+	firstLine',
+	segment,
+	segmentDelim,
+	massReplace,
+	hGetSomeString,
+	exitBool,
+
+	prop_segment_regressionTest,
+) where
 
 import System.IO
 import Control.Monad
@@ -16,11 +28,8 @@ import Foreign
 import Data.Char
 import Data.List
 import System.Exit
-#ifndef mingw32_HOST_OS
-import System.Posix.Process (getAnyProcessStatus)
-import Utility.Exception
-#endif
 import Control.Applicative
+import qualified Data.ByteString as S
 import Prelude
 
 {- A version of hgetContents that is not lazy. Ensures file is 
@@ -49,6 +58,11 @@ separate c l = unbreak $ break c l
 firstLine :: String -> String
 firstLine = takeWhile (/= '\n')
 
+firstLine' :: S.ByteString -> S.ByteString
+firstLine' = S.takeWhile (/= nl)
+  where
+	nl = fromIntegral (ord '\n')
+
 {- Splits a list into segments that are delimited by items matching
  - a predicate. (The delimiters are not included in the segments.)
  - Segments may be empty. -}
@@ -112,22 +126,6 @@ hGetSomeString h sz = do
 	peekbytes :: Int -> Ptr Word8 -> IO [Word8]
 	peekbytes len buf = mapM (peekElemOff buf) [0..pred len]
 
-{- Reaps any zombie processes that may be hanging around.
- -
- - Warning: Not thread safe. Anything that was expecting to wait
- - on a process and get back an exit status is going to be confused
- - if this reap gets there first. -}
-reapZombies :: IO ()
-#ifndef mingw32_HOST_OS
-reapZombies =
-	-- throws an exception when there are no child processes
-	catchDefaultIO Nothing (getAnyProcessStatus False True)
-		>>= maybe (return ()) (const reapZombies)
-
-#else
-reapZombies = return ()
-#endif
-
 exitBool :: Bool -> IO a
 exitBool False = exitFailure
 exitBool True = exitSuccess
diff --git a/Utility/Monad.hs b/Utility/Monad.hs
index ac75104..abe06f3 100644
--- a/Utility/Monad.hs
+++ b/Utility/Monad.hs
@@ -7,7 +7,19 @@
 
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.Monad where
+module Utility.Monad (
+	firstM,
+	getM,
+	anyM,
+	allM,
+	untilTrue,
+	ifM,
+	(<||>),
+	(<&&>),
+	observe,
+	after,
+	noop,
+) where
 
 import Data.Maybe
 import Control.Monad
diff --git a/Utility/PartialPrelude.hs b/Utility/PartialPrelude.hs
index 47e9831..90c67ff 100644
--- a/Utility/PartialPrelude.hs
+++ b/Utility/PartialPrelude.hs
@@ -7,7 +7,18 @@
 
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.PartialPrelude where
+module Utility.PartialPrelude (
+	Utility.PartialPrelude.read,
+	Utility.PartialPrelude.head,
+	Utility.PartialPrelude.tail,
+	Utility.PartialPrelude.init,
+	Utility.PartialPrelude.last,
+	Utility.PartialPrelude.readish,
+	Utility.PartialPrelude.headMaybe,
+	Utility.PartialPrelude.lastMaybe,
+	Utility.PartialPrelude.beginning,
+	Utility.PartialPrelude.end,
+) where
 
 import qualified Data.Maybe
 
@@ -38,11 +49,9 @@ last = Prelude.last
 
 {- Attempts to read a value from a String.
  -
- - Ignores leading/trailing whitespace, and throws away any trailing
- - text after the part that can be read.
- -
- - readMaybe is available in Text.Read in new versions of GHC,
- - but that one requires the entire string to be consumed.
+ - Unlike Text.Read.readMaybe, this ignores some trailing text
+ - after the part that can be read. However, if the trailing text looks
+ - like another readable value, it fails.
  -}
 readish :: Read a => String -> Maybe a
 readish s = case reads s of
diff --git a/Utility/Path.hs b/Utility/Path.hs
index dc91ce5..ecc752c 100644
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -5,10 +5,32 @@
  - License: BSD-2-clause
  -}
 
-{-# LANGUAGE PackageImports, CPP #-}
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.Path where
+module Utility.Path (
+	simplifyPath,
+	absPathFrom,
+	parentDir,
+	upFrom,
+	dirContains,
+	absPath,
+	relPathCwdToFile,
+	relPathDirToFile,
+	relPathDirToFileAbs,
+	segmentPaths,
+	runSegmentPaths,
+	relHome,
+	inPath,
+	searchPath,
+	dotfile,
+	sanitizeFilePath,
+	splitShortExtensions,
+
+	prop_upFrom_basics,
+	prop_relPathDirToFile_basics,
+	prop_relPathDirToFile_regressionTest,
+) where
 
 import System.FilePath
 import Data.List
@@ -17,17 +39,11 @@ import Data.Char
 import Control.Applicative
 import Prelude
 
-#ifdef mingw32_HOST_OS
-import qualified System.FilePath.Posix as Posix
-#else
-import System.Posix.Files
-import Utility.Exception
-#endif
-
 import Utility.Monad
 import Utility.UserInfo
 import Utility.Directory
 import Utility.Split
+import Utility.FileSystemEncoding
 
 {- Simplifies a path, removing any "." component, collapsing "dir/..", 
  - and removing the trailing path separator.
@@ -97,7 +113,10 @@ prop_upFrom_basics dir
  - are all equivilant.
  -}
 dirContains :: FilePath -> FilePath -> Bool
-dirContains a b = a == b || a' == b' || (addTrailingPathSeparator a') `isPrefixOf` b'
+dirContains a b = a == b
+	|| a' == b'
+	|| (addTrailingPathSeparator a') `isPrefixOf` b'
+	|| a' == "." && normalise ("." </> b') == b'
   where
 	a' = norm a
 	b' = norm b
@@ -185,20 +204,21 @@ prop_relPathDirToFile_regressionTest = same_dir_shortcurcuits_at_difference
  - we stop preserving ordering at that point. Presumably a user passing
  - that many paths in doesn't care too much about order of the later ones.
  -}
-segmentPaths :: [FilePath] -> [FilePath] -> [[FilePath]]
+segmentPaths :: [RawFilePath] -> [RawFilePath] -> [[RawFilePath]]
 segmentPaths [] new = [new]
 segmentPaths [_] new = [new] -- optimisation
 segmentPaths (l:ls) new = found : segmentPaths ls rest
   where
 	(found, rest) = if length ls < 100
-		then partition (l `dirContains`) new
-		else break (\p -> not (l `dirContains` p)) new
+		then partition inl new
+		else break (not . inl) new
+	inl f = fromRawFilePath l `dirContains` fromRawFilePath f
 
 {- This assumes that it's cheaper to call segmentPaths on the result,
  - than it would be to run the action separately with each path. In
  - the case of git file list commands, that assumption tends to hold.
  -}
-runSegmentPaths :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
+runSegmentPaths :: ([RawFilePath] -> IO [RawFilePath]) -> [RawFilePath] -> IO [[RawFilePath]]
 runSegmentPaths a paths = segmentPaths paths <$> a paths
 
 {- Converts paths in the home directory to use ~/ -}
@@ -247,50 +267,6 @@ dotfile file
   where
 	f = takeFileName file
 
-{- Converts a DOS style path to a msys2 style path. Only on Windows.
- - Any trailing '\' is preserved as a trailing '/' 
- - 
- - Taken from: http://sourceforge.net/p/msys2/wiki/MSYS2%20introduction/i
- -
- - The virtual filesystem contains:
- -  /c, /d, ...	mount points for Windows drives
- -}
-toMSYS2Path :: FilePath -> FilePath
-#ifndef mingw32_HOST_OS
-toMSYS2Path = id
-#else
-toMSYS2Path p
-	| null drive = recombine parts
-	| otherwise = recombine $ "/" : driveletter drive : parts
-  where
-	(drive, p') = splitDrive p
-	parts = splitDirectories p'
-	driveletter = map toLower . takeWhile (/= ':')
-	recombine = fixtrailing . Posix.joinPath
-	fixtrailing s
-		| hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s
-		| otherwise = s
-#endif
-
-{- Maximum size to use for a file in a specified directory.
- -
- - Many systems have a 255 byte limit to the name of a file, 
- - so that's taken as the max if the system has a larger limit, or has no
- - limit.
- -}
-fileNameLengthLimit :: FilePath -> IO Int
-#ifdef mingw32_HOST_OS
-fileNameLengthLimit _ = return 255
-#else
-fileNameLengthLimit dir = do
-	-- getPathVar can fail due to statfs(2) overflow
-	l <- catchDefaultIO 0 $
-		fromIntegral <$> getPathVar dir FileNameLimit
-	if l <= 0
-		then return 255
-		else return $ minimum [l, 255]
-#endif
-
 {- Given a string that we'd like to use as the basis for FilePath, but that
  - was provided by a third party and is not to be trusted, returns the closest
  - sane FilePath.
diff --git a/Utility/PosixFiles.hs b/Utility/PosixFiles.hs
deleted file mode 100644
index 37253da..0000000
--- a/Utility/PosixFiles.hs
+++ /dev/null
@@ -1,42 +0,0 @@
-{- POSIX files (and compatablity wrappers).
- -
- - This is like System.PosixCompat.Files, but with a few fixes.
- -
- - Copyright 2014 Joey Hess <id@joeyh.name>
- -
- - License: BSD-2-clause
- -}
-
-{-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -fno-warn-tabs #-}
-
-module Utility.PosixFiles (
-	module X,
-	rename
-) where
-
-import System.PosixCompat.Files as X hiding (rename)
-
-#ifndef mingw32_HOST_OS
-import System.Posix.Files (rename)
-#else
-import qualified System.Win32.File as Win32
-import qualified System.Win32.HardLink as Win32
-#endif
-
-{- System.PosixCompat.Files.rename on Windows calls renameFile,
- - so cannot rename directories. 
- -
- - Instead, use Win32 moveFile, which can. It needs to be told to overwrite
- - any existing file. -}
-#ifdef mingw32_HOST_OS
-rename :: FilePath -> FilePath -> IO ()
-rename src dest = Win32.moveFileEx src dest Win32.mOVEFILE_REPLACE_EXISTING
-#endif
-
-{- System.PosixCompat.Files.createLink throws an error, but windows
- - does support hard links. -}
-#ifdef mingw32_HOST_OS
-createLink :: FilePath -> FilePath -> IO ()
-createLink = Win32.createHardLink
-#endif
diff --git a/Utility/Process.hs b/Utility/Process.hs
index 6d981cb..af3a5f4 100644
--- a/Utility/Process.hs
+++ b/Utility/Process.hs
@@ -24,11 +24,10 @@ module Utility.Process (
 	createProcessSuccess,
 	createProcessChecked,
 	createBackgroundProcess,
-	processTranscript,
-	processTranscript',
 	withHandle,
 	withIOHandles,
 	withOEHandles,
+	withNullHandle,
 	withQuietOutput,
 	feedWithQuietOutput,
 	createProcess,
@@ -54,13 +53,6 @@ import System.Log.Logger
 import Control.Concurrent
 import qualified Control.Exception as E
 import Control.Monad
-#ifndef mingw32_HOST_OS
-import qualified System.Posix.IO
-#else
-import Control.Applicative
-#endif
-import Data.Maybe
-import Prelude
 
 type CreateProcessRunner = forall a. CreateProcess -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO a) -> IO a
 
@@ -170,68 +162,6 @@ createProcessChecked checker p a = do
 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.
-processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
-processTranscript cmd opts = processTranscript' (proc cmd opts)
-
-processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool)
-processTranscript' cp 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 $ cp
-		{ std_in = if isJust input then CreatePipe else Inherit
-		, std_out = UseHandle writeh
-		, std_err = UseHandle writeh
-		}
-	hClose writeh
-
-	get <- mkreader readh
-	writeinput input p
-	transcript <- get
-
-	ok <- checkSuccessProcess pid
-	return (transcript, ok)
-#else
-{- This implementation for Windows puts stderr after stdout. -}
-	p@(_, _, _, pid) <- createProcess $ cp
-		{ std_in = if isJust input then CreatePipe else Inherit
-		, std_out = CreatePipe
-		, std_err = CreatePipe
-		}
-
-	getout <- mkreader (stdoutHandle p)
-	geterr <- mkreader (stderrHandle p)
-	writeinput input p
-	transcript <- (++) <$> getout <*> geterr
-
-	ok <- checkSuccessProcess pid
-	return (transcript, ok)
-#endif
-  where
-	mkreader h = do
-		s <- hGetContents h
-		v <- newEmptyMVar
-		void $ forkIO $ do
-			void $ E.evaluate (length s)
-			putMVar v ()
-		return $ do
-			takeMVar v
-			return s
-
-	writeinput (Just s) p = do
-		let inh = stdinHandle p
-		unless (null s) $ do
-			hPutStr inh s
-			hFlush inh
-		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.
@@ -248,13 +178,10 @@ withHandle h creator p a = creator p' $ a . select
 		, std_out = Inherit
 		, std_err = Inherit
 		}
-	(select, p')
-		| h == StdinHandle  =
-			(stdinHandle, base { std_in = CreatePipe })
-		| h == StdoutHandle =
-			(stdoutHandle, base { std_out = CreatePipe })
-		| h == StderrHandle =
-			(stderrHandle, base { std_err = CreatePipe })
+	(select, p') = case h of
+		StdinHandle -> (stdinHandle, base { std_in = CreatePipe })
+		StdoutHandle -> (stdoutHandle, base { std_out = CreatePipe })
+		StderrHandle -> (stderrHandle, base { std_err = CreatePipe })
 
 -- | Like withHandle, but passes (stdin, stdout) handles to the action.
 withIOHandles
@@ -284,13 +211,16 @@ withOEHandles creator p a = creator p' $ a . oeHandles
 		, std_err = CreatePipe
 		}
 
+withNullHandle :: (Handle -> IO a) -> IO a
+withNullHandle = withFile devNull WriteMode
+
 -- | Forces the CreateProcessRunner to run quietly;
 -- both stdout and stderr are discarded.
 withQuietOutput
 	:: CreateProcessRunner
 	-> CreateProcess
 	-> IO ()
-withQuietOutput creator p = withFile devNull WriteMode $ \nullh -> do
+withQuietOutput creator p = withNullHandle $ \nullh -> do
 	let p' = p
 		{ std_out = UseHandle nullh
 		, std_err = UseHandle nullh
@@ -316,7 +246,8 @@ devNull :: FilePath
 #ifndef mingw32_HOST_OS
 devNull = "/dev/null"
 #else
-devNull = "NUL"
+-- Use device namespace to prevent GHC from rewriting path
+devNull = "\\\\.\\NUL"
 #endif
 
 -- | Extract a desired handle from createProcess's tuple.
diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs
index e89d103..b0a39f3 100644
--- a/Utility/QuickCheck.hs
+++ b/Utility/QuickCheck.hs
@@ -6,7 +6,7 @@
  -}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE TypeSynonymInstances, CPP #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 module Utility.QuickCheck
 	( module X
@@ -15,29 +15,24 @@ module Utility.QuickCheck
 
 import Test.QuickCheck as X
 import Data.Time.Clock.POSIX
+import Data.Ratio
 import System.Posix.Types
-#if ! MIN_VERSION_QuickCheck(2,8,2)
-import qualified Data.Map as M
-import qualified Data.Set as S
-#endif
-import Control.Applicative
+import Data.List.NonEmpty (NonEmpty(..))
 import Prelude
 
-#if ! MIN_VERSION_QuickCheck(2,8,2)
-instance (Arbitrary k, Arbitrary v, Ord k) => Arbitrary (M.Map k v) where
-	arbitrary = M.fromList <$> arbitrary
-
-instance (Arbitrary v, Ord v) => Arbitrary (S.Set v) where
-	arbitrary = S.fromList <$> arbitrary
-#endif
-
-{- Times before the epoch are excluded. -}
+{- Times before the epoch are excluded. Half with decimal and half without. -}
 instance Arbitrary POSIXTime where
-	arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral
+	arbitrary = do
+		n <- nonNegative arbitrarySizedBoundedIntegral :: Gen Int
+		d <- nonNegative arbitrarySizedIntegral
+		withd <- arbitrary
+		return $ if withd
+			then fromIntegral n + fromRational (1 % max d 1)
+			else fromIntegral n
 
 {- Pids are never negative, or 0. -}
 instance Arbitrary ProcessID where
-	arbitrary = arbitrarySizedBoundedIntegral `suchThat` (> 0)
+	arbitrary = positive arbitrarySizedBoundedIntegral
 
 {- Inodes are never negative. -}
 instance Arbitrary FileID where
@@ -47,6 +42,9 @@ instance Arbitrary FileID where
 instance Arbitrary FileOffset where
 	arbitrary = nonNegative arbitrarySizedIntegral
 
+instance Arbitrary l => Arbitrary (NonEmpty l) where
+	arbitrary = (:|) <$> arbitrary <*> arbitrary
+
 nonNegative :: (Num a, Ord a) => Gen a -> Gen a
 nonNegative g = g `suchThat` (>= 0)
 
diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs
index f190b40..c6881b7 100644
--- a/Utility/Rsync.hs
+++ b/Utility/Rsync.hs
@@ -7,12 +7,26 @@
 
 {-# LANGUAGE CPP #-}
 
-module Utility.Rsync where
+module Utility.Rsync (
+	rsyncShell,
+	rsyncServerSend,
+	rsyncServerReceive,
+	rsyncUseDestinationPermissions,
+	rsync,
+	rsyncUrlIsShell,
+	rsyncUrlIsPath,
+	rsyncProgress,
+	filterRsyncSafeOptions,
+) where
 
 import Common
 import Utility.Metered
 import Utility.Tuple
 
+#ifdef mingw32_HOST_OS
+import qualified System.FilePath.Posix as Posix
+#endif
+
 import Data.Char
 import System.Console.GetOpt
 
@@ -99,7 +113,16 @@ rsyncUrlIsPath s
  - The params must enable rsync's --progress mode for this to work.
  -}
 rsyncProgress :: OutputHandler -> MeterUpdate -> [CommandParam] -> IO Bool
-rsyncProgress oh meter = commandMeter parseRsyncProgress oh meter "rsync" . rsyncParamsFixup
+rsyncProgress oh meter ps =
+	commandMeter' parseRsyncProgress oh meter "rsync" (rsyncParamsFixup ps) >>= \case
+		Just ExitSuccess -> return True
+		Just (ExitFailure exitcode) -> do
+			when (exitcode /= 1) $
+				hPutStrLn stderr $ "rsync exited " ++ show exitcode
+			return False
+		Nothing -> do
+			hPutStrLn stderr $ "unable to run rsync"
+			return False
 
 {- Strategy: Look for chunks prefixed with \r (rsync writes a \r before
  - the first progress output, and each thereafter). The first number
@@ -139,3 +162,27 @@ filterRsyncSafeOptions = fst3 . getOpt Permute
 	[ Option [] ["bwlimit"] (reqArgLong "bwlimit") "" ]
   where
 	reqArgLong x = ReqArg (\v -> "--" ++ x ++ "=" ++ v) ""
+
+{- Converts a DOS style path to a msys2 style path. Only on Windows.
+ - Any trailing '\' is preserved as a trailing '/' 
+ - 
+ - Taken from: http://sourceforge.net/p/msys2/wiki/MSYS2%20introduction/i
+ -
+ - The virtual filesystem contains:
+ -  /c, /d, ...	mount points for Windows drives
+ -}
+#ifdef mingw32_HOST_OS
+toMSYS2Path :: FilePath -> FilePath
+toMSYS2Path p
+	| null drive = recombine parts
+	| otherwise = recombine $ "/" : driveletter drive : parts
+  where
+	(drive, p') = splitDrive p
+	parts = splitDirectories p'
+	driveletter = map toLower . takeWhile (/= ':')
+	recombine = fixtrailing . Posix.joinPath
+	fixtrailing s
+		| hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s
+		| otherwise = s
+#endif
+
diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs
index eb34d3d..19d5f20 100644
--- a/Utility/SafeCommand.hs
+++ b/Utility/SafeCommand.hs
@@ -7,7 +7,23 @@
 
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.SafeCommand where
+module Utility.SafeCommand (
+	CommandParam(..),
+	toCommand,
+	boolSystem,
+	boolSystem',
+	boolSystemEnv,
+	safeSystem,
+	safeSystem',
+	safeSystemEnv,
+	shellWrap,
+	shellEscape,
+	shellUnEscape,
+	segmentXargsOrdered,
+	segmentXargsUnordered,
+	prop_isomorphic_shellEscape,
+	prop_isomorphic_shellEscape_multiword,
+) where
 
 import System.Exit
 import Utility.Process
@@ -27,19 +43,21 @@ data CommandParam
 -- | Used to pass a list of CommandParams to a function that runs
 -- a command and expects Strings. -}
 toCommand :: [CommandParam] -> [String]
-toCommand = map unwrap
+toCommand = map toCommand'
+
+toCommand' :: CommandParam -> String
+toCommand' (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.
+toCommand' (File s@(h:_))
+	| isAlphaNum h || h `elem` pathseps = s
+	| otherwise = "./" ++ s
   where
-	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
 	-- '/' is explicitly included because it's an alternative
 	-- path separator on Windows.
 	pathseps = pathSeparator:"./"
+toCommand' (File s) = s
 
 -- | Run a system command, and returns True or False if it succeeded or failed.
 --
diff --git a/Utility/Split.hs b/Utility/Split.hs
index decfe7d..028218e 100644
--- a/Utility/Split.hs
+++ b/Utility/Split.hs
@@ -7,7 +7,12 @@
 
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.Split where
+module Utility.Split (
+	split,
+	splitc,
+	replace,
+	dropFromEnd,
+) where
 
 import Data.List (intercalate)
 import Data.List.Split (splitOn)
@@ -28,3 +33,7 @@ splitc c s = case break (== c) s of
 -- | same as Data.List.Utils.replace
 replace :: Eq a => [a] -> [a] -> [a] -> [a] 
 replace old new = intercalate new . split old
+
+-- | Only traverses the list once while dropping the last n items.
+dropFromEnd :: Int -> [a] -> [a]
+dropFromEnd n l = zipWith const l (drop n l)
diff --git a/Utility/ThreadScheduler.hs b/Utility/ThreadScheduler.hs
index da05e99..ef69ead 100644
--- a/Utility/ThreadScheduler.hs
+++ b/Utility/ThreadScheduler.hs
@@ -8,7 +8,14 @@
 
 {-# LANGUAGE CPP #-}
 
-module Utility.ThreadScheduler where
+module Utility.ThreadScheduler (
+	Seconds(..),
+	Microseconds,
+	runEvery,
+	threadDelaySeconds,
+	waitForTermination,
+	oneSecond,
+) where
 
 import Control.Monad
 import Control.Concurrent
@@ -18,10 +25,8 @@ import System.Posix.IO
 #endif
 #ifndef mingw32_HOST_OS
 import System.Posix.Signals
-#ifndef __ANDROID__
 import System.Posix.Terminal
 #endif
-#endif
 
 newtype Seconds = Seconds { fromSeconds :: Int }
 	deriving (Eq, Ord, Show)
@@ -63,10 +68,8 @@ waitForTermination = do
 	let check sig = void $
 		installHandler sig (CatchOnce $ putMVar lock ()) Nothing
 	check softwareTermination
-#ifndef __ANDROID__
 	whenM (queryTerminal stdInput) $
 		check keyboardSignal
-#endif
 	takeMVar lock
 #endif
 
diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs
index 7255c14..6ee592b 100644
--- a/Utility/Tmp.hs
+++ b/Utility/Tmp.hs
@@ -1,4 +1,4 @@
-{- Temporary files and directories.
+{- Temporary files.
  -
  - Copyright 2010-2013 Joey Hess <id@joeyh.name>
  -
@@ -8,17 +8,19 @@
 {-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.Tmp where
+module Utility.Tmp (
+	Template,
+	viaTmp,
+	withTmpFile,
+	withTmpFileIn,
+	relatedTemplate,
+) where
 
 import System.IO
-import Control.Monad.IfElse
 import System.FilePath
 import System.Directory
 import Control.Monad.IO.Class
 import System.PosixCompat.Files
-#ifndef mingw32_HOST_OS
-import System.Posix.Temp (mkdtemp)
-#endif
 
 import Utility.Exception
 import Utility.FileSystemEncoding
@@ -32,7 +34,7 @@ viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> v -> m ()) -> FilePath -> v -
 viaTmp a file content = bracketIO setup cleanup use
   where
 	(dir, base) = splitFileName file
-	template = base ++ ".tmp"
+	template = relatedTemplate (base ++ ".tmp")
 	setup = do
 		createDirectoryIfMissing True dir
 		openTempFile dir template
@@ -62,51 +64,6 @@ withTmpFileIn tmpdir template a = bracket create remove use
 		catchBoolIO (removeFile name >> return True)
 	use (name, h) = a name h
 
-{- Runs an action with a tmp directory located within the system's tmp
- - directory (or within "." if there is none), then removes the tmp
- - directory and all its contents. -}
-withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a
-withTmpDir template a = do
-	topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
-#ifndef mingw32_HOST_OS
-	-- Use mkdtemp to create a temp directory securely in /tmp.
-	bracket
-		(liftIO $ mkdtemp $ topleveltmpdir </> template)
-		removeTmpDir
-		a
-#else
-	withTmpDirIn topleveltmpdir template a
-#endif
-
-{- Runs an action with a tmp directory located within a specified directory,
- - then removes the tmp directory and all its contents. -}
-withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a
-withTmpDirIn tmpdir template = bracketIO create removeTmpDir
-  where
-	create = do
-		createDirectoryIfMissing True tmpdir
-		makenewdir (tmpdir </> template) (0 :: Int)
-	makenewdir t n = do
-		let dir = t ++ "." ++ show n
-		catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do
-			createDirectory dir
-			return dir
-
-{- Deletes the entire contents of the the temporary directory, if it
- - exists. -}
-removeTmpDir :: MonadIO m => FilePath -> m ()
-removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do
-#if mingw32_HOST_OS
-	-- Windows will often refuse to delete a file
-	-- after a process has just written to it and exited.
-	-- Because it's crap, presumably. So, ignore failure
-	-- to delete the temp directory.
-	_ <- tryIO $ removeDirectoryRecursive tmpdir
-	return ()
-#else
-	removeDirectoryRecursive tmpdir
-#endif
-
 {- It's not safe to use a FilePath of an existing file as the template
  - for openTempFile, because if the FilePath is really long, the tmpfile
  - will be longer, and may exceed the maximum filename length.
diff --git a/Utility/Tmp/Dir.hs b/Utility/Tmp/Dir.hs
new file mode 100644
index 0000000..c68ef86
--- /dev/null
+++ b/Utility/Tmp/Dir.hs
@@ -0,0 +1,70 @@
+{- Temporary directories
+ -
+ - Copyright 2010-2013 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Tmp.Dir (
+	withTmpDir,
+	withTmpDirIn,
+) where
+
+import Control.Monad.IfElse
+import System.FilePath
+import System.Directory
+import Control.Monad.IO.Class
+#ifndef mingw32_HOST_OS
+import System.Posix.Temp (mkdtemp)
+#endif
+
+import Utility.Exception
+import Utility.Tmp (Template)
+
+{- Runs an action with a tmp directory located within the system's tmp
+ - directory (or within "." if there is none), then removes the tmp
+ - directory and all its contents. -}
+withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a
+withTmpDir template a = do
+	topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
+#ifndef mingw32_HOST_OS
+	-- Use mkdtemp to create a temp directory securely in /tmp.
+	bracket
+		(liftIO $ mkdtemp $ topleveltmpdir </> template)
+		removeTmpDir
+		a
+#else
+	withTmpDirIn topleveltmpdir template a
+#endif
+
+{- Runs an action with a tmp directory located within a specified directory,
+ - then removes the tmp directory and all its contents. -}
+withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a
+withTmpDirIn tmpdir template = bracketIO create removeTmpDir
+  where
+	create = do
+		createDirectoryIfMissing True tmpdir
+		makenewdir (tmpdir </> template) (0 :: Int)
+	makenewdir t n = do
+		let dir = t ++ "." ++ show n
+		catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do
+			createDirectory dir
+			return dir
+
+{- Deletes the entire contents of the the temporary directory, if it
+ - exists. -}
+removeTmpDir :: MonadIO m => FilePath -> m ()
+removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do
+#if mingw32_HOST_OS
+	-- Windows will often refuse to delete a file
+	-- after a process has just written to it and exited.
+	-- Because it's crap, presumably. So, ignore failure
+	-- to delete the temp directory.
+	_ <- tryIO $ removeDirectoryRecursive tmpdir
+	return ()
+#else
+	removeDirectoryRecursive tmpdir
+#endif
diff --git a/Utility/Tuple.hs b/Utility/Tuple.hs
index 25c6e8f..9638bcc 100644
--- a/Utility/Tuple.hs
+++ b/Utility/Tuple.hs
@@ -5,7 +5,11 @@
  - License: BSD-2-clause
  -}
 
-module Utility.Tuple where
+module Utility.Tuple (
+	fst3,
+	snd3,
+	thd3,
+) where
 
 fst3 :: (a,b,c) -> a
 fst3 (a,_,_) = a
diff --git a/Utility/UserInfo.hs b/Utility/UserInfo.hs
index d504fa5..17ce8db 100644
--- a/Utility/UserInfo.hs
+++ b/Utility/UserInfo.hs
@@ -14,7 +14,7 @@ module Utility.UserInfo (
 	myUserGecos,
 ) where
 
-import Utility.Env
+import Utility.Env.Basic
 import Utility.Exception
 #ifndef mingw32_HOST_OS
 import Utility.Data
@@ -47,8 +47,8 @@ myUserName = myVal env userName
 #endif
 
 myUserGecos :: IO (Maybe String)
--- userGecos crashes on Android and is not available on Windows.
-#if defined(__ANDROID__) || defined(mingw32_HOST_OS)
+-- userGecos is not available on Windows.
+#if defined(mingw32_HOST_OS)
 myUserGecos = return Nothing
 #else
 myUserGecos = eitherToMaybe <$> myVal [] userGecos
@@ -57,10 +57,13 @@ myUserGecos = eitherToMaybe <$> myVal [] userGecos
 myVal :: [String] -> (UserEntry -> String) -> IO (Either String String)
 myVal envvars extract = go envvars
   where
+	go [] = either (const $ envnotset) (Right . extract) <$> get
+	go (v:vs) = maybe (go vs) (return . Right) =<< getEnv v
 #ifndef mingw32_HOST_OS
-	go [] = Right . extract <$> (getUserEntryForID =<< getEffectiveUserID)
+	-- This may throw an exception if the system doesn't have a
+	-- passwd file etc; don't let it crash.
+	get = tryNonAsync $ getUserEntryForID =<< getEffectiveUserID
 #else
-	go [] = return $ either Left (Right . extract) $
-		Left ("environment not set: " ++ show envvars)
+	get = return envnotset
 #endif
-	go (v:vs) = maybe (go vs) (return . Right) =<< getEnv v
+	envnotset = Left ("environment not set: " ++ show envvars)
-- 
cgit v1.2.3