a11d6e0baf
* sync: Avoid pushing view branches to remotes. * Changed the name of view branches to include the parent branch. Existing view branches checked out using an old name will still work. It does not seem useful for sync to push view branches around, because the information in a view branch can entirely be derived from other information in git. And sync doesn't push adjusted branches around either. The better view branch names make it more in line with adjusted branch names, but were also needed to make fromViewBranch be able to return the original branch name. Kept the old view branch names still working. But, when those branches exist in a repo, sync will still try to push them as before. Avoiding that would need more complicated and/or expensive changes to sync. Sponsored-By: Boyd Stephen Smith Jr. on Patreon
130 lines
3.9 KiB
Haskell
130 lines
3.9 KiB
Haskell
{- git-annex recent views log
|
|
-
|
|
- The most recently accessed view comes first.
|
|
-
|
|
- This file is stored locally in .git/annex/, not in the git-annex branch.
|
|
-
|
|
- Copyright 2014-2023 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Logs.View (
|
|
currentView,
|
|
setView,
|
|
removeView,
|
|
recentViews,
|
|
branchView,
|
|
fromViewBranch,
|
|
is_branchView,
|
|
prop_branchView_legal,
|
|
) where
|
|
|
|
import Annex.Common
|
|
import Types.View
|
|
import Types.MetaData
|
|
import qualified Git
|
|
import qualified Git.Branch
|
|
import qualified Git.Ref
|
|
import Git.Types
|
|
import Logs.File
|
|
|
|
import qualified Data.Text as T
|
|
import qualified Data.Set as S
|
|
import Data.Char
|
|
import qualified Data.ByteString as B
|
|
|
|
setView :: View -> Annex ()
|
|
setView v = do
|
|
old <- take 99 . filter (/= v) <$> recentViews
|
|
writeViews (v : old)
|
|
|
|
writeViews :: [View] -> Annex ()
|
|
writeViews l = do
|
|
f <- fromRepo gitAnnexViewLog
|
|
writeLogFile f $ unlines $ map show l
|
|
|
|
removeView :: View -> Annex ()
|
|
removeView v = writeViews =<< filter (/= v) <$> recentViews
|
|
|
|
recentViews :: Annex [View]
|
|
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)
|
|
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
|
|
|
|
branchViewPrefix :: B.ByteString
|
|
branchViewPrefix = "refs/heads/views"
|
|
|
|
{- Generates a git branch name for a View.
|
|
-
|
|
- 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 <> ")"
|
|
where
|
|
basebranch = fromRef' (Git.Ref.base (viewParentBranch view))
|
|
|
|
{- Old name used for a view did not include the name of the parent branch. -}
|
|
branchViewOld :: View -> Git.Branch
|
|
branchViewOld view = Git.Ref $
|
|
branchViewPrefix <> "/" <> branchViewDesc view True
|
|
|
|
branchViewDesc :: View -> Bool -> B.ByteString
|
|
branchViewDesc view pareninvisibles = encodeBS $
|
|
intercalate ";" $ map branchcomp (viewComponents view)
|
|
where
|
|
branchcomp c
|
|
| viewVisible c || not pareninvisibles = branchcomp' c
|
|
| otherwise = "(" ++ branchcomp' c ++ ")"
|
|
branchcomp' (ViewComponent metafield viewfilter _) = concat
|
|
[ forcelegal (T.unpack (fromMetaField metafield))
|
|
, branchvals viewfilter
|
|
]
|
|
branchvals (FilterValues set) = '=' : branchset set
|
|
branchvals (FilterGlob glob) = '=' : forcelegal glob
|
|
branchvals (ExcludeValues set) = "!=" ++ branchset set
|
|
branchvals (FilterValuesOrUnset set _) = '=' : branchset set
|
|
branchvals (FilterGlobOrUnset glob _) = '=' : forcelegal glob
|
|
branchset = intercalate ","
|
|
. map (forcelegal . decodeBS . fromMetaValue)
|
|
. S.toList
|
|
forcelegal s
|
|
| Git.Ref.legal True s = s
|
|
| otherwise = map (\c -> if isAlphaNum c then c else '_') s
|
|
|
|
is_branchView :: Git.Branch -> Bool
|
|
is_branchView (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
|
|
where
|
|
prefixlen = B.length branchViewPrefix + 1
|
|
openparen = fromIntegral (ord '(')
|
|
|
|
prop_branchView_legal :: View -> Bool
|
|
prop_branchView_legal = Git.Ref.legal False . fromRef . branchView
|