1{- adjusted branch names
2 -
3 - Copyright 2016-2020 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8{-# LANGUAGE OverloadedStrings #-}
9
10module Annex.AdjustedBranch.Name (
11	originalToAdjusted,
12	adjustedToOriginal,
13	AdjBranch(..),
14	OrigBranch,
15) where
16
17import Types.AdjustedBranch
18import Git
19import qualified Git.Ref
20import Utility.Misc
21
22import Control.Applicative
23import Data.Char
24import qualified Data.ByteString as S
25
26adjustedBranchPrefix :: S.ByteString
27adjustedBranchPrefix = "refs/heads/adjusted/"
28
29class SerializeAdjustment t where
30	serializeAdjustment :: t -> S.ByteString
31	deserializeAdjustment :: S.ByteString -> Maybe t
32
33instance SerializeAdjustment Adjustment where
34	serializeAdjustment (LinkAdjustment l) =
35		serializeAdjustment l
36	serializeAdjustment (PresenceAdjustment p Nothing) =
37		serializeAdjustment p
38	serializeAdjustment (PresenceAdjustment p (Just l)) =
39		serializeAdjustment p <> "-" <> serializeAdjustment l
40	serializeAdjustment (LinkPresentAdjustment l) =
41		serializeAdjustment l
42	deserializeAdjustment s =
43		(LinkAdjustment <$> deserializeAdjustment s)
44			<|>
45		(PresenceAdjustment <$> deserializeAdjustment s1 <*> pure (deserializeAdjustment s2))
46			<|>
47		(PresenceAdjustment <$> deserializeAdjustment s <*> pure Nothing)
48			<|>
49		(LinkPresentAdjustment <$> deserializeAdjustment s)
50	  where
51		(s1, s2) = separate' (== (fromIntegral (ord '-'))) s
52
53instance SerializeAdjustment LinkAdjustment where
54	serializeAdjustment UnlockAdjustment = "unlocked"
55	serializeAdjustment LockAdjustment = "locked"
56	serializeAdjustment FixAdjustment = "fixed"
57	serializeAdjustment UnFixAdjustment = "unfixed"
58	deserializeAdjustment "unlocked" = Just UnlockAdjustment
59	deserializeAdjustment "locked" = Just LockAdjustment
60	deserializeAdjustment "fixed" = Just FixAdjustment
61	deserializeAdjustment "unfixed" = Just UnFixAdjustment
62	deserializeAdjustment _ = Nothing
63
64instance SerializeAdjustment PresenceAdjustment where
65	serializeAdjustment HideMissingAdjustment = "hidemissing"
66	serializeAdjustment ShowMissingAdjustment = "showmissing"
67	deserializeAdjustment "hidemissing" = Just HideMissingAdjustment
68	deserializeAdjustment "showmissing" = Just ShowMissingAdjustment
69	deserializeAdjustment _ = Nothing
70
71instance SerializeAdjustment LinkPresentAdjustment where
72	serializeAdjustment UnlockPresentAdjustment = "unlockpresent"
73	serializeAdjustment LockPresentAdjustment = "lockpresent"
74	deserializeAdjustment "unlockpresent" = Just UnlockPresentAdjustment
75	deserializeAdjustment "lockpresent" = Just LockPresentAdjustment
76	deserializeAdjustment _ = Nothing
77
78newtype AdjBranch = AdjBranch { adjBranch :: Branch }
79
80originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch
81originalToAdjusted orig adj = AdjBranch $ Ref $
82	adjustedBranchPrefix <> base <> "(" <> serializeAdjustment adj <> ")"
83  where
84	base = fromRef' (Git.Ref.base orig)
85
86type OrigBranch = Branch
87
88adjustedToOriginal :: Branch -> Maybe (Adjustment, OrigBranch)
89adjustedToOriginal b
90	| adjustedBranchPrefix `S.isPrefixOf` bs = do
91		let (base, as) = separate' (== openparen) (S.drop prefixlen bs)
92		adj <- deserializeAdjustment (S.takeWhile (/= closeparen) as)
93		Just (adj, Git.Ref.branchRef (Ref base))
94	| otherwise = Nothing
95  where
96	bs = fromRef' b
97	prefixlen = S.length adjustedBranchPrefix
98	openparen = fromIntegral (ord '(')
99	closeparen = fromIntegral (ord ')')
100