adeiu, MissingH

Removed dependency on MissingH, instead depending on the split
library.

After laying groundwork for this since 2015, it
was mostly straightforward. Added Utility.Tuple and
Utility.Split. Eyeballed System.Path.WildMatch while implementing
the same thing.

Since MissingH's progress meter display was being used, I re-implemented
my own. Bonus: Now progress is displayed for transfers of files of
unknown size.

This commit was sponsored by Shane-o on Patreon.

13 files changed, 184 insertions, 46 deletions

diff --git a/Utility/DataUnits.hs b/Utility/DataUnits.hs
index 6e40932ef..a6c9ffcf1 100644
--- a/Utility/DataUnits.hs
+++ b/Utility/DataUnits.hs
@@ -45,6 +45,7 @@ module Utility.DataUnits (
 	ByteSize,
 
 	roughSize,
+	roughSize',
 	compareSizes,
 	readSize
 ) where
@@ -109,7 +110,10 @@ oldSchoolUnits = zipWith (curry mingle) storageUnits memoryUnits
 
 {- approximate display of a particular number of bytes -}
 roughSize :: [Unit] -> Bool -> ByteSize -> String
-roughSize units short i
+roughSize units short i = roughSize' units short 2 i
+
+roughSize' :: [Unit] -> Bool -> Int -> ByteSize -> String
+roughSize' units short precision i
 	| i < 0 = '-' : findUnit units' (negate i)
 	| otherwise = findUnit units' i
   where
@@ -123,7 +127,7 @@ roughSize units short i
 	showUnit x (Unit size abbrev name) = s ++ " " ++ unit
 	  where
 		v = (fromInteger x :: Double) / fromInteger size
-		s = showImprecise 2 v
+		s = showImprecise precision v
 		unit
 			| short = abbrev
 			| s == "1" = name
diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs
index 785b078ef..444dc4a90 100644
--- a/Utility/FileSystemEncoding.hs
+++ b/Utility/FileSystemEncoding.hs
@@ -19,6 +19,10 @@ module Utility.FileSystemEncoding (
 	encodeW8NUL,
 	decodeW8NUL,
 	truncateFilePath,
+	s2w8,
+	w82s,
+	c2w8,
+	w82c,
 ) where
 
 import qualified GHC.Foreign as GHC
@@ -27,15 +31,14 @@ import Foreign.C
 import System.IO
 import System.IO.Unsafe
 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
