hssqlppp-0.6.2: SQL parser and type checker

Safe HaskellSafe
LanguageHaskell2010

Database.HsSqlPpp.Lex

Synopsis

Documentation

data Token Source #

Represents a lexed token

Constructors

Symbol String

a symbol in postgresql dialect is one of the following:

  • one of the characters (),;[]{} (the {} is for odbc)
  • '..' or ':=' or '.' or ':'
  • a compound symbol, which starts with one of '*/<>=~!@%^&|`?'

things that are not lexed as symbols:

  • [] used in quoted identifiers, prefix @,#,: used in identifiers
  • $n positional arg
Identifier (Maybe (String, String)) String

This is an identifier or keyword.

The 'Maybe (Char,Char)' selects the quoted style - Nothing means the identifier was unquoted otherwise the two characters are the start and end quote.

'"' is used to quote identifiers in standard sql, sql server also uses [brackets] to quote identifiers.

The identifier also includes the 'variable marker prefix' used in sql server (e.g. @identifier, #identifier), and oracle (e.g. :identifier)

PrefixedVariable Char String 
PositionalArg Int

a postgresql positional arg, e.g. $1

SqlString String String String

This is a string literal.

The first field is the quotes used: single quote (') for normal strings, E' for escape supporting strings, and $$ delimiter for postgresql dollar quoted strings.

The lexer doesn't process the escapes in strings, but passes on the literal source e.g. E'\n' parses to SqlString "E'" "\n" with the literal characters '\' and 'n' in the string, not a newline character. quotes within a string ('') or escaped string ('' or \') are passed through unchanged

SqlNumber String

a number literal (integral or otherwise), stored in original format unchanged

Whitespace String

non-significant whitespace (space, tab, newline) (strictly speaking, it is up to the client to decide whether the whitespace is significant or not)

LineComment String

a commented line using --, contains every character starting with the '--' and including the terminating newline character if there is one - this will be missing if the last line in the source is a line comment with no trailing newline

BlockComment String

a block comment, /* stuff */, includes the comment delimiters

Splice Char String

an antiquotation splice, e.g. $x(stuff)

CopyPayload String

the copy data in a copy from stdin

Instances
Eq Token Source # 
Instance details

Defined in Database.HsSqlPpp.Internals.LexInternal

Methods

(==) :: Token -> Token -> Bool #

(/=) :: Token -> Token -> Bool #

Show Token Source # 
Instance details

Defined in Database.HsSqlPpp.Internals.LexInternal

Methods

showsPrec :: Int -> Token -> ShowS #

show :: Token -> String #

showList :: [Token] -> ShowS #

prettyToken :: Dialect -> Token -> String Source #

Accurate pretty printing, if you lex a bunch of tokens, then pretty print them, should should get back exactly the same string

lexToken :: Dialect -> Parser ((FilePath, Int, Int), Token) Source #

parser for a sql token

data Dialect Source #

Instances
Eq Dialect Source # 
Instance details

Defined in Database.HsSqlPpp.Internals.Dialect

Methods

(==) :: Dialect -> Dialect -> Bool #

(/=) :: Dialect -> Dialect -> Bool #

Data Dialect Source # 
Instance details

Defined in Database.HsSqlPpp.Internals.Dialect

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Dialect -> c Dialect #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Dialect #

toConstr :: Dialect -> Constr #

dataTypeOf :: Dialect -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Dialect) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dialect) #

gmapT :: (forall b. Data b => b -> b) -> Dialect -> Dialect #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Dialect -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Dialect -> r #

gmapQ :: (forall d. Data d => d -> u) -> Dialect -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Dialect -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Dialect -> m Dialect #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Dialect -> m Dialect #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Dialect -> m Dialect #

Show Dialect Source # 
Instance details

Defined in Database.HsSqlPpp.Internals.Dialect