aboutsummaryrefslogtreecommitdiffstats
path: root/app/Query/Parser.hs
diff options
context:
space:
mode:
Diffstat (limited to 'app/Query/Parser.hs')
-rw-r--r--app/Query/Parser.hs126
1 files changed, 0 insertions, 126 deletions
diff --git a/app/Query/Parser.hs b/app/Query/Parser.hs
deleted file mode 100644
index f2012e2..0000000
--- a/app/Query/Parser.hs
+++ /dev/null
@@ -1,126 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module 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 Exception (ParseError (ParseError))
-import 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
- ]