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
|
module Issue.Filter
( Filter,
filterArg,
applyFilters,
)
where
import Control.Applicative (liftA2, (<|>))
import Data.Attoparsec.Text qualified as A
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Issue (Issue (..))
import Issue.Tag (tagKey, tagValue)
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`.
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 a
= Eq a
| Ge a
| Gt a
| Le a
| Lt a
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 = fromMaybe True . (<*>) (op <$> v) . tagValue
op :: Ord a => Op a -> (a -> Bool)
op (Eq a) = flip (==) a
op (Ge a) = flip (>=) a
op (Gt a) = flip (>) a
op (Le a) = flip (<=) a
op (Lt a) = flip (<) a
|
