undo command

This commit was sponsored by Andrew Cant.

CmdLine/GitAnnex.hs

@@ -84,6 +84,7 @@ import qualified Command.Indirect
 import qualified Command.Upgrade
 import qualified Command.Forget
 import qualified Command.Proxy
+import qualified Command.Undo
 import qualified Command.Version
 import qualified Command.Help
 #ifdef WITH_ASSISTANT
@@ -177,6 +178,7 @@ cmds = concat
 	, Command.Upgrade.cmd
 	, Command.Forget.cmd
 	, Command.Proxy.cmd
+	, Command.Undo.cmd
 	, Command.Version.cmd
 	, Command.Help.cmd
 #ifdef WITH_ASSISTANT

Command/Undo.hs

@@ -0,0 +1,84 @@
+{- git-annex command
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Undo where
+
+import Common.Annex
+import Command
+import Config
+import Annex.Direct
+import Annex.CatFile
+import Git.DiffTree
+import Git.FilePath
+import Git.UpdateIndex
+import Git.Sha
+import qualified Git.LsFiles as LsFiles
+import qualified Git.Command as Git
+import qualified Git.Branch
+import qualified Command.Sync
+
+cmd :: [Command]
+cmd = [notBareRepo $
+	command "undo" paramPaths seek
+		SectionCommon "undo last change to a file or directory"]
+
+seek :: CommandSeek
+seek ps = do
+	-- Safety first; avoid any undo that would touch files that are not
+	-- in the index.
+	(fs, cleanup) <- inRepo $ LsFiles.notInRepo False ps
+	unless (null fs) $
+		error $ "Cannot undo changes to files that are not checked into git: " ++ unwords fs
+	void $ liftIO $ cleanup
+
+	-- Committing staged changes before undo allows later
+	-- undoing the undo. It would be nicer to only commit staged
+	-- changes to the specified files, rather than all staged changes,
+	-- but that is difficult to do; a partial git-commit can't be done 
+	-- in direct mode.
+	void $ Command.Sync.commitStaged Git.Branch.ManualCommit
+		"commit before undo"
+	
+	withStrings start ps
+
+start :: FilePath -> CommandStart
+start p = do
+	showStart "undo" p
+	next $ perform p
+
+perform :: FilePath -> CommandPerform
+perform p = do
+	g <- gitRepo
+
+	-- Get the reversed diff that needs to be applied to undo.
+	(diff, cleanup) <- inRepo $
+		diffLog [Param "-R", Param "--", Param p]
+	top <- inRepo $ toTopFilePath p
+	let diff' = filter (`isDiffOf` top) diff
+	liftIO $ streamUpdateIndex g (map stageDiffTreeItem diff')
+
+	-- Take two passes through the diff, first doing any removals,
+	-- and then any adds. This order is necessary to handle eg, removing
+	-- a directory and replacing it with a file.
+	let (removals, adds) = partition (\di -> dstsha di == nullSha) diff'
+	let mkrel di = liftIO $ relPathCwdToFile $ fromTopFilePath (file di) g
+
+	forM_ removals $ \di -> do
+		f <- mkrel di
+		whenM isDirect $
+			maybe noop (`removeDirect` f)
+				=<< catKey (srcsha di) (srcmode di)
+		liftIO $ nukeFile f
+
+	forM_ adds $ \di -> do
+		f <- mkrel di
+		inRepo $ Git.run [Param "checkout", Param "--", File f]
+		whenM isDirect $
+			maybe noop (`toDirect` f)
+				=<< catKey (dstsha di) (dstmode di)
+
+	next $ liftIO cleanup

Git/DiffTree.hs

@@ -7,10 +7,12 @@
 
 module Git.DiffTree (
 	DiffTreeItem(..),
+	isDiffOf,
 	diffTree,
 	diffTreeRecursive,
 	diffIndex,
 	diffWorkTree,
+	diffLog,
 ) where
 
 import Numeric
@@ -33,6 +35,13 @@ data DiffTreeItem = DiffTreeItem
 	, file :: TopFilePath
 	} deriving Show
 
+{- Checks if the DiffTreeItem modifies a file with a given name
+ - or under a directory by that name. -}
+isDiffOf :: DiffTreeItem -> TopFilePath -> Bool
+isDiffOf diff f = case getTopFilePath f of
+	"" -> True -- top of repo contains all
+	d -> d `dirContains` getTopFilePath (file diff)
+
 {- Diffs two tree Refs. -}
 diffTree :: Ref -> Ref -> Repo -> IO ([DiffTreeItem], IO Bool)
 diffTree src dst = getdiff (Param "diff-tree")
@@ -66,16 +75,23 @@ diffIndex' ref params repo =
 		, return ([], return True)
 		)
 
