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)
+		ifM (liftIO $ compareInodeCache f cache)
-			( return $ Just (f, compareCache 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,
+	recordedInodeCache,
-	recordedCache,
+	updateInodeCache,
-	compareCache,
+	writeInodeCache,
-	writeCache,
+	compareInodeCache,
-	genCache,
+	toInodeCache,
-	toCache,
-	Cache(..),
-	prop_read_show_direct
 ) where
 
 import Common.Annex
@@ -26,8 +23,7 @@ import Annex.Perms
 import qualified Git
 import Utility.TempFile
 import Logs.Location
-
+import Utility.InodeCache
-import System.Posix.Types
 
 {- 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
+	old <- recordedInodeCache key
-	compareCache file old
+	liftIO $ compareInodeCache file old
 
 changedFileStatus :: Key -> FileStatus -> Annex Bool
 changedFileStatus key status = do
-	old <- recordedCache key
+	old <- recordedInodeCache key
-	let curr = toCache status
+	let curr = toInodeCache status
 	return $ curr /= old
 
-{- Gets the recorded cache for a key. -}
+{- Gets the recorded inode cache for a key. -}
-recordedCache :: Key -> Annex (Maybe Cache)
+recordedInodeCache :: Key -> Annex (Maybe InodeCache)
-recordedCache key = withCacheFile key $ \cachefile ->
+recordedInodeCache key = withInodeCacheFile key $ \f ->
-	liftIO $ catchDefaultIO Nothing $ readCache <$> readFile cachefile
+	liftIO $ catchDefaultIO Nothing $ readInodeCache <$> readFile f
-
-{- 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
 
 {- Stores a cache of attributes for a file that is associated with a key. -}
-updateCache :: Key -> FilePath -> Annex ()
+updateInodeCache :: Key -> FilePath -> Annex ()
-updateCache key file = maybe noop (writeCache key) =<< liftIO (genCache file)
+updateInodeCache key file = maybe noop (writeInodeCache key)
+	=<< liftIO (genInodeCache file)
 
 {- Writes a cache for a key. -}
-writeCache :: Key -> Cache -> Annex ()
+writeInodeCache :: Key -> InodeCache -> Annex ()
-writeCache key cache = withCacheFile key $ \cachefile -> do
+writeInodeCache key cache = withInodeCacheFile key $ \f -> do
-	createContentDir cachefile
+	createContentDir f
-	liftIO $ writeFile cachefile $ showCache cache
+	liftIO $ writeFile f $ showInodeCache cache
 
-{- Cache a file's inode, size, and modification time to determine if it's
+withInodeCacheFile :: Key -> (FilePath -> Annex a) -> Annex a
- - been changed. -}
+withInodeCacheFile key a = a =<< inRepo (gitAnnexInodeCache key)
-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)

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

Command/Add.hs

@@ -95,7 +95,7 @@ ingest (Just source) = do
 		( do
 			mstat <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus $ keyFilename source
 			k <- genKey source backend
-			godirect k (toCache =<< mstat)
+			godirect k (toInodeCache =<< mstat)
 		, go =<< genKey source backend
 		)
   where
@@ -107,9 +107,9 @@ ingest (Just source) = do
 	go Nothing = failure
 
 	godirect (Just (key, _)) (Just cache) =
-		ifM (compareCache (keyFilename source) $ Just cache)
+		ifM (liftIO $ compareInodeCache (keyFilename source) $ Just cache)
 			( do
-				writeCache key cache
+				writeInodeCache key cache
 				void $ addAssociatedFile key $ keyFilename source
 				unlessM crippledFileSystem $
 					liftIO $ allowWrite $ keyFilename source

Command/Indirect.hs

@@ -73,7 +73,7 @@ perform = do
 		showEndOk
 
 	cleandirect k = do
-		liftIO . nukeFile =<< inRepo (gitAnnexCache k)
+		liftIO . nukeFile =<< inRepo (gitAnnexInodeCache k)
 		liftIO . nukeFile =<< inRepo (gitAnnexMapping k)
 
 cleanup :: CommandCleanup

Locations.hs

@@ -12,7 +12,7 @@ module Locations (
 	keyPath,
 	gitAnnexLocation,
 	gitAnnexMapping,
-	gitAnnexCache,
+	gitAnnexInodeCache,
 	annexLocations,
 	annexLocation,
 	gitAnnexDir,
@@ -123,8 +123,8 @@ gitAnnexMapping key r = do
 {- File that caches information about a key's content, used to determine
  - if a file has changed.
  - Used in direct mode. -}
-gitAnnexCache :: Key -> Git.Repo -> IO FilePath
+gitAnnexInodeCache :: Key -> Git.Repo -> IO FilePath
-gitAnnexCache key r  = do
+gitAnnexInodeCache key r  = do
 	loc <- gitAnnexLocation key r 
 	return $ loc ++ ".cache"
 

Utility/InodeCache.hs

@@ -0,0 +1,50 @@
+{- Caching a file's inode, size, and modification time to see when it's changed.
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.InodeCache where
+
+import Common
+import System.Posix.Types
+
+data InodeCache = InodeCache FileID FileOffset EpochTime
+	deriving (Eq, Show)
+
+showInodeCache :: InodeCache -> String
+showInodeCache (InodeCache inode size mtime) = unwords
+	[ show inode
+	, show size
+	, show mtime
+	]
+
+readInodeCache :: String -> Maybe InodeCache
+readInodeCache s = case words s of
+	(inode:size:mtime:_) -> InodeCache
+		<$> readish inode
+		<*> readish size
+		<*> readish mtime
+	_ -> Nothing
+
+-- for quickcheck
+prop_read_show_inodecache :: InodeCache -> Bool
+prop_read_show_inodecache c = readInodeCache (showInodeCache c) == Just c
+
+genInodeCache :: FilePath -> IO (Maybe InodeCache)
+genInodeCache f = catchDefaultIO Nothing $ toInodeCache <$> getFileStatus f
+
+toInodeCache :: FileStatus -> Maybe InodeCache
+toInodeCache s
+	| isRegularFile s = Just $ InodeCache
+		(fileID s)
+		(fileSize s)
+		(modificationTime s)
+	| otherwise = Nothing
+
+{- Compares an inode cache with the current inode of file. -}
+compareInodeCache :: FilePath -> Maybe InodeCache -> IO Bool
+compareInodeCache file old = do
+	curr <- genInodeCache file
+	return $ isJust curr && curr == old

test.hs

@@ -54,7 +54,7 @@ import qualified Utility.Format
 import qualified Utility.Verifiable
 import qualified Utility.Process
 import qualified Utility.Misc
-import qualified Annex.Content.Direct
+import qualified Utility.InodeCache
 
 -- instances for quickcheck
 instance Arbitrary Types.Key.Key where
@@ -119,7 +119,7 @@ quickcheck = TestLabel "quickcheck" $ TestList
 	, qctest "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane
 	, qctest "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest
 	, qctest "prop_read_write_transferinfo" Logs.Transfer.prop_read_write_transferinfo
-	, qctest "prop_read_show_direct" Annex.Content.Direct.prop_read_show_direct
+	, qctest "prop_read_show_inodecache" Utility.InodeCache.prop_read_show_inodecache
 	, qctest "prop_parse_show_log" Logs.Presence.prop_parse_show_log
 	, qctest "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel
 	, qctest "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog