git-annex/Command/Undo.hs
Joey Hess 13260ccc3a undo command
This commit was sponsored by Andrew Cant.
2014-11-14 14:41:07 -04:00

84 lines
2.3 KiB
Haskell

{- 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