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
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

View file

@ -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

View file

@ -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

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"
paramNumber :: String
paramNumber = "NUMBER"
paramNumRange :: String
paramNumRange = "NUM|RANGE"
paramRemote :: String
paramRemote = "REMOTE"
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
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 <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.
* 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