rewrite loggedkeys to use git-annex branch
That sucking sound is a whole page of code vanishing to be replaced with return . catMaybes . map (logFileKey . takeFileName) =<< Branch.files What can I say, git is my database, and haskell my copilot.
This commit is contained in:
parent
68783fd5e0
commit
aad73c5721
3 changed files with 12 additions and 22 deletions
|
@ -11,7 +11,7 @@ module Branch (
|
|||
get,
|
||||
change,
|
||||
commit,
|
||||
shortref
|
||||
files
|
||||
) where
|
||||
|
||||
import Control.Monad (unless, when, liftM)
|
||||
|
@ -222,3 +222,10 @@ cmdOutput cmd params = do
|
|||
let rv = seq retval retval
|
||||
_ <- getProcessStatus True False pid
|
||||
return rv
|
||||
|
||||
{- Lists all files on the branch. -}
|
||||
files :: Annex [FilePath]
|
||||
files = withIndexUpdate $ do
|
||||
g <- Annex.gitRepo
|
||||
liftIO $ Git.pipeNullSplit g
|
||||
[Params "ls-tree --name-only -r -z", Param fullname]
|
||||
|
|
|
@ -66,10 +66,8 @@ checkRemoteUnused name = do
|
|||
checkRemoteUnused' :: Remote.Remote Annex -> Annex ()
|
||||
checkRemoteUnused' r = do
|
||||
showNote $ "checking for unused data..."
|
||||
g <- Annex.gitRepo
|
||||
referenced <- getKeysReferenced
|
||||
logged <- loggedKeys g
|
||||
remotehas <- filterM isthere logged
|
||||
remotehas <- filterM isthere =<< loggedKeys
|
||||
let remoteunused = remotehas `exclude` referenced
|
||||
let list = number 0 remoteunused
|
||||
writeUnusedFile "" list
|
||||
|
|
|
@ -26,7 +26,6 @@ module LocationLog (
|
|||
import Data.Time.Clock.POSIX
|
||||
import Data.Time
|
||||
import System.Locale
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import qualified Data.Map as Map
|
||||
import Control.Monad (when)
|
||||
|
@ -35,7 +34,6 @@ import Control.Monad.State (liftIO)
|
|||
|
||||
import qualified GitRepo as Git
|
||||
import qualified Branch
|
||||
import Utility
|
||||
import UUID
|
||||
import Types
|
||||
import Locations
|
||||
|
@ -148,19 +146,6 @@ mapLog m l =
|
|||
|
||||
{- Finds all keys that have location log information.
|
||||
- (There may be duplicate keys in the list.) -}
|
||||
loggedKeys :: Git.Repo -> Annex [Key]
|
||||
loggedKeys repo = do
|
||||
_ <- error "FIXME.. does not look in git-annex branch yet"
|
||||
exists <- liftIO $ doesDirectoryExist dir
|
||||
if exists
|
||||
then do
|
||||
-- 2 levels of hashing
|
||||
levela <- liftIO $ dirContents dir
|
||||
levelb <- mapM tryDirContents levela
|
||||
files <- mapM tryDirContents (concat levelb)
|
||||
return $ catMaybes $
|
||||
map (logFileKey . takeFileName) (concat files)
|
||||
else return []
|
||||
where
|
||||
tryDirContents d = liftIO $ catch (dirContents d) (return . const [])
|
||||
dir = gitStateDir repo
|
||||
loggedKeys :: Annex [Key]
|
||||
loggedKeys =
|
||||
return . catMaybes . map (logFileKey . takeFileName) =<< Branch.files
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue