forget --drop-dead: Completely removes mentions of repositories that have been marked as dead from the git-annex branch.

Wrote nice pure transition calculator, and ugly code to stage its results
into the git-annex branch. Also had to split up several Log modules
that Annex.Branch needed to use, but that themselves used Annex.Branch.

The transition calculator is limited to looking at and changing one file at
a time. While this made the implementation relatively easy, it precludes
transitions that do stuff like deleting old url log files for keys that are
being removed because they are no longer present anywhere.

5 files changed, 126 insertions, 118 deletions

diff --git a/Logs/Presence.hs b/Logs/Presence.hs
index ec5cec209..516d59618 100644
--- a/Logs/Presence.hs
+++ b/Logs/Presence.hs
@@ -12,36 +12,18 @@
  -}
 
 module Logs.Presence (
-	LogStatus(..),
-	LogLine(LogLine),
+	module X,
 	addLog,
 	readLog,
-	getLog,
-	parseLog,
-	showLog,
 	logNow,
-	compactLog,
-	currentLog,
-	prop_parse_show_log,
+	currentLog
 ) where
 
 import Data.Time.Clock.POSIX
-import Data.Time
-import System.Locale
-import qualified Data.Map as M
 
+import Logs.Presence.Pure as X
 import Common.Annex
 import qualified Annex.Branch
-import Utility.QuickCheck
-
-data LogLine = LogLine {
-	date :: POSIXTime,
-	status :: LogStatus,
-	info :: String
-} deriving (Eq, Show)
-
-data LogStatus = InfoPresent | InfoMissing
-	deriving (Eq, Show, Bounded, Enum)
 
 addLog :: FilePath -> LogLine -> Annex ()
 addLog file line = Annex.Branch.change file $ \s -> 
@@ -52,29 +34,6 @@ addLog file line = Annex.Branch.change file $ \s ->
 readLog :: FilePath -> Annex [LogLine]
 readLog = parseLog <$$> Annex.Branch.get
 
