aboutsummaryrefslogtreecommitdiff
path: root/UUIDLog.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-10-06 15:23:26 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-10-06 15:23:26 -0400
commit52fa4096480ba74c355dffcddbda766994f4d5b7 (patch)
tree0cfdbda71044115865ad39aea7a2a98b64fbdf78 /UUIDLog.hs
parentdab5bddc64ab4ad479a1104748c15d194e138847 (diff)
add UUIDLog, a generic module for mergable uuid-based logs
Diffstat (limited to 'UUIDLog.hs')
-rw-r--r--UUIDLog.hs110
1 files changed, 110 insertions, 0 deletions
diff --git a/UUIDLog.hs b/UUIDLog.hs
new file mode 100644
index 000000000..d6eb8fbbb
--- /dev/null
+++ b/UUIDLog.hs
@@ -0,0 +1,110 @@
+{- git-annex uuid-based logs
+ -
+ - This is used to store information about a UUID in a way that can
+ - be union merged.
+ -
+ - A line of the log will look like: "UUID[ INFO[ timestamp=foo]]"
+ - The timestamp is last for backwards compatability reasons,
+ - and may not be present on old log lines.
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module UUIDLog (
+ Log,
+ LogEntry(..),
+ parseLog,
+ showLog,
+ changeLog,
+ addLog,
+ simpleMap,
+
+ prop_TimeStamp_sane,
+ prop_addLog_sane,
+) where
+
+import qualified Data.Map as M
+import Data.Time.Clock.POSIX
+import Data.Time
+import System.Locale
+
+import Common
+import Types.UUID
+
+data TimeStamp = Unknown | Date POSIXTime
+ deriving (Eq, Ord, Show)
+
+data LogEntry a = LogEntry
+ { changed :: TimeStamp
+ , value :: a
+ } deriving (Eq, Show)
+
+type Log a = M.Map UUID (LogEntry a)
+
+tskey :: String
+tskey = "timestamp="
+
+showLog :: (a -> String) -> Log a -> String
+showLog shower = unlines . map showpair . M.toList
+ where
+ showpair (k, LogEntry (Date p) v) =
+ unwords [k, shower v, tskey ++ show p]
+ showpair (k, LogEntry Unknown v) =
+ unwords [k, shower v]
+
+parseLog :: (String -> Maybe a) -> String -> Log a
+parseLog parser = M.fromListWith best . catMaybes . map pair . lines
+ where
+ pair line
+ | null ws = Nothing
+ | otherwise = case parser $ unwords info of
+ Nothing -> Nothing
+ Just v -> Just (u, LogEntry c v)
+ where
+ ws = words line
+ u = head ws
+ end = last ws
+ c
+ | tskey `isPrefixOf` end =
+ pdate $ tail $ dropWhile (/= '=') end
+ | otherwise = Unknown
+ info
+ | c == Unknown = drop 1 ws
+ | otherwise = drop 1 $ init ws
+ pdate s = case parseTime defaultTimeLocale "%s%Qs" s of
+ Nothing -> Unknown
+ Just d -> Date $ utcTimeToPOSIXSeconds d
+
+changeLog :: POSIXTime -> UUID -> a -> Log a -> Log a
+changeLog t u v = M.insert u $ LogEntry (Date t) v
+
+{- Only add an LogEntry if it's newer (or at least as new as) than any
+ - existing LogEntry for a UUID. -}
+addLog :: UUID -> LogEntry a -> Log a -> Log a
+addLog = M.insertWith best
+
+{- Converts a Log into a simple Map without the timestamp information.
+ - This is a one-way trip, but useful for code that never needs to change
+ - the log. -}
+simpleMap :: Log a -> M.Map UUID a
+simpleMap = M.map value
+
+best :: LogEntry a -> LogEntry a -> LogEntry a
+best new old
+ | changed old > changed new = old
+ | otherwise = new
+
+-- Unknown is oldest.
+prop_TimeStamp_sane :: Bool
+prop_TimeStamp_sane = Unknown < Date 1
+
+prop_addLog_sane :: Bool
+prop_addLog_sane = newWins && newestWins
+ where
+ newWins = addLog "foo" (LogEntry (Date 1) "new") l == l2
+ newestWins = addLog "foo" (LogEntry (Date 1) "newest") l2 /= l2
+
+ l = M.fromList [("foo", LogEntry (Date 0) "old")]
+ l2 = M.fromList [("foo", LogEntry (Date 1) "new")]