From 3898d8c091ab1d5e4df9912851dc70de58d7259d Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 7 Dec 2012 14:40:31 -0400
Subject: [PATCH] support for storing files in direct mode

---
 Annex/Content.hs | 57 ++++++++++++++++++++++++++++++++++++++----------
 Config.hs        |  4 ++--
 Locations.hs     |  8 +++++++
 3 files changed, 56 insertions(+), 13 deletions(-)

diff --git a/Annex/Content.hs b/Annex/Content.hs
index e6afd5465f..f66fd51ef2 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -194,7 +194,8 @@ checkDiskSpace destination key alreadythere = do
 				" more" ++ forcemsg
 		forcemsg = " (use --force to override this check or adjust annex.diskreserve)"
 
-{- Moves a file into .git/annex/objects/
+{- Moves a key's content into .git/annex/objects/
+ - In direct mode, moves it to the associated file, or files.
  -
  - What if the key there already has content? This could happen for
  - various reasons; perhaps the same content is being annexed again.
@@ -216,16 +217,50 @@ checkDiskSpace destination key alreadythere = do
  - meet.
  -}
 moveAnnex :: Key -> FilePath -> Annex ()
-moveAnnex key src = do
-	dest <- inRepo $ gitAnnexLocation key
-	ifM (liftIO $ doesFileExist dest)
-		( liftIO $ removeFile src
-		, do
-			createContentDir dest
-			liftIO $ moveFile src dest
-			freezeContent dest
-			freezeContentDir dest
-		)
+moveAnnex key src = ifM isDirect
+	( storefiles =<< associatedFiles key
+	, storeobject
+	)
+  where
+	storeobject = do
+		dest <- inRepo $ gitAnnexLocation key
+		ifM (liftIO $ doesFileExist dest)
+			( liftIO $ removeFile src
+			, do
+				createContentDir dest
+				liftIO $ moveFile src dest
+				freezeContent dest
+				freezeContentDir dest
+			)
+	storefiles [] = storeobject
+	storefiles (dest:fs) = do
+		thawContent src
+		liftIO $ replacefile dest $ moveFile src
+		liftIO $ forM_ fs $ \f -> replacefile f $ createLink dest
+	replacefile file a = do
+		{- Remove any symlink or existing file. -}
+		r <- tryIO $ removeFile file
+		{- Only need to create parent directory if file did not exist. -}
+		case r of
+			Left _ -> createDirectoryIfMissing True (parentDir file)
+			_ -> noop
+		a file
+
+{- Files in the tree that are associated with a key.
+ - For use in direct mode.
+ -
+ - When no known associated files exist, returns the gitAnnexLocation. -}
+associatedFiles :: Key -> Annex [FilePath]
+associatedFiles key = do
+	mapping <- inRepo $ gitAnnexMapping key
+	files <- liftIO $ catchDefaultIO [] $ lines <$> readFile mapping
+	if null files
+		then do
+			l <- inRepo $ gitAnnexLocation key
+			return [l]
+		else do
+			top <- fromRepo Git.repoPath
+			return $ map (top </>) files
 
 withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a
 withObjectLoc key a = do
diff --git a/Config.hs b/Config.hs
index 4658531cff..0f948f5e55 100644
--- a/Config.hs
+++ b/Config.hs
@@ -117,8 +117,8 @@ getDiskReserve = fromMaybe megabyte . readSize dataUnits
 	megabyte = 1000000
 
 {- Gets annex.direct setting. -}
-getDirect :: Annex Bool
-getDirect = fromMaybe False . Git.Config.isTrue <$>
+isDirect :: Annex Bool
+isDirect = fromMaybe False . Git.Config.isTrue <$>
 	getConfig (annexConfig "direct") ""
 
 {- Gets annex.httpheaders or annex.httpheaders-command setting,
diff --git a/Locations.hs b/Locations.hs
index db97bbec72..36172d621a 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -11,6 +11,7 @@ module Locations (
 	keyPaths,
 	keyPath,
 	gitAnnexLocation,
+	gitAnnexMapping,
 	annexLocations,
 	annexLocation,
 	gitAnnexDir,
@@ -107,6 +108,13 @@ gitAnnexLocation key r
 	check locs@(l:_) = fromMaybe l <$> firstM doesFileExist locs
 	check [] = error "internal"
 
+{- File that maps from a key to the file(s) in the git repository.
+ - Used in direct mode. -}
+gitAnnexMapping :: Key -> Git.Repo -> IO FilePath
+gitAnnexMapping key r = do
+	loc <- gitAnnexLocation key r 
+	return $ loc ++ ".map"
+
 {- The annex directory of a repository. -}
 gitAnnexDir :: Git.Repo -> FilePath
 gitAnnexDir r = addTrailingPathSeparator $ Git.localGitDir r </> annexDir