-{- Parses a log file. Unparseable lines are ignored. -}
-parseLog :: String -> [LogLine]
-parseLog = mapMaybe parseline . lines
-  where
-	parseline l = LogLine
-		<$> (utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" d)
-		<*> parsestatus s
-		<*> pure rest
-	  where
-		(d, pastd) = separate (== ' ') l
-		(s, rest) = separate (== ' ') pastd
-	parsestatus "1" = Just InfoPresent
-	parsestatus "0" = Just InfoMissing
-	parsestatus _ = Nothing
-
-{- Generates a log file. -}
-showLog :: [LogLine] -> String
-showLog = unlines . map genline
-  where
-	genline (LogLine d s i) = unwords [show d, genstatus s, i]
-	genstatus InfoPresent = "1"
-	genstatus InfoMissing = "0"
-
 {- Generates a new LogLine with the current date. -}
 logNow :: LogStatus -> String -> Annex LogLine
 logNow s i = do
@@ -84,39 +43,3 @@ logNow s i = do
 {- Reads a log and returns only the info that is still in effect. -}
 currentLog :: FilePath -> Annex [String]
 currentLog file = map info . filterPresent <$> readLog file
-
-{- Given a log, returns only the info that is are still in effect. -}
-getLog :: String -> [String]
-getLog = map info . filterPresent . parseLog
-
-{- Returns the info from LogLines that are in effect. -}
-filterPresent :: [LogLine] -> [LogLine]
-filterPresent = filter (\l -> InfoPresent == status l) . compactLog
-
-{- Compacts a set of logs, returning a subset that contains the current
- - status. -}
-compactLog :: [LogLine] -> [LogLine]
-compactLog = M.elems . foldr mapLog M.empty
-
-type LogMap = M.Map String LogLine
-
-{- Inserts a log into a map of logs, if the log has better (ie, newer)
- - information than the other logs in the map -}
-mapLog :: LogLine -> LogMap -> LogMap
-mapLog l m
-	| better = M.insert i l m
-	| otherwise = m
-  where
-	better = maybe True newer $ M.lookup i m
-	newer l' = date l' <= date l
-	i = info l
-
-instance Arbitrary LogLine where
-	arbitrary = LogLine
-		<$> arbitrary
-		<*> elements [minBound..maxBound]
-		<*> arbitrary `suchThat` ('\n' `notElem`)
-
-prop_parse_show_log :: [LogLine] -> Bool
-prop_parse_show_log l = parseLog (showLog l) == l
-
diff --git a/Logs/Presence/Pure.hs b/Logs/Presence/Pure.hs
new file mode 100644
index 000000000..ffeb78b26
--- /dev/null
+++ b/Logs/Presence/Pure.hs
@@ -0,0 +1,84 @@
+{- git-annex presence log, pure operations
+ -
+ - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Logs.Presence.Pure where
+
+import Data.Time.Clock.POSIX
+import Data.Time
+import System.Locale
+import qualified Data.Map as M
+
+import Common.Annex
+import Utility.QuickCheck
+
+data LogLine = LogLine {
+	date :: POSIXTime,
+	status :: LogStatus,
+	info :: String
+} deriving (Eq, Show)
+
+data LogStatus = InfoPresent | InfoMissing
+	deriving (Eq, Show, Bounded, Enum)
+
+{- Parses a log file. Unparseable lines are ignored. -}
+parseLog :: String -> [LogLine]
+parseLog = mapMaybe parseline . lines
+  where
+	parseline l = LogLine
+		<$> (utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" d)
+		<*> parsestatus s
+		<*> pure rest
+	  where
+		(d, pastd) = separate (== ' ') l
+		(s, rest) = separate (== ' ') pastd
+	parsestatus "1" = Just InfoPresent
+	parsestatus "0" = Just InfoMissing
+	parsestatus _ = Nothing
+
+{- Generates a log file. -}
+showLog :: [LogLine] -> String
+showLog = unlines . map genline
+  where
+	genline (LogLine d s i) = unwords [show d, genstatus s, i]
+	genstatus InfoPresent = "1"
+	genstatus InfoMissing = "0"
+
+{- Given a log, returns only the info that is are still in effect. -}
+getLog :: String -> [String]
+getLog = map info . filterPresent . parseLog
+
+{- Returns the info from LogLines that are in effect. -}
+filterPresent :: [LogLine] -> [LogLine]
+filterPresent = filter (\l -> InfoPresent == status l) . compactLog
+
+{- Compacts a set of logs, returning a subset that contains the current
+ - status. -}
+compactLog :: [LogLine] -> [LogLine]
+compactLog = M.elems . foldr mapLog M.empty
+
+type LogMap = M.Map String LogLine
+
+{- Inserts a log into a map of logs, if the log has better (ie, newer)
+ - information than the other logs in the map -}
+mapLog :: LogLine -> LogMap -> LogMap
+mapLog l m
+	| better = M.insert i l m
+	| otherwise = m
+  where
+	better = maybe True newer $ M.lookup i m
+	newer l' = date l' <= date l
+	i = info l
+
+instance Arbitrary LogLine where
+	arbitrary = LogLine
+		<$> arbitrary
+		<*> elements [minBound..maxBound]
+		<*> arbitrary `suchThat` ('\n' `notElem`)
+
+prop_parse_show_log :: [LogLine] -> Bool
+prop_parse_show_log l = parseLog (showLog l) == l
+
diff --git a/Logs/Transitions.hs b/Logs/Transitions.hs
index d4b7d5eb3..783ce5090 100644
--- a/Logs/Transitions.hs
+++ b/Logs/Transitions.hs
@@ -7,16 +7,6 @@
  - done that is listed in the remote branch by checking that the local
  - branch contains the same transition, with the same or newer start time.
  -
- - When a remote branch that has had an transition performed on it
- - becomes available for merging into the local git-annex branch,
- - the transition is first performed on the local branch.
- -
- - When merging a remote branch into the local git-annex branch,
- - all transitions that have been performed on the local branch must also
- - have been performed on the remote branch already. (Or it would be
- - possible to perform the transitions on a fixup branch and merge it,
- - but that would be expensive.)
- -
  - Copyright 2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
@@ -86,9 +76,6 @@ parseTransitionLine s = TransitionLine <$> pdate ds <*> readish ts
 combineTransitions :: [Transitions] -> Transitions
 combineTransitions = S.unions
 
-inTransitions :: Transition -> Transitions -> Bool
-inTransitions t = not . S.null . S.filter (\l -> transition l == t)
-
 transitionList :: Transitions -> [Transition]
 transitionList = map transition . S.elems
 
diff --git a/Logs/Trust.hs b/Logs/Trust.hs
index 6c6b33f70..c6f0ad3ab 100644
--- a/Logs/Trust.hs
+++ b/Logs/Trust.hs
@@ -6,6 +6,7 @@
  -}
 
 module Logs.Trust (
+	module X,
 	trustLog,
 	TrustLevel(..),
 	trustGet,
@@ -16,8 +17,6 @@ module Logs.Trust (
 	lookupTrust,
 	trustMapLoad,
 	trustMapRaw,
-	
-	prop_parse_show_TrustLog,
 ) where
 
 import qualified Data.Map as M
@@ -31,6 +30,7 @@ import Logs
 import Logs.UUIDBased
 import Remote.List
 import qualified Types.Remote
+import Logs.Trust.Pure as X
 
 {- Returns a list of UUIDs that the trustLog indicates have the
  - specified trust level.
@@ -94,26 +94,4 @@ trustMapLoad = do
 {- Does not include forcetrust or git config values, just those from the
  - log file. -}
 trustMapRaw :: Annex TrustMap
-trustMapRaw = simpleMap . parseLog (Just . parseTrustLog)
-	<$> Annex.Branch.get trustLog
-
-{- The trust.log used to only list trusted repos, without a field for the
- - trust status, which is why this defaults to Trusted. -}
-parseTrustLog :: String -> TrustLevel
-parseTrustLog s = maybe Trusted parse $ headMaybe $ words s
-  where
-	parse "1" = Trusted
-	parse "0" = UnTrusted
-	parse "X" = DeadTrusted
-	parse _ = SemiTrusted
-
-showTrustLog :: TrustLevel -> String
-showTrustLog Trusted = "1"
-showTrustLog UnTrusted = "0"
-showTrustLog DeadTrusted = "X"
-showTrustLog SemiTrusted = "?"
-
-prop_parse_show_TrustLog :: Bool
-prop_parse_show_TrustLog = all check [minBound .. maxBound]
-  where
-	check l = parseTrustLog (showTrustLog l) == l
+trustMapRaw = calcTrustMap <$> Annex.Branch.get trustLog
diff --git a/Logs/Trust/Pure.hs b/Logs/Trust/Pure.hs
new file mode 100644
index 000000000..11cfbe056
--- /dev/null
+++ b/Logs/Trust/Pure.hs
@@ -0,0 +1,36 @@
+{- git-annex trust log, pure operations
+ -
+ - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Logs.Trust.Pure where
+
+import Common.Annex
+import Types.TrustLevel
+import Logs.UUIDBased
+
+calcTrustMap :: String -> TrustMap
+calcTrustMap = simpleMap . parseLog (Just . parseTrustLog)
+
+{- The trust.log used to only list trusted repos, without a field for the
+ - trust status, which is why this defaults to Trusted. -}
+parseTrustLog :: String -> TrustLevel
+parseTrustLog s = maybe Trusted parse $ headMaybe $ words s
+  where
+	parse "1" = Trusted
+	parse "0" = UnTrusted
+	parse "X" = DeadTrusted
+	parse _ = SemiTrusted
+
+showTrustLog :: TrustLevel -> String
+showTrustLog Trusted = "1"
+showTrustLog UnTrusted = "0"
+showTrustLog DeadTrusted = "X"
+showTrustLog SemiTrusted = "?"
+
+prop_parse_show_TrustLog :: Bool
+prop_parse_show_TrustLog = all check [minBound .. maxBound]
+  where
+	check l = parseTrustLog (showTrustLog l) == l