unused: Now also lists files fsck places in .git/annex/bad/
This commit is contained in:
parent
49efc6c399
commit
43f0a666f0
5 changed files with 114 additions and 78 deletions
|
@ -21,54 +21,66 @@ import qualified Annex
|
|||
import qualified Command.Drop
|
||||
import qualified Command.Move
|
||||
import qualified Remote
|
||||
import qualified GitRepo as Git
|
||||
import Backend
|
||||
import Key
|
||||
|
||||
type UnusedMap = M.Map String Key
|
||||
|
||||
command :: [Command]
|
||||
command = [repoCommand "dropunused" (paramRepeating paramNumber) seek
|
||||
"drop unused file content"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withUnusedMap]
|
||||
seek = [withUnusedMaps]
|
||||
|
||||
{- Read unusedlog once, and pass the map to each start action. -}
|
||||
withUnusedMap :: CommandSeek
|
||||
withUnusedMap params = do
|
||||
m <- readUnusedLog
|
||||
return $ map (start m) params
|
||||
{- Read unused logs once, and pass the maps to each start action. -}
|
||||
withUnusedMaps :: CommandSeek
|
||||
withUnusedMaps params = do
|
||||
unused <- readUnusedLog ""
|
||||
unusedbad <- readUnusedLog "bad"
|
||||
unusedtmp <- readUnusedLog "tmp"
|
||||
return $ map (start (unused, unusedbad, unusedtmp)) params
|
||||
|
||||
start :: M.Map String Key -> CommandStartString
|
||||
start m s = notBareRepo $ do
|
||||
case M.lookup s m of
|
||||
Nothing -> return Nothing
|
||||
Just key -> do
|
||||
showStart "dropunused" s
|
||||
from <- Annex.getState Annex.fromremote
|
||||
case from of
|
||||
Just name -> do
|
||||
r <- Remote.byName name
|
||||
return $ Just $ performRemote r key
|
||||
_ -> return $ Just $ perform key
|
||||
start :: (UnusedMap, UnusedMap, UnusedMap) -> CommandStartString
|
||||
start (unused, unusedbad, unusedtmp) s = notBareRepo $ search
|
||||
[ (unused, perform)
|
||||
, (unusedbad, performOther gitAnnexBadLocation)
|
||||
, (unusedtmp, performOther gitAnnexTmpLocation)
|
||||
]
|
||||
where
|
||||
search [] = return Nothing
|
||||
search ((m, a):rest) = do
|
||||
case M.lookup s m of
|
||||
Nothing -> search rest
|
||||
Just key -> do
|
||||
showStart "dropunused" s
|
||||
return $ Just $ a key
|
||||
|
||||
{- drop both content in the backend and any tmp file for the key -}
|
||||
perform :: Key -> CommandPerform
|
||||
perform key = do
|
||||
g <- Annex.gitRepo
|
||||
let tmp = gitAnnexTmpLocation g key
|
||||
tmp_exists <- liftIO $ doesFileExist tmp
|
||||
when tmp_exists $ liftIO $ removeFile tmp
|
||||
backend <- keyBackend key
|
||||
Command.Drop.perform key backend (Just 0) -- force drop
|
||||
from <- Annex.getState Annex.fromremote
|
||||
case from of
|
||||
Just name -> do
|
||||
r <- Remote.byName name
|
||||
showNote $ "from " ++ Remote.name r ++ "..."
|
||||
return $ Just $ Command.Move.fromCleanup r True key
|
||||
_ -> do
|
||||
backend <- keyBackend key
|
||||
Command.Drop.perform key backend (Just 0) -- force drop
|
||||
|
||||
performRemote :: Remote.Remote Annex -> Key -> CommandPerform
|
||||
performRemote r key = do
|
||||
showNote $ "from " ++ Remote.name r ++ "..."
|
||||
return $ Just $ Command.Move.fromCleanup r True key
|
||||
|
||||
readUnusedLog :: Annex (M.Map String Key)
|
||||
readUnusedLog = do
|
||||
performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform
|
||||
performOther filespec key = do
|
||||
g <- Annex.gitRepo
|
||||
let f = gitAnnexUnusedLog g
|
||||
let f = filespec g key
|
||||
e <- liftIO $ doesFileExist f
|
||||
when e $ liftIO $ removeFile f
|
||||
return $ Just $ return True
|
||||
|
||||
readUnusedLog :: FilePath -> Annex UnusedMap
|
||||
readUnusedLog prefix = do
|
||||
g <- Annex.gitRepo
|
||||
let f = gitAnnexUnusedLog prefix g
|
||||
e <- liftIO $ doesFileExist f
|
||||
if e
|
||||
then do
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue