1{- git-annex presence log
2 -
3 - This is used to store presence information in the git-annex branch in
4 - a way that can be union merged.
5 -
6 - A line of the log will look like: "date N INFO"
7 - Where N=1 when the INFO is present, 0 otherwise.
8 -
9 - Copyright 2010-2021 Joey Hess <id@joeyh.name>
10 -
11 - Licensed under the GNU AGPL version 3 or higher.
12 -}
13
14module Logs.Presence (
15	module X,
16	addLog,
17	addLog',
18	maybeAddLog,
19	readLog,
20	currentLog,
21	currentLogInfo,
22	historicalLogInfo,
23) where
24
25import Logs.Presence.Pure as X
26import Annex.Common
27import Annex.VectorClock
28import qualified Annex.Branch
29import Git.Types (RefDate)
30
31{- Adds to the log, removing any LogLines that are obsoleted. -}
32addLog :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> Annex ()
33addLog ru file logstatus loginfo =
34	addLog' ru file logstatus loginfo =<< currentVectorClock
35
36addLog' :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> CandidateVectorClock -> Annex ()
37addLog' ru file logstatus loginfo c =
38	Annex.Branch.change ru file $ \b ->
39		let old = parseLog b
40		    line = genLine logstatus loginfo c old
41		in buildLog $ compactLog (line : old)
42
43{- When a LogLine already exists with the same status and info, but an
44 - older timestamp, that LogLine is preserved, rather than updating the log
45 - with a newer timestamp.
46 -}
47maybeAddLog :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> Annex ()
48maybeAddLog ru file logstatus loginfo = do
49	c <- currentVectorClock
50	Annex.Branch.maybeChange ru file $ \b ->
51		let old = parseLog b
52		    line = genLine logstatus loginfo c old
53		in do
54			m <- insertNewStatus line $ logMap old
55			return $ buildLog $ mapLog m
56
57genLine :: LogStatus -> LogInfo -> CandidateVectorClock -> [LogLine] -> LogLine
58genLine logstatus loginfo c old = LogLine c' logstatus loginfo
59  where
60	oldcs = map date (filter (\l -> info l == loginfo) old)
61	c' = advanceVectorClock c oldcs
62
63{- Reads a log file.
64 - Note that the LogLines returned may be in any order. -}
65readLog :: RawFilePath -> Annex [LogLine]
66readLog = parseLog <$$> Annex.Branch.get
67
68{- Reads a log and returns only the info that is still in effect. -}
69currentLogInfo :: RawFilePath -> Annex [LogInfo]
70currentLogInfo file = map info <$> currentLog file
71
72currentLog :: RawFilePath -> Annex [LogLine]
73currentLog file = filterPresent <$> readLog file
74
75{- Reads a historical version of a log and returns the info that was in
76 - effect at that time.
77 -
78 - The date is formatted as shown in gitrevisions man page.
79 -}
80historicalLogInfo :: RefDate -> RawFilePath -> Annex [LogInfo]
81historicalLogInfo refdate file = map info . filterPresent . parseLog
82	<$> Annex.Branch.getHistorical refdate file
83