The parser uses a separate lexer for two reasons:
1. sql syntax is very awkward to parse, the separate lexer makes it
easier to handle this in most places (in some places it makes it
harder or impossible, the fix is to switch to something better than
parsec)
2. using a separate lexer gives a huge speed boost because it reduces
backtracking. (We could get this by making the parsing code a lot more
complex also.)
3. we can test the lexer relatively exhaustively, then even when we
don't do nearly as comprehensive testing on the syntax level, we still
have a relatively high assurance of the low level of bugs. This is
much more difficult to get parity with when testing the syntax parser
directly without the separately testing lexing stage.
>
> {-# LANGUAGE TupleSections #-}
> module Language.SQL.SimpleSQL.Lex
> (Token(..)
> ,lexSQL
> ,prettyToken
> ,prettyTokens
> ,ParseError(..)
> ,tokenListWillPrintAndLex
> ,ansi2011
> ) where
> import Language.SQL.SimpleSQL.Dialect
> import Text.Parsec (option,string,manyTill,anyChar
> ,try,string,many1,oneOf,digit,(<|>),choice,char,eof
> ,many,runParser,lookAhead,satisfy
> ,setPosition,getPosition
> ,setSourceColumn,setSourceLine
> ,sourceName, setSourceName
> ,sourceLine, sourceColumn
> ,notFollowedBy)
> import Language.SQL.SimpleSQL.Combinators
> import Language.SQL.SimpleSQL.Errors
> import Control.Applicative hiding ((<|>), many)
> import Data.Char
> import Control.Monad
> import Prelude hiding (takeWhile)
> import Text.Parsec.String (Parser)
> import Data.Maybe
>
> data Token
>
>
>
>
>
> = Symbol String
>
>
>
>
> | Identifier (Maybe (String,String)) String
>
>
>
> | PrefixedVariable Char String
>
>
> | PositionalArg Int
>
>
>
>
>
> | SqlString String String String
>
>
>
> | SqlNumber String
>
>
> | Whitespace String
>
>
>
>
>
> | String
>
>
> | String
>
> deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq,Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show)
>
>
> prettyToken :: Dialect -> Token -> String
> prettyToken :: Dialect -> Token -> String
prettyToken _ (Symbol s :: String
s) = String
s
> prettyToken _ (Identifier Nothing t :: String
t) = String
t
> prettyToken _ (Identifier (Just (q1 :: String
q1,q2 :: String
q2)) t :: String
t) = String
q1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
q2
> prettyToken _ (PrefixedVariable c :: Char
c p :: String
p) = Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
p
> prettyToken _ (PositionalArg p :: Int
p) = '$'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> String
forall a. Show a => a -> String
show Int
p
> prettyToken _ (SqlString s :: String
s e :: String
e t :: String
t) = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e
> prettyToken _ (SqlNumber r :: String
r) = String
r
> prettyToken _ (Whitespace t :: String
t) = String
t
> prettyToken _ (LineComment l :: String
l) = String
l
> prettyToken _ (BlockComment c :: String
c) = String
c
> prettyTokens :: Dialect -> [Token] -> String
> prettyTokens :: Dialect -> [Token] -> String
prettyTokens d :: Dialect
d ts :: [Token]
ts = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Token -> String) -> [Token] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Dialect -> Token -> String
prettyToken Dialect
d) [Token]
ts
TODO: try to make all parsers applicative only
>
> lexSQL :: Dialect
>
> -> FilePath
>
> -> Maybe (Int,Int)
>
>
> -> String
>
> -> Either ParseError [((String,Int,Int),Token)]
> lexSQL :: Dialect
-> String
-> Maybe (Int, Int)
-> String
-> Either ParseError [((String, Int, Int), Token)]
lexSQL dialect :: Dialect
dialect fn' :: String
fn' p :: Maybe (Int, Int)
p src :: String
src =
> let (l' :: Int
l',c' :: Int
c') = (Int, Int) -> Maybe (Int, Int) -> (Int, Int)
forall a. a -> Maybe a -> a
fromMaybe (1,1) Maybe (Int, Int)
p
> in (ParseError -> Either ParseError [((String, Int, Int), Token)])
-> ([((String, Int, Int), Token)]
-> Either ParseError [((String, Int, Int), Token)])
-> Either ParseError [((String, Int, Int), Token)]
-> Either ParseError [((String, Int, Int), Token)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParseError -> Either ParseError [((String, Int, Int), Token)]
forall a b. a -> Either a b
Left (ParseError -> Either ParseError [((String, Int, Int), Token)])
-> (ParseError -> ParseError)
-> ParseError
-> Either ParseError [((String, Int, Int), Token)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseError -> ParseError
convParseError String
src) [((String, Int, Int), Token)]
-> Either ParseError [((String, Int, Int), Token)]
forall a b. b -> Either a b
Right
> (Either ParseError [((String, Int, Int), Token)]
-> Either ParseError [((String, Int, Int), Token)])
-> Either ParseError [((String, Int, Int), Token)]
-> Either ParseError [((String, Int, Int), Token)]
forall a b. (a -> b) -> a -> b
$ Parsec String () [((String, Int, Int), Token)]
-> ()
-> String
-> String
-> Either ParseError [((String, Int, Int), Token)]
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser ((String, Int, Int) -> ParsecT String () Identity ()
forall (m :: * -> *) s u.
Monad m =>
(String, Int, Int) -> ParsecT s u m ()
setPos (String
fn',Int
l',Int
c') ParsecT String () Identity ()
-> Parsec String () [((String, Int, Int), Token)]
-> Parsec String () [((String, Int, Int), Token)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity ((String, Int, Int), Token)
-> Parsec String () [((String, Int, Int), Token)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Dialect -> ParsecT String () Identity ((String, Int, Int), Token)
sqlToken Dialect
dialect) Parsec String () [((String, Int, Int), Token)]
-> ParsecT String () Identity ()
-> Parsec String () [((String, Int, Int), Token)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) () String
fn' String
src
> where
> setPos :: (String, Int, Int) -> ParsecT s u m ()
setPos (fn :: String
fn,l :: Int
l,c :: Int
c) = do
> (SourcePos -> SourcePos)
-> ParsecT s u m SourcePos -> ParsecT s u m SourcePos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SourcePos -> String -> SourcePos)
-> String -> SourcePos -> SourcePos
forall a b c. (a -> b -> c) -> b -> a -> c
flip SourcePos -> String -> SourcePos
setSourceName String
fn
> (SourcePos -> SourcePos)
-> (SourcePos -> SourcePos) -> SourcePos -> SourcePos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourcePos -> Int -> SourcePos) -> Int -> SourcePos -> SourcePos
forall a b c. (a -> b -> c) -> b -> a -> c
flip SourcePos -> Int -> SourcePos
setSourceLine Int
l
> (SourcePos -> SourcePos)
-> (SourcePos -> SourcePos) -> SourcePos -> SourcePos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourcePos -> Int -> SourcePos) -> Int -> SourcePos -> SourcePos
forall a b c. (a -> b -> c) -> b -> a -> c
flip SourcePos -> Int -> SourcePos
setSourceColumn Int
c) ParsecT s u m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
> ParsecT s u m SourcePos
-> (SourcePos -> ParsecT s u m ()) -> ParsecT s u m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SourcePos -> ParsecT s u m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition
>
> sqlToken :: Dialect -> Parser ((String,Int,Int),Token)
> sqlToken :: Dialect -> ParsecT String () Identity ((String, Int, Int), Token)
sqlToken d :: Dialect
d = do
> SourcePos
p' <- ParsecT String () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
> let p :: (String, Int, Int)
p = (SourcePos -> String
sourceName SourcePos
p',SourcePos -> Int
sourceLine SourcePos
p', SourcePos -> Int
sourceColumn SourcePos
p')
The order of parsers is important: strings and quoted identifiers can
start out looking like normal identifiers, so we try to parse these
first and use a little bit of try. Line and block comments start like
symbols, so we try these before symbol. Numbers can start with a . so
this is also tried before symbol (a .1 will be parsed as a number, but
. otherwise will be parsed as a symbol).
> ((String, Int, Int)
p,) (Token -> ((String, Int, Int), Token))
-> ParsecT String () Identity Token
-> ParsecT String () Identity ((String, Int, Int), Token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT String () Identity Token]
-> ParsecT String () Identity Token
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Dialect -> ParsecT String () Identity Token
sqlString Dialect
d
> ,Dialect -> ParsecT String () Identity Token
identifier Dialect
d
> ,Dialect -> ParsecT String () Identity Token
lineComment Dialect
d
> ,Dialect -> ParsecT String () Identity Token
blockComment Dialect
d
> ,Dialect -> ParsecT String () Identity Token
sqlNumber Dialect
d
> ,Dialect -> ParsecT String () Identity Token
positionalArg Dialect
d
> ,Dialect -> ParsecT String () Identity Token
dontParseEndBlockComment Dialect
d
> ,Dialect -> ParsecT String () Identity Token
prefixedVariable Dialect
d
> ,Dialect -> ParsecT String () Identity Token
symbol Dialect
d
> ,Dialect -> ParsecT String () Identity Token
sqlWhitespace Dialect
d]
Parses identifiers:
simple_identifier_23
u&"unicode quoted identifier"
"quoted identifier"
"quoted identifier "" with double quote char"
`mysql quoted identifier`
> identifier :: Dialect -> Parser Token
> identifier :: Dialect -> ParsecT String () Identity Token
identifier d :: Dialect
d =
> [ParsecT String () Identity Token]
-> ParsecT String () Identity Token
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
> [ParsecT String () Identity Token
quotedIden
> ,ParsecT String () Identity Token
unicodeQuotedIden
> ,ParsecT String () Identity Token
regularIden
> ,Bool -> ParsecT String () Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Dialect -> Bool
diBackquotedIden Dialect
d) ParsecT String () Identity ()
-> ParsecT String () Identity Token
-> ParsecT String () Identity Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () Identity Token
mySqlQuotedIden
> ,Bool -> ParsecT String () Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Dialect -> Bool
diSquareBracketQuotedIden Dialect
d) ParsecT String () Identity ()
-> ParsecT String () Identity Token
-> ParsecT String () Identity Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () Identity Token
sqlServerQuotedIden
> ]
> where
> regularIden :: ParsecT String () Identity Token
regularIden = Maybe (String, String) -> String -> Token
Identifier Maybe (String, String)
forall a. Maybe a
Nothing (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
identifierString
> quotedIden :: ParsecT String () Identity Token
quotedIden = Maybe (String, String) -> String -> Token
Identifier ((String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just ("\"","\"")) (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
qidenPart
> mySqlQuotedIden :: ParsecT String () Identity Token
mySqlQuotedIden = Maybe (String, String) -> String -> Token
Identifier ((String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just ("`","`"))
> (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '`' ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> ParsecT String () Identity String
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='`') ParsecT String () Identity String
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '`')
> sqlServerQuotedIden :: ParsecT String () Identity Token
sqlServerQuotedIden = Maybe (String, String) -> String -> Token
Identifier ((String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just ("[","]"))
> (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '[' ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> ParsecT String () Identity String
takeWhile1 (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` "[]") ParsecT String () Identity String
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ']')
>
>
> unicodeQuotedIden :: ParsecT String () Identity Token
unicodeQuotedIden = Maybe (String, String) -> String -> Token
Identifier
> (Maybe (String, String) -> String -> Token)
-> ParsecT String () Identity (Maybe (String, String))
-> ParsecT String () Identity (String -> Token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Maybe (String, String)
f (Char -> Maybe (String, String))
-> ParsecT String () Identity Char
-> ParsecT String () Identity (Maybe (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "uU" ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "&"))
> ParsecT String () Identity (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity String
qidenPart
> where f :: Char -> Maybe (String, String)
f x :: Char
x = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
: "&\"", "\"")
> qidenPart :: ParsecT String () Identity String
qidenPart = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '"' ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT String () Identity String
qidenSuffix ""
> qidenSuffix :: String -> ParsecT String () Identity String
qidenSuffix t :: String
t = do
> String
s <- (Char -> Bool) -> ParsecT String () Identity String
takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='"')
> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '"'
>
> [ParsecT String () Identity String]
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [do
> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '"'
> String -> ParsecT String () Identity String
qidenSuffix (String -> ParsecT String () Identity String)
-> String -> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
t,String
s,"\"\""]
> ,String -> ParsecT String () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String () Identity String)
-> String -> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
t,String
s]]
This parses a valid identifier without quotes.
> identifierString :: Parser String
> identifierString :: ParsecT String () Identity String
identifierString =
> (Char -> Bool)
-> (Char -> Bool) -> ParsecT String () Identity String
startsWith (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' Bool -> Bool -> Bool
|| Char -> Bool
isAlpha Char
c) Char -> Bool
isIdentifierChar
this can be moved to the dialect at some point
> isIdentifierChar :: Char -> Bool
> isIdentifierChar :: Char -> Bool
isIdentifierChar c :: Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' Bool -> Bool -> Bool
|| Char -> Bool
isAlphaNum Char
c
use try because : and @ can be part of other things also
> prefixedVariable :: Dialect -> Parser Token
> prefixedVariable :: Dialect -> ParsecT String () Identity Token
prefixedVariable d :: Dialect
d = ParsecT String () Identity Token
-> ParsecT String () Identity Token
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity Token
-> ParsecT String () Identity Token)
-> ParsecT String () Identity Token
-> ParsecT String () Identity Token
forall a b. (a -> b) -> a -> b
$ [ParsecT String () Identity Token]
-> ParsecT String () Identity Token
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
> [Char -> String -> Token
PrefixedVariable (Char -> String -> Token)
-> ParsecT String () Identity Char
-> ParsecT String () Identity (String -> Token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':' ParsecT String () Identity (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity String
identifierString
> ,Bool -> ParsecT String () Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Dialect -> Bool
diAtIdentifier Dialect
d) ParsecT String () Identity ()
-> ParsecT String () Identity Token
-> ParsecT String () Identity Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
> Char -> String -> Token
PrefixedVariable (Char -> String -> Token)
-> ParsecT String () Identity Char
-> ParsecT String () Identity (String -> Token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '@' ParsecT String () Identity (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity String
identifierString
> ,Bool -> ParsecT String () Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Dialect -> Bool
diHashIdentifier Dialect
d) ParsecT String () Identity ()
-> ParsecT String () Identity Token
-> ParsecT String () Identity Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
> Char -> String -> Token
PrefixedVariable (Char -> String -> Token)
-> ParsecT String () Identity Char
-> ParsecT String () Identity (String -> Token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '#' ParsecT String () Identity (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity String
identifierString
> ]
> positionalArg :: Dialect -> Parser Token
> positionalArg :: Dialect -> ParsecT String () Identity Token
positionalArg d :: Dialect
d =
> Bool -> ParsecT String () Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Dialect -> Bool
diPositionalArg Dialect
d) ParsecT String () Identity ()
-> ParsecT String () Identity Token
-> ParsecT String () Identity Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
>
> Int -> Token
PositionalArg (Int -> Token)
-> ParsecT String () Identity Int
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Int -> ParsecT String () Identity Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '$' ParsecT String () Identity Char
-> ParsecT String () Identity Int -> ParsecT String () Identity Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> ParsecT String () Identity String
-> ParsecT String () Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit))
Parse a SQL string. Examples:
'basic string'
'string with '' a quote'
n'international text'
b'binary string'
x'hexidecimal string'
> sqlString :: Dialect -> Parser Token
> sqlString :: Dialect -> ParsecT String () Identity Token
sqlString d :: Dialect
d = ParsecT String () Identity Token
dollarString ParsecT String () Identity Token
-> ParsecT String () Identity Token
-> ParsecT String () Identity Token
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Token
csString ParsecT String () Identity Token
-> ParsecT String () Identity Token
-> ParsecT String () Identity Token
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Token
normalString
> where
> dollarString :: ParsecT String () Identity Token
dollarString = do
> Bool -> ParsecT String () Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT String () Identity ())
-> Bool -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Dialect -> Bool
diDollarString Dialect
d
>
>
> String
delim <- (\x :: String
x -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["$",String
x,"$"])
> ShowS
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '$' ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" ParsecT String () Identity String
identifierString ParsecT String () Identity String
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '$')
> String -> String -> String -> Token
SqlString String
delim String
delim (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String
-> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
delim)
> normalString :: ParsecT String () Identity Token
normalString = String -> String -> String -> Token
SqlString "'" "'" (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\'' ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> String -> ParsecT String () Identity String
normalStringSuffix Bool
False "")
> normalStringSuffix :: Bool -> String -> ParsecT String () Identity String
normalStringSuffix allowBackslash :: Bool
allowBackslash t :: String
t = do
> String
s <- (Char -> Bool) -> ParsecT String () Identity String
takeTill ((Char -> Bool) -> ParsecT String () Identity String)
-> (Char -> Bool) -> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ if Bool
allowBackslash
> then (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "'\\")
> else (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\'')
>
> [ParsecT String () Identity String]
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [do
> String
ctu <- [ParsecT String () Identity String]
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ["''" String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "''")
> ,"\\'" String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "\\'"
> ,"\\" String
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\\']
> Bool -> String -> ParsecT String () Identity String
normalStringSuffix Bool
allowBackslash (String -> ParsecT String () Identity String)
-> String -> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
t,String
s,String
ctu]
> ,[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
t,String
s] String
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\'']
>
>
>
>
>
>
>
>
> csString :: ParsecT String () Identity Token
csString
> | Dialect -> Bool
diEString Dialect
d =
> [ParsecT String () Identity Token]
-> ParsecT String () Identity Token
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [String -> String -> String -> Token
SqlString (String -> String -> String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity (String -> String -> Token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "e'" ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "E'")
> ParsecT String () Identity (String -> String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity (String -> Token)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> ParsecT String () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return "'" ParsecT String () Identity (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> String -> ParsecT String () Identity String
normalStringSuffix Bool
True ""
> ,ParsecT String () Identity Token
csString']
> | Bool
otherwise = ParsecT String () Identity Token
csString'
> csString' :: ParsecT String () Identity Token
csString' = String -> String -> String -> Token
SqlString
> (String -> String -> String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity (String -> String -> Token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String () Identity String
forall u. ParsecT String u Identity String
cs
> ParsecT String () Identity (String -> String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity (String -> Token)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> ParsecT String () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return "'"
> ParsecT String () Identity (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> String -> ParsecT String () Identity String
normalStringSuffix Bool
False ""
> csPrefixes :: String
csPrefixes = "nNbBxX"
> cs :: ParsecT String u Identity String
cs = [ParsecT String u Identity String]
-> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT String u Identity String]
-> ParsecT String u Identity String)
-> [ParsecT String u Identity String]
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ ((Char -> ParsecT String u Identity String)
-> String -> [ParsecT String u Identity String]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Char
x -> String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ([Char
x] String -> ShowS
forall a. [a] -> [a] -> [a]
++ "'")) String
csPrefixes)
> [ParsecT String u Identity String]
-> [ParsecT String u Identity String]
-> [ParsecT String u Identity String]
forall a. [a] -> [a] -> [a]
++ [String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "u&'"
> ,String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "U&'"]
numbers
digits
digits.[digits][e[+-]digits]
[digits].digits[e[+-]digits]
digitse[+-]digits
where digits is one or more decimal digits (0 through 9). At least one
digit must be before or after the decimal point, if one is used. At
least one digit must follow the exponent marker (e), if one is
present. There cannot be any spaces or other characters embedded in
the constant. Note that any leading plus or minus sign is not actually
considered part of the constant; it is an operator applied to the
constant.
> sqlNumber :: Dialect -> Parser Token
> sqlNumber :: Dialect -> ParsecT String () Identity Token
sqlNumber d :: Dialect
d =
> String -> Token
SqlNumber (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
completeNumber
>
> ParsecT String () Identity Token
-> ParsecT String () Identity ()
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [ParsecT String () Identity ()] -> ParsecT String () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [
> Bool -> ParsecT String () Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Dialect -> Bool
diPostgresSymbols Dialect
d)
> ParsecT String () Identity ()
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity String
-> ParsecT String () Identity ())
-> ParsecT String () Identity String
-> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT String () Identity String
-> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String
-> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "..")
> ParsecT String () Identity ()
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "eE."))
> ,ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "eE.")
> ]
> where
> completeNumber :: ParsecT String () Identity String
completeNumber =
> (ParsecT String () Identity String
forall u. ParsecT String u Identity String
int ParsecT String () Identity String
-> GenParser Char () ShowS -> ParsecT String () Identity String
forall t s a.
GenParser t s a -> GenParser t s (a -> a) -> GenParser t s a
<??> (ParsecT String () Identity String -> GenParser Char () ShowS
forall a.
ParsecT String () Identity [a]
-> ParsecT String () Identity ([a] -> [a])
pp ParsecT String () Identity String
forall u. ParsecT String u Identity String
dot GenParser Char () ShowS
-> GenParser Char () ShowS -> GenParser Char () ShowS
forall t s a.
GenParser t s (a -> a)
-> GenParser t s (a -> a) -> GenParser t s (a -> a)
<??.> ParsecT String () Identity String -> GenParser Char () ShowS
forall a.
ParsecT String () Identity [a]
-> ParsecT String () Identity ([a] -> [a])
pp ParsecT String () Identity String
forall u. ParsecT String u Identity String
int)
>
>
>
>
> ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (String -> ShowS)
-> ParsecT String () Identity String -> GenParser Char () ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
forall u. ParsecT String u Identity String
dot GenParser Char () ShowS
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity String
forall u. ParsecT String u Identity String
int))
> ParsecT String () Identity String
-> GenParser Char () ShowS -> ParsecT String () Identity String
forall t s a.
GenParser t s a -> GenParser t s (a -> a) -> GenParser t s a
<??> ParsecT String () Identity String -> GenParser Char () ShowS
forall a.
ParsecT String () Identity [a]
-> ParsecT String () Identity ([a] -> [a])
pp ParsecT String () Identity String
forall u. ParsecT String u Identity String
expon
> int :: ParsecT String u Identity String
int = ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
>
>
>
> dot :: ParsecT String u Identity String
dot = let p :: ParsecT String u Identity String
p = String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "." ParsecT String u Identity String
-> ParsecT String u Identity () -> ParsecT String u Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '.')
> in if Dialect -> Bool
diPostgresSymbols Dialect
d
> then ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String u Identity String
forall u. ParsecT String u Identity String
p
> else ParsecT String u Identity String
forall u. ParsecT String u Identity String
p
> expon :: ParsecT String u Identity String
expon = (:) (Char -> ShowS)
-> ParsecT String u Identity Char
-> ParsecT String u Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "eE" ParsecT String u Identity ShowS
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String u Identity String
forall u. ParsecT String u Identity String
sInt
> sInt :: ParsecT String u Identity String
sInt = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (String -> ShowS)
-> ParsecT String u Identity String
-> ParsecT String u Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "+" ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "-") ParsecT String u Identity ShowS
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String u Identity String
forall u. ParsecT String u Identity String
int
> pp :: ParsecT String () Identity [a]
-> ParsecT String () Identity ([a] -> [a])
pp = (ParsecT String () Identity [a]
-> ([a] -> [a] -> [a]) -> ParsecT String () Identity ([a] -> [a])
forall (f :: * -> *) b a c.
Applicative f =>
f b -> (a -> b -> c) -> f (a -> c)
<$$> [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++))
Symbols
A symbol is an operator, or one of the misc symbols which include:
. .. := : :: ( ) ? ; , { } (for odbc)
The postgresql operator syntax allows a huge range of operators
compared with ansi and other dialects
> symbol :: Dialect -> Parser Token
> symbol :: Dialect -> ParsecT String () Identity Token
symbol d :: Dialect
d = String -> Token
Symbol (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT String () Identity String]
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([[ParsecT String () Identity String]]
-> [ParsecT String () Identity String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
> [[ParsecT String () Identity String]
forall u. [ParsecT String u Identity String]
dots
> ,if Dialect -> Bool
diPostgresSymbols Dialect
d
> then [ParsecT String () Identity String]
forall u. [ParsecT String u Identity String]
postgresExtraSymbols
> else []
> ,[ParsecT String () Identity String]
forall u. [ParsecT String u Identity String]
miscSymbol
> ,if Dialect -> Bool
diOdbc Dialect
d then [ParsecT String () Identity String]
forall u. [ParsecT String u Identity String]
odbcSymbol else []
> ,if Dialect -> Bool
diPostgresSymbols Dialect
d
> then [ParsecT String () Identity String]
generalizedPostgresqlOperator
> else [ParsecT String () Identity String]
forall u. [ParsecT String u Identity String]
basicAnsiOps
> ])
> where
> dots :: [ParsecT String u Identity String]
dots = [ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '.')]
> odbcSymbol :: [ParsecT String u Identity String]
odbcSymbol = [String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "{", String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "}"]
> postgresExtraSymbols :: [ParsecT String u Identity String]
postgresExtraSymbols =
> [ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ":=")
>
> ,ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "::" ParsecT String u Identity String
-> ParsecT String u Identity () -> ParsecT String u Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':'))
> ,ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ":" ParsecT String u Identity String
-> ParsecT String u Identity () -> ParsecT String u Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':'))]
> miscSymbol :: [ParsecT String u Identity String]
miscSymbol = (Char -> ParsecT String u Identity String)
-> String -> [ParsecT String u Identity String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (String -> ParsecT String u Identity String)
-> (Char -> String) -> Char -> ParsecT String u Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ShowS
forall a. a -> [a] -> [a]
:[])) (String -> [ParsecT String u Identity String])
-> String -> [ParsecT String u Identity String]
forall a b. (a -> b) -> a -> b
$
> case () of
> _ | Dialect -> Bool
diSqlServerSymbols Dialect
d -> ",;():?"
> | Dialect -> Bool
diPostgresSymbols Dialect
d -> "[],;()"
> | Bool
otherwise -> "[],;():?"
try is used because most of the first characters of the two character
symbols can also be part of a single character symbol
> basicAnsiOps :: [ParsecT String u Identity String]
basicAnsiOps = (String -> ParsecT String u Identity String)
-> [String] -> [ParsecT String u Identity String]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String u Identity String
-> ParsecT String u Identity String)
-> (String -> ParsecT String u Identity String)
-> String
-> ParsecT String u Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string) [">=","<=","!=","<>"]
> [ParsecT String u Identity String]
-> [ParsecT String u Identity String]
-> [ParsecT String u Identity String]
forall a. [a] -> [a] -> [a]
++ (Char -> ParsecT String u Identity String)
-> String -> [ParsecT String u Identity String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (String -> ParsecT String u Identity String)
-> (Char -> String) -> Char -> ParsecT String u Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ShowS
forall a. a -> [a] -> [a]
:[])) "+-^*/%~&<>="
> [ParsecT String u Identity String]
-> [ParsecT String u Identity String]
-> [ParsecT String u Identity String]
forall a. [a] -> [a] -> [a]
++ [ParsecT String u Identity String]
forall u. [ParsecT String u Identity String]
pipes
> pipes :: [ParsecT String u Identity String]
pipes =
>
>
> [Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '|' ParsecT String u Identity Char
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
> [ParsecT String u Identity String]
-> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ["||" String
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '|' ParsecT String u Identity String
-> ParsecT String u Identity () -> ParsecT String u Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '|')
> ,String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return "|"]]
postgresql generalized operators
this includes the custom operators that postgres supports,
plus all the standard operators which could be custom operators
according to their grammar
rules
An operator name is a sequence of up to NAMEDATALEN-1 (63 by default) characters from the following list:
+ - * / < > = ~ ! @ # % ^ & | ` ?
There are a few restrictions on operator names, however:
A multiple-character operator name cannot end in + or -, unless the name also contains at least one of these characters:
~ ! @ # % ^ & | ` ?
which allows the last character of a multi character symbol to be + or
-
> generalizedPostgresqlOperator :: [Parser String]
> generalizedPostgresqlOperator :: [ParsecT String () Identity String]
generalizedPostgresqlOperator = [ParsecT String () Identity String
forall u. ParsecT String u Identity String
singlePlusMinus,ParsecT String () Identity String
forall u. ParsecT String u Identity String
opMoreChars]
> where
> allOpSymbols :: String
allOpSymbols = "+-*/<>=~!@#%^&|`?"
>
>
> exceptionOpSymbols :: String
exceptionOpSymbols = "~!@#%^&|`?"
>
> singlePlusMinus :: ParsecT String u Identity String
singlePlusMinus = ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String u Identity String
-> ParsecT String u Identity String)
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ do
> Char
c <- String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "+-"
> ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (ParsecT String u Identity Char -> ParsecT String u Identity ())
-> ParsecT String u Identity Char -> ParsecT String u Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
allOpSymbols
> String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c]
>
>
>
> moreOpCharsException :: ParsecT String u Identity String
moreOpCharsException = do
> Char
c <- String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` "-/*") String
allOpSymbols)
>
>
> ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '*'))
> ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '-' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '-'))
>
>
> ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '*' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/'))
> (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:) ShowS
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT String u Identity String
moreOpCharsException
> opMoreChars :: ParsecT String u Identity String
opMoreChars = [ParsecT String u Identity String]
-> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
> [
> (:)
> (Char -> ShowS)
-> ParsecT String u Identity Char
-> ParsecT String u Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
exceptionOpSymbols
> ParsecT String u Identity ShowS
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT String u Identity String
forall u. ParsecT String u Identity String
moreOpCharsException
> ,(:)
> (Char -> ShowS)
-> ParsecT String u Identity Char
-> ParsecT String u Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (
> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '+' ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
allOpSymbols))
> ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
>
> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '-'
> ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '-')
> ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
allOpSymbols))
> ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '*'))
> ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '*' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/'))
> ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
> String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "<>=")
> ParsecT String u Identity ShowS
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT String u Identity String
opMoreChars
> ]
> sqlWhitespace :: Dialect -> Parser Token
> sqlWhitespace :: Dialect -> ParsecT String () Identity Token
sqlWhitespace _ = String -> Token
Whitespace (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSpace)
> lineComment :: Dialect -> Parser Token
> _ =
> (\s :: String
s -> String -> Token
LineComment (String -> Token) -> String -> Token
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["--",String
s]) (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
>
>
> (ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "--") ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (
>
> String -> Maybe String -> String
forall a. [a] -> Maybe [a] -> [a]
conc (String -> Maybe String -> String)
-> ParsecT String () Identity String
-> ParsecT String () Identity (Maybe String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity (Maybe String)
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT String () Identity (Maybe String)
-> ParsecT String () Identity (Maybe String)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT String () Identity (Maybe String)
forall u. ParsecT String u Identity (Maybe String)
lineCommentEnd) ParsecT String () Identity (Maybe String -> String)
-> ParsecT String () Identity (Maybe String)
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity (Maybe String)
forall u. ParsecT String u Identity (Maybe String)
lineCommentEnd))
> where
> conc :: [a] -> Maybe [a] -> [a]
conc a :: [a]
a Nothing = [a]
a
> conc a :: [a]
a (Just b :: [a]
b) = [a]
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
b
> lineCommentEnd :: ParsecT String u Identity (Maybe String)
lineCommentEnd =
> String -> Maybe String
forall a. a -> Maybe a
Just "\n" Maybe String
-> ParsecT String u Identity Char
-> ParsecT String u Identity (Maybe String)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\n'
> ParsecT String u Identity (Maybe String)
-> ParsecT String u Identity (Maybe String)
-> ParsecT String u Identity (Maybe String)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe String
forall a. Maybe a
Nothing Maybe String
-> ParsecT String u Identity ()
-> ParsecT String u Identity (Maybe String)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT String u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
Try is used in the block comment for the two symbol bits because we
want to backtrack if we read the first symbol but the second symbol
isn't there.
> blockComment :: Dialect -> Parser Token
> _ =
> (\s :: String
s -> String -> Token
BlockComment (String -> Token) -> String -> Token
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["/*",String
s]) (String -> Token)
-> ParsecT String () Identity String
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
> (ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "/*") ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ParsecT String () Identity String
commentSuffix 0)
> where
> commentSuffix :: Int -> Parser String
> commentSuffix :: Int -> ParsecT String () Identity String
commentSuffix n :: Int
n = do
>
> String
x <- (Char -> Bool) -> ParsecT String () Identity String
takeWhile (\e :: Char
e -> Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '/' Bool -> Bool -> Bool
&& Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '*')
> [ParsecT String () Identity String]
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [
>
> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "*/") ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> let t :: String
t = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
x,"*/"]
> in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
> then String -> ParsecT String () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
t
> else (\s :: String
s -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
t,String
s]) ShowS
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT String () Identity String
commentSuffix (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
>
> ,ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "/*") ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((\s :: String
s -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
x,"/*",String
s]) ShowS
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT String () Identity String
commentSuffix (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1))
>
> ,(\c :: Char
c s :: String
s -> String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
c] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s) (Char -> ShowS)
-> ParsecT String () Identity Char -> GenParser Char () ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar GenParser Char () ShowS
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ParsecT String () Identity String
commentSuffix Int
n]
This is to improve user experience: provide an error if we see */
outside a comment. This could potentially break postgres ops with */
in them (which is a stupid thing to do). In other cases, the user
should write * / instead (I can't think of any cases when this would
be valid syntax though).
> dontParseEndBlockComment :: Dialect -> Parser Token
> _ =
>
> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "*/") ParsecT String () Identity String
-> ParsecT String () Identity Token
-> ParsecT String () Identity Token
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT String () Identity Token
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "comment end without comment start"
Some helper combinators
> startsWith :: (Char -> Bool) -> (Char -> Bool) -> Parser String
> startsWith :: (Char -> Bool)
-> (Char -> Bool) -> ParsecT String () Identity String
startsWith p :: Char -> Bool
p ps :: Char -> Bool
ps = do
> Char
c <- (Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
p
> [ParsecT String () Identity String]
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [(:) Char
c ShowS
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Char -> Bool) -> ParsecT String () Identity String
takeWhile1 Char -> Bool
ps)
> ,String -> ParsecT String () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c]]
> takeWhile1 :: (Char -> Bool) -> Parser String
> takeWhile1 :: (Char -> Bool) -> ParsecT String () Identity String
takeWhile1 p :: Char -> Bool
p = ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
p)
> takeWhile :: (Char -> Bool) -> Parser String
> takeWhile :: (Char -> Bool) -> ParsecT String () Identity String
takeWhile p :: Char -> Bool
p = ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
p)
> takeTill :: (Char -> Bool) -> Parser String
> takeTill :: (Char -> Bool) -> ParsecT String () Identity String
takeTill p :: Char -> Bool
p = ParsecT String () Identity Char
-> ParsecT String () Identity ()
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ((Char -> Bool) -> ParsecT String () Identity ()
peekSatisfy Char -> Bool
p)
> peekSatisfy :: (Char -> Bool) -> Parser ()
> peekSatisfy :: (Char -> Bool) -> ParsecT String () Identity ()
peekSatisfy p :: Char -> Bool
p = ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ((Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
p)
This utility function will accurately report if the two tokens are
pretty printed, if they should lex back to the same two tokens. This
function is used in testing (and can be used in other places), and
must not be implemented by actually trying to print both tokens and
then lex them back from a single string (because then we would have
the risk of thinking two tokens cannot be together when there is bug
in the lexer, which the testing is supposed to find).
maybe do some quick checking to make sure this function only gives
true negatives: check pairs which return false actually fail to lex or
give different symbols in return: could use quickcheck for this
a good sanity test for this function is to change it to always return
true, then check that the automated tests return the same number of
successes. I don't think it succeeds this test at the moment
>
>
>
> tokenListWillPrintAndLex :: Dialect -> [Token] -> Bool
> tokenListWillPrintAndLex :: Dialect -> [Token] -> Bool
tokenListWillPrintAndLex _ [] = Bool
True
> tokenListWillPrintAndLex _ [_] = Bool
True
> tokenListWillPrintAndLex d :: Dialect
d (a :: Token
a:b :: Token
b:xs :: [Token]
xs) =
> Dialect -> Token -> Token -> Bool
tokensWillPrintAndLex Dialect
d Token
a Token
b Bool -> Bool -> Bool
&& Dialect -> [Token] -> Bool
tokenListWillPrintAndLex Dialect
d (Token
bToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
xs)
> tokensWillPrintAndLex :: Dialect -> Token -> Token -> Bool
> tokensWillPrintAndLex :: Dialect -> Token -> Token -> Bool
tokensWillPrintAndLex d :: Dialect
d a :: Token
a b :: Token
b
a : followed by an identifier character will look like a host param
followed by = or : makes a different symbol
> | Symbol ":" <- Token
a
> , (Char -> Bool) -> Bool
checkFirstBChar (\x :: Char
x -> Char -> Bool
isIdentifierChar Char
x Bool -> Bool -> Bool
|| Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ":=") = Bool
False
two symbols next to eachother will fail if the symbols can combine and
(possibly just the prefix) look like a different symbol
> | Dialect -> Bool
diPostgresSymbols Dialect
d
> , Symbol a' :: String
a' <- Token
a
> , Symbol b' :: String
b' <- Token
b
> , String
b' String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ["+", "-"] Bool -> Bool -> Bool
|| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ((Char -> Bool) -> String -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
a') "~!@#%^&|`?") = Bool
False
check two adjacent symbols in non postgres where the combination
possibilities are much more limited. This is ansi behaviour, it might
be different when the other dialects are done properly
> | Symbol a' :: String
a' <- Token
a
> , Symbol b' :: String
b' <- Token
b
> , (String
a',String
b') (String, String) -> [(String, String)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [("<",">")
> ,("<","=")
> ,(">","=")
> ,("!","=")
> ,("|","|")
> ,("||","|")
> ,("|","||")
> ,("||","||")
> ,("<",">=")
> ] = Bool
False
two whitespaces will be combined
> | Whitespace {} <- Token
a
> , Whitespace {} <- Token
b = Bool
False
line comment without a newline at the end will eat the next token
> | LineComment {} <- Token
a
> , (Char -> Bool) -> Bool
checkLastAChar (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='\n') = Bool
False
check the last character of the first token and the first character of
the second token forming a comment start or end symbol
> | let f :: Char -> Char -> Bool
f '-' '-' = Bool
True
> f '/' '*' = Bool
True
> f '*' '/' = Bool
True
> f _ _ = Bool
False
> in (Char -> Char -> Bool) -> Bool
checkBorderChars Char -> Char -> Bool
f = Bool
False
a symbol will absorb a following .
TODO: not 100% on this always being bad
> | Symbol {} <- Token
a
> , (Char -> Bool) -> Bool
checkFirstBChar (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='.') = Bool
False
cannot follow a symbol ending in : with another token starting with :
> | let f :: Char -> Char -> Bool
f ':' ':' = Bool
True
> f _ _ = Bool
False
> in (Char -> Char -> Bool) -> Bool
checkBorderChars Char -> Char -> Bool
f = Bool
False
unquoted identifier followed by an identifier letter
> | Identifier Nothing _ <- Token
a
> , (Char -> Bool) -> Bool
checkFirstBChar Char -> Bool
isIdentifierChar = Bool
False
a quoted identifier using ", followed by a " will fail
> | Identifier (Just (_,"\"")) _ <- Token
a
> , (Char -> Bool) -> Bool
checkFirstBChar (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='"') = Bool
False
prefixed variable followed by an identifier char will be absorbed
> | PrefixedVariable {} <- Token
a
> , (Char -> Bool) -> Bool
checkFirstBChar Char -> Bool
isIdentifierChar = Bool
False
a positional arg will absorb a following digit
> | PositionalArg {} <- Token
a
> , (Char -> Bool) -> Bool
checkFirstBChar Char -> Bool
isDigit = Bool
False
a string ending with ' followed by a token starting with ' will be absorbed
> | SqlString _ "'" _ <- Token
a
> , (Char -> Bool) -> Bool
checkFirstBChar (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='\'') = Bool
False
a number followed by a . will fail or be absorbed
> | SqlNumber {} <- Token
a
> , (Char -> Bool) -> Bool
checkFirstBChar (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='.') = Bool
False
a number followed by an e or E will fail or be absorbed
> | SqlNumber {} <- Token
a
> , (Char -> Bool) -> Bool
checkFirstBChar (\x :: Char
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='e' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'E') = Bool
False
two numbers next to eachother will fail or be absorbed
> | SqlNumber {} <- Token
a
> , SqlNumber {} <- Token
b = Bool
False
> | Bool
otherwise = Bool
True
> where
> prettya :: String
prettya = Dialect -> Token -> String
prettyToken Dialect
d Token
a
> prettyb :: String
prettyb = Dialect -> Token -> String
prettyToken Dialect
d Token
b
>
>
>
> checkBorderChars :: (Char -> Char -> Bool) -> Bool
checkBorderChars f :: Char -> Char -> Bool
f
> | (_:_) <- String
prettya
> , (fb :: Char
fb:_) <- String
prettyb
> , Char
la <- String -> Char
forall a. [a] -> a
last String
prettya
> = Char -> Char -> Bool
f Char
la Char
fb
> checkBorderChars _ = Bool
False
> checkFirstBChar :: (Char -> Bool) -> Bool
checkFirstBChar f :: Char -> Bool
f = case String
prettyb of
> (b' :: Char
b':_) -> Char -> Bool
f Char
b'
> _ -> Bool
False
> checkLastAChar :: (Char -> Bool) -> Bool
checkLastAChar f :: Char -> Bool
f = case String
prettya of
> (_:_) -> Char -> Bool
f (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Char
forall a. [a] -> a
last String
prettya
> _ -> Bool
False
TODO:
make the tokenswill print more dialect accurate. Maybe add symbol
chars and identifier chars to the dialect definition and use them from
here
start adding negative / different parse dialect tests
add token tables and tests for oracle, sql server
review existing tables
look for refactoring opportunities, especially the token
generation tables in the tests
do some user documentation on lexing, and lexing/dialects
start thinking about a more separated design for the dialect handling
lexing tests are starting to take a really long time, so split the
tests so it is much easier to run all the tests except the lexing
tests which only need to be run when working on the lexer (which
should be relatively uncommon), or doing a commit or finishing off a
series of commits,
start writing the error message tests:
generate/write a large number of syntax errors
create a table with the source and the error message
try to compare some different versions of code to compare the
quality of the error messages by hand
get this checked in so improvements and regressions in the error
message quality can be tracked a little more easily (although it will
still be manual)
try again to add annotation to the ast