addunused: New command, the opposite of dropunused, it relinks unused content into the git repository.
This commit is contained in:
parent
7d6b36dffb
commit
392931eca9
8 changed files with 145 additions and 64 deletions
34
Command/AddUnused.hs
Normal file
34
Command/AddUnused.hs
Normal 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"
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
91
Logs/Unused.hs
Normal 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
|
2
Usage.hs
2
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
|
||||
|
|
2
debian/changelog
vendored
2
debian/changelog
vendored
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue