{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Database.Esqueleto.Internal.ExprParser where
import Prelude hiding (takeWhile)
import Control.Applicative ((<|>))
import Control.Monad (void)
import Data.Attoparsec.Text
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as Text
import Database.Persist.Sql
data TableAccess = TableAccess
{ tableAccessTable :: Text
, tableAccessColumn :: Text
}
deriving (Eq, Ord, Show)
parseOnExpr :: SqlBackend -> Text -> Either String (Set TableAccess)
parseOnExpr sqlBackend text = do
c <- mkEscapeChar sqlBackend
parseOnly (onExpr c) text
mkEscapeChar :: SqlBackend -> Either String Char
mkEscapeChar sqlBackend =
case Text.uncons (connEscapeName sqlBackend (DBName "")) of
Nothing ->
Left "Failed to get an escape character from the SQL backend."
Just (c, _) ->
Right c
type ExprParser a = Char -> Parser a
onExpr :: ExprParser (Set TableAccess)
onExpr e = Set.fromList <$> many' tableAccesses
where
tableAccesses = do
skipToEscape e <?> "Skipping to an escape char"
parseTableAccess e <?> "Parsing a table access"
skipToEscape :: ExprParser ()
skipToEscape escapeChar = void (takeWhile (/= escapeChar))
parseEscapedIdentifier :: ExprParser [Char]
parseEscapedIdentifier escapeChar = do
char escapeChar
str <- parseEscapedChars escapeChar
char escapeChar
pure str
parseTableAccess :: ExprParser TableAccess
parseTableAccess ec = do
tableAccessTable <- Text.pack <$> parseEscapedIdentifier ec
_ <- char '.'
tableAccessColumn <- Text.pack <$> parseEscapedIdentifier ec
pure TableAccess {..}
parseEscapedChars :: ExprParser [Char]
parseEscapedChars escapeChar = go
where
twoEscapes = char escapeChar *> char escapeChar
go = many' (notChar escapeChar <|> twoEscapes)