--unused: New switch that makes git-annex operate on all data found by the last run of git annex unused. Supported by fsck, get, move, copy.
This commit is contained in:
parent
ef4239dda0
commit
04d07f2c1f
13 changed files with 120 additions and 87 deletions
|
@ -8,10 +8,10 @@
|
|||
module Command.AddUnused where
|
||||
|
||||
import Common.Annex
|
||||
import Logs.Unused
|
||||
import Logs.Location
|
||||
import Command
|
||||
import qualified Command.Add
|
||||
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
|
||||
import Types.Key
|
||||
|
||||
def :: [Command]
|
||||
|
|
|
@ -21,7 +21,7 @@ seek :: [CommandSeek]
|
|||
seek =
|
||||
[ withField Command.Move.toOption Remote.byNameWithUUID $ \to ->
|
||||
withField Command.Move.fromOption Remote.byNameWithUUID $ \from ->
|
||||
withAll (Command.Move.startAll to from False) $
|
||||
withKeyOptions (Command.Move.startKey to from False) $
|
||||
withFilesInGit $ whenAnnexed $ start to from
|
||||
]
|
||||
|
||||
|
|
|
@ -7,7 +7,6 @@
|
|||
|
||||
module Command.DropUnused where
|
||||
|
||||
import Logs.Unused
|
||||
import Common.Annex
|
||||
import Command
|
||||
import qualified Annex
|
||||
|
@ -15,6 +14,7 @@ import qualified Command.Drop
|
|||
import qualified Remote
|
||||
import qualified Git
|
||||
import qualified Option
|
||||
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
|
||||
|
||||
def :: [Command]
|
||||
def = [withOptions [Command.Drop.fromOption] $
|
||||
|
|
|
@ -64,18 +64,17 @@ incrementalScheduleOption = Option.field [] "incremental-schedule" paramTime
|
|||
|
||||
fsckOptions :: [Option]
|
||||
fsckOptions =
|
||||
[ allOption
|
||||
, fromOption
|
||||
[ fromOption
|
||||
, startIncrementalOption
|
||||
, moreIncrementalOption
|
||||
, incrementalScheduleOption
|
||||
]
|
||||
] ++ keyOptions
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek =
|
||||
[ withField fromOption Remote.byNameWithUUID $ \from ->
|
||||
withIncremental $ \i ->
|
||||
withAll (startAll i) $
|
||||
withKeyOptions (startKey i) $
|
||||
withFilesInGit $ whenAnnexed $ start from i
|
||||
]
|
||||
|
||||
|
@ -173,8 +172,8 @@ performRemote key file backend numcopies remote =
|
|||
)
|
||||
dummymeter _ = noop
|
||||
|
||||
startAll :: Incremental -> Key -> CommandStart
|
||||
startAll inc key = case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of
|
||||
startKey :: Incremental -> Key -> CommandStart
|
||||
startKey inc key = case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of
|
||||
Nothing -> stop
|
||||
Just backend -> runFsck inc (key2file key) key $ performAll key backend
|
||||
|
||||
|
|
|
@ -23,12 +23,12 @@ def = [withOptions getOptions $ command "get" paramPaths seek
|
|||
SectionCommon "make content of annexed files available"]
|
||||
|
||||
getOptions :: [Option]
|
||||
getOptions = [allOption, Command.Move.fromOption]
|
||||
getOptions = [Command.Move.fromOption] ++ keyOptions
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek =
|
||||
[ withField Command.Move.fromOption Remote.byNameWithUUID $ \from ->
|
||||
withAll (startAll from) $
|
||||
withKeyOptions (startKeys from) $
|
||||
withFilesInGit $ whenAnnexed $ start from
|
||||
]
|
||||
|
||||
|
@ -37,8 +37,8 @@ start from file (key, _) = start' expensivecheck from key (Just file)
|
|||
where
|
||||
expensivecheck = checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just file))
|
||||
|
||||
startAll :: Maybe Remote -> Key -> CommandStart
|
||||
startAll from key = start' (return True) from key Nothing
|
||||
startKeys :: Maybe Remote -> Key -> CommandStart
|
||||
startKeys from key = start' (return True) from key Nothing
|
||||
|
||||
start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> CommandStart
|
||||
start' expensivecheck from key afile = stopUnless (not <$> inAnnex key) $
|
||||
|
|
|
@ -32,21 +32,21 @@ toOption :: Option
|
|||
toOption = Option.field ['t'] "to" paramRemote "destination remote"
|
||||
|
||||
moveOptions :: [Option]
|
||||
moveOptions = [allOption, fromOption, toOption]
|
||||
moveOptions = [fromOption, toOption] ++ keyOptions
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek =
|
||||
[ withField toOption Remote.byNameWithUUID $ \to ->
|
||||
withField fromOption Remote.byNameWithUUID $ \from ->
|
||||
withAll (startAll to from True) $
|
||||
withKeyOptions (startKey to from True) $
|
||||
withFilesInGit $ whenAnnexed $ start to from True
|
||||
]
|
||||
|
||||
start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart
|
||||
start to from move file (key, _) = start' to from move (Just file) key
|
||||
|
||||
startAll :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart
|
||||
startAll to from move key = start' to from move Nothing key
|
||||
startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart
|
||||
startKey to from move key = start' to from move Nothing key
|
||||
|
||||
start' :: Maybe Remote -> Maybe Remote -> Bool -> AssociatedFile -> Key -> CommandStart
|
||||
start' to from move afile key = do
|
||||
|
|
|
@ -15,6 +15,7 @@ import Data.BloomFilter
|
|||
import Data.BloomFilter.Easy
|
||||
import Data.BloomFilter.Hash
|
||||
import Control.Monad.ST
|
||||
import qualified Data.Map as M
|
||||
|
||||
import Common.Annex
|
||||
import Command
|
||||
|
@ -311,3 +312,49 @@ staleKeys dirspec = do
|
|||
return $ mapMaybe (fileKey . takeFileName) files
|
||||
, return []
|
||||
)
|
||||
|
||||
data UnusedMaps = UnusedMaps
|
||||
{ unusedMap :: UnusedMap
|
||||
, unusedBadMap :: UnusedMap
|
||||
, unusedTmpMap :: UnusedMap
|
||||
}
|
||||
|
||||
{- Read unused logs once, and pass the maps to each start action. -}
|
||||
withUnusedMaps :: (UnusedMaps -> Int -> CommandStart) -> CommandSeek
|
||||
withUnusedMaps a params = do
|
||||
unused <- readUnusedLog ""
|
||||
unusedbad <- readUnusedLog "bad"
|
||||
unusedtmp <- readUnusedLog "tmp"
|
||||
return $ map (a $ UnusedMaps unused unusedbad unusedtmp) $
|
||||
concatMap unusedSpec params
|
||||
|
||||
unusedSpec :: String -> [Int]
|
||||
unusedSpec spec
|
||||
| "-" `isInfixOf` spec = range $ separate (== '-') spec
|
||||
| otherwise = maybe badspec (: []) (readish spec)
|
||||
where
|
||||
range (a, b) = case (readish a, readish b) of
|
||||
(Just x, Just y) -> [x..y]
|
||||
_ -> badspec
|
||||
badspec = error $ "Expected number or range, not \"" ++ spec ++ "\""
|
||||
|
||||
{- Start action for unused content. Finds the number in the maps, and
|
||||
- calls either of 3 actions, depending on the type of unused file. -}
|
||||
startUnused :: String
|
||||
-> (Key -> CommandPerform)
|
||||
-> (Key -> CommandPerform)
|
||||
-> (Key -> CommandPerform)
|
||||
-> UnusedMaps -> Int -> CommandStart
|
||||
startUnused message unused badunused tmpunused maps n = search
|
||||
[ (unusedMap maps, unused)
|
||||
, (unusedBadMap maps, badunused)
|
||||
, (unusedTmpMap maps, tmpunused)
|
||||
]
|
||||
where
|
||||
search [] = stop
|
||||
search ((m, a):rest) =
|
||||
case M.lookup n m of
|
||||
Nothing -> search rest
|
||||
Just key -> do
|
||||
showStart message (show n)
|
||||
next $ a key
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue