packages feed

git-annex 10.20261006 → 10.20261020

raw patch · 21 files changed

+406/−208 lines, 21 files

Files

+ Annex/AdjustTreeItem.hs view
@@ -0,0 +1,174 @@+{- TreeItem adjustment implementation+ -+ - Copyright 2016-2026 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE BangPatterns, OverloadedStrings #-}++module Annex.AdjustTreeItem (+	AdjustTreeItem,+	getAdjustTreeItem+) where++import Annex.Common+import Types.AdjustedBranch+import Types.AdjustTreeItem+import Git+import Git.Types+import Git.Tree (TreeItem(..))+import Git.FilePath+import Annex.CatFile+import Annex.Link+import Annex.Content.Presence+import {-# SOURCE #-} Annex.Wanted+import qualified Database.Keys+import Utility.FileMode+import qualified Utility.RawFilePath as R++import System.PosixCompat.Files (fileMode)++getAdjustTreeItem :: AdjustTreeItem+getAdjustTreeItem = AdjustTreeItem+	{ adjustTreeItem = adjustTreeItemC+	, adjustmentIsStable = adjustmentIsStableC+	}++class AdjustTreeItemClass t where+	-- How to perform various adjustments to a TreeItem.+	adjustTreeItemC :: t -> TreeItem -> Annex (Maybe TreeItem)+	-- Will adjusting a given tree always yield the same adjusted tree?+	adjustmentIsStableC :: t -> Bool++instance AdjustTreeItemClass Adjustment where+	adjustTreeItemC (LinkAdjustment l) t = adjustTreeItemC l t+	adjustTreeItemC (PresenceAdjustment p Nothing) t = adjustTreeItemC p t+	adjustTreeItemC (PresenceAdjustment p (Just l)) t =+		adjustTreeItemC p t >>= \case+			Nothing -> return Nothing+			Just t' -> adjustTreeItemC l t'+	adjustTreeItemC (LockUnlockPresentAdjustment l) t = adjustTreeItemC l t+	adjustTreeItemC (WantedAdjustment p Nothing) t = adjustTreeItemC p t+	adjustTreeItemC (WantedAdjustment p (Just l)) t =+		adjustTreeItemC p t >>= \case+			Nothing -> return Nothing+			Just t' -> adjustTreeItemC l t'++	adjustmentIsStableC (LinkAdjustment l) = adjustmentIsStableC l+	adjustmentIsStableC (PresenceAdjustment p _) = adjustmentIsStableC p+	adjustmentIsStableC (LockUnlockPresentAdjustment l) = adjustmentIsStableC l+	adjustmentIsStableC (WantedAdjustment p _) = adjustmentIsStableC p++instance AdjustTreeItemClass LinkAdjustment where+	adjustTreeItemC UnlockAdjustment =+		ifSymlink adjustToPointer noAdjust+	adjustTreeItemC LockAdjustment =+		ifSymlink noAdjust adjustToSymlink+	adjustTreeItemC FixAdjustment =+		ifSymlink adjustToSymlink noAdjust+	adjustTreeItemC UnFixAdjustment =+		ifSymlink (adjustToSymlink' gitAnnexLinkCanonical) noAdjust+	+	adjustmentIsStableC _ = True++instance AdjustTreeItemClass PresenceAdjustment where+	adjustTreeItemC HideMissingAdjustment = +		ifPresent noAdjust hideAdjust+	adjustTreeItemC ShowMissingAdjustment =+		noAdjust++	adjustmentIsStableC HideMissingAdjustment = False+	adjustmentIsStableC ShowMissingAdjustment = True++instance AdjustTreeItemClass WantedAdjustment where+	adjustTreeItemC HideUnwantedAdjustment = +		ifWanted noAdjust hideAdjust+	adjustTreeItemC ShowUnwantedAdjustment =+		noAdjust++	adjustmentIsStableC HideUnwantedAdjustment = False+	adjustmentIsStableC ShowUnwantedAdjustment = True++instance AdjustTreeItemClass LockUnlockPresentAdjustment where+	adjustTreeItemC UnlockPresentAdjustment = +		ifPresent adjustToPointer adjustToSymlink+	adjustTreeItemC LockPresentAdjustment =+		-- Turn all pointers back to symlinks, whether the content+		-- is present or not. This is done because the content+		-- availability may have changed and the branch not been+		-- re-adjusted to keep up, so there may be pointers whose+		-- content is not present.+		ifSymlink noAdjust adjustToSymlink++	adjustmentIsStableC UnlockPresentAdjustment = False+	adjustmentIsStableC LockPresentAdjustment = True++ifSymlink+	:: (TreeItem -> Annex a)+	-> (TreeItem -> Annex a)+	-> TreeItem+	-> Annex a+ifSymlink issymlink notsymlink ti@(TreeItem _f m _s)+	| toTreeItemType m == Just TreeSymlink = issymlink ti+	| otherwise = notsymlink ti++ifPresent+	:: (TreeItem -> Annex (Maybe TreeItem))+	-> (TreeItem -> Annex (Maybe TreeItem))+	-> TreeItem+	-> Annex (Maybe TreeItem)+ifPresent ispresent notpresent ti@(TreeItem _ _ s) =+	catKey s >>= \case+		Just k -> ifM (inAnnex k)+			( ispresent ti+			, notpresent ti+			)+		Nothing -> return (Just ti)++ifWanted+	:: (TreeItem -> Annex (Maybe TreeItem))+	-> (TreeItem -> Annex (Maybe TreeItem))+	-> TreeItem+	-> Annex (Maybe TreeItem)+ifWanted iswanted notwanted ti@(TreeItem topf _ s) =+	catKey s >>= \case+		Just k -> do+			af <- AssociatedFile . Just+				<$> fromRepo (fromTopFilePath topf)+			ifM (wantGet NoLiveUpdate True (Just k) af)+				( iswanted ti+				, notwanted ti+				)+		Nothing -> return (Just ti)++noAdjust :: TreeItem -> Annex (Maybe TreeItem)+noAdjust = return . Just++hideAdjust :: TreeItem -> Annex (Maybe TreeItem)+hideAdjust _ = return Nothing++adjustToPointer :: TreeItem -> Annex (Maybe TreeItem)+adjustToPointer ti@(TreeItem f _m s) = catKey s >>= \case+	Just k -> do+		Database.Keys.addAssociatedFile k f+		exe <- catchDefaultIO False $+			(isExecutable . fileMode) <$> +				(liftIO . R.getFileStatus . fromOsPath+					=<< calcRepo (gitAnnexLocation k))+		let mode = fromTreeItemType $ +			if exe then TreeExecutable else TreeFile+		Just . TreeItem f mode <$> hashPointerFile k+	Nothing -> return (Just ti)++adjustToSymlink :: TreeItem -> Annex (Maybe TreeItem)+adjustToSymlink = adjustToSymlink' gitAnnexLink++adjustToSymlink' :: (OsPath -> Key -> Git.Repo -> GitConfig -> IO OsPath) -> TreeItem -> Annex (Maybe TreeItem)+adjustToSymlink' gitannexlink ti@(TreeItem f _m s) = catKey s >>= \case+	Just k -> do+		absf <- inRepo $ \r -> absPath $ fromTopFilePath f r+		linktarget <- calcRepo $ gitannexlink absf k+		Just . TreeItem f (fromTreeItemType TreeSymlink)+			<$> hashSymlink (fromOsPath linktarget)+	Nothing -> return (Just ti)
Annex/AdjustedBranch.hs view
@@ -1,6 +1,6 @@ {- adjusted branch  -- - Copyright 2016-2024 Joey Hess <id@joeyh.name>+ - Copyright 2016-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -12,6 +12,7 @@ 	LinkAdjustment(..), 	PresenceAdjustment(..), 	LockUnlockPresentAdjustment(..),+	WantedAdjustment(..), 	adjustmentHidesFiles, 	adjustmentIsStable, 	OrigBranch,@@ -41,6 +42,7 @@  import Annex.Common import Types.AdjustedBranch+import Types.AdjustTreeItem import Annex.AdjustedBranch.Name import qualified Annex import Git@@ -58,125 +60,16 @@ import qualified Git.LockFile import Annex.CatFile import Annex.Link-import Annex.Content.Presence import Annex.CurrentBranch import Types.CleanupActions-import qualified Database.Keys import Config import Logs.View (is_branchView) import Logs.AdjustedBranchUpdate-import Utility.FileMode-import qualified Utility.RawFilePath as R import qualified Utility.FileIO as F  import Data.Time.Clock.POSIX import qualified Data.Map as M-import System.PosixCompat.Files (fileMode) -class AdjustTreeItem t where-	-- How to perform various adjustments to a TreeItem.-	adjustTreeItem :: t -> TreeItem -> Annex (Maybe TreeItem)-	-- Will adjusting a given tree always yield the same adjusted tree?-	adjustmentIsStable :: t -> Bool--instance AdjustTreeItem Adjustment where-	adjustTreeItem (LinkAdjustment l) t = adjustTreeItem l t-	adjustTreeItem (PresenceAdjustment p Nothing) t = adjustTreeItem p t-	adjustTreeItem (PresenceAdjustment p (Just l)) t =-		adjustTreeItem p t >>= \case-			Nothing -> return Nothing-			Just t' -> adjustTreeItem l t'-	adjustTreeItem (LockUnlockPresentAdjustment l) t = adjustTreeItem l t--	adjustmentIsStable (LinkAdjustment l) = adjustmentIsStable l-	adjustmentIsStable (PresenceAdjustment p _) = adjustmentIsStable p-	adjustmentIsStable (LockUnlockPresentAdjustment l) = adjustmentIsStable l--instance AdjustTreeItem LinkAdjustment where-	adjustTreeItem UnlockAdjustment =-		ifSymlink adjustToPointer noAdjust-	adjustTreeItem LockAdjustment =-		ifSymlink noAdjust adjustToSymlink-	adjustTreeItem FixAdjustment =-		ifSymlink adjustToSymlink noAdjust-	adjustTreeItem UnFixAdjustment =-		ifSymlink (adjustToSymlink' gitAnnexLinkCanonical) noAdjust-	-	adjustmentIsStable _ = True--instance AdjustTreeItem PresenceAdjustment where-	adjustTreeItem HideMissingAdjustment = -		ifPresent noAdjust hideAdjust-	adjustTreeItem ShowMissingAdjustment =-		noAdjust--	adjustmentIsStable HideMissingAdjustment = False-	adjustmentIsStable ShowMissingAdjustment = True--instance AdjustTreeItem LockUnlockPresentAdjustment where-	adjustTreeItem UnlockPresentAdjustment = -		ifPresent adjustToPointer adjustToSymlink-	adjustTreeItem LockPresentAdjustment =-		-- Turn all pointers back to symlinks, whether the content-		-- is present or not. This is done because the content-		-- availability may have changed and the branch not been-		-- re-adjusted to keep up, so there may be pointers whose-		-- content is not present.-		ifSymlink noAdjust adjustToSymlink--	adjustmentIsStable UnlockPresentAdjustment = False-	adjustmentIsStable LockPresentAdjustment = True--ifSymlink-	:: (TreeItem -> Annex a)-	-> (TreeItem -> Annex a)-	-> TreeItem-	-> Annex a-ifSymlink issymlink notsymlink ti@(TreeItem _f m _s)-	| toTreeItemType m == Just TreeSymlink = issymlink ti-	| otherwise = notsymlink ti--ifPresent-	:: (TreeItem -> Annex (Maybe TreeItem))-	-> (TreeItem -> Annex (Maybe TreeItem))-	-> TreeItem-	-> Annex (Maybe TreeItem)-ifPresent ispresent notpresent ti@(TreeItem _ _ s) =-	catKey s >>= \case-		Just k -> ifM (inAnnex k) (ispresent ti, notpresent ti)-		Nothing -> return (Just ti)--noAdjust :: TreeItem -> Annex (Maybe TreeItem)-noAdjust = return . Just--hideAdjust :: TreeItem -> Annex (Maybe TreeItem)-hideAdjust _ = return Nothing--adjustToPointer :: TreeItem -> Annex (Maybe TreeItem)-adjustToPointer ti@(TreeItem f _m s) = catKey s >>= \case-	Just k -> do-		Database.Keys.addAssociatedFile k f-		exe <- catchDefaultIO False $-			(isExecutable . fileMode) <$> -				(liftIO . R.getFileStatus . fromOsPath-					=<< calcRepo (gitAnnexLocation k))-		let mode = fromTreeItemType $ -			if exe then TreeExecutable else TreeFile-		Just . TreeItem f mode <$> hashPointerFile k-	Nothing -> return (Just ti)--adjustToSymlink :: TreeItem -> Annex (Maybe TreeItem)-adjustToSymlink = adjustToSymlink' gitAnnexLink--adjustToSymlink' :: (OsPath -> Key -> Git.Repo -> GitConfig -> IO OsPath) -> TreeItem -> Annex (Maybe TreeItem)-adjustToSymlink' gitannexlink ti@(TreeItem f _m s) = catKey s >>= \case-	Just k -> do-		absf <- inRepo $ \r -> absPath $ fromTopFilePath f r-		linktarget <- calcRepo $ gitannexlink absf k-		Just . TreeItem f (fromTreeItemType TreeSymlink)-			<$> hashSymlink (fromOsPath linktarget)-	Nothing -> return (Just ti)- -- This is a hidden branch ref, that's used as the basis for the AdjBranch, -- since pushes can overwrite the OrigBranch at any time. So, changes -- are propagated from the AdjBranch to the head of the BasisBranch.@@ -201,11 +94,11 @@  - Can fail, if no branch is checked out, or if the adjusted branch already  - exists, or if staged changes prevent a checkout.  -}-enterAdjustedBranch :: Adjustment -> Annex Bool-enterAdjustedBranch adj = inRepo Git.Branch.current >>= \case+enterAdjustedBranch :: Adjustment -> AdjustTreeItem -> Annex Bool+enterAdjustedBranch adj ati = inRepo Git.Branch.current >>= \case 	Just currbranch -> case getAdjustment currbranch of 		Just curradj | curradj == adj ->-			updateAdjustedBranch adj (AdjBranch currbranch)+			updateAdjustedBranch adj ati (AdjBranch currbranch) 				(fromAdjustedBranch currbranch) 		_ -> go currbranch 	Nothing -> do@@ -233,7 +126,7 @@ 			, do 				starttime <- liftIO getPOSIXTime 				b <- preventCommits $ const $ -					adjustBranch adj origbranch+					adjustBranch adj ati origbranch 				ok <- checkoutAdjustedBranch b False 				when ok $ 					recordAdjustedBranchUpdateFinished starttime@@ -257,19 +150,19 @@  - and rebuilding the adjusted branch, and then checking it out.  - But, it can be implemented more efficiently than that.  -}-updateAdjustedBranch :: Adjustment -> AdjBranch -> OrigBranch -> Annex Bool-updateAdjustedBranch adj (AdjBranch currbranch) origbranch-	| not (adjustmentIsStable adj) = do+updateAdjustedBranch :: Adjustment -> AdjustTreeItem -> AdjBranch -> OrigBranch -> Annex Bool+updateAdjustedBranch adj ati (AdjBranch currbranch) origbranch+	| not (adjustmentIsStable ati adj) = do 		(b, origheadfile, newheadfile) <- preventCommits $ \commitlck -> do 			-- Avoid losing any commits that the adjusted branch 			-- has that have not yet been propagated back to the 			-- origbranch.-			_ <- propigateAdjustedCommits' True origbranch adj commitlck+			_ <- propigateAdjustedCommits' True origbranch adj ati commitlck 			 			origheadfile <- inRepo $ F.readFile' . Git.Ref.headFile 			origheadsha <- inRepo (Git.Ref.sha currbranch) 			-			b <- adjustBranch adj origbranch+			b <- adjustBranch adj ati origbranch  			-- Git normally won't do anything when asked to check 			-- out the currently checked out branch, even when its@@ -300,7 +193,7 @@ 		return ok 	| otherwise = preventCommits $ \commitlck -> do 		-- Done for consistency.-		_ <- propigateAdjustedCommits' True origbranch adj commitlck+		_ <- propigateAdjustedCommits' True origbranch adj ati commitlck 		-- No need to actually update the branch because the 		-- adjustment is stable. 		return True@@ -309,15 +202,15 @@  - When the adjusted branch needs to be refreshed to reflect  - those changes, it's handled here.  -}-adjustedBranchRefresh :: Annex a -> Annex a-adjustedBranchRefresh a = do+adjustedBranchRefresh :: AdjustTreeItem -> Annex a -> Annex a+adjustedBranchRefresh ati a = do 	r <- a 	go 	return r   where 	go = getCurrentBranch >>= \case 		(Just origbranch, Just adj) ->-			unless (adjustmentIsStable adj) $ do+			unless (adjustmentIsStable ati adj) $ do 				recordAdjustedBranchUpdateNeeded 				n <- annexAdjustedBranchRefresh <$> Annex.getGitConfig 				unless (n == 0) $ ifM (checkcounter n)@@ -325,9 +218,9 @@ 					-- adjust the AssociatedFile, and only call this once 					-- at shutdown to handle cases where not all 					-- AssociatedFiles are known.-					( adjustedBranchRefreshFull' adj origbranch+					( adjustedBranchRefreshFull' adj ati origbranch 					, Annex.addCleanupAction AdjustedBranchUpdate $-						adjustedBranchRefreshFull' adj origbranch+						adjustedBranchRefreshFull' adj ati origbranch 					) 		_ -> return () 	@@ -343,25 +236,25 @@  {- Slow, but more dependable version of adjustedBranchRefresh that  - does not rely on all AssociatedFiles being known. -}-adjustedBranchRefreshFull :: Adjustment -> OrigBranch -> Annex ()-adjustedBranchRefreshFull adj origbranch =+adjustedBranchRefreshFull :: Adjustment -> AdjustTreeItem -> OrigBranch -> Annex ()+adjustedBranchRefreshFull adj ati origbranch = 	whenM isAdjustedBranchUpdateNeeded $ do-		adjustedBranchRefreshFull' adj origbranch+		adjustedBranchRefreshFull' adj ati origbranch -adjustedBranchRefreshFull' :: Adjustment -> OrigBranch -> Annex ()-adjustedBranchRefreshFull' adj origbranch = do+adjustedBranchRefreshFull' :: Adjustment -> AdjustTreeItem -> OrigBranch -> Annex ()+adjustedBranchRefreshFull' adj ati origbranch = do 	-- Restage pointer files so modifications to them due to get/drop 	-- do not prevent checking out the updated adjusted branch. 	restagePointerFiles =<< Annex.gitRepo 	starttime <- liftIO getPOSIXTime 	let adjbranch = originalToAdjusted origbranch adj-	ifM (updateAdjustedBranch adj adjbranch origbranch)+	ifM (updateAdjustedBranch adj ati adjbranch origbranch) 		( recordAdjustedBranchUpdateFinished starttime 		, warning "Updating adjusted branch failed." 		) -adjustToCrippledFileSystem :: Annex ()-adjustToCrippledFileSystem = do+adjustToCrippledFileSystem :: AdjustTreeItem -> Annex ()+adjustToCrippledFileSystem ati = do 	warning "Entering an adjusted branch where files are unlocked as this filesystem does not support locked files." 	whenM (isNothing <$> inRepo Git.Branch.current) $ 		commitForAdjustedBranch []@@ -373,7 +266,7 @@ 				ifM (inRepo (Git.Ref.exists $ adjBranch adjbranch)) 					( unlessM (checkoutAdjustedBranch adjbranch False) $ 						failedenter-					, unlessM (enterAdjustedBranch adj) $+					, unlessM (enterAdjustedBranch adj ati) $ 						failedenter 					) 		Nothing -> failedenter@@ -404,25 +297,25 @@ setAdjustedBranch :: String -> AdjBranch -> Ref -> Annex () setAdjustedBranch msg (AdjBranch b) r = inRepo $ Git.Branch.update msg b r -adjustBranch :: Adjustment -> OrigBranch -> Annex AdjBranch-adjustBranch adj origbranch = do+adjustBranch :: Adjustment -> AdjustTreeItem -> OrigBranch -> Annex AdjBranch+adjustBranch adj ati origbranch = do 	-- Start basis off with the current value of the origbranch. 	setBasisBranch basis origbranch-	sha <- adjustCommit adj basis+	sha <- adjustCommit adj ati basis 	setAdjustedBranch "entering adjusted branch" adjbranch sha 	return adjbranch   where 	adjbranch = originalToAdjusted origbranch adj 	basis = basisBranch adjbranch -adjustCommit :: Adjustment -> BasisBranch -> Annex Sha-adjustCommit adj basis = do-	treesha <- adjustTree adj basis+adjustCommit :: Adjustment -> AdjustTreeItem -> BasisBranch -> Annex Sha+adjustCommit adj ati basis = do+	treesha <- adjustTree adj ati basis 	commitAdjustedTree treesha basis -adjustTree :: Adjustment -> BasisBranch -> Annex Sha-adjustTree adj (BasisBranch basis) = do-	let toadj = adjustTreeItem adj+adjustTree :: Adjustment -> AdjustTreeItem -> BasisBranch -> Annex Sha+adjustTree adj ati (BasisBranch basis) = do+	let toadj = adjustTreeItem ati adj 	treesha <- Git.Tree.adjustTree 		toadj  		[] @@ -504,10 +397,10 @@  - After propagating the commits back to the basis branch,  - rebase the adjusted branch on top of the updated basis branch.  -}-propigateAdjustedCommits :: OrigBranch -> Adjustment -> Annex ()-propigateAdjustedCommits origbranch adj = +propigateAdjustedCommits :: OrigBranch -> Adjustment -> AdjustTreeItem -> Annex ()+propigateAdjustedCommits origbranch adj ati =  	preventCommits $ \commitsprevented ->-		join $ snd <$> propigateAdjustedCommits' True origbranch adj commitsprevented+		join $ snd <$> propigateAdjustedCommits' True origbranch adj ati commitsprevented 		 {- Returns sha of updated basis branch, and action which will rebase  - the adjusted branch on top of the updated basis branch. -}@@ -515,9 +408,10 @@ 	:: Bool 	-> OrigBranch 	-> Adjustment+	-> AdjustTreeItem 	-> CommitsPrevented 	-> Annex (Maybe Sha, Annex ())-propigateAdjustedCommits' warnwhendiverged origbranch adj _commitsprevented =+propigateAdjustedCommits' warnwhendiverged origbranch adj ati _commitsprevented = 	inRepo (Git.Ref.sha basis) >>= \case 		Just origsha -> catCommit currbranch >>= \case 			Just currcommit -> do@@ -552,7 +446,7 @@ 			| hasAdjustedBranchCommitMessage c -> 				go origsha parent True l 			| pastadjcommit -> do-				commit <- reverseAdjustedCommit parent adj (sha, c) origbranch+				commit <- reverseAdjustedCommit parent adj ati (sha, c) origbranch 				go origsha commit pastadjcommit l 		_ -> go origsha parent pastadjcommit l 	rebase currcommit newparent = do@@ -573,12 +467,12 @@  - The commit message, and the author and committer metadata are  - copied over from the basiscommit. However, any gpg signature  - will be lost, and any other headers are not copied either. -}-reverseAdjustedCommit :: Sha -> Adjustment -> (Sha, Commit) -> OrigBranch -> Annex Sha-reverseAdjustedCommit commitparent adj (csha, basiscommit) origbranch+reverseAdjustedCommit :: Sha -> Adjustment -> AdjustTreeItem -> (Sha, Commit) -> OrigBranch -> Annex Sha+reverseAdjustedCommit commitparent adj ati (csha, basiscommit) origbranch 	| length (commitParent basiscommit) > 1 = giveup mergeerror 	| otherwise = do 		cmode <- annexCommitMode <$> Annex.getGitConfig-		treesha <- reverseAdjustedTree commitparent adj csha+		treesha <- reverseAdjustedTree commitparent adj ati csha 		revadjcommit <- inRepo $ commitWithMetaData 			(commitAuthorMetaData basiscommit) 			(commitCommitterMetaData basiscommit) $@@ -598,13 +492,13 @@  -  - commitDiff does not support merge commits, so the csha must not be a  - merge commit. -}-reverseAdjustedTree :: Sha -> Adjustment -> Sha -> Annex Sha-reverseAdjustedTree basis adj csha = do+reverseAdjustedTree :: Sha -> Adjustment -> AdjustTreeItem -> Sha -> Annex Sha+reverseAdjustedTree basis adj ati csha = do 	(diff, cleanup) <- inRepo (Git.DiffTree.commitDiff csha) 	let (adds, others) = partition (\dti -> Git.DiffTree.srcsha dti `elem` nullShas) diff 	let (removes, changes) = partition (\dti -> Git.DiffTree.dstsha dti `elem` nullShas) others 	adds' <- catMaybes <$>-		mapM (adjustTreeItem reverseadj) (map diffTreeToTreeItem adds)+		mapM (adjustTreeItem ati reverseadj) (map diffTreeToTreeItem adds) 	treesha <- Git.Tree.adjustTree 		(propchanges changes) 		adds'@@ -619,7 +513,7 @@ 	propchanges changes ti@(TreeItem f _ _) = 		case M.lookup (norm f) m of 			Nothing -> return (Just ti) -- not changed-			Just change -> adjustTreeItem reverseadj change+			Just change -> adjustTreeItem ati reverseadj change 	  where 		m = M.fromList $ map (\i@(TreeItem f' _ _) -> (norm f', i)) $ 			map diffTreeToTreeItem changes
Annex/AdjustedBranch/Merge.hs view
@@ -14,6 +14,7 @@  import Annex.Common import Annex.AdjustedBranch+import Annex.AdjustTreeItem import qualified Annex import Git import Git.Types@@ -49,7 +50,7 @@  	go commitsprevented = do 		(updatedorig, _) <- propigateAdjustedCommits'-			False origbranch adj commitsprevented+			False origbranch adj getAdjustTreeItem commitsprevented 		changestomerge updatedorig  	{- Since the adjusted branch changes files, merging tomerge@@ -131,7 +132,7 @@ 	postmerge (Just mergecommit) = do 		setBasisBranch basis mergecommit 		inRepo $ Git.Branch.update' origbranch mergecommit-		adjtree <- adjustTree adj (BasisBranch mergecommit)+		adjtree <- adjustTree adj getAdjustTreeItem (BasisBranch mergecommit) 		adjmergecommit <- commitAdjustedTree adjtree (BasisBranch mergecommit) 		-- Make currbranch be the parent, so that merging 		-- this commit will be a fast-forward.@@ -155,7 +156,7 @@ 					[adjmergecommit] 					(commitTree currentcommit) 				inRepo $ Git.Branch.update "updating adjusted branch" currbranch c-				propigateAdjustedCommits origbranch adj+				propigateAdjustedCommits origbranch adj getAdjustTreeItem 			else inRepo $ Git.Branch.update "updating adjusted branch" currbranch adjmergecommit 		return True 	reparent _ _ Nothing = return False
Annex/AdjustedBranch/Name.hs view
@@ -1,6 +1,6 @@ {- adjusted branch names  -- - Copyright 2016-2020 Joey Hess <id@joeyh.name>+ - Copyright 2016-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -39,6 +39,10 @@ 		serializeAdjustment p <> "-" <> serializeAdjustment l 	serializeAdjustment (LockUnlockPresentAdjustment l) = 		serializeAdjustment l+	serializeAdjustment (WantedAdjustment p Nothing) =+		serializeAdjustment p+	serializeAdjustment (WantedAdjustment p (Just l)) = +		serializeAdjustment p <> "-" <> serializeAdjustment l 	deserializeAdjustment s =  		(LinkAdjustment <$> deserializeAdjustment s) 			<|>@@ -47,6 +51,10 @@ 		(PresenceAdjustment <$> deserializeAdjustment s <*> pure Nothing) 			<|> 		(LockUnlockPresentAdjustment <$> deserializeAdjustment s)+			<|>+		(WantedAdjustment <$> deserializeAdjustment s1 <*> pure (deserializeAdjustment s2))+			<|>+		(WantedAdjustment <$> deserializeAdjustment s <*> pure Nothing) 	  where 		(s1, s2) = separate' (== (fromIntegral (ord '-'))) s @@ -73,6 +81,13 @@ 	serializeAdjustment LockPresentAdjustment = "lockpresent" 	deserializeAdjustment "unlockpresent" = Just UnlockPresentAdjustment 	deserializeAdjustment "lockpresent" = Just LockPresentAdjustment+	deserializeAdjustment _ = Nothing++instance SerializeAdjustment WantedAdjustment where+	serializeAdjustment HideUnwantedAdjustment = "hideunwanted"+	serializeAdjustment ShowUnwantedAdjustment = "showunwanted"+	deserializeAdjustment "hideunwanted" = Just HideUnwantedAdjustment+	deserializeAdjustment "showunwanted" = Just ShowUnwantedAdjustment 	deserializeAdjustment _ = Nothing  newtype AdjBranch = AdjBranch { adjBranch :: Branch }
Annex/Branch.hs view
@@ -38,6 +38,7 @@ 	files, 	rememberTreeish, 	performTransitions,+	checkTransitionedRef, 	withIndex, 	precache, 	UnmergedBranches(..),@@ -807,6 +808,18 @@ 			ignoreRefs untransitionedrefs 			return True +{- Checks if the passed ref is to a sha that has been merged into the+ - git-annex branch already, but was not able to be listed as a parent due+ - to a transition. If so, returns the sha. -}+checkTransitionedRef :: Git.Ref -> Annex (Maybe Git.Sha)+checkTransitionedRef r = do+	ir <- getIgnoredRefs+	if S.null ir+		then return Nothing+		else inRepo (Git.Ref.sha r) >>= \case+			Just sha | S.member sha ir -> return (Just sha)+			_ -> return Nothing+ {- Performs the specified transitions on the contents of the index file,  - commits it to the branch, or creates a new branch.  -}@@ -846,7 +859,7 @@ 	message 		| neednewlocalbranch && null transitionedrefs = "new branch for transition " ++ tdesc 		| otherwise = "continuing transition " ++ tdesc-	tdesc = show $ map describeTransition tlist+	tdesc = intercalate ", " (map describeTransition tlist) 	tlist = knownTransitionList ts  	{- The changes to make to the branch are calculated and applied to
Annex/Content.hs view
@@ -94,6 +94,7 @@ import Annex.InodeSentinal import Annex.ReplaceFile import Annex.AdjustedBranch (adjustedBranchRefresh)+import Annex.AdjustTreeItem import Annex.DirHashes import Messages.Progress import Types.Remote (RetrievalSecurityPolicy(..), VerifyConfigA(..), name, storeKey, uuid)@@ -538,7 +539,7 @@   where 	storeobject dest = ifM (liftIO $ doesPathExist dest) 		( alreadyhave-		, adjustedBranchRefresh $ modifyContentDir dest $ do+		, adjustedBranchRefresh getAdjustTreeItem $ modifyContentDir dest $ do 			liftIO $ moveFile src dest 			-- Freeze the object file now that it is in place. 			-- Waiting until now to freeze it allows for freeze@@ -793,7 +794,7 @@ 	-- it's unmodified. 	resetpointer file = unlessM (liftIO $ isSymbolicLink <$> R.getSymbolicLinkStatus (fromOsPath file)) $ 		ifM (isUnmodified key file)-			( adjustedBranchRefresh $ +			( adjustedBranchRefresh getAdjustTreeItem $  				depopulatePointerFile QueueRestage key file 			-- Modified file, so leave it alone. 			-- If it was a hard link to the annex object,
Annex/Ingest.hs view
@@ -257,7 +257,7 @@ cleanCruft source = when (contentLocation source /= keyFilename source) $ 	liftIO $ removeWhenExistsWith removeFile $ contentLocation source --- If a worktree file was was hard linked to an annex object before,+-- If a worktree file was hard linked to an annex object before, -- modifying the file would have caused the object to have the wrong -- content. Clean up from that. cleanOldKeys :: OsPath -> Key -> Annex ()@@ -351,6 +351,8 @@ 	go (LinkAdjustment UnFixAdjustment) = False 	go (PresenceAdjustment _ (Just la)) = go (LinkAdjustment la) 	go (PresenceAdjustment _ Nothing) = False+	go (WantedAdjustment _ (Just la)) = go (LinkAdjustment la)+	go (WantedAdjustment _ Nothing) = False 	go (LockUnlockPresentAdjustment UnlockPresentAdjustment) = contentpresent 	go (LockUnlockPresentAdjustment LockPresentAdjustment) = False
Annex/Init.hs view
@@ -49,6 +49,7 @@ import Config.Smudge import qualified Upgrade.V5.Direct as Direct import qualified Annex.AdjustedBranch as AdjustedBranch+import Annex.AdjustTreeItem import Remote.List.Util (remotesChanged) import Annex.Environment import Annex.Hook@@ -169,7 +170,7 @@ 		AdjustedBranch.InAdjustedClone -> return () 		AdjustedBranch.NotInAdjustedClone -> 			ifM (crippledFileSystem <&&> (not <$> isBareRepo))-				( AdjustedBranch.adjustToCrippledFileSystem+				( AdjustedBranch.adjustToCrippledFileSystem getAdjustTreeItem 				-- Handle case where this repo was cloned from a 				-- direct mode repo 				, unlessM isBareRepo
Annex/SpecialRemote/Config.hs view
@@ -159,6 +159,7 @@ 	, cipherField 	, cipherkeysField 	, pubkeysField+	, onlyEncryptCredsField 	-- legacy chunking was either enabled or not, so has to be the same 	-- across configs for remotes that access the same data 	, chunksizeField
+ Annex/Wanted.hs-boot view
@@ -0,0 +1,5 @@+module Annex.Wanted where++import Annex.Common++wantGet :: LiveUpdate -> Bool -> Maybe Key -> AssociatedFile -> Annex Bool
Assistant/MakeRepo.hs view
@@ -18,6 +18,7 @@ import qualified Annex import Annex.UUID import Annex.AdjustedBranch+import Annex.AdjustTreeItem import Annex.Action import Annex.Startup import Types.StandardGroups@@ -73,7 +74,7 @@ 	 - once a day. 	 -} 	when primary_assistant_repo $ do-		void $ enterAdjustedBranch (LinkAdjustment UnlockAdjustment)+		void $ enterAdjustedBranch (LinkAdjustment UnlockAdjustment) getAdjustTreeItem 		setConfig (annexConfig "thin") (Git.Config.boolConfig True) 		inRepo $ Git.Command.run 			[Param "config", Param "gc.auto", Param "0"]
Assistant/Sync.hs view
@@ -1,6 +1,6 @@ {- git-annex assistant repo syncing  -- - Copyright 2012 Joey Hess <id@joeyh.name>+ - Copyright 2012-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -39,6 +39,7 @@ import Assistant.Commits import Types.Transfer import Database.Export+import Utility.Tuple  import Data.Time.Clock import qualified Data.Map as M@@ -162,20 +163,23 @@  	fallback branch g u rs = do 		debug ["fallback pushing to", show rs]-		(succeeded, failed) <- parallelPush g rs (taggedPush u Nothing branch)+		(succeeded, failed) <- parallelPush g rs+			(\r -> return $ taggedPush u Nothing branch r) 		updatemap succeeded failed 		return failed-		+	 	push ms branch remote = Command.Sync.pushBranch remote (Just branch) ms -parallelPush :: Git.Repo -> [Remote] -> (Remote -> Git.Repo -> IO Bool)-> Assistant ([Remote], [Remote])+parallelPush :: Git.Repo -> [Remote] -> (Remote -> Annex (Git.Repo -> IO Bool)) -> Assistant ([Remote], [Remote]) parallelPush g rs a = do-	rgs <- liftAnnex $ mapM topush rs-	(succeededrgs, failedrgs) <- liftIO $ inParallel (uncurry a) rgs-	return (map fst succeededrgs, map fst failedrgs)+	ars <- liftAnnex $ mapM topush rs+	(succeeded, failed) <- liftIO $+		inParallel (\(_, a', r) -> a' r) ars+	return (map fst3 succeeded, map fst3 failed)   where-	topush r = (,)+	topush r = (,,) 		<$> pure r+		<*> a r 		<*> (Remote.getRepo r >>= \repo -> 			sshOptionsTo repo (Remote.gitconfig r) g)
CHANGELOG view
@@ -1,3 +1,15 @@+git-annex (10.20261020) upstream; urgency=medium++  * adjust --hide-unwanted: New option to make an adjusted branch+    containing only wanted files.+  * push: Force push to remote git-annex branch when it has been+    supersceded by a transition.+  * Fix handling of --sameas special remotes with onlyencryptcreds=yes.+  * Linux standalone builds bundled CA certs updated for+    EMudhra Intermediate CA Compromise.++ -- Joey Hess <id@joeyh.name>  Tue, 20 Oct 2026 16:45:06 -0400+ git-annex (10.20261006) upstream; urgency=medium    * Fix stack build.
Command/Adjust.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2016-2018 Joey Hess <id@joeyh.name>+ - Copyright 2016-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -9,6 +9,7 @@  import Command import Annex.AdjustedBranch+import Annex.AdjustTreeItem  cmd :: Command cmd = notBareRepo $ noDaemonRunning $@@ -17,22 +18,27 @@  optParser :: CmdParamsDesc -> Parser Adjustment optParser _ =-	linkPresentAdjustmentParser+	linkPresentWantedAdjustmentParser 	<|> (LockUnlockPresentAdjustment <$> lockUnlockPresentAdjustmentParser) 	-linkPresentAdjustmentParser :: Parser Adjustment-linkPresentAdjustmentParser = comb <$> some ps+linkPresentWantedAdjustmentParser :: Parser Adjustment+linkPresentWantedAdjustmentParser = comb <$> some ps   where 	ps = (LinkAdjustment <$> linkAdjustmentParser) 		<|> (PresenceAdjustment <$> presenceAdjustmentParser <*> pure Nothing)+		<|> (WantedAdjustment <$> wantedAdjustmentParser <*> pure Nothing) 	comb (LinkAdjustment _ : LinkAdjustment b : c) = 		comb (LinkAdjustment b : c) 	comb (PresenceAdjustment _a1 a2 : PresenceAdjustment b1 b2 : c) =  		comb (PresenceAdjustment b1 (b2 <|> a2) : c)+	comb (WantedAdjustment _a1 a2 : WantedAdjustment b1 b2 : c) = +		comb (WantedAdjustment b1 (b2 <|> a2) : c) 	comb (LinkAdjustment a : PresenceAdjustment b1 b2 : c) = 		comb (PresenceAdjustment b1 (b2 <|> Just a) : c) 	comb (PresenceAdjustment a1 _a2 : LinkAdjustment b : c) = 		comb (PresenceAdjustment a1 (Just b) : c)+	comb (WantedAdjustment a1 _a2 : LinkAdjustment b : c) =+		comb (WantedAdjustment a1 (Just b) : c) 	comb (a : _) = a 	comb [] = error "internal" @@ -58,6 +64,13 @@ 		<> help "hide annexed files whose content is not present" 		) +wantedAdjustmentParser :: Parser WantedAdjustment+wantedAdjustmentParser =+	flag' HideUnwantedAdjustment+		( long "hide-unwanted"+		<> help "hide annexed files that are not wanted"+		)+ lockUnlockPresentAdjustmentParser :: Parser LockUnlockPresentAdjustment lockUnlockPresentAdjustmentParser = 	flag' UnlockPresentAdjustment@@ -71,4 +84,4 @@ start :: Adjustment -> CommandStart start adj =  	starting "adjust" (ActionItemOther Nothing) (SeekInput []) $-		next $ enterAdjustedBranch adj+		next $ enterAdjustedBranch adj getAdjustTreeItem
Command/EnableRemote.hs view
@@ -16,7 +16,6 @@ import qualified Git import qualified Annex.SpecialRemote as SpecialRemote import qualified Remote-import qualified Types.Remote as Remote import qualified Remote.Git import qualified Command.InitRemote import Logs.UUID@@ -67,7 +66,7 @@ 			-- remote that has an url (eg gcrypt). 			rs <- Remote.remoteList 			case filter (\rmt -> Remote.name rmt == name) rs of-				(rmt:_) | Remote.remotetype rmt == Remote.Git.remote ->+				(rmt:_) | R.remotetype rmt == Remote.Git.remote -> 					startNormalRemote name r 				_  -> go [] @@ -83,12 +82,12 @@ 	ai = ActionItemOther (Just (UnquotedString name)) 	si = SeekInput [name] -startSpecialRemote :: EnableRemoteOptions -> RemoteName -> Remote.RemoteConfig -> [(UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID))] -> CommandStart+startSpecialRemote :: EnableRemoteOptions -> RemoteName -> R.RemoteConfig -> [(UUID, R.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID))] -> CommandStart startSpecialRemote o = startSpecialRemote' "enableremote" (performSpecialRemote o)  type PerformSpecialRemote = RemoteType -> UUID -> RemoteName -> R.RemoteConfig -> R.RemoteConfig -> RemoteGitConfig -> Maybe (SpecialRemote.ConfigFrom UUID) -> CommandPerform -startSpecialRemote' :: String -> PerformSpecialRemote -> RemoteName -> Remote.RemoteConfig -> [(UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID))] -> CommandStart+startSpecialRemote' :: String -> PerformSpecialRemote -> RemoteName -> R.RemoteConfig -> [(UUID, R.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID))] -> CommandStart startSpecialRemote' cname perform name config [] = do 	m <- SpecialRemote.specialRemoteMap 	confm <- Logs.Remote.remoteConfigMap@@ -106,7 +105,7 @@ 				giveup "Cannot change type= of existing special remote. Instead, use: git-annex initremote --sameas" 			_ -> noop 		gc <- maybe (liftIO dummyRemoteGitConfig) -			(return . Remote.gitconfig)+			(return . R.gitconfig) 			=<< Remote.byUUID u 		perform t u name c fullconfig gc mcu   where@@ -169,7 +168,7 @@  -- Use dead remote only when there is no other remote -- with the same name-deadLast :: RemoteName -> ([(UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID))] -> Annex a) -> Annex a+deadLast :: RemoteName -> ([(UUID, R.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID))] -> Annex a) -> Annex a deadLast name use = 	SpecialRemote.findExisting' name >>= \case 		([], l) -> use l
Command/Sync.hs view
@@ -8,6 +8,7 @@  {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}  module Command.Sync ( 	cmd,@@ -68,6 +69,7 @@ import Annex.AutoMerge import Annex.AdjustedBranch import Annex.AdjustedBranch.Merge+import Annex.AdjustTreeItem import Annex.View import Annex.Ssh import Annex.BloomFilter@@ -551,17 +553,18 @@ 		Nothing -> case madj of 			Just adj -> do 				when forpush $-					propigateAdjustedCommits branch adj+					propigateAdjustedCommits branch adj getAdjustTreeItem 				when forpull $ 					updateadjustedbranch adj 			Nothing -> noop   where 	-- The adjusted branch may need to be updated, if the adjustment 	-- is not stable, and the usual configuration does not update it.-	updateadjustedbranch adj = unless (adjustmentIsStable adj) $-		annexAdjustedBranchRefresh <$> Annex.getGitConfig >>= \case-			0 -> adjustedBranchRefreshFull adj branch-			_ -> return ()+	updateadjustedbranch adj = +		unless (adjustmentIsStable getAdjustTreeItem adj) $+			annexAdjustedBranchRefresh <$> Annex.getGitConfig >>= \case+				0 -> adjustedBranchRefreshFull adj getAdjustTreeItem branch+				_ -> return () 	 	updateview view madj' = updateView view madj' >>= \case 		Nothing -> noop@@ -710,8 +713,8 @@ 			repo <- Remote.getRepo remote 			showOutput 			ms <- Annex.getState Annex.output-			ok <- inRepoWithSshOptionsTo repo gc $-				pushBranch remote mainbranch ms+			pb <- pushBranch remote mainbranch ms+			ok <- inRepoWithSshOptionsTo repo gc pb 			if ok 				then postpushupdate repo 				else do@@ -753,8 +756,8 @@ 				<&&> 			needUpdateInsteadEmulation			 -{- Pushes a regular branch like master to a remote. Also pushes the git-annex- - branch.+{- Returns an IO action that pushes a regular branch like master to a remote,+ - and pushes the git-annex branch.  -  - If the remote is a bare git repository, it's best to push the regular  - branch directly to it, so that cloning/pulling will get it.@@ -788,13 +791,23 @@  - new data is usually sent in this push (due to synced/git-annex already  - having been pushed), it's ok to hide git's output to avoid displaying  - a push error.+ - + - When the remote's git-annex branch has been incorporated in a+ - transition, push of the git-annex branch is forced, with a lease, + - to avoid the push failing due to a non fast-forward.  -}-pushBranch :: Remote -> Maybe Git.Branch -> MessageState -> Git.Repo -> IO Bool-pushBranch remote mbranch ms g = do-	directpushed <- directpush-	annexpush `after` syncpush directpushed+pushBranch+	:: Remote+	-> Maybe Git.Branch+	-> MessageState+	-> Annex (Git.Repo -> IO Bool)+pushBranch remote mbranch ms = do+	annexpush <- getannexpush+	return $ \g -> do+		directpushed <- directpush g+		annexpush g `after` syncpush directpushed g   where-	directpush = case mbranch of+	directpush g = case mbranch of 		Just branch -> do 			let p = flip Git.Command.gitCreateProcess g $ 				pushparams True@@ -806,7 +819,7 @@ 			return (True, exitcode == ExitSuccess) 		Nothing -> return (False, False) 	-	syncpush (directpushed, directbranchupdated) =  do+	syncpush (directpushed, directbranchupdated) g = do 		let p = flip Git.Command.gitCreateProcess g $ 			pushparams (not directpushed) $ catMaybes 				[ if not directbranchupdated@@ -822,8 +835,22 @@ 			relaystderr (stderrHandle h) (processHandle h) 			checkSuccessProcess (processHandle h) 	-	annexpush = void $ tryIO $ flip Git.Command.runQuiet g $ pushparams False-		[ Git.fromRef $ Git.Ref.base $ Annex.Branch.name ]+	getannexpush = do+		let rb = remoteBranch remote Annex.Branch.name+		leaseopt <- Annex.Branch.checkTransitionedRef rb >>= return . \case+			Just sha -> Just $ concat+				[ "--force-with-lease="+				, Git.fromRef Annex.Branch.name+				, ":"+				, Git.fromRef sha+				]+			Nothing -> Nothing+		return $ \g ->+			void $ tryIO $ flip Git.Command.runQuiet g $+				pushparams False $ catMaybes +					[ Just $ Git.fromRef $ Git.Ref.base $ Annex.Branch.name+					, leaseopt+					] 	 	-- In the default configuration of receive.denyCurrentBranch, 	-- git's stderr message mentions that config setting@@ -853,7 +880,7 @@ 			relaystderr herr pid 		Nothing -> return () -	pushparams forceprogress branches = catMaybes+	pushparams forceprogress ps = catMaybes 		[ Just $ Param "push" 		, if commandProgressDisabled' ms 			then Just $ Param "--quiet"@@ -861,7 +888,7 @@ 				then Just $ Param "--progress" 				else Nothing 		, Just $ Param $ Remote.name remote-		] ++ map Param branches+		] ++ map Param ps 	 	syncrefspec b = concat  		[ Git.fromRef $ Git.Ref.base b@@ -1100,7 +1127,7 @@ 		-- branch, it will be up-to-date. 		case (mcurrbranch, madj) of 			(Just currbranch, Just adj) ->-				propigateAdjustedCommits currbranch adj+				propigateAdjustedCommits currbranch adj getAdjustTreeItem 			_ -> noop 		or <$> forM rs go   where
Logs/File.hs view
@@ -131,7 +131,7 @@ -- streamed. It is run even if the log file does not exist. If the -- finalizer throws an exception, the log file is left unchanged. -- --- Locking is used to prevent writes to to the log file while this+-- Locking is used to prevent writes to the log file while this -- is running. streamLogFile :: OsPath -> OsPath -> Annex () -> (String -> Annex ()) -> Annex () streamLogFile f lck finalizer processor =
+ Types/AdjustTreeItem.hs view
@@ -0,0 +1,19 @@+{- type for adjusting a TreeItem+ -+ - Copyright 2016-2026 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Types.AdjustTreeItem where++import Annex.Common+import Types.AdjustedBranch+import Git.Tree (TreeItem(..))++data AdjustTreeItem = AdjustTreeItem+	-- How to perform various adjustments to a TreeItem.+	{ adjustTreeItem :: Adjustment -> TreeItem -> Annex (Maybe TreeItem)+	-- Will adjusting a given tree always yield the same adjusted tree?+	, adjustmentIsStable :: Adjustment -> Bool+	}
Types/AdjustedBranch.hs view
@@ -1,6 +1,6 @@ {- adjusted branch types  -- - Copyright 2016-2020 Joey Hess <id@joeyh.name>+ - Copyright 2016-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -11,6 +11,7 @@ 	= LinkAdjustment LinkAdjustment 	| PresenceAdjustment PresenceAdjustment (Maybe LinkAdjustment) 	| LockUnlockPresentAdjustment LockUnlockPresentAdjustment+	| WantedAdjustment WantedAdjustment (Maybe LinkAdjustment) 	deriving (Show, Eq)  data LinkAdjustment@@ -30,6 +31,11 @@ 	| LockPresentAdjustment 	deriving (Show, Eq) +data WantedAdjustment+	= HideUnwantedAdjustment+	| ShowUnwantedAdjustment+	deriving (Show, Eq)+ -- Adjustments have to be able to be reversed, so that commits made to the -- adjusted branch can be reversed to the commit that would have been made -- without the adjustment and applied to the original branch.@@ -43,6 +49,8 @@ 		PresenceAdjustment (reverseAdjustment p) (fmap reverseAdjustment ml) 	reverseAdjustment (LockUnlockPresentAdjustment l) = 		LockUnlockPresentAdjustment (reverseAdjustment l)+	reverseAdjustment (WantedAdjustment l ml) = +		WantedAdjustment (reverseAdjustment l) (fmap reverseAdjustment ml)  instance ReversableAdjustment LinkAdjustment where 	reverseAdjustment UnlockAdjustment = LockAdjustment@@ -59,6 +67,11 @@ 	reverseAdjustment UnlockPresentAdjustment = LockPresentAdjustment 	reverseAdjustment LockPresentAdjustment = UnlockPresentAdjustment +instance ReversableAdjustment WantedAdjustment where+	reverseAdjustment HideUnwantedAdjustment = ShowUnwantedAdjustment+	reverseAdjustment ShowUnwantedAdjustment = HideUnwantedAdjustment+ adjustmentHidesFiles :: Adjustment -> Bool adjustmentHidesFiles (PresenceAdjustment HideMissingAdjustment _) = True+adjustmentHidesFiles (WantedAdjustment HideUnwantedAdjustment _) = True adjustmentHidesFiles _ = False
Upgrade/V5.hs view
@@ -31,6 +31,7 @@ import Git.Ref import Utility.InodeCache import Annex.AdjustedBranch+import Annex.AdjustTreeItem import qualified Utility.FileIO as F  upgrade :: Bool -> Annex UpgradeResult@@ -71,7 +72,7 @@ 	{- Create adjusted branch where all files are unlocked. 	 - This should have the same content for each file as 	 - have been staged in upgradeDirectWorkTree. -}-	AdjBranch b <- adjustBranch (LinkAdjustment UnlockAdjustment) cur+	AdjBranch b <- adjustBranch (LinkAdjustment UnlockAdjustment) getAdjustTreeItem cur 	{- Since the work tree was already set up by 	 - upgradeDirectWorkTree, and contains unlocked file 	 - contents too, don't use git checkout to check out the
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 10.20261006+Version: 10.20261020 Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -561,6 +561,7 @@     Annex.AdjustedBranch     Annex.AdjustedBranch.Merge     Annex.AdjustedBranch.Name+    Annex.AdjustTreeItem     Annex.AutoMerge     Annex.Balanced     Annex.BloomFilter@@ -1023,6 +1024,7 @@     Types     Types.ActionItem     Types.AdjustedBranch+    Types.AdjustTreeItem     Types.Availability     Types.Backend     Types.Benchmark