log compaction

LocationLog.hs

@@ -7,21 +7,19 @@
  -
  - Location tracking information is stored in `.git-annex/filename.log`.
  - Repositories record their name and the date when they --get or --drop
- - a file's content. (Git is configured to use a union merge for this file,
+ - a file's content.
- - so the lines may be in arbitrary order, but it will never conflict.)
  -
  - A line of the log will look like: "date N reponame"
  - Where N=1 when the repo has the file, and 0 otherwise.
  - 
- - TOOD: compact logs, by storing only current presence infomation when
+ - Git is configured to use a union merge for this file,
- - writing them.
+ - so the lines may be in arbitrary order, but it will never conflict.
- -
- - TODO: use ByteString
  -}
 
 module LocationLog where
 
 import Data.DateTime
+import qualified Data.Map as Map
 import System.IO
 import System.Directory
 import Data.Char
@@ -81,12 +79,19 @@ readLog file = do
 			return []
 
 {- Adds a LogLine to a log file -}
-writeLog :: String -> LogLine -> IO ()
+appendLog :: String -> LogLine -> IO ()
-writeLog file line = do
+appendLog file line = do
 	createDirectoryIfMissing True (parentDir file)
 	withFileLocked file AppendMode $ \h ->
 		hPutStrLn h $ show line
 
+{- Writes a set of lines to a log file -}
+writeLog :: String -> [LogLine] -> IO ()
+writeLog file lines = do
+	createDirectoryIfMissing True (parentDir file)
+	withFileLocked file WriteMode $ \h ->
+		hPutStr h $ unlines $ map show lines
+
 {- Generates a new LogLine with the current date. -}
 logNow :: LogStatus -> String -> IO LogLine
 logNow status repo = do
@@ -112,3 +117,24 @@ fileLocations file = do
  - is (or should still be) present. -}
 filterPresent :: [LogLine] -> [LogLine]
 filterPresent lines = error "unimplimented" -- TODO
+
+{- Compacts a set of logs, returning a subset that contains the current
+ - status. -}
+compactLog :: [LogLine] -> [LogLine]
+compactLog lines = compactLog' Map.empty lines
+compactLog' map [] = Map.elems map
+compactLog' map (l:ls) = compactLog' (mapLog map l) ls
+
+{- Inserts a log into a map of logs, if the log has better (ie, newer)
+ - information about a repo than the other logs in the map -}
+mapLog map log = 
+	if (better)
+		then Map.insert (repo log) log map
+		else map
+	where
+		better = case (Map.lookup (repo log) map) of
+			-- <= used because two log entries could
+			-- have the same timestamp; if so the one that
+			-- is seen last should win.
+			Just l -> (date l <= date log)
+			Nothing -> True

demo.log

@@ -1,8 +1,11 @@
 1286654242 1 repo
 1286652724 0 foo
+1286656282 1 foo
+1286656282 0 repo
+1286656281 0 foo
+# some garbage, should be ignored
 a a a
+
 a 1 a
 -1 a a
 1286652724 1 foo
-1286656282 1 foo
-1286656282 0 repo

git-annex.hs

@@ -7,4 +7,4 @@ import GitRepo
 main = do
 	gitPrep
 	l <- readLog "demo.log"
-	writeLog "demo2.log" $ l !! 0
+	writeLog "demo2.log" $ compactLog l