summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Command/AddUnused.hs34
-rw-r--r--Command/DropUnused.hs60
-rw-r--r--Command/Unused.hs10
-rw-r--r--GitAnnex.hs2
-rw-r--r--Logs/Unused.hs91
-rw-r--r--Usage.hs2
-rw-r--r--debian/changelog2
-rw-r--r--doc/git-annex.mdwn8
8 files changed, 145 insertions, 64 deletions
diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs
new file mode 100644
index 000000000..c498216dc
--- /dev/null
+++ b/Command/AddUnused.hs
@@ -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"
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index 9c9513ca9..a94c2873d 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]
-
-{- 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]
- _ -> []
+seek = [withUnusedMaps start]
-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 5bdadcf44..6b319ee72 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 52886c308..0e707b186 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 000000000..7d240cfe3
--- /dev/null
+++ b/Logs/Unused.hs
@@ -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
diff --git a/Usage.hs b/Usage.hs
index b1de930ef..e74c1490d 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 72bce8551..b419b4622 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 <joeyh@debian.org> Wed, 02 May 2012 13:06:18 -0400
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 998e1fa26..5d41f86e9 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