diff options
Diffstat (limited to 'Command/DropUnused.hs')
-rw-r--r-- | Command/DropUnused.hs | 76 |
1 files changed, 44 insertions, 32 deletions
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 1eec68820..b129235e1 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -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 +performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform +performOther filespec key = do + g <- Annex.gitRepo + let f = filespec g key + e <- liftIO $ doesFileExist f + when e $ liftIO $ removeFile f + return $ Just $ return True -readUnusedLog :: Annex (M.Map String Key) -readUnusedLog = do +readUnusedLog :: FilePath -> Annex UnusedMap +readUnusedLog prefix = do g <- Annex.gitRepo - let f = gitAnnexUnusedLog g + let f = gitAnnexUnusedLog prefix g e <- liftIO $ doesFileExist f if e then do |