--branch, stage 2

Show branch:file that is being operated on.

I had to make ActionItem a type and not a type class because
withKeyOptions' passed two different types of values when using the type
class, and I could not get the type checker to accept that.

Annex/Drop.hs

@@ -117,10 +117,10 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do
 			)
 
 	dropl fs n = checkdrop fs n Nothing $ \numcopies ->
-		Command.Drop.startLocal afile numcopies key preverified
+		Command.Drop.startLocal afile (mkActionItem afile) numcopies key preverified
 
 	dropr fs r n  = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies ->
-		Command.Drop.startRemote afile numcopies key r
+		Command.Drop.startRemote afile (mkActionItem afile) numcopies key r
 
 	slocs = S.fromList locs
 	

CmdLine/Seek.hs

@@ -4,7 +4,7 @@
  - the values a user passes to a command, and prepare actions operating
  - on them.
  -
- - Copyright 2010-2015 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2016 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -161,19 +161,29 @@ withNothing _ _ = error "This command takes no parameters."
  -
  - Otherwise falls back to a regular CommandSeek action on
  - whatever params were passed. -}
-withKeyOptions :: Maybe KeyOptions -> Bool -> (Key -> CommandStart) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
+withKeyOptions 
+	:: Maybe KeyOptions
+	-> Bool
+	-> (Key -> ActionItem -> CommandStart)
+	-> (CmdParams -> CommandSeek)
+	-> CmdParams
+	-> CommandSeek
 withKeyOptions ko auto keyaction = withKeyOptions' ko auto mkkeyaction
   where
 	mkkeyaction = do
 		matcher <- Limit.getMatcher
-		return $ \getkeys ->
+		return $ \k i ->
-			seekActions $ map (process matcher) <$> getkeys
+			whenM (matcher $ MatchingKey k) $
-	process matcher k = ifM (matcher $ MatchingKey k)
+				commandAction $ keyaction k i
-		( keyaction k
-		, return Nothing
-		)
 
-withKeyOptions' :: Maybe KeyOptions -> Bool -> Annex (Annex [Key] -> Annex ()) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
+withKeyOptions' 
+	:: Maybe KeyOptions
+	-> Bool
+	-> Annex (Key -> ActionItem -> Annex ())
+	-> (CmdParams
+	-> CommandSeek)
+	-> CmdParams
+	-> CommandSeek
 withKeyOptions' ko auto mkkeyaction fallbackaction params = do
 	bare <- fromRepo Git.repoIsLocalBare
 	when (auto && bare) $
@@ -194,15 +204,17 @@ withKeyOptions' ko auto mkkeyaction fallbackaction params = do
 		| auto = error "Cannot use --auto with --all or --branch or --unused or --key or --incomplete"
 		| otherwise = a
 	incompletekeys = staleKeysPrune gitAnnexTmpObjectDir True
-	runkeyaction ks = do
+	runkeyaction getks = do
 		keyaction <- mkkeyaction
-		keyaction ks
+		ks <- getks
+		forM_ ks $ \k -> keyaction k (mkActionItem k)
 	runbranchkeys bs = do
 		keyaction <- mkkeyaction
 		forM_ bs $ \b -> do
 			(l, cleanup) <- inRepo $ LsTree.lsTree b
-			forM_ l $ \i ->
+			forM_ l $ \i -> do
-				maybe noop (\k -> keyaction (return [k]))
+				let bfp = mkActionItem $ BranchFilePath b (LsTree.file i)
+				maybe noop (\k -> keyaction k bfp)
 					=<< catKey (LsTree.sha i)
 			unlessM (liftIO cleanup) $
 				error ("git ls-tree " ++ Git.fromRef b ++ " failed")

Command/Drop.hs

@@ -63,36 +63,38 @@ seek o = allowConcurrentOutput $
 	go = whenAnnexed $ start o
 
 start :: DropOptions -> FilePath -> Key -> CommandStart
-start o file key = start' o key (Just file)
+start o file key = start' o key afile (mkActionItem afile)
+  where
+	afile = Just file
 
-start' :: DropOptions -> Key -> AssociatedFile -> CommandStart
+start' :: DropOptions -> Key -> AssociatedFile -> ActionItem -> CommandStart
-start' o key afile = do
+start' o key afile ai = do
 	from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o)
 	checkDropAuto (autoMode o) from afile key $ \numcopies ->
 		stopUnless (want from) $
 			case from of
-				Nothing -> startLocal afile numcopies key []
+				Nothing -> startLocal afile ai numcopies key []
 				Just remote -> do
 					u <- getUUID
 					if Remote.uuid remote == u
