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

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

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