module Hpgsql.ParsingInternal
( parseSql,
BlockOrNotBlock (..),
ParsingOpts (..),
QQExprKind (..),
blockListText,
blockText,
flattenBlocks,
)
where
import Control.Applicative
( optional,
(<|>),
)
import Control.Monad
( void,
)
import Data.Attoparsec.Text
( Parser,
char,
endOfInput,
many',
many1,
peekChar,
string,
takeWhile,
takeWhile1,
)
import qualified Data.Attoparsec.Text as Parsec
import qualified Data.Char as Char
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)
import qualified Data.Text as Text
import Language.Haskell.Meta.Parse (parseExp)
import Prelude hiding (takeWhile)
data BlockOrNotBlock = StaticSql !Text | DollarNumberedArg !Int | QuestionMarkArg | QuasiQuoterExpression !QQExprKind !Text | SemiColon | !Text
deriving stock (BlockOrNotBlock -> BlockOrNotBlock -> Bool
(BlockOrNotBlock -> BlockOrNotBlock -> Bool)
-> (BlockOrNotBlock -> BlockOrNotBlock -> Bool)
-> Eq BlockOrNotBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockOrNotBlock -> BlockOrNotBlock -> Bool
== :: BlockOrNotBlock -> BlockOrNotBlock -> Bool
$c/= :: BlockOrNotBlock -> BlockOrNotBlock -> Bool
/= :: BlockOrNotBlock -> BlockOrNotBlock -> Bool
Eq, Int -> BlockOrNotBlock -> ShowS
[BlockOrNotBlock] -> ShowS
BlockOrNotBlock -> [Char]
(Int -> BlockOrNotBlock -> ShowS)
-> (BlockOrNotBlock -> [Char])
-> ([BlockOrNotBlock] -> ShowS)
-> Show BlockOrNotBlock
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockOrNotBlock -> ShowS
showsPrec :: Int -> BlockOrNotBlock -> ShowS
$cshow :: BlockOrNotBlock -> [Char]
show :: BlockOrNotBlock -> [Char]
$cshowList :: [BlockOrNotBlock] -> ShowS
showList :: [BlockOrNotBlock] -> ShowS
Show)
data QQExprKind = QQInterpolation | QQEmbeddedQuery
deriving stock (QQExprKind -> QQExprKind -> Bool
(QQExprKind -> QQExprKind -> Bool)
-> (QQExprKind -> QQExprKind -> Bool) -> Eq QQExprKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QQExprKind -> QQExprKind -> Bool
== :: QQExprKind -> QQExprKind -> Bool
$c/= :: QQExprKind -> QQExprKind -> Bool
/= :: QQExprKind -> QQExprKind -> Bool
Eq, Int -> QQExprKind -> ShowS
[QQExprKind] -> ShowS
QQExprKind -> [Char]
(Int -> QQExprKind -> ShowS)
-> (QQExprKind -> [Char])
-> ([QQExprKind] -> ShowS)
-> Show QQExprKind
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QQExprKind -> ShowS
showsPrec :: Int -> QQExprKind -> ShowS
$cshow :: QQExprKind -> [Char]
show :: QQExprKind -> [Char]
$cshowList :: [QQExprKind] -> ShowS
showList :: [QQExprKind] -> ShowS
Show)
data ParsingOpts = AcceptQuestionMarksAsQueryArgs | AcceptOnlyDollarNumberedArgs | AcceptQuasiQuoterExpressions
deriving stock (Int -> ParsingOpts -> ShowS
[ParsingOpts] -> ShowS
ParsingOpts -> [Char]
(Int -> ParsingOpts -> ShowS)
-> (ParsingOpts -> [Char])
-> ([ParsingOpts] -> ShowS)
-> Show ParsingOpts
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParsingOpts -> ShowS
showsPrec :: Int -> ParsingOpts -> ShowS
$cshow :: ParsingOpts -> [Char]
show :: ParsingOpts -> [Char]
$cshowList :: [ParsingOpts] -> ShowS
showList :: [ParsingOpts] -> ShowS
Show)
parseSql :: ParsingOpts -> Text -> [BlockOrNotBlock]
parseSql :: ParsingOpts -> Text -> [BlockOrNotBlock]
parseSql ParsingOpts
_ Text
"" = []
parseSql ParsingOpts
popts Text
str = case Parser [[BlockOrNotBlock]]
-> Text -> Either [Char] [[BlockOrNotBlock]]
forall a. Parser a -> Text -> Either [Char] a
Parsec.parseOnly (Parser Text [BlockOrNotBlock] -> Parser [[BlockOrNotBlock]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (ParsingOpts -> Bool -> Parser Text [BlockOrNotBlock]
sqlStatementParser ParsingOpts
popts Bool
True) Parser [[BlockOrNotBlock]]
-> Parser Text () -> Parser [[BlockOrNotBlock]]
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput) Text
str of
Right [[BlockOrNotBlock]]
mStatements -> [[BlockOrNotBlock]] -> [BlockOrNotBlock]
forall a. Monoid a => [a] -> a
mconcat [[BlockOrNotBlock]]
mStatements
Left [Char]
err -> [Char] -> [BlockOrNotBlock]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [BlockOrNotBlock]) -> [Char] -> [BlockOrNotBlock]
forall a b. (a -> b) -> a -> b
$ [Char]
"Bug in hpgsql when parsing SQL: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
err
sqlStatementParser :: ParsingOpts -> Bool -> Parser [BlockOrNotBlock]
sqlStatementParser :: ParsingOpts -> Bool -> Parser Text [BlockOrNotBlock]
sqlStatementParser ParsingOpts
popts Bool
isBeginningOfStmt = do
t1 <-
(if Bool
isBeginningOfStmt then Parser Text [BlockOrNotBlock]
commentOrSpaceParser else [Char] -> Parser Text [BlockOrNotBlock]
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"No whitespace parsing in the middle")
Parser Text [BlockOrNotBlock]
-> Parser Text [BlockOrNotBlock] -> Parser Text [BlockOrNotBlock]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (\Text
t -> [Text -> BlockOrNotBlock
StaticSql Text
t | Bool -> Bool
not (Text -> Bool
Text.null Text
t)])
(Text -> [BlockOrNotBlock])
-> Parser Text Text -> Parser Text [BlockOrNotBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Text
takeWhile
(\Char
c -> Bool -> Bool
not (ParsingOpts -> Char -> Bool
isPossibleBlockStartingChar ParsingOpts
popts Char
c) Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';')
mc <- peekChar
case mc of
Maybe Char
Nothing -> if [BlockOrNotBlock] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BlockOrNotBlock]
t1 then [Char] -> Parser Text [BlockOrNotBlock]
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Nothing to parse" else [BlockOrNotBlock] -> Parser Text [BlockOrNotBlock]
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [BlockOrNotBlock]
t1
Just Char
';' -> do
Parser Text Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Char -> Parser Text ())
-> Parser Text Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
char Char
';'
[BlockOrNotBlock] -> Parser Text [BlockOrNotBlock]
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([BlockOrNotBlock] -> Parser Text [BlockOrNotBlock])
-> [BlockOrNotBlock] -> Parser Text [BlockOrNotBlock]
forall a b. (a -> b) -> a -> b
$ [BlockOrNotBlock]
t1 [BlockOrNotBlock] -> [BlockOrNotBlock] -> [BlockOrNotBlock]
forall a. [a] -> [a] -> [a]
++ [BlockOrNotBlock
SemiColon]
Just Char
_ -> do
t2 <- Parser Text [BlockOrNotBlock] -> Parser [[BlockOrNotBlock]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (ParsingOpts -> Parser Text [BlockOrNotBlock]
blockParser ParsingOpts
popts) Parser [[BlockOrNotBlock]]
-> Parser [[BlockOrNotBlock]] -> Parser [[BlockOrNotBlock]]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (\Text
pt -> [[Text -> BlockOrNotBlock
StaticSql Text
pt]]) (Text -> [[BlockOrNotBlock]])
-> Parser Text Text -> Parser [[BlockOrNotBlock]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Text Text
Parsec.take Int
1
t3 <- sqlStatementParser popts False <|> ([] <$ endOfInput)
pure $ t1 ++ mconcat t2 <> t3
where
commentOrSpaceParser :: Parser [BlockOrNotBlock]
commentOrSpaceParser :: Parser Text [BlockOrNotBlock]
commentOrSpaceParser =
Parser Text BlockOrNotBlock -> Parser Text [BlockOrNotBlock]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Text -> BlockOrNotBlock
CommentsOrWhitespace (Text -> BlockOrNotBlock)
-> Parser Text Text -> Parser Text BlockOrNotBlock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Text
takeWhile1 Char -> Bool
Char.isSpace Parser Text BlockOrNotBlock
-> Parser Text BlockOrNotBlock -> Parser Text BlockOrNotBlock
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text BlockOrNotBlock
doubleDashComment Parser Text BlockOrNotBlock
-> Parser Text BlockOrNotBlock -> Parser Text BlockOrNotBlock
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text BlockOrNotBlock
cStyleComment)
eol :: Parser Text
eol :: Parser Text Text
eol = Text -> Parser Text Text
string Text
"\n" Parser Text Text -> Parser Text Text -> Parser Text Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
string Text
"\r\n"
blockText :: BlockOrNotBlock -> Text
blockText :: BlockOrNotBlock -> Text
blockText = \case
StaticSql Text
t -> Text
t
CommentsOrWhitespace Text
t -> Text
t
BlockOrNotBlock
QuestionMarkArg -> Text
"?"
DollarNumberedArg Int
n -> Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n)
QuasiQuoterExpression QQExprKind
QQInterpolation Text
t -> Text
"#{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
QuasiQuoterExpression QQExprKind
QQEmbeddedQuery Text
t -> Text
"^{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
BlockOrNotBlock
SemiColon -> Text
";"
blockListText :: [BlockOrNotBlock] -> Text
blockListText :: [BlockOrNotBlock] -> Text
blockListText = [Text] -> Text
Text.concat ([Text] -> Text)
-> ([BlockOrNotBlock] -> [Text]) -> [BlockOrNotBlock] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockOrNotBlock -> Text) -> [BlockOrNotBlock] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map BlockOrNotBlock -> Text
blockText
blockParser :: ParsingOpts -> Parser [BlockOrNotBlock]
blockParser :: ParsingOpts -> Parser Text [BlockOrNotBlock]
blockParser ParsingOpts
popts =
(BlockOrNotBlock -> [BlockOrNotBlock] -> [BlockOrNotBlock]
forall a. a -> [a] -> [a]
: [])
(BlockOrNotBlock -> [BlockOrNotBlock])
-> Parser Text BlockOrNotBlock -> Parser Text [BlockOrNotBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( case ParsingOpts
popts of
ParsingOpts
AcceptQuasiQuoterExpressions -> Parser Text BlockOrNotBlock
quasiQuoterExpressionParser
ParsingOpts
_ -> [Char] -> Parser Text BlockOrNotBlock
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"No quasiquoter expressions"
)
Parser Text [BlockOrNotBlock]
-> Parser Text [BlockOrNotBlock] -> Parser Text [BlockOrNotBlock]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (BlockOrNotBlock -> [BlockOrNotBlock] -> [BlockOrNotBlock]
forall a. a -> [a] -> [a]
: []) (BlockOrNotBlock -> [BlockOrNotBlock])
-> Parser Text BlockOrNotBlock -> Parser Text [BlockOrNotBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text BlockOrNotBlock
parseStdConformingString
Parser Text [BlockOrNotBlock]
-> Parser Text [BlockOrNotBlock] -> Parser Text [BlockOrNotBlock]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsingOpts -> Parser Text [BlockOrNotBlock]
parenthesisedExpression ParsingOpts
popts
Parser Text [BlockOrNotBlock]
-> Parser Text [BlockOrNotBlock] -> Parser Text [BlockOrNotBlock]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (BlockOrNotBlock -> [BlockOrNotBlock] -> [BlockOrNotBlock]
forall a. a -> [a] -> [a]
: []) (BlockOrNotBlock -> [BlockOrNotBlock])
-> Parser Text BlockOrNotBlock -> Parser Text [BlockOrNotBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text BlockOrNotBlock
cStyleComment
Parser Text [BlockOrNotBlock]
-> Parser Text [BlockOrNotBlock] -> Parser Text [BlockOrNotBlock]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (BlockOrNotBlock -> [BlockOrNotBlock] -> [BlockOrNotBlock]
forall a. a -> [a] -> [a]
: [])
(BlockOrNotBlock -> [BlockOrNotBlock])
-> Parser Text BlockOrNotBlock -> Parser Text [BlockOrNotBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( case ParsingOpts
popts of
ParsingOpts
AcceptOnlyDollarNumberedArgs -> Parser Text BlockOrNotBlock
dollarNumberedQueryArgParser
ParsingOpts
_ -> [Char] -> Parser Text BlockOrNotBlock
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"No dollar-numbered query args"
)
Parser Text [BlockOrNotBlock]
-> Parser Text [BlockOrNotBlock] -> Parser Text [BlockOrNotBlock]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (BlockOrNotBlock -> [BlockOrNotBlock] -> [BlockOrNotBlock]
forall a. a -> [a] -> [a]
: []) (BlockOrNotBlock -> [BlockOrNotBlock])
-> Parser Text BlockOrNotBlock -> Parser Text [BlockOrNotBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text BlockOrNotBlock
dollarStringParser
Parser Text [BlockOrNotBlock]
-> Parser Text [BlockOrNotBlock] -> Parser Text [BlockOrNotBlock]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (BlockOrNotBlock -> [BlockOrNotBlock] -> [BlockOrNotBlock]
forall a. a -> [a] -> [a]
: [])
(BlockOrNotBlock -> [BlockOrNotBlock])
-> Parser Text BlockOrNotBlock -> Parser Text [BlockOrNotBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( case ParsingOpts
popts of
ParsingOpts
AcceptQuestionMarksAsQueryArgs -> Parser Text BlockOrNotBlock
questionMarkQueryArgParser
ParsingOpts
_ -> [Char] -> Parser Text BlockOrNotBlock
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"No question marks as query args"
)
Parser Text [BlockOrNotBlock]
-> Parser Text [BlockOrNotBlock] -> Parser Text [BlockOrNotBlock]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (BlockOrNotBlock -> [BlockOrNotBlock] -> [BlockOrNotBlock]
forall a. a -> [a] -> [a]
: []) (BlockOrNotBlock -> [BlockOrNotBlock])
-> Parser Text BlockOrNotBlock -> Parser Text [BlockOrNotBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text BlockOrNotBlock
doubleDashComment
Parser Text [BlockOrNotBlock]
-> Parser Text [BlockOrNotBlock] -> Parser Text [BlockOrNotBlock]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (BlockOrNotBlock -> [BlockOrNotBlock] -> [BlockOrNotBlock]
forall a. a -> [a] -> [a]
: []) (BlockOrNotBlock -> [BlockOrNotBlock])
-> Parser Text BlockOrNotBlock -> Parser Text [BlockOrNotBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text BlockOrNotBlock
doubleQuotedIdentifier
Parser Text [BlockOrNotBlock]
-> Parser Text [BlockOrNotBlock] -> Parser Text [BlockOrNotBlock]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (BlockOrNotBlock -> [BlockOrNotBlock] -> [BlockOrNotBlock]
forall a. a -> [a] -> [a]
: []) (BlockOrNotBlock -> [BlockOrNotBlock])
-> Parser Text BlockOrNotBlock -> Parser Text [BlockOrNotBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text BlockOrNotBlock
cStyleEscapedString
isPossibleBlockStartingChar :: ParsingOpts -> Char -> Bool
isPossibleBlockStartingChar :: ParsingOpts -> Char -> Bool
isPossibleBlockStartingChar ParsingOpts
popts Char
c =
Char
c
Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'('
Bool -> Bool -> Bool
|| Char
c
Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
Bool -> Bool -> Bool
|| Char
c
Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
Bool -> Bool -> Bool
|| Char
c
Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"'
Bool -> Bool -> Bool
|| Char
c
Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$'
Bool -> Bool -> Bool
|| Char
c
Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''
Bool -> Bool -> Bool
|| Char
c
Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'E'
Bool -> Bool -> Bool
|| Char
c
Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?'
Bool -> Bool -> Bool
|| ( case ParsingOpts
popts of
ParsingOpts
AcceptQuasiQuoterExpressions -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'^'
ParsingOpts
_ -> Bool
False
)
quasiQuoterExpressionParser :: Parser BlockOrNotBlock
quasiQuoterExpressionParser :: Parser Text BlockOrNotBlock
quasiQuoterExpressionParser = do
prefix <- Text -> Parser Text Text
string Text
"#{" Parser Text Text -> Parser Text Text -> Parser Text Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
string Text
"^{"
let kind = if Text
prefix Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"#{" then QQExprKind
QQInterpolation else QQExprKind
QQEmbeddedQuery
expr <- findExpressionEnd ""
pure $ QuasiQuoterExpression kind expr
where
findExpressionEnd :: Text -> Parser Text Text
findExpressionEnd Text
acc = do
chunk <- (Char -> Bool) -> Parser Text Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}')
void $ char '}'
let candidate = Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
chunk
case parseExp (Text.unpack candidate) of
Right Exp
_ -> Text -> Parser Text Text
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
candidate
Left [Char]
_ -> Text -> Parser Text Text
findExpressionEnd (Text
candidate Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}")
dollarNumberedQueryArgParser :: Parser BlockOrNotBlock
dollarNumberedQueryArgParser :: Parser Text BlockOrNotBlock
dollarNumberedQueryArgParser = do
Parser Text Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Char -> Parser Text ())
-> Parser Text Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
char Char
'$'
Int -> BlockOrNotBlock
DollarNumberedArg (Int -> BlockOrNotBlock)
-> Parser Text Int -> Parser Text BlockOrNotBlock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Int
forall a. Integral a => Parser a
Parsec.decimal
questionMarkQueryArgParser :: Parser BlockOrNotBlock
questionMarkQueryArgParser :: Parser Text BlockOrNotBlock
questionMarkQueryArgParser = do
Parser Text Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Char -> Parser Text ())
-> Parser Text Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
char Char
'?'
escapedQuestionMark <- Parser Text Char -> Parser (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text Char -> Parser (Maybe Char))
-> Parser Text Char -> Parser (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
char Char
'?'
case escapedQuestionMark of
Just Char
_ -> BlockOrNotBlock -> Parser Text BlockOrNotBlock
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BlockOrNotBlock -> Parser Text BlockOrNotBlock)
-> BlockOrNotBlock -> Parser Text BlockOrNotBlock
forall a b. (a -> b) -> a -> b
$ Text -> BlockOrNotBlock
StaticSql Text
"?"
Maybe Char
Nothing -> BlockOrNotBlock -> Parser Text BlockOrNotBlock
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlockOrNotBlock
QuestionMarkArg
dollarStringParser :: Parser BlockOrNotBlock
dollarStringParser :: Parser Text BlockOrNotBlock
dollarStringParser = (Text -> BlockOrNotBlock)
-> Parser Text Text -> Parser Text BlockOrNotBlock
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> BlockOrNotBlock
StaticSql (Parser Text Text -> Parser Text BlockOrNotBlock)
-> Parser Text Text -> Parser Text BlockOrNotBlock
forall a b. (a -> b) -> a -> b
$ do
Parser Text Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Char -> Parser Text ())
-> Parser Text Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
char Char
'$'
b <- (Char -> Bool) -> Parser Text Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'$')
void $ char '$'
let dollarSep = Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"$"
rest <- go dollarSep
pure $ dollarSep <> rest
where
go :: Text -> Parser Text Text
go Text
dollarSep = do
t <- (Char -> Bool) -> Parser Text Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'$')
ending <- optional $ string dollarSep <|> "" <$ endOfInput
case ending of
Maybe Text
Nothing -> do
Parser Text Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Char -> Parser Text ())
-> Parser Text Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
char Char
'$'
rest <- Text -> Parser Text Text
go Text
dollarSep
pure $ t <> "$" <> rest
Just Text
e -> Text -> Parser Text Text
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text Text) -> Text -> Parser Text Text
forall a b. (a -> b) -> a -> b
$ Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
doubleDashComment :: Parser BlockOrNotBlock
= (Text -> BlockOrNotBlock)
-> Parser Text Text -> Parser Text BlockOrNotBlock
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> BlockOrNotBlock
CommentsOrWhitespace (Parser Text Text -> Parser Text BlockOrNotBlock)
-> Parser Text Text -> Parser Text BlockOrNotBlock
forall a b. (a -> b) -> a -> b
$ do
begin <- Text -> Parser Text Text
string Text
"--"
rest <- Parsec.takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r')
end <- eol <|> "" <$ endOfInput
pure $ begin <> rest <> end
cStyleComment :: Parser BlockOrNotBlock
= (Text -> BlockOrNotBlock)
-> Parser Text Text -> Parser Text BlockOrNotBlock
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> BlockOrNotBlock
CommentsOrWhitespace (Parser Text Text -> Parser Text BlockOrNotBlock)
-> Parser Text Text -> Parser Text BlockOrNotBlock
forall a b. (a -> b) -> a -> b
$ do
openComment <- Text -> Parser Text Text
string Text
"/*"
rest <-
Parsec.scan
(1 :: Int, False, False)
( \(Int
openCommentCount, Bool
hasPartialOpening, Bool
hasPartialClosing) Char
c ->
Maybe (Int, Bool, Bool) -> Maybe (Int, Bool, Bool)
forall {a} {b} {c}.
(Eq a, Num a) =>
Maybe (a, b, c) -> Maybe (a, b, c)
nothingWhenDone (Maybe (Int, Bool, Bool) -> Maybe (Int, Bool, Bool))
-> Maybe (Int, Bool, Bool) -> Maybe (Int, Bool, Bool)
forall a b. (a -> b) -> a -> b
$ case (Bool
hasPartialOpening, Bool
hasPartialClosing, Char
c) of
(Bool
False, Bool
False, Char
'/') -> (Int, Bool, Bool) -> Maybe (Int, Bool, Bool)
forall a. a -> Maybe a
Just (Int
openCommentCount, Bool
True, Bool
False)
(Bool
False, Bool
True, Char
'/') -> (Int, Bool, Bool) -> Maybe (Int, Bool, Bool)
forall a. a -> Maybe a
Just (Int
openCommentCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Bool
False, Bool
False)
(Bool
True, Bool
False, Char
'/') -> (Int, Bool, Bool) -> Maybe (Int, Bool, Bool)
forall a. a -> Maybe a
Just (Int
openCommentCount, Bool
True, Bool
False)
(Bool
False, Bool
False, Char
'*') -> (Int, Bool, Bool) -> Maybe (Int, Bool, Bool)
forall a. a -> Maybe a
Just (Int
openCommentCount, Bool
False, Bool
True)
(Bool
True, Bool
False, Char
'*') -> (Int, Bool, Bool) -> Maybe (Int, Bool, Bool)
forall a. a -> Maybe a
Just (Int
openCommentCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Bool
False, Bool
False)
(Bool
False, Bool
True, Char
'*') -> (Int, Bool, Bool) -> Maybe (Int, Bool, Bool)
forall a. a -> Maybe a
Just (Int
openCommentCount, Bool
False, Bool
True)
(Bool
True, Bool
True, Char
_) ->
[Char] -> Maybe (Int, Bool, Bool)
forall a. HasCallStack => [Char] -> a
error
[Char]
"Report this as a bug in codd: C Style comment parser invalid state"
(Bool, Bool, Char)
_ -> (Int, Bool, Bool) -> Maybe (Int, Bool, Bool)
forall a. a -> Maybe a
Just (Int
openCommentCount, Bool
False, Bool
False)
)
end <- string "/" <|> "" <$ endOfInput
pure $ openComment <> rest <> end
where
nothingWhenDone :: Maybe (a, b, c) -> Maybe (a, b, c)
nothingWhenDone (Just (a
0, b
_, c
_)) = Maybe (a, b, c)
forall a. Maybe a
Nothing
nothingWhenDone Maybe (a, b, c)
x = Maybe (a, b, c)
x
parenthesisedExpression :: ParsingOpts -> Parser [BlockOrNotBlock]
parenthesisedExpression :: ParsingOpts -> Parser Text [BlockOrNotBlock]
parenthesisedExpression ParsingOpts
popts = do
openParen <- Text -> Parser Text Text
string Text
"(" Parser Text Text -> Parser Text Text -> Parser Text Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Text Text
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"No open paren"
rest <- insideParenParser
pure $ StaticSql openParen : rest
where
insideParenParser :: Parser [BlockOrNotBlock]
insideParenParser :: Parser Text [BlockOrNotBlock]
insideParenParser = do
more <-
(Char -> Bool) -> Parser Text Text
takeWhile
(\Char
c -> Bool -> Bool
not (ParsingOpts -> Char -> Bool
isPossibleBlockStartingChar ParsingOpts
popts Char
c) Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
')')
nextChar <- peekChar
case nextChar of
Maybe Char
Nothing -> [BlockOrNotBlock] -> Parser Text [BlockOrNotBlock]
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> BlockOrNotBlock
StaticSql Text
more]
Just Char
')' -> do
closeParen <- Text -> Parser Text Text
string Text
")"
pure [StaticSql more, StaticSql closeParen]
Just Char
_ -> do
blocksOrOtherwise <- ParsingOpts -> Parser Text [BlockOrNotBlock]
blockParser ParsingOpts
popts Parser Text [BlockOrNotBlock]
-> Parser Text [BlockOrNotBlock] -> Parser Text [BlockOrNotBlock]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (\Text
t -> [Text -> BlockOrNotBlock
StaticSql Text
t]) (Text -> [BlockOrNotBlock])
-> Parser Text Text -> Parser Text [BlockOrNotBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Text Text
Parsec.take Int
1
rest <- insideParenParser
pure $ StaticSql more : blocksOrOtherwise ++ rest
parseWithEscapeCharPreserve :: (Char -> Bool) -> Parser Text
parseWithEscapeCharPreserve :: (Char -> Bool) -> Parser Text Text
parseWithEscapeCharPreserve Char -> Bool
untilc = do
cs <- (Char -> Bool) -> Parser Text Text
Parsec.takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
untilc Char
c))
nextChar <- peekChar
case nextChar of
Just Char
'\\' -> do
c <- Int -> Parser Text Text
Parsec.take Int
2
rest <- parseWithEscapeCharPreserve untilc
pure $ cs <> c <> rest
Maybe Char
_ -> Text -> Parser Text Text
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
cs
doubleQuotedIdentifier :: Parser BlockOrNotBlock
doubleQuotedIdentifier :: Parser Text BlockOrNotBlock
doubleQuotedIdentifier = (Text -> BlockOrNotBlock)
-> Parser Text Text -> Parser Text BlockOrNotBlock
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> BlockOrNotBlock
StaticSql (Parser Text Text -> Parser Text BlockOrNotBlock)
-> Parser Text Text -> Parser Text BlockOrNotBlock
forall a b. (a -> b) -> a -> b
$ do
openingQuote <- Text -> Parser Text Text
string Text
"\""
rest <- parseWithEscapeCharPreserve (== '"')
ending <- string "\""
pure $ openingQuote <> rest <> ending
cStyleEscapedString :: Parser BlockOrNotBlock
cStyleEscapedString :: Parser Text BlockOrNotBlock
cStyleEscapedString = (Text -> BlockOrNotBlock)
-> Parser Text Text -> Parser Text BlockOrNotBlock
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> BlockOrNotBlock
StaticSql (Parser Text Text -> Parser Text BlockOrNotBlock)
-> Parser Text Text -> Parser Text BlockOrNotBlock
forall a b. (a -> b) -> a -> b
$ do
openingChars <- Text -> Parser Text Text
string Text
"E'"
rest <-
Parsec.scan
(False, False)
( \(Bool
lastCharWasBackslash, Bool
lastCharWasSingleQuote) Char
c ->
case ((Bool
lastCharWasBackslash, Bool
lastCharWasSingleQuote), Char
c) of
((Bool
False, Bool
False), Char
'\'') -> (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
False, Bool
True)
((Bool
False, Bool
True), Char
'\'') -> (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
False, Bool
False)
((Bool
False, Bool
True), Char
_) -> Maybe (Bool, Bool)
forall a. Maybe a
Nothing
((Bool
False, Bool
False), Char
'\\') -> (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
True, Bool
False)
((Bool
False, Bool
False), Char
_) -> (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
False, Bool
False)
((Bool
True, Bool
False), Char
_) -> (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
False, Bool
False)
((Bool
True, Bool
True), Char
_) ->
[Char] -> Maybe (Bool, Bool)
forall a. HasCallStack => [Char] -> a
error
[Char]
"Please submit this as a bug report to codd, saying both backslash and single quote were last char in cStyleEscapedString"
)
pure $ openingChars <> rest
parseStdConformingString :: Parser BlockOrNotBlock
parseStdConformingString :: Parser Text BlockOrNotBlock
parseStdConformingString = (Text -> BlockOrNotBlock)
-> Parser Text Text -> Parser Text BlockOrNotBlock
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> BlockOrNotBlock
StaticSql (Parser Text Text -> Parser Text BlockOrNotBlock)
-> Parser Text Text -> Parser Text BlockOrNotBlock
forall a b. (a -> b) -> a -> b
$ do
openingQuote <- Text -> Parser Text Text
string Text
"'"
rest <-
Parsec.scan
False
( \Bool
lastCharWasQuote Char
c -> case (Bool
lastCharWasQuote, Char
c) of
(Bool
False, Char
'\'') -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
(Bool
True, Char
'\'') -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
(Bool
True, Char
_) -> Maybe Bool
forall a. Maybe a
Nothing
(Bool
False, Char
_) -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
)
pure $ openingQuote <> rest
flattenBlocks :: [BlockOrNotBlock] -> [BlockOrNotBlock]
flattenBlocks :: [BlockOrNotBlock] -> [BlockOrNotBlock]
flattenBlocks =
(NonEmpty BlockOrNotBlock -> BlockOrNotBlock)
-> [NonEmpty BlockOrNotBlock] -> [BlockOrNotBlock]
forall a b. (a -> b) -> [a] -> [b]
map
( \bs :: NonEmpty BlockOrNotBlock
bs@(BlockOrNotBlock
firstEl :| [BlockOrNotBlock]
_) -> case BlockOrNotBlock
firstEl of
StaticSql Text
_ -> Text -> BlockOrNotBlock
StaticSql (Text -> BlockOrNotBlock) -> Text -> BlockOrNotBlock
forall a b. (a -> b) -> a -> b
$ [BlockOrNotBlock] -> Text
blockListText ([BlockOrNotBlock] -> Text) -> [BlockOrNotBlock] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty BlockOrNotBlock -> [BlockOrNotBlock]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty BlockOrNotBlock
bs
CommentsOrWhitespace Text
_ -> Text -> BlockOrNotBlock
CommentsOrWhitespace (Text -> BlockOrNotBlock) -> Text -> BlockOrNotBlock
forall a b. (a -> b) -> a -> b
$ [BlockOrNotBlock] -> Text
blockListText ([BlockOrNotBlock] -> Text) -> [BlockOrNotBlock] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty BlockOrNotBlock -> [BlockOrNotBlock]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty BlockOrNotBlock
bs
BlockOrNotBlock
x -> BlockOrNotBlock
x
)
([NonEmpty BlockOrNotBlock] -> [BlockOrNotBlock])
-> ([BlockOrNotBlock] -> [NonEmpty BlockOrNotBlock])
-> [BlockOrNotBlock]
-> [BlockOrNotBlock]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockOrNotBlock -> BlockOrNotBlock -> Bool)
-> [BlockOrNotBlock] -> [NonEmpty BlockOrNotBlock]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy
( \BlockOrNotBlock
a BlockOrNotBlock
b -> case (BlockOrNotBlock
a, BlockOrNotBlock
b) of
(StaticSql Text
_, StaticSql Text
_) -> Bool
True
(CommentsOrWhitespace Text
_, CommentsOrWhitespace Text
_) -> Bool
True
(BlockOrNotBlock, BlockOrNotBlock)
_ -> Bool
False
)
([BlockOrNotBlock] -> [NonEmpty BlockOrNotBlock])
-> ([BlockOrNotBlock] -> [BlockOrNotBlock])
-> [BlockOrNotBlock]
-> [NonEmpty BlockOrNotBlock]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockOrNotBlock -> Bool) -> [BlockOrNotBlock] -> [BlockOrNotBlock]
forall a. (a -> Bool) -> [a] -> [a]
filter (\BlockOrNotBlock
b -> BlockOrNotBlock -> Text
blockText BlockOrNotBlock
b Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"")