git-annex/Command/PreCommit.hs
Joey Hess bc5c54c987 symlink touching fun
When adding files to the annex, the symlinks pointing at the annexed
content are made to have the same mtime as the original file. While git
does not preserve that information, this allows a tool like metastore to be
used with annexed files.
2011-03-14 23:00:23 -04:00

46 lines
1.2 KiB
Haskell

{- git-annex command
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.PreCommit where
import Control.Monad.State (liftIO)
import Command
import qualified Annex
import qualified GitRepo as Git
import qualified Command.Add
import qualified Command.Fix
import Utility
command :: [Command]
command = [Command "pre-commit" paramPath seek "run by git pre-commit hook"]
{- The pre-commit hook needs to fix symlinks to all files being committed.
- And, it needs to inject unlocked files into the annex. -}
seek :: [CommandSeek]
seek = [withFilesToBeCommitted Command.Fix.start,
withFilesUnlockedToBeCommitted start]
start :: CommandStartBackendFile
start pair = return $ Just $ perform pair
perform :: BackendFile -> CommandPerform
perform pair@(file, _) = do
ok <- doCommand $ Command.Add.start pair
if ok
then return $ Just $ cleanup file
else error $ "failed to add " ++ file ++ "; canceling commit"
cleanup :: FilePath -> CommandCleanup
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" [Params "-q --", File file]
Annex.queueRun
return True