From 47ca7c9e8658c1bdbd9e9519581935b1da3ee538 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Fri, 20 Dec 2024 19:05:05 +0100
Subject: add =~ comparison

---
 astore.cabal              |  1 +
 default.nix               |  1 +
 src/Store/Query.hs        |  5 +++++
 src/Store/Query/Parser.hs | 39 ++++++++++++++++++++++++++++++++++-----
 src/Store/Query/Type.hs   |  5 +++++
 5 files changed, 46 insertions(+), 5 deletions(-)

diff --git a/astore.cabal b/astore.cabal
index 601192f..eeb8189 100644
--- a/astore.cabal
+++ b/astore.cabal
@@ -45,6 +45,7 @@ library
         megaparsec,
         mtl,
         parser-combinators,
+        regex-pcre,
         resourcet,
         tagged,
         text,
diff --git a/default.nix b/default.nix
index 6bd2d86..b123f31 100644
--- a/default.nix
+++ b/default.nix
@@ -13,6 +13,7 @@ rec {
     buildInputs = [
       haskellPackages.cabal-install
       haskellPackages.ormolu
+      pkgs.pkg-config
     ];
     withHoogle = true;
     withHaddock = true;
diff --git a/src/Store/Query.hs b/src/Store/Query.hs
index 4c0f829..8520d0b 100644
--- a/src/Store/Query.hs
+++ b/src/Store/Query.hs
@@ -24,6 +24,7 @@ import Store.Query.Record
 import Store.Query.Type
 import Store.Store qualified as S
 import System.FilePath ((</>))
+import Text.Regex.PCRE
 
 data Paginated = Paginated
   { count :: Int,
@@ -194,6 +195,10 @@ satisfies Nothing _ = True
 satisfies (Just (And ws)) vs = all (\w -> satisfies (Just w) vs) ws
 satisfies (Just (Or ws)) vs = any (\w -> satisfies (Just w) vs) ws
 satisfies (Just (Where (Eq f g))) vs = either Just (flip lookups vs) f == either Just (flip lookups vs) g
+satisfies (Just (Where (Regex f p))) vs =
+  case either Just (flip lookups vs) f of
+    Just (J.String s) -> p `matchTest` T.unpack s
+    _ -> False
 
 decodeFile :: String -> String -> S.StoreM J.Value
 decodeFile c fn = do
diff --git a/src/Store/Query/Parser.hs b/src/Store/Query/Parser.hs
index 5b7bc1b..ce2a4dd 100644
--- a/src/Store/Query/Parser.hs
+++ b/src/Store/Query/Parser.hs
@@ -15,9 +15,11 @@ import Data.Vector qualified as V
 import Data.Void (Void)
 import Store.Exception (ParseError (ParseError))
 import Store.Query.Type
+import System.IO.Unsafe (unsafePerformIO)
 import Text.Megaparsec qualified as P
 import Text.Megaparsec.Char qualified as P
 import Text.Megaparsec.Char.Lexer qualified as P
+import Text.Regex.PCRE.String
 
 instance IsString Query where
   fromString =
@@ -82,6 +84,7 @@ instance IsString Query where
       comma = void $ lexeme (P.string ",")
       embed = void $ lexeme (P.string "EMBED")
       eq = void $ lexeme (P.string "==")
+      match = void $ lexeme (P.string "=~")
       from = void $ lexeme (P.string "FROM")
       on = void $ lexeme (P.string "ON")
       or = void $ lexeme (P.string "OR")
@@ -119,11 +122,22 @@ instance IsString Query where
             Where <$> comparison
           ]
 
-      comparison = do
-        a <- P.choice [Left <$> value, Right <$> field]
-        eq
-        b <- P.choice [Left <$> value, Right <$> field]
-        pure $ Eq a b
+      comparison =
+        P.choice
+          ( map
+              P.try
+              [ do
+                  a <- P.choice [Left <$> value, Right <$> field]
+                  eq
+                  b <- P.choice [Left <$> value, Right <$> field]
+                  pure $ Eq a b,
+                do
+                  a <- P.choice [Left <$> value, Right <$> field]
+                  match
+                  b <- regex
+                  pure $ Regex a b
+              ]
+          )
 
       offsetClause = do
         offset_
@@ -244,6 +258,21 @@ instance IsString Query where
       fieldPart :: P.Parsec Void String String
       fieldPart = P.takeWhile1P Nothing (\c -> not (isSpace c) && c /= ',' && c /= '.')
 
+      regex = lexeme do
+        ( unsafePerformIO . compile compBlank execBlank
+            <$> between (Just (P.string "\\")) (P.string "/") (P.string "/")
+          )
+          >>= either (\e -> error ("regex failed to compile: " <> show e)) pure
+
+      between (Just e) start end = start >> go
+        where
+          go =
+            P.choice
+              [ e >> (:) <$> P.anySingle <*> go,
+                P.try ((const "") <$> end),
+                (:) <$> P.anySingle <*> go
+              ]
+
       joinType :: P.Parsec Void String JoinType
       joinType =
         P.choice
diff --git a/src/Store/Query/Type.hs b/src/Store/Query/Type.hs
index 2f1f5ec..b431f6c 100644
--- a/src/Store/Query/Type.hs
+++ b/src/Store/Query/Type.hs
@@ -20,6 +20,7 @@ import Data.Aeson qualified as J
 import Data.Map qualified as M
 import Store.Query.Field
 import Store.Query.Record
+import Text.Regex.PCRE
 
 data Query
   = Delete Collection (Maybe WhereClause)
@@ -67,8 +68,12 @@ data WhereClause
 
 data Comparison
   = Eq (Either J.Value Field) (Either J.Value Field)
+  | Regex (Either J.Value Field) Regex
   deriving (Show)
 
+instance Show Regex where
+  show _ = "<REGEX>"
+
 data LimitClause = Limit Int
   deriving (Show)
 
-- 
cgit v1.2.3