start to support core.symlinks=false

Utility functions to handle no symlink mode, and converted Annex.Content to
use them; still many other places to convert.

2 files changed, 21 insertions, 25 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index e488de274..5abcb2a9e 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -50,6 +50,7 @@ import Annex.Exception
 import Git.SharedRepository
 import Annex.Perms
 import Annex.Content.Direct
+import Backend
 
 {- Checks if a given key's content is currently present. -}
 inAnnex :: Key -> Annex Bool
@@ -248,33 +249,27 @@ moveAnnex key src = withObjectLoc key storeobject storedirect
 				freezeContent dest
 				freezeContentDir dest
 			)
-	storedirect fs = storedirect' =<< liftIO (filterM validsymlink fs)
-
-	validsymlink f = do
-		tl <- tryIO $ readSymbolicLink f
-		return $ case tl of
-			Right l
-				| isLinkToAnnex l ->
-					Just key == fileKey (takeFileName l)
-			_ -> False
+	storedirect fs = storedirect' =<< filterM validsymlink fs
+	validsymlink f = (==) (Just key) <$> isAnnexLink f
 
 	storedirect' [] = storeobject =<< inRepo (gitAnnexLocation key)
 	storedirect' (dest:fs) = do
 		updateInodeCache key src
 		thawContent src
-		liftIO $ replaceFile dest $ moveFile src
-		liftIO $ forM_ fs $ \f -> replaceFile f $
-			void . copyFileExternal dest
+		replaceFile dest $ liftIO . moveFile src
+		forM_ fs $ \f -> replaceFile f $
+			void . liftIO . copyFileExternal dest
 
 {- Replaces any existing file with a new version, by running an action.
  - First, makes sure the file is deleted. Or, if it didn't already exist,
  - makes sure the parent directory exists. -}
-replaceFile :: FilePath -> (FilePath -> IO ()) -> IO ()
+replaceFile :: FilePath -> (FilePath -> Annex ()) -> Annex ()
 replaceFile file a = do
-	r <- tryIO $ removeFile file
-	case r of
-		Left _ -> createDirectoryIfMissing True (parentDir file)
-		_ -> noop
+	liftIO $ do
+		r <- tryIO $ removeFile file
+		case r of
+			Left _ -> createDirectoryIfMissing True $ parentDir file
+			_ -> noop
 	a file
 
 {- Runs an action to transfer an object's content.
@@ -370,8 +365,8 @@ removeAnnex key = withObjectLoc key remove removedirect
 		cwd <- liftIO getCurrentDirectory
 		let top' = fromMaybe top $ absNormPath cwd top
 		let l' = relPathDirToFile top' (fromMaybe l $ absNormPath top' l)
-		liftIO $ replaceFile f $ const $
-			createSymbolicLink l' f
+		replaceFile f $ const $
+			makeAnnexLink l' f
 
 {- Moves a key's file out of .git/annex/objects/ -}
 fromAnnex :: Key -> FilePath -> Annex ()
diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index 733cb9356..a4839d509 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -155,8 +155,8 @@ mergeDirectCleanup d oldsha newsha = do
  	 - Symlinks are replaced with their content, if it's available. -}
 	movein k f = do
 		l <- calcGitLink f k
-		liftIO $ replaceFile f $ const $
-			createSymbolicLink l f
+		replaceFile f $ const $
+			liftIO $ createSymbolicLink l f
 		toDirect k f
 	
 	{- Any new, modified, or renamed files were written to the temp
@@ -181,14 +181,15 @@ toDirectGen k f = do
 				{- Move content from annex to direct file. -}
 				updateInodeCache k loc
 				thawContent loc
-				liftIO $ replaceFile f $ moveFile loc
+				replaceFile f $
+					liftIO . moveFile loc
 			, return Nothing
 			)
 		(loc':_) -> ifM (liftIO $ catchBoolIO $ not . isSymbolicLink <$> getSymbolicLinkStatus loc')
 			{- Another direct file has the content; copy it. -}
-			( return $ Just $ do
-				liftIO $ replaceFile f $
-					void . copyFileExternal loc'
+			( return $ Just $
+				replaceFile f $
+					void . liftIO . copyFileExternal loc'
 			, return Nothing
 			)