diff options
| -rw-r--r-- | CmdLine/Seek.hs | 3 | ||||
| -rw-r--r-- | Database/Keys.hs | 13 | ||||
| -rw-r--r-- | Git/LsTree.hs | 9 |
3 files changed, 13 insertions, 12 deletions
diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index e6ee6f3fe..cb7faebac 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -77,7 +77,7 @@ withFilesInRefs a = mapM_ go where go r = do matcher <- Limit.getMatcher - l <- inRepo $ LsTree.lsTree (Git.Ref r) + (l, cleanup) <- inRepo $ LsTree.lsTree (Git.Ref r) forM_ l $ \i -> do let f = getTopFilePath $ LsTree.file i v <- catKey (Git.Ref $ LsTree.sha i) @@ -85,6 +85,7 @@ withFilesInRefs a = mapM_ go Nothing -> noop Just k -> whenM (matcher $ MatchingKey k) $ commandAction $ a f k + liftIO $ void cleanup withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CmdParams -> CommandSeek withPathContents a params = do diff --git a/Database/Keys.hs b/Database/Keys.hs index 0cd7401be..7a844b5b0 100644 --- a/Database/Keys.hs +++ b/Database/Keys.hs @@ -29,9 +29,8 @@ import Database.Types import Database.Keys.Handle import qualified Database.Queue as H import Locations -import Common hiding (delete) -import Annex -import Types.Key +import Common.Annex hiding (delete) +import qualified Annex import Annex.Perms import Annex.LockFile import Utility.InodeCache @@ -42,7 +41,6 @@ import qualified Git.Branch import Git.Ref import Git.FilePath import Annex.CatFile -import Messages import Database.Persist.TH import Database.Esqueleto hiding (Key) @@ -130,12 +128,12 @@ queueDb a (WriteHandle h) = liftIO $ H.queueDb h checkcommit a {- Gets the handle cached in Annex state; creates a new one if it's not yet - available, but doesn't open the database. -} getDbHandle :: Annex DbHandle -getDbHandle = go =<< getState keysdbhandle +getDbHandle = go =<< Annex.getState Annex.keysdbhandle where go (Just h) = pure h go Nothing = do h <- liftIO newDbHandle - changeState $ \s -> s { keysdbhandle = Just h } + Annex.changeState $ \s -> s { Annex.keysdbhandle = Just h } return h {- Opens the database, perhaps creating it if it doesn't exist yet. @@ -219,11 +217,12 @@ scanAssociatedFiles = whenM (isJust <$> inRepo Git.Branch.current) $ runWriter $ \h -> do showSideAction "scanning for unlocked files" dropallassociated h - l <- inRepo $ Git.LsTree.lsTree headRef + (l, cleanup) <- inRepo $ Git.LsTree.lsTree headRef forM_ l $ \i -> when (isregfile i) $ maybe noop (add h i) =<< catKey (Git.Types.Ref $ Git.LsTree.sha i) + liftIO $ void cleanup where dropallassociated = queueDb $ delete $ from $ \(_r :: SqlExpr (Entity Associated)) -> diff --git a/Git/LsTree.hs b/Git/LsTree.hs index 1ed62477e..13f3e4bcd 100644 --- a/Git/LsTree.hs +++ b/Git/LsTree.hs @@ -1,6 +1,6 @@ {- git ls-tree interface - - - Copyright 2011 Joey Hess <id@joeyh.name> + - Copyright 2011-2016 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -32,9 +32,10 @@ data TreeItem = TreeItem {- Lists the complete contents of a tree, recursing into sub-trees, - with lazy output. -} -lsTree :: Ref -> Repo -> IO [TreeItem] -lsTree t repo = map parseLsTree - <$> pipeNullSplitZombie (lsTreeParams t []) repo +lsTree :: Ref -> Repo -> IO ([TreeItem], IO Bool) +lsTree t repo = do + (l, cleanup) <- pipeNullSplit (lsTreeParams t []) repo + return (map parseLsTree l, cleanup) lsTreeParams :: Ref -> [CommandParam] -> [CommandParam] lsTreeParams r ps = |