diff --git a/Annex/Branch.hs b/Annex/Branch.hs index a853d5de1d..8501625898 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -468,16 +468,28 @@ commitIndex' jl branchref message basemessage retrynum parents = do commitIndex' jl committedref racemessage basemessage retrynum' [committedref] {- Lists all files on the branch. including ones in the journal - - that have not been committed yet. There may be duplicates in the list. -} -files :: Annex ([RawFilePath], IO Bool) + - that have not been committed yet. + - + - There may be duplicates in the list, when the journal has files that + - have not been written to the branch yet. + - + - In a read-only repository that has other git-annex branches that have + - not been merged in, returns Nothing, because it's not possible to + - efficiently handle that. + -} +files :: Annex (Maybe ([RawFilePath], IO Bool)) files = do - _ <- update - (bfs, cleanup) <- branchFiles - -- ++ forces the content of the first list to be buffered in - -- memory, so use journalledFiles, which should be much smaller - -- most of the time. branchFiles will stream as the list is consumed. - l <- (++) <$> journalledFiles <*> pure bfs - return (l, cleanup) + st <- update + if not (null (unmergedRefs st)) + then return Nothing + else do + (bfs, cleanup) <- branchFiles + -- ++ forces the content of the first list to be + -- buffered in memory, so use journalledFiles, + -- which should be much smaller most of the time. + -- branchFiles will stream as the list is consumed. + l <- (++) <$> journalledFiles <*> pure bfs + return (Just (l, cleanup)) {- Lists all files currently in the journal. There may be duplicates in - the list when using a private journal. -} diff --git a/Assistant/DeleteRemote.hs b/Assistant/DeleteRemote.hs index f0743401bd..07de5744af 100644 --- a/Assistant/DeleteRemote.hs +++ b/Assistant/DeleteRemote.hs @@ -53,14 +53,14 @@ removeRemote uuid = do - in keys in the current branch. -} removableRemote :: UrlRenderer -> UUID -> Assistant () -removableRemote urlrenderer uuid = do - keys <- getkeys - if null keys - then finishRemovingRemote urlrenderer uuid - else do +removableRemote urlrenderer uuid = getkeys >>= \case + Just keys + | null keys -> finishRemovingRemote urlrenderer uuid + | otherwise -> do r <- fromMaybe (error "unknown remote") <$> liftAnnex (Remote.remoteFromUUID uuid) mapM_ (queueremaining r) keys + Nothing -> noop where queueremaining r k = queueTransferWhenSmall "remaining object in unwanted remote" diff --git a/Command/Info.hs b/Command/Info.hs index f4ef0df800..8f9f243a0b 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2011-2020 Joey Hess + - Copyright 2011-2021 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -370,13 +370,17 @@ local_annex_size = simpleStat "local annex size" $ -- "remote" is in the name for JSON backwards-compatibility repo_annex_keys :: UUID -> Stat -repo_annex_keys u = stat "remote annex keys" $ json show $ - countKeys <$> cachedRemoteData u +repo_annex_keys u = stat "remote annex keys" $ \d -> + cachedRemoteData u >>= \case + Right rd -> json show (pure (countKeys rd)) d + Left n-> json id (pure n) d -- "remote" is in the name for JSON backwards-compatibility repo_annex_size :: UUID -> Stat repo_annex_size u = simpleStat "remote annex size" $ - showSizeKeys =<< cachedRemoteData u + cachedRemoteData u >>= \case + Right d -> showSizeKeys d + Left n -> pure n known_annex_files :: Bool -> Stat known_annex_files isworktree = @@ -524,20 +528,22 @@ cachedPresentData = do put s { presentData = Just v } return v -cachedRemoteData :: UUID -> StatState KeyInfo +cachedRemoteData :: UUID -> StatState (Either String KeyInfo) cachedRemoteData u = do s <- get case M.lookup u (repoData s) of - Just v -> return v + Just v -> return (Right v) Nothing -> do let combinedata d uk = finishCheck uk >>= \case Nothing -> return d Just k -> return $ addKey k d - (ks, cleanup) <- lift $ loggedKeysFor' u - v <- lift $ foldM combinedata emptyKeyInfo ks - liftIO $ void cleanup - put s { repoData = M.insert u v (repoData s) } - return v + lift (loggedKeysFor' u) >>= \case + Just (ks, cleanup) -> do + v <- lift $ foldM combinedata emptyKeyInfo ks + liftIO $ void cleanup + put s { repoData = M.insert u v (repoData s) } + return (Right v) + Nothing -> return (Left "not available in this read-only repository with unmerged git-annex branches") cachedReferencedData :: StatState KeyInfo cachedReferencedData = do diff --git a/Command/Unused.hs b/Command/Unused.hs index 3019dfa7d7..c0eea57068 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -101,7 +101,9 @@ checkRemoteUnused remotename refspec = go =<< Remote.nameToUUID remotename r <- Remote.byUUID u _ <- check "" (remoteUnusedMsg r remotename) (remoteunused u) 0 next $ return True - remoteunused u = excludeReferenced refspec =<< loggedKeysFor u + remoteunused u = loggedKeysFor u >>= \case + Just ks -> excludeReferenced refspec ks + Nothing -> giveup "This repository is read-only." check :: FilePath -> ([(Int, Key)] -> String) -> Annex [Key] -> Int -> Annex Int check file msg a c = do diff --git a/Logs/Location.hs b/Logs/Location.hs index f752e97b98..860d0f456b 100644 --- a/Logs/Location.hs +++ b/Logs/Location.hs @@ -137,15 +137,17 @@ finishCheck (Unchecked a) = a - - Keys that have been marked as dead are not included. -} -loggedKeys :: Annex ([Unchecked Key], IO Bool) +loggedKeys :: Annex (Maybe ([Unchecked Key], IO Bool)) loggedKeys = loggedKeys' (not <$$> checkDead) -loggedKeys' :: (Key -> Annex Bool) -> Annex ([Unchecked Key], IO Bool) +loggedKeys' :: (Key -> Annex Bool) -> Annex (Maybe ([Unchecked Key], IO Bool)) loggedKeys' check = do config <- Annex.getGitConfig - (bfs, cleanup) <- Annex.Branch.files - let l = mapMaybe (defercheck <$$> locationLogFileKey config) bfs - return (l, cleanup) + Annex.Branch.files >>= \case + Nothing -> return Nothing + Just (bfs, cleanup) -> do + let l = mapMaybe (defercheck <$$> locationLogFileKey config) bfs + return (Just (l, cleanup)) where defercheck k = Unchecked $ ifM (check k) ( return (Just k) @@ -157,14 +159,15 @@ loggedKeys' check = do - - This does not stream well; use loggedKeysFor' for lazy streaming. -} -loggedKeysFor :: UUID -> Annex [Key] -loggedKeysFor u = do - (l, cleanup) <- loggedKeysFor' u - l' <- catMaybes <$> mapM finishCheck l - liftIO $ void cleanup - return l' +loggedKeysFor :: UUID -> Annex (Maybe [Key]) +loggedKeysFor u = loggedKeysFor' u >>= \case + Nothing -> return Nothing + Just (l, cleanup) -> do + l' <- catMaybes <$> mapM finishCheck l + liftIO $ void cleanup + return (Just l') -loggedKeysFor' :: UUID -> Annex ([Unchecked Key], IO Bool) +loggedKeysFor' :: UUID -> Annex (Maybe ([Unchecked Key], IO Bool)) loggedKeysFor' u = loggedKeys' isthere where isthere k = do