-						then startLocal afile numcopies key []
+						then startLocal afile ai numcopies key []
-						else startRemote afile numcopies key remote
+						else startRemote afile ai numcopies key remote
 	  where
 		want from
 			| autoMode o = wantDrop False (Remote.uuid <$> from) (Just key) afile
 			| otherwise = return True
 
-startKeys :: DropOptions -> Key -> CommandStart
+startKeys :: DropOptions -> Key -> ActionItem -> CommandStart
 startKeys o key = start' o key Nothing
 
-startLocal :: AssociatedFile -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart
+startLocal :: AssociatedFile -> ActionItem -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart
-startLocal afile numcopies key preverified = stopUnless (inAnnex key) $ do
+startLocal afile ai numcopies key preverified = stopUnless (inAnnex key) $ do
-	showStart' "drop" key afile
+	showStart' "drop" key ai
 	next $ performLocal key afile numcopies preverified
 
-startRemote :: AssociatedFile -> NumCopies -> Key -> Remote -> CommandStart
+startRemote :: AssociatedFile -> ActionItem -> NumCopies -> Key -> Remote -> CommandStart
-startRemote afile numcopies key remote = do
+startRemote afile ai numcopies key remote = do
-	showStart' ("drop " ++ Remote.name remote) key afile
+	showStart' ("drop " ++ Remote.name remote) key ai
 	next $ performRemote key afile numcopies remote
 
 performLocal :: Key -> AssociatedFile -> NumCopies -> [VerifiedCopy] -> CommandPerform

Command/DropKey.hs

@@ -42,7 +42,7 @@ seek o = do
 
 start :: Key -> CommandStart
 start key = do
-	showStart' "dropkey" key key
+	showStart' "dropkey" key (mkActionItem key)
 	next $ perform key
 
 perform :: Key -> CommandPerform

Command/Fsck.hs

@@ -89,7 +89,7 @@ seek o = allowConcurrentOutput $ do
 	checkDeadRepo u
 	i <- prepIncremental u (incrementalOpt o)
 	withKeyOptions (keyOptions o) False
-		(\k -> startKey i k =<< getNumCopies)
+		(\k ai -> startKey i k ai =<< getNumCopies)
 		(withFilesInGit $ whenAnnexed $ start from i)
 		(fsckFiles o)
 	cleanupIncremental i
@@ -111,7 +111,7 @@ start from inc file key = do
 				Nothing -> go $ perform key file backend numcopies
 				Just r -> go $ performRemote key file backend numcopies r
   where
-	go = runFsck inc file key
+	go = runFsck inc (mkActionItem (Just file)) key
 
 perform :: Key -> FilePath -> Backend -> NumCopies -> Annex Bool
 perform key file backend numcopies = do
@@ -173,11 +173,11 @@ performRemote key file backend numcopies remote =
 		)
 	dummymeter _ = noop
 
-startKey :: Incremental -> Key -> NumCopies -> CommandStart
+startKey :: Incremental -> Key -> ActionItem -> NumCopies -> CommandStart
-startKey inc key numcopies =
+startKey inc key ai numcopies =
 	case Backend.maybeLookupBackendName (keyBackendName key) of
 		Nothing -> stop
-		Just backend -> runFsck inc (key2file key) key $
+		Just backend -> runFsck inc ai key $
 			performKey key backend numcopies
 
 performKey :: Key -> Backend -> NumCopies -> Annex Bool
@@ -504,10 +504,10 @@ badContentRemote remote localcopy key = do
 		(False, True) -> "dropped from " ++ Remote.name remote
 		(_, False) -> "failed to drop from" ++ Remote.name remote
 
-runFsck :: Incremental -> FilePath -> Key -> Annex Bool -> CommandStart
+runFsck :: Incremental -> ActionItem -> Key -> Annex Bool -> CommandStart
-runFsck inc file key a = ifM (needFsck inc key)
+runFsck inc ai key a = ifM (needFsck inc key)
 	( do
-		showStart "fsck" file
+		showStart' "fsck" key ai
 		next $ do
 			ok <- a
 			when ok $

Command/Get.hs

@@ -49,17 +49,18 @@ seek o = allowConcurrentOutput $ do
 			(getFiles o)
 
 start :: GetOptions -> Maybe Remote -> FilePath -> Key -> CommandStart
-start o from file key = start' expensivecheck from key (Just file)
+start o from file key = start' expensivecheck from key afile (mkActionItem afile)
   where
+	afile = Just file
 	expensivecheck
 		| autoMode o = numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)
 		| otherwise = return True
 
