packages feed

simple-sql-parser 0.5.0 → 0.6.0

raw patch · 16 files changed

+664/−560 lines, 16 files

Files

Language/SQL/SimpleSQL/Combinators.lhs view
@@ -15,10 +15,9 @@ >     ,(<$$$$$>) >     ) where -> import Control.Applicative ((<$>), (<*>), (<**>), pure, Applicative)+> import Control.Applicative ((<**>)) > import Text.Parsec (option,many) > import Text.Parsec.String (GenParser)-  a possible issue with the option suffix is that it enforces left associativity when chaining it recursively. Have to review
Language/SQL/SimpleSQL/Dialect.lhs view
@@ -4,8 +4,7 @@  > {-# LANGUAGE DeriveDataTypeable #-} > module Language.SQL.SimpleSQL.Dialect->     (SyntaxFlavour(..)->     ,Dialect(..)+>     (Dialect(..) >     ,ansi2011 >     ,mysql >     ,postgres@@ -15,40 +14,527 @@  > import Data.Data --hack for now, later will expand to flags on a feature by feature basis--> data SyntaxFlavour = ANSI2011->                    | MySQL->                    | Postgres->                    | Oracle->                    | SQLServer->                      deriving (Eq,Show,Read,Data,Typeable)- > -- | Used to set the dialect used for parsing and pretty printing, > -- very unfinished at the moment.-> data Dialect = Dialect {diSyntaxFlavour :: SyntaxFlavour->                        ,allowOdbc :: Bool}+> --+> -- The keyword handling works as follows:+> --+> -- There is a list of reserved keywords. These will never parse as+> -- anything other than as a keyword, unless they are in one of the+> -- other lists.+> --+> -- There is a list of \'identifier\' keywords. These are reserved+> -- keywords, with an exception that they will parse as an+> -- identifier in a scalar expression. They won't parse as+> -- identifiers in other places, e.g. column names or aliases.+> --+> -- There is a list of \'app\' keywords. These are reserved keywords,+> -- with an exception that they will also parse in an \'app-like\'+> -- construct - a regular function call, or any of the aggregate and+> -- window variations.+> --+> -- There is a list of special type names. This list serves two+> -- purposes - it is a list of the reserved keywords which are also+> -- type names, and it is a list of all the multi word type names.+> --+> -- Every keyword should appear in the keywords lists, and then you can+> -- add them to the other lists if you want exceptions. Most things+> -- that refer to functions, types or variables that are keywords in+> -- the ansi standard, can be removed from the keywords lists+> -- completely with little effect. With most of the actual SQL+> -- keywords, removing them from the keyword list will result in+> -- lots of valid syntax no longer parsing (and probably bad parse+> -- error messages too).+> --+> -- In the code, all special syntax which looks identical to regular+> -- identifiers or function calls (apart from the name), is treated+> -- like a regular identifier or function call.+> --+> -- It's easy to break the parser by removing the wrong words from+> -- the keywords list or adding the wrong words to the other lists.+>+> data Dialect = Dialect+>     { -- | reserved keywords+>      diKeywords :: [String]+>       -- | keywords with identifier exception+>     ,diIdentifierKeywords :: [String]+>       -- | keywords with app exception+>     ,diAppKeywords :: [String]+>      -- | keywords with type exception plus all the type names which+>      -- are multiple words+>     ,diSpecialTypeNames :: [String]+>      -- | allow ansi fetch first syntax+>     ,diFetchFirst :: Bool+>      -- | allow limit keyword (mysql, postgres,+>      -- ...)+>     ,diLimit :: Bool+>      -- | allow parsing ODBC syntax+>     ,diOdbc :: Bool+>      -- | allow quoting identifiers with \`backquotes\`+>     ,diBackquotedIden :: Bool+>      -- | allow quoting identifiers with [square brackets]+>     ,diSquareBracketQuotedIden :: Bool+>      -- | allow identifiers with a leading at @example+>     ,diAtIdentifier :: Bool+>      -- | allow identifiers with a leading \# \#example+>     ,diHashIdentifier :: Bool+>      -- | allow positional identifiers like this: $1 +>     ,diPositionalArg :: Bool+>      -- | allow postgres style dollar strings+>     ,diDollarString :: Bool+>      -- | allow strings with an e - e"example"+>     ,diEString :: Bool+>      -- | allow postgres style symbols+>     ,diPostgresSymbols :: Bool+>      -- | allow sql server style symbols+>     ,diSqlServerSymbols :: Bool+>     } >                deriving (Eq,Show,Read,Data,Typeable)  > -- | ansi sql 2011 dialect > ansi2011 :: Dialect-> ansi2011 = Dialect ANSI2011 False+> ansi2011 = Dialect {diKeywords = ansi2011ReservedKeywords+>                    ,diIdentifierKeywords = []+>                    ,diAppKeywords = ["set"]+>                    ,diSpecialTypeNames = ansi2011TypeNames+>                    ,diFetchFirst = True+>                    ,diLimit = False+>                    ,diOdbc = False+>                    ,diBackquotedIden = False+>                    ,diSquareBracketQuotedIden = False+>                    ,diAtIdentifier = False+>                    ,diHashIdentifier = False+>                    ,diPositionalArg = False+>                    ,diDollarString = False+>                    ,diEString = False+>                    ,diPostgresSymbols = False+>                    ,diSqlServerSymbols = False+>                    }  > -- | mysql dialect > mysql :: Dialect-> mysql = Dialect MySQL False+> mysql = addLimit ansi2011 {diFetchFirst = False+>                           ,diBackquotedIden = True+>                           }  > -- | postgresql dialect > postgres :: Dialect-> postgres = Dialect Postgres False+> postgres = addLimit ansi2011 {diPositionalArg = True+>                              ,diDollarString = True+>                              ,diEString = True+>                              ,diPostgresSymbols = True}  > -- | oracle dialect > oracle :: Dialect-> oracle = Dialect Oracle False+> oracle = ansi2011 -- {}  > -- | microsoft sql server dialect > sqlserver :: Dialect-> sqlserver = Dialect SQLServer False+> sqlserver = ansi2011 {diSquareBracketQuotedIden = True+>                      ,diAtIdentifier = True+>                      ,diHashIdentifier = True+>                      ,diSqlServerSymbols = True } +> addLimit :: Dialect -> Dialect+> addLimit d = d {diKeywords = "limit": diKeywords d+>                ,diLimit = True} ++The keyword handling is quite strong - an alternative way to do it+would be to have as few keywords as possible, and only require them+to be quoted when this is needed to resolve a parsing ambiguity.++I don't think this is a good idea for genuine keywords (it probably is+for all the 'fake' keywords in the standard - things which are+essentially function names, or predefined variable names, or type+names, eetc.).++1. working out exactly when each keyword would need to be quoted is+quite error prone, and might change as the parser implementation is+maintained - which would be terrible for users++2. it's not user friendly for the user to deal with a whole load of+special cases - either something is a keyword, then you know you must+always quote it, or it isn't, then you know you never need to quote+it++3. I think not having exceptions makes for better error messages for+the user, and a better sql code maintenance experience.++This might not match actual existing SQL products that well, some of+which I think have idiosyncratic rules about when a keyword must be+quoted. If you want to match one of these dialects exactly with this+parser, I think it will be a lot of work.++> ansi2011ReservedKeywords :: [String]+> ansi2011ReservedKeywords =+>     [--"abs" -- function+>      "all" -- keyword only?+>     ,"allocate" -- keyword+>     ,"alter" -- keyword+>     ,"and" -- keyword+>     --,"any" -- keyword? and function+>     ,"are" -- keyword+>     ,"array" -- keyword, and used in some special places, like array[...], and array(subquery)+>     --,"array_agg" -- function+>     -- ,"array_max_cardinality" -- function+>     ,"as" -- keyword+>     ,"asensitive" -- keyword+>     ,"asymmetric" -- keyword+>     ,"at" -- keyword+>     ,"atomic" -- keyword+>     ,"authorization" -- keyword+>     --,"avg" -- function+>     ,"begin" -- keyword+>     --,"begin_frame" -- identifier+>     --,"begin_partition" -- identifier+>     ,"between" -- keyword+>     ,"bigint" -- type+>     ,"binary" -- type+>     ,"blob" -- type+>     ,"boolean" -- type+>     ,"both" -- keyword+>     ,"by" -- keyword+>     ,"call" -- keyword+>     ,"called" -- keyword+>     -- ,"cardinality" -- function + identifier?+>     ,"cascaded" -- keyword+>     ,"case" -- keyword+>     ,"cast" -- special function+>     -- ,"ceil" -- function+>     -- ,"ceiling" -- function+>     ,"char"  -- type (+ keyword?)+>     --,"char_length" -- function+>     ,"character" -- type+>     --,"character_length" -- function+>     ,"check" -- keyword+>     ,"clob" -- type+>     ,"close" -- keyword+>     -- ,"coalesce" -- function+>     ,"collate" -- keyword+>     --,"collect" -- function+>     ,"column" -- keyword+>     ,"commit" -- keyword+>     ,"condition" -- keyword+>     ,"connect" -- keyword+>     ,"constraint" --keyword+>     --,"contains" -- keyword?+>     --,"convert" -- function?+>     --,"corr" -- function+>     ,"corresponding" --keyword+>     --,"count" --function+>     --,"covar_pop" -- function+>     --,"covar_samp" --function+>     ,"create" -- keyword+>     ,"cross" -- keyword+>     ,"cube" -- keyword+>     --,"cume_dist" -- function+>     ,"current" -- keyword+>     -- ,"current_catalog" --identifier?+>     --,"current_date" -- identifier+>     --,"current_default_transform_group"  -- identifier+>     --,"current_path"  -- identifier+>     --,"current_role"  -- identifier+>     -- ,"current_row"  -- identifier+>     -- ,"current_schema"  -- identifier+>     -- ,"current_time"  -- identifier+>     --,"current_timestamp"  -- identifier+>     --,"current_transform_group_for_type"  -- identifier, or keyword?+>     --,"current_user" -- identifier+>     ,"cursor" -- keyword+>     ,"cycle" --keyword+>     ,"date" -- type+>     --,"day" -- keyword? - the parser needs it to not be a keyword to parse extract at the moment+>     ,"deallocate" -- keyword+>     ,"dec" -- type+>     ,"decimal" -- type+>     ,"declare" -- keyword+>     --,"default" -- identifier + keyword+>     ,"delete" -- keyword+>     --,"dense_rank" -- functino+>     ,"deref" -- keyword+>     ,"describe"  -- keyword+>     ,"deterministic"+>     ,"disconnect"+>     ,"distinct"+>     ,"double"+>     ,"drop"+>     ,"dynamic"+>     ,"each"+>     --,"element"+>     ,"else"+>     ,"end"+>     -- ,"end_frame"  -- identifier+>     -- ,"end_partition"  -- identifier+>     ,"end-exec" -- no idea what this is+>     ,"equals"+>     ,"escape"+>     --,"every"+>     ,"except"+>     ,"exec"+>     ,"execute"+>     ,"exists"+>     ,"exp"+>     ,"external"+>     ,"extract"+>     --,"false"+>     ,"fetch"+>     ,"filter"+>     -- ,"first_value"+>     ,"float"+>     --,"floor"+>     ,"for"+>     ,"foreign"+>     -- ,"frame_row"  -- identifier+>     ,"free"+>     ,"from"+>     ,"full"+>     ,"function"+>     --,"fusion"+>     ,"get"+>     ,"global"+>     ,"grant"+>     ,"group"+>     --,"grouping"+>     ,"groups"+>     ,"having"+>     ,"hold"+>     --,"hour"+>     ,"identity"+>     ,"in"+>     ,"indicator"+>     ,"inner"+>     ,"inout"+>     ,"insensitive"+>     ,"insert"+>     ,"int"+>     ,"integer"+>     ,"intersect"+>     --,"intersection"+>     ,"interval"+>     ,"into"+>     ,"is"+>     ,"join"+>     --,"lag"+>     ,"language"+>     ,"large"+>     --,"last_value"+>     ,"lateral"+>     --,"lead"+>     ,"leading"+>     ,"left"+>     ,"like"+>     ,"like_regex"+>     --,"ln"+>     ,"local"+>     ,"localtime"+>     ,"localtimestamp"+>     --,"lower"+>     ,"match"+>     --,"max"+>     ,"member"+>     ,"merge"+>     ,"method"+>     --,"min"+>     --,"minute"+>     --,"mod"+>     ,"modifies"+>     --,"module"+>     --,"month"+>     ,"multiset"+>     ,"national"+>     ,"natural"+>     ,"nchar"+>     ,"nclob"+>     ,"new"+>     ,"no"+>     ,"none"+>     ,"normalize"+>     ,"not"+>     --,"nth_value"+>     ,"ntile"+>     --,"null"+>     --,"nullif"+>     ,"numeric"+>     ,"octet_length"+>     ,"occurrences_regex"+>     ,"of"+>     ,"offset"+>     ,"old"+>     ,"on"+>     ,"only"+>     ,"open"+>     ,"or"+>     ,"order"+>     ,"out"+>     ,"outer"+>     ,"over"+>     ,"overlaps"+>     ,"overlay"+>     ,"parameter"+>     ,"partition"+>     ,"percent"+>     --,"percent_rank"+>     --,"percentile_cont"+>     --,"percentile_disc"+>     ,"period"+>     ,"portion"+>     ,"position"+>     ,"position_regex"+>     --,"power"+>     ,"precedes"+>     ,"precision"+>     ,"prepare"+>     ,"primary"+>     ,"procedure"+>     ,"range"+>     --,"rank"+>     ,"reads"+>     ,"real"+>     ,"recursive"+>     ,"ref"+>     ,"references"+>     ,"referencing"+>     --,"regr_avgx"+>     --,"regr_avgy"+>     --,"regr_count"+>     --,"regr_intercept"+>     --,"regr_r2"+>     --,"regr_slope"+>     --,"regr_sxx"+>     --,"regr_sxy"+>     --,"regr_syy"+>     ,"release"+>     ,"result"+>     ,"return"+>     ,"returns"+>     ,"revoke"+>     ,"right"+>     ,"rollback"+>     ,"rollup"+>     --,"row"+>     --,"row_number"+>     ,"rows"+>     ,"savepoint"+>     ,"scope"+>     ,"scroll"+>     ,"search"+>     --,"second"+>     ,"select"+>     ,"sensitive"+>     --,"session_user"+>     ,"set"+>     ,"similar"+>     ,"smallint"+>     --,"some"+>     ,"specific"+>     ,"specifictype"+>     ,"sql"+>     ,"sqlexception"+>     ,"sqlstate"+>     ,"sqlwarning"+>     --,"sqrt"+>     --,"start"+>     ,"static"+>     --,"stddev_pop"+>     --,"stddev_samp"+>     ,"submultiset"+>     --,"substring"+>     ,"substring_regex"+>     ,"succeeds"+>     --,"sum"+>     ,"symmetric"+>     ,"system"+>     --,"system_time"+>     --,"system_user"+>     ,"table"+>     ,"tablesample"+>     ,"then"+>     ,"time"+>     ,"timestamp"+>     ,"timezone_hour"+>     ,"timezone_minute"+>     ,"to"+>     ,"trailing"+>     ,"translate"+>     ,"translate_regex"+>     ,"translation"+>     ,"treat"+>     ,"trigger"+>     ,"truncate"+>     --,"trim"+>     --,"trim_array"+>     --,"true"+>     ,"uescape"+>     ,"union"+>     ,"unique"+>     --,"unknown"+>     ,"unnest"+>     ,"update"+>     ,"upper"+>     --,"user"+>     ,"using"+>     --,"value"+>     ,"values"+>     ,"value_of"+>     --,"var_pop"+>     --,"var_samp"+>     ,"varbinary"+>     ,"varchar"+>     ,"varying"+>     ,"versioning"+>     ,"when"+>     ,"whenever"+>     ,"where"+>     --,"width_bucket"+>     ,"window"+>     ,"with"+>     ,"within"+>     ,"without"+>     --,"year"+>     ]+++> ansi2011TypeNames :: [String]+> ansi2011TypeNames =+>     ["double precision"+>     ,"character varying"+>     ,"char varying"+>     ,"character large object"+>     ,"char large object"+>     ,"national character"+>     ,"national char"+>     ,"national character varying"+>     ,"national char varying"+>     ,"national character large object"+>     ,"nchar large object"+>     ,"nchar varying"+>     ,"bit varying"+>     ,"binary large object"+>     ,"binary varying"+>         -- reserved keyword typenames:+>     ,"array"+>     ,"bigint"+>     ,"binary"+>     ,"blob"+>     ,"boolean"+>     ,"char"+>     ,"character"+>     ,"clob"+>     ,"date"+>     ,"dec"+>     ,"decimal"+>     ,"double"+>     ,"float"+>     ,"int"+>     ,"integer"+>     ,"nchar"+>     ,"nclob"+>     ,"numeric"+>     ,"real"+>     ,"smallint"+>     ,"time"+>     ,"timestamp"+>     ,"varchar"+>     ,"varbinary"+>     ]
Language/SQL/SimpleSQL/Lex.lhs view
@@ -24,8 +24,8 @@ >     ,prettyToken >     ,prettyTokens >     ,ParseError(..)->     ,Dialect(..) >     ,tokenListWillPrintAndLex+>     ,ansi2011 >     ) where  > import Language.SQL.SimpleSQL.Dialect@@ -174,8 +174,8 @@ >     [quotedIden >     ,unicodeQuotedIden >     ,regularIden->     ,guard (diSyntaxFlavour d == MySQL) >> mySqlQuotedIden->     ,guard (diSyntaxFlavour d == SQLServer) >> sqlServerQuotedIden+>     ,guard (diBackquotedIden d) >> mySqlQuotedIden+>     ,guard (diSquareBracketQuotedIden d) >> sqlServerQuotedIden >     ] >   where >     regularIden = Identifier Nothing <$> identifierString@@ -217,15 +217,15 @@ > prefixedVariable :: Dialect -> Parser Token > prefixedVariable  d = try $ choice >     [PrefixedVariable <$> char ':' <*> identifierString->     ,guard (diSyntaxFlavour d == SQLServer) >>+>     ,guard (diAtIdentifier d) >> >      PrefixedVariable <$> char '@' <*> identifierString->     ,guard (diSyntaxFlavour d == SQLServer) >>+>     ,guard (diHashIdentifier d) >> >      PrefixedVariable <$> char '#' <*> identifierString >     ]  > positionalArg :: Dialect -> Parser Token > positionalArg d =->   guard (diSyntaxFlavour d == Postgres) >>+>   guard (diPositionalArg d) >> >   -- use try to avoid ambiguities with other syntax which starts with dollar >   PositionalArg <$> try (char '$' *> (read <$> many1 digit)) @@ -243,7 +243,7 @@ > sqlString d = dollarString <|> csString <|> normalString >   where >     dollarString = do->         guard $ diSyntaxFlavour d == Postgres+>         guard $ diDollarString d >         -- use try because of ambiguity with symbols and with >         -- positional arg >         delim <- (\x -> concat ["$",x,"$"])@@ -270,7 +270,7 @@ >     -- error messages and user predictability make it a good >     -- pragmatic choice >     csString->       | diSyntaxFlavour d == Postgres =+>       | diEString d = >         choice [SqlString <$> try (string "e'" <|> string "E'") >                           <*> return "'" <*> normalStringSuffix True "" >                ,csString']@@ -304,7 +304,7 @@ >     SqlNumber <$> completeNumber >     -- this is for definitely avoiding possibly ambiguous source >     <* choice [-- special case to allow e.g. 1..2->                guard (diSyntaxFlavour d == Postgres)+>                guard (diPostgresSymbols d) >                *> (void $ lookAhead $ try $ string "..") >                   <|> void (notFollowedBy (oneOf "eE.")) >               ,notFollowedBy (oneOf "eE.")@@ -324,7 +324,7 @@ >     -- special case for postgresql, we backtrack if we see two adjacent dots >     -- to parse 1..2, but in other dialects we commit to the failure >     dot = let p = string "." <* notFollowedBy (char '.')->           in if (diSyntaxFlavour d == Postgres)+>           in if diPostgresSymbols d >              then try p >              else p >     expon = (:) <$> oneOf "eE" <*> sInt@@ -342,12 +342,12 @@ > symbol :: Dialect -> Parser Token > symbol d  = Symbol <$> choice (concat >    [dots->    ,if (diSyntaxFlavour d == Postgres)+>    ,if diPostgresSymbols d >     then postgresExtraSymbols >     else [] >    ,miscSymbol->    ,if allowOdbc d then odbcSymbol else []->    ,if (diSyntaxFlavour d == Postgres)+>    ,if diOdbc d then odbcSymbol else []+>    ,if diPostgresSymbols d >     then generalizedPostgresqlOperator >     else basicAnsiOps >    ])@@ -360,10 +360,10 @@ >        ,try (string "::" <* notFollowedBy (char ':')) >        ,try (string ":" <* notFollowedBy (char ':'))] >    miscSymbol = map (string . (:[])) $->        case diSyntaxFlavour d of->            SQLServer -> ",;():?"->            Postgres -> "[],;()"->            _ -> "[],;():?"+>                 case () of+>                     _ | diSqlServerSymbols d -> ",;():?"+>                       | diPostgresSymbols d -> "[],;()"+>                       | otherwise -> "[],;():?"  try is used because most of the first characters of the two character symbols can also be part of a single character symbol@@ -562,7 +562,7 @@ two symbols next to eachother will fail if the symbols can combine and (possibly just the prefix) look like a different symbol ->     | Dialect {diSyntaxFlavour = Postgres} <- d+>     | diPostgresSymbols d >     , Symbol a' <- a >     , Symbol b' <- b >     , b' `notElem` ["+", "-"] || or (map (`elem` a') "~!@#%^&|`?") = False
Language/SQL/SimpleSQL/Parse.lhs view
@@ -185,28 +185,29 @@  > import Control.Monad.Identity (Identity) > import Control.Monad (guard, void)-> import Control.Applicative ((<$), (<$>), (<*>) ,(<*), (*>), (<**>), pure)+> import Control.Applicative ((<**>)) > import Data.Char (toLower, isDigit) > import Text.Parsec (setPosition,setSourceColumn,setSourceLine,getPosition >                    ,option,between,sepBy,sepBy1 >                    ,try,many,many1,(<|>),choice,eof >                    ,optionMaybe,optional,runParser >                    ,chainl1, chainr1,(<?>))-> -- import Text.Parsec.String (Parser) > import Text.Parsec.Perm (permute,(<$?>), (<|?>)) > import Text.Parsec.Prim (getState, token) > import Text.Parsec.Pos (newPos) > import qualified Text.Parsec.Expr as E > import Data.List (intercalate,sort,groupBy) > import Data.Function (on)+> import Data.Maybe+> import Text.Parsec.String (GenParser)+ > import Language.SQL.SimpleSQL.Syntax > import Language.SQL.SimpleSQL.Combinators > import Language.SQL.SimpleSQL.Errors > import Language.SQL.SimpleSQL.Dialect > import qualified Language.SQL.SimpleSQL.Lex as L-> import Data.Maybe-> import Text.Parsec.String (GenParser) + = Public API  > -- | Parses a query expr, trailing semicolon optional.@@ -508,48 +509,10 @@ >     -- this parser handles the fixed set of multi word >     -- type names, plus all the type names which are >     -- reserved words->     reservedTypeNames = (:[]) . Name Nothing . unwords <$> makeKeywordTree->         ["double precision"->         ,"character varying"->         ,"char varying"->         ,"character large object"->         ,"char large object"->         ,"national character"->         ,"national char"->         ,"national character varying"->         ,"national char varying"->         ,"national character large object"->         ,"nchar large object"->         ,"nchar varying"->         ,"bit varying"->         ,"binary large object"->         ,"binary varying"->         -- reserved keyword typenames:->         ,"array"->         ,"bigint"->         ,"binary"->         ,"blob"->         ,"boolean"->         ,"char"->         ,"character"->         ,"clob"->         ,"date"->         ,"dec"->         ,"decimal"->         ,"double"->         ,"float"->         ,"int"->         ,"integer"->         ,"nchar"->         ,"nclob"->         ,"numeric"->         ,"real"->         ,"smallint"->         ,"time"->         ,"timestamp"->         ,"varchar"->         ,"varbinary"->         ]+>     reservedTypeNames = do+>         d <- getState+>         (:[]) . Name Nothing . unwords <$> makeKeywordTree (diSpecialTypeNames d)+>           = Scalar expressions @@ -719,91 +682,20 @@ > idenExpr = >     -- todo: work out how to left factor this >     try (TypedLit <$> typeName <*> singleQuotesOnlyStringTok)->     <|> multisetSetFunction->     <|> (try keywordFunction <**> app) >     <|> (names <**> option Iden app)+>     <|> keywordFunctionOrIden >   where->     -- this is a special case because set is a reserved keyword->     -- and the names parser won't parse it->     multisetSetFunction =->         App [Name Nothing "set"] . (:[]) <$>->         (try (keyword_ "set" *> openParen)->          *> scalarExpr <* closeParen)->     keywordFunction =->         let makeKeywordFunction x = if map toLower x `elem` keywordFunctionNames->                                     then return [Name Nothing x]->                                     else fail ""->         in unquotedIdentifierTok [] Nothing >>= makeKeywordFunction->     -- todo: this list should be in the dialects->     -- we should have tests to check these work->     -- we should have tests to check if they are used elsewhere, you->     -- get a keyword failure->     -- these are the names of functions which are also keywords->     -- so this identifier can only be used unquoted for a function application->     -- and nowhere else->     -- not sure if this list is 100% correct->     -- todo: make a corresponding list of reserved keywords which can be->     -- parsed as an identifier->     keywordFunctionNames = ["abs"->                            ,"all"->                            ,"any"->                            ,"array_agg"->                            ,"avg"->                            ,"ceil"->                            ,"ceiling"->                            ,"char_length"->                            ,"character_length"->                            ,"coalesce"->                            ,"collect"->                            ,"contains"->                            ,"convert"->                            ,"corr"->                            ,"covar_pop"->                            ,"covar_samp"->                            ,"count"->                            ,"cume_dist"->                            ,"grouping"->                            ,"intersection"->                            ,"ln"->                            ,"max"->                            ,"mod"->                            ,"percent_rank"->                            ,"percentile_cont"->                            ,"percentile_disc"->                            ,"power"->                            ,"rank"->                            ,"regr_avgx"->                            ,"regr_avgy"->                            ,"regr_count"->                            ,"regr_intercept"->                            ,"regr_r2"->                            ,"regr_slope"->                            ,"regr_sxx"->                            ,"regr_sxy"->                            ,"regr_syy"->                            ,"row"->                            ,"row_number"->                            ,"some"->                            ,"stddev_pop"->                            ,"stddev_samp"->                            ,"sum"->                            ,"upper"->                            ,"var_pop"->                            ,"var_samp"->                            ,"width_bucket"->                            -- window functions added here too->                            ,"row_number"->                            ,"rank"->                            ,"dense_rank"->                            ,"percent_rank"->                            ,"cume_dist"->                            ,"ntile"->                            ,"lead"->                            ,"lag"->                            ,"first_value"->                            ,"last_value"->                            ,"nth_value"->                            ]+>     -- special cases for keywords that can be parsed as an iden or app+>     keywordFunctionOrIden = try $ do+>         x <- unquotedIdentifierTok [] Nothing+>         d <- getState+>         let i = map toLower x `elem` diIdentifierKeywords d+>             a = map toLower x `elem` diAppKeywords d+>         case () of+>             _  | i && a -> pure [Name Nothing x] <**> option Iden app+>                | i -> pure (Iden [Name Nothing x])+>                | a -> pure [Name Nothing x] <**> app+>                | otherwise -> fail ""   === special@@ -1467,12 +1359,12 @@ > fetch :: Parser ScalarExpr > fetch = fetchFirst <|> limit >   where->     fetchFirst = guardDialect [ANSI2011]+>     fetchFirst = guardDialect diFetchFirst >                  *> fs *> scalarExpr <* ro >     fs = makeKeywordTree ["fetch first", "fetch next"] >     ro = makeKeywordTree ["rows only", "row only"] >     -- todo: not in ansi sql dialect->     limit = guardDialect [MySQL] *>+>     limit = guardDialect diLimit *> >             keyword_ "limit" *> scalarExpr  == common table expressions@@ -1482,9 +1374,12 @@ >     With <$> option False (True <$ keyword_ "recursive") >          <*> commaSep1 withQuery <*> queryExpr >   where->     withQuery = (,) <$> (fromAlias <* keyword_ "as")+>     withQuery = (,) <$> (withAlias <* keyword_ "as") >                     <*> parens queryExpr+>     withAlias = Alias <$> name <*> columnAliases+>     columnAliases = optionMaybe $ parens $ commaSep1 name + == query expression  This parser parses any query expression variant: normal select, cte,@@ -2118,6 +2013,7 @@ > identifierTok :: [String] -> Parser (Maybe (String,String), String) > identifierTok blackList = mytoken (\tok -> >     case tok of+>       L.Identifier q@(Just {}) p -> Just (q,p) >       L.Identifier q p | map toLower p `notElem` blackList -> Just (q,p) >       _ -> Nothing) @@ -2198,7 +2094,7 @@ > commaSep1 = (`sepBy1` comma)  > blacklist :: Dialect -> [String]-> blacklist = reservedWord+> blacklist d = diKeywords d  These blacklisted names are mostly needed when we parse something with an optional alias, e.g. select a a from t. If we write select a from@@ -2208,352 +2104,38 @@ identifier parsers are used to only blacklist the bare minimum. Something like this might be needed for dialect support, even if it is pretty silly to use a keyword as an unquoted identifier when-there is a effing quoting syntax as well.+there is a quoting syntax as well.  The standard has a weird mix of reserved keywords and unreserved keywords (I'm not sure what exactly being an unreserved keyword means). -can't work out if aggregate functions are supposed to be reserved or-not, leave them unreserved for now+The current approach tries to have everything which is a keyword only+in the keyword list - so it can only be used in some other context if+quoted. If something is a 'ansi keyword', but appears only as an+identifier or function name for instance in the syntax (or something+that looks identical to this), then it isn't treated as a keyword at+all. When there is some overlap (e.g. 'set'), then there is either+special case parsing code to handle this (in the case of set), or it+is not treated as a keyword (not perfect, but if it more or less+works, ok for now). -> reservedWord :: Dialect -> [String]-> reservedWord d | diSyntaxFlavour d == ANSI2011 =->     ["abs"->     --,"all"->     ,"allocate"->     ,"alter"->     ,"and"->     --,"any"->     ,"are"->     ,"array"->     --,"array_agg"->     ,"array_max_cardinality"->     ,"as"->     ,"asensitive"->     ,"asymmetric"->     ,"at"->     ,"atomic"->     ,"authorization"->     --,"avg"->     ,"begin"->     ,"begin_frame"->     ,"begin_partition"->     ,"between"->     ,"bigint"->     ,"binary"->     ,"blob"->     ,"boolean"->     ,"both"->     ,"by"->     ,"call"->     ,"called"->     ,"cardinality"->     ,"cascaded"->     ,"case"->     ,"cast"->     ,"ceil"->     ,"ceiling"->     ,"char"->     ,"char_length"->     ,"character"->     ,"character_length"->     ,"check"->     ,"clob"->     ,"close"->     ,"coalesce"->     ,"collate"->     --,"collect"->     ,"column"->     ,"commit"->     ,"condition"->     ,"connect"->     ,"constraint"->     ,"contains"->     ,"convert"->     --,"corr"->     ,"corresponding"->     --,"count"->     --,"covar_pop"->     --,"covar_samp"->     ,"create"->     ,"cross"->     ,"cube"->     --,"cume_dist"->     ,"current"->     ,"current_catalog"->     --,"current_date"->     --,"current_default_transform_group"->     --,"current_path"->     --,"current_role"->     ,"current_row"->     ,"current_schema"->     ,"current_time"->     ,"current_timestamp"->     ,"current_transform_group_for_type"->     --,"current_user"->     ,"cursor"->     ,"cycle"->     ,"date"->     --,"day"->     ,"deallocate"->     ,"dec"->     ,"decimal"->     ,"declare"->     --,"default"->     ,"delete"->     --,"dense_rank"->     ,"deref"->     ,"describe"->     ,"deterministic"->     ,"disconnect"->     ,"distinct"->     ,"double"->     ,"drop"->     ,"dynamic"->     ,"each"->     --,"element"->     ,"else"->     ,"end"->     ,"end_frame"->     ,"end_partition"->     ,"end-exec"->     ,"equals"->     ,"escape"->     --,"every"->     ,"except"->     ,"exec"->     ,"execute"->     ,"exists"->     ,"exp"->     ,"external"->     ,"extract"->     --,"false"->     ,"fetch"->     ,"filter"->     ,"first_value"->     ,"float"->     ,"floor"->     ,"for"->     ,"foreign"->     ,"frame_row"->     ,"free"->     ,"from"->     ,"full"->     ,"function"->     --,"fusion"->     ,"get"->     ,"global"->     ,"grant"->     ,"group"->     --,"grouping"->     ,"groups"->     ,"having"->     ,"hold"->     --,"hour"->     ,"identity"->     ,"in"->     ,"indicator"->     ,"inner"->     ,"inout"->     ,"insensitive"->     ,"insert"->     ,"int"->     ,"integer"->     ,"intersect"->     --,"intersection"->     ,"interval"->     ,"into"->     ,"is"->     ,"join"->     ,"lag"->     ,"language"->     ,"large"->     ,"last_value"->     ,"lateral"->     ,"lead"->     ,"leading"->     ,"left"->     ,"like"->     ,"like_regex"->     ,"ln"->     ,"local"->     ,"localtime"->     ,"localtimestamp"->     ,"lower"->     ,"match"->     --,"max"->     ,"member"->     ,"merge"->     ,"method"->     --,"min"->     --,"minute"->     ,"mod"->     ,"modifies"->     --,"module"->     --,"month"->     ,"multiset"->     ,"national"->     ,"natural"->     ,"nchar"->     ,"nclob"->     ,"new"->     ,"no"->     ,"none"->     ,"normalize"->     ,"not"->     ,"nth_value"->     ,"ntile"->     --,"null"->     ,"nullif"->     ,"numeric"->     ,"octet_length"->     ,"occurrences_regex"->     ,"of"->     ,"offset"->     ,"old"->     ,"on"->     ,"only"->     ,"open"->     ,"or"->     ,"order"->     ,"out"->     ,"outer"->     ,"over"->     ,"overlaps"->     ,"overlay"->     ,"parameter"->     ,"partition"->     ,"percent"->     --,"percent_rank"->     --,"percentile_cont"->     --,"percentile_disc"->     ,"period"->     ,"portion"->     ,"position"->     ,"position_regex"->     ,"power"->     ,"precedes"->     ,"precision"->     ,"prepare"->     ,"primary"->     ,"procedure"->     ,"range"->     --,"rank"->     ,"reads"->     ,"real"->     ,"recursive"->     ,"ref"->     ,"references"->     ,"referencing"->     --,"regr_avgx"->     --,"regr_avgy"->     --,"regr_count"->     --,"regr_intercept"->     --,"regr_r2"->     --,"regr_slope"->     --,"regr_sxx"->     --,"regr_sxy"->     --,"regr_syy"->     ,"release"->     ,"result"->     ,"return"->     ,"returns"->     ,"revoke"->     ,"right"->     ,"rollback"->     ,"rollup"->     ,"row"->     ,"row_number"->     ,"rows"->     ,"savepoint"->     ,"scope"->     ,"scroll"->     ,"search"->     --,"second"->     ,"select"->     ,"sensitive"->     --,"session_user"->     ,"set"->     ,"similar"->     ,"smallint"->     --,"some"->     ,"specific"->     ,"specifictype"->     ,"sql"->     ,"sqlexception"->     ,"sqlstate"->     ,"sqlwarning"->     ,"sqrt"->     --,"start"->     ,"static"->     --,"stddev_pop"->     --,"stddev_samp"->     ,"submultiset"->     ,"substring"->     ,"substring_regex"->     ,"succeeds"->     --,"sum"->     ,"symmetric"->     ,"system"->     ,"system_time"->     --,"system_user"->     ,"table"->     ,"tablesample"->     ,"then"->     ,"time"->     ,"timestamp"->     ,"timezone_hour"->     ,"timezone_minute"->     ,"to"->     ,"trailing"->     ,"translate"->     ,"translate_regex"->     ,"translation"->     ,"treat"->     ,"trigger"->     ,"truncate"->     ,"trim"->     ,"trim_array"->     --,"true"->     ,"uescape"->     ,"union"->     ,"unique"->     --,"unknown"->     ,"unnest"->     ,"update"->     ,"upper"->     --,"user"->     ,"using"->     --,"value"->     ,"values"->     ,"value_of"->     --,"var_pop"->     --,"var_samp"->     ,"varbinary"->     ,"varchar"->     ,"varying"->     ,"versioning"->     ,"when"->     ,"whenever"->     ,"where"->     ,"width_bucket"->     ,"window"->     ,"with"->     ,"within"->     ,"without"->     --,"year"->     ]+An exception to this is the standard type names are considered as+keywords at the moment, with a special case in the type parser to+make this work. Maybe this isn't necessary or is a bad idea. -TODO: create this list properly-      move this list into the dialect data type+It is possible to have a problem if you remove something which is a+keyword from this list, and still want to parse statements using it+as a keyword - for instance, removing things like 'from' or 'as',+will likely mean many things don't parse anymore. -> reservedWord _ = reservedWord ansi2011 ++ ["limit"] + ----------- -bit hacky, used to make the dialect available during parsing so-different parsers can be used for different dialects+Used to make the dialect available during parsing so different parsers+can be used for different dialects. Not sure if this is the best way+to do it, but it's convenient  > type ParseState = Dialect @@ -2561,19 +2143,10 @@  > type Parser = GenParser Token ParseState -> guardDialect :: [SyntaxFlavour] -> Parser ()-> guardDialect ds = do+> guardDialect :: (Dialect -> Bool) -> Parser ()+> guardDialect f = do >     d <- getState->     guard (diSyntaxFlavour d `elem` ds)--TODO: the ParseState and the Dialect argument should be turned into a-flags struct. Part (or all?) of this struct is the dialect-information, but each dialect has different versions + a big set of-flags to control syntax variations within a version of a product-dialect (for instance, string and identifier parsing rules vary from-dialect to dialect and version to version, and most or all SQL DBMSs-appear to have a set of flags to further enable or disable variations-for quoting and escaping strings and identifiers).+>     guard (f d) -The dialect stuff can also be used for custom options: e.g. to only+The dialect stuff could also be used for custom options: e.g. to only parse dml for instance.
Language/SQL/SimpleSQL/Pretty.lhs view
@@ -1,5 +1,4 @@ -> {-# LANGUAGE CPP #-} > -- | These is the pretty printing functions, which produce SQL > -- source from ASTs. The code attempts to format the output in a > -- readable way.@@ -10,23 +9,24 @@ >     ,prettyStatements >     ) where -#if MIN_VERSION_base(4,11,0)- > import Prelude hiding ((<>)) -#endif- TODO: there should be more comments in this file, especially the bits which have been changed to try to improve the layout of the output.+Try to do this when this code is ported to a modern pretty printing lib. -> import Language.SQL.SimpleSQL.Syntax-> import Language.SQL.SimpleSQL.Dialect+> --import Language.SQL.SimpleSQL.Dialect > import Text.PrettyPrint (render, vcat, text, (<>), (<+>), empty, parens, >                          nest, Doc, punctuate, comma, sep, quotes, >                          brackets,hcat) > import Data.Maybe (maybeToList, catMaybes) > import Data.List (intercalate) ++> import Language.SQL.SimpleSQL.Syntax+> import Language.SQL.SimpleSQL.Dialect++ > -- | Convert a query expr ast to concrete syntax. > prettyQueryExpr :: Dialect -> QueryExpr -> String > prettyQueryExpr d = render . queryExpr d@@ -337,7 +337,7 @@ >       ] >   where >     fetchFirst =->       me (\e -> if diSyntaxFlavour dia == MySQL+>       me (\e -> if diLimit dia >                 then text "limit" <+> scalarExpr dia e >                 else text "fetch first" <+> scalarExpr dia e >                      <+> text "rows only") fe@@ -360,8 +360,13 @@ >   text "with" <+> (if rc then text "recursive" else empty) >   <+> vcat [nest 5 >             (vcat $ punctuate comma $ flip map withs $ \(n,q) ->->              alias n <+> text "as" <+> parens (queryExpr d q))+>              withAlias n <+> text "as" <+> parens (queryExpr d q)) >            ,queryExpr d qe]+>   where+>     withAlias (Alias nm cols) = name nm+>                                 <+> me (parens . commaSep . map name) cols++ > queryExpr d (Values vs) = >     text "values" >     <+> nest 7 (commaSep (map (parens . commaSep . map (scalarExpr d)) vs))
Language/SQL/SimpleSQL/Syntax.lhs view
@@ -57,19 +57,11 @@ >     ,PrivilegeAction(..) >     ,AdminOptionFor(..) >     ,GrantOptionFor(..)->      -- * Dialects->     ,Dialect(allowOdbc)->     ,ansi2011->     ,mysql->     ,postgres->     ,oracle->     ,sqlserver >      -- * Comment >     ,Comment(..) >     ) where  > import Data.Data-> import Language.SQL.SimpleSQL.Dialect  > -- | Represents a value expression. This is used for the expressions > -- in select lists. It is also used for expressions in where, group
changelog view
@@ -1,3 +1,13 @@+0.6.0+        tested with ghc 8.8.1 also+        change the dialect handling - now a dialect is a bunch of flags+          plus a keyword list, and custom dialects are now feasible+          (still incomplete)+        fix parsing for a lot of things which are keywords in the standard+        fix bug with cte pretty printing an extra 'as', which the parser+          also incorrectly accepted+        bug fix: allow keywords that are quoted to be parsed as identifiers+ 0.5.0         update to work with ghc 8.6.5, also tested with 8.4.4 and 8.2.1 	rename some of the modules Lexer -> Lex, Parser -> Parse
simple-sql-parser.cabal view
@@ -1,5 +1,5 @@ name:                simple-sql-parser-version:             0.5.0+version:             0.6.0 synopsis:            A parser for SQL.  description:@@ -30,15 +30,18 @@   Description: Build SimpleSqlParserTool exe   Default:     False +Flag fixitytest+  Description: Build fixity test exe+  Default:     False+   library   exposed-modules:     Language.SQL.SimpleSQL.Pretty,                        Language.SQL.SimpleSQL.Parse,                        Language.SQL.SimpleSQL.Lex,-                       Language.SQL.SimpleSQL.Syntax-  Other-Modules:       Language.SQL.SimpleSQL.Errors,-                       Language.SQL.SimpleSQL.Combinators,+                       Language.SQL.SimpleSQL.Syntax,                        Language.SQL.SimpleSQL.Dialect-  other-extensions:    TupleSections+  Other-Modules:       Language.SQL.SimpleSQL.Errors,+                       Language.SQL.SimpleSQL.Combinators   build-depends:       base >=4 && <5,                        parsec >=3.1 && <3.2,                        mtl >=2.1 && <2.3,@@ -86,7 +89,8 @@                        Language.SQL.SimpleSQL.Tests,                        Language.SQL.SimpleSQL.Tpch,                        Language.SQL.SimpleSQL.ScalarExprs,-                       Language.SQL.SimpleSQL.LexerTests+                       Language.SQL.SimpleSQL.LexerTests,+                       Language.SQL.SimpleSQL.CustomDialect    other-extensions:    TupleSections,DeriveDataTypeable   default-language:    Haskell2010@@ -130,7 +134,7 @@   other-extensions:    TupleSections,DeriveDataTypeable   default-language:    Haskell2010   ghc-options:         -Wall-  if flag(parserexe)+  if flag(fixitytest)     buildable:         True   else     buildable:         False
+ tools/Language/SQL/SimpleSQL/CustomDialect.lhs view
@@ -0,0 +1,27 @@++> module Language.SQL.SimpleSQL.CustomDialect (customDialectTests) where++> import Language.SQL.SimpleSQL.TestTypes++> customDialectTests :: TestItem+> customDialectTests = Group "custom dialect tests" (map (uncurry ParseQueryExpr) passTests+>     ++ map (uncurry ParseScalarExprFails) failTests )+>   where+>     failTests = [(ansi2011,"SELECT DATE('2000-01-01')")+>                 ,(ansi2011,"SELECT DATE")+>                 ,(dateApp,"SELECT DATE")+>                 ,(dateIden,"SELECT DATE('2000-01-01')")+>                 -- show this never being allowed as an alias+>                 ,(ansi2011,"SELECT a date")+>                 ,(dateApp,"SELECT a date")+>                 ,(dateIden,"SELECT a date")+>                 ]+>     passTests = [(ansi2011,"SELECT a b")+>                 ,(noDateKeyword,"SELECT DATE('2000-01-01')")+>                 ,(noDateKeyword,"SELECT DATE")+>                 ,(dateApp,"SELECT DATE('2000-01-01')")+>                 ,(dateIden,"SELECT DATE")+>                 ]+>     noDateKeyword = ansi2011 {diKeywords = filter (/="date") (diKeywords ansi2011)}+>     dateIden = ansi2011 {diIdentifierKeywords = "date" : diIdentifierKeywords ansi2011}+>     dateApp = ansi2011 {diAppKeywords = "date" : diAppKeywords ansi2011}
tools/Language/SQL/SimpleSQL/LexerTests.lhs view
@@ -315,7 +315,7 @@  > odbcLexerTests :: TestItem > odbcLexerTests = Group "odbcLexTests" $->     [ LexTest sqlserver {allowOdbc = True} s t | (s,t) <-+>     [ LexTest sqlserver {diOdbc = True} s t | (s,t) <- >     [("{}", [Symbol "{", Symbol "}"]) >     ]] >     ++ [LexFails sqlserver "{"
tools/Language/SQL/SimpleSQL/Odbc.lhs view
@@ -29,14 +29,14 @@ >               ,iden "SQL_DATE"]) >             ] >        ,Group "outer join" [->              TestQueryExpr ansi2011 {allowOdbc=True}+>              TestQueryExpr ansi2011 {diOdbc=True} >              "select * from {oj t1 left outer join t2 on expr}" >              $ makeSelect >                    {qeSelectList = [(Star,Nothing)] >                    ,qeFrom = [TROdbc $ TRJoin (TRSimple [Name Nothing "t1"]) False JLeft (TRSimple [Name Nothing "t2"]) >                                          (Just $ JoinOn $ Iden [Name Nothing "expr"])]}] >        ,Group "check parsing bugs" [->              TestQueryExpr ansi2011 {allowOdbc=True}+>              TestQueryExpr ansi2011 {diOdbc=True} >              "select {fn CONVERT(cint,SQL_BIGINT)} from t;" >              $ makeSelect >                    {qeSelectList = [(OdbcFunc (ap "CONVERT"@@ -45,7 +45,7 @@ >                    ,qeFrom = [TRSimple [Name Nothing "t"]]}] >        ] >   where->     e = TestScalarExpr ansi2011 {allowOdbc = True}+>     e = TestScalarExpr ansi2011 {diOdbc = True} >     --tsql = ParseProcSql defaultParseFlags {pfDialect=sqlServerDialect} >     ap n = App [Name Nothing n] >     iden n = Iden [Name Nothing n]
tools/Language/SQL/SimpleSQL/QueryExprs.lhs view
@@ -13,6 +13,12 @@ >     ,("select 1;",[ms]) >     ,("select 1;select 1",[ms,ms]) >     ,(" select 1;select 1; ",[ms,ms])+>     ,("SELECT CURRENT_TIMESTAMP;"+>      ,[SelectStatement $ makeSelect+>       {qeSelectList = [(Iden [Name Nothing "CURRENT_TIMESTAMP"],Nothing)]}])+>     ,("SELECT \"CURRENT_TIMESTAMP\";"+>      ,[SelectStatement $ makeSelect+>       {qeSelectList = [(Iden [Name (Just ("\"","\"")) "CURRENT_TIMESTAMP"],Nothing)]}]) >     ] >   where >     ms = SelectStatement $ makeSelect {qeSelectList = [(NumLit "1",Nothing)]}
tools/Language/SQL/SimpleSQL/ScalarExprs.lhs view
@@ -50,6 +50,7 @@ >     [("iden1", Iden [Name Nothing "iden1"]) >     --,("t.a", Iden2 "t" "a") >     ,("\"quoted identifier\"", Iden [Name (Just ("\"","\"")) "quoted identifier"])+>     ,("\"from\"", Iden [Name (Just ("\"","\"")) "from"]) >     ]  > star :: TestItem@@ -413,3 +414,4 @@ >     ] >   where >     t fn = TestScalarExpr ansi2011 (fn ++ "(a)") $ App [Name Nothing fn] [Iden [Name Nothing "a"]]+
tools/Language/SQL/SimpleSQL/TestTypes.lhs view
@@ -4,11 +4,12 @@  > module Language.SQL.SimpleSQL.TestTypes >     (TestItem(..)->     ,ansi2011,mysql,postgres,oracle,sqlserver->     ,allowOdbc) where+>     ,module Language.SQL.SimpleSQL.Dialect+>     ) where  > import Language.SQL.SimpleSQL.Syntax > import Language.SQL.SimpleSQL.Lex (Token)+> import Language.SQL.SimpleSQL.Dialect  TODO: maybe make the dialect args into [dialect], then each test checks all the dialects mentioned work, and all the dialects not
tools/Language/SQL/SimpleSQL/Tests.lhs view
@@ -38,6 +38,7 @@  > import Language.SQL.SimpleSQL.MySQL > import Language.SQL.SimpleSQL.Oracle+> import Language.SQL.SimpleSQL.CustomDialect  Order the tests to start from the simplest first. This is also the order on the generated documentation.@@ -62,6 +63,7 @@ >     ,sql2011BitsTests >     ,mySQLTests >     ,oracleTests+>     ,customDialectTests >     ]  > tests :: T.TestTree
tools/SimpleSqlParserTool.lhs view
@@ -14,16 +14,13 @@ > import System.Exit > import Data.List > import Text.Show.Pretty-> import Control.Applicative+> --import Control.Applicative  > import Language.SQL.SimpleSQL.Pretty > import Language.SQL.SimpleSQL.Parse-> import Language.SQL.SimpleSQL.Syntax > import Language.SQL.SimpleSQL.Lex  -> dialect = ansi2011- > main :: IO () > main = do >     args <- getArgs@@ -58,8 +55,8 @@ > getInput :: [String] -> IO (FilePath,String) > getInput as = >     case as of->       ["-"] -> ("-",) <$> getContents->       ("-c":as') -> return ("-", unwords as')+>       ["-"] -> ("",) <$> getContents+>       ("-c":as') -> return ("", unwords as') >       [filename] -> (filename,) <$> readFile filename >       _ -> showHelp (Just "arguments not recognised") >> error "" @@ -70,7 +67,7 @@ >       (f,src) <- getInput args >       either (error . peFormattedError) >           (putStrLn . ppShow)->           $ parseStatements dialect f Nothing src+>           $ parseStatements ansi2011 f Nothing src >   )  > lexCommand :: (String,[String] -> IO ())@@ -80,7 +77,7 @@ >       (f,src) <- getInput args >       either (error . peFormattedError) >              (putStrLn . intercalate ",\n" . map show)->              $ lexSQL dialect f Nothing src+>              $ lexSQL ansi2011 f Nothing src >   )  @@ -90,7 +87,7 @@ >   ,\args -> do >       (f,src) <- getInput args >       either (error . peFormattedError)->           (putStrLn . prettyStatements dialect)->           $ parseStatements dialect f Nothing src+>           (putStrLn . prettyStatements ansi2011)+>           $ parseStatements ansi2011 f Nothing src  >   )