aboutsummaryrefslogtreecommitdiffstats
path: root/src/Store/Query/Parser.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Store/Query/Parser.hs')
-rw-r--r--src/Store/Query/Parser.hs67
1 files changed, 48 insertions, 19 deletions
diff --git a/src/Store/Query/Parser.hs b/src/Store/Query/Parser.hs
index 93e408c..cb02f32 100644
--- a/src/Store/Query/Parser.hs
+++ b/src/Store/Query/Parser.hs
@@ -4,9 +4,8 @@ module Store.Query.Parser () where
import Control.Exception (throw)
import Control.Monad (void)
-import Control.Monad.Combinators.NonEmpty qualified as PN
import Data.Char (isSpace)
-import Data.List.NonEmpty qualified as N
+import Data.Map qualified as M
import Data.String (IsString (fromString))
import Data.Text qualified as T
import Data.Void (Void)
@@ -39,6 +38,7 @@ instance IsString Query where
lexeme = P.lexeme $ void $ P.takeWhileP Nothing isSpace
and = void $ lexeme (P.string "AND")
+ colon = void $ lexeme (P.string ":")
comma = void $ lexeme (P.string ",")
embed = void $ lexeme (P.string "EMBED")
eq = void $ lexeme (P.string "==")
@@ -84,26 +84,55 @@ instance IsString Query where
pure $ Eq a b
fieldSelector =
- P.choice
- [ do
- void $ lexeme $ P.string "*"
- pure All,
- do
- Only <$> PN.sepBy1 field comma
- ]
+ lexeme $
+ P.choice
+ [ do
+ void $ lexeme $ P.string "{"
+ kvs <-
+ P.sepBy
+ ( P.choice
+ [ P.try do
+ k <-
+ lexeme $
+ P.takeWhile1P
+ Nothing
+ ( \c ->
+ not (isSpace c)
+ && c /= '.'
+ && c /= ','
+ && c /= ':'
+ )
+ lexeme $ colon
+ v <- fieldSelector
+ pure (k, v),
+ do
+ f@(Field c ks) <- field
+ let k
+ | null ks = c
+ | otherwise = T.unpack (last ks)
+ pure (k, SelectField f)
+ ]
+ )
+ comma
+ void $ lexeme $ P.string "}"
+ pure $ SelectObject (M.fromList kvs),
+ do
+ SelectField <$> field
+ ]
field :: P.Parsec Void String Field
field =
- lexeme . P.choice $
- [ P.try
- do
- Qualified
- <$> (fieldPart <* P.string ".")
- <*> (N.map T.pack <$> PN.sepBy1 fieldPart (P.string ".")),
- do
- Unqualified
- <$> (N.map T.pack <$> PN.sepBy1 fieldPart (P.string "."))
- ]
+ lexeme do
+ Field
+ <$> fieldPart
+ <*> ( P.choice
+ [ do
+ void $ P.string "."
+ map T.pack <$> P.sepBy fieldPart (P.string "."),
+ do
+ pure []
+ ]
+ )
fieldPart :: P.Parsec Void String String
fieldPart = P.takeWhile1P Nothing (\c -> not (isSpace c) && c /= ',' && c /= '.')