split out Utility.InodeCache

Annex/Content.hs

@@ -260,7 +260,7 @@ moveAnnex key src = withObjectLoc key storeobject storedirect
 
 	storedirect' [] = storeobject =<< inRepo (gitAnnexLocation key)
 	storedirect' (dest:fs) = do
-		updateCache key src
+		updateInodeCache key src
 		thawContent src
 		liftIO $ replaceFile dest $ moveFile src
 		liftIO $ forM_ fs $ \f -> replaceFile f $
@@ -308,10 +308,10 @@ prepSendAnnex key = withObjectLoc key indirect direct
 	indirect f = return $ Just (f, return True)
 	direct [] = return Nothing
 	direct (f:fs) = do
-		cache <- recordedCache key
+		cache <- recordedInodeCache key
 		-- check that we have a good file
-		ifM (compareCache f cache)
-			( return $ Just (f, compareCache f cache)
+		ifM (liftIO $ compareInodeCache f cache)
+			( return $ Just (f, liftIO $ compareInodeCache f cache)
 			, direct fs
 			)
 
@@ -361,10 +361,10 @@ removeAnnex key = withObjectLoc key remove removedirect
 		liftIO $ removeFile file
 		cleanObjectLoc key
 	removedirect fs = do
-		cache <- recordedCache key
+		cache <- recordedInodeCache key
 		mapM_ (resetfile cache) fs
 		cleanObjectLoc key
-	resetfile cache f = whenM (compareCache f cache) $ do
+	resetfile cache f = whenM (liftIO $ compareInodeCache f cache) $ do
 		l <- calcGitLink f key
 		top <- fromRepo Git.repoPath
 		cwd <- liftIO getCurrentDirectory

Annex/Content/Direct.hs

@@ -11,14 +11,11 @@ module Annex.Content.Direct (
 	addAssociatedFile,
 	goodContent,
 	changedFileStatus,
-	updateCache,
-	recordedCache,
-	compareCache,
-	writeCache,
-	genCache,
-	toCache,
-	Cache(..),
-	prop_read_show_direct
+	recordedInodeCache,
+	updateInodeCache,
+	writeInodeCache,
+	compareInodeCache,
+	toInodeCache,
 ) where
 
 import Common.Annex
@@ -26,8 +23,7 @@ import Annex.Perms
 import qualified Git
 import Utility.TempFile
 import Logs.Location
-
-import System.Posix.Types
+import Utility.InodeCache
 
 {- Absolute FilePaths of Files in the tree that are associated with a key. -}
 associatedFiles :: Key -> Annex [FilePath]
@@ -98,70 +94,30 @@ normaliseAssociatedFile file = do
  -}
 goodContent :: Key -> FilePath -> Annex Bool
 goodContent key file = do
-	old <- recordedCache key
-	compareCache file old
+	old <- recordedInodeCache key
+	liftIO $ compareInodeCache file old
 
 changedFileStatus :: Key -> FileStatus -> Annex Bool
 changedFileStatus key status = do
-	old <- recordedCache key
-	let curr = toCache status
+	old <- recordedInodeCache key
+	let curr = toInodeCache status
 	return $ curr /= old
 
-{- Gets the recorded cache for a key. -}
-recordedCache :: Key -> Annex (Maybe Cache)
-recordedCache key = withCacheFile key $ \cachefile ->
-	liftIO $ catchDefaultIO Nothing $ readCache <$> readFile cachefile
-
-{- Compares a cache with the current cache for a file. -}
-compareCache :: FilePath -> Maybe Cache -> Annex Bool
-compareCache file old = do
-	curr <- liftIO $ genCache file
-	return $ isJust curr && curr == old
+{- Gets the recorded inode cache for a key. -}
+recordedInodeCache :: Key -> Annex (Maybe InodeCache)
+recordedInodeCache key = withInodeCacheFile key $ \f ->
+	liftIO $ catchDefaultIO Nothing $ readInodeCache <$> readFile f
 
 {- Stores a cache of attributes for a file that is associated with a key. -}
