aboutsummaryrefslogtreecommitdiff
path: root/Database/Keys.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-10-17 14:58:33 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-10-17 14:58:33 -0400
commit697bb401dbb2a9497e8e3cbc895052ad87a75c23 (patch)
tree75ce98791b4863dea985fa3c16b19d9cc5dfcab5 /Database/Keys.hs
parent124a153411a440c6996315ca0189556aabbae78b (diff)
refactor
Diffstat (limited to 'Database/Keys.hs')
-rw-r--r--Database/Keys.hs32
1 files changed, 1 insertions, 31 deletions
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 ->