diff options
Diffstat (limited to 'Command')
-rw-r--r-- | Command/AddUnused.hs | 2 | ||||
-rw-r--r-- | Command/Copy.hs | 2 | ||||
-rw-r--r-- | Command/DropUnused.hs | 2 | ||||
-rw-r--r-- | Command/Fsck.hs | 11 | ||||
-rw-r--r-- | Command/Get.hs | 8 | ||||
-rw-r--r-- | Command/Move.hs | 8 | ||||
-rw-r--r-- | Command/Unused.hs | 47 |
7 files changed, 63 insertions, 17 deletions
diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs index 33acc4487..21a75137f 100644 --- a/Command/AddUnused.hs +++ b/Command/AddUnused.hs @@ -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] diff --git a/Command/Copy.hs b/Command/Copy.hs index 979eead65..4e1646ad1 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -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 ] diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index a23e0cb39..687a38a04 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -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] $ diff --git a/Command/Fsck.hs b/Command/Fsck.hs index dd2d81ecf..ccc5811cc 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -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 diff --git a/Command/Get.hs b/Command/Get.hs index 56dbe415f..0bbe4dc1a 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -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) $ diff --git a/Command/Move.hs b/Command/Move.hs index 3f91f1bd9..142a84d71 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -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 diff --git a/Command/Unused.hs b/Command/Unused.hs index 6c4a61cd4..989faa9a3 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -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 |