blob: a0019a06c7a1bff76328251df13fa1b34381b00e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
{- git-annex export log
-
- Copyright 2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Logs.Export where
import qualified Data.Map as M
import Annex.Common
import qualified Annex.Branch
import qualified Git
import Logs
import Logs.UUIDBased
import Annex.UUID
-- | Get the treeish that was exported to a special remote.
--
-- If the list contains multiple items, there was an export conflict,
-- and different trees were exported to the same special remote.
getExport :: UUID -> Annex [Git.Ref]
getExport remoteuuid = nub . mapMaybe get . M.elems . simpleMap
. parseLogNew parseExportLog
<$> Annex.Branch.get exportLog
where
get (ExportLog t u)
| u == remoteuuid = Just t
| otherwise = Nothing
data ExportChange = ExportChange
{ oldTreeish :: [Git.Ref]
, newTreeish :: Git.Ref
}
-- | Record a change in what's exported to a special remote.
--
-- Any entries in the log for the oldTreeish will be updated to the
-- newTreeish. This way, when multiple repositories are exporting to
-- the same special remote, there's no conflict as long as they move
-- forward in lock-step.
recordExport :: UUID -> ExportChange -> Annex ()
recordExport remoteuuid ec = do
c <- liftIO currentVectorClock
u <- getUUID
let val = ExportLog (newTreeish ec) remoteuuid
Annex.Branch.change exportLog $
showLogNew formatExportLog
. changeLog c u val
. M.mapWithKey (updateothers c u)
. parseLogNew parseExportLog
where
updateothers c u theiru le@(LogEntry _ (ExportLog t remoteuuid'))
| u == theiru || remoteuuid' /= remoteuuid || t `notElem` oldTreeish ec = le
| otherwise = LogEntry c (ExportLog (newTreeish ec) theiru)
data ExportLog = ExportLog Git.Ref UUID
formatExportLog :: ExportLog -> String
formatExportLog (ExportLog treeish remoteuuid) =
Git.fromRef treeish ++ " " ++ fromUUID remoteuuid
parseExportLog :: String -> Maybe ExportLog
parseExportLog s = case words s of
(t:u:[]) -> Just $ ExportLog (Git.Ref t) (toUUID u)
_ -> Nothing
|
