direct mode committing

1 files changed, 105 insertions, 0 deletions

diff --git a/Annex/Direct.hs b/Annex/Direct.hs
new file mode 100644
index 000000000..12984687e
--- /dev/null
+++ b/Annex/Direct.hs
@@ -0,0 +1,105 @@
+{- git-annex direct mode
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.Direct where
+
+import Common.Annex
+import qualified Git
+import qualified Git.LsFiles
+import qualified Git.UpdateIndex
+import qualified Git.HashObject
+import qualified Annex.Queue
+import Git.Types
+import Annex.CatFile
+import Logs.Location
+import Backend
+import Types.KeySource
+import Annex.Content
+import Annex.Content.Direct
+
+{- Uses git ls-files to find files that need to be committed, and stages
+ - them into the index. Returns True if some changes were staged. -}
+stageDirect :: Annex Bool
+stageDirect = do
+	Annex.Queue.flush
+	top <- fromRepo Git.repoPath
+	(l, cleanup) <- inRepo $ Git.LsFiles.stagedDetails [top]
+	forM_ l go
+	void $ liftIO cleanup
+	staged <- Annex.Queue.size
+	Annex.Queue.flush
+	return $ staged /= 0
+  where
+	{- Determine what kind of modified or deleted file this is, as
+	 - efficiently as we can, by getting any key that's associated
+	 - with it in git, as well as its stat info. -}
+	go (file, Just sha) = do
+		mkey <- catKey sha
+		mstat <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
+		case (mkey, mstat, toCache =<< mstat) of
+			(Just key, _, Just cache) -> do
+				{- All direct mode files will show as
+				 - modified, so compare the cache to see if
+				 - it really was. -}
+				oldcache <- recordedCache key
+				when (oldcache /= Just cache) $
+					modifiedannexed file key cache
+			(Just key, Nothing, _) -> deletedannexed file key
+			(Nothing, Nothing, _) -> deletegit file
+			(_, Just _, _) -> addgit file
+	go (file, Nothing) = do
+		mstat <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
+		case (mstat, toCache =<< mstat) of
+			(Nothing, _) -> noop
+			(Just stat, Just cache)
+				| isSymbolicLink stat -> addgit file
+				| otherwise -> void $ addDirect file cache
+			(Just stat, Nothing)
+				| isSymbolicLink stat -> addgit file
+				| otherwise -> noop
+
+	modifiedannexed file oldkey cache = do
+		void $ removeAssociatedFile oldkey file
+		void $ addDirect file cache
+	
+	deletedannexed file key = do
+		void $ removeAssociatedFile key file
+		deletegit file
+	
+	addgit file = Annex.Queue.addCommand "add" [Param "-f"] [file]
+
+	deletegit file = Annex.Queue.addCommand "rm" [Param "-f"] [file]
+
+{- Adds a file to the annex in direct mode. Can fail, if the file is
+ - modified or deleted while it's being added. -}
+addDirect :: FilePath -> Cache -> Annex Bool
+addDirect file cache = do
+	showStart "add" file
+	let source = KeySource
+		{ keyFilename = file
+		, contentLocation = file
+		}
+	got =<< genKey source =<< chooseBackend file
+  where
+	got Nothing = do
+		showEndFail
+		return False
+	got (Just (key, _)) = ifM (compareCache file $ Just cache)
+		( do
+			link <- calcGitLink file key
+			sha <- inRepo $ Git.HashObject.hashObject BlobObject link
+			Annex.Queue.addUpdateIndex =<<
+				inRepo (Git.UpdateIndex.stageSymlink file sha)
+			writeCache key cache
+			void $ addAssociatedFile key file
+			logStatus key InfoPresent
+			showEndOk
+			return True
+		, do
+			showEndFail
+			return False
+		)