understand adjusted view branch names
An adjusted view branch has a name like "refs/heads/adjusted/views/master(author=_)(unlocked)", so it is a view branch that has been converted to an adjusted branch. Made Logs.View support such branch names. So now git-annex sync and pre-commit handle updating metadata on commit in such a branch. Much remains to be done to fully support adjusted view branches, including actually applying the adjustment when updating the view branch. Sponsored-by: Graham Spencer on Patreon
This commit is contained in:
parent
2a966f49f2
commit
cc32e31161
9 changed files with 113 additions and 79 deletions
70
Logs/View.hs
70
Logs/View.hs
|
@ -19,12 +19,15 @@ module Logs.View (
|
|||
branchView,
|
||||
fromViewBranch,
|
||||
is_branchView,
|
||||
branchViewPrefix,
|
||||
prop_branchView_legal,
|
||||
) where
|
||||
|
||||
import Annex.Common
|
||||
import Types.View
|
||||
import Types.MetaData
|
||||
import Types.AdjustedBranch
|
||||
import Annex.AdjustedBranch.Name
|
||||
import qualified Git
|
||||
import qualified Git.Branch
|
||||
import qualified Git.Ref
|
||||
|
@ -54,31 +57,49 @@ recentViews = do
|
|||
f <- fromRawFilePath <$> fromRepo gitAnnexViewLog
|
||||
liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFile f)
|
||||
|
||||
{- Gets the currently checked out view, if there is one. -}
|
||||
currentView :: Annex (Maybe View)
|
||||
{- Gets the currently checked out view, if there is one.
|
||||
-
|
||||
- The view may also have an adjustment applied to it.
|
||||
-}
|
||||
currentView :: Annex (Maybe (View, Maybe Adjustment))
|
||||
currentView = go =<< inRepo Git.Branch.current
|
||||
where
|
||||
go (Just b) | branchViewPrefix `B.isPrefixOf` fromRef' b =
|
||||
headMaybe . filter (\v -> branchView v == b || branchViewOld v == b)
|
||||
<$> recentViews
|
||||
go _ = return Nothing
|
||||
go (Just b) = case adjustedToOriginal b of
|
||||
Nothing -> getvb b Nothing
|
||||
Just (adj, b') -> getvb b' (Just adj)
|
||||
go Nothing = return Nothing
|
||||
|
||||
getvb b madj
|
||||
| branchViewPrefix `B.isPrefixOf` fromRef' b = do
|
||||
vb <- headMaybe
|
||||
. filter (\v -> branchView v Nothing == b || branchViewOld v == b)
|
||||
<$> recentViews
|
||||
case vb of
|
||||
Just vb' -> return (Just (vb', madj))
|
||||
Nothing -> return Nothing
|
||||
| otherwise = return Nothing
|
||||
|
||||
{- Note that this is not the prefix used when an adjustment is applied to a
|
||||
- view branch. -}
|
||||
branchViewPrefix :: B.ByteString
|
||||
branchViewPrefix = "refs/heads/views"
|
||||
|
||||
{- Generates a git branch name for a View.
|
||||
{- Generates a git branch name for a View, which may also have an
|
||||
- adjustment applied to it.
|
||||
-
|
||||
- There is no guarantee that each view gets a unique branch name,
|
||||
- but the branch name is used to express the view as well as possible
|
||||
- given the constraints on git branch names. It includes the name of the
|
||||
- parent branch, and what metadata is used.
|
||||
-}
|
||||
branchView :: View -> Git.Branch
|
||||
branchView view = Git.Ref $
|
||||
branchViewPrefix <> "/" <> basebranch
|
||||
<> "(" <> branchViewDesc view False <> ")"
|
||||
branchView :: View -> Maybe Adjustment -> Git.Branch
|
||||
branchView view madj = case madj of
|
||||
Nothing -> vb
|
||||
Just adj -> adjBranch $ originalToAdjusted vb adj
|
||||
where
|
||||
basebranch = fromRef' (Git.Ref.base (viewParentBranch view))
|
||||
vb = Git.Ref $ branchViewPrefix <> "/" <> basebranch
|
||||
<> "(" <> branchViewDesc view False <> ")"
|
||||
|
||||
{- Old name used for a view did not include the name of the parent branch. -}
|
||||
branchViewOld :: View -> Git.Branch
|
||||
|
@ -109,22 +130,31 @@ branchViewDesc view pareninvisibles = encodeBS $
|
|||
| otherwise = map (\c -> if isAlphaNum c then c else '_') s
|
||||
|
||||
is_branchView :: Git.Branch -> Bool
|
||||
is_branchView (Ref b) = (branchViewPrefix <> "/") `B.isPrefixOf` b
|
||||
is_branchView b = case adjustedToOriginal b of
|
||||
Nothing -> hasprefix b
|
||||
Just (_adj, b') -> hasprefix b'
|
||||
where
|
||||
hasprefix (Ref b') = (branchViewPrefix <> "/") `B.isPrefixOf` b'
|
||||
|
||||
{- Converts a view branch as generated by branchView (but not by
|
||||
- branchViewOld) back to the parent branch.
|
||||
- Has no effect on other branches. -}
|
||||
fromViewBranch :: Git.Branch -> Git.Branch
|
||||
fromViewBranch b =
|
||||
let bs = fromRef' b
|
||||
in if (branchViewPrefix <> "/") `B.isPrefixOf` bs
|
||||
then
|
||||
let (branch, _desc) = separate' (== openparen) (B.drop prefixlen bs)
|
||||
in Ref branch
|
||||
else b
|
||||
fromViewBranch b = case adjustedToOriginal b of
|
||||
Nothing -> go b
|
||||
Just (_adj, b') -> go b'
|
||||
where
|
||||
go b' =
|
||||
let bs = fromRef' b'
|
||||
in if (branchViewPrefix <> "/") `B.isPrefixOf` bs
|
||||
then
|
||||
let (branch, _desc) = separate' (== openparen) (B.drop prefixlen bs)
|
||||
in Ref branch
|
||||
else b'
|
||||
|
||||
prefixlen = B.length branchViewPrefix + 1
|
||||
openparen = fromIntegral (ord '(')
|
||||
|
||||
prop_branchView_legal :: View -> Bool
|
||||
prop_branchView_legal = Git.Ref.legal False . fromRef . branchView
|
||||
prop_branchView_legal = Git.Ref.legal False
|
||||
. fromRef . (\v -> branchView v Nothing)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue