From 697bb401dbb2a9497e8e3cbc895052ad87a75c23 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 17 Oct 2016 14:58:33 -0400
Subject: refactor

---
 Database/Keys.hs     | 32 +-------------------------------
 Database/Keys/SQL.hs | 12 ++++++++++++
 2 files changed, 13 insertions(+), 31 deletions(-)

(limited to 'Database')

diff --git a/Database/Keys.hs b/Database/Keys.hs
index 3d9330e90..77f4f6382 100644
--- a/Database/Keys.hs
+++ b/Database/Keys.hs
@@ -14,11 +14,11 @@ module Database.Keys (
 	getAssociatedFiles,
 	getAssociatedKey,
 	removeAssociatedFile,
-	scanAssociatedFiles,
 	storeInodeCaches,
 	addInodeCaches,
 	getInodeCaches,
 	removeInodeCaches,
+	runWriter,
 ) where
 
 import qualified Database.Keys.SQL as SQL
@@ -36,11 +36,7 @@ import Annex.InodeSentinal
 import qualified Git.Types
 import qualified Git.LsTree
 import qualified Git.Branch
-import Git.Ref
 import Git.FilePath
-import Annex.CatFile
-
-import Database.Esqueleto hiding (Key)
 
 {- Runs an action that reads from the database.
  -
@@ -168,32 +164,6 @@ getAssociatedKey = map fromIKey <$$> runReaderIO . SQL.getAssociatedKey
 removeAssociatedFile :: Key -> TopFilePath -> Annex ()
 removeAssociatedFile k = runWriterIO . SQL.removeAssociatedFile (toIKey k)
 
-{- Find all unlocked associated files. This is expensive, and so normally
- - the associated files are updated incrementally when changes are noticed. -}
-scanAssociatedFiles :: Annex ()
-scanAssociatedFiles = whenM (isJust <$> inRepo Git.Branch.current) $ 
-	runWriter $ \h -> do
-		showSideAction "scanning for unlocked files"
-		dropallassociated h
-		(l, cleanup) <- inRepo $ Git.LsTree.lsTree headRef
-		forM_ l $ \i -> 
-			when (isregfile i) $
-				maybe noop (add h i)
-					=<< catKey (Git.LsTree.sha i)
-		liftIO $ void cleanup
-  where
-	dropallassociated h = liftIO $ flip SQL.queueDb h $
-		delete $ from $ \(_r :: SqlExpr (Entity SQL.Associated)) ->
-			return ()
-	isregfile i = case Git.Types.toBlobType (Git.LsTree.mode i) of
-		Just Git.Types.FileBlob -> True
-		Just Git.Types.ExecutableBlob -> True
-		_ -> False
-	add h i k = liftIO $ flip SQL.queueDb h $ 
-		void $ insertUnique $ SQL.Associated
-			(toIKey k)
-			(toSFilePath $ getTopFilePath $ Git.LsTree.file i)
-
 {- Stats the files, and stores their InodeCaches. -}
 storeInodeCaches :: Key -> [FilePath] -> Annex ()
 storeInodeCaches k fs = withTSDelta $ \d ->
diff --git a/Database/Keys/SQL.hs b/Database/Keys/SQL.hs
index 88e6ba2dc..77c1e4429 100644
--- a/Database/Keys/SQL.hs
+++ b/Database/Keys/SQL.hs
@@ -68,6 +68,18 @@ addAssociatedFile ik f = queueDb $ do
   where
 	af = toSFilePath (getTopFilePath f)
 
+-- Does not remove any old association for a file, but less expensive
+-- than addAssociatedFile. Calling dropAllAssociatedFiles first and then
+-- this is an efficient way to update all associated files.
+addAssociatedFileFast :: IKey -> TopFilePath -> WriteHandle -> IO ()
+addAssociatedFileFast ik f = queueDb $ void $ insertUnique $ Associated ik af
+  where
+	af = toSFilePath (getTopFilePath f)
+
+dropAllAssociatedFiles :: WriteHandle -> IO ()
+dropAllAssociatedFiles = queueDb $
+	delete $ from $ \(_r :: SqlExpr (Entity Associated)) -> return ()
+
 {- Note that the files returned were once associated with the key, but
  - some of them may not be any longer. -}
 getAssociatedFiles :: IKey -> ReadHandle -> IO [TopFilePath]
-- 
cgit v1.2.3