packages feed

git-repair 1.20210111 → 1.20210629

raw patch · 26 files changed

+487/−212 lines, 26 files

Files

Build/TestConfig.hs view
@@ -97,7 +97,7 @@  - the command. -} findCmdPath :: ConfigKey -> String -> Test findCmdPath k command = do-	ifM (inPath command)+	ifM (inSearchPath command) 		( return $ Config k $ MaybeStringConfig $ Just command 		, do 			r <- getM find ["/usr/sbin", "/sbin", "/usr/local/sbin"]
CHANGELOG view
@@ -1,3 +1,12 @@+git-repair (1.20210629) unstable; urgency=medium++  * Fixed bug that interrupting the program while it was fixing repository+    corruption would lose objects that were contained in pack files.+  * Fix reversion in version 1.20200504 that prevented fetching+    missing objects from remotes.++ -- Joey Hess <id@joeyh.name>  Tue, 29 Jun 2021 13:29:10 -0400+ git-repair (1.20210111) unstable; urgency=medium    * Improve output to not give the impression it's stalled running fsck
Git.hs view
@@ -3,7 +3,7 @@  - This is written to be completely independant of git-annex and should be  - suitable for other uses.  -- - Copyright 2010-2020 Joey Hess <id@joeyh.name>+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -55,6 +55,7 @@ repoDescribe :: Repo -> String repoDescribe Repo { remoteName = Just name } = name repoDescribe Repo { location = Url url } = show url+repoDescribe Repo { location = UnparseableUrl url } = url repoDescribe Repo { location = Local { worktree = Just dir } } = fromRawFilePath dir repoDescribe Repo { location = Local { gitdir = dir } } = fromRawFilePath dir repoDescribe Repo { location = LocalUnknown dir } = fromRawFilePath dir@@ -63,13 +64,14 @@ {- Location of the repo, either as a path or url. -} repoLocation :: Repo -> String repoLocation Repo { location = Url url } = show url+repoLocation Repo { location = UnparseableUrl url } = url repoLocation Repo { location = Local { worktree = Just dir } } = fromRawFilePath dir repoLocation Repo { location = Local { gitdir = dir } } = fromRawFilePath dir repoLocation Repo { location = LocalUnknown dir } = fromRawFilePath dir repoLocation Repo { location = Unknown } = error "unknown repoLocation"  {- Path to a repository. For non-bare, this is the worktree, for bare, - - it's the gitdir, and for URL repositories, is the path on the remote+ - it's the gitdit, and for URL repositories, is the path on the remote  - host. -} repoPath :: Repo -> RawFilePath repoPath Repo { location = Url u } = toRawFilePath $ unEscapeString $ uriPath u@@ -77,6 +79,7 @@ repoPath Repo { location = Local { gitdir = d } } = d repoPath Repo { location = LocalUnknown dir } = dir repoPath Repo { location = Unknown } = error "unknown repoPath"+repoPath Repo { location = UnparseableUrl _u } = error "unknwon repoPath"  repoWorkTree :: Repo -> Maybe RawFilePath repoWorkTree Repo { location = Local { worktree = Just d } } = Just d@@ -91,6 +94,7 @@  - or bare and non-bare, these functions help with that. -} repoIsUrl :: Repo -> Bool repoIsUrl Repo { location = Url _ } = True+repoIsUrl Repo { location = UnparseableUrl _ } = True repoIsUrl _ = False  repoIsSsh :: Repo -> Bool
Git/Branch.hs view
@@ -1,6 +1,6 @@ {- git branch stuff  -- - Copyright 2011 Joey Hess <id@joeyh.name>+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -166,7 +166,7 @@  -} commit :: CommitMode -> Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha) commit commitmode allowempty message branch parentrefs repo = do-	tree <- getSha "write-tree" $ pipeReadStrict [Param "write-tree"] repo+	tree <- writeTree repo 	ifM (cancommit tree) 		( do 			sha <- commitTree commitmode message parentrefs tree repo@@ -184,6 +184,19 @@ commitAlways :: CommitMode -> String -> Branch -> [Ref] -> Repo -> IO Sha commitAlways commitmode message branch parentrefs repo = fromJust 	<$> commit commitmode True message branch parentrefs repo++-- Throws exception if the index is locked, with an error message output by+-- git on stderr.+writeTree :: Repo -> IO Sha+writeTree repo = getSha "write-tree" $+	pipeReadStrict [Param "write-tree"] repo++-- Avoids error output if the command fails due to eg, the index being locked.+writeTreeQuiet :: Repo -> IO (Maybe Sha)+writeTreeQuiet repo = extractSha <$> withNullHandle go+  where+	go nullh = pipeReadStrict' (\p -> p { std_err = UseHandle nullh }) +		[Param "write-tree"] repo  commitTree :: CommitMode -> String -> [Ref] -> Ref -> Repo -> IO Sha commitTree commitmode message parentrefs tree repo =
Git/CatFile.hs view
@@ -326,7 +326,7 @@ 		(hClose hin) 		(catObjectReader readObjectContent c hout) 	feeder c h (v, ref) = do-		liftIO $ writeChan c (ref, v)+		writeChan c (ref, v) 		S8.hPutStrLn h (fromRef' ref)  catObjectMetaDataStream
Git/Command.hs view
@@ -70,17 +70,15 @@  - Nonzero exit status is ignored.  -} pipeReadStrict :: [CommandParam] -> Repo -> IO S.ByteString-pipeReadStrict = pipeReadStrict' S.hGetContents+pipeReadStrict = pipeReadStrict' id -{- The reader action must be strict. -}-pipeReadStrict' :: (Handle -> IO a) -> [CommandParam] -> Repo -> IO a-pipeReadStrict' reader params repo = assertLocal repo $ withCreateProcess p go+pipeReadStrict' :: (CreateProcess -> CreateProcess) -> [CommandParam] -> Repo -> IO S.ByteString+pipeReadStrict' fp params repo = assertLocal repo $ withCreateProcess p go   where-	p  = (gitCreateProcess params repo)-		{ std_out = CreatePipe }+	p = fp (gitCreateProcess params repo) { std_out = CreatePipe }  	go _ (Just outh) _ pid = do-		output <- reader outh+		output <- S.hGetContents outh 		hClose outh 		void $ waitForProcess pid 		return output
Git/Construct.hs view
@@ -1,6 +1,6 @@ {- Construction of Git Repo objects  -- - Copyright 2010-2020 Joey Hess <id@joeyh.name>+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -57,54 +57,58 @@  {- Local Repo constructor, accepts a relative or absolute path. -} fromPath :: RawFilePath -> IO Repo-fromPath dir = fromAbsPath =<< absPath dir+fromPath dir+	-- When dir == "foo/.git", git looks for "foo/.git/.git",+	-- and failing that, uses "foo" as the repository.+	| (P.pathSeparator `B.cons` ".git") `B.isSuffixOf` canondir =+		ifM (doesDirectoryExist $ fromRawFilePath dir </> ".git")+			( ret dir+			, ret (P.takeDirectory canondir)+			)+	| otherwise = ifM (doesDirectoryExist (fromRawFilePath dir))+		( checkGitDirFile dir >>= maybe (ret dir) (pure . newFrom)+		-- git falls back to dir.git when dir doesn't+		-- exist, as long as dir didn't end with a+		-- path separator+		, if dir == canondir+			then ret (dir <> ".git")+			else ret dir+		)+  where+	ret = pure . newFrom . LocalUnknown+	canondir = P.dropTrailingPathSeparator dir  {- Local Repo constructor, requires an absolute path to the repo be  - specified. -} fromAbsPath :: RawFilePath -> IO Repo fromAbsPath dir-	| absoluteGitPath dir = hunt+	| absoluteGitPath dir = fromPath dir 	| otherwise = 		error $ "internal error, " ++ show dir ++ " is not absolute"-  where-	ret = pure . newFrom . LocalUnknown-	canondir = P.dropTrailingPathSeparator dir-	{- When dir == "foo/.git", git looks for "foo/.git/.git",-	 - and failing that, uses "foo" as the repository. -}-	hunt-		| (P.pathSeparator `B.cons` ".git") `B.isSuffixOf` canondir =-			ifM (doesDirectoryExist $ fromRawFilePath dir </> ".git")-				( ret dir-				, ret (P.takeDirectory canondir)-				)-		| otherwise = ifM (doesDirectoryExist (fromRawFilePath dir))-			( checkGitDirFile dir >>= maybe (ret dir) (pure . newFrom)-			-- git falls back to dir.git when dir doesn't-			-- exist, as long as dir didn't end with a-			-- path separator-			, if dir == canondir-				then ret (dir <> ".git")-				else ret dir-			) -{- Remote Repo constructor. Throws exception on invalid url.+{- Construct a Repo for a remote's url.  -  - Git is somewhat forgiving about urls to repositories, allowing- - eg spaces that are not normally allowed unescaped in urls.+ - eg spaces that are not normally allowed unescaped in urls. Such+ - characters get escaped.+ -+ - This will always succeed, even if the url cannot be parsed+ - or is invalid, because git can also function despite remotes having+ - such urls, only failing if such a remote is used.  -} fromUrl :: String -> IO Repo fromUrl url-	| not (isURI url) = fromUrlStrict $ escapeURIString isUnescapedInURI url-	| otherwise = fromUrlStrict url+	| not (isURI url) = fromUrl' $ escapeURIString isUnescapedInURI url+	| otherwise = fromUrl' url -fromUrlStrict :: String -> IO Repo-fromUrlStrict url-	| "file://" `isPrefixOf` url = fromAbsPath $ toRawFilePath $-		unEscapeString $ uriPath u-	| otherwise = pure $ newFrom $ Url u-  where-	u = fromMaybe bad $ parseURI url-	bad = error $ "bad url " ++ url+fromUrl' :: String -> IO Repo+fromUrl' url+	| "file://" `isPrefixOf` url = case parseURI url of+		Just u -> fromAbsPath $ toRawFilePath $ unEscapeString $ uriPath u+		Nothing -> pure $ newFrom $ UnparseableUrl url+	| otherwise = case parseURI url of+		Just u -> pure $ newFrom $ Url u+		Nothing -> pure $ newFrom $ UnparseableUrl url  {- Creates a repo that has an unknown location. -} fromUnknown :: Repo@@ -116,24 +120,24 @@ localToUrl reference r 	| not $ repoIsUrl reference = error "internal error; reference repo not url" 	| repoIsUrl r = r-	| otherwise = case Url.authority reference of-		Nothing -> r-		Just auth -> +	| otherwise = case (Url.authority reference, Url.scheme reference) of+		(Just auth, Just s) ->  			let absurl = concat-				[ Url.scheme reference+				[ s 				, "//" 				, auth 				, fromRawFilePath (repoPath r) 				] 			in r { location = Url $ fromJust $ parseURI absurl }+		_ -> r  {- Calculates a list of a repo's configured remotes, by parsing its config. -} fromRemotes :: Repo -> IO [Repo]-fromRemotes repo = mapM construct remotepairs+fromRemotes repo = catMaybes <$> mapM construct remotepairs   where 	filterconfig f = filter f $ M.toList $ config repo 	filterkeys f = filterconfig (\(k,_) -> f k)-	remotepairs = filterkeys isRemoteKey+	remotepairs = filterkeys isRemoteUrlKey 	construct (k,v) = remoteNamedFromKey k $ 		fromRemoteLocation (fromConfigValue v) repo @@ -145,8 +149,10 @@  {- Sets the name of a remote based on the git config key, such as  - "remote.foo.url". -}-remoteNamedFromKey :: ConfigKey -> IO Repo -> IO Repo-remoteNamedFromKey = remoteNamed . remoteKeyToRemoteName+remoteNamedFromKey :: ConfigKey -> IO Repo -> IO (Maybe Repo)+remoteNamedFromKey k r = case remoteKeyToRemoteName k of+	Nothing -> pure Nothing+	Just n -> Just <$> remoteNamed n r  {- Constructs a new Repo for one of a Repo's remotes using a given  - location (ie, an url). -}@@ -187,6 +193,7 @@ 	expandt True ('~':'/':cs) = do 		h <- myHomeDir 		return $ h </> cs+	expandt True "~" = myHomeDir 	expandt True ('~':cs) = do 		let (name, rest) = findname "" cs 		u <- getUserEntryForName name
Git/CurrentRepo.hs view
@@ -10,6 +10,7 @@ module Git.CurrentRepo where  import Common+import Git import Git.Types import Git.Construct import qualified Git.Config@@ -46,12 +47,12 @@ 	wt <- maybe (worktree (location r)) Just 		<$> getpathenvprefix "GIT_WORK_TREE" prefix 	case wt of-		Nothing -> return r+		Nothing -> relPath r 		Just d -> do 			curr <- R.getCurrentDirectory 			unless (d `dirContains` curr) $ 				setCurrentDirectory (fromRawFilePath d)-			return $ addworktree wt r+			relPath $ addworktree wt r   where 	getpathenv s = do 		v <- getEnv s
+ Git/Env.hs view
@@ -0,0 +1,52 @@+{- Adjusting the environment while running git commands.+ -+ - Copyright 2014-2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Git.Env where++import Common+import Git+import Git.Types+import Utility.Env++{- Adjusts the gitEnv of a Repo. Copies the system environment if the repo+ - does not have any gitEnv yet. -}+adjustGitEnv :: Repo -> ([(String, String)] -> [(String, String)]) -> IO Repo+adjustGitEnv g adj = do+	e <- maybe getEnvironment return (gitEnv g)+	let e' = adj e+	return $ g { gitEnv = Just e' }+  where++addGitEnv :: Repo -> String -> String -> IO Repo+addGitEnv g var val = adjustGitEnv g (addEntry var val)++{- Environment variables to use when running a command.+ - Includes GIT_DIR pointing at the repo, and GIT_WORK_TREE when the repo+ - is not bare. Also includes anything added to the Repo's gitEnv,+ - and a copy of the rest of the system environment. -}+propGitEnv :: Repo -> IO [(String, String)]+propGitEnv g = do+	g' <- addGitEnv g "GIT_DIR" (fromRawFilePath (localGitDir g))+	g'' <- maybe (pure g')+		(addGitEnv g' "GIT_WORK_TREE" . fromRawFilePath)+		(repoWorkTree g)+	return $ fromMaybe [] (gitEnv g'')++{- Use with any action that makes a commit to set metadata. -}+commitWithMetaData :: CommitMetaData -> CommitMetaData -> (Repo -> IO a) -> Repo -> IO a+commitWithMetaData authormetadata committermetadata a g =+	a =<< adjustGitEnv g adj+  where+	adj = mkadj "AUTHOR" authormetadata+		. mkadj "COMMITTER" committermetadata+	mkadj p md = go "NAME" commitName+		. go "EMAIL" commitEmail+		. go "DATE" commitDate+	  where+		go s getv = case getv md of+			Nothing -> id+			Just v -> addEntry ("GIT_" ++ p ++ "_" ++ s) v
Git/LsTree.hs view
@@ -1,13 +1,14 @@ {- git ls-tree interface  -- - Copyright 2011-2020 Joey Hess <id@joeyh.name>+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.LsTree ( 	TreeItem(..),-	LsTreeMode(..),+	LsTreeRecursive(..),+	LsTreeLong(..), 	lsTree, 	lsTree', 	lsTreeStrict,@@ -27,6 +28,7 @@  import Numeric import Data.Either+import Data.Char import System.Posix.Types import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L@@ -38,44 +40,55 @@ 	{ mode :: FileMode 	, typeobj :: S.ByteString 	, sha :: Ref+	, size :: Maybe FileSize 	, file :: TopFilePath+	-- ^ only available when long is used 	} deriving (Show) -data LsTreeMode = LsTreeRecursive | LsTreeNonRecursive+data LsTreeRecursive = LsTreeRecursive | LsTreeNonRecursive +{- Enabling --long also gets the size of tree items.+ - This slows down ls-tree some, since it has to look up the size of each+ - blob.+ -}+data LsTreeLong = LsTreeLong Bool+ {- Lists the contents of a tree, with lazy output. -}-lsTree :: LsTreeMode -> Ref -> Repo -> IO ([TreeItem], IO Bool)+lsTree :: LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO ([TreeItem], IO Bool) lsTree = lsTree' [] -lsTree' :: [CommandParam] -> LsTreeMode -> Ref -> Repo -> IO ([TreeItem], IO Bool)-lsTree' ps lsmode t repo = do-	(l, cleanup) <- pipeNullSplit (lsTreeParams lsmode t ps) repo-	return (rights (map parseLsTree l), cleanup)+lsTree' :: [CommandParam] -> LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO ([TreeItem], IO Bool)+lsTree' ps recursive long t repo = do+	(l, cleanup) <- pipeNullSplit (lsTreeParams recursive long t ps) repo+	return (rights (map (parseLsTree long) l), cleanup) -lsTreeStrict :: LsTreeMode -> Ref -> Repo -> IO [TreeItem]+lsTreeStrict :: LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO [TreeItem] lsTreeStrict = lsTreeStrict' [] -lsTreeStrict' :: [CommandParam] -> LsTreeMode -> Ref -> Repo -> IO [TreeItem]-lsTreeStrict' ps lsmode t repo = rights . map parseLsTreeStrict-	<$> pipeNullSplitStrict (lsTreeParams lsmode t ps) repo+lsTreeStrict' :: [CommandParam] -> LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO [TreeItem]+lsTreeStrict' ps recursive long t repo = rights . map (parseLsTreeStrict long)+	<$> pipeNullSplitStrict (lsTreeParams recursive long t ps) repo -lsTreeParams :: LsTreeMode -> Ref -> [CommandParam] -> [CommandParam]-lsTreeParams lsmode r ps =+lsTreeParams :: LsTreeRecursive -> LsTreeLong -> Ref -> [CommandParam] -> [CommandParam]+lsTreeParams recursive long r ps = 	[ Param "ls-tree" 	, Param "--full-tree" 	, Param "-z"-	] ++ recursiveparams ++ ps +++	] ++ recursiveparams ++ longparams ++ ps ++ 	[ Param "--" 	, File $ fromRef r 	]   where-	recursiveparams = case lsmode of+	recursiveparams = case recursive of 		LsTreeRecursive -> [ Param "-r" ] 		LsTreeNonRecursive -> []+	longparams = case long of+		LsTreeLong True -> [ Param "--long" ]+		LsTreeLong False -> []  {- Lists specified files in a tree. -}-lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem]-lsTreeFiles t fs repo = rights . map (parseLsTree . L.fromStrict)+lsTreeFiles :: LsTreeLong -> Ref -> [FilePath] -> Repo -> IO [TreeItem]+lsTreeFiles long t fs repo = rights . map (parseLsTree long . L.fromStrict) 	<$> pipeNullSplitStrict ps repo   where 	ps =@@ -86,41 +99,57 @@ 		, File $ fromRef t 		] ++ map File fs -parseLsTree :: L.ByteString -> Either String TreeItem-parseLsTree b = case A.parse parserLsTree b of+parseLsTree :: LsTreeLong -> L.ByteString -> Either String TreeItem+parseLsTree long b = case A.parse (parserLsTree long) b of 	A.Done _ r  -> Right r 	A.Fail _ _ err -> Left err -parseLsTreeStrict :: S.ByteString -> Either String TreeItem-parseLsTreeStrict b = go (AS.parse parserLsTree b)+parseLsTreeStrict :: LsTreeLong -> S.ByteString -> Either String TreeItem+parseLsTreeStrict long b = go (AS.parse (parserLsTree long) b)   where 	go (AS.Done _ r) = Right r 	go (AS.Fail _ _ err) = Left err 	go (AS.Partial c) = go (c mempty)  {- Parses a line of ls-tree output, in format:- - mode SP type SP sha TAB file+ -   mode SP type SP sha TAB file+ - Or long format:+ -   mode SP type SP sha SPACES size TAB file  -- - (The --long format is not currently supported.) -}-parserLsTree :: A.Parser TreeItem-parserLsTree = TreeItem-	-- mode-	<$> octal-	<* A8.char ' '-	-- type-	<*> A8.takeTill (== ' ')-	<* A8.char ' '-	-- sha-	<*> (Ref <$> A8.takeTill (== '\t'))-	<* A8.char '\t'-	-- file-	<*> (asTopFilePath . Git.Filename.decode <$> A.takeByteString)+ - The TAB can also be a space. Git does not use that, but an earlier+ - version of formatLsTree did, and this keeps parsing what it output+ - working.+ -}+parserLsTree :: LsTreeLong -> A.Parser TreeItem+parserLsTree long = case long of+	LsTreeLong False -> +		startparser <*> pure Nothing <* filesep <*> fileparser+	LsTreeLong True ->+		startparser <* sizesep <*> sizeparser <* filesep <*> fileparser+  where+	startparser = TreeItem+		-- mode+		<$> octal+		<* A8.char ' '+		-- type+		<*> A8.takeTill (== ' ')+		<* A8.char ' '+		-- sha+		<*> (Ref <$> A8.takeTill A8.isSpace) -{- Inverse of parseLsTree -}-formatLsTree :: TreeItem -> String-formatLsTree ti = unwords-	[ showOct (mode ti) ""-	, decodeBS (typeobj ti)-	, fromRef (sha ti)-	, fromRawFilePath (getTopFilePath (file ti))-	]+	fileparser = asTopFilePath . Git.Filename.decode <$> A.takeByteString++	sizeparser = fmap Just A8.decimal++	filesep = A8.space++	sizesep = A.many1 A8.space++{- Inverse of parseLsTree. Note that the long output format is not+ - generated, so any size information is not included. -}+formatLsTree :: TreeItem -> S.ByteString+formatLsTree ti = S.intercalate (S.singleton (fromIntegral (ord ' ')))+	[ encodeBS' (showOct (mode ti) "")+	, typeobj ti+	, fromRef' (sha ti)+	] <> (S.cons (fromIntegral (ord '\t')) (getTopFilePath (file ti)))
Git/Ref.hs view
@@ -64,12 +64,17 @@  {- A Ref that can be used to refer to a file in the repository, as staged  - in the index.- -- - Prefixing the file with ./ makes this work even if in a subdirectory- - of a repo.  -}-fileRef :: RawFilePath -> Ref-fileRef f = Ref $ ":./" <> toInternalGitPath f+fileRef :: RawFilePath -> IO Ref+fileRef f = do+	-- The filename could be absolute, or contain eg "../repo/file",+	-- neither of which work in a ref, so convert it to a minimal+	-- relative path.+	f' <- relPathCwdToFile f+ 	-- Prefixing the file with ./ makes this work even when in a+	-- subdirectory of a repo. Eg, ./foo in directory bar refers+	-- to bar/foo, not to foo in the top of the repository.+	return $ Ref $ ":./" <> toInternalGitPath f'  {- A Ref that can be used to refer to a file in a particular branch. -} branchFileRef :: Branch -> RawFilePath -> Ref@@ -81,10 +86,13 @@  {- A Ref that can be used to refer to a file in the repository as it  - appears in a given Ref. -}-fileFromRef :: Ref -> RawFilePath -> Ref-fileFromRef r f = let (Ref fr) = fileRef f in Ref (fromRef' r <> fr)+fileFromRef :: Ref -> RawFilePath -> IO Ref+fileFromRef r f = do+	(Ref fr) <- fileRef f+	return (Ref (fromRef' r <> fr)) -{- Checks if a ref exists. -}+{- Checks if a ref exists. Note that it must be fully qualified,+ - eg refs/heads/master rather than master. -} exists :: Ref -> Repo -> IO Bool exists ref = runBool 	[ Param "show-ref"
Git/Remote.hs view
@@ -1,6 +1,6 @@ {- git remote stuff  -- - Copyright 2012 Joey Hess <id@joeyh.name>+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -23,15 +23,23 @@ import Git.FilePath #endif -{- Is a git config key one that specifies the location of a remote? -}-isRemoteKey :: ConfigKey -> Bool-isRemoteKey (ConfigKey k) = "remote." `S.isPrefixOf` k && ".url" `S.isSuffixOf` k+{- Is a git config key one that specifies the url of a remote? -}+isRemoteUrlKey :: ConfigKey -> Bool+isRemoteUrlKey = isRemoteKey "url" -{- Get a remote's name from the config key that specifies its location. -}-remoteKeyToRemoteName :: ConfigKey -> RemoteName-remoteKeyToRemoteName (ConfigKey k) = decodeBS' $-	S.intercalate "." $ dropFromEnd 1 $ drop 1 $ S8.split '.' k+isRemoteKey :: S.ByteString -> ConfigKey -> Bool+isRemoteKey want (ConfigKey k) =+	"remote." `S.isPrefixOf` k && ("." <> want) `S.isSuffixOf` k +{- Get a remote's name from the a config key such as remote.name.url+ - or any other per-remote config key. -}+remoteKeyToRemoteName :: ConfigKey -> Maybe RemoteName+remoteKeyToRemoteName (ConfigKey k)+	| "remote." `S.isPrefixOf` k = +		let n = S.intercalate "." $ dropFromEnd 1 $ drop 1 $ S8.split '.' k+		in if S.null n then Nothing else Just (decodeBS' n)+	| otherwise = Nothing+ {- Construct a legal git remote name out of an arbitrary input string.  -  - There seems to be no formal definition of this in the git source,@@ -99,7 +107,9 @@ 			concatMap splitconfigs $ M.toList $ fullconfig repo 		splitconfigs (k, vs) = map (\v -> (k, v)) vs 		(prefix, suffix) = ("url." , ".insteadof")-	urlstyle v = isURI v || ":" `isInfixOf` v && "//" `isInfixOf` v+	-- git supports URIs that contain unescaped characters such as+	-- spaces. So to test if it's a (git) URI, escape those.+	urlstyle v = isURI (escapeURIString isUnescapedInURI v) 	-- git remotes can be written scp style -- [user@]host:dir 	-- but foo::bar is a git-remote-helper location instead 	scpstyle v = ":" `isInfixOf` v
Git/Repair.hs view
@@ -1,6 +1,6 @@ {- git repository recovery  -- - Copyright 2013-2014 Joey Hess <id@joeyh.name>+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -29,6 +29,7 @@ import Git.Types import Git.Fsck import Git.Index+import Git.Env import qualified Git.Config as Config import qualified Git.Construct as Construct import qualified Git.LsTree as LsTree@@ -61,15 +62,14 @@ 		whenM (isMissing s r) $ 			removeLoose s -{- Explodes all pack files, and deletes them.- -- - First moves all pack files to a temp dir, before unpacking them each in- - turn.+{- Explodes all pack files to loose objects, and deletes the pack files.  -- - This is because unpack-objects will not unpack a pack file if it's in the- - git repo.+ - git unpack-objects will not unpack objects from a pack file that are+ - in the git repo. So, GIT_OBJECT_DIRECTORY is pointed to a temporary+ - directory, and the loose objects then are moved into place, before+ - deleting the pack files.  -- - Also, this prevents unpack-objects from possibly looking at corrupt+ - Also, that prevents unpack-objects from possibly looking at corrupt  - pack files to see if they contain an object, while unpacking a  - non-corrupt pack file.  -}@@ -78,18 +78,28 @@   where 	go [] = return False 	go packs = withTmpDir "packs" $ \tmpdir -> do+		r' <- addGitEnv r "GIT_OBJECT_DIRECTORY" tmpdir 		putStrLn "Unpacking all pack files." 		forM_ packs $ \packfile -> do-			moveFile packfile (tmpdir </> takeFileName packfile)-			removeWhenExistsWith R.removeLink-				(packIdxFile (toRawFilePath packfile))-		forM_ packs $ \packfile -> do-			let tmp = tmpdir </> takeFileName packfile-			allowRead (toRawFilePath tmp)+			-- Just in case permissions are messed up.+			allowRead (toRawFilePath packfile) 			-- May fail, if pack file is corrupt. 			void $ tryIO $-				pipeWrite [Param "unpack-objects", Param "-r"] r $ \h ->-				L.hPut h =<< L.readFile tmp+				pipeWrite [Param "unpack-objects", Param "-r"] r' $ \h ->+				L.hPut h =<< L.readFile packfile+		objs <- dirContentsRecursive tmpdir+		forM_ objs $ \objfile -> do+			f <- relPathDirToFile+				(toRawFilePath tmpdir)+				(toRawFilePath objfile)+			let dest = objectsDir r P.</> f+			createDirectoryIfMissing True+				(fromRawFilePath (parentDir dest))+			moveFile objfile (fromRawFilePath dest)+		forM_ packs $ \packfile -> do+			let f = toRawFilePath packfile+			removeWhenExistsWith R.removeLink f+			removeWhenExistsWith R.removeLink (packIdxFile f) 		return True  {- Try to retrieve a set of missing objects, from the remotes of a@@ -105,7 +115,10 @@ 	| otherwise = withTmpDir "tmprepo" $ \tmpdir -> do 		unlessM (boolSystem "git" [Param "init", File tmpdir]) $ 			error $ "failed to create temp repository in " ++ tmpdir-		tmpr <- Config.read =<< Construct.fromAbsPath (toRawFilePath tmpdir)+		tmpr <- Config.read =<< Construct.fromPath (toRawFilePath tmpdir)+		let repoconfig r' = fromRawFilePath (localGitDir r' P.</> "config")+		whenM (doesFileExist (repoconfig r)) $+			L.readFile (repoconfig r) >>= L.writeFile (repoconfig tmpr) 		rs <- Construct.fromRemotes r 		stillmissing <- pullremotes tmpr rs fetchrefstags missing 		if S.null (knownMissing stillmissing)@@ -351,8 +364,9 @@ verifyTree missing treesha r 	| S.member treesha missing = return False 	| otherwise = do-		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams LsTree.LsTreeRecursive treesha []) r-		let objshas = mapMaybe (LsTree.sha <$$> eitherToMaybe . LsTree.parseLsTree) ls+		let nolong = LsTree.LsTreeLong False+		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams LsTree.LsTreeRecursive nolong treesha []) r+		let objshas = mapMaybe (LsTree.sha <$$> eitherToMaybe . LsTree.parseLsTree nolong) ls 		if any (`S.member` missing) objshas 			then do 				void cleanup
Git/Types.hs view
@@ -34,6 +34,7 @@ 	= Local { gitdir :: RawFilePath, worktree :: Maybe RawFilePath } 	| LocalUnknown RawFilePath 	| Url URI+	| UnparseableUrl String 	| Unknown 	deriving (Show, Eq, Ord)
Git/Url.hs view
@@ -1,6 +1,6 @@ {- git repository urls  -- - Copyright 2010, 2011 Joey Hess <id@joeyh.name>+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -18,12 +18,11 @@  import Common import Git.Types-import Git  {- Scheme of an URL repo. -}-scheme :: Repo -> String-scheme Repo { location = Url u } = uriScheme u-scheme repo = notUrl repo+scheme :: Repo -> Maybe String+scheme Repo { location = Url u } = Just (uriScheme u)+scheme _ = Nothing  {- Work around a bug in the real uriRegName  - <http://trac.haskell.org/network/ticket/40> -}@@ -65,13 +64,9 @@ {- Applies a function to extract part of the uriAuthority of an URL repo. -} authpart :: (URIAuth -> a) -> Repo -> Maybe a authpart a Repo { location = Url u } = a <$> uriAuthority u-authpart _ repo = notUrl repo+authpart _ _ = Nothing  {- Path part of an URL repo. -}-path :: Repo -> FilePath-path Repo { location = Url u } = uriPath u-path repo = notUrl repo--notUrl :: Repo -> a-notUrl repo = error $-	"acting on local git repo " ++ repoDescribe repo ++ " not supported"+path :: Repo -> Maybe FilePath+path Repo { location = Url u } = Just (uriPath u)+path _ = Nothing
Utility/Batch.hs view
@@ -57,7 +57,7 @@ getBatchCommandMaker :: IO BatchCommandMaker getBatchCommandMaker = do #ifndef mingw32_HOST_OS-	nicers <- filterM (inPath . fst)+	nicers <- filterM (inSearchPath . fst) 		[ ("nice", []) 		, ("ionice", ["-c3"]) 		, ("nocache", [])
+ Utility/Debug.hs view
@@ -0,0 +1,102 @@+{- Debug output+ -+ - Copyright 2021 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++{-# LANGUAGE OverloadedStrings, FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -fno-warn-tabs -w #-}++module Utility.Debug (+	DebugSource(..),+	DebugSelector(..),+	configureDebug,+	getDebugSelector,+	debug,+	fastDebug+) where++import qualified Data.ByteString as S+import Data.IORef+import Data.String+import Data.Time+import System.IO.Unsafe (unsafePerformIO)+import qualified Data.Semigroup as Sem+import Prelude++import Utility.FileSystemEncoding++-- | The source of a debug message. For example, this could be a module or+-- function name.+newtype DebugSource = DebugSource S.ByteString+	deriving (Eq, Show)++instance IsString DebugSource where+	fromString = DebugSource . encodeBS'++-- | Selects whether to display a message from a source.+data DebugSelector +	= DebugSelector (DebugSource -> Bool)+	| NoDebugSelector++instance Sem.Semigroup DebugSelector where+	DebugSelector a <> DebugSelector b = DebugSelector (\v -> a v || b v)+	NoDebugSelector <> NoDebugSelector = NoDebugSelector+	NoDebugSelector <> b = b+	a <> NoDebugSelector = a++instance Monoid DebugSelector where+	mempty = NoDebugSelector++-- | Configures debugging.+configureDebug+	:: (S.ByteString -> IO ())+	-- ^ Used to display debug output.+	-> DebugSelector+	-> IO ()+configureDebug src p = writeIORef debugConfigGlobal (src, p)++-- | Gets the currently configured DebugSelector.+getDebugSelector :: IO DebugSelector+getDebugSelector = snd <$> readIORef debugConfigGlobal++-- A global variable for the debug configuration.+{-# NOINLINE debugConfigGlobal #-}+debugConfigGlobal :: IORef (S.ByteString -> IO (), DebugSelector)+debugConfigGlobal = unsafePerformIO $ newIORef (dontshow, selectnone)+  where+	dontshow _ = return ()+	selectnone = NoDebugSelector++-- | Displays a debug message, if that has been enabled by configureDebug.+--+-- This is reasonably fast when debugging is not enabled, but since it does+-- have to consult a IORef each time, using it in a tight loop may slow+-- down the program.+debug :: DebugSource -> String -> IO ()+debug src msg = readIORef debugConfigGlobal >>= \case+	(displayer, NoDebugSelector) ->+		displayer =<< formatDebugMessage src msg+	(displayer, DebugSelector p)+		| p src -> displayer =<< formatDebugMessage src msg+		| otherwise -> return ()++-- | Displays a debug message, if the DebugSelector allows.+--+-- When the DebugSelector does not let the message be displayed, this runs+-- very quickly, allowing it to be used inside tight loops.+fastDebug :: DebugSelector -> DebugSource -> String -> IO ()+fastDebug NoDebugSelector src msg = do+	(displayer, _) <- readIORef debugConfigGlobal+	displayer =<< formatDebugMessage src msg+fastDebug (DebugSelector p) src msg+	| p src = fastDebug NoDebugSelector src msg+	| otherwise = return ()++formatDebugMessage :: DebugSource -> String -> IO S.ByteString+formatDebugMessage (DebugSource src) msg = do+	t <- encodeBS' . formatTime defaultTimeLocale "[%F %X%Q]"+		<$> getZonedTime+	return (t <> " (" <> src <> ") " <> encodeBS msg)
Utility/Exception.hs view
@@ -39,7 +39,7 @@  {- 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 expeected to see in some+ - where there's a problem that the user is expected to see in some  - circumstances. -} giveup :: [Char] -> a giveup = errorWithoutStackTrace
Utility/InodeCache.hs view
@@ -24,6 +24,7 @@ 	showInodeCache, 	genInodeCache, 	toInodeCache,+	toInodeCache',  	InodeCacheKey, 	inodeCacheToKey,@@ -189,7 +190,10 @@ 	toInodeCache delta f =<< R.getFileStatus f  toInodeCache :: TSDelta -> RawFilePath -> FileStatus -> IO (Maybe InodeCache)-toInodeCache (TSDelta getdelta) f s+toInodeCache d f s = toInodeCache' d f s (fileID s)++toInodeCache' :: TSDelta -> RawFilePath -> FileStatus -> FileID -> IO (Maybe InodeCache)+toInodeCache' (TSDelta getdelta) f s inode 	| isRegularFile s = do 		delta <- getdelta 		sz <- getFileSize' f s@@ -198,7 +202,7 @@ #else 		let mtime = modificationTimeHiRes s #endif-		return $ Just $ InodeCache $ InodeCachePrim (fileID s) sz (MTimeHighRes (mtime + highResTime delta))+		return $ Just $ InodeCache $ InodeCachePrim inode sz (MTimeHighRes (mtime + highResTime delta)) 	| otherwise = pure Nothing  {- Some filesystem get new random inodes each time they are mounted.
Utility/Metered.hs view
@@ -1,6 +1,6 @@ {- Metered IO and actions  -- - Copyright 2012-2020 Joey Hess <id@joeyh.name>+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -118,23 +118,24 @@ withMeteredFile f meterupdate a = withBinaryFile f ReadMode $ \h -> 	hGetContentsMetered h meterupdate >>= a -{- Writes a ByteString to a Handle, updating a meter as it's written. -}-meteredWrite :: MeterUpdate -> Handle -> L.ByteString -> IO ()-meteredWrite meterupdate h = void . meteredWrite' meterupdate h+{- Calls the action repeatedly with chunks from the lazy ByteString.+ - Updates the meter after each chunk is processed. -}+meteredWrite :: MeterUpdate -> (S.ByteString -> IO ()) -> L.ByteString -> IO ()+meteredWrite meterupdate a = void . meteredWrite' meterupdate a -meteredWrite' :: MeterUpdate -> Handle -> L.ByteString -> IO BytesProcessed-meteredWrite' meterupdate h = go zeroBytesProcessed . L.toChunks +meteredWrite' :: MeterUpdate -> (S.ByteString -> IO ()) -> L.ByteString -> IO BytesProcessed+meteredWrite' meterupdate a = go zeroBytesProcessed . L.toChunks    where 	go sofar [] = return sofar 	go sofar (c:cs) = do-		S.hPut h c+		a c 		let !sofar' = addBytesProcessed sofar $ S.length c 		meterupdate sofar' 		go sofar' cs  meteredWriteFile :: MeterUpdate -> FilePath -> L.ByteString -> IO () meteredWriteFile meterupdate f b = withBinaryFile f WriteMode $ \h ->-	meteredWrite meterupdate h b+	meteredWrite meterupdate (S.hPut h) b  {- Applies an offset to a MeterUpdate. This can be useful when  - performing a sequence of actions, such as multiple meteredWriteFiles,@@ -424,7 +425,8 @@ 		hPutStr h ('\r':s ++ padding) 		hFlush h --- | Clear meter displayed by displayMeterHandle.+-- | Clear meter displayed by displayMeterHandle. May be called before+-- outputting something else, followed by more calls to displayMeterHandle. clearMeterHandle :: Meter -> Handle -> IO () clearMeterHandle (Meter _ _ v _) h = do 	olds <- readMVar v
Utility/Path.hs view
@@ -18,11 +18,12 @@ 	segmentPaths', 	runSegmentPaths, 	runSegmentPaths',-	inPath,-	searchPath, 	dotfile, 	splitShortExtensions, 	relPathDirToFileAbs,+	inSearchPath,+	searchPath,+	searchPathContents, ) where  import System.FilePath.ByteString@@ -30,11 +31,13 @@ import qualified Data.ByteString as B import Data.List import Data.Maybe+import Control.Monad import Control.Applicative import Prelude  import Utility.Monad import Utility.SystemDirectory+import Utility.Exception  #ifdef mingw32_HOST_OS import Data.Char@@ -136,33 +139,6 @@ runSegmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[r]] runSegmentPaths' si c a paths = segmentPaths' si c paths <$> a paths -{- Checks if a command is available in PATH.- -- - The command may be fully-qualified, in which case, this succeeds as- - long as it exists. -}-inPath :: String -> IO Bool-inPath command = isJust <$> searchPath command--{- Finds a command in PATH and returns the full path to it.- -- - 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-	| P.isAbsolute command = check command-	| otherwise = P.getSearchPath >>= getM indir-  where-	indir d = check $ d P.</> command-	check f = firstM doesFileExist-#ifdef mingw32_HOST_OS-		[f, f ++ ".exe"]-#else-		[f]-#endif- {- Checks if a filename is a unix dotfile. All files inside dotdirs  - count as dotfiles. -} dotfile :: RawFilePath -> Bool@@ -189,8 +165,7 @@ 		(base, ext) = splitExtension f 		len = B.length ext -{- This requires the first path to be absolute, and the- - second path cannot contain ../ or ./+{- This requires both paths to be absolute and normalized.  -  - On Windows, if the paths are on different drives,  - a relative path is not possible and the path is simply@@ -214,3 +189,44 @@ #ifdef mingw32_HOST_OS 	normdrive = map toLower . takeWhile (/= ':') . fromRawFilePath . takeDrive #endif++{- Checks if a command is available in PATH.+ -+ - The command may be fully-qualified, in which case, this succeeds as+ - long as it exists. -}+inSearchPath :: String -> IO Bool+inSearchPath command = isJust <$> searchPath command++{- Finds a command in PATH and returns the full path to it.+ -+ - 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+	| P.isAbsolute command = check command+	| otherwise = P.getSearchPath >>= getM indir+  where+	indir d = check $ d P.</> command+	check f = firstM doesFileExist+#ifdef mingw32_HOST_OS+		[f, f ++ ".exe"]+#else+		[f]+#endif++{- Finds commands in PATH that match a predicate. Note that the predicate+ - matches on the basename of the command, but the full path to it is+ - returned.+ -+ - Note that this will find commands in PATH that are not executable.+ -}+searchPathContents :: (FilePath -> Bool) -> IO [FilePath]+searchPathContents p =+	filterM doesFileExist +		=<< (concat <$> (P.getSearchPath >>= mapM go))+  where+	go d = map (d P.</>) . filter p+		<$> catchDefaultIO [] (getDirectoryContents d)
Utility/Path/AbsRel.hs view
@@ -1,6 +1,6 @@ {- absolute and relative path manipulation  -- - Copyright 2010-2020 Joey Hess <id@joeyh.name>+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -19,6 +19,7 @@ ) where  import System.FilePath.ByteString+import qualified Data.ByteString as B #ifdef mingw32_HOST_OS import System.Directory (getCurrentDirectory) #else@@ -64,22 +65,27 @@ #endif 		return $ absPathFrom cwd file -{- Constructs a relative path from the CWD to a file.+{- Constructs the minimal relative path from the CWD to a file.  -  - For example, assuming CWD is /tmp/foo/bar:  -    relPathCwdToFile "/tmp/foo" == ".."  -    relPathCwdToFile "/tmp/foo/bar" == "" + -    relPathCwdToFile "../bar/baz" == "baz"  -} relPathCwdToFile :: RawFilePath -> IO RawFilePath-relPathCwdToFile f = do+relPathCwdToFile f+	-- Optimisation: Avoid doing any IO when the path is relative+	-- and does not contain any ".." component.+	| isRelative f && not (".." `B.isInfixOf` f) = return f+	| otherwise = do #ifdef mingw32_HOST_OS-	c <- toRawFilePath <$> getCurrentDirectory+		c <- toRawFilePath <$> getCurrentDirectory #else-	c <- getWorkingDirectory+		c <- getWorkingDirectory #endif-	relPathDirToFile c f+		relPathDirToFile c f -{- Constructs a relative path from a directory to a file. -}+{- Constructs a minimal relative path from a directory to a file. -} relPathDirToFile :: RawFilePath -> RawFilePath -> IO RawFilePath relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
Utility/Process.hs view
@@ -7,6 +7,7 @@  -}  {-# LANGUAGE CPP, Rank2Types, LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-tabs #-}  module Utility.Process (@@ -38,10 +39,10 @@ import Utility.Misc import Utility.Exception import Utility.Monad+import Utility.Debug  import System.Exit import System.IO-import System.Log.Logger import Control.Monad.IO.Class import Control.Concurrent.Async import qualified Data.ByteString as S@@ -187,7 +188,7 @@ debugProcess :: CreateProcess -> ProcessHandle -> IO () debugProcess p h = do 	pid <- getPid h-	debugM "Utility.Process" $ unwords+	debug "Utility.Process" $ unwords 		[ describePid pid 		, action ++ ":" 		, showCmd p@@ -211,7 +212,7 @@ 	-- Have to get pid before waiting, which closes the ProcessHandle. 	pid <- getPid h 	r <- Utility.Process.Shim.waitForProcess h-	debugM "Utility.Process" (describePid pid ++ " done " ++ show r)+	debug "Utility.Process" (describePid pid ++ " done " ++ show r) 	return r  cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
Utility/QuickCheck.hs view
@@ -12,8 +12,7 @@ 	( module X 	, TestableString 	, fromTestableString-	, TestableFilePath-	, fromTestableFilePath+	, TestableFilePath(..) 	, nonNegative 	, positive 	) where
Utility/ThreadScheduler.hs view
@@ -15,6 +15,7 @@ 	threadDelaySeconds, 	waitForTermination, 	oneSecond,+	unboundDelay, ) where  import Control.Monad
git-repair.cabal view
@@ -1,11 +1,11 @@ Name: git-repair-Version: 1.20210111+Version: 1.20210629 Cabal-Version: >= 1.10 License: AGPL-3 Maintainer: Joey Hess <joey@kitenet.net> Author: Joey Hess Stability: Stable-Copyright: 2013-2020 Joey Hess+Copyright: 2013-2021 Joey Hess License-File: COPYRIGHT Build-Type: Custom Homepage: http://git-repair.branchable.com/@@ -30,7 +30,7 @@     hslogger, split, unix-compat, process, unix, filepath,     filepath-bytestring (>= 1.4.2.1.1), async,     exceptions, bytestring, directory, IfElse, data-default,-    mtl, Cabal+    mtl, Cabal, time  source-repository head   type: git@@ -47,7 +47,8 @@    utf8-string, async, optparse-applicative (>= 0.14.1),    data-default, deepseq, attoparsec,    network-uri (>= 2.6), network (>= 2.6),-   filepath-bytestring (>= 1.4.2.1.0)+   filepath-bytestring (>= 1.4.2.1.0),+   time    if (os(windows))     Build-Depends: setenv@@ -70,6 +71,7 @@     Git.CurrentRepo     Git.Destroyer     Git.DiffTreeItem+    Git.Env     Git.FilePath     Git.Filename     Git.Fsck@@ -91,6 +93,7 @@     Utility.Applicative     Utility.Batch     Utility.CoProcess+    Utility.Debug     Utility.Data     Utility.DataUnits     Utility.Directory