git-annex adjust --lock-missing

Like --hide-missing the branch does not get updated when content
availability changes.

Seems to basically work, but sync does not update it yet.

Also, when a file is present and so unlocked, git mv followed by
git-annex sync results in the basis branch being updated to contain the
file with the new name, unlocked. This seems different than what
happens in an adjusted unlocked branch, where the commit propigates back
locked. Probably the reverse adjustment code needs to be improved to
handle this case.

Annex/AdjustedBranch.hs

@@ -11,6 +11,7 @@ module Annex.AdjustedBranch (
 	Adjustment(..),
 	LinkAdjustment(..),
 	PresenceAdjustment(..),
+	LinkMissingAdjustment(..),
 	adjustmentHidesFiles,
 	OrigBranch,
 	AdjBranch(..),
@@ -76,31 +77,55 @@ instance AdjustTreeItem Adjustment where
 		adjustTreeItem p t >>= \case
 			Nothing -> return Nothing
 			Just t' -> adjustTreeItem l t'
+	adjustTreeItem (LinkMissingAdjustment l) t = adjustTreeItem l t
 
 instance AdjustTreeItem LinkAdjustment where
-	adjustTreeItem UnlockAdjustment = ifSymlink adjustToPointer noAdjust
+	adjustTreeItem UnlockAdjustment =
-	adjustTreeItem LockAdjustment = ifSymlink noAdjust adjustToSymlink
+		ifSymlink adjustToPointer noAdjust
-	adjustTreeItem FixAdjustment = ifSymlink adjustToSymlink noAdjust
+	adjustTreeItem LockAdjustment =
-	adjustTreeItem UnFixAdjustment = ifSymlink (adjustToSymlink' gitAnnexLinkCanonical) noAdjust
+		ifSymlink noAdjust adjustToSymlink
+	adjustTreeItem FixAdjustment =
+		ifSymlink adjustToSymlink noAdjust
+	adjustTreeItem UnFixAdjustment =
+		ifSymlink (adjustToSymlink' gitAnnexLinkCanonical) noAdjust
 
 instance AdjustTreeItem PresenceAdjustment where
-	adjustTreeItem HideMissingAdjustment = \ti@(TreeItem _ _ s) ->
+	adjustTreeItem HideMissingAdjustment = 
-		catKey s >>= \case
+		ifPresent noAdjust hideAdjust
-			Just k -> ifM (inAnnex k)
+	adjustTreeItem ShowMissingAdjustment =
-				( return (Just ti)
+		noAdjust
-				, return Nothing
-				)
-			Nothing -> return (Just ti)
-	adjustTreeItem ShowMissingAdjustment = noAdjust
 
-ifSymlink :: (TreeItem -> Annex a) -> (TreeItem -> Annex a) -> TreeItem -> Annex a
+instance AdjustTreeItem LinkMissingAdjustment where
+	adjustTreeItem LockMissingAdjustment = 
+		ifPresent adjustToPointer adjustToSymlink
+	adjustTreeItem UnlockMissingAdjustment =
+		noAdjust
+
+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
@@ -197,7 +222,20 @@ checkoutAdjustedBranch (AdjBranch b) checkoutparams = do
  - But, it can be implemented more efficiently than that.
  -}
 updateAdjustedBranch :: Adjustment -> AdjBranch -> OrigBranch -> Annex Bool
-updateAdjustedBranch adj@(PresenceAdjustment _ _) (AdjBranch currbranch) origbranch = do
+updateAdjustedBranch adj@(PresenceAdjustment _ _) currbranch origbranch =
+	updateAdjustedBranch' adj currbranch origbranch
+updateAdjustedBranch adj@(LinkMissingAdjustment _) currbranch origbranch =
+	updateAdjustedBranch' adj currbranch origbranch
+updateAdjustedBranch adj@(LinkAdjustment _) _ origbranch =
+	preventCommits $ \commitlck -> do
+		-- Not really needed here, but done for consistency.
+		_ <- propigateAdjustedCommits' origbranch adj commitlck
+		-- No need to do anything else, because link adjustments
+		-- are stable.
+		return True
+
+updateAdjustedBranch' :: Adjustment -> AdjBranch -> OrigBranch -> Annex Bool
+updateAdjustedBranch' adj (AdjBranch currbranch) origbranch = do
 	b <- preventCommits $ \commitlck -> do
 		-- Avoid losing any commits that the adjusted branch has that
 		-- have not yet been propigated back to the origbranch.
@@ -216,11 +254,6 @@ updateAdjustedBranch adj@(PresenceAdjustment _ _) (AdjBranch currbranch) origbra
 	-- Make git checkout quiet to avoid warnings about disconnected
 	-- branch tips being lost.
 	checkoutAdjustedBranch b [Param "--quiet"]
-updateAdjustedBranch adj@(LinkAdjustment _) _ origbranch = preventCommits $ \commitlck -> do
-	-- Not really needed here, but done for consistency.
-	_ <- propigateAdjustedCommits' origbranch adj commitlck
-	-- No need to do anything else, because link adjustments are stable.
-	return True
 
 adjustToCrippledFileSystem :: Annex ()
 adjustToCrippledFileSystem = do

Annex/AdjustedBranch/Name.hs

@@ -1,6 +1,6 @@
 {- adjusted branch names
  -
- - Copyright 2016-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2016-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -37,12 +37,16 @@ instance SerializeAdjustment Adjustment where
 		serializeAdjustment p
 	serializeAdjustment (PresenceAdjustment p (Just l)) = 
 		serializeAdjustment p <> "-" <> serializeAdjustment l
+	serializeAdjustment (LinkMissingAdjustment l) =
+		serializeAdjustment l
 	deserializeAdjustment s = 
 		(LinkAdjustment <$> deserializeAdjustment s)
 			<|>
 		(PresenceAdjustment <$> deserializeAdjustment s1 <*> pure (deserializeAdjustment s2))
 			<|>
 		(PresenceAdjustment <$> deserializeAdjustment s <*> pure Nothing)
+			<|>
+		(LinkMissingAdjustment <$> deserializeAdjustment s)
 	  where
 		(s1, s2) = separate' (== (fromIntegral (ord '-'))) s
 
@@ -64,6 +68,13 @@ instance SerializeAdjustment PresenceAdjustment where
 	deserializeAdjustment "showmissing" = Just ShowMissingAdjustment
 	deserializeAdjustment _ = Nothing
 
+instance SerializeAdjustment LinkMissingAdjustment where
+	serializeAdjustment LockMissingAdjustment = "lockmissing"
+	serializeAdjustment UnlockMissingAdjustment = "unlockmissing"
+	deserializeAdjustment "lockmissing" = Just LockMissingAdjustment
+	deserializeAdjustment "unlockmissing" = Just UnlockMissingAdjustment
+	deserializeAdjustment _ = Nothing
+
 newtype AdjBranch = AdjBranch { adjBranch :: Branch }
 
 originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch

CHANGELOG

@@ -8,6 +8,9 @@ git-annex (8.20201104) UNRELEASED; urgency=medium
     copied it from some other repository.
   * examinekey: Added two new format variables: objectpath and objectpointer
   * examinekey: Added --migrate-to-backend
+  * adjust: New --lock-missing mode which locks files whose content is not
+    present (so the broken symlink is visible), while unlocking files whose
+    content is present.
 
  -- Joey Hess <id@joeyh.name>  Mon, 09 Nov 2020 15:15:20 -0400
 

Command/Adjust.hs

@@ -19,6 +19,7 @@ optParser :: CmdParamsDesc -> Parser Adjustment
 optParser _ =
 	(LinkAdjustment <$> linkAdjustmentParser)
 	<|> (PresenceAdjustment <$> presenceAdjustmentParser <*> maybeLinkAdjustmentParser)
+	<|> (LinkMissingAdjustment <$> linkMissingAdjustmentParser)
 
 linkAdjustmentParser :: Parser LinkAdjustment
 linkAdjustmentParser =
@@ -45,6 +46,13 @@ presenceAdjustmentParser =
 		<> help "hide annexed files whose content is not present"
 		)
 
+linkMissingAdjustmentParser :: Parser LinkMissingAdjustment
+linkMissingAdjustmentParser =
+	flag' LockMissingAdjustment
+		( long "lock-missing"
+		<> help "lock files whose content is present; unlock rest"
+		)
+
 seek :: Adjustment -> CommandSeek
 seek = commandAction . start
 

Types/AdjustedBranch.hs

@@ -1,6 +1,6 @@
 {- adjusted branch types
  -
- - Copyright 2016-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2016-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -10,9 +10,9 @@ module Types.AdjustedBranch where
 data Adjustment
 	= LinkAdjustment LinkAdjustment
 	| PresenceAdjustment PresenceAdjustment (Maybe LinkAdjustment)
+	| LinkMissingAdjustment LinkMissingAdjustment
 	deriving (Show, Eq)
 
--- Doesn't make sense to combine unlock with fix.
 data LinkAdjustment
 	= UnlockAdjustment
 	| LockAdjustment
@@ -25,6 +25,11 @@ data PresenceAdjustment
 	| ShowMissingAdjustment
 	deriving (Show, Eq)
 
+data LinkMissingAdjustment
+	= LockMissingAdjustment
+	| UnlockMissingAdjustment
+	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.
@@ -36,6 +41,8 @@ instance ReversableAdjustment Adjustment where
 		LinkAdjustment (reverseAdjustment l)
 	reverseAdjustment (PresenceAdjustment p ml) =
 		PresenceAdjustment (reverseAdjustment p) (fmap reverseAdjustment ml)
+	reverseAdjustment (LinkMissingAdjustment l) =
+		LinkMissingAdjustment (reverseAdjustment l)
 
 instance ReversableAdjustment LinkAdjustment where
 	reverseAdjustment UnlockAdjustment = LockAdjustment
@@ -48,6 +55,10 @@ instance ReversableAdjustment PresenceAdjustment where
 	reverseAdjustment HideMissingAdjustment = ShowMissingAdjustment
 	reverseAdjustment ShowMissingAdjustment = HideMissingAdjustment
 
+instance ReversableAdjustment LinkMissingAdjustment where
+	reverseAdjustment LockMissingAdjustment = UnlockMissingAdjustment
+	reverseAdjustment UnlockMissingAdjustment = LockMissingAdjustment
+
 adjustmentHidesFiles :: Adjustment -> Bool
 adjustmentHidesFiles (PresenceAdjustment HideMissingAdjustment _) = True
 adjustmentHidesFiles _ = False

doc/git-annex-adjust.mdwn

@@ -86,10 +86,27 @@ back to the original branch.
 
   Despite missing files being hidden, `git annex sync --content` will
   still operate on them, and can be used to download missing
-  files from remotes.
+  files from remotes. It also updates the adjusted branch after
+  transferring content.
 
   This option can be combined with --unlock, --lock, or --fix.
 
+* `--lock-missing`
+
+  Lock files whose content is not present, and unlock files whose content
+  is present. This provides the benefits of working with unlocked files,
+  but makes it easier to see when the content of a file is not missing,
+  since it will be a broken symlink.
+  
+  The adjusted branch is not immediately changed when content availability
+  changes, so when you `git annex get` files, they will remain locked.
+  And when you `git annex drop` files, they will remain locked and so will
+  not be broken symlinks.
+  
+  To update the adjusted branch to reflect changes to content availability, 
+  run `git annex adjust --hide-missing` again. Or use `git-annex sync
+  --content`, which updates the branch after transferring content.
+
 # SEE ALSO
 
 [[git-annex]](1)