aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorLibravatar Alexander Foremny <aforemny@posteo.de>2023-10-17 10:01:23 +0200
committerLibravatar Alexander Foremny <aforemny@posteo.de>2023-10-17 10:15:27 +0200
commitda12170e694872fd91f81a27748eed07dc3f75cc (patch)
treedb17e301360b83327ac47881cb81d409bcfef46b
parentbb88dbe078a0f16c0626a2825fd9f4d6bc775875 (diff)
add filter operators
The following filter expressions are now additionally valid: ``` --filter @tag <=VALUE --filter @tag <VALUE --filter @tag >=VALUE --filter @tag >VALUE ``` Note that negation needs some re-work. Currently, only `--filter !@tag <VALUE` is valid, and `--filter @tag !<VALUE` is not. The first version may not behave as you would expect it. A tracking issue has been created. Note that without typing tag values, all comparisons perform lexicographically on `String`s.
-rw-r--r--anissue.cabal1
-rw-r--r--app/Issue/Filter.hs100
-rw-r--r--app/Issue/Tag.hs15
-rw-r--r--app/Main.hs9
4 files changed, 95 insertions, 30 deletions
diff --git a/anissue.cabal b/anissue.cabal
index 7157c4e..8988ebf 100644
--- a/anissue.cabal
+++ b/anissue.cabal
@@ -86,6 +86,7 @@ executable anissue
-- Other library packages from which modules are imported.
build-depends: base ^>=4.16.4.0,
aeson,
+ attoparsec,
binary,
bytestring,
directory,
diff --git a/app/Issue/Filter.hs b/app/Issue/Filter.hs
index fb6d205..efcf88c 100644
--- a/app/Issue/Filter.hs
+++ b/app/Issue/Filter.hs
@@ -5,46 +5,99 @@ module Issue.Filter
)
where
-import Control.Applicative (liftA2)
-import Control.Arrow (second)
+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 (Tag (..))
+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 Text)
+ = 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.maybeReader (parse . T.pack))
+ (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"
)
)
- where
- parse s
- | "@" `T.isPrefixOf` s =
- Just (Filter Include (uncurry ByTag (splitValue (T.drop 1 s))))
- | "!@" `T.isPrefixOf` s =
- Just (Filter Exclude (uncurry ByTag (splitValue (T.drop 2 s))))
- | otherwise = Nothing
-
- splitValue :: Text -> (Text, Maybe Text)
- splitValue s = case second T.strip (T.breakOn " " s) of
- (k, "") -> (k, Nothing)
- (k, v) -> (k, Just v)
applyFilters :: [Filter] -> ([Issue] -> [Issue])
applyFilters fs = filter (filtersPredicate fs)
@@ -61,7 +114,14 @@ modePredicate Include p = p
modePredicate Exclude p = not . p
simpleFilterPredicate :: SimpleFilter -> (Issue -> Bool)
-simpleFilterPredicate (ByTag k v) i = any ((&&) <$> matchKey <*> matchValue) i.tags
+simpleFilterPredicate (ByTag k v) i = any ((&&) <$> matchKey <*> matchValue) (i.tags ++ i.internalTags)
where
- matchKey (Tag k' _) = k' == k
- matchValue (Tag _ v') = fromMaybe True ((==) <$> v' <*> v)
+ 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
diff --git a/app/Issue/Tag.hs b/app/Issue/Tag.hs
index 8b6d6d4..85636b5 100644
--- a/app/Issue/Tag.hs
+++ b/app/Issue/Tag.hs
@@ -1,4 +1,11 @@
-module Issue.Tag (Tag (..), extractTags, internalTags) where
+module Issue.Tag
+ ( Tag (..),
+ extractTags,
+ internalTags,
+ tagKey,
+ tagValue,
+ )
+where
import Data.Binary (Binary)
import Data.Maybe (catMaybes)
@@ -10,6 +17,12 @@ import Issue.Provenance (Provenance (..))
data Tag = Tag Text (Maybe Text) deriving (Show, Generic, Binary)
+tagKey :: Tag -> Text
+tagKey (Tag k _) = k
+
+tagValue :: Tag -> Maybe Text
+tagValue (Tag _ v) = v
+
extractTags :: Text -> [Tag]
extractTags =
catMaybes
diff --git a/app/Main.hs b/app/Main.hs
index 59afb73..78b95f2 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -34,15 +34,6 @@
-- Issues having a `@priority` tag whose value is not an integer should be regarded not matching the filter.
-- @topic tags
--- TODO Tag improvements (dates)
---
--- I would like anissue to support due dates when filtering. Let's for a first implementation add the following filter syntax:
---
--- `--filter '@due 2023-10-04'` for all issues that are marked `@due 2023-10-04` or with an earlier `@due` date.
---
--- Issues having a `@due` tag whose value does not follow that date format precisely should be regarded not matching the filter.
--- @topic tags
-
-- TODO Add support for ammendments
--
-- The user can ammend more information to an issue which is located at