diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs new file mode 100644 index 0000000000..c498216dc3 --- /dev/null +++ b/Command/AddUnused.hs @@ -0,0 +1,34 @@ +{- git-annex command + - + - Copyright 2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.AddUnused where + +import Common.Annex +import Logs.Unused +import Command +import qualified Command.Add + +def :: [Command] +def = [command "addunused" (paramRepeating paramNumRange) + seek "add back unused files"] + +seek :: [CommandSeek] +seek = [withUnusedMaps start] + +start :: UnusedMaps -> Int -> CommandStart +start = startUnused "addunused" perform (performOther "bad") (performOther "tmp") + +perform :: Key -> CommandPerform +perform key = next $ Command.Add.cleanup file key True + where + file = "unused." ++ show key + +{- The content is not in the annex, but in another directory, and + - it seems better to error out, rather than moving bad/tmp content into + - the annex. -} +performOther :: String -> Key -> CommandPerform +performOther other _ = error $ "cannot addunused " ++ other ++ "content" diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 9c9513ca9d..a94c2873dd 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -7,8 +7,7 @@ module Command.DropUnused where -import qualified Data.Map as M - +import Logs.Unused import Common.Annex import Command import qualified Annex @@ -16,50 +15,17 @@ import qualified Command.Drop import qualified Remote import qualified Git import qualified Option -import Types.Key - -type UnusedMap = M.Map Integer Key def :: [Command] def = [withOptions [Command.Drop.fromOption] $ - command "dropunused" (paramRepeating paramNumber) + command "dropunused" (paramRepeating paramNumRange) seek "drop unused file content"] seek :: [CommandSeek] -seek = [withUnusedMaps] +seek = [withUnusedMaps start] -{- 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)) $ - concatMap unusedSpec params - -unusedSpec :: String -> [Integer] -unusedSpec spec - | "-" `isInfixOf` spec = range $ separate (== '-') spec - | otherwise = catMaybes [readish spec] - where - range (a, b) = case (readish a, readish b) of - (Just x, Just y) -> [x..y] - _ -> [] - -start :: (UnusedMap, UnusedMap, UnusedMap) -> Integer -> CommandStart -start (unused, unusedbad, unusedtmp) n = search - [ (unused, perform) - , (unusedbad, performOther gitAnnexBadLocation) - , (unusedtmp, performOther gitAnnexTmpLocation) - ] - where - search [] = stop - search ((m, a):rest) = - case M.lookup n m of - Nothing -> search rest - Just key -> do - showStart "dropunused" (show n) - next $ a key +start :: UnusedMaps -> Int -> CommandStart +start = startUnused "dropunused" perform (performOther gitAnnexBadLocation) (performOther gitAnnexTmpLocation) perform :: Key -> CommandPerform perform key = maybe droplocal dropremote =<< Remote.byName =<< from @@ -76,19 +42,3 @@ performOther filespec key = do f <- fromRepo $ filespec key liftIO $ whenM (doesFileExist f) $ removeFile f next $ return True - -readUnusedLog :: FilePath -> Annex UnusedMap -readUnusedLog prefix = do - f <- fromRepo $ gitAnnexUnusedLog prefix - ifM (liftIO $ doesFileExist f) - ( M.fromList . catMaybes . map parse . lines - <$> liftIO (readFile f) - , return M.empty - ) - where - parse line = - case (readish tag, readKey rest) of - (Just num, Just key) -> Just (num, key) - _ -> Nothing - where - (tag, rest) = separate (== ' ') line diff --git a/Command/Unused.hs b/Command/Unused.hs index 5bdadcf44a..6b319ee72c 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -19,9 +19,9 @@ import Control.Monad.ST import Common.Annex import Command +import Logs.Unused import Annex.Content import Utility.FileMode -import Utility.TempFile import Logs.Location import Config import qualified Annex @@ -91,19 +91,13 @@ check file msg a c = do l <- a let unusedlist = number c l unless (null l) $ showLongNote $ msg unusedlist - writeUnusedFile file unusedlist + writeUnusedLog file unusedlist return $ c + length l number :: Int -> [a] -> [(Int, a)] number _ [] = [] number n (x:xs) = (n+1, x) : number (n+1) xs -writeUnusedFile :: FilePath -> [(Int, Key)] -> Annex () -writeUnusedFile prefix l = do - logfile <- fromRepo $ gitAnnexUnusedLog prefix - liftIO $ viaTmp writeFile logfile $ - unlines $ map (\(n, k) -> show n ++ " " ++ show k) l - table :: [(Int, Key)] -> [String] table l = " NUMBER KEY" : map cols l where diff --git a/GitAnnex.hs b/GitAnnex.hs index 52886c3087..0e707b1868 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -37,6 +37,7 @@ import qualified Command.InitRemote import qualified Command.Fsck import qualified Command.Unused import qualified Command.DropUnused +import qualified Command.AddUnused import qualified Command.Unlock import qualified Command.Lock import qualified Command.PreCommit @@ -86,6 +87,7 @@ cmds = concat , Command.Fsck.def , Command.Unused.def , Command.DropUnused.def + , Command.AddUnused.def , Command.Find.def , Command.Whereis.def , Command.Log.def diff --git a/Logs/Unused.hs b/Logs/Unused.hs new file mode 100644 index 0000000000..7d240cfe33 --- /dev/null +++ b/Logs/Unused.hs @@ -0,0 +1,91 @@ +{- git-annex unused log file + - + - Copyright 2010,2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Logs.Unused ( + UnusedMap, + UnusedMaps(..), + writeUnusedLog, + readUnusedLog, + withUnusedMaps, + startUnused, +) where + +import qualified Data.Map as M + +import Common.Annex +import Command +import Types.Key +import Utility.TempFile + +writeUnusedLog :: FilePath -> [(Int, Key)] -> Annex () +writeUnusedLog prefix l = do + logfile <- fromRepo $ gitAnnexUnusedLog prefix + liftIO $ viaTmp writeFile logfile $ + unlines $ map (\(n, k) -> show n ++ " " ++ show k) l + +readUnusedLog :: FilePath -> Annex UnusedMap +readUnusedLog prefix = do + f <- fromRepo $ gitAnnexUnusedLog prefix + ifM (liftIO $ doesFileExist f) + ( M.fromList . catMaybes . map parse . lines + <$> liftIO (readFile f) + , return M.empty + ) + where + parse line = + case (readish tag, readKey rest) of + (Just num, Just key) -> Just (num, key) + _ -> Nothing + where + (tag, rest) = separate (== ' ') line + +type UnusedMap = M.Map Int Key + +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 = catMaybes [readish spec] + where + range (a, b) = case (readish a, readish b) of + (Just x, Just y) -> [x..y] + _ -> [] + +{- 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 diff --git a/Usage.hs b/Usage.hs index b1de930ef2..e74c1490d0 100644 --- a/Usage.hs +++ b/Usage.hs @@ -61,6 +61,8 @@ paramUrl :: String paramUrl = "URL" paramNumber :: String paramNumber = "NUMBER" +paramNumRange :: String +paramNumRange = "NUM|RANGE" paramRemote :: String paramRemote = "REMOTE" paramGlob :: String diff --git a/debian/changelog b/debian/changelog index 72bce85511..b419b46227 100644 --- a/debian/changelog +++ b/debian/changelog @@ -6,6 +6,8 @@ git-annex (3.20120431) UNRELEASED; urgency=low (specificially hidrive.strato.com) that use rsync over ssh but do not pass it through the shell. * dropunused: Allow specifying ranges to drop. + * addunused: New command, the opposite of dropunused, it relinks unused + content into the git repository. -- Joey Hess Wed, 02 May 2012 13:06:18 -0400 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 998e1fa266..5d41f86e9c 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -235,7 +235,7 @@ subdirectories). To check for annexed data on a remote, specify --from. -* dropunused [number ...] +* dropunused [number|range ...] Drops the data corresponding to the numbers, as listed by the last `git annex unused` @@ -244,6 +244,12 @@ subdirectories). To drop the data from a remote, specify --from. +* addunused [number|range ...] + + Adds back files for the content corresponding to the numbers or ranges, + as listed by the last `git annex unused`. The files will have names + starting with "unused." + * merge Automatically merges remote tracking branches */git-annex into