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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
{- 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,
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
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 <- fromRepo gitAnnexViewLog
liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFileString f)
{- 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) = 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, 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 -> 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
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 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 = 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 . (\v -> branchView v Nothing)
|
