understand adjusted view branch names

An adjusted view branch has a name like
"refs/heads/adjusted/views/master(author=_)(unlocked)", so it is a view
branch that has been converted to an adjusted branch.

Made Logs.View support such branch names. So now git-annex sync and
pre-commit handle updating metadata on commit in such a branch.

Much remains to be done to fully support adjusted view branches,
including actually applying the adjustment when updating the view branch.

Sponsored-by: Graham Spencer on Patreon

Command/PreCommit.hs

@@ -45,10 +45,9 @@ seek ps = do
 	runAnnexHook preCommitAnnexHook
 
 	-- committing changes to a view updates metadata
-	mv <- currentView
-	case mv of
+	currentView >>= \case
 		Nothing -> noop
-		Just v -> withViewChanges
+		Just (v, _madj) -> withViewChanges
 			(addViewMetaData v)
 			(removeViewMetaData v)
 

Command/Sync.hs

@@ -439,32 +439,33 @@ pushLocal o b = stopUnless (notOnlyAnnex o) $ do
 updateBranches :: CurrBranch -> Annex ()
 updateBranches (Nothing, _) = noop
 updateBranches (Just branch, madj) = do
-	-- When in an adjusted branch, propigate any changes made to it
-	-- back to the original branch. The adjusted branch may also need
-	-- to be updated, if the adjustment is not stable, and the usual
-	-- configuration does not update it.
-	case madj of
-		Just adj -> do
-			let origbranch = branch
-			propigateAdjustedCommits origbranch adj
-			unless (adjustmentIsStable adj) $
-				annexAdjustedBranchRefresh <$> Annex.getGitConfig >>= \case
-					0 -> adjustedBranchRefreshFull adj origbranch
-					_ -> return ()
-		-- When in a view branch, update it to reflect any changes
-		-- of its parent branch or the metadata.
-		Nothing -> currentView >>= \case
+	-- When in a view branch, update it to reflect any changes
+	-- of its parent branch or the metadata.
+	currentView >>= \case
+		Just (view, madj') -> updateView view madj' >>= \case
 			Nothing -> noop
-			Just view -> updateView view >>= \case
-				Nothing -> noop
-				Just newcommit -> do
-					ok <- inRepo $ Git.Command.runBool
-						[ Param "merge"
-						, Param (Git.fromRef newcommit)
-						]
-					unless ok $
-						giveup $ "failed to update view"
-					
+			Just newcommit -> do
+				ok <- inRepo $ Git.Command.runBool
+					[ Param "merge"
+					, Param (Git.fromRef newcommit)
+					]
+				unless ok $
+					giveup $ "failed to update view"
+		-- When in an adjusted branch, propigate any changes
+		-- made to it back to the original branch. The adjusted
+		-- branch may also need to be updated, if the adjustment
+		-- is not stable, and the usual configuration does not
+		-- update it.
+		Nothing -> case madj of
+			Just adj -> do
+				let origbranch = branch
+				propigateAdjustedCommits origbranch adj
+				unless (adjustmentIsStable adj) $
+					annexAdjustedBranchRefresh <$> Annex.getGitConfig >>= \case
+						0 -> adjustedBranchRefreshFull adj origbranch
+						_ -> return ()
+			Nothing -> noop
+	
 	-- Update the sync branch to match the new state of the branch
 	inRepo $ updateBranch (syncBranch branch) (fromViewBranch branch)
 

Command/VAdd.hs

@@ -23,7 +23,7 @@ seek = withWords (commandAction . start)
 
 start :: [String] -> CommandStart
 start params = starting "vadd" (ActionItemOther Nothing) (SeekInput params) $ 
-	withCurrentView $ \view -> do
+	withCurrentView $ \view madj -> do
 		vu <- annexViewUnsetDirectory <$> Annex.getGitConfig
 		let (view', change) = refineView view $
 			map (parseViewParam vu) (reverse params)
@@ -34,5 +34,5 @@ start params = starting "vadd" (ActionItemOther Nothing) (SeekInput params) $
 			Narrowing -> next $ do
 				if visibleViewSize view' == visibleViewSize view
 					then giveup "That would not add an additional level of directory structure to the view. To filter the view, use vfilter instead of vadd."
-					else checkoutViewBranch view' narrowView
+					else checkoutViewBranch view' madj narrowView
 			Widening -> giveup "Widening view to match more files is not currently supported."

Command/VCycle.hs

@@ -26,13 +26,13 @@ start ::CommandStart
 start = go =<< currentView
   where
 	go Nothing = giveup "Not in a view."
-	go (Just v) = starting "vcycle" (ActionItemOther Nothing) (SeekInput []) $ do
+	go (Just (v, madj)) = starting "vcycle" (ActionItemOther Nothing) (SeekInput []) $ do
 		let v' = v { viewComponents = vcycle [] (viewComponents v) }
 		if v == v'
 			then do
 				showNote "unchanged"
 				next $ return True
-			else next $ checkoutViewBranch v' narrowView
+			else next $ checkoutViewBranch v' madj narrowView
 
 	vcycle rest (c:cs)
 		| viewVisible c = rest ++ cs ++ [c]

Command/VFilter.hs

@@ -22,10 +22,10 @@ seek = withWords (commandAction . start)
 
 start :: [String] -> CommandStart
 start params = starting "vfilter" (ActionItemOther Nothing) (SeekInput params) $
-	withCurrentView $ \view -> do
+	withCurrentView $ \view madj -> do
 		vu <- annexViewUnsetDirectory <$> Annex.getGitConfig
 		let view' = filterView view $
 			map (parseViewParam vu) (reverse params)
 		next $ if visibleViewSize view' > visibleViewSize view
 			then giveup "That would add an additional level of directory structure to the view, rather than filtering it. If you want to do that, use vadd instead of vfilter."
-			else checkoutViewBranch view' narrowView
+			else checkoutViewBranch view' madj narrowView

Command/VPop.hs

@@ -27,7 +27,7 @@ start :: [String] -> CommandStart
 start ps = go =<< currentView
   where
 	go Nothing = giveup "Not in a view."
-	go (Just v) = starting "vpop" ai si $ do
+	go (Just (v, madj)) = starting "vpop" ai si $ do
 		removeView v
 		(oldvs, vs) <- splitAt (num - 1) . filter (sameparentbranch v)
 			<$> recentViews
@@ -35,7 +35,8 @@ start ps = go =<< currentView
 		case vs of
 			(oldv:_) -> next $ do
 				showOutput
-				checkoutViewBranch oldv (return . branchView)
+				checkoutViewBranch oldv madj
+					(\v' madj' -> return (branchView v' madj'))
 			_ -> next $ do
 				showOutput
 				inRepo $ Git.Command.runBool

Command/View.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2014-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -19,6 +19,7 @@ import Git.Status
 import Types.View
 import Annex.View
 import Logs.View
+import Types.AdjustedBranch
 
 import qualified System.FilePath.ByteString as P
 
@@ -43,7 +44,7 @@ start ps = ifM safeToEnterView
 	si = SeekInput ps
 	go view Nothing = starting "view" ai si $
 		perform view
-	go view (Just v)
+	go view (Just (v, _madj))
 		| v == view = stop
 		| otherwise = giveup "Already in a view. Use the vfilter and vadd commands to further refine this view."
 
@@ -75,7 +76,7 @@ safeToEnterView = do
 perform :: View -> CommandPerform
 perform view = do
 	showAction "searching"
-	next $ checkoutViewBranch view applyView
+	next $ checkoutViewBranch view Nothing applyView
 
 paramView :: String
 paramView = paramRepeating "TAG FIELD=GLOB ?TAG FIELD?=GLOB FIELD!=VALUE"
@@ -89,11 +90,11 @@ mkView ps = go =<< inRepo Git.Branch.current
 		return $ fst $ refineView (View b []) $
 			map (parseViewParam vu) (reverse ps)
 
-checkoutViewBranch :: View -> (View -> Annex Git.Branch) -> CommandCleanup
-checkoutViewBranch view mkbranch = do
+checkoutViewBranch :: View -> Maybe Adjustment -> (View -> Maybe Adjustment -> Annex Git.Branch) -> CommandCleanup
+checkoutViewBranch view madj mkbranch = do
 	here <- liftIO getCurrentDirectory
 
-	branch <- mkbranch view
+	branch <- mkbranch view madj
 	
 	showOutput
 	ok <- inRepo $ Git.Command.runBool