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
|
module Issue.Filter
( Filter,
filterArg,
applyFilters,
)
where
import Control.Applicative (liftA2, (<|>))
import Data.Attoparsec.Text qualified as A
import Data.Text (Text)
import Data.Text qualified as T
import Issue (Issue (..))
import Issue.Tag (tagKey, tagValue)
import Issue.TypedValue (castDef)
import Options.Applicative qualified as O
-- 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 deriving (Show)
data Mode = Include | Exclude deriving (Show)
data SimpleFilter
= ByTag Text (Maybe (Op, Text))
deriving (Show)
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 =
A.choice
[ byTagParser
]
byTagParser :: A.Parser SimpleFilter
byTagParser =
ByTag
<$> (A.string "@" *> A.takeWhile1 (/= ' ') <* A.skipSpace)
<*> ((Just <$> opParser (A.takeWhile1 (/= '\n'))) <|> pure Nothing)
opParser :: A.Parser a -> A.Parser (Op, a)
opParser p =
(,)
<$> ( A.choice
[ A.try (pure Ge <* A.string ">="),
A.try (pure Le <* A.string "<="),
pure Gt <* A.string ">",
pure Lt <* A.string "<",
pure Eq
]
)
<*> p
data Op
= Eq
| Ge
| Gt
| Le
| Lt
deriving (Show)
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 (o, v'), Just w') -> castDef False (op o) v' w'
(Just _, Nothing) -> False
(Nothing, _) -> True
op :: Ord a => Op -> (a -> a -> Bool)
op (Eq) = flip (==)
op (Ge) = flip (>=)
op (Gt) = flip (>)
op (Le) = flip (<=)
op (Lt) = flip (<)
|
