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.

Annex/Branch.hs

@@ -29,8 +29,8 @@ module Annex.Branch (
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Set as S
 import qualified Data.Map as M
-import Data.Bits.Utils
 import Data.Function
+import Data.Char
 import Control.Concurrent (threadDelay)
 
 import Annex.Common
@@ -304,7 +304,7 @@ commitIndex' jl branchref message basemessage retrynum parents = do
 	-- look for "parent ref" lines and return the refs
 	commitparents = map (Git.Ref . snd) . filter isparent .
 		map (toassoc . decodeBS) . L.split newline
-	newline = c2w8 '\n'
+	newline = fromIntegral (ord '\n')
 	toassoc = separate (== ' ')
 	isparent (k,_) = k == "parent"
 		

Annex/UUID.hs

@@ -37,7 +37,7 @@ import Config
 import qualified Data.UUID as U
 import qualified Data.UUID.V4 as U4
 import qualified Data.UUID.V5 as U5
-import Data.Bits.Utils
+import Utility.FileSystemEncoding
 
 configkey :: ConfigKey
 configkey = annexConfig "uuid"

Assistant/Threads/Committer.hs

@@ -38,9 +38,9 @@ import Annex.Content.Direct
 import qualified Database.Keys
 import qualified Command.Sync
 import qualified Git.Branch
+import Utility.Tuple
 
 import Data.Time.Clock
-import Data.Tuple.Utils
 import qualified Data.Set as S
 import qualified Data.Map as M
 import Data.Either

Assistant/Threads/Watcher.hs

@@ -44,13 +44,13 @@ import Git.FilePath
 import Config
 import Config.GitConfig
 import Utility.ThreadScheduler
+import Utility.FileSystemEncoding
 import Logs.Location
 import qualified Database.Keys
 #ifndef mingw32_HOST_OS
 import qualified Utility.Lsof as Lsof
 #endif
 
-import Data.Bits.Utils
 import Data.Typeable
 import qualified Data.ByteString.Lazy as L
 import qualified Control.Exception as E

Assistant/Upgrade.hs

@@ -39,9 +39,9 @@ import qualified Utility.Lsof as Lsof
 import qualified Build.SysConfig
 import qualified Utility.Url as Url
 import qualified Annex.Url as Url
+import Utility.Tuple
 
 import qualified Data.Map as M
-import Data.Tuple.Utils
 
 {- Upgrade without interaction in the webapp. -}
 unattendedUpgrade :: Assistant ()

Build/EvilLinker.hs

@@ -10,7 +10,6 @@
 
 module Main where
 
-import Data.List.Utils
 import Text.Parsec
 import Text.Parsec.String
 import Control.Applicative ((<$>))
@@ -23,6 +22,7 @@ import Utility.Process hiding (env)
 import qualified Utility.Process
 import Utility.Env
 import Utility.Directory
+import Utility.Split
 
 data CmdParams = CmdParams
 	{ cmd :: String

Build/EvilSplicer.hs

@@ -35,7 +35,6 @@ import Text.Parsec.String
 import Control.Applicative ((<$>))
 import Data.Either
 import Data.List hiding (find)
-import Data.String.Utils
 import Data.Char
 import System.Environment
 import System.FilePath
@@ -49,6 +48,7 @@ import Utility.Exception hiding (try)
 import Utility.Path
 import Utility.FileSystemEncoding
 import Utility.Directory
+import Utility.Split
 
 data Coord = Coord
 	{ coordLine :: Int

CHANGELOG

@@ -4,6 +4,8 @@ git-annex (6.20170511) UNRELEASED; urgency=medium
     When ssh connection caching is enabled (and when GIT_ANNEX_USE_GIT_SSH
     is not set), only one ssh password prompt will be made per host, and
     only one ssh password prompt will be made at a time.
+  * Removed dependency on MissingH, instead depending on the split library.
+  * Progress is displayed for transfers of files of unknown size.
 
  -- Joey Hess <id@joeyh.name>  Thu, 11 May 2017 15:16:23 -0400
 

Command/List.hs

@@ -11,7 +11,6 @@ module Command.List where
 import qualified Data.Set as S
 import qualified Data.Map as M
 import Data.Function
-import Data.Tuple.Utils
 import Data.Ord
 
 import Command
@@ -20,6 +19,7 @@ import Logs.Trust
 import Logs.UUID
 import Annex.UUID
 import Git.Types (RemoteName)
+import Utility.Tuple
 
 cmd :: Command
 cmd = noCommit $ withGlobalOptions annexedMatchingOptions $

Command/Uninit.hs

@@ -18,9 +18,6 @@ import Annex.Content
 import Annex.Init
 import Utility.FileMode
 
-import System.IO.HVFS
-import System.IO.HVFS.Utils
-
 cmd :: Command
 cmd = addCheck check $ 
 	command "uninit" SectionUtility
@@ -101,7 +98,8 @@ prepareRemoveAnnexDir annexdir = do
 
 prepareRemoveAnnexDir' :: FilePath -> IO ()
 prepareRemoveAnnexDir' annexdir =
-	recurseDir SystemFS annexdir >>= mapM_ (void . tryIO . allowWrite)
+	dirTreeRecursiveSkipping (const False) annexdir 
+		>>= mapM_ (void . tryIO . allowWrite)
 
 {- Keys that were moved out of the annex have a hard link still in the
  - annex, with > 1 link count, and those can be removed.

Common.hs

@@ -9,7 +9,6 @@ import Control.Monad.IO.Class as X (liftIO)
 
 import Data.Maybe as X
 import Data.List as X hiding (head, tail, init, last)
-import Data.String.Utils as X hiding (join)
 import Data.Monoid as X
 import Data.Default as X
 
@@ -32,5 +31,6 @@ import Utility.Applicative as X
 import Utility.PosixFiles as X hiding (fileSize)
 import Utility.FileSize as X
 import Utility.Network as X
+import Utility.Split as X
 
 import Utility.PartialPrelude as X

Git/CatFile.hs

@@ -26,7 +26,6 @@ import qualified Data.ByteString.Lazy.Char8 as L8
 import qualified Data.Map as M
 import Data.String
 import Data.Char
-import Data.Tuple.Utils
 import Numeric
 import System.Posix.Types
 
@@ -38,6 +37,7 @@ import Git.Types
 import Git.FilePath
 import qualified Utility.CoProcess as CoProcess
 import Utility.FileSystemEncoding
+import Utility.Tuple
 
 data CatFileHandle = CatFileHandle 
 	{ catFileProcess :: CoProcess.CoProcessHandle

Git/Construct.hs

@@ -94,7 +94,7 @@ fromUrl url
 
 fromUrlStrict :: String -> IO Repo
 fromUrlStrict url
-	| startswith "file://" url = fromAbsPath $ unEscapeString $ uriPath u
+	| "file://" `isPrefixOf` url = fromAbsPath $ unEscapeString $ uriPath u
 	| otherwise = pure $ newFrom $ Url u
   where
 	u = fromMaybe bad $ parseURI url
@@ -128,7 +128,7 @@ fromRemotes repo = mapM construct remotepairs
 	filterconfig f = filter f $ M.toList $ config repo
 	filterkeys f = filterconfig (\(k,_) -> f k)
 	remotepairs = filterkeys isremote
-	isremote k = startswith "remote." k && endswith ".url" k
+	isremote k = "remote." `isPrefixOf` k && ".url" `isSuffixOf` k
 	construct (k,v) = remoteNamedFromKey k $ fromRemoteLocation v repo
 
 {- Sets the name of a remote when constructing the Repo to represent it. -}

Git/Remote.hs

@@ -74,9 +74,9 @@ parseRemoteLocation s repo = ret $ calcloc s
 		(bestkey, bestvalue) = maximumBy longestvalue insteadofs
 		longestvalue (_, a) (_, b) = compare b a
 		insteadofs = filterconfig $ \(k, v) -> 
-			startswith prefix k &&
+			prefix `isPrefixOf` k &&
-			endswith suffix k &&
+			suffix `isSuffixOf` k &&
-			startswith v l
+			v `isPrefixOf` l
 		filterconfig f = filter f $
 			concatMap splitconfigs $ M.toList $ fullconfig repo
 		splitconfigs (k, vs) = map (\v -> (k, v)) vs

Git/Repair.hs

@@ -39,10 +39,10 @@ import qualified Git.Branch as Branch
 import Utility.Tmp
 import Utility.Rsync
 import Utility.FileMode
+import Utility.Tuple
 
 import qualified Data.Set as S
 import qualified Data.ByteString.Lazy as L
-import Data.Tuple.Utils
 
 {- Given a set of bad objects found by git fsck, which may not
  - be complete, finds and removes all corrupt objects. -}

Messages/Progress.hs

@@ -23,34 +23,28 @@ import qualified System.Console.Regions as Regions
 import qualified System.Console.Concurrent as Console
 #endif
 
-import Data.Progress.Meter
-import Data.Progress.Tracker
-import Data.Quantity
-
 {- Shows a progress meter while performing a transfer of a key.
  - The action is passed a callback to use to update the meter. -}
 metered :: Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a
 metered othermeter key a = withMessageState $ go (keySize key)
   where
 	go _ (MessageState { outputType = QuietOutput }) = nometer
-	go Nothing (MessageState { outputType = NormalOutput }) = nometer
+	go (msize) (MessageState { outputType = NormalOutput, concurrentOutputEnabled = False }) = do
-	go (Just size) (MessageState { outputType = NormalOutput, concurrentOutputEnabled = False }) = do
 		showOutput
-		(progress, meter) <- mkmeter size
+		meter <- liftIO $ mkMeter msize bandwidthMeter $ 
-		m <- liftIO $ rateLimitMeterUpdate 0.1 (Just size) $ \n -> do
+			displayMeterHandle stdout
-			setP progress $ fromBytesProcessed n
+		m <- liftIO $ rateLimitMeterUpdate 0.1 msize $
-			displayMeter stdout meter
+			updateMeter meter
 		r <- a (combinemeter m)
-		liftIO $ clearMeter stdout meter
+		liftIO $ clearMeterHandle meter stdout
 		return r
-	go (Just size) (MessageState { outputType = NormalOutput, concurrentOutputEnabled = True }) =
+	go (msize) (MessageState { outputType = NormalOutput, concurrentOutputEnabled = True }) =
 #if WITH_CONCURRENTOUTPUT
 		withProgressRegion $ \r -> do
-			(progress, meter) <- mkmeter size
+			meter <- liftIO $ mkMeter msize bandwidthMeter $ \_ s ->
-			m <- liftIO $ rateLimitMeterUpdate 0.1 (Just size) $ \n -> do
+				Regions.setConsoleRegion r ('\n' : s)
-				setP progress $ fromBytesProcessed n
+			m <- liftIO $ rateLimitMeterUpdate 0.1 msize $
-				s <- renderMeter meter
+				updateMeter meter
-				Regions.setConsoleRegion r ("\n" ++ s)
 			a (combinemeter m)
 #else
 		nometer
@@ -62,11 +56,6 @@ metered othermeter key a = withMessageState $ go (keySize key)
 			JSON.progress buf msize
 		a (combinemeter m)
 
-	mkmeter size = do
-		progress <- liftIO $ newProgress "" size
-		meter <- liftIO $ newMeter progress "B" 25 (renderNums binaryOpts 1)
-		return (progress, meter)
-
 	nometer = a $ combinemeter (const noop)
 
 	combinemeter m = case othermeter of

Remote/Helper/Encryptable.hs

@@ -21,13 +21,13 @@ module Remote.Helper.Encryptable (
 import qualified Data.Map as M
 import qualified "sandi" Codec.Binary.Base64 as B64
 import qualified Data.ByteString as B
-import Data.Bits.Utils
 
 import Annex.Common
 import Types.Remote
 import Crypto
 import Types.Crypto
 import qualified Annex
+import Utility.FileSystemEncoding
 
 -- Used to ensure that encryption has been set up before trying to
 -- eg, store creds in the remote config that would need to use the

Remote/Helper/Special.hs

@@ -62,7 +62,7 @@ findSpecialRemotes s = do
   where
 	remotepairs = M.toList . M.filterWithKey match
 	construct (k,_) = Git.Construct.remoteNamedFromKey k (pure Git.Construct.fromUnknown)
-	match k _ = startswith "remote." k && endswith (".annex-"++s) k
+	match k _ = "remote." `isPrefixOf` k && (".annex-"++s) `isSuffixOf` k
 
 {- Sets up configuration for a special remote in .git/config. -}
 gitConfigSpecialRemote :: UUID -> RemoteConfig -> String -> String -> Annex ()

Remote/Rsync/RsyncUrl.hs

@@ -17,7 +17,7 @@ import Utility.SafeCommand
 import Data.Default
 import System.FilePath.Posix
 #ifdef mingw32_HOST_OS
-import Data.String.Utils
+import Utility.Split
 #endif
 import Annex.DirHashes
 

Remote/S3.hs

@@ -29,7 +29,6 @@ import Control.Monad.Trans.Resource
 import Control.Monad.Catch
 import Data.Conduit
 import Data.IORef
-import Data.Bits.Utils
 import System.Log.Logger
 
 import Annex.Common
@@ -46,6 +45,7 @@ import Annex.UUID
 import Logs.Web
 import Utility.Metered
 import Utility.DataUnits
+import Utility.FileSystemEncoding
 import Annex.Content
 import Annex.Url (withUrlOptions)
 import Utility.Url (checkBoth, managerSettings, closeManager)

Remote/WebDAV/DavLocation.hs

@@ -13,14 +13,14 @@ module Remote.WebDAV.DavLocation where
 import Types
 import Annex.Locations
 import Utility.Url (URLString)
+#ifdef mingw32_HOST_OS
+import Utility.Split
+#endif
 
 import System.FilePath.Posix -- for manipulating url paths
 import Network.Protocol.HTTP.DAV (inDAVLocation, DAVT)
 import Control.Monad.IO.Class (MonadIO)
 import Data.Default
-#ifdef mingw32_HOST_OS
-import Data.String.Utils
-#endif
 
 -- Relative to the top of the DAV url.
 type DavLocation = String

Types/Distribution.hs

@@ -8,12 +8,12 @@
 module Types.Distribution where
 
 import Utility.PartialPrelude
+import Utility.Split
 import Types.Key
 import Key
 import Data.Time.Clock
 import Git.Config (isTrue, boolConfig)
 
-import Data.String.Utils
 import Control.Applicative
 import Prelude
 

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

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.

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

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
+testHarness cmd a = withTmpDir "gpgtmpXXXXXX" $ \tmpdir ->
-	orig <- getEnv var
+	bracket (setup tmpdir) (cleanup tmpdir) (const a)
-	bracket setup (cleanup orig) (const a)
   where
 	var = "GNUPGHOME"		
 
-	setup = do
+	setup tmpdir = do
-		base <- getTemporaryDirectory
+		orig <- getEnv var
-		dir <- mktmpdir $ base </> "gpgtmpXXXXXX"
+		setEnv var tmpdir True
-		setEnv var dir 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

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

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

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')

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

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. -}

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

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

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

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

debian/control

@@ -6,7 +6,7 @@ Build-Depends:
 	ghc (>= 7.4),
 	cabal-install,
 	libghc-mtl-dev (>= 2.1.1),
-	libghc-missingh-dev,
+	libghc-split-dev,
 	libghc-data-default-dev,
 	libghc-hslogger-dev,
 	libghc-pcre-light-dev,

git-annex.cabal

@@ -304,7 +304,7 @@ source-repository head
   location: git://git-annex.branchable.com/
 
 custom-setup
-  Setup-Depends: base (>= 4.5), hslogger, MissingH, unix-compat, process,
+  Setup-Depends: base (>= 4.5), hslogger, split, unix-compat, process,
     unix, filepath, exceptions, bytestring, directory, IfElse, data-default,
     Cabal
 
@@ -330,7 +330,6 @@ Executable git-annex
    directory (>= 1.2),
    filepath,
    IfElse,
-   MissingH,
    hslogger,
    monad-logger,
    free,
@@ -362,7 +361,8 @@ Executable git-annex
    securemem,
    crypto-api,
    cryptonite,
-   memory
+   memory,
+   split
   CC-Options: -Wall
   GHC-Options: -Wall -fno-warn-tabs
   Extensions: PackageImports
@@ -1051,6 +1051,7 @@ Executable git-annex
     Utility.Scheduled.QuickCheck
     Utility.Shell
     Utility.SimpleProtocol
+    Utility.Split
     Utility.SshConfig
     Utility.Su
     Utility.SystemDirectory
@@ -1061,6 +1062,7 @@ Executable git-annex
     Utility.Tmp
     Utility.Tor
     Utility.Touch
+    Utility.Tuple
     Utility.Url
     Utility.UserInfo
     Utility.Verifiable