aboutsummaryrefslogtreecommitdiffstats
path: root/app
diff options
context:
space:
mode:
authorLibravatar Alexander Foremny <aforemny@posteo.de>2023-12-08 15:17:08 +0100
committerLibravatar Alexander Foremny <aforemny@posteo.de>2023-12-08 15:17:11 +0100
commit4686cd9cdef6c087bd9e92fee5f01d0a559ca357 (patch)
tree0c9f35a52c95c1fdecc3e5e7e9a76a235c7f0138 /app
parent3ceee81182d4f47adc8d3b349b2622027345bd7e (diff)
feat: add filtering tags by (POSIX) regex
Example: ``` anissue list --filter '@title /foo/' ```
Diffstat (limited to 'app')
-rw-r--r--app/Issue/Filter.hs86
-rw-r--r--app/Main.hs8
2 files changed, 47 insertions, 47 deletions
diff --git a/app/Issue/Filter.hs b/app/Issue/Filter.hs
index 68eda87..6d6d608 100644
--- a/app/Issue/Filter.hs
+++ b/app/Issue/Filter.hs
@@ -10,12 +10,12 @@ where
import Control.Applicative (liftA2, (<|>))
import Data.Attoparsec.Text qualified as A
import Data.List (isPrefixOf)
-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
+import Text.RE.TDFA.Text qualified as R
-- TODO Revise filter negation
--
@@ -46,13 +46,12 @@ import Options.Applicative qualified as O
-- is not parsed. It is just the literal value `!<v`.
--
-- @backlog
-data Filter = Filter Mode SimpleFilter deriving (Show)
+data Filter = Filter Mode SimpleFilter
-data Mode = Include | Exclude deriving (Show)
+data Mode = Include | Exclude
data SimpleFilter
- = ByTag Text (Maybe (Op, Text))
- deriving (Show)
+ = ByTag T.Text (Maybe Test)
filterParser :: A.Parser Filter
filterParser = Filter <$> modeParser <*> simpleFilterParser
@@ -61,37 +60,48 @@ filterParser = Filter <$> modeParser <*> simpleFilterParser
modeParser = (const Exclude <$> A.string "!") <|> (pure Include)
simpleFilterParser :: A.Parser SimpleFilter
- simpleFilterParser =
- A.choice
- [ byTagParser
- ]
+ simpleFilterParser = 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)
+ <*> ((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 =
@@ -125,17 +135,15 @@ simpleFilterPredicate (ByTag k v) i = any ((&&) <$> matchKey <*> matchValue) (i.
matchKey = (==) k . tagKey
matchValue t =
case (v, tagValue t) of
- (Just (o, v'), Just w') -> castDef False (op o) v' w'
+ (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
-op :: Ord a => Op -> (a -> a -> Bool)
-op (Eq) = flip (==)
-op (Ge) = flip (>=)
-op (Gt) = flip (>)
-op (Le) = flip (<=)
-op (Lt) = flip (<)
-
applyClosed :: Bool -> [Issue] -> [Issue]
applyClosed closed = filter (\issue -> closed || not issue.closed)
diff --git a/app/Main.hs b/app/Main.hs
index 0154a6c..7c9ce49 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -35,12 +35,6 @@
-- @topic tags
-- @backlog
--- TODO Tag improvements (globbing)
---
--- I would like to filter `--filter '@assigned *@posteo.de'`.
--- @topic tags
--- @backlog
-
-- TODO Add support for ammendments
--
-- The user can ammend more information to an issue which is located at
@@ -412,7 +406,6 @@ data Options = Options
noPager :: Bool,
width :: Maybe Int
}
- deriving (Show)
data Color
= Always
@@ -499,7 +492,6 @@ data Command
edit :: Bool
}
| Tags
- deriving (Show)
cmd :: O.Parser Command
cmd =