addunused: New command, the opposite of dropunused, it relinks unused content into the git repository.

This commit is contained in:
Joey Hess 2012-05-02 14:59:05 -04:00
parent 7d6b36dffb
commit 392931eca9
8 changed files with 145 additions and 64 deletions

34
Command/AddUnused.hs Normal file
View file

@ -0,0 +1,34 @@
{- git-annex command
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- 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"

View file

@ -7,8 +7,7 @@
module Command.DropUnused where module Command.DropUnused where
import qualified Data.Map as M import Logs.Unused
import Common.Annex import Common.Annex
import Command import Command
import qualified Annex import qualified Annex
@ -16,50 +15,17 @@ import qualified Command.Drop
import qualified Remote import qualified Remote
import qualified Git import qualified Git
import qualified Option import qualified Option
import Types.Key
type UnusedMap = M.Map Integer Key
def :: [Command] def :: [Command]
def = [withOptions [Command.Drop.fromOption] $ def = [withOptions [Command.Drop.fromOption] $
command "dropunused" (paramRepeating paramNumber) command "dropunused" (paramRepeating paramNumRange)
seek "drop unused file content"] seek "drop unused file content"]
seek :: [CommandSeek] seek :: [CommandSeek]
seek = [withUnusedMaps] seek = [withUnusedMaps start]
{- Read unused logs once, and pass the maps to each start action. -} start :: UnusedMaps -> Int -> CommandStart
withUnusedMaps :: CommandSeek start = startUnused "dropunused" perform (performOther gitAnnexBadLocation) (performOther gitAnnexTmpLocation)
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
perform :: Key -> CommandPerform perform :: Key -> CommandPerform
perform key = maybe droplocal dropremote =<< Remote.byName =<< from perform key = maybe droplocal dropremote =<< Remote.byName =<< from
@ -76,19 +42,3 @@ performOther filespec key = do
f <- fromRepo $ filespec key f <- fromRepo $ filespec key
liftIO $ whenM (doesFileExist f) $ removeFile f liftIO $ whenM (doesFileExist f) $ removeFile f
next $ return True 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

View file

@ -19,9 +19,9 @@ import Control.Monad.ST
import Common.Annex import Common.Annex
import Command import Command
import Logs.Unused
import Annex.Content import Annex.Content
import Utility.FileMode import Utility.FileMode
import Utility.TempFile
import Logs.Location import Logs.Location
import Config import Config
import qualified Annex import qualified Annex
@ -91,19 +91,13 @@ check file msg a c = do
l <- a l <- a
let unusedlist = number c l let unusedlist = number c l
unless (null l) $ showLongNote $ msg unusedlist unless (null l) $ showLongNote $ msg unusedlist
writeUnusedFile file unusedlist writeUnusedLog file unusedlist
return $ c + length l return $ c + length l
number :: Int -> [a] -> [(Int, a)] number :: Int -> [a] -> [(Int, a)]
number _ [] = [] number _ [] = []
number n (x:xs) = (n+1, x) : number (n+1) xs 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 :: [(Int, Key)] -> [String]
table l = " NUMBER KEY" : map cols l table l = " NUMBER KEY" : map cols l
where where

View file

@ -37,6 +37,7 @@ import qualified Command.InitRemote
import qualified Command.Fsck import qualified Command.Fsck
import qualified Command.Unused import qualified Command.Unused
import qualified Command.DropUnused import qualified Command.DropUnused
import qualified Command.AddUnused
import qualified Command.Unlock import qualified Command.Unlock
import qualified Command.Lock import qualified Command.Lock
import qualified Command.PreCommit import qualified Command.PreCommit
@ -86,6 +87,7 @@ cmds = concat
, Command.Fsck.def , Command.Fsck.def
, Command.Unused.def , Command.Unused.def
, Command.DropUnused.def , Command.DropUnused.def
, Command.AddUnused.def
, Command.Find.def , Command.Find.def
, Command.Whereis.def , Command.Whereis.def
, Command.Log.def , Command.Log.def

91
Logs/Unused.hs Normal file
View file

@ -0,0 +1,91 @@
{- git-annex unused log file
-
- Copyright 2010,2012 Joey Hess <joey@kitenet.net>
-
- 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

View file

@ -61,6 +61,8 @@ paramUrl :: String
paramUrl = "URL" paramUrl = "URL"
paramNumber :: String paramNumber :: String
paramNumber = "NUMBER" paramNumber = "NUMBER"
paramNumRange :: String
paramNumRange = "NUM|RANGE"
paramRemote :: String paramRemote :: String
paramRemote = "REMOTE" paramRemote = "REMOTE"
paramGlob :: String paramGlob :: String

2
debian/changelog vendored
View file

@ -6,6 +6,8 @@ git-annex (3.20120431) UNRELEASED; urgency=low
(specificially hidrive.strato.com) that use rsync over ssh but do not (specificially hidrive.strato.com) that use rsync over ssh but do not
pass it through the shell. pass it through the shell.
* dropunused: Allow specifying ranges to drop. * dropunused: Allow specifying ranges to drop.
* addunused: New command, the opposite of dropunused, it relinks unused
content into the git repository.
-- Joey Hess <joeyh@debian.org> Wed, 02 May 2012 13:06:18 -0400 -- Joey Hess <joeyh@debian.org> Wed, 02 May 2012 13:06:18 -0400

View file

@ -235,7 +235,7 @@ subdirectories).
To check for annexed data on a remote, specify --from. 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 Drops the data corresponding to the numbers, as listed by the last
`git annex unused` `git annex unused`
@ -244,6 +244,12 @@ subdirectories).
To drop the data from a remote, specify --from. 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 * merge
Automatically merges remote tracking branches */git-annex into Automatically merges remote tracking branches */git-annex into