summaryrefslogtreecommitdiff
path: root/Logs/Presence
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-08-31 17:38:33 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-08-31 17:51:13 -0400
commit2afb4de6c02a4515f8b1bf6e24a32cbde7eae5a8 (patch)
tree22f667488fe21140622dd235fed81d03c1b747de /Logs/Presence
parent2b83639fac92307deeaa7b1bc75a0c71f35e5b1e (diff)
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.
Diffstat (limited to 'Logs/Presence')
-rw-r--r--Logs/Presence/Pure.hs84
1 files changed, 84 insertions, 0 deletions
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
+