direct mode committing

4 files changed, 138 insertions, 26 deletions

diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs
index 88c498d31..cde9d5170 100644
--- a/Annex/CatFile.hs
+++ b/Annex/CatFile.hs
@@ -9,6 +9,7 @@ module Annex.CatFile (
 	catFile,
 	catObject,
 	catObjectDetails,
+	catKey,
 	catFileHandle
 ) where
 
@@ -42,3 +43,7 @@ catFileHandle = maybe startup return =<< Annex.getState Annex.catfilehandle
 			h <- inRepo Git.CatFile.catFileStart
 			Annex.changeState $ \s -> s { Annex.catfilehandle = Just h }
 			return h
+
+{- From the Sha of a symlink back to the key. -}
+catKey :: Sha -> Annex (Maybe Key)
+catKey sha = fileKey . takeFileName . encodeW8 . L.unpack  <$> catObject sha
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 61f521bd1..980321721 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -10,7 +10,6 @@ module Annex.Content (
 	inAnnexSafe,
 	lockContent,
 	calcGitLink,
-	logStatus,
 	getViaTmp,
 	getViaTmpUnchecked,
 	withTmp,
@@ -33,7 +32,6 @@ import System.IO.Unsafe (unsafeInterleaveIO)
 
 import Common.Annex
 import Logs.Location
-import Annex.UUID
 import qualified Git
 import qualified Git.Config
 import qualified Annex
@@ -132,13 +130,6 @@ calcGitLink file key = do
 	where
 		whoops = error $ "unable to normalize " ++ file
 
-{- Updates the Logs.Location when a key's presence changes in the current
- - repository. -}
-logStatus :: Key -> LogStatus -> Annex ()
-logStatus key status = do
-	u <- getUUID
-	logChange key u status
-
 {- Runs an action, passing it a temporary filename to get,
  - and if the action succeeds, moves the temp file into 
  - the annex as a key's content. -}
diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs
index f481030ba..f6a564bf0 100644
--- a/Annex/Content/Direct.hs
+++ b/Annex/Content/Direct.hs
@@ -7,13 +7,18 @@
 
 module Annex.Content.Direct (
 	associatedFiles,
-	changeAssociatedFiles,
+	removeAssociatedFile,
+	addAssociatedFile,
 	updateAssociatedFiles,
 	goodContent,
 	updateCache,
 	recordedCache,
 	compareCache,
-	removeCache
+	writeCache,
+	removeCache,
+	genCache,
+	toCache,
+	Cache
 ) where
 
 import Common.Annex
@@ -23,9 +28,9 @@ import Git.Sha
 import Annex.CatFile
 import Utility.TempFile
 import Utility.FileMode
+import Logs.Location
 
 import System.Posix.Types
-import qualified Data.ByteString.Lazy as L
 
 {- Files in the tree that are associated with a key. -}
 associatedFiles :: Key -> Annex [FilePath]
@@ -42,19 +47,24 @@ associatedFilesRelative key = do
 	liftIO $ catchDefaultIO [] $ lines <$> readFile mapping
 
 {- Changes the associated files information for a key, applying a
- - transformation to the list. -}
-changeAssociatedFiles :: Key -> ([FilePath] -> [FilePath]) -> Annex ()
+ - transformation to the list. Returns a copy of the new info. -}
+changeAssociatedFiles :: Key -> ([FilePath] -> [FilePath]) -> Annex [FilePath]
 changeAssociatedFiles key transform = do
 	mapping <- inRepo $ gitAnnexMapping key
 	files <- associatedFilesRelative key
 	let files' = transform files
 	when (files /= files') $
 		liftIO $ viaTmp writeFile mapping $ unlines files'
+	return files'
 
-removeAssociatedFile :: Key -> FilePath -> Annex ()
-removeAssociatedFile key file = changeAssociatedFiles key $ filter (/= file)
+removeAssociatedFile :: Key -> FilePath -> Annex [FilePath]
+removeAssociatedFile key file = do
+	fs <- changeAssociatedFiles key $ filter (/= file)
+	when (null fs) $
+		logStatus key InfoMissing
+	return fs
 
-addAssociatedFile :: Key -> FilePath -> Annex ()
+addAssociatedFile :: Key -> FilePath -> Annex [FilePath]
 addAssociatedFile key file = changeAssociatedFiles key $ \files ->
 	if file `elem` files
 		then files
@@ -74,10 +84,8 @@ updateAssociatedFiles oldsha newsha = do
 	  where
 		go getsha getmode a =
 			when (getsha item /= nullSha && isSymLink (getmode item)) $ do
-				key <- getkey $ getsha item
-				maybe noop (\k -> a k $ DiffTree.file item) key
-		getkey sha = fileKey . takeFileName . encodeW8 . L.unpack
-			<$> catObject sha
+				key <- catKey (getsha item)
+				maybe noop (\k -> void $ a k $ DiffTree.file item) key
 
 {- Checks if a file in the tree, associated with a key, has not been modified.
  -
@@ -103,10 +111,13 @@ compareCache file old = do
 
 {- Stores a cache of attributes for a file that is associated with a key. -}
 updateCache :: Key -> FilePath -> Annex ()
-updateCache key file = do
-	withCacheFile key $ \cachefile -> do
-		createDirectoryIfMissing True (parentDir cachefile)
-		maybe noop (writeFile cachefile . showCache) =<< genCache file
+updateCache key file = maybe noop (writeCache key) =<< liftIO (genCache file)
+
+{- Writes a cache for a key. -}
+writeCache :: Key -> Cache -> Annex ()
+writeCache key cache = withCacheFile key $ \cachefile -> do
+	createDirectoryIfMissing True (parentDir cachefile)
+	writeFile cachefile $ showCache cache
 
 {- Removes a cache. -}
 removeCache :: Key -> Annex ()
@@ -115,7 +126,7 @@ removeCache key = withCacheFile key nukeFile
 {- Cache a file's inode, size, and modification time to determine if it's
  - been changed. -}
 data Cache = Cache FileID FileOffset EpochTime
-  deriving (Eq)
+  deriving (Eq, Show)
 
 showCache :: Cache -> String
 showCache (Cache inode size mtime) = unwords
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
+		)