10 files changed, 117 insertions, 55 deletions
diff --git a/src/Utility/FileMode.hs b/src/Utility/FileMode.hs
index bb3780c6..d9a26944 100644
--- a/src/Utility/FileMode.hs
+++ b/src/Utility/FileMode.hs
@@ -1,6 +1,6 @@
 {- File mode utilities.
  -
- - Copyright 2010-2012 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2017 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -130,6 +130,21 @@ withUmask umask a = bracket setup cleanup go
 withUmask _ a = a
 #endif
 
+getUmask :: IO FileMode
+#ifndef mingw32_HOST_OS
+getUmask = bracket setup cleanup return
+  where
+	setup = setFileCreationMask nullFileMode
+	cleanup = setFileCreationMask
+#else
+getUmask = return nullFileMode
+#endif
+
+defaultFileMode :: IO FileMode
+defaultFileMode = do
+	umask <- getUmask
+	return $ intersectFileModes (complement umask) stdFileMode
+
 combineModes :: [FileMode] -> FileMode
 combineModes [] = 0
 combineModes [m] = m
@@ -162,7 +177,10 @@ writeFileProtected file content = writeFileProtected' file
 	(\h -> hPutStr h content)
 
 writeFileProtected' :: FilePath -> (Handle -> IO ()) -> IO ()
-writeFileProtected' file writer = withUmask 0o0077 $
+writeFileProtected' file writer = protectedOutput $
 	withFile file WriteMode $ \h -> do
 		void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes
 		writer h
+
+protectedOutput :: IO a -> IO a
+protectedOutput = withUmask 0o0077
diff --git a/src/Utility/FileSystemEncoding.hs b/src/Utility/FileSystemEncoding.hs
index be43ace9..862f0721 100644
--- a/src/Utility/FileSystemEncoding.hs
+++ b/src/Utility/FileSystemEncoding.hs
@@ -10,8 +10,8 @@
 
 module Utility.FileSystemEncoding (
 	useFileSystemEncoding,
+	fileEncoding,
 	withFilePath,
-	md5FilePath,
 	decodeBS,
 	encodeBS,
 	decodeW8,
@@ -19,6 +19,8 @@ module Utility.FileSystemEncoding (
 	encodeW8NUL,
 	decodeW8NUL,
 	truncateFilePath,
+	s2w8,
+	w82s,
 ) where
 
 import qualified GHC.Foreign as GHC
@@ -26,17 +28,15 @@ import qualified GHC.IO.Encoding as Encoding
 import Foreign.C
 import System.IO
 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
+import Utility.Split
 
 {- Makes all subsequent Handles that are opened, as well as stdio Handles,
  - use the filesystem encoding, instead of the encoding of the current
@@ -63,6 +63,13 @@ useFileSystemEncoding = do
 	hSetEncoding stderr e
 	Encoding.setLocaleEncoding e	
 
+fileEncoding :: Handle -> IO ()
+#ifndef mingw32_HOST_OS
+fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding
+#else
+fileEncoding h = hSetEncoding h Encoding.utf8
+#endif
+
 {- Marshal a Haskell FilePath into a NUL terminated C string using temporary
  - storage. The FilePath is encoded using the filesystem encoding,
  - reversing the decoding that should have been done when the FilePath
@@ -93,10 +100,6 @@ _encodeFilePath fp = unsafePerformIO $ do
 	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
-md5FilePath = MD5.Str . _encodeFilePath
-
 {- Decodes a ByteString into a FilePath, applying the filesystem encoding. -}
 decodeBS :: L.ByteString -> FilePath
 #ifndef mingw32_HOST_OS
@@ -137,14 +140,26 @@ decodeW8 = s2w8 . _encodeFilePath
 
 {- Like encodeW8 and decodeW8, but NULs are passed through unchanged. -}
 encodeW8NUL :: [Word8] -> FilePath
-encodeW8NUL = intercalate nul . map encodeW8 . split (s2w8 nul)
+encodeW8NUL = intercalate [nul] . map encodeW8 . splitc (c2w8 nul)
   where
-	nul = ['\NUL']
+	nul = '\NUL'
 
 decodeW8NUL :: FilePath -> [Word8]
-decodeW8NUL = intercalate (s2w8 nul) . map decodeW8 . split nul
+decodeW8NUL = intercalate [c2w8 nul] . map decodeW8 . splitc nul
   where
-	nul = ['\NUL']
+	nul = '\NUL'
+
+c2w8 :: Char -> Word8
+c2w8 = fromIntegral . fromEnum
+
+w82c :: Word8 -> Char
+w82c = toEnum . fromIntegral
+
+s2w8 :: String -> [Word8]
+s2w8 = map c2w8
+
+w82s :: [Word8] -> String
+w82s = map w82c
 
 {- Truncates a FilePath to the given number of bytes (or less),
  - as represented on disk.
diff --git a/src/Utility/LinuxMkLibs.hs b/src/Utility/LinuxMkLibs.hs
index 122f3964..15f82fd1 100644
--- a/src/Utility/LinuxMkLibs.hs
+++ b/src/Utility/LinuxMkLibs.hs
@@ -12,10 +12,10 @@ import Utility.Directory
 import Utility.Process
 import Utility.Monad
 import Utility.Path
+import Utility.Split
 
 import Data.Maybe
 import System.FilePath
-import Data.List.Utils
 import System.Posix.Files
 import Data.Char
 import Control.Monad.IfElse
diff --git a/src/Utility/PartialPrelude.hs b/src/Utility/PartialPrelude.hs
index 55795563..47e98318 100644
--- a/src/Utility/PartialPrelude.hs
+++ b/src/Utility/PartialPrelude.hs
@@ -2,7 +2,7 @@
  - bugs.
  -
  - This exports functions that conflict with the prelude, which avoids
- - them being accidentially used.
+ - them being accidentally used.
  -}
 
 {-# OPTIONS_GHC -fno-warn-tabs #-}
diff --git a/src/Utility/Path.hs b/src/Utility/Path.hs
index 3ee5ff39..2383ad06 100644
--- a/src/Utility/Path.hs
+++ b/src/Utility/Path.hs
@@ -10,7 +10,6 @@
 
 module Utility.Path where
 
-import Data.String.Utils
 import System.FilePath
 import Data.List
 import Data.Maybe
@@ -25,7 +24,6 @@ import System.Posix.Files
 import Utility.Exception
 #endif
 
-import qualified "MissingH" System.Path as MissingH
 import Utility.Monad
 import Utility.UserInfo
 import Utility.Directory
@@ -68,18 +66,6 @@ simplifyPath path = dropTrailingPathSeparator $
 absPathFrom :: FilePath -> FilePath -> FilePath
 absPathFrom dir path = simplifyPath (combine dir path)
 
-{- On Windows, this converts the paths to unix-style, in order to run
- - MissingH's absNormPath on them. -}
-absNormPathUnix :: FilePath -> FilePath -> Maybe FilePath
-#ifndef mingw32_HOST_OS
-absNormPathUnix dir path = MissingH.absNormPath dir path
-#else
-absNormPathUnix dir path = todos <$> MissingH.absNormPath (fromdos dir) (fromdos path)
-  where
-	fromdos = replace "\\" "/"
-	todos = replace "/" "\\"
-#endif
-
 {- takeDirectory "foo/bar/" is "foo/bar". This instead yields "foo" -}
 parentDir :: FilePath -> FilePath
 parentDir = takeDirectory . dropTrailingPathSeparator
@@ -89,12 +75,11 @@ parentDir = takeDirectory . dropTrailingPathSeparator
 upFrom :: FilePath -> Maybe FilePath
 upFrom dir
 	| length dirs < 2 = Nothing
-	| otherwise = Just $ joinDrive drive (intercalate s $ init dirs)
+	| otherwise = Just $ joinDrive drive $ joinPath $ init dirs
   where
 	-- on Unix, the drive will be "/" when the dir is absolute, otherwise ""
 	(drive, path) = splitDrive dir
-	dirs = filter (not . null) $ split s path
-	s = [pathSeparator]
+	dirs = filter (not . null) $ splitPath path
 
 prop_upFrom_basics :: FilePath -> Bool
 prop_upFrom_basics dir
@@ -149,11 +134,10 @@ relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
 relPathDirToFileAbs :: FilePath -> FilePath -> FilePath
 relPathDirToFileAbs from to
 	| takeDrive from /= takeDrive to = to
-	| otherwise = intercalate s $ dotdots ++ uncommon
+	| otherwise = joinPath $ dotdots ++ uncommon
   where
-	s = [pathSeparator]
-	pfrom = split s from
-	pto = split s to
+	pfrom = splitPath from
+	pto = splitPath to
 	common = map fst $ takeWhile same $ zip pfrom pto
 	same (c,d) = c == d
 	uncommon = drop numcommon pto
@@ -227,6 +211,8 @@ inPath command = isJust <$> searchPath command
  -
  - The command may be fully qualified already, in which case it will
  - be returned if it exists.
+ -
+ - Note that this will find commands in PATH that are not executable.
  -}
 searchPath :: String -> IO (Maybe FilePath)
 searchPath command
diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs
index ed02f49e..6d981cb5 100644
--- a/src/Utility/Process.hs
+++ b/src/Utility/Process.hs
@@ -174,22 +174,21 @@ createBackgroundProcess p a = a =<< createProcess p
 -- returns a transcript combining its stdout and stderr, and
 -- whether it succeeded or failed.
 processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
-processTranscript = processTranscript' id
+processTranscript cmd opts = processTranscript' (proc cmd opts)
 
-processTranscript' :: (CreateProcess -> CreateProcess) -> String -> [String] -> Maybe String -> IO (String, Bool)
-processTranscript' modproc cmd opts input = do
+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 $ modproc $
-		(proc cmd opts)
-			{ std_in = if isJust input then CreatePipe else Inherit
-			, std_out = UseHandle writeh
-			, std_err = UseHandle writeh
-			}
+	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
@@ -200,12 +199,11 @@ processTranscript' modproc cmd opts input = do
 	return (transcript, ok)
 #else
 {- This implementation for Windows puts stderr after stdout. -}
-	p@(_, _, _, pid) <- createProcess $ modproc $
-		(proc cmd opts)
-			{ std_in = if isJust input then CreatePipe else Inherit
-			, std_out = CreatePipe
-			, std_err = CreatePipe
-			}
+	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)
diff --git a/src/Utility/SafeCommand.hs b/src/Utility/SafeCommand.hs
index 5ce17a84..eb34d3de 100644
--- a/src/Utility/SafeCommand.hs
+++ b/src/Utility/SafeCommand.hs
@@ -11,7 +11,7 @@ module Utility.SafeCommand where
 
 import System.Exit
 import Utility.Process
-import Data.String.Utils
+import Utility.Split
 import System.FilePath
 import Data.Char
 import Data.List
@@ -86,7 +86,7 @@ shellEscape :: String -> String
 shellEscape f = "'" ++ escaped ++ "'"
   where
 	-- replace ' with '"'"'
-	escaped = intercalate "'\"'\"'" $ split "'" f
+	escaped = intercalate "'\"'\"'" $ splitc '\'' f
 
 -- | Unescapes a set of shellEscaped words or filenames.
 shellUnEscape :: String -> [String]
diff --git a/src/Utility/Scheduled.hs b/src/Utility/Scheduled.hs
index d23aaf03..b68ff901 100644
--- a/src/Utility/Scheduled.hs
+++ b/src/Utility/Scheduled.hs
@@ -29,6 +29,7 @@ module Utility.Scheduled (
 import Utility.Data
 import Utility.PartialPrelude
 import Utility.Misc
+import Utility.Tuple
 
 import Data.List
 import Data.Time.Clock
@@ -37,7 +38,6 @@ import Data.Time.Calendar
 import Data.Time.Calendar.WeekDate
 import Data.Time.Calendar.OrdinalDate
 import Data.Time.Format ()
-import Data.Tuple.Utils
 import Data.Char
 import Control.Applicative
 import Prelude
diff --git a/src/Utility/Split.hs b/src/Utility/Split.hs
new file mode 100644
index 00000000..b3e5e276
--- /dev/null
+++ b/src/Utility/Split.hs
@@ -0,0 +1,28 @@
+{- split utility functions
+ -
+ - Copyright 2017 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+module Utility.Split where
+
+import Data.List (intercalate)
+import Data.List.Split (splitOn)
+
+-- | same as Data.List.Utils.split
+--
+-- intercalate x . splitOn x === id
+split :: Eq a => [a] -> [a] -> [[a]]
+split = splitOn
+
+-- | Split on a single character. This is over twice as fast as using
+-- split on a list of length 1, while producing identical results. -}
+splitc :: Eq c => c -> [c] -> [[c]]
+splitc c s = case break (== c) s of
+	(i, _c:rest) -> i : splitc c rest
+	(i, []) -> i : []
+
+-- | same as Data.List.Utils.replace
+replace :: Eq a => [a] -> [a] -> [a] -> [a] 
+replace old new = intercalate new . split old
diff --git a/src/Utility/Tuple.hs b/src/Utility/Tuple.hs
new file mode 100644
index 00000000..25c6e8f3
--- /dev/null
+++ b/src/Utility/Tuple.hs
@@ -0,0 +1,17 @@
+{- tuple utility functions
+ -
+ - Copyright 2017 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+module Utility.Tuple where
+
+fst3 :: (a,b,c) -> a
+fst3 (a,_,_) = a
+
+snd3 :: (a,b,c) -> b
+snd3 (_,b,_) = b
+
+thd3 :: (a,b,c) -> c
+thd3 (_,_,c) = c