9b1fe37818
An adjusted view branch has a name like "adjusted/views/master(author=_)(unlocked)" and so the adjustment starts at the last open paren, not the first open paren. Note that git-annex sync still does not do anything useful when run in such a branch, because it does not realize that it is a view branch. This is only groundwork for adjusted view branches. This also fixes adjusted branches when the basis branch name contains parens for some other reason, though that is not common in a git branch name. Sponsored-by: Boyd Stephen Smith Jr. on Patreon
99 lines
3.3 KiB
Haskell
99 lines
3.3 KiB
Haskell
{- adjusted branch names
|
|
-
|
|
- Copyright 2016-2020 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Annex.AdjustedBranch.Name (
|
|
originalToAdjusted,
|
|
adjustedToOriginal,
|
|
AdjBranch(..),
|
|
OrigBranch,
|
|
) where
|
|
|
|
import Types.AdjustedBranch
|
|
import Git
|
|
import qualified Git.Ref
|
|
import Utility.Misc
|
|
|
|
import Control.Applicative
|
|
import Data.Char
|
|
import qualified Data.ByteString as S
|
|
|
|
adjustedBranchPrefix :: S.ByteString
|
|
adjustedBranchPrefix = "refs/heads/adjusted/"
|
|
|
|
class SerializeAdjustment t where
|
|
serializeAdjustment :: t -> S.ByteString
|
|
deserializeAdjustment :: S.ByteString -> Maybe t
|
|
|
|
instance SerializeAdjustment Adjustment where
|
|
serializeAdjustment (LinkAdjustment l) =
|
|
serializeAdjustment l
|
|
serializeAdjustment (PresenceAdjustment p Nothing) =
|
|
serializeAdjustment p
|
|
serializeAdjustment (PresenceAdjustment p (Just l)) =
|
|
serializeAdjustment p <> "-" <> serializeAdjustment l
|
|
serializeAdjustment (LinkPresentAdjustment l) =
|
|
serializeAdjustment l
|
|
deserializeAdjustment s =
|
|
(LinkAdjustment <$> deserializeAdjustment s)
|
|
<|>
|
|
(PresenceAdjustment <$> deserializeAdjustment s1 <*> pure (deserializeAdjustment s2))
|
|
<|>
|
|
(PresenceAdjustment <$> deserializeAdjustment s <*> pure Nothing)
|
|
<|>
|
|
(LinkPresentAdjustment <$> deserializeAdjustment s)
|
|
where
|
|
(s1, s2) = separate' (== (fromIntegral (ord '-'))) s
|
|
|
|
instance SerializeAdjustment LinkAdjustment where
|
|
serializeAdjustment UnlockAdjustment = "unlocked"
|
|
serializeAdjustment LockAdjustment = "locked"
|
|
serializeAdjustment FixAdjustment = "fixed"
|
|
serializeAdjustment UnFixAdjustment = "unfixed"
|
|
deserializeAdjustment "unlocked" = Just UnlockAdjustment
|
|
deserializeAdjustment "locked" = Just LockAdjustment
|
|
deserializeAdjustment "fixed" = Just FixAdjustment
|
|
deserializeAdjustment "unfixed" = Just UnFixAdjustment
|
|
deserializeAdjustment _ = Nothing
|
|
|
|
instance SerializeAdjustment PresenceAdjustment where
|
|
serializeAdjustment HideMissingAdjustment = "hidemissing"
|
|
serializeAdjustment ShowMissingAdjustment = "showmissing"
|
|
deserializeAdjustment "hidemissing" = Just HideMissingAdjustment
|
|
deserializeAdjustment "showmissing" = Just ShowMissingAdjustment
|
|
deserializeAdjustment _ = Nothing
|
|
|
|
instance SerializeAdjustment LinkPresentAdjustment where
|
|
serializeAdjustment UnlockPresentAdjustment = "unlockpresent"
|
|
serializeAdjustment LockPresentAdjustment = "lockpresent"
|
|
deserializeAdjustment "unlockpresent" = Just UnlockPresentAdjustment
|
|
deserializeAdjustment "lockpresent" = Just LockPresentAdjustment
|
|
deserializeAdjustment _ = Nothing
|
|
|
|
newtype AdjBranch = AdjBranch { adjBranch :: Branch }
|
|
|
|
originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch
|
|
originalToAdjusted orig adj = AdjBranch $ Ref $
|
|
adjustedBranchPrefix <> base <> "(" <> serializeAdjustment adj <> ")"
|
|
where
|
|
base = fromRef' (Git.Ref.base orig)
|
|
|
|
type OrigBranch = Branch
|
|
|
|
adjustedToOriginal :: Branch -> Maybe (Adjustment, OrigBranch)
|
|
adjustedToOriginal b
|
|
| adjustedBranchPrefix `S.isPrefixOf` bs = do
|
|
let (base, as) = separateEnd' (== openparen) (S.drop prefixlen bs)
|
|
adj <- deserializeAdjustment (S.takeWhile (/= closeparen) as)
|
|
Just (adj, Git.Ref.branchRef (Ref base))
|
|
| otherwise = Nothing
|
|
where
|
|
bs = fromRef' b
|
|
prefixlen = S.length adjustedBranchPrefix
|
|
openparen = fromIntegral (ord '(')
|
|
closeparen = fromIntegral (ord ')')
|