diff options
author | Joey Hess <joey@kitenet.net> | 2010-11-10 14:11:19 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-11-10 14:11:19 -0400 |
commit | f5f472e8550ae438b1dc751a18cccf0efbaccd1d (patch) | |
tree | 426ccf3aa6191898d27b3f62933170a698ba89c6 /Command | |
parent | 05ca2bebff521b1fa9b79014b1856b828d897b6d (diff) | |
parent | 16ba23d48de00daccbfb481dd1baca91047f8b3e (diff) |
Merge branch 'checkout'
Diffstat (limited to 'Command')
-rw-r--r-- | Command/Lock.hs | 50 | ||||
-rw-r--r-- | Command/PreCommit.hs | 40 | ||||
-rw-r--r-- | Command/Unlock.hs | 39 |
3 files changed, 129 insertions, 0 deletions
diff --git a/Command/Lock.hs b/Command/Lock.hs new file mode 100644 index 000000000..955749e93 --- /dev/null +++ b/Command/Lock.hs @@ -0,0 +1,50 @@ +{- git-annex command + - + - Copyright 2010 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +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 + +perform :: FilePath -> SubCmdPerform +perform file = do + liftIO $ removeFile file + g <- Annex.gitRepo + -- first reset the file to drop any changes checked into the index + liftIO $ Git.run g ["reset", "-q", "--", file] + -- checkout the symlink + liftIO $ Git.run g ["checkout", "--", file] + return $ Just $ return True -- no cleanup needed + +{- Checks if a file is unlocked for edit. + - + - But, without the symlink to the annex, cannot tell for sure if the + - file was annexed before. So, check if git thinks the file's type has + - changed (from a symlink to a regular file). -} +isLocked :: FilePath -> Annex Bool +isLocked file = do + g <- Annex.gitRepo + typechanged <- liftIO $ Git.typeChangedFiles g file + s <- liftIO $ getSymbolicLinkStatus file + return $ (not $ elem file typechanged) || isSymbolicLink s diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs new file mode 100644 index 000000000..cd6ce6f08 --- /dev/null +++ b/Command/PreCommit.hs @@ -0,0 +1,40 @@ +{- 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 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. -} +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 stage the symlink + g <- Annex.gitRepo + liftIO $ Git.run g ["reset", "-q", "--", file] + Annex.queueRun + + -- Fix symlinks as they are committed, this ensures the + -- relative links are not broken when moved around. + Command.Fix.start file diff --git a/Command/Unlock.hs b/Command/Unlock.hs new file mode 100644 index 000000000..de21988de --- /dev/null +++ b/Command/Unlock.hs @@ -0,0 +1,39 @@ +{- git-annex command + - + - Copyright 2010 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Unlock where + +import Control.Monad.State (liftIO) +import System.Directory + +import Command +import qualified Annex +import Types +import Messages +import Locations +import Utility +import Core + +{- The unlock subcommand replaces the symlink with a copy of the file's + - content. -} +start :: SubCmdStartString +start file = isAnnexed file $ \(key, _) -> do + showStart "unlock" file + return $ Just $ perform file key + +perform :: FilePath -> Key -> SubCmdPerform +perform dest key = do + g <- Annex.gitRepo + let src = annexLocation g key + liftIO $ removeFile dest + showNote "copying..." + ok <- liftIO $ boolSystem "cp" ["-p", src, dest] + if ok + then do + liftIO $ allowWrite dest + return $ Just $ return True + else error "cp failed!" |