diff options
Diffstat (limited to 'Logs')
-rw-r--r-- | Logs/Activity.hs | 6 | ||||
-rw-r--r-- | Logs/Chunk.hs | 5 | ||||
-rw-r--r-- | Logs/Config.hs | 5 | ||||
-rw-r--r-- | Logs/Difference.hs | 5 | ||||
-rw-r--r-- | Logs/Group.hs | 5 | ||||
-rw-r--r-- | Logs/Location.hs | 6 | ||||
-rw-r--r-- | Logs/MapLog.hs | 39 | ||||
-rw-r--r-- | Logs/MetaData.hs | 17 | ||||
-rw-r--r-- | Logs/Multicast.hs | 6 | ||||
-rw-r--r-- | Logs/PreferredContent/Raw.hs | 13 | ||||
-rw-r--r-- | Logs/Presence.hs | 9 | ||||
-rw-r--r-- | Logs/Presence/Pure.hs | 18 | ||||
-rw-r--r-- | Logs/Remote.hs | 13 | ||||
-rw-r--r-- | Logs/RemoteState.hs | 5 | ||||
-rw-r--r-- | Logs/Schedule.hs | 5 | ||||
-rw-r--r-- | Logs/SingleValue.hs | 12 | ||||
-rw-r--r-- | Logs/Transitions.hs | 14 | ||||
-rw-r--r-- | Logs/Trust/Basic.hs | 6 | ||||
-rw-r--r-- | Logs/UUID.hs | 16 | ||||
-rw-r--r-- | Logs/UUIDBased.hs | 13 |
20 files changed, 104 insertions, 114 deletions
diff --git a/Logs/Activity.hs b/Logs/Activity.hs index 6f5bf0deb..d7474704e 100644 --- a/Logs/Activity.hs +++ b/Logs/Activity.hs @@ -12,8 +12,6 @@ module Logs.Activity ( lastActivities, ) where -import Data.Time.Clock.POSIX - import Annex.Common import qualified Annex.Branch import Logs @@ -24,9 +22,9 @@ data Activity = Fsck recordActivity :: Activity -> UUID -> Annex () recordActivity act uuid = do - ts <- liftIO getPOSIXTime + c <- liftIO currentVectorClock Annex.Branch.change activityLog $ - showLog show . changeLog ts uuid act . parseLog readish + showLog show . changeLog c uuid act . parseLog readish lastActivities :: Maybe Activity -> Annex (Log Activity) lastActivities wantact = parseLog onlywanted <$> Annex.Branch.get activityLog diff --git a/Logs/Chunk.hs b/Logs/Chunk.hs index b591a2a6d..0a419716b 100644 --- a/Logs/Chunk.hs +++ b/Logs/Chunk.hs @@ -32,14 +32,13 @@ import Logs.Chunk.Pure import qualified Annex import qualified Data.Map as M -import Data.Time.Clock.POSIX chunksStored :: UUID -> Key -> ChunkMethod -> ChunkCount -> Annex () chunksStored u k chunkmethod chunkcount = do - ts <- liftIO getPOSIXTime + c <- liftIO currentVectorClock config <- Annex.getGitConfig Annex.Branch.change (chunkLogFile config k) $ - showLog . changeMapLog ts (u, chunkmethod) chunkcount . parseLog + showLog . changeMapLog c (u, chunkmethod) chunkcount . parseLog chunksRemoved :: UUID -> Key -> ChunkMethod -> Annex () chunksRemoved u k chunkmethod = chunksStored u k chunkmethod 0 diff --git a/Logs/Config.hs b/Logs/Config.hs index b16a64dba..7d1576b27 100644 --- a/Logs/Config.hs +++ b/Logs/Config.hs @@ -19,7 +19,6 @@ import Logs import Logs.MapLog import qualified Annex.Branch -import Data.Time.Clock.POSIX import qualified Data.Map as M type ConfigName = String @@ -33,9 +32,9 @@ setGlobalConfig name new = do setGlobalConfig' :: ConfigName -> ConfigValue -> Annex () setGlobalConfig' name new = do - now <- liftIO getPOSIXTime + c <- liftIO currentVectorClock Annex.Branch.change configLog $ - showMapLog id id . changeMapLog now name new . parseGlobalConfig + showMapLog id id . changeMapLog c name new . parseGlobalConfig unsetGlobalConfig :: ConfigName -> Annex () unsetGlobalConfig name = do diff --git a/Logs/Difference.hs b/Logs/Difference.hs index 9817393e3..e392d3f11 100644 --- a/Logs/Difference.hs +++ b/Logs/Difference.hs @@ -12,7 +12,6 @@ module Logs.Difference ( module Logs.Difference.Pure ) where -import Data.Time.Clock.POSIX import qualified Data.Map as M import Annex.Common @@ -24,9 +23,9 @@ import Logs.Difference.Pure recordDifferences :: Differences -> UUID -> Annex () recordDifferences ds@(Differences {}) uuid = do - ts <- liftIO getPOSIXTime + c <- liftIO currentVectorClock Annex.Branch.change differenceLog $ - showLog id . changeLog ts uuid (showDifferences ds) . parseLog Just + showLog id . changeLog c uuid (showDifferences ds) . parseLog Just recordDifferences UnknownDifferences _ = return () -- Map of UUIDs that have Differences recorded. diff --git a/Logs/Group.hs b/Logs/Group.hs index 7090e7b45..b43062746 100644 --- a/Logs/Group.hs +++ b/Logs/Group.hs @@ -18,7 +18,6 @@ module Logs.Group ( import qualified Data.Map as M import qualified Data.Set as S -import Data.Time.Clock.POSIX import Annex.Common import Logs @@ -36,10 +35,10 @@ lookupGroups u = (fromMaybe S.empty . M.lookup u) . groupsByUUID <$> groupMap groupChange :: UUID -> (S.Set Group -> S.Set Group) -> Annex () groupChange uuid@(UUID _) modifier = do curr <- lookupGroups uuid - ts <- liftIO getPOSIXTime + c <- liftIO currentVectorClock Annex.Branch.change groupLog $ showLog (unwords . S.toList) . - changeLog ts uuid (modifier curr) . + changeLog c uuid (modifier curr) . parseLog (Just . S.fromList . words) -- The changed group invalidates the preferred content cache. diff --git a/Logs/Location.hs b/Logs/Location.hs index 5ead34be6..a94dc9089 100644 --- a/Logs/Location.hs +++ b/Logs/Location.hs @@ -33,6 +33,7 @@ import Logs import Logs.Presence import Annex.UUID import Annex.CatFile +import Annex.VectorClock import Git.Types (RefDate, Ref) import qualified Annex @@ -107,7 +108,10 @@ setDead key = do setDead' :: LogLine -> LogLine setDead' l = l { status = InfoDead - , date = date l + realToFrac (picosecondsToDiffTime 1) + , date = case date l of + VectorClock c -> VectorClock $ + c + realToFrac (picosecondsToDiffTime 1) + Unknown -> Unknown } {- Finds all keys that have location log information. diff --git a/Logs/MapLog.hs b/Logs/MapLog.hs index 097439ac5..7fe9e5782 100644 --- a/Logs/MapLog.hs +++ b/Logs/MapLog.hs @@ -11,20 +11,21 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Logs.MapLog where - -import qualified Data.Map as M -import Data.Time.Clock.POSIX +module Logs.MapLog ( + module Logs.MapLog, + VectorClock, + currentVectorClock, +) where import Common +import Annex.VectorClock import Logs.TimeStamp import Logs.Line -data TimeStamp = Unknown | Date POSIXTime - deriving (Eq, Ord, Show) +import qualified Data.Map as M data LogEntry v = LogEntry - { changed :: TimeStamp + { changed :: VectorClock , value :: v } deriving (Eq, Show) @@ -33,8 +34,8 @@ 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 (VectorClock c) v) = + unwords [show c, fieldshower f, valueshower v] showpair (f, LogEntry Unknown v) = unwords ["0", fieldshower f, valueshower v] @@ -44,14 +45,14 @@ parseMapLog fieldparser valueparser = M.fromListWith best . mapMaybe parse . spl parse line = do let (ts, rest) = splitword line (sf, sv) = splitword rest - date <- Date <$> parsePOSIXTime ts + c <- VectorClock <$> parsePOSIXTime ts f <- fieldparser sf v <- valueparser sv - Just (f, LogEntry date v) + Just (f, LogEntry c 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 +changeMapLog :: Ord f => VectorClock -> f -> v -> MapLog f v -> MapLog f v +changeMapLog c f v = M.insert f $ LogEntry c v {- Only add an LogEntry if it's newer (or at least as new as) than any - existing LogEntry for a field. -} @@ -69,15 +70,11 @@ 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 + newWins = addMapLog ("foo") (LogEntry (VectorClock 1) "new") l == l2 + newestWins = addMapLog ("foo") (LogEntry (VectorClock 1) "newest") l2 /= l2 - l = M.fromList [("foo", LogEntry (Date 0) "old")] - l2 = M.fromList [("foo", LogEntry (Date 1) "new")] + l = M.fromList [("foo", LogEntry (VectorClock 0) "old")] + l2 = M.fromList [("foo", LogEntry (VectorClock 1) "new")] diff --git a/Logs/MetaData.hs b/Logs/MetaData.hs index 52370d2c5..92e396541 100644 --- a/Logs/MetaData.hs +++ b/Logs/MetaData.hs @@ -36,6 +36,7 @@ module Logs.MetaData ( import Annex.Common import Types.MetaData import Annex.MetaData.StandardFields +import Annex.VectorClock import qualified Annex.Branch import qualified Annex import Logs @@ -44,7 +45,6 @@ import Logs.TimeStamp import qualified Data.Set as S import qualified Data.Map as M -import Data.Time.Clock.POSIX instance SingleValueSerializable MetaData where serialize = Types.MetaData.serialize @@ -83,26 +83,29 @@ getCurrentMetaData k = do let MetaData m = value l ts = lastchangedval l in M.map (const ts) m - lastchangedval l = S.singleton $ toMetaValue $ showts $ changed l + lastchangedval l = S.singleton $ toMetaValue $ showts $ + case changed l of + VectorClock t -> t + Unknown -> 0 showts = formatPOSIXTime "%F@%H-%M-%S" {- Adds in some metadata, which can override existing values, or unset - them, but otherwise leaves any existing metadata as-is. -} addMetaData :: Key -> MetaData -> Annex () -addMetaData k metadata = addMetaData' k metadata =<< liftIO getPOSIXTime +addMetaData k metadata = addMetaData' k metadata =<< liftIO currentVectorClock -{- Reusing the same timestamp when making changes to the metadata +{- Reusing the same VectorClock when making changes to the metadata - of multiple keys is a nice optimisation. The same metadata lines - will tend to be generated across the different log files, and so - git will be able to pack the data more efficiently. -} -addMetaData' :: Key -> MetaData -> POSIXTime -> Annex () -addMetaData' k d@(MetaData m) now +addMetaData' :: Key -> MetaData -> VectorClock -> Annex () +addMetaData' k d@(MetaData m) c | d == emptyMetaData = noop | otherwise = do config <- Annex.getGitConfig Annex.Branch.change (metaDataLogFile config k) $ showLog . simplifyLog - . S.insert (LogEntry now metadata) + . S.insert (LogEntry c metadata) . parseLog where metadata = MetaData $ M.filterWithKey (\f _ -> not (isLastChangedField f)) m diff --git a/Logs/Multicast.hs b/Logs/Multicast.hs index 386899fdf..8deb2800b 100644 --- a/Logs/Multicast.hs +++ b/Logs/Multicast.hs @@ -11,8 +11,6 @@ module Logs.Multicast ( knownFingerPrints, ) where -import Data.Time.Clock.POSIX - import Annex.Common import qualified Annex.Branch import Logs @@ -25,9 +23,9 @@ newtype Fingerprint = Fingerprint String recordFingerprint :: Fingerprint -> UUID -> Annex () recordFingerprint fp uuid = do - ts <- liftIO getPOSIXTime + c <- liftIO currentVectorClock Annex.Branch.change multicastLog $ - showLog show . changeLog ts uuid fp . parseLog readish + showLog show . changeLog c uuid fp . parseLog readish knownFingerPrints :: Annex (M.Map UUID Fingerprint) knownFingerPrints = simpleMap . parseLog readish <$> Annex.Branch.get activityLog diff --git a/Logs/PreferredContent/Raw.hs b/Logs/PreferredContent/Raw.hs index e23b09c55..8df5edd43 100644 --- a/Logs/PreferredContent/Raw.hs +++ b/Logs/PreferredContent/Raw.hs @@ -7,9 +7,6 @@ module Logs.PreferredContent.Raw where -import qualified Data.Map as M -import Data.Time.Clock.POSIX - import Annex.Common import qualified Annex.Branch import qualified Annex @@ -19,6 +16,8 @@ import Logs.MapLog import Types.StandardGroups import Types.Group +import qualified Data.Map as M + {- Changes the preferred content configuration of a remote. -} preferredContentSet :: UUID -> PreferredContentExpression -> Annex () preferredContentSet = setLog preferredContentLog @@ -28,10 +27,10 @@ requiredContentSet = setLog requiredContentLog setLog :: FilePath -> UUID -> PreferredContentExpression -> Annex () setLog logfile uuid@(UUID _) val = do - ts <- liftIO getPOSIXTime + c <- liftIO currentVectorClock Annex.Branch.change logfile $ showLog id - . changeLog ts uuid val + . changeLog c uuid val . parseLog Just Annex.changeState $ \s -> s { Annex.preferredcontentmap = Nothing @@ -42,10 +41,10 @@ setLog _ NoUUID _ = error "unknown UUID; cannot modify" {- Changes the preferred content configuration of a group. -} groupPreferredContentSet :: Group -> PreferredContentExpression -> Annex () groupPreferredContentSet g val = do - ts <- liftIO getPOSIXTime + c <- liftIO currentVectorClock Annex.Branch.change groupPreferredContentLog $ showMapLog id id - . changeMapLog ts g val + . changeMapLog c g val . parseMapLog Just Just Annex.changeState $ \s -> s { Annex.preferredcontentmap = Nothing } diff --git a/Logs/Presence.hs b/Logs/Presence.hs index 29b786e5e..382a5a302 100644 --- a/Logs/Presence.hs +++ b/Logs/Presence.hs @@ -22,10 +22,9 @@ module Logs.Presence ( historicalLogInfo, ) where -import Data.Time.Clock.POSIX - import Logs.Presence.Pure as X import Annex.Common +import Annex.VectorClock import qualified Annex.Branch import Git.Types (RefDate) @@ -49,11 +48,11 @@ maybeAddLog file line = Annex.Branch.maybeChange file $ \s -> do readLog :: FilePath -> Annex [LogLine] readLog = parseLog <$$> Annex.Branch.get -{- Generates a new LogLine with the current date. -} +{- Generates a new LogLine with the current time. -} logNow :: LogStatus -> String -> Annex LogLine logNow s i = do - now <- liftIO getPOSIXTime - return $ LogLine now s i + c <- liftIO currentVectorClock + return $ LogLine c s i {- Reads a log and returns only the info that is still in effect. -} currentLogInfo :: FilePath -> Annex [String] diff --git a/Logs/Presence/Pure.hs b/Logs/Presence/Pure.hs index 8abf5e52b..03cbdcdc1 100644 --- a/Logs/Presence/Pure.hs +++ b/Logs/Presence/Pure.hs @@ -7,19 +7,19 @@ module Logs.Presence.Pure where -import Data.Time.Clock.POSIX -import qualified Data.Map as M - import Annex.Common +import Annex.VectorClock import Logs.TimeStamp import Logs.Line import Utility.QuickCheck -data LogLine = LogLine { - date :: POSIXTime, - status :: LogStatus, - info :: String -} deriving (Eq, Show) +import qualified Data.Map as M + +data LogLine = LogLine + { date :: VectorClock + , status :: LogStatus + , info :: String + } deriving (Eq, Show) data LogStatus = InfoPresent | InfoMissing | InfoDead deriving (Eq, Show, Bounded, Enum) @@ -29,7 +29,7 @@ parseLog :: String -> [LogLine] parseLog = mapMaybe parseline . splitLines where parseline l = LogLine - <$> parsePOSIXTime d + <$> (VectorClock <$> parsePOSIXTime d) <*> parseStatus s <*> pure rest where diff --git a/Logs/Remote.hs b/Logs/Remote.hs index 1eb1c41b1..47a339a5f 100644 --- a/Logs/Remote.hs +++ b/Logs/Remote.hs @@ -18,22 +18,21 @@ module Logs.Remote ( prop_parse_show_Config, ) where -import qualified Data.Map as M -import Data.Time.Clock.POSIX -import Data.Char - import Annex.Common import qualified Annex.Branch import Types.Remote import Logs import Logs.UUIDBased +import qualified Data.Map as M +import Data.Char + {- Adds or updates a remote's config in the log. -} configSet :: UUID -> RemoteConfig -> Annex () -configSet u c = do - ts <- liftIO getPOSIXTime +configSet u cfg = do + c <- liftIO currentVectorClock Annex.Branch.change remoteLog $ - showLog showConfig . changeLog ts u c . parseLog parseConfig + showLog showConfig . changeLog c u cfg . parseLog parseConfig {- Map of remotes by uuid containing key/value config maps. -} readRemoteLog :: Annex (M.Map UUID RemoteConfig) diff --git a/Logs/RemoteState.hs b/Logs/RemoteState.hs index ff4979f9c..17d084f78 100644 --- a/Logs/RemoteState.hs +++ b/Logs/RemoteState.hs @@ -17,16 +17,15 @@ import qualified Annex.Branch import qualified Annex import qualified Data.Map as M -import Data.Time.Clock.POSIX type RemoteState = String setRemoteState :: UUID -> Key -> RemoteState -> Annex () setRemoteState u k s = do - ts <- liftIO getPOSIXTime + c <- liftIO currentVectorClock config <- Annex.getGitConfig Annex.Branch.change (remoteStateLogFile config k) $ - showLogNew id . changeLog ts u s . parseLogNew Just + showLogNew id . changeLog c u s . parseLogNew Just getRemoteState :: UUID -> Key -> Annex (Maybe RemoteState) getRemoteState u k = do diff --git a/Logs/Schedule.hs b/Logs/Schedule.hs index 844781d50..aea0df223 100644 --- a/Logs/Schedule.hs +++ b/Logs/Schedule.hs @@ -19,7 +19,6 @@ module Logs.Schedule ( import qualified Data.Map as M import qualified Data.Set as S -import Data.Time.Clock.POSIX import Data.Time.LocalTime import Annex.Common @@ -31,9 +30,9 @@ import Utility.Tmp scheduleSet :: UUID -> [ScheduledActivity] -> Annex () scheduleSet uuid@(UUID _) activities = do - ts <- liftIO getPOSIXTime + c <- liftIO currentVectorClock Annex.Branch.change scheduleLog $ - showLog id . changeLog ts uuid val . parseLog Just + showLog id . changeLog c uuid val . parseLog Just where val = fromScheduledActivities activities scheduleSet NoUUID _ = error "unknown UUID; cannot modify" diff --git a/Logs/SingleValue.hs b/Logs/SingleValue.hs index 201e205eb..24242c83f 100644 --- a/Logs/SingleValue.hs +++ b/Logs/SingleValue.hs @@ -17,16 +17,16 @@ import Annex.Common import qualified Annex.Branch import Logs.TimeStamp import Logs.Line +import Annex.VectorClock import qualified Data.Set as S -import Data.Time.Clock.POSIX class SingleValueSerializable v where serialize :: v -> String deserialize :: String -> Maybe v data LogEntry v = LogEntry - { changed :: POSIXTime + { changed :: VectorClock , value :: v } deriving (Eq, Show, Ord) @@ -42,9 +42,9 @@ parseLog = S.fromList . mapMaybe parse . splitLines where parse line = do let (ts, s) = splitword line - date <- parsePOSIXTime ts + c <- VectorClock <$> parsePOSIXTime ts v <- deserialize s - Just (LogEntry date v) + Just (LogEntry c v) splitword = separate (== ' ') newestValue :: Log v -> Maybe v @@ -60,6 +60,6 @@ getLog = newestValue <$$> readLog setLog :: (SingleValueSerializable v) => FilePath -> v -> Annex () setLog f v = do - now <- liftIO getPOSIXTime - let ent = LogEntry now v + c <- liftIO currentVectorClock + let ent = LogEntry c v Annex.Branch.change f $ \_old -> showLog (S.singleton ent) diff --git a/Logs/Transitions.hs b/Logs/Transitions.hs index 04f9824b1..79acb87dd 100644 --- a/Logs/Transitions.hs +++ b/Logs/Transitions.hs @@ -14,13 +14,13 @@ module Logs.Transitions where -import Data.Time.Clock.POSIX -import qualified Data.Set as S - import Annex.Common +import Annex.VectorClock import Logs.TimeStamp import Logs.Line +import qualified Data.Set as S + transitionsLog :: FilePath transitionsLog = "transitions.log" @@ -30,7 +30,7 @@ data Transition deriving (Show, Ord, Eq, Read) data TransitionLine = TransitionLine - { transitionStarted :: POSIXTime + { transitionStarted :: VectorClock , transition :: Transition } deriving (Show, Ord, Eq) @@ -43,8 +43,8 @@ describeTransition ForgetDeadRemotes = "forget dead remotes" noTransitions :: Transitions noTransitions = S.empty -addTransition :: POSIXTime -> Transition -> Transitions -> Transitions -addTransition ts t = S.insert $ TransitionLine ts t +addTransition :: VectorClock -> Transition -> Transitions -> Transitions +addTransition c t = S.insert $ TransitionLine c t showTransitions :: Transitions -> String showTransitions = unlines . map showTransitionLine . S.elems @@ -67,7 +67,7 @@ showTransitionLine (TransitionLine ts t) = unwords [show t, show ts] parseTransitionLine :: String -> Maybe TransitionLine parseTransitionLine s = TransitionLine - <$> parsePOSIXTime ds + <$> (VectorClock <$> parsePOSIXTime ds) <*> readish ts where ws = words s diff --git a/Logs/Trust/Basic.hs b/Logs/Trust/Basic.hs index da542d472..850fcc95f 100644 --- a/Logs/Trust/Basic.hs +++ b/Logs/Trust/Basic.hs @@ -11,8 +11,6 @@ module Logs.Trust.Basic ( trustMapRaw, ) where -import Data.Time.Clock.POSIX - import Annex.Common import Types.TrustLevel import qualified Annex.Branch @@ -24,10 +22,10 @@ import Logs.Trust.Pure as X {- Changes the trust level for a uuid in the trustLog. -} trustSet :: UUID -> TrustLevel -> Annex () trustSet uuid@(UUID _) level = do - ts <- liftIO getPOSIXTime + c <- liftIO currentVectorClock Annex.Branch.change trustLog $ showLog showTrustLog . - changeLog ts uuid level . + changeLog c uuid level . parseLog (Just . parseTrustLog) Annex.changeState $ \s -> s { Annex.trustmap = Nothing } trustSet NoUUID _ = error "unknown UUID; cannot modify" diff --git a/Logs/UUID.hs b/Logs/UUID.hs index 4c84d10bd..1160dfcda 100644 --- a/Logs/UUID.hs +++ b/Logs/UUID.hs @@ -21,23 +21,23 @@ module Logs.UUID ( uuidMapLoad ) where -import qualified Data.Map as M -import Data.Time.Clock.POSIX - import Types.UUID import Annex.Common +import Annex.VectorClock import qualified Annex import qualified Annex.Branch import Logs import Logs.UUIDBased import qualified Annex.UUID +import qualified Data.Map as M + {- Records a description for a uuid in the log. -} describeUUID :: UUID -> String -> Annex () describeUUID uuid desc = do - ts <- liftIO getPOSIXTime + c <- liftIO currentVectorClock Annex.Branch.change uuidLog $ - showLog id . changeLog ts uuid desc . fixBadUUID . parseLog Just + showLog id . changeLog c uuid desc . fixBadUUID . parseLog Just {- Temporarily here to fix badly formatted uuid logs generated by - versions 3.20111105 and 3.20111025. @@ -52,7 +52,7 @@ fixBadUUID :: Log String -> Log String fixBadUUID = M.fromList . map fixup . M.toList where fixup (k, v) - | isbad = (fixeduuid, LogEntry (Date $ newertime v) fixedvalue) + | isbad = (fixeduuid, LogEntry (newertime v) fixedvalue) | otherwise = (k, v) where kuuid = fromUUID k @@ -63,8 +63,8 @@ fixBadUUID = M.fromList . map fixup . M.toList fixedvalue = unwords $ kuuid: Prelude.init ws -- For the fixed line to take precidence, it should be -- slightly newer, but only slightly. - newertime (LogEntry (Date d) _) = d + minimumPOSIXTimeSlice - newertime (LogEntry Unknown _) = minimumPOSIXTimeSlice + newertime (LogEntry (VectorClock c) _) = VectorClock (c + minimumPOSIXTimeSlice) + newertime (LogEntry Unknown _) = VectorClock minimumPOSIXTimeSlice minimumPOSIXTimeSlice = 0.000001 isuuid s = length s == 36 && length (splitc '-' s) == 5 diff --git a/Logs/UUIDBased.hs b/Logs/UUIDBased.hs index 97ecd1011..fd1cd7c2d 100644 --- a/Logs/UUIDBased.hs +++ b/Logs/UUIDBased.hs @@ -17,7 +17,8 @@ module Logs.UUIDBased ( Log, LogEntry(..), - TimeStamp(..), + VectorClock, + currentVectorClock, parseLog, parseLogNew, parseLogWithUUID, @@ -29,10 +30,10 @@ module Logs.UUIDBased ( ) where import qualified Data.Map as M -import Data.Time.Clock.POSIX import Common import Types.UUID +import Annex.VectorClock import Logs.MapLog import Logs.TimeStamp import Logs.Line @@ -42,8 +43,8 @@ type Log v = MapLog UUID v showLog :: (v -> String) -> Log v -> String showLog shower = unlines . map showpair . M.toList where - showpair (k, LogEntry (Date p) v) = - unwords [fromUUID k, shower v, tskey ++ show p] + showpair (k, LogEntry (VectorClock c) v) = + unwords [fromUUID k, shower v, tskey ++ show c] showpair (k, LogEntry Unknown v) = unwords [fromUUID k, shower v] @@ -75,7 +76,7 @@ parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . splitLines | otherwise = drop 1 $ beginning ws pdate s = case parsePOSIXTime s of Nothing -> Unknown - Just d -> Date d + Just d -> VectorClock d showLogNew :: (v -> String) -> Log v -> String showLogNew = showMapLog fromUUID @@ -83,7 +84,7 @@ showLogNew = showMapLog fromUUID parseLogNew :: (String -> Maybe v) -> String -> Log v parseLogNew = parseMapLog (Just . toUUID) -changeLog :: POSIXTime -> UUID -> v -> Log v -> Log v +changeLog :: VectorClock -> UUID -> v -> Log v -> Log v changeLog = changeMapLog addLog :: UUID -> LogEntry v -> Log v -> Log v |