-startKeys :: Maybe Remote -> Key -> CommandStart
+startKeys :: Maybe Remote -> Key -> ActionItem -> CommandStart
 startKeys from key = start' (return True) from key Nothing
 
-start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> CommandStart
+start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> CommandStart
-start' expensivecheck from key afile = stopUnless (not <$> inAnnex key) $
+start' expensivecheck from key afile ai = stopUnless (not <$> inAnnex key) $
 	stopUnless expensivecheck $
 		case from of
 			Nothing -> go $ perform key afile
@@ -68,7 +69,7 @@ start' expensivecheck from key afile = stopUnless (not <$> inAnnex key) $
 					go $ Command.Move.fromPerform src False key afile
   where
 	go a = do
-		showStart' "get" key afile
+		showStart' "get" key ai
 		next a
 
 perform :: Key -> AssociatedFile -> CommandPerform

Command/MetaData.hs

@@ -69,20 +69,19 @@ seek o = do
 		(forFiles o)
 
 start :: POSIXTime -> MetaDataOptions -> FilePath -> Key -> CommandStart
-start now o file = start' (Just file) now o
+start now o file k = startKeys now o k (mkActionItem afile)
+  where
+	afile = Just file
 
-startKeys :: POSIXTime -> MetaDataOptions -> Key -> CommandStart
+startKeys :: POSIXTime -> MetaDataOptions -> Key -> ActionItem -> CommandStart
-startKeys = start' Nothing
+startKeys now o k ai = case getSet o of
-
-start' :: AssociatedFile -> POSIXTime -> MetaDataOptions -> Key -> CommandStart
-start' afile now o k = case getSet o of
 	Get f -> do
 		l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k
 		liftIO $ forM_ l $
 			putStrLn . fromMetaValue
 		stop
 	_ -> do
-		showStart' "metadata" k afile
+		showStart' "metadata" k ai
 		next $ perform now o k
 
 perform :: POSIXTime -> MetaDataOptions -> Key -> CommandPerform

Command/Mirror.hs

@@ -47,25 +47,27 @@ seek o = allowConcurrentOutput $
 		(mirrorFiles o)
 
 start :: MirrorOptions -> FilePath -> Key -> CommandStart
-start o file = startKey o (Just file)
+start o file k = startKey o afile k (mkActionItem afile)
+  where
+	afile = Just file
 
-startKey :: MirrorOptions -> Maybe FilePath -> Key -> CommandStart
+startKey :: MirrorOptions -> Maybe FilePath -> Key -> ActionItem -> CommandStart
-startKey o afile key = case fromToOptions o of
+startKey o afile key ai = case fromToOptions o of
 	ToRemote r -> ifM (inAnnex key)
-		( Command.Move.toStart False afile key =<< getParsed r
+		( Command.Move.toStart False afile key ai =<< getParsed r
 		, do
 			numcopies <- getnumcopies
-			Command.Drop.startRemote afile numcopies key =<< getParsed r
+			Command.Drop.startRemote afile ai numcopies key =<< getParsed r
 		)
 	FromRemote r -> do
 		haskey <- flip Remote.hasKey key =<< getParsed r
 		case haskey of
 			Left _ -> stop
-			Right True -> Command.Get.start' (return True) Nothing key afile
+			Right True -> Command.Get.start' (return True) Nothing key afile ai
 			Right False -> ifM (inAnnex key)
 				( do
 					numcopies <- getnumcopies
-					Command.Drop.startLocal afile numcopies key []
+					Command.Drop.startLocal afile ai numcopies key []
 				, stop
 				)
   where

Command/Move.hs

@@ -51,18 +51,20 @@ seek o = allowConcurrentOutput $
 		(moveFiles o)
 
 start :: MoveOptions -> Bool -> FilePath -> Key -> CommandStart
-start o move = start' o move . Just
+start o move f k = start' o move afile k (mkActionItem afile)
+  where
+	afile = Just f
 
-startKey :: MoveOptions -> Bool -> Key -> CommandStart
+startKey :: MoveOptions -> Bool -> Key -> ActionItem -> CommandStart
 startKey o move = start' o move Nothing
 
-start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> CommandStart
+start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart
-start' o move afile key = 
+start' o move afile key ai = 
 	case fromToOptions o of
-		FromRemote src -> fromStart move afile key =<< getParsed src
+		FromRemote src -> fromStart move afile key ai =<< getParsed src
-		ToRemote dest -> toStart move afile key =<< getParsed dest
+		ToRemote dest -> toStart move afile key ai =<< getParsed dest
 
-showMoveAction :: Bool -> Key -> AssociatedFile -> Annex ()
+showMoveAction :: Bool -> Key -> ActionItem -> Annex ()
 showMoveAction move = showStart' (if move then "move" else "copy")
 
 {- Moves (or copies) the content of an annexed file to a remote.
@@ -74,16 +76,16 @@ showMoveAction move = showStart' (if move then "move" else "copy")
  - A file's content can be moved even if there are insufficient copies to
  - allow it to be dropped.
  -}
-toStart :: Bool -> AssociatedFile -> Key -> Remote -> CommandStart
+toStart :: Bool -> AssociatedFile -> Key -> ActionItem -> Remote -> CommandStart
-toStart move afile key dest = do
+toStart move afile key ai dest = do
 	u <- getUUID
 	ishere <- inAnnex key
 	if not ishere || u == Remote.uuid dest
 		then stop -- not here, so nothing to do
-		else toStart' dest move afile key
+		else toStart' dest move afile key ai
 
-toStart' :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart
+toStart' :: Remote -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart
-toStart' dest move afile key = do
+toStart' dest move afile key ai = do
 	fast <- Annex.getState Annex.fast
 	if fast && not move && not (Remote.hasKeyCheap dest)
 		then ifM (expectedPresent dest key)
@@ -93,7 +95,7 @@ toStart' dest move afile key = do
 		else go False (Remote.hasKey dest key)
   where
 	go fastcheck isthere = do
-		showMoveAction move key afile
+		showMoveAction move key ai
 		next $ toPerform dest move key afile fastcheck =<< isthere
 
 expectedPresent :: Remote -> Key -> Annex Bool
@@ -143,13 +145,13 @@ toPerform dest move key afile fastcheck isthere =
  - If the current repository already has the content, it is still removed
  - from the remote.
  -}
