diff options
Diffstat (limited to 'app')
-rw-r--r-- | app/Issue/Filter.hs | 74 | ||||
-rw-r--r-- | app/Main.hs | 13 |
2 files changed, 49 insertions, 38 deletions
diff --git a/app/Issue/Filter.hs b/app/Issue/Filter.hs index efcf88c..c30a8e2 100644 --- a/app/Issue/Filter.hs +++ b/app/Issue/Filter.hs @@ -7,12 +7,13 @@ 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 Data.Time.Calendar (Day) import Issue (Issue (..)) import Issue.Tag (tagKey, tagValue) import Options.Applicative qualified as O +import Text.Read (readMaybe) -- TODO Revise filter negation -- @@ -46,7 +47,7 @@ data Filter = Filter Mode SimpleFilter deriving (Show) data Mode = Include | Exclude deriving (Show) data SimpleFilter - = ByTag Text (Maybe (Op Text)) + = ByTag Text (Maybe (Op, Text)) deriving (Show) filterParser :: A.Parser Filter @@ -67,24 +68,25 @@ filterParser = Filter <$> modeParser <*> simpleFilterParser <$> (A.string "@" *> A.takeWhile1 (/= ' ') <* A.skipSpace) <*> ((Just <$> opParser (A.takeWhile1 (/= '\n'))) <|> pure Nothing) - opParser :: A.Parser a -> A.Parser (Op a) + 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 - ] - ) + (,) + <$> ( 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 +data Op + = Eq + | Ge + | Gt + | Le + | Lt deriving (Show) filterArg :: O.Parser [Filter] @@ -117,11 +119,33 @@ 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 + matchValue t = + case (v, tagValue t) of + (Just (o, v'), Just w') -> cast (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 (<) + +data Type a where + Date :: Type Day + Int :: Type Int + String :: Type Text + +cast :: (forall a. Ord a => a -> a -> Bool) -> (Text -> Text -> Bool) +cast eq x y + | Just x' <- castTo Date x, Just y' <- castTo Date y = eq x' y' + | Just _ <- castTo Date x, Nothing <- castTo Date y = False + | Just x' <- castTo Int x, Just y' <- castTo Int y = eq x' y' + | Just _ <- castTo Int x, Nothing <- castTo Int y = False + | otherwise = eq x y + +castTo :: Type a -> Text -> Maybe a +castTo Date = readMaybe . T.unpack +castTo Int = readMaybe . T.unpack +castTo String = Just diff --git a/app/Main.hs b/app/Main.hs index 78b95f2..e8440f7 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -21,19 +21,6 @@ -- I would like to filter `--filter '@assigned *@posteo.de'`. -- @topic tags --- TODO Tag improvements (priorities) --- --- I would like anissue to support priorities when filtering. Let's for a first implementation say that priorities are represented by an integer-values `@priority` tag on an issue. The `--filter` can be extended for filtering integer-valued tags, and the following syntax: --- --- - `--filter '@priority >1'`, `--filter '@priority <1` --- - `--filter '@priority >=1'`, `--filter '@priority <=1` --- --- At some later point, we can configure `high`, `medium`, `low` to mean --- `1,2,3`, `4,5,6`, `7,8,9` respectively. --- --- Issues having a `@priority` tag whose value is not an integer 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 |