@@ -139,14 +142,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/Utility/Glob.hs b/Utility/Glob.hs
index 119ea4834..c7d535933 100644
--- a/Utility/Glob.hs
+++ b/Utility/Glob.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PackageImports #-}
+
 {- file globbing
  -
  - Copyright 2014 Joey Hess <id@joeyh.name>
@@ -14,10 +16,9 @@ module Utility.Glob (
 
 import Utility.Exception
 
-import System.Path.WildMatch
-
 import "regex-tdfa" Text.Regex.TDFA
 import "regex-tdfa" Text.Regex.TDFA.String
+import Data.Char
 
 newtype Glob = Glob Regex
 
@@ -30,11 +31,31 @@ compileGlob glob globcase = Glob $
 		Right r -> r
 		Left _ -> giveup $ "failed to compile regex: " ++ regex
   where
-	regex = '^':wildToRegex glob
+	regex = '^' : wildToRegex glob ++ "$"
 	casesentitive = case globcase of
 		CaseSensative -> True
 		CaseInsensative -> False
 
+wildToRegex :: String -> String
+wildToRegex = concat . go
+  where
+	go [] = []
+	go ('*':xs) = ".*" : go xs
+	go ('?':xs) = "." : go xs
+	go ('[':'!':xs) = "[^" : inpat xs
+	go ('[':xs) = "[" : inpat xs
+	go (x:xs)
+		| isDigit x || isAlpha x = [x] : go xs
+		| otherwise = esc x : go xs
+
+	inpat [] = []
+	inpat (x:xs) = case x of
+		']' -> "]" : go xs
+		'\\' -> esc x : inpat xs
+		_ -> [x] : inpat xs
+
+	esc c = ['\\', c]
+
 matchGlob :: Glob -> String -> Bool
 matchGlob (Glob regex) val = 
 	case execute regex val of
diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs
index f6173cdb4..336711b3f 100644
--- a/Utility/Gpg.hs
+++ b/Utility/Gpg.hs
@@ -14,11 +14,9 @@ import qualified Build.SysConfig as SysConfig
 #ifndef mingw32_HOST_OS
 import System.Posix.Types
 import qualified System.Posix.IO
-import System.Path
 import Utility.Env
-#else
-import Utility.Tmp
 #endif
+import Utility.Tmp
 import Utility.Format (decode_c)
 
 import Control.Concurrent
@@ -336,23 +334,21 @@ keyBlock public ls = unlines
 {- Runs an action using gpg in a test harness, in which gpg does
  - not use ~/.gpg/, but a directory with the test key set up to be used. -}
 testHarness :: GpgCmd -> IO a -> IO a
-testHarness cmd a = do
-	orig <- getEnv var
-	bracket setup (cleanup orig) (const a)
+testHarness cmd a = withTmpDir "gpgtmpXXXXXX" $ \tmpdir ->
+	bracket (setup tmpdir) (cleanup tmpdir) (const a)
   where
 	var = "GNUPGHOME"		
 
-	setup = do
-		base <- getTemporaryDirectory
-		dir <- mktmpdir $ base </> "gpgtmpXXXXXX"
-		setEnv var dir True
+	setup tmpdir = do
+		orig <- getEnv var
+		setEnv var tmpdir True
 		-- For some reason, recent gpg needs a trustdb to be set up.
 		_ <- pipeStrict cmd [Param "--trust-model", Param "auto", Param "--update-trustdb"] []
 		_ <- pipeStrict cmd [Param "--import", Param "-q"] $ unlines
 			[testSecretKey, testKey]
-		return dir
+		return orig
 		
-	cleanup orig tmpdir = do
+	cleanup tmpdir orig = do
 		removeDirectoryRecursive tmpdir
 			-- gpg-agent may be shutting down at the same time
 			-- and may delete its socket at the same time as
diff --git a/Utility/LinuxMkLibs.hs b/Utility/LinuxMkLibs.hs
index 122f39643..15f82fd18 100644
--- a/Utility/LinuxMkLibs.hs
+++ b/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/Utility/Metered.hs b/Utility/Metered.hs
index e21e18cf1..626aa2ca1 100644
--- a/Utility/Metered.hs
+++ b/Utility/Metered.hs
@@ -10,6 +10,10 @@
 module Utility.Metered where
 
 import Common
+import Utility.FileSystemEncoding
+import Utility.Percentage
+import Utility.DataUnits
+import Utility.HumanTime
 
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString as S
@@ -17,7 +21,6 @@ import System.IO.Unsafe
 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)
@@ -216,7 +219,7 @@ commandMeter progressparser oh meterupdate cmd params =
 				unless (quietMode oh) $ do
 					S.hPut stdout b
 					hFlush stdout
-				let s = w82s (S.unpack b)
+				let s = encodeW8 (S.unpack b)
 				let (mbytes, buf') = progressparser (buf++s)
 				case mbytes of
 					Nothing -> feedprogress prev buf' h
@@ -297,3 +300,77 @@ rateLimitMeterUpdate delta totalsize meterupdate = do
 					putMVar lastupdate now
 					meterupdate n
 				else putMVar lastupdate prev
+
+data Meter = Meter (Maybe Integer) (MVar MeterState) (MVar String) RenderMeter DisplayMeter
+
+type MeterState = (BytesProcessed, POSIXTime)
+
+type DisplayMeter = MVar String -> String -> 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
+	<*> ((\t -> newMVar (zeroBytesProcessed, t)) =<< getPOSIXTime)
+	<*> newMVar ""
+	<*> pure rendermeter
+	<*> pure displaymeter
+
+-- | Updates the meter, displaying it if necessary.
+updateMeter :: Meter -> BytesProcessed -> IO ()
+updateMeter (Meter totalsize sv bv rendermeter displaymeter) new = do
+	now <- getPOSIXTime
+	(old, before) <- swapMVar sv (new, now)
+	when (old /= new) $
+		displaymeter bv $ 
+			rendermeter totalsize (old, before) (new, now)
+
+-- | Display meter to a Handle.
+displayMeterHandle :: Handle -> DisplayMeter
+displayMeterHandle h v s = do
+	olds <- swapMVar v s
+	-- Avoid writing when the rendered meter has not changed.
+	when (olds /= s) $ do
+		let padding = replicate (length olds - length s) ' '
+		hPutStr h ('\r':s ++ padding)
+		hFlush h
+
+-- | Clear meter displayed by displayMeterHandle.
+clearMeterHandle :: Meter -> Handle -> IO ()
+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
+-- or when total size is not known:
+--   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 rate
+		, estimatedcompletion
+		]
+  where
+	percentoramount = case mtotalsize of
+		Just totalsize -> showPercentage 0 $
+			percentage totalsize (min new totalsize)
+		Nothing -> roughSize' memoryUnits True 2 new
+	rate = roughSize' memoryUnits True 0 bytespersecond ++ "/s"
+	bytespersecond
+		| duration == 0 = fromIntegral transferred
+		| otherwise = floor $ fromIntegral transferred / duration
+	transferred = max 0 (new - old)
+	duration = max 0 (now - before)
+	estimatedcompletion = case mtotalsize of
+		Just totalsize
+			| bytespersecond > 0 -> 
+				Just $ fromDuration $ Duration $
+					totalsize `div` bytespersecond
+		_ -> Nothing
diff --git a/Utility/Misc.hs b/Utility/Misc.hs
index 564935ddb..4498c0a03 100644
--- a/Utility/Misc.hs
+++ b/Utility/Misc.hs
@@ -45,14 +45,6 @@ separate c l = unbreak $ break c l
 		| null b = r
 		| otherwise = (a, tail b)
 
-{- Split on a single character. This is over twice as fast as using
- - Data.List.Utils.split on a list of length 1, while producing
- - identical results. -}
-splitc :: Char -> String -> [String]
-splitc c s = case break (== c) s of
-	(i, _c:rest) -> i : splitc c rest
-	(i, []) -> i : []
-
 {- Breaks out the first line. -}
 firstLine :: String -> String
 firstLine = takeWhile (/= '\n')
diff --git a/Utility/Path.hs b/Utility/Path.hs
index c53d122d5..0779d1676 100644
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -10,7 +10,6 @@
 
 module Utility.Path where
 
-import Data.String.Utils
 import System.FilePath
 import Data.List
 import Data.Maybe
@@ -28,6 +27,7 @@ import Utility.Exception
 import Utility.Monad
 import Utility.UserInfo
 import Utility.Directory
+import Utility.Split
 
 {- Simplifies a path, removing any "." component, collapsing "dir/..", 
  - and removing the trailing path separator.
@@ -76,12 +76,13 @@ 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 $ intercalate s $ init dirs
   where
-	-- on Unix, the drive will be "/" when the dir is absolute, otherwise ""
+	-- 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) $ split s path
 
 prop_upFrom_basics :: FilePath -> Bool
 prop_upFrom_basics dir
@@ -140,9 +141,9 @@ relPathDirToFileAbs from to
   where
 	pfrom = sp from
 	pto = sp to
-	sp = dropTrailingPathSeparator . splitPath
+	sp = map dropTrailingPathSeparator . splitPath
 	common = map fst $ takeWhile same $ zip pfrom pto
-	same (c,d) = c = d
+	same (c,d) = c == d
 	uncommon = drop numcommon pto
 	dotdots = replicate (length pfrom - numcommon) ".."
 	numcommon = length common
diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs
index d3823a528..f190b40de 100644
--- a/Utility/Rsync.hs
+++ b/Utility/Rsync.hs
@@ -11,10 +11,10 @@ module Utility.Rsync where
 
 import Common
 import Utility.Metered
+import Utility.Tuple
 
 import Data.Char
 import System.Console.GetOpt
-import Data.Tuple.Utils
 
 {- Generates parameters to make rsync use a specified command as its remote
  - shell. -}
diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs
index bef0a619d..eb34d3de7 100644
--- a/Utility/SafeCommand.hs
+++ b/Utility/SafeCommand.hs
@@ -11,7 +11,7 @@ module Utility.SafeCommand where
 
 import System.Exit
 import Utility.Process
-import Utility.Misc
+import Utility.Split
 import System.FilePath
 import Data.Char
 import Data.List
diff --git a/Utility/Scheduled.hs b/Utility/Scheduled.hs
index d23aaf039..b68ff901c 100644
--- a/Utility/Scheduled.hs
+++ b/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/Utility/Split.hs b/Utility/Split.hs
new file mode 100644
index 000000000..decfe7d39
--- /dev/null
+++ b/Utility/Split.hs
@@ -0,0 +1,30 @@
+{- split utility functions
+ -
+ - Copyright 2017 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+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/Utility/Tuple.hs b/Utility/Tuple.hs
index 78dd5d0c9..25c6e8f36 100644
--- a/Utility/Tuple.hs
+++ b/Utility/Tuple.hs
@@ -5,11 +5,13 @@
  - License: BSD-2-clause
  -}
 
+module Utility.Tuple where
+
 fst3 :: (a,b,c) -> a
-fst3 (a,b,c) = a
+fst3 (a,_,_) = a
 
 snd3 :: (a,b,c) -> b
-snd3 (a,b,c) = b
+snd3 (_,b,_) = b
 
 thd3 :: (a,b,c) -> c
-thd3 (a,b,c) = c
+thd3 (_,_,c) = c