-fromStart :: Bool -> AssociatedFile -> Key -> Remote -> CommandStart
+fromStart :: Bool -> AssociatedFile -> Key -> ActionItem -> Remote -> CommandStart
-fromStart move afile key src
+fromStart move afile key ai src
 	| move = go
 	| otherwise = stopUnless (not <$> inAnnex key) go
   where
 	go = stopUnless (fromOk src key) $ do
-		showMoveAction move key afile
+		showMoveAction move key ai
 		next $ fromPerform src move key afile
 
 fromOk :: Remote -> Key -> Annex Bool

Command/SetPresentKey.hs

@@ -23,7 +23,7 @@ seek = withWords start
 
 start :: [String] -> CommandStart
 start (ks:us:vs:[]) = do
-	showStart' "setpresentkey" k k
+	showStart' "setpresentkey" k (mkActionItem k)
 	next $ perform k (toUUID us) s
   where
 	k = fromMaybe (error "bad key") (file2key ks)

Command/Sync.hs

@@ -449,8 +449,7 @@ seekSyncContent o rs = do
   where
 	seekworktree mvar l bloomfeeder = seekHelper LsFiles.inRepo l >>=
 		mapM_ (\f -> ifAnnexed f (go (Right bloomfeeder) mvar (Just f)) noop)
-	seekkeys mvar bloom getkeys =
+	seekkeys mvar bloom k _ = go (Left bloom) mvar Nothing k
-		mapM_ (go (Left bloom) mvar Nothing) =<< getkeys
 	go ebloom mvar af k = commandAction $ do
 		whenM (syncFile ebloom rs af k) $
 			void $ liftIO $ tryPutMVar mvar ()
@@ -512,7 +511,7 @@ syncFile ebloom rs af k = do
 		, return []
 		)
 	get have = includeCommandAction $ do
-		showStart' "get" k af
+		showStart' "get" k (mkActionItem af)
 		next $ next $ getKey' k af have
 
 	wantput r
@@ -527,4 +526,4 @@ syncFile ebloom rs af k = do
 		, return []
 		)
 	put dest = includeCommandAction $ 
-		Command.Move.toStart' dest False af k
+		Command.Move.toStart' dest False af k (mkActionItem af)

Command/Whereis.hs

@@ -47,14 +47,13 @@ seek o = do
 				(whereisFiles o)
 
 start :: M.Map UUID Remote -> FilePath -> Key -> CommandStart
-start remotemap file key = start' remotemap key (Just file)
+start remotemap file key = startKeys remotemap key (mkActionItem afile)
+  where
+	afile = Just file
 
-startKeys :: M.Map UUID Remote -> Key -> CommandStart
+startKeys :: M.Map UUID Remote -> Key -> ActionItem -> CommandStart
-startKeys remotemap key = start' remotemap key Nothing
+startKeys remotemap key ai = do
-
+	showStart' "whereis" key ai
-start' :: M.Map UUID Remote -> Key -> AssociatedFile -> CommandStart
-start' remotemap key afile = do
-	showStart' "whereis" key afile
 	next $ perform remotemap key
 
 perform :: M.Map UUID Remote -> Key -> CommandPerform

