diff options
| -rw-r--r-- | Logs.hs | 12 | ||||
| -rw-r--r-- | Logs/MapLog.hs | 81 | ||||
| -rw-r--r-- | Logs/UUIDBased.hs | 75 | ||||
| -rw-r--r-- | Test.hs | 6 | ||||
| -rw-r--r-- | doc/internals.mdwn | 9 |
5 files changed, 117 insertions, 66 deletions
@@ -24,7 +24,7 @@ getLogVariety :: FilePath -> Maybe LogVariety getLogVariety f | f `elem` topLevelUUIDBasedLogs = Just UUIDBasedLog | isRemoteStateLog f = Just NewUUIDBasedLog - | isMetaDataLog f || f == numcopiesLog = Just OtherLog + | isMetaDataLog f || f `elem` otherLogs = Just OtherLog | otherwise = PresenceLog <$> firstJust (presenceLogs f) {- All the uuid-based logs stored in the top of the git-annex branch. -} @@ -45,6 +45,13 @@ presenceLogs f = , locationLogFileKey f ] +{- Logs that are neither UUID based nor presence logs. -} +otherLogs :: [FilePath] +otherLogs = + [ numcopiesLog + , groupPreferredContentLog + ] + uuidLog :: FilePath uuidLog = "uuid.log" @@ -63,6 +70,9 @@ groupLog = "group.log" preferredContentLog :: FilePath preferredContentLog = "preferred-content.log" +groupPreferredContentLog :: FilePath +groupPreferredContentLog = "group-preferred-content.log" + scheduleLog :: FilePath scheduleLog = "schedule.log" diff --git a/Logs/MapLog.hs b/Logs/MapLog.hs new file mode 100644 index 000000000..1725ef953 --- /dev/null +++ b/Logs/MapLog.hs @@ -0,0 +1,81 @@ +{- git-annex Map log + - + - This is used to store a Map, in a way that can be union merged. + - + - A line of the log will look like: "timestamp field value" + - + - Copyright 2014 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Logs.MapLog where + +import qualified Data.Map as M +import Data.Time.Clock.POSIX +import Data.Time +import System.Locale + +import Common + +data TimeStamp = Unknown | Date POSIXTime + deriving (Eq, Ord, Show) + +data LogEntry v = LogEntry + { changed :: TimeStamp + , value :: v + } deriving (Eq, Show) + +type MapLog f v = M.Map f (LogEntry v) + +showMapLog :: (f -> String) -> (v -> String) -> MapLog f v -> String +showMapLog fieldshower valueshower = unlines . map showpair . M.toList + where + showpair (f, LogEntry (Date p) v) = + unwords [show p, fieldshower f, valueshower v] + showpair (f, LogEntry Unknown v) = + unwords ["0", fieldshower f, valueshower v] + +parseMapLog :: Ord f => (String -> Maybe f) -> (String -> Maybe v) -> String -> MapLog f v +parseMapLog fieldparser valueparser = M.fromListWith best . mapMaybe parse . lines + where + parse line = do + let (ts, rest) = splitword line + (sf, sv) = splitword rest + date <- Date . utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" ts + f <- fieldparser sf + v <- valueparser sv + Just (f, LogEntry date v) + splitword = separate (== ' ') + +changeMapLog :: Ord f => POSIXTime -> f -> v -> MapLog f v -> MapLog f v +changeMapLog t f v = M.insert f $ LogEntry (Date t) v + +{- Only add an LogEntry if it's newer (or at least as new as) than any + - existing LogEntry for a field. -} +addMapLog :: Ord f => f -> LogEntry v -> MapLog f v -> MapLog f v +addMapLog = M.insertWith' best + +{- Converts a MapLog 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 :: MapLog f v -> M.Map f v +simpleMap = M.map value + +best :: LogEntry v -> LogEntry v -> LogEntry v +best new old + | changed old > changed new = old + | otherwise = new + +-- Unknown is oldest. +prop_TimeStamp_sane :: Bool +prop_TimeStamp_sane = Unknown < Date 1 + +prop_addMapLog_sane :: Bool +prop_addMapLog_sane = newWins && newestWins + where + newWins = addMapLog ("foo") (LogEntry (Date 1) "new") l == l2 + newestWins = addMapLog ("foo") (LogEntry (Date 1) "newest") l2 /= l2 + + l = M.fromList [("foo", LogEntry (Date 0) "old")] + l2 = M.fromList [("foo", LogEntry (Date 1) "new")] diff --git a/Logs/UUIDBased.hs b/Logs/UUIDBased.hs index 430c92d55..b403b6253 100644 --- a/Logs/UUIDBased.hs +++ b/Logs/UUIDBased.hs @@ -26,9 +26,6 @@ module Logs.UUIDBased ( changeLog, addLog, simpleMap, - - prop_TimeStamp_sane, - prop_addLog_sane, ) where import qualified Data.Map as M @@ -38,21 +35,11 @@ import System.Locale import Common import Types.UUID +import Logs.MapLog -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) +type Log v = MapLog UUID v -tskey :: String -tskey = "timestamp=" - -showLog :: (a -> String) -> Log a -> String +showLog :: (v -> String) -> Log v -> String showLog shower = unlines . map showpair . M.toList where showpair (k, LogEntry (Date p) v) = @@ -60,14 +47,6 @@ showLog shower = unlines . map showpair . M.toList showpair (k, LogEntry Unknown v) = unwords [fromUUID k, shower v] -showLogNew :: (a -> String) -> Log a -> String -showLogNew shower = unlines . map showpair . M.toList - where - showpair (k, LogEntry (Date p) v) = - unwords [show p, fromUUID k, shower v] - showpair (k, LogEntry Unknown v) = - unwords ["0", fromUUID k, shower v] - parseLog :: (String -> Maybe a) -> String -> Log a parseLog = parseLogWithUUID . const @@ -98,45 +77,17 @@ parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . lines Nothing -> Unknown Just d -> Date $ utcTimeToPOSIXSeconds d -parseLogNew :: (String -> Maybe a) -> String -> Log a -parseLogNew parser = M.fromListWith best . mapMaybe parse . lines - where - parse line = do - let (ts, rest) = splitword line - (u, v) = splitword rest - date <- Date . utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" ts - val <- parser v - Just (toUUID u, LogEntry date val) - splitword = separate (== ' ') - -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 +showLogNew :: (v -> String) -> Log v -> String +showLogNew = showMapLog fromUUID -{- 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 +parseLogNew :: (String -> Maybe v) -> String -> Log v +parseLogNew = parseMapLog (Just . toUUID) -best :: LogEntry a -> LogEntry a -> LogEntry a -best new old - | changed old > changed new = old - | otherwise = new +changeLog :: POSIXTime -> UUID -> v -> Log v -> Log v +changeLog = changeMapLog --- Unknown is oldest. -prop_TimeStamp_sane :: Bool -prop_TimeStamp_sane = Unknown < Date 1 +addLog :: UUID -> LogEntry v -> Log v -> Log v +addLog = addMapLog -prop_addLog_sane :: Bool -prop_addLog_sane = newWins && newestWins - where - newWins = addLog (UUID "foo") (LogEntry (Date 1) "new") l == l2 - newestWins = addLog (UUID "foo") (LogEntry (Date 1) "newest") l2 /= l2 - - l = M.fromList [(UUID "foo", LogEntry (Date 0) "old")] - l2 = M.fromList [(UUID "foo", LogEntry (Date 1) "new")] +tskey :: String +tskey = "timestamp=" @@ -43,7 +43,7 @@ import qualified Types.Backend import qualified Types.TrustLevel import qualified Types import qualified Logs -import qualified Logs.UUIDBased +import qualified Logs.MapLog import qualified Logs.Trust import qualified Logs.Remote import qualified Logs.Unused @@ -140,8 +140,8 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" , testProperty "prop_cost_sane" Config.Cost.prop_cost_sane , testProperty "prop_matcher_sane" Utility.Matcher.prop_matcher_sane , testProperty "prop_HmacSha1WithCipher_sane" Crypto.prop_HmacSha1WithCipher_sane - , testProperty "prop_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane - , testProperty "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane + , testProperty "prop_TimeStamp_sane" Logs.MapLog.prop_TimeStamp_sane + , testProperty "prop_addMapLog_sane" Logs.MapLog.prop_addMapLog_sane , testProperty "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane , testProperty "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest , testProperty "prop_read_write_transferinfo" Logs.Transfer.prop_read_write_transferinfo diff --git a/doc/internals.mdwn b/doc/internals.mdwn index 4e003d9bc..0c5124d0b 100644 --- a/doc/internals.mdwn +++ b/doc/internals.mdwn @@ -150,6 +150,15 @@ Files matching the expression are preferred to be retained in the repository, while files not matching it are preferred to be stored somewhere else. +## `group-preferred-content.log` + +Contains standard preferred content settings for groups. (Overriding or +supplimenting the ones built into git-annex.) + +The file format is one line per group, staring with a timestamp, then a +space, then the group name followed by a space and then the preferred +content expression. + ## `aaa/bbb/*.log` These log files record [[location_tracking]] information |