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
|
module Issue.Filter
( Filter,
filterArg,
applyFilters,
applyClosed,
applyPath,
)
where
import Control.Applicative (liftA2, (<|>))
import Data.Attoparsec.Text qualified as A
import Data.List (isPrefixOf)
import Data.Text qualified as T
import Issue (Issue (..))
import Issue.Tag (tagKey, tagValue)
import Issue.TypedValue (castDef)
import Options.Applicative qualified as O
import Text.RE.TDFA.Text qualified as R
-- TODO Revise filter negation
--
-- Currently the following syntax in valid:
--
-- ```
-- --filter !@t (*)
-- --filter !@t v
-- --filter !@t <v
-- ```
--
-- It does not do what one might expect.
--
-- Currently the following syntax is invalid[1]:
--
-- ```
-- --filter @t !v
-- --filter @t !<v
-- ```
--
-- I will have to think about what types of negation to support and with what
-- semantics.
--
-- I am leaning towards only being able to use negation on the tag when no
-- operators are used, ie. only allowing (*). Thoughts?
--
-- [1] Not in the sense that it is rejected, but in the sense that the negation
-- is not parsed. It is just the literal value `!<v`.
--
-- @backlog
data Filter = Filter Mode SimpleFilter
data Mode = Include | Exclude
data SimpleFilter
= ByTag T.Text (Maybe Test)
filterParser :: A.Parser Filter
filterParser = Filter <$> modeParser <*> simpleFilterParser
where
modeParser :: A.Parser Mode
modeParser = (const Exclude <$> A.string "!") <|> (pure Include)
simpleFilterParser :: A.Parser SimpleFilter
simpleFilterParser = byTagParser
byTagParser :: A.Parser SimpleFilter
byTagParser =
ByTag
<$> (A.string "@" *> A.takeWhile1 (/= ' ') <* A.skipSpace)
<*> ((Just <$> testParser) <|> pure Nothing)
data Test
= Eq T.Text
| Ge T.Text
| Gt T.Text
| Le T.Text
| Lt T.Text
| Match R.RE
testParser :: A.Parser Test
testParser =
A.choice
[ A.try
( A.string "/"
*> ( Match
<$> ( R.compileRegex . T.unpack . T.concat
=<< O.many
( A.choice
[ A.string "\\" *> A.string "/",
A.string "\\" *> A.string "\\",
T.pack . (: []) <$> A.notChar '/'
]
)
)
)
<* A.string "/"
),
A.try (A.string ">=" *> (Ge . T.pack <$> value)),
A.try (A.string "<=" *> (Le . T.pack <$> value)),
A.try (A.string ">" *> (Gt . T.pack <$> value)),
A.try (A.string "<" *> (Lt . T.pack <$> value)),
(Eq . T.pack <$> A.many1 A.anyChar)
]
where
value = A.many1 A.anyChar
filterArg :: O.Parser [Filter]
filterArg =
O.many
( O.option
(O.eitherReader (A.parseOnly filterParser . T.pack))
( O.long "filter"
<> O.short 'f'
<> O.metavar "FILTER"
<> O.help "Filters selected issues. Examples: @assigned, !@assigned joe"
)
)
applyFilters :: [Filter] -> ([Issue] -> [Issue])
applyFilters fs = filter (filtersPredicate fs)
filtersPredicate :: [Filter] -> (Issue -> Bool)
filtersPredicate [] = \_ -> True
filtersPredicate fs = foldr1 (liftA2 (&&)) (map filterPredicate fs)
filterPredicate :: Filter -> (Issue -> Bool)
filterPredicate (Filter m sf) = modePredicate m (simpleFilterPredicate sf)
modePredicate :: Mode -> (Issue -> Bool) -> (Issue -> Bool)
modePredicate Include p = p
modePredicate Exclude p = not . p
simpleFilterPredicate :: SimpleFilter -> (Issue -> Bool)
simpleFilterPredicate (ByTag k v) i = any ((&&) <$> matchKey <*> matchValue) (i.tags ++ i.internalTags)
where
matchKey = (==) k . tagKey
matchValue t =
case (v, tagValue t) of
(Just (Eq v'), Just w') -> castDef False (==) w' v'
(Just (Ge v'), Just w') -> castDef False (>=) w' v'
(Just (Gt v'), Just w') -> castDef False (>) w' v'
(Just (Le v'), Just w') -> castDef False (<=) w' v'
(Just (Lt v'), Just w') -> castDef False (<) w' v'
(Just (Match p), Just w') -> R.matched (w' R.?=~ p)
(Just _, Nothing) -> False
(Nothing, _) -> True
applyClosed :: Bool -> [Issue] -> [Issue]
applyClosed closed = filter (\issue -> closed || not issue.closed)
applyPath :: [FilePath] -> [Issue] -> [Issue]
applyPath files =
filter
( \issue ->
if null files
then True
else any (`isPrefixOf` issue.file) files
)
|