diff options
| author |  Joey Hess <joeyh@joeyh.name> | 2016-10-17 14:58:33 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2016-10-17 14:58:33 -0400 |
| commit | 697bb401dbb2a9497e8e3cbc895052ad87a75c23 (patch) | |
| tree | 75ce98791b4863dea985fa3c16b19d9cc5dfcab5 /Database/Keys.hs | |
| parent | 124a153411a440c6996315ca0189556aabbae78b (diff) | |
refactor
Diffstat (limited to 'Database/Keys.hs')
| -rw-r--r-- | Database/Keys.hs | 32 |
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 -> |