blob: 93e408cb3cbc86b99f2b1bd2dae6043ce3155746 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
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.String (IsString (fromString))
import Data.Text qualified as T
import Data.Void (Void)
import Store.Exception (ParseError (ParseError))
import Store.Query.Type
import Text.Megaparsec qualified as P
import Text.Megaparsec.Char qualified as P
import Text.Megaparsec.Char.Lexer qualified as P
instance IsString Query where
fromString =
either (throw . ParseError . P.errorBundlePretty @String @Void) id
. P.parse parser ""
where
parser = do
void $ P.many P.space1
select
fs <- fieldSelector
from
c <- collection
js <- joinClauses
es <- embedClauses
w <- P.optional do
where_
whereClause
P.eof
pure $ Select fs c js es w
lexeme :: P.Parsec Void String a -> P.Parsec Void String a
lexeme = P.lexeme $ void $ P.takeWhileP Nothing isSpace
and = void $ lexeme (P.string "AND")
comma = void $ lexeme (P.string ",")
embed = void $ lexeme (P.string "EMBED")
eq = void $ lexeme (P.string "==")
from = void $ lexeme (P.string "FROM")
on = void $ lexeme (P.string "ON")
or = void $ lexeme (P.string "OR")
select = void $ lexeme (P.string "SELECT")
where_ = void $ lexeme (P.string "WHERE")
collection = lexeme $ P.takeWhile1P (Just "collection") (not . isSpace)
joinClauses = P.many joinClause
joinClause = do
t <- joinType
c <- collection
w <- P.optional do
on
whereClause
pure $ JoinClause t c w
embedClauses = P.many embedClause
embedClause = do
embed
c <- collection
w <- P.optional do
on
whereClause
pure $ EmbedClause c w
whereClause =
P.choice
[ P.try (And . map Where <$> P.sepBy1 comparison and),
P.try (Or . map Where <$> P.sepBy1 comparison or),
Where <$> comparison
]
comparison = do
a <- field
eq
b <- field
pure $ Eq a b
fieldSelector =
P.choice
[ do
void $ lexeme $ P.string "*"
pure All,
do
Only <$> PN.sepBy1 field comma
]
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 "."))
]
fieldPart :: P.Parsec Void String String
fieldPart = P.takeWhile1P Nothing (\c -> not (isSpace c) && c /= ',' && c /= '.')
joinType :: P.Parsec Void String JoinType
joinType =
P.choice
[ do
void $ lexeme (P.string "LEFT")
void $ lexeme (P.string "JOIN")
pure JoinLeft,
do
void $ lexeme (P.string "RIGHT")
void $ lexeme (P.string "JOIN")
pure JoinRight,
do
void $ lexeme (P.string "FULL")
void $ lexeme (P.string "JOIN")
pure JoinFull
]
|
