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.
This commit is contained in:
Joey Hess 2010-11-11 17:58:55 -04:00
parent b5ce88dd2a
commit ce62f5abf1
6 changed files with 84 additions and 71 deletions

View file

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