-updateCache :: Key -> FilePath -> Annex ()
-updateCache key file = maybe noop (writeCache key) =<< liftIO (genCache file)
+updateInodeCache :: Key -> FilePath -> Annex ()
+updateInodeCache key file = maybe noop (writeInodeCache key)
+	=<< liftIO (genInodeCache file)
 
 {- Writes a cache for a key. -}
-writeCache :: Key -> Cache -> Annex ()
-writeCache key cache = withCacheFile key $ \cachefile -> do
-	createContentDir cachefile
-	liftIO $ writeFile cachefile $ showCache cache
+writeInodeCache :: Key -> InodeCache -> Annex ()
+writeInodeCache key cache = withInodeCacheFile key $ \f -> do
+	createContentDir f
+	liftIO $ writeFile f $ showInodeCache cache
 
-{- Cache a file's inode, size, and modification time to determine if it's
- - been changed. -}
-data Cache = Cache FileID FileOffset EpochTime
-	deriving (Eq, Show)
-
-showCache :: Cache -> String
-showCache (Cache inode size mtime) = unwords
-	[ show inode
-	, show size
-	, show mtime
-	]
-
-readCache :: String -> Maybe Cache
-readCache s = case words s of
-	(inode:size:mtime:_) -> Cache
-		<$> readish inode
-		<*> readish size
-		<*> readish mtime
-	_ -> Nothing
-
--- for quickcheck
-prop_read_show_direct :: Cache -> Bool
-prop_read_show_direct c = readCache (showCache c) == Just c
-
-genCache :: FilePath -> IO (Maybe Cache)
-genCache f = catchDefaultIO Nothing $ toCache <$> getFileStatus f
-
-toCache :: FileStatus -> Maybe Cache
-toCache s
-	| isRegularFile s = Just $ Cache
-		(fileID s)
-		(fileSize s)
-		(modificationTime s)
-	| otherwise = Nothing
-
-withCacheFile :: Key -> (FilePath -> Annex a) -> Annex a
-withCacheFile key a = a =<< inRepo (gitAnnexCache key)
+withInodeCacheFile :: Key -> (FilePath -> Annex a) -> Annex a
+withInodeCacheFile key a = a =<< inRepo (gitAnnexInodeCache key)

Annex/Direct.hs

@@ -24,6 +24,7 @@ import Backend
 import Types.KeySource
 import Annex.Content
 import Annex.Content.Direct
+import Utility.InodeCache
 import Utility.CopyFile
 
 {- Uses git ls-files to find files that need to be committed, and stages
@@ -45,12 +46,12 @@ stageDirect = do
 	go (file, Just sha) = do
 		mkey <- catKey sha
 		mstat <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
-		case (mkey, mstat, toCache =<< mstat) of
+		case (mkey, mstat, toInodeCache =<< 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
+				oldcache <- recordedInodeCache key
 				when (oldcache /= Just cache) $
 					modifiedannexed file key cache
 			(Just key, Nothing, _) -> deletedannexed file key
@@ -72,7 +73,7 @@ stageDirect = do
 
 {- 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 :: FilePath -> InodeCache -> Annex Bool
 addDirect file cache = do
 	showStart "add" file
 	let source = KeySource
@@ -84,13 +85,13 @@ addDirect file cache = do
 	got Nothing = do
 		showEndFail
 		return False
-	got (Just (key, _)) = ifM (compareCache file $ Just cache)
+	got (Just (key, _)) = ifM (liftIO $ compareInodeCache 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
+			writeInodeCache key cache
 			void $ addAssociatedFile key file
 			logStatus key InfoPresent
 			showEndOk
@@ -177,7 +178,7 @@ toDirectGen k f = do
 		[] -> ifM (liftIO $ doesFileExist loc)
 			( return $ Just $ do
 				{- Move content from annex to direct file. -}
-				updateCache k loc
+				updateInodeCache k loc
 				thawContent loc
 				liftIO $ replaceFile f $ moveFile loc
 			, return Nothing