+{- Runs git log in --raw mode to get the changes that were made in
+ - a particular commit. The output format is adjusted to be the same
+ - as diff-tree --raw._-}
+diffLog :: [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
+diffLog params = getdiff (Param "log")
+	(Param "-n1" : Param "--abbrev=40" : Param "--pretty=format:" : params)
+
 getdiff :: CommandParam -> [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
 getdiff command params repo = do
 	(diff, cleanup) <- pipeNullSplit ps repo
-	return (parseDiffTree diff, cleanup)
+	return (parseDiffRaw diff, cleanup)
   where
 	ps = command : Params "-z --raw --no-renames -l0" : params
 
-{- Parses diff-tree output. -}
+{- Parses --raw output used by diff-tree and git-log. -}
-parseDiffTree :: [String] -> [DiffTreeItem]
+parseDiffRaw :: [String] -> [DiffTreeItem]
-parseDiffTree l = go l []
+parseDiffRaw l = go l []
   where
 	go [] c = c
 	go (info:f:rest) c = go rest (mk info f : c)

Git/UpdateIndex.hs

@@ -19,7 +19,8 @@ module Git.UpdateIndex (
 	updateIndexLine,
 	stageFile,
 	unstageFile,
-	stageSymlink
+	stageSymlink,
+	stageDiffTreeItem,
 ) where
 
 import Common
@@ -28,6 +29,7 @@ import Git.Types
 import Git.Command
 import Git.FilePath
 import Git.Sha
+import qualified Git.DiffTree as Diff
 
 {- Streamers are passed a callback and should feed it lines in the form
  - read by update-index, and generated by ls-tree. -}
@@ -95,7 +97,10 @@ stageFile sha filetype file repo = do
 unstageFile :: FilePath -> Repo -> IO Streamer
 unstageFile file repo = do
 	p <- toTopFilePath file repo
-	return $ pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p
+	return $ unstageFile' p
+
+unstageFile' :: TopFilePath -> Streamer
+unstageFile' p = pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p
 
 {- A streamer that adds a symlink to the index. -}
 stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
@@ -106,5 +111,11 @@ stageSymlink file sha repo = do
 		<*> toTopFilePath file repo
 	return $ pureStreamer line
 
+{- A streamer that applies a DiffTreeItem to the index. -}
+stageDiffTreeItem :: Diff.DiffTreeItem -> Streamer
+stageDiffTreeItem d = case toBlobType (Diff.dstmode d) of
+	Nothing -> unstageFile' (Diff.file d)
+	Just t -> pureStreamer $ updateIndexLine (Diff.dstsha d) t (Diff.file d)
+
 indexPath :: TopFilePath -> InternalGitPath
 indexPath = toInternalGitPath . getTopFilePath

debian/changelog

@@ -6,6 +6,8 @@ git-annex (5.20141126) UNRELEASED; urgency=medium
   * proxy: New command for direct mode repositories, allows bypassing
     the direct mode guard in a safe way to do all sorts of things
     including git revert, git mv, git checkout ...
+  * undo: New command to undo the most recent change to a file
+    or to the contents of a directory.
   * Work around behavior change in lsof 4.88's -F output format.
   * Debian package is now maintained by Gergely Nagy.
 

doc/git-annex.mdwn

@@ -282,6 +282,22 @@ subdirectories).
   are on a video hosting site, and the video is downloaded. This allows
   importing e.g., youtube playlists.
 
+* `undo [filename|directory] ...`
+
+  When passed a filename, undoes the last change that was made to that
+  file.
+
+  When passed a directory, undoes the last change that was made to the
+  contents of that directory.
+
+  Running undo a second time will undo the undo, returning the working
+  tree to the same state it had before. In order for undoing an undo of
+  staged changes, any staged changes are first committed by the
+  undo command.
+
+  Note that this does not undo get/drop of a file's content; it only
+  operates on the file tree committed to git.
+
 * `watch`
 
   Watches for changes to files in the current directory and its subdirectories,

doc/todo/direct_mode_undo.mdwn

@@ -80,5 +80,7 @@ the last change to each file would be expensive, and likely confusing.
 Instead, when a directory is passed, it could find the most recent commit
 that touched files in that directory, and undo the changes to those files.
 
+> [[done]] --[[Joey]]
+
 Also, --depth could make undo look for an older commit than the most
 recent one to affect the specified file.