summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2017-05-15 23:32:17 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2017-05-16 01:03:52 -0400
commit4dc2000f97236089a8613cc6b0bf9846fea6abfa (patch)
tree83df60ef702246b0b71bc99e141d4a8bf1990438
parent973180b077e60b5d12d7c57d926878d11d7f2105 (diff)
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.
-rw-r--r--Annex/Branch.hs4
-rw-r--r--Annex/UUID.hs2
-rw-r--r--Assistant/Threads/Committer.hs2
-rw-r--r--Assistant/Threads/Watcher.hs2
-rw-r--r--Assistant/Upgrade.hs2
-rw-r--r--Build/EvilLinker.hs2
-rw-r--r--Build/EvilSplicer.hs2
-rw-r--r--CHANGELOG2
-rw-r--r--Command/List.hs2
-rw-r--r--Command/Uninit.hs6
-rw-r--r--Common.hs2
-rw-r--r--Git/CatFile.hs2
-rw-r--r--Git/Construct.hs4
-rw-r--r--Git/Remote.hs6
-rw-r--r--Git/Repair.hs2
-rw-r--r--Messages/Progress.hs33
-rw-r--r--Remote/Helper/Encryptable.hs2
-rw-r--r--Remote/Helper/Special.hs2
-rw-r--r--Remote/Rsync/RsyncUrl.hs2
-rw-r--r--Remote/S3.hs2
-rw-r--r--Remote/WebDAV/DavLocation.hs6
-rw-r--r--Types/Distribution.hs2
-rw-r--r--Utility/DataUnits.hs8
-rw-r--r--Utility/FileSystemEncoding.hs27
-rw-r--r--Utility/Glob.hs27
-rw-r--r--Utility/Gpg.hs20
-rw-r--r--Utility/LinuxMkLibs.hs2
-rw-r--r--Utility/Metered.hs81
-rw-r--r--Utility/Misc.hs8
-rw-r--r--Utility/Path.hs13
-rw-r--r--Utility/Rsync.hs2
-rw-r--r--Utility/SafeCommand.hs2
-rw-r--r--Utility/Scheduled.hs2
-rw-r--r--Utility/Split.hs30
-rw-r--r--Utility/Tuple.hs8
-rw-r--r--debian/control2
-rw-r--r--git-annex.cabal8
37 files changed, 230 insertions, 101 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index af29b02b0..5482dc44b 100644
--- a/Annex/Branch.hs
+++ b/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"
diff --git a/Annex/UUID.hs b/Annex/UUID.hs
index 0e87cda59..8a2d88427 100644
--- a/Annex/UUID.hs
+++ b/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"
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index d0acb8c60..3680349be 100644
--- a/Assistant/Threads/Committer.hs
+++ b/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
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index 90bb3dc78..742b8c88f 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/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
diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs
index 67a4d9fc2..cd1be4d4e 100644
--- a/Assistant/Upgrade.hs
+++ b/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 ()
diff --git a/Build/EvilLinker.hs b/Build/EvilLinker.hs
index 47111d476..8d3afa9cd 100644
--- a/Build/EvilLinker.hs
+++ b/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
diff --git a/Build/EvilSplicer.hs b/Build/EvilSplicer.hs
index 4e7b1c9bf..e07034c5b 100644
--- a/Build/EvilSplicer.hs
+++ b/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
diff --git a/CHANGELOG b/CHANGELOG
index 8edf324de..972d2f27b 100644
--- a/CHANGELOG
+++ b/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
diff --git a/Command/List.hs b/Command/List.hs
index 2676b5d5d..05f12822a 100644
--- a/Command/List.hs
+++ b/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 $
diff --git a/Command/Uninit.hs b/Command/Uninit.hs
index d8c7d1295..af628d7a9 100644
--- a/Command/Uninit.hs
+++ b/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.
diff --git a/Common.hs b/Common.hs
index 2e28117b6..ba8382613 100644
--- a/Common.hs
+++ b/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
diff --git a/Git/CatFile.hs b/Git/CatFile.hs
index 4935cdffa..ba68c4ea3 100644
--- a/Git/CatFile.hs
+++ b/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
diff --git a/Git/Construct.hs b/Git/Construct.hs
index 489927880..4ad74fd73 100644
--- a/Git/Construct.hs
+++ b/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. -}
diff --git a/Git/Remote.hs b/Git/Remote.hs
index 717b54045..f6eaf9362 100644
--- a/Git/Remote.hs
+++ b/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 &&
- endswith suffix k &&
- startswith v l
+ prefix `isPrefixOf` k &&
+ suffix `isSuffixOf` k &&
+ v `isPrefixOf` l
filterconfig f = filter f $
concatMap splitconfigs $ M.toList $ fullconfig repo
splitconfigs (k, vs) = map (\v -> (k, v)) vs
diff --git a/Git/Repair.hs b/Git/Repair.hs
index 1baf51a64..8e4324858 100644
--- a/Git/Repair.hs
+++ b/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. -}
diff --git a/Messages/Progress.hs b/Messages/Progress.hs
index c4f55de50..3c263c05c 100644
--- a/Messages/Progress.hs
+++ b/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 (Just size) (MessageState { outputType = NormalOutput, concurrentOutputEnabled = False }) = do
+ go (msize) (MessageState { outputType = NormalOutput, concurrentOutputEnabled = False }) = do
showOutput
- (progress, meter) <- mkmeter size
- m <- liftIO $ rateLimitMeterUpdate 0.1 (Just size) $ \n -> do
- setP progress $ fromBytesProcessed n
- displayMeter stdout meter
+ meter <- liftIO $ mkMeter msize bandwidthMeter $
+ displayMeterHandle stdout
+ m <- liftIO $ rateLimitMeterUpdate 0.1 msize $
+ 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
- m <- liftIO $ rateLimitMeterUpdate 0.1 (Just size) $ \n -> do
- setP progress $ fromBytesProcessed n
- s <- renderMeter meter
- Regions.setConsoleRegion r ("\n" ++ s)
+ meter <- liftIO $ mkMeter msize bandwidthMeter $ \_ s ->
+ Regions.setConsoleRegion r ('\n' : s)
+ m <- liftIO $ rateLimitMeterUpdate 0.1 msize $
+ updateMeter meter
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
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index b72a60efa..1fe6d75be 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/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
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index 28970872e..ae654d517 100644
--- a/Remote/Helper/Special.hs
+++ b/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 ()
diff --git a/Remote/Rsync/RsyncUrl.hs b/Remote/Rsync/RsyncUrl.hs
index f7e9ebbb9..c0f30c1fb 100644
--- a/Remote/Rsync/RsyncUrl.hs
+++ b/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
diff --git a/Remote/S3.hs b/Remote/S3.hs
index ab8411726..a341da488 100644
--- a/Remote/S3.hs
+++ b/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)
diff --git a/Remote/WebDAV/DavLocation.hs b/Remote/WebDAV/DavLocation.hs
index e0e184686..daa669de1 100644
--- a/Remote/WebDAV/DavLocation.hs
+++ b/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
diff --git a/Types/Distribution.hs b/Types/Distribution.hs
index 80471c067..d19074bf9 100644
--- a/Types/Distribution.hs
+++ b/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
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
diff --git a/debian/control b/debian/control
index 1d012cea0..b34a79002 100644
--- a/debian/control
+++ b/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,
diff --git a/git-annex.cabal b/git-annex.cabal
index 8d8255027..04b43d986 100644
--- a/git-annex.cabal
+++ b/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