undo command

This commit was sponsored by Andrew Cant.

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