Git/FilePath.hs

@@ -14,6 +14,8 @@
 
 module Git.FilePath (
 	TopFilePath,
+	BranchFilePath(..),
+	descBranchFilePath,
 	getTopFilePath,
 	fromTopFilePath,
 	toTopFilePath,
@@ -33,6 +35,13 @@ import qualified System.FilePath.Posix
 newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath }
 	deriving (Show, Eq, Ord)
 
+{- A file in a branch or other treeish. -}
+data BranchFilePath = BranchFilePath Ref TopFilePath
+
+{- Git uses the branch:file form to refer to a BranchFilePath -}
+descBranchFilePath :: BranchFilePath -> String
+descBranchFilePath (BranchFilePath b f) = fromRef b ++ ':' : getTopFilePath f
+
 {- Path to a TopFilePath, within the provided git repo. -}
 fromTopFilePath :: TopFilePath -> Git.Repo -> FilePath
 fromTopFilePath p repo = combine (repoPath repo) (getTopFilePath p)

Messages.hs

@@ -9,6 +9,8 @@
 
 module Messages (
 	showStart,
+	ActionItem,
+	mkActionItem,
 	showStart',
 	showNote,
 	showAction,
@@ -50,36 +52,50 @@ import System.Log.Handler.Simple
 import Common
 import Types
 import Types.Messages
+import Git.FilePath
 import Messages.Internal
 import qualified Messages.JSON as JSON
 import Types.Key
 import qualified Annex
 
 showStart :: String -> FilePath -> Annex ()
-showStart command file = outputMessage (JSON.start command (Just file) Nothing) $
+showStart command file = outputMessage json $
 	command ++ " " ++ file ++ " "
+  where
+	json = JSON.start command (Just file) Nothing
 
-class ActionItem i where
+data ActionItem 
-	actionItemDesc :: i -> Key -> String
+	= ActionItemAssociatedFile AssociatedFile
-	actionItemWorkTreeFile :: i -> Maybe FilePath
+	| ActionItemKey
+	| ActionItemBranchFilePath BranchFilePath
 
-instance ActionItem FilePath where
+class MkActionItem t where
-	actionItemDesc f _ = f
+	mkActionItem :: t -> ActionItem
-	actionItemWorkTreeFile = Just
 
-instance ActionItem AssociatedFile where
+instance MkActionItem AssociatedFile where
-	actionItemDesc (Just f) _ = f
+	mkActionItem = ActionItemAssociatedFile
-	actionItemDesc Nothing k = key2file k
-	actionItemWorkTreeFile = id
 
-instance ActionItem Key where
+instance MkActionItem Key where
-	actionItemDesc k _ = key2file k
+	mkActionItem _ = ActionItemKey
+
+instance MkActionItem BranchFilePath where
+	mkActionItem = ActionItemBranchFilePath
+
+actionItemDesc :: ActionItem -> Key -> String
+actionItemDesc (ActionItemAssociatedFile (Just f)) _ = f
+actionItemDesc (ActionItemAssociatedFile Nothing) k = key2file k
+actionItemDesc ActionItemKey k = key2file k
+actionItemDesc (ActionItemBranchFilePath bfp) _ = descBranchFilePath bfp
+
+actionItemWorkTreeFile :: ActionItem -> Maybe FilePath
+actionItemWorkTreeFile (ActionItemAssociatedFile af) = af
 actionItemWorkTreeFile _ = Nothing
 
-showStart' :: ActionItem i => String -> Key -> i -> Annex ()
+showStart' :: String -> Key -> ActionItem -> Annex ()
-showStart' command key i = 
+showStart' command key i = outputMessage json $
-	outputMessage (JSON.start command (actionItemWorkTreeFile i) (Just key)) $
 	command ++ " " ++ actionItemDesc i key ++ " "
+  where
+	json = JSON.start command (actionItemWorkTreeFile i) (Just key)
 
 showNote :: String -> Annex ()
 showNote s = outputMessage (JSON.note s) $ "(" ++ s ++ ") "

doc/todo/operate_on_branch_contents.mdwn

@@ -26,3 +26,5 @@ or `refs/tags/*` can be operated on. --[[Joey]]
 >> I've implemented the first part of this, so --branch works
 >> but the name of the key is shown, rather than the file from the branch.
 >> --[[Joey]]
+
+>>> All [[done]] now. --[[Joey]]