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
|
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
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
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"
|
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
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
|
(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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue