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,
|
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]
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue