diff options
| -rw-r--r-- | astore.cabal | 1 | ||||
| -rw-r--r-- | default.nix | 1 | ||||
| -rw-r--r-- | src/Store/Query.hs | 5 | ||||
| -rw-r--r-- | src/Store/Query/Parser.hs | 39 | ||||
| -rw-r--r-- | 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) |