unannex, uninit: Avoid committing after every file is unannexed, for massive speedup.

pre-commit hook lock added, so unannex can prevent the hook from running
in a confusing state.

This commit was sponsored by Fredrik Hammar

2 files changed, 62 insertions, 22 deletions

diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs
index fa34ad245..412b9ae08 100644
--- a/Command/PreCommit.hs
+++ b/Command/PreCommit.hs
@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Command.PreCommit where
 
 import Common.Annex
@@ -16,11 +18,17 @@ import Annex.Direct
 import Annex.Hook
 import Annex.View
 import Annex.View.ViewedFile
+import Annex.Perms
+import Annex.Exception
 import Logs.View
 import Logs.MetaData
 import Types.View
 import Types.MetaData
 
+#ifdef mingw32_HOST_OS
+import Utility.WinLock
+#endif
+
 import qualified Data.Set as S
 
 def :: [Command]
@@ -28,7 +36,7 @@ def = [command "pre-commit" paramPaths seek SectionPlumbing
 	"run by git pre-commit hook"]
 
 seek :: CommandSeek
-seek ps = ifM isDirect
+seek ps = lockPreCommitHook $ ifM isDirect
 	( do
 		-- update direct mode mappings for committed files
 		withWords startDirect ps
@@ -82,3 +90,22 @@ showMetaDataChange = showLongNote . unlines . concatMap showmeta . fromMetaData
 	showset v
 		| isSet v = "+"
 		| otherwise = "-"
+
+{- Takes exclusive lock; blocks until available. -}
+lockPreCommitHook :: Annex a -> Annex a
+lockPreCommitHook a = do
+	lockfile <- fromRepo gitAnnexPreCommitLock
+	createAnnexDirectory $ takeDirectory lockfile
+	mode <- annexFileMode
+	bracketIO (lock lockfile mode) unlock (const a)
+  where
+#ifndef mingw32_HOST_OS
+	lock lockfile mode = do
+		l <- liftIO $ noUmask mode $ createFile lockfile mode
+		liftIO $ waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0)
+		return l
+	unlock = closeFd
+#else
+	lock lockfile _mode = liftIO $ waitToLock $  lockExclusive lockfile
+	unlock = dropLock
+#endif
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index 1f2978430..3da7c2a41 100644
--- a/Command/Unannex.hs
+++ b/Command/Unannex.hs
@@ -16,15 +16,47 @@ import qualified Annex
 import Annex.Content
 import Annex.Content.Direct
 import qualified Git.Command
-import qualified Git.LsFiles as LsFiles
+import qualified Git.Ref
+import qualified Git.DiffTree as DiffTree
 import Utility.CopyFile
+import Command.PreCommit (lockPreCommitHook)
 
 def :: [Command]
 def = [command "unannex" paramPaths seek SectionUtility
 		"undo accidential add command"]
 
 seek :: CommandSeek
-seek = withFilesInGit $ whenAnnexed start
+seek = wrapUnannex . (withFilesInGit $ whenAnnexed start)
+
+wrapUnannex :: Annex a -> Annex a
+wrapUnannex a = ifM isDirect
+	( a
+	{- Run with the pre-commit hook disabled, to avoid confusing
+	 - behavior if an unannexed file is added back to git as
+	 - a normal, non-annexed file and then committed.
+	 - Otherwise, the pre-commit hook would think that the file
+	 - has been unlocked and needs to be re-annexed.
+	 -
+	 - At the end, make a commit removing the unannexed files.
+	 -}
+	, ifM cleanindex
+		( lockPreCommitHook $ commit `after` a
+		, error "Cannot proceed with uncommitted changes staged in the index. Recommend you: git commit"
+		)
+	)
+  where
+	commit = inRepo $ Git.Command.run
+		[ Param "commit"
+		, Param "-q"
+		, Param "--allow-empty"
+		, Param "--no-verify"
+		, Param "-m", Param "content removed from git annex"
+		]
+	cleanindex = do
+		(diff, cleanup) <- inRepo $ DiffTree.diffIndex Git.Ref.headRef
+		if null diff
+			then void (liftIO cleanup) >> return True
+			else void (liftIO cleanup) >> return False
 
 start :: FilePath -> (Key, Backend) -> CommandStart
 start file (key, _) = stopUnless (inAnnex key) $ do
@@ -36,26 +68,7 @@ start file (key, _) = stopUnless (inAnnex key) $ do
 performIndirect :: FilePath -> Key -> CommandPerform
 performIndirect file key = do
 	liftIO $ removeFile file
-	
-	-- git rm deletes empty directory without --cached
 	inRepo $ Git.Command.run [Params "rm --cached --force --quiet --", File file]
-	
-	-- If the file was already committed, it is now staged for removal.
-	-- Commit that removal now, to avoid later confusing the
-	-- pre-commit hook, if this file is later added back to
-	-- git as a normal non-annexed file, to thinking that the
-	-- file has been unlocked and needs to be re-annexed.
-	(s, reap) <- inRepo $ LsFiles.staged [file]
-	unless (null s) $
-		inRepo $ Git.Command.run
-			[ Param "commit"
-			, Param "-q"
-			, Param "--no-verify"
-			, Param "-m", Param "content removed from git annex"
-			, Param "--", File file
-			]
-	void $ liftIO reap
-
 	next $ cleanupIndirect file key
 
 cleanupIndirect :: FilePath -> Key -> CommandCleanup