diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index 7958351..e99090a 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -10,13 +10,19 @@ swap order in select items > ,parseQueryExprs > ,ParseError(..)) where -> import Control.Monad.Identity -> import Control.Applicative hiding (many, (<|>), optional) -> import Data.Maybe -> import Data.Char -> import Text.Parsec hiding (ParseError) -> import qualified Text.Parsec as P -> import Text.Parsec.Perm +> import Control.Monad.Identity (Identity) +> import Control.Monad (guard, void) +> import Control.Applicative ((<$), (<$>), (<*>) ,(<*), (*>)) +> import Data.Maybe (fromMaybe,catMaybes) +> import Data.Char (toLower) +> import Text.Parsec (errorPos,sourceLine,sourceColumn,sourceName +> ,setPosition,setSourceColumn,setSourceLine,getPosition +> ,option,between,sepBy,sepBy1,string,manyTill,anyChar +> ,try,string,many1,oneOf,digit,(<|>),choice,char,eof +> ,optionMaybe,optional,many,letter,alphaNum,parse) +> import Text.Parsec.String (Parser) +> import qualified Text.Parsec as P (ParseError) +> import Text.Parsec.Perm (permute,(<$?>), (<|?>)) > import qualified Text.Parsec.Expr as E > import Language.SQL.SimpleSQL.Syntax @@ -61,7 +67,7 @@ automatically skips leading whitespace checks the parser parses all the input using eof converts the error return to the nice wrapper -> wrapParse :: P a +> wrapParse :: Parser a > -> FilePath > -> Maybe (Int,Int) > -> String @@ -85,18 +91,16 @@ converts the error return to the nice wrapper ------------------------------------------------ -> type P a = ParsecT String () Identity a - = value expressions == literals See the stringLiteral lexer below for notes on string literal syntax. -> estring :: P ValueExpr +> estring :: Parser ValueExpr > estring = StringLit <$> stringLiteral -> number :: P ValueExpr +> number :: Parser ValueExpr > number = NumLit <$> numberLiteral parse SQL interval literals, something like @@ -108,14 +112,14 @@ wrap the whole lot in try, in case we get something like this: interval '3 days' which parses as a typed literal -> interval :: P ValueExpr +> interval :: Parser ValueExpr > interval = try (keyword_ "interval" >> > IntervalLit > <$> stringLiteral > <*> identifierString > <*> optionMaybe (try $ parens integerLiteral)) -> literal :: P ValueExpr +> literal :: Parser ValueExpr > literal = number <|> estring <|> interval == identifiers @@ -123,11 +127,11 @@ which parses as a typed literal Uses the identifierString 'lexer'. See this function for notes on identifiers. -> name :: P Name +> name :: Parser Name > name = choice [QName <$> quotedIdentifier > ,Name <$> identifierString] -> identifier :: P ValueExpr +> identifier :: Parser ValueExpr > identifier = Iden <$> name == star @@ -137,14 +141,14 @@ places as well. Because it is quite general, the parser doesn't attempt to check that the star is in a valid context, it parses it OK in any value expression context. -> star :: P ValueExpr +> star :: Parser ValueExpr > star = Star <$ symbol "*" == parameter use in e.g. select * from t where a = ? -> parameter :: P ValueExpr +> parameter :: Parser ValueExpr > parameter = Parameter <$ symbol "?" == function application, aggregates and windows @@ -157,7 +161,7 @@ The parsing for the aggregate extensions is here as well: aggregate([all|distinct] args [order by orderitems]) -> aggOrApp :: P ValueExpr +> aggOrApp :: Parser ValueExpr > aggOrApp = > makeApp > <$> name @@ -168,7 +172,7 @@ aggregate([all|distinct] args [order by orderitems]) > makeApp i (Nothing,es,Nothing) = App i es > makeApp i (d,es,od) = AggregateApp i d es (fromMaybe [] od) -> duplicates :: P (Maybe SetQuantifier) +> duplicates :: Parser (Maybe SetQuantifier) > duplicates = optionMaybe $ try $ > choice [All <$ keyword_ "all" > ,Distinct <$ keyword "distinct"] @@ -183,7 +187,7 @@ The convention in this file is that the 'Suffix', erm, suffix on parser names means that they have been left factored. These are almost always used with the optionSuffix combinator. -> windowSuffix :: ValueExpr -> P ValueExpr +> windowSuffix :: ValueExpr -> Parser ValueExpr > windowSuffix (App f es) = > try (keyword_ "over") > *> parens (WindowApp f es @@ -220,12 +224,12 @@ always used with the optionSuffix combinator. > mkFrame rs c = c rs > windowSuffix _ = fail "" -> app :: P ValueExpr +> app :: Parser ValueExpr > app = aggOrApp >>= optionSuffix windowSuffix == case expression -> scase :: P ValueExpr +> scase :: Parser ValueExpr > scase = > Case <$> (try (keyword_ "case") *> optionMaybe (try valueExpr)) > <*> many1 swhen @@ -245,7 +249,7 @@ to separate the arguments. cast: cast(expr as type) -> cast :: P ValueExpr +> cast :: Parser ValueExpr > cast = parensCast <|> prefixCast > where > parensCast = try (keyword_ "cast") >> @@ -266,7 +270,7 @@ operatorname(firstArg keyword0 arg0 keyword1 arg1 etc.) > -> SpecialOpKFirstArg -- has a first arg without a keyword > -> [(String,Bool)] -- the other args with their keywords > -- and whether they are optional -> -> P ValueExpr +> -> Parser ValueExpr > specialOpK opName firstArg kws = > keyword_ opName >> do > void $ symbol "(" @@ -312,31 +316,31 @@ TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ] target_string [COLLATE collation_name] ) -> specialOpKs :: P ValueExpr +> specialOpKs :: Parser ValueExpr > specialOpKs = choice $ map try > [extract, position, substring, convert, translate, overlay, trim] -> extract :: P ValueExpr +> extract :: Parser ValueExpr > extract = specialOpK "extract" SOKMandatory [("from", True)] -> position :: P ValueExpr +> position :: Parser ValueExpr > position = specialOpK "position" SOKMandatory [("in", True)] strictly speaking, the substring must have at least one of from and for, but the parser doens't enforce this -> substring :: P ValueExpr +> substring :: Parser ValueExpr > substring = specialOpK "substring" SOKMandatory > [("from", False),("for", False),("collate", False)] -> convert :: P ValueExpr +> convert :: Parser ValueExpr > convert = specialOpK "convert" SOKMandatory [("using", True)] -> translate :: P ValueExpr +> translate :: Parser ValueExpr > translate = specialOpK "translate" SOKMandatory [("using", True)] -> overlay :: P ValueExpr +> overlay :: Parser ValueExpr > overlay = specialOpK "overlay" SOKMandatory > [("placing", True),("from", True),("for", False)] @@ -344,7 +348,7 @@ trim is too different because of the optional char, so a custom parser the both ' ' is filled in as the default if either parts are missing in the source -> trim :: P ValueExpr +> trim :: Parser ValueExpr > trim = > keyword "trim" >> > parens (mkTrim @@ -368,7 +372,7 @@ a in (queryexpr) this is parsed as a postfix operator which is why it is in this form -> inSuffix :: P (ValueExpr -> ValueExpr) +> inSuffix :: Parser (ValueExpr -> ValueExpr) > inSuffix = > mkIn <$> inty > <*> parens (choice @@ -393,7 +397,7 @@ parsing' is used to create alternative value expression parser which is identical to the normal one expect it doesn't recognise the binary and operator. This is the call to valueExprB. -> betweenSuffix :: P (ValueExpr -> ValueExpr) +> betweenSuffix :: Parser (ValueExpr -> ValueExpr) > betweenSuffix = > makeOp <$> (Name <$> opName) > <*> valueExprB @@ -407,7 +411,7 @@ and operator. This is the call to valueExprB. subquery expression: [exists|all|any|some] (queryexpr) -> subquery :: P ValueExpr +> subquery :: Parser ValueExpr > subquery = > choice > [try $ SubQueryExpr SqSq <$> parens queryExpr @@ -422,7 +426,7 @@ subquery expression: typename: used in casts. Special cases for the multi keyword typenames that SQL supports. -> typeName :: P TypeName +> typeName :: Parser TypeName > typeName = choice (multiWordParsers > ++ [TypeName <$> identifierString]) > >>= optionSuffix precision @@ -449,7 +453,7 @@ that SQL supports. todo: timestamp types: | TIME [