packages feed

git-repair 1.20161118 → 1.20170626

raw patch · 39 files changed

+693/−199 lines, 39 filesdep +data-defaultdep +splitdep −MissingH

Dependencies added: data-default, split

Dependencies removed: MissingH

Files

CHANGELOG view
@@ -1,3 +1,11 @@+git-repair (1.20170626) unstable; urgency=medium++  * Merge from git-annex.+  * Removes dependency on MissingH, adding a dependency on split instead.+  * Fixes build with directory-1.3.++ -- Joey Hess <id@joeyh.name>  Mon, 26 Jun 2017 12:15:29 -0400+ git-repair (1.20161118) unstable; urgency=medium    * Fix build with recent versions of cabal and ghc.
Common.hs view
@@ -5,12 +5,12 @@ import Control.Monad as X import Control.Monad.IfElse as X import Control.Applicative as X-import "mtl" Control.Monad.State.Strict as X (liftIO)+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  import System.FilePath as X import System.IO as X hiding (FilePath)@@ -24,12 +24,12 @@ import Utility.SafeCommand as X import Utility.Process as X import Utility.Path as X+import Utility.Directory as X import Utility.Monad as X import Utility.Data as X import Utility.Applicative as X-import Utility.FileSystemEncoding as X import Utility.PosixFiles as X hiding (fileSize) import Utility.FileSize as X-import Utility.Directory as X+import Utility.Split as X  import Utility.PartialPrelude as X
Git/CatFile.hs view
@@ -26,7 +26,6 @@ import qualified Data.Map as M import Data.String import Data.Char-import Data.Tuple.Utils import Numeric import System.Posix.Types @@ -37,6 +36,8 @@ 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/Command.hs view
@@ -53,7 +53,6 @@ pipeReadLazy :: [CommandParam] -> Repo -> IO (String, IO Bool) pipeReadLazy params repo = assertLocal repo $ do 	(_, Just h, _, pid) <- createProcess p { std_out = CreatePipe }-	fileEncoding h 	c <- hGetContents h 	return (c, checkSuccessProcess pid)   where@@ -66,7 +65,6 @@ pipeReadStrict :: [CommandParam] -> Repo -> IO String pipeReadStrict params repo = assertLocal repo $ 	withHandle StdoutHandle (createProcessChecked ignoreFailureProcess) p $ \h -> do-		fileEncoding h 		output <- hGetContentsStrict h 		hClose h 		return output@@ -81,9 +79,7 @@ 	writeReadProcessEnv "git" (toCommand $ gitCommandLine params repo)  		(gitEnv repo) writer (Just adjusthandle)   where-	adjusthandle h = do-		fileEncoding h-		hSetNewlineMode h noNewlineTranslation+	adjusthandle h = hSetNewlineMode h noNewlineTranslation  {- Runs a git command, feeding it input on a handle with an action. -} pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO ()@@ -95,16 +91,16 @@ pipeNullSplit :: [CommandParam] -> Repo -> IO ([String], IO Bool) pipeNullSplit params repo = do 	(s, cleanup) <- pipeReadLazy params repo-	return (filter (not . null) $ split sep s, cleanup)+	return (filter (not . null) $ splitc sep s, cleanup)   where-	sep = "\0"+	sep = '\0'  pipeNullSplitStrict :: [CommandParam] -> Repo -> IO [String] pipeNullSplitStrict params repo = do 	s <- pipeReadStrict params repo-	return $ filter (not . null) $ split sep s+	return $ filter (not . null) $ splitc sep s   where-	sep = "\0"+	sep = '\0'  pipeNullSplitZombie :: [CommandParam] -> Repo -> IO [String] pipeNullSplitZombie params repo = leaveZombie <$> pipeNullSplit params repo
Git/Config.hs view
@@ -79,10 +79,6 @@ {- Reads git config from a handle and populates a repo with it. -} hRead :: Repo -> Handle -> IO Repo hRead repo h = do-	-- We use the FileSystemEncoding when reading from git-config,-	-- because it can contain arbitrary filepaths (and other strings)-	-- in any encoding.-	fileEncoding h 	val <- hGetContentsStrict h 	store val repo @@ -136,7 +132,7 @@ 	-- --list output will have an = in the first line 	| all ('=' `elem`) (take 1 ls) = sep '=' ls 	-- --null --list output separates keys from values with newlines-	| otherwise = sep '\n' $ split "\0" s+	| otherwise = sep '\n' $ splitc '\0' s   where 	ls = lines s 	sep c = M.fromListWith (++) . map (\(k,v) -> (k, [v])) .@@ -167,7 +163,6 @@ fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, String)) fromPipe r cmd params = try $ 	withHandle StdoutHandle createProcessSuccess p $ \h -> do-		fileEncoding h 		val <- hGetContentsStrict h 		r' <- store val r 		return (r', val)
Git/Construct.hs view
@@ -26,7 +26,7 @@ #ifndef mingw32_HOST_OS import System.Posix.User #endif-import qualified Data.Map as M hiding (map, split)+import qualified Data.Map as M import Network.URI  import Common@@ -94,7 +94,7 @@  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 @@ 	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. -}@@ -143,7 +143,7 @@ remoteNamedFromKey k = remoteNamed basename   where 	basename = intercalate "." $ -		reverse $ drop 1 $ reverse $ drop 1 $ split "." k+		reverse $ drop 1 $ reverse $ drop 1 $ splitc '.' k  {- Constructs a new Repo for one of a Repo's remotes using a given  - location (ie, an url). -}
Git/CurrentRepo.hs view
@@ -52,7 +52,7 @@ 		curr <- getCurrentDirectory 		Git.Config.read $ newFrom $ 			Local { gitdir = absd, worktree = Just curr }-	configure Nothing Nothing = error "Not in a git repository."+	configure Nothing Nothing = giveup "Not in a git repository."  	addworktree w r = changelocation r $ 		Local { gitdir = gitdir (location r), worktree = w }
Git/Filename.hs view
@@ -8,9 +8,10 @@  module Git.Filename where +import Common import Utility.Format (decode_c, encode_c) -import Common+import Data.Char  decode :: String -> FilePath decode [] = []@@ -23,6 +24,11 @@ encode :: FilePath -> String encode s = "\"" ++ encode_c s ++ "\"" -{- for quickcheck -}-prop_isomorphic_deencode :: String -> Bool-prop_isomorphic_deencode s = s == decode (encode s)+{- For quickcheck. + -+ - See comment on Utility.Format.prop_encode_c_decode_c_roundtrip for+ - why this only tests chars < 256 -}+prop_encode_decode_roundtrip :: String -> Bool+prop_encode_decode_roundtrip s = s' == decode (encode s')+  where+	s' = filter (\c -> ord c < 256) s
Git/LsTree.hs view
@@ -24,6 +24,7 @@ import qualified Git.Filename  import Numeric+import Data.Char import System.Posix.Types  data TreeItem = TreeItem@@ -66,7 +67,9 @@ 		, File $ fromRef t 		] ++ map File fs -{- Parses a line of ls-tree output.+{- Parses a line of ls-tree output, in format:+ - mode SP type SP sha TAB file+ -  - (The --long format is not currently supported.) -} parseLsTree :: String -> TreeItem parseLsTree l = TreeItem @@ -76,12 +79,9 @@ 	, file = sfile 	}   where-	-- l = <mode> SP <type> SP <sha> TAB <file>-	-- All fields are fixed, so we can pull them out of-	-- specific positions in the line.-	(m, past_m) = splitAt 7 l-	(!t, past_t) = splitAt 4 past_m-	(!s, past_s) = splitAt shaSize $ Prelude.tail past_t-	!f = Prelude.tail past_s+	(m, past_m) = splitAt 7 l -- mode is 6 bytes+	(!t, past_t) = separate isSpace past_m+	(!s, past_s) = splitAt shaSize past_t+	!f = drop 1 past_s 	!smode = fst $ Prelude.head $ readOct m 	!sfile = asTopFilePath $ Git.Filename.decode f
Git/Ref.hs view
@@ -144,6 +144,6 @@ 	ends v = v `isSuffixOf` s 	begins v = v `isPrefixOf` s -	pathbits = split "/" s+	pathbits = splitc '/' s 	illegalchars = " ~^:?*[\\" ++ controlchars 	controlchars = chr 0o177 : [chr 0 .. chr (0o40-1)]
Git/Remote.hs view
@@ -74,9 +74,9 @@ 		(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
Git/Repair.hs view
@@ -39,10 +39,10 @@ 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. -}@@ -614,4 +614,4 @@ safeReadFile :: FilePath -> IO String safeReadFile f = do 	allowRead f-	readFileStrictAnyEncoding f+	readFileStrict f
Git/UpdateIndex.hs view
@@ -55,7 +55,6 @@ startUpdateIndex repo = do 	(Just h, _, _, p) <- createProcess (gitCreateProcess params repo) 		{ std_in = CreatePipe }-	fileEncoding h 	return $ UpdateIndexHandle p h   where 	params = map Param ["update-index", "-z", "--index-info"]
Utility/CoProcess.hs view
@@ -47,10 +47,10 @@ 	rawMode to 	return $ CoProcessState pid to from s   where-	rawMode h = do-		fileEncoding h #ifdef mingw32_HOST_OS-		hSetNewlineMode h noNewlineTranslation+	rawMode h = hSetNewlineMode h noNewlineTranslation+#else+	rawMode _ = return () #endif  stop :: CoProcessHandle -> IO ()
+ Utility/DataUnits.hs view
@@ -0,0 +1,166 @@+{- data size display and parsing+ -+ - Copyright 2011 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -+ -+ - And now a rant: + -+ - In the beginning, we had powers of two, and they were good.+ -+ - Disk drive manufacturers noticed that some powers of two were+ - sorta close to some powers of ten, and that rounding down to the nearest+ - power of ten allowed them to advertise their drives were bigger. This+ - was sorta annoying.+ -+ - Then drives got big. Really, really big. This was good.+ -+ - Except that the small rounding error perpretrated by the drive+ - manufacturers suffered the fate of a small error, and became a large+ - error. This was bad.+ -+ - So, a committee was formed. And it arrived at a committee-like decision,+ - which satisfied noone, confused everyone, and made the world an uglier+ - place. As with all committees, this was meh.+ -+ - And the drive manufacturers happily continued selling drives that are+ - increasingly smaller than you'd expect, if you don't count on your+ - fingers. But that are increasingly too big for anyone to much notice.+ - This caused me to need git-annex.+ -+ - Thus, I use units here that I loathe. Because if I didn't, people would+ - be confused that their drives seem the wrong size, and other people would+ - complain at me for not being standards compliant. And we call this+ - progress?+ -}++module Utility.DataUnits (+	dataUnits,+	storageUnits,+	memoryUnits,+	bandwidthUnits,+	oldSchoolUnits,+	Unit(..),+	ByteSize,++	roughSize,+	roughSize',+	compareSizes,+	readSize+) where++import Data.List+import Data.Char++import Utility.HumanNumber++type ByteSize = Integer+type Name = String+type Abbrev = String+data Unit = Unit ByteSize Abbrev Name+	deriving (Ord, Show, Eq)++dataUnits :: [Unit]+dataUnits = storageUnits ++ memoryUnits++{- Storage units are (stupidly) powers of ten. -}+storageUnits :: [Unit]+storageUnits =+	[ Unit (p 8) "YB" "yottabyte"+	, Unit (p 7) "ZB" "zettabyte"+	, Unit (p 6) "EB" "exabyte"+	, Unit (p 5) "PB" "petabyte"+	, Unit (p 4) "TB" "terabyte"+	, Unit (p 3) "GB" "gigabyte"+	, Unit (p 2) "MB" "megabyte"+	, Unit (p 1) "kB" "kilobyte" -- weird capitalization thanks to committe+	, Unit (p 0) "B" "byte"+	]+  where+	p :: Integer -> Integer+	p n = 1000^n++{- Memory units are (stupidly named) powers of 2. -}+memoryUnits :: [Unit]+memoryUnits =+	[ Unit (p 8) "YiB" "yobibyte"+	, Unit (p 7) "ZiB" "zebibyte"+	, Unit (p 6) "EiB" "exbibyte"+	, Unit (p 5) "PiB" "pebibyte"+	, Unit (p 4) "TiB" "tebibyte"+	, Unit (p 3) "GiB" "gibibyte"+	, Unit (p 2) "MiB" "mebibyte"+	, Unit (p 1) "KiB" "kibibyte"+	, Unit (p 0) "B" "byte"+	]+  where+	p :: Integer -> Integer+	p n = 2^(n*10)++{- Bandwidth units are only measured in bits if you're some crazy telco. -}+bandwidthUnits :: [Unit]+bandwidthUnits = error "stop trying to rip people off"++{- Do you yearn for the days when men were men and megabytes were megabytes? -}+oldSchoolUnits :: [Unit]+oldSchoolUnits = zipWith (curry mingle) storageUnits memoryUnits+  where+	mingle (Unit _ a n, Unit s' _ _) = Unit s' a n++{- approximate display of a particular number of bytes -}+roughSize :: [Unit] -> Bool -> ByteSize -> String+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+	units' = sortBy (flip compare) units -- largest first++	findUnit (u@(Unit s _ _):us) i'+		| i' >= s = showUnit i' u+		| otherwise = findUnit us i'+	findUnit [] i' = showUnit i' (last units') -- bytes++	showUnit x (Unit size abbrev name) = s ++ " " ++ unit+	  where+		v = (fromInteger x :: Double) / fromInteger size+		s = showImprecise precision v+		unit+			| short = abbrev+			| s == "1" = name+			| otherwise = name ++ "s"++{- displays comparison of two sizes -}+compareSizes :: [Unit] -> Bool -> ByteSize -> ByteSize -> String+compareSizes units abbrev old new+	| old > new = roughSize units abbrev (old - new) ++ " smaller"+	| old < new = roughSize units abbrev (new - old) ++ " larger"+	| otherwise = "same"++{- Parses strings like "10 kilobytes" or "0.5tb". -}+readSize :: [Unit] -> String -> Maybe ByteSize+readSize units input+	| null parsednum || null parsedunit = Nothing+	| otherwise = Just $ round $ number * fromIntegral multiplier+  where+	(number, rest) = head parsednum+	multiplier = head parsedunit+	unitname = takeWhile isAlpha $ dropWhile isSpace rest++	parsednum = reads input :: [(Double, String)]+	parsedunit = lookupUnit units unitname++	lookupUnit _ [] = [1] -- no unit given, assume bytes+	lookupUnit [] _ = []+	lookupUnit (Unit s a n:us) v+		| a ~~ v || n ~~ v = [s]+		| plural n ~~ v || a ~~ byteabbrev v = [s]+		| otherwise = lookupUnit us v+		+	a ~~ b = map toLower a == map toLower b+		+	plural n = n ++ "s"+	byteabbrev a = a ++ "b"
Utility/Directory.hs view
@@ -96,10 +96,10 @@ 	go c (dir:dirs) 		| skipdir (takeFileName dir) = go c dirs 		| otherwise = unsafeInterleaveIO $ do-			subdirs <- go c+			subdirs <- go [] 				=<< filterM (isDirectory <$$> getSymbolicLinkStatus) 				=<< catchDefaultIO [] (dirContents dir)-			go (subdirs++[dir]) dirs+			go (subdirs++dir:c) dirs  {- Moves one filename to another.  - First tries a rename, but falls back to moving across devices if needed. -}
Utility/DottedVersion.hs view
@@ -25,7 +25,7 @@ normalize :: String -> DottedVersion normalize v = DottedVersion v $  	sum $ mult 1 $ reverse $ extend precision $ take precision $-		map readi $ split "." v+		map readi $ splitc '.' v   where 	extend n l = l ++ replicate (n - length l) 0 	mult _ [] = []
Utility/Exception.hs view
@@ -1,6 +1,6 @@ {- Simple IO exception handling (and some more)  -- - Copyright 2011-2015 Joey Hess <id@joeyh.name>+ - Copyright 2011-2016 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -10,6 +10,7 @@  module Utility.Exception ( 	module X,+	giveup, 	catchBoolIO, 	catchMaybeIO, 	catchDefaultIO,@@ -39,6 +40,21 @@ import GHC.IO.Exception (IOErrorType(..))  import Utility.Data++{- Like error, this throws an exception. Unlike error, if this exception+ - is not caught, it won't generate a backtrace. So use this for situations+ - 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
Utility/FileMode.hs view
@@ -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 _ 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 @@ 	(\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
Utility/FileSystemEncoding.hs view
@@ -1,6 +1,6 @@ {- GHC File system encoding handling.  -- - Copyright 2012-2014 Joey Hess <id@joeyh.name>+ - Copyright 2012-2016 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -9,9 +9,9 @@ {-# OPTIONS_GHC -fno-warn-tabs #-}  module Utility.FileSystemEncoding (+	useFileSystemEncoding, 	fileEncoding, 	withFilePath,-	md5FilePath, 	decodeBS, 	encodeBS, 	decodeW8,@@ -19,7 +19,10 @@ 	encodeW8NUL, 	decodeW8NUL, 	truncateFilePath,-	setConsoleEncoding,+	s2w8,+	w82s,+	c2w8,+	w82c, ) where  import qualified GHC.Foreign as GHC@@ -27,29 +30,45 @@ 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 -{- Sets a Handle to use the filesystem encoding. This causes data- - written or read from it to be encoded/decoded the same- - as ghc 7.4 does to filenames etc. This special encoding- - allows "arbitrary undecodable bytes to be round-tripped through it".+{- Makes all subsequent Handles that are opened, as well as stdio Handles,+ - use the filesystem encoding, instead of the encoding of the current+ - locale.+ -+ - The filesystem encoding allows "arbitrary undecodable bytes to be+ - round-tripped through it". This avoids encoded failures when data is not+ - encoded matching the current locale.+ -+ - Note that code can still use hSetEncoding to change the encoding of a+ - Handle. This only affects the default encoding.  -}+useFileSystemEncoding :: IO ()+useFileSystemEncoding = do+#ifndef mingw32_HOST_OS+	e <- Encoding.getFileSystemEncoding+#else+	{- The file system encoding does not work well on Windows,+	 - and Windows only has utf FilePaths anyway. -}+	let e = Encoding.utf8+#endif+	hSetEncoding stdin e+	hSetEncoding stdout e+	hSetEncoding stderr e+	Encoding.setLocaleEncoding e	+ fileEncoding :: Handle -> IO () #ifndef mingw32_HOST_OS fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding #else-{- The file system encoding does not work well on Windows,- - and Windows only has utf FilePaths anyway. -} fileEncoding h = hSetEncoding h Encoding.utf8 #endif @@ -83,10 +102,6 @@ 	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@@ -127,15 +142,27 @@  {- 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.  -@@ -165,10 +192,3 @@ 					else go (c:coll) (cnt - x') (L8.drop 1 bs) 			_ -> coll #endif--{- This avoids ghc's output layer crashing on invalid encoded characters in- - filenames when printing them out. -}-setConsoleEncoding :: IO ()-setConsoleEncoding = do-	fileEncoding stdout-	fileEncoding stderr
Utility/Format.hs view
@@ -11,7 +11,7 @@ 	format, 	decode_c, 	encode_c,-	prop_isomorphic_deencode+	prop_encode_c_decode_c_roundtrip ) where  import Text.Printf (printf)@@ -100,8 +100,8 @@ empty (Const "") = True empty _ = False -{- Decodes a C-style encoding, where \n is a newline, \NNN is an octal- - encoded character, and \xNN is a hex encoded character.+{- Decodes a C-style encoding, where \n is a newline (etc),+ - \NNN is an octal encoded character, and \xNN is a hex encoded character.  -} decode_c :: FormatString -> String decode_c [] = []@@ -173,6 +173,15 @@ 	e_asc c = showoctal $ ord c 	showoctal i = '\\' : printf "%03o" i -{- for quickcheck -}-prop_isomorphic_deencode :: String -> Bool-prop_isomorphic_deencode s = s == decode_c (encode_c s)+{- 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".+ -+ - This property papers over the problem, by only testing chars < 256.+ -}+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
+ Utility/HumanNumber.hs view
@@ -0,0 +1,21 @@+{- numbers for humans+ -+ - Copyright 2012-2013 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++module Utility.HumanNumber where++{- Displays a fractional value as a string with a limited number+ - of decimal digits. -}+showImprecise :: RealFrac a => Int -> a -> String+showImprecise precision n+	| precision == 0 || remainder == 0 = show (round n :: Integer)+	| otherwise = show int ++ "." ++ striptrailing0s (pad0s $ show remainder)+  where+	int :: Integer+	(int, frac) = properFraction n+	remainder = round (frac * 10 ^ precision) :: Integer+	pad0s s = replicate (precision - length s) '0' ++ s+	striptrailing0s = reverse . dropWhile (== '0') . reverse
+ Utility/HumanTime.hs view
@@ -0,0 +1,102 @@+{- Time for humans.+ -+ - Copyright 2012-2013 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++module Utility.HumanTime (+	Duration(..),+	durationSince,+	durationToPOSIXTime,+	durationToDays,+	daysToDuration,+	parseDuration,+	fromDuration,+	prop_duration_roundtrips+) where++import Utility.PartialPrelude+import Utility.QuickCheck++import qualified Data.Map as M+import Data.Time.Clock+import Data.Time.Clock.POSIX (POSIXTime)+import Data.Char+import Control.Applicative+import Prelude++newtype Duration = Duration { durationSeconds :: Integer }+	deriving (Eq, Ord, Read, Show)++durationSince :: UTCTime -> IO Duration+durationSince pasttime = do+	now <- getCurrentTime+	return $ Duration $ round $ diffUTCTime now pasttime++durationToPOSIXTime :: Duration -> POSIXTime+durationToPOSIXTime = fromIntegral . durationSeconds++durationToDays :: Duration -> Integer+durationToDays d = durationSeconds d `div` dsecs++daysToDuration :: Integer -> Duration+daysToDuration i = Duration $ i * dsecs++{- Parses a human-input time duration, of the form "5h", "1m", "5h1m", etc -}+parseDuration :: Monad m => String -> m Duration+parseDuration = maybe parsefail (return . Duration) . go 0+  where+	go n [] = return n+	go n s = do+		num <- readish s :: Maybe Integer+		case dropWhile isDigit s of+			(c:rest) -> do+				u <- M.lookup c unitmap+				go (n + num * u) rest+			_ -> return $ n + num+	parsefail = fail "duration parse error; expected eg \"5m\" or \"1h5m\""++fromDuration :: Duration -> String+fromDuration Duration { durationSeconds = d }+	| d == 0 = "0s"+	| otherwise = concatMap showunit $ go [] units d+  where+	showunit (u, n)+		| n > 0 = show n ++ [u]+		| otherwise = ""+	go c [] _ = reverse c+	go c ((u, n):us) v =+		let (q,r) = v `quotRem` n+		in go ((u, q):c) us r++units :: [(Char, Integer)]+units = +	[ ('y', ysecs)+	, ('d', dsecs)+	, ('h', hsecs)+	, ('m', msecs)+	, ('s', 1)+	]++unitmap :: M.Map Char Integer+unitmap = M.fromList units++ysecs :: Integer+ysecs = dsecs * 365++dsecs :: Integer+dsecs = hsecs * 24++hsecs :: Integer+hsecs = msecs * 60++msecs :: Integer+msecs = 60++-- Durations cannot be negative.+instance Arbitrary Duration where+	arbitrary = Duration <$> nonNegative arbitrary++prop_duration_roundtrips :: Duration -> Bool+prop_duration_roundtrips d = parseDuration (fromDuration d) == Just d
Utility/Metered.hs view
@@ -1,15 +1,19 @@ {- Metered IO and actions  -- - Copyright 2012-2106 Joey Hess <id@joeyh.name>+ - Copyright 2012-2016 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -} -{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE TypeSynonymInstances, BangPatterns #-}  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 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)@@ -85,12 +88,15 @@  {- Writes a ByteString to a Handle, updating a meter as it's written. -} meteredWrite :: MeterUpdate -> Handle -> L.ByteString -> IO ()-meteredWrite meterupdate h = go zeroBytesProcessed . L.toChunks +meteredWrite meterupdate h = void . meteredWrite' meterupdate h++meteredWrite' :: MeterUpdate -> Handle -> L.ByteString -> IO BytesProcessed+meteredWrite' meterupdate h = go zeroBytesProcessed . L.toChunks    where-	go _ [] = return ()+	go sofar [] = return sofar 	go sofar (c:cs) = do 		S.hPut h c-		let sofar' = addBytesProcessed sofar $ S.length c+		let !sofar' = addBytesProcessed sofar $ S.length c 		meterupdate sofar' 		go sofar' cs @@ -112,30 +118,30 @@  - meter updates, so use caution.  -} hGetContentsMetered :: Handle -> MeterUpdate -> IO L.ByteString-hGetContentsMetered h = hGetUntilMetered h (const True)+hGetContentsMetered h = hGetMetered h Nothing -{- Reads from the Handle, updating the meter after each chunk.+{- Reads from the Handle, updating the meter after each chunk is read.  -+ - Stops at EOF, or when the requested number of bytes have been read.+ - Closes the Handle at EOF, but otherwise leaves it open.+ -  - Note that the meter update is run in unsafeInterleaveIO, which means that  - it can be run at any time. It's even possible for updates to run out  - of order, as different parts of the ByteString are consumed.- -- - Stops at EOF, or when keepgoing evaluates to False.- - Closes the Handle at EOF, but otherwise leaves it open.  -}-hGetUntilMetered :: Handle -> (Integer -> Bool) -> MeterUpdate -> IO L.ByteString-hGetUntilMetered h keepgoing meterupdate = lazyRead zeroBytesProcessed+hGetMetered :: Handle -> Maybe Integer -> MeterUpdate -> IO L.ByteString+hGetMetered h wantsize meterupdate = lazyRead zeroBytesProcessed   where 	lazyRead sofar = unsafeInterleaveIO $ loop sofar  	loop sofar = do-		c <- S.hGet h defaultChunkSize+		c <- S.hGet h (nextchunksize (fromBytesProcessed sofar)) 		if S.null c 			then do 				hClose h 				return $ L.empty 			else do-				let sofar' = addBytesProcessed sofar (S.length c)+				let !sofar' = addBytesProcessed sofar (S.length c) 				meterupdate sofar' 				if keepgoing (fromBytesProcessed sofar') 					then do@@ -145,6 +151,18 @@ 						cs <- lazyRead sofar' 						return $ L.append (L.fromChunks [c]) cs 					else return $ L.fromChunks [c]+	+	keepgoing n = case wantsize of+		Nothing -> True+		Just sz -> n < sz+	+	nextchunksize n = case wantsize of+		Nothing -> defaultChunkSize+		Just sz -> +			let togo = sz - n+			in if togo < toInteger defaultChunkSize+				then fromIntegral togo+				else defaultChunkSize  {- Same default chunk size Lazy ByteStrings use. -} defaultChunkSize :: Int@@ -153,22 +171,27 @@ 	k = 1024 	chunkOverhead = 2 * sizeOf (1 :: Int) -- GHC specific -{- Runs an action, watching a file as it grows and updating the meter. -}+{- Runs an action, watching a file as it grows and updating the meter.+ -+ - The file may already exist, and the action could throw the original file+ - away and start over. To avoid reporting the original file size followed+ - by a smaller size in that case, wait until the file starts growing+ - before updating the meter for the first time.+ -} watchFileSize :: (MonadIO m, MonadMask m) => FilePath -> MeterUpdate -> m a -> m a watchFileSize f p a = bracket -	(liftIO $ forkIO $ watcher zeroBytesProcessed)+	(liftIO $ forkIO $ watcher =<< getsz) 	(liftIO . void . tryIO . killThread) 	(const a)   where 	watcher oldsz = do-		v <- catchMaybeIO $ toBytesProcessed <$> getFileSize f-		newsz <- case v of-			Just sz | sz /= oldsz -> do-				p sz-				return sz-			_ -> return oldsz 		threadDelay 500000 -- 0.5 seconds-		watcher newsz+		sz <- getsz+		when (sz > oldsz) $+			p sz+		watcher sz+	getsz = catchDefaultIO zeroBytesProcessed $+		toBytesProcessed <$> getFileSize f  data OutputHandler = OutputHandler 	{ quietMode :: Bool@@ -201,7 +224,7 @@ 				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@@ -282,3 +305,77 @@ 					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 view
@@ -10,9 +10,6 @@  module Utility.Misc where -import Utility.FileSystemEncoding-import Utility.Monad- import System.IO import Control.Monad import Foreign@@ -34,20 +31,6 @@ {- A version of readFile that is not lazy. -} readFileStrict :: FilePath -> IO String readFileStrict = readFile >=> \s -> length s `seq` return s--{-  Reads a file strictly, and using the FileSystemEncoding, so it will- -  never crash on a badly encoded file. -}-readFileStrictAnyEncoding :: FilePath -> IO String-readFileStrictAnyEncoding f = withFile f ReadMode $ \h -> do-	fileEncoding h-	hClose h `after` hGetContentsStrict h--{- Writes a file, using the FileSystemEncoding so it will never crash- - on a badly encoded content string. -}-writeFileAnyEncoding :: FilePath -> String -> IO ()-writeFileAnyEncoding f content = withFile f WriteMode $ \h -> do-	fileEncoding h-	hPutStr h content  {- Like break, but the item matching the condition is not included  - in the second result list.
Utility/PartialPrelude.hs view
@@ -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 #-}
Utility/Path.hs view
@@ -10,7 +10,6 @@  module Utility.Path where -import Data.String.Utils import System.FilePath import Data.List import Data.Maybe@@ -25,10 +24,10 @@ import Utility.Exception #endif -import qualified "MissingH" System.Path as MissingH 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.@@ -68,18 +67,6 @@ 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 +76,13 @@ 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@@ -149,11 +137,11 @@ 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 = sp from+	pto = sp to+	sp = map dropTrailingPathSeparator . splitPath 	common = map fst $ takeWhile same $ zip pfrom pto 	same (c,d) = c == d 	uncommon = drop numcommon pto@@ -227,6 +215,8 @@  -  - 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
+ Utility/Percentage.hs view
@@ -0,0 +1,33 @@+{- percentages+ -+ - Copyright 2012 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++module Utility.Percentage (+	Percentage,+	percentage,+	showPercentage+) where++import Data.Ratio++import Utility.HumanNumber++newtype Percentage = Percentage (Ratio Integer)++instance Show Percentage where+	show = showPercentage 0++{- Normally the big number comes first. But 110% is allowed if desired. :) -}+percentage :: Integer -> Integer -> Percentage+percentage 0 _ = Percentage 0+percentage full have = Percentage $ have * 100 % full++{- Pretty-print a Percentage, with a specified level of precision. -}+showPercentage :: Int -> Percentage -> String+showPercentage precision (Percentage p) = v ++ "%"+  where+	v = showImprecise precision n+	n = fromRational p :: Double
Utility/Process.hs view
@@ -174,22 +174,21 @@ -- 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 @@ 	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)
Utility/QuickCheck.hs view
@@ -35,9 +35,6 @@ instance Arbitrary POSIXTime where 	arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral -instance Arbitrary EpochTime where-	arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral- {- Pids are never negative, or 0. -} instance Arbitrary ProcessID where 	arbitrary = arbitrarySizedBoundedIntegral `suchThat` (> 0)
Utility/Rsync.hs view
@@ -11,10 +11,10 @@  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. -}@@ -24,7 +24,7 @@ 	{- rsync requires some weird, non-shell like quoting in 	- here. A doubled single quote inside the single quoted 	- string is a single quote. -}-	escape s = "'" ++  intercalate "''" (split "'" s) ++ "'"+	escape s = "'" ++  intercalate "''" (splitc '\'' s) ++ "'"  {- Runs rsync in server mode to send a file. -} rsyncServerSend :: [CommandParam] -> FilePath -> IO Bool@@ -123,7 +123,7 @@ 	{- Find chunks that each start with delim. 	 - The first chunk doesn't start with it 	 - (it's empty when delim is at the start of the string). -}-	progresschunks = drop 1 . split [delim]+	progresschunks = drop 1 . splitc delim 	findbytesstart s = dropWhile isSpace s  	parsebytes :: String -> Maybe Integer
Utility/SafeCommand.hs view
@@ -11,7 +11,7 @@  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 f = "'" ++ escaped ++ "'"   where 	-- replace ' with '"'"'-	escaped = intercalate "'\"'\"'" $ split "'" f+	escaped = intercalate "'\"'\"'" $ splitc '\'' f  -- | Unescapes a set of shellEscaped words or filenames. shellUnEscape :: String -> [String]
+ Utility/Split.hs view
@@ -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/SystemDirectory.hs view
@@ -13,4 +13,4 @@ 	module System.Directory ) where -import System.Directory hiding (isSymbolicLink)+import System.Directory hiding (isSymbolicLink, getFileSize)
+ Utility/Tuple.hs view
@@ -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
− Utility/URI.hs 
@@ -1,18 +0,0 @@-{- Network.URI- -- - Copyright 2014 Joey Hess <id@joeyh.name>- -- - License: BSD-2-clause- -}--{-# LANGUAGE CPP #-}--module Utility.URI where---- Old versions of network lacked an Ord for URI-#if ! MIN_VERSION_network(2,4,0)-import Network.URI--instance Ord URI where-	a `compare` b = show a `compare` show b-#endif
Utility/UserInfo.hs view
@@ -16,6 +16,7 @@  import Utility.Env import Utility.Data+import Utility.Exception  import System.PosixCompat import Control.Applicative@@ -25,7 +26,7 @@  -  - getpwent will fail on LDAP or NIS, so use HOME if set. -} myHomeDir :: IO FilePath-myHomeDir = either error return =<< myVal env homeDirectory+myHomeDir = either giveup return =<< myVal env homeDirectory   where #ifndef mingw32_HOST_OS 	env = ["HOME"]
git-repair.cabal view
@@ -1,5 +1,5 @@ Name: git-repair-Version: 1.20161118+Version: 1.20170626 Cabal-Version: >= 1.8 License: GPL Maintainer: Joey Hess <joey@kitenet.net>@@ -30,7 +30,7 @@   Default: True  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,     mtl, Cabal @@ -41,10 +41,11 @@ Executable git-repair   Main-Is: git-repair.hs   GHC-Options: -threaded -Wall -fno-warn-tabs-  Build-Depends: MissingH, hslogger, directory, filepath, containers, mtl,+  Build-Depends: split, hslogger, directory, filepath, containers, mtl,    unix-compat, bytestring, exceptions (>= 0.6), transformers,    base >= 4.5, base < 5, IfElse, text, process, time, QuickCheck,-   utf8-string, async, optparse-applicative (>= 0.10.0)+   utf8-string, async, optparse-applicative (>= 0.10.0),+   data-default    if flag(network-uri)     Build-Depends: network-uri (>= 2.6), network (>= 2.6)@@ -91,6 +92,7 @@     Utility.Batch     Utility.CoProcess     Utility.Data+    Utility.DataUnits     Utility.Directory     Utility.DottedVersion     Utility.Env@@ -99,19 +101,23 @@     Utility.FileSize     Utility.FileSystemEncoding     Utility.Format+    Utility.HumanNumber+    Utility.HumanTime     Utility.Metered     Utility.Misc     Utility.Monad     Utility.PartialPrelude     Utility.Path+    Utility.Percentage     Utility.PosixFiles     Utility.Process     Utility.Process.Shim     Utility.QuickCheck     Utility.Rsync     Utility.SafeCommand+    Utility.Split     Utility.SystemDirectory     Utility.ThreadScheduler     Utility.Tmp-    Utility.URI+    Utility.Tuple     Utility.UserInfo
git-repair.hs view
@@ -15,6 +15,7 @@ import qualified Git.Destroyer import qualified Git.Fsck import Utility.Tmp+import Utility.FileSystemEncoding  data Settings = Settings 	{ forced :: Bool@@ -46,7 +47,9 @@ 		)  main :: IO ()-main = execParser opts >>= go+main = do+	useFileSystemEncoding+	execParser opts >>= go   where 	opts = info (helper <*> parseSettings) desc 	desc = fullDesc