rework command dispatching for add and pre-commit

Both subcommands do two different operations on different sets of files, so
allowing a subcommand to perform a list of operations cleans things up.

Command/Lock.hs

@@ -9,23 +9,17 @@ module Command.Lock where
 
 import Control.Monad.State (liftIO)
 import System.Directory
-import System.Posix.Files
 
-import Types
 import Command
 import Messages
 import qualified Annex
 import qualified GitRepo as Git
 
 {- Undo unlock -}
-start :: SubCmdStartString
-start file = do
-	locked <- isLocked file
-	if locked
-		then return Nothing
-		else do
-			showStart "lock" file
-			return $ Just $ perform file
+start :: SubCmdStartBackendFile
+start (file, _) = do
+	showStart "lock" file
+	return $ Just $ perform file
 
 perform :: FilePath -> SubCmdPerform
 perform file = do
@@ -36,17 +30,3 @@ perform file = do
 	-- checkout the symlink
 	liftIO $ Git.run g ["checkout", "--", file]
 	return $ Just $ return True -- no cleanup needed
-
-{- Checks if a file is unlocked for edit. -}
-isLocked :: FilePath -> Annex Bool
-isLocked file = do
-	-- check if it's a symlink first, as that's cheapest
-	s <- liftIO $ getSymbolicLinkStatus file
-	if (isSymbolicLink s)
-		then return True -- Symlinked files are always locked.
-		else do
-			-- Not a symlink, so see if the type has changed,
-			-- if so it is presumed to have been unlocked.
-			g <- Annex.gitRepo
-			typechanged <- liftIO $ Git.typeChangedFiles g file
-			return $ not $ elem file typechanged

Command/PreCommit.hs

@@ -8,34 +8,32 @@
 module Command.PreCommit where
 
 import Control.Monad.State (liftIO)
-import Control.Monad (when, unless)
 
 import Command
 import qualified Annex
 import qualified Backend
 import qualified GitRepo as Git
-import qualified Command.Fix
-import qualified Command.Lock
 import qualified Command.Add
 
-{- Run by git pre-commit hook. -}
+{- Run by git pre-commit hook; passed unlocked files that are being
+ - committed. -}
 start :: SubCmdStartString
-start file = do
-	-- If a file is unlocked for edit, add its new content to the
-	-- annex. -}
-	locked <- Command.Lock.isLocked file
-	when (not locked) $ do
-		pairs <- Backend.chooseBackends [file]
-		ok <- doSubCmd $ Command.Add.start $ pairs !! 0
-		unless (ok) $ do
-			error $ "failed to add " ++ file ++ "; canceling commit"
-		-- git commit will have staged the file's content;
-		-- drop that and run command queued by Add.state to
-		-- stage the symlink
-		g <- Annex.gitRepo
-		liftIO $ Git.run g ["reset", "-q", "--", file]
-		Annex.queueRun
+start file = return $ Just $ perform file
 
-	-- Fix symlinks as they are committed, this ensures the
-	-- relative links are not broken when moved around.
-	Command.Fix.start file
+perform :: FilePath -> SubCmdPerform
+perform file = do
+	pairs <- Backend.chooseBackends [file]
+	ok <- doSubCmd $ Command.Add.start $ pairs !! 0
+	if ok
+		then return $ Just $ cleanup file
+		else error $ "failed to add " ++ file ++ "; canceling commit"
+
+cleanup :: FilePath -> SubCmdCleanup
+cleanup file = do
+	-- git commit will have staged the file's content;
+	-- drop that and run command queued by Add.state to
+	-- stage the symlink
+	g <- Annex.gitRepo
+	liftIO $ Git.run g ["reset", "-q", "--", file]
+	Annex.queueRun
+	return True