9f1577f746
The only remaining vestiage of backends is different types of keys. These are still called "backends", mostly to avoid needing to change user interface and configuration. But everything to do with storing keys in different backends was gone; instead different types of remotes are used. In the refactoring, lots of code was moved out of odd corners like Backend.File, to closer to where it's used, like Command.Drop and Command.Fsck. Quite a lot of dead code was removed. Several data structures became simpler, which may result in better runtime efficiency. There should be no user-visible changes.
88 lines
2.3 KiB
Haskell
88 lines
2.3 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.DropUnused where
|
|
|
|
import Control.Monad.State (liftIO)
|
|
import qualified Data.Map as M
|
|
import System.Directory
|
|
import Data.Maybe
|
|
|
|
import Command
|
|
import Types
|
|
import Messages
|
|
import Locations
|
|
import qualified Annex
|
|
import qualified Command.Drop
|
|
import qualified Command.Move
|
|
import qualified Remote
|
|
import qualified Git
|
|
import Types.Key
|
|
import Utility
|
|
|
|
type UnusedMap = M.Map String Key
|
|
|
|
command :: [Command]
|
|
command = [repoCommand "dropunused" (paramRepeating paramNumber) seek
|
|
"drop unused file content"]
|
|
|
|
seek :: [CommandSeek]
|
|
seek = [withUnusedMaps]
|
|
|
|
{- 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 :: (UnusedMap, UnusedMap, UnusedMap) -> CommandStartString
|
|
start (unused, unusedbad, unusedtmp) s = notBareRepo $ search
|
|
[ (unused, perform)
|
|
, (unusedbad, performOther gitAnnexBadLocation)
|
|
, (unusedtmp, performOther gitAnnexTmpLocation)
|
|
]
|
|
where
|
|
search [] = stop
|
|
search ((m, a):rest) = do
|
|
case M.lookup s m of
|
|
Nothing -> search rest
|
|
Just key -> do
|
|
showStart "dropunused" s
|
|
next $ a key
|
|
|
|
perform :: Key -> CommandPerform
|
|
perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote
|
|
where
|
|
dropremote name = do
|
|
r <- Remote.byName name
|
|
showNote $ "from " ++ Remote.name r ++ "..."
|
|
next $ Command.Move.fromCleanup r True key
|
|
droplocal = Command.Drop.perform key (Just 0) -- force drop
|
|
|
|
performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform
|
|
performOther filespec key = do
|
|
g <- Annex.gitRepo
|
|
let f = filespec g key
|
|
liftIO $ whenM (doesFileExist f) $ removeFile f
|
|
next $ 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
|
|
l <- liftIO $ readFile f
|
|
return $ M.fromList $ map parse $ lines l
|
|
else return $ M.empty
|
|
where
|
|
parse line = (head ws, fromJust $ readKey $ unwords $ tail ws)
|
|
where
|
|
ws = words line
|