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:
Joey Hess 2011-06-22 23:24:14 -04:00
parent 68783fd5e0
commit aad73c5721
3 changed files with 12 additions and 22 deletions

View file

@ -11,7 +11,7 @@ module Branch (
get, get,
change, change,
commit, commit,
shortref files
) where ) where
import Control.Monad (unless, when, liftM) import Control.Monad (unless, when, liftM)
@ -222,3 +222,10 @@ cmdOutput cmd params = do
let rv = seq retval retval let rv = seq retval retval
_ <- getProcessStatus True False pid _ <- getProcessStatus True False pid
return rv 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]

View file

@ -66,10 +66,8 @@ checkRemoteUnused name = do
checkRemoteUnused' :: Remote.Remote Annex -> Annex () checkRemoteUnused' :: Remote.Remote Annex -> Annex ()
checkRemoteUnused' r = do checkRemoteUnused' r = do
showNote $ "checking for unused data..." showNote $ "checking for unused data..."
g <- Annex.gitRepo
referenced <- getKeysReferenced referenced <- getKeysReferenced
logged <- loggedKeys g remotehas <- filterM isthere =<< loggedKeys
remotehas <- filterM isthere logged
let remoteunused = remotehas `exclude` referenced let remoteunused = remotehas `exclude` referenced
let list = number 0 remoteunused let list = number 0 remoteunused
writeUnusedFile "" list writeUnusedFile "" list

View file

@ -26,7 +26,6 @@ module LocationLog (
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
import Data.Time import Data.Time
import System.Locale import System.Locale
import System.Directory
import System.FilePath import System.FilePath
import qualified Data.Map as Map import qualified Data.Map as Map
import Control.Monad (when) import Control.Monad (when)
@ -35,7 +34,6 @@ import Control.Monad.State (liftIO)
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified Branch import qualified Branch
import Utility
import UUID import UUID
import Types import Types
import Locations import Locations
@ -148,19 +146,6 @@ mapLog m l =
{- Finds all keys that have location log information. {- Finds all keys that have location log information.
- (There may be duplicate keys in the list.) -} - (There may be duplicate keys in the list.) -}
loggedKeys :: Git.Repo -> Annex [Key] loggedKeys :: Annex [Key]
loggedKeys repo = do loggedKeys =
_ <- error "FIXME.. does not look in git-annex branch yet" return . catMaybes . map (logFileKey . takeFileName) =<< Branch.files
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