From b24f614f0f6aa8363b12f007a44a5d4bc41ec739 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Tue, 17 Oct 2023 10:59:24 +0200
Subject: make filter type-aware

We interpret the following types:

- ISO8601-formatted strings as dates,
- integer-formatted strings as integers,
- all other strings as strings.

If the filter value matches a format, it is cast into the respective
data type. For comparison-based filtering, the tag's value is then cast
into the same data type and comparison is performed type-aware. If the
tag's value is not castable, we consider it not matching.
---
 app/Issue/Filter.hs | 74 +++++++++++++++++++++++++++++++++++------------------
 1 file changed, 49 insertions(+), 25 deletions(-)

(limited to 'app/Issue/Filter.hs')

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
-- 
cgit v1.2.3