From dbd48baaa1d1bce3d0d0139b8ffe55370fabe672 Mon Sep 17 00:00:00 2001 From: Jake Wheat Date: Sun, 20 Apr 2014 23:14:55 +0300 Subject: [PATCH] rename LobTypeName to PrecLengthTypeName rename LobMultiplier and LobUnits to PrecMultiplier and PrecUnits remove support for limit syntax remove the unreserved keyword list since it isn't useful tests for row value constructors tests for table value constructors tests for query specifications tests for explicit table work on tests for setops,order by,offset,fetch and sort specification --- Language/SQL/SimpleSQL/Parser.lhs | 248 +----------------- Language/SQL/SimpleSQL/Pretty.lhs | 16 +- Language/SQL/SimpleSQL/Syntax.lhs | 14 +- tools/Language/SQL/SimpleSQL/Postgres.lhs | 2 +- .../SQL/SimpleSQL/QueryExprComponents.lhs | 7 +- tools/Language/SQL/SimpleSQL/SQL2003.lhs | 8 +- tools/Language/SQL/SimpleSQL/SQL2011.lhs | 106 ++++++-- 7 files changed, 122 insertions(+), 279 deletions(-) diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index d4489bc..c5b0e77 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -459,7 +459,7 @@ TODO: this code needs heavy refactoring > lob tn = parens $ do > (x,y) <- lobPrecToken > z <- optionMaybe lobUnits -> return $ LobTypeName tn x y z +> return $ PrecLengthTypeName tn x y z > precscale tn = parens (commaSep unsignedInteger) >>= makeWrap > where > makeWrap [a] = return $ PrecTypeName tn a @@ -470,15 +470,15 @@ TODO: this code needs heavy refactoring > tcollate = keyword_ "collate" *> names > lobPrecToken = lexeme $ do > p <- read <$> many1 digit "unsigned integer" -> x <- choice [Just LobK <$ keyword_ "k" -> ,Just LobM <$ keyword_ "m" -> ,Just LobG <$ keyword_ "g" -> ,Just LobT <$ keyword_ "t" -> ,Just LobP <$ keyword_ "p" +> x <- choice [Just PrecK <$ keyword_ "k" +> ,Just PrecM <$ keyword_ "m" +> ,Just PrecG <$ keyword_ "g" +> ,Just PrecT <$ keyword_ "t" +> ,Just PrecP <$ keyword_ "p" > ,return Nothing] > return (p,x) -> lobUnits = choice [LobCharacters <$ keyword_ "characters" -> ,LobOctets <$ keyword_ "octets"] +> lobUnits = choice [PrecCharacters <$ keyword_ "characters" +> ,PrecOctets <$ keyword_ "octets"] > -- deal with multiset and array suffixes > tnSuffix x = > multisetSuffix x <|> arrayTNSuffix x <|> return x @@ -506,6 +506,7 @@ TODO: this code needs heavy refactoring > ,"nchar varying" > ,"bit varying" > ,"binary large object" +> ,"binary varying" > -- reserved keyword typenames: > ,"array" > ,"bigint" @@ -530,6 +531,7 @@ TODO: this code needs heavy refactoring > ,"time" > ,"timestamp" > ,"varchar" +> ,"varbinary" > ] = Value expressions @@ -1331,12 +1333,10 @@ allows offset and fetch in either order > ,keyword_ "row"]) > fetch :: Parser ValueExpr -> fetch = choice [ansiFetch, limit] +> fetch = fs *> valueExpr <* ro > where > fs = makeKeywordTree ["fetch first", "fetch next"] > ro = makeKeywordTree ["rows only", "row only"] -> ansiFetch = fs *> valueExpr <* ro -> limit = keyword_ "limit" *> valueExpr == common table expressions @@ -1703,228 +1703,6 @@ The standard has a weird mix of reserved keywords and unreserved keywords (I'm not sure what exactly being an unreserved keyword means). -> _nonReservedWord :: [String] -> _nonReservedWord = -> ["a" -> ,"absolute" -> ,"action" -> ,"ada" -> ,"add" -> ,"admin" -> ,"after" -> ,"always" -> ,"asc" -> ,"assertion" -> ,"assignment" -> ,"attribute" -> ,"attributes" -> ,"before" -> ,"bernoulli" -> ,"breadth" -> ,"c" -> ,"cascade" -> ,"catalog" -> ,"catalog_name" -> ,"chain" -> ,"character_set_catalog" -> ,"character_set_name" -> ,"character_set_schema" -> ,"characteristics" -> ,"characters" -> ,"class_origin" -> ,"cobol" -> ,"collation" -> ,"collation_catalog" -> ,"collation_name" -> ,"collation_schema" -> ,"column_name" -> ,"command_function" -> ,"command_function_code" -> ,"committed" -> ,"condition_number" -> ,"connection" -> ,"connection_name" -> ,"constraint_catalog" -> ,"constraint_name" -> ,"constraint_schema" -> ,"constraints" -> ,"constructor" -> ,"continue" -> ,"cursor_name" -> ,"data" -> ,"datetime_interval_code" -> ,"datetime_interval_precision" -> ,"defaults" -> ,"deferrable" -> ,"deferred" -> ,"defined" -> ,"definer" -> ,"degree" -> ,"depth" -> ,"derived" -> ,"desc" -> ,"descriptor" -> ,"diagnostics" -> ,"dispatch" -> ,"domain" -> ,"dynamic_function" -> ,"dynamic_function_code" -> ,"enforced" -> ,"exclude" -> ,"excluding" -> ,"expression" -> ,"final" -> ,"first" -> ,"flag" -> ,"following" -> ,"fortran" -> ,"found" -> ,"g" -> ,"general" -> ,"generated" -> ,"go" -> ,"goto" -> ,"granted" -> ,"hierarchy" -> ,"ignore" -> ,"immediate" -> ,"immediately" -> ,"implementation" -> ,"including" -> ,"increment" -> ,"initially" -> ,"input" -> ,"instance" -> ,"instantiable" -> ,"instead" -> ,"invoker" -> ,"isolation" -> ,"k" -> ,"key" -> ,"key_member" -> ,"key_type" -> ,"last" -> ,"length" -> ,"level" -> ,"locator" -> ,"m" -> ,"map" -> ,"matched" -> ,"maxvalue" -> ,"message_length" -> ,"message_octet_length" -> ,"message_text" -> ,"minvalue" -> ,"more" -> ,"mumps" -> ,"name" -> ,"names" -> ,"nesting" -> ,"next" -> ,"nfc" -> ,"nfd" -> ,"nfkc" -> ,"nfkd" -> ,"normalized" -> ,"nullable" -> ,"nulls" -> ,"number" -> ,"object" -> ,"octets" -> ,"option" -> ,"options" -> ,"ordering" -> ,"ordinality" -> ,"others" -> ,"output" -> ,"overriding" -> ,"p" -> ,"pad" -> ,"parameter_mode" -> ,"parameter_name" -> ,"parameter_ordinal_position" -> ,"parameter_specific_catalog" -> ,"parameter_specific_name" -> ,"parameter_specific_schema" -> ,"partial" -> ,"pascal" -> ,"path" -> ,"placing" -> ,"pli" -> ,"preceding" -> ,"preserve" -> ,"prior" -> ,"privileges" -> ,"public" -> ,"read" -> ,"relative" -> ,"repeatable" -> ,"respect" -> ,"restart" -> ,"restrict" -> ,"returned_cardinality" -> ,"returned_length" -> ,"returned_octet_length" -> ,"returned_sqlstate" -> ,"role" -> ,"routine" -> ,"routine_catalog" -> ,"routine_name" -> ,"routine_schema" -> ,"row_count" -> ,"scale" -> ,"schema" -> ,"schema_name" -> ,"scope_catalog" -> ,"scope_name" -> ,"scope_schema" -> ,"section" -> ,"security" -> ,"self" -> ,"sequence" -> ,"serializable" -> ,"server_name" -> ,"session" -> ,"sets" -> ,"simple" -> ,"size" -> ,"source" -> ,"space" -> ,"specific_name" -> ,"state" -> ,"statement" -> ,"structure" -> ,"style" -> ,"subclass_origin" -> ,"t" -> ,"table_name" -> ,"temporary" -> ,"ties" -> ,"top_level_count" -> ,"transaction" -> ,"transaction_active" -> ,"transactions_committed" -> ,"transactions_rolled_back" -> ,"transform" -> ,"transforms" -> ,"trigger_catalog" -> ,"trigger_name" -> ,"trigger_schema" -> ,"type" -> ,"unbounded" -> ,"uncommitted" -> ,"under" -> ,"unnamed" -> ,"usage" -> ,"user_defined_type_catalog" -> ,"user_defined_type_code" -> ,"user_defined_type_name" -> ,"user_defined_type_schema" -> ,"view" -> ,"work" -> ,"write" -> ,"zone"] - > reservedWord :: [String] > reservedWord = > ["abs" @@ -2251,10 +2029,6 @@ means). > ,"within" > ,"without" > --,"year" -> -> -- added for this parser -> -- todo: remove this when dialects with limit are added -> ,"limit" > ] -------------------------------------------- diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 1752d77..c04965e 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -257,18 +257,18 @@ which have been changed to try to improve the layout of the output. > typeName (PrecTypeName t a) = names t <+> parens (text $ show a) > typeName (PrecScaleTypeName t a b) = > names t <+> parens (text (show a) <+> comma <+> text (show b)) -> typeName (LobTypeName t i m u) = +> typeName (PrecLengthTypeName t i m u) = > names t > <> parens (text (show i) > <> me (\x -> case x of -> LobK -> text "K" -> LobM -> text "M" -> LobG -> text "G" -> LobT -> text "T" -> LobP -> text "P") m +> PrecK -> text "K" +> PrecM -> text "M" +> PrecG -> text "G" +> PrecT -> text "T" +> PrecP -> text "P") m > <+> me (\x -> case x of -> LobCharacters -> text "CHARACTERS" -> LobOctets -> text "OCTETS") u) +> PrecCharacters -> text "CHARACTERS" +> PrecOctets -> text "OCTETS") u) > typeName (CharTypeName t i cs col) = > names t > <> me (\x -> parens (text $ show x)) i diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index 4dc7900..a0af988 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -7,8 +7,8 @@ > ,Name(..) > ,TypeName(..) > ,IntervalTypeField(..) -> ,LobMultiplier(..) -> ,LobUnits(..) +> ,PrecMultiplier(..) +> ,PrecUnits(..) > ,SetQuantifier(..) > ,SortSpec(..) > ,Direction(..) @@ -172,7 +172,7 @@ > = TypeName [Name] > | PrecTypeName [Name] Integer > | PrecScaleTypeName [Name] Integer Integer -> | LobTypeName [Name] Integer (Maybe LobMultiplier) (Maybe LobUnits) +> | PrecLengthTypeName [Name] Integer (Maybe PrecMultiplier) (Maybe PrecUnits) > -- precision, characterset, collate > | CharTypeName [Name] (Maybe Integer) [Name] [Name] > | TimeTypeName [Name] (Maybe Integer) Bool -- true == with time zone @@ -185,10 +185,10 @@ > data IntervalTypeField = Itf String (Maybe (Integer, Maybe Integer)) > deriving (Eq,Show,Read,Data,Typeable) -> data LobMultiplier = LobK | LobM | LobG | LobT | LobP -> deriving (Eq,Show,Read,Data,Typeable) -> data LobUnits = LobCharacters -> | LobOctets +> data PrecMultiplier = PrecK | PrecM | PrecG | PrecT | PrecP +> deriving (Eq,Show,Read,Data,Typeable) +> data PrecUnits = PrecCharacters +> | PrecOctets > deriving (Eq,Show,Read,Data,Typeable) > -- | Used for 'expr in (value expression list)', and 'expr in diff --git a/tools/Language/SQL/SimpleSQL/Postgres.lhs b/tools/Language/SQL/SimpleSQL/Postgres.lhs index cf506d3..19b1807 100644 --- a/tools/Language/SQL/SimpleSQL/Postgres.lhs +++ b/tools/Language/SQL/SimpleSQL/Postgres.lhs @@ -218,7 +218,7 @@ queries section > \ UNION ALL\n\ > \ SELECT n+1 FROM t\n\ > \)\n\ -> \SELECT n FROM t LIMIT 100;" +> \SELECT n FROM t --LIMIT 100;" -- limit is not standard select page reference diff --git a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs index 867e85a..f2377ca 100644 --- a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs +++ b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs @@ -129,9 +129,10 @@ These are a few misc tests which don't fit anywhere else. > ,ms Nothing (Just $ NumLit "10")) > ,("select a from t offset 5 row fetch first 10 row only" > ,ms (Just $ NumLit "5") (Just $ NumLit "10")) -> -- postgres -> ,("select a from t limit 10 offset 5" -> ,ms (Just $ NumLit "5") (Just $ NumLit "10")) +> -- postgres: disabled, will add back when postgres +> -- dialect is added +> --,("select a from t limit 10 offset 5" +> -- ,ms (Just $ NumLit "5") (Just $ NumLit "10")) > ] > where > ms o l = makeSelect diff --git a/tools/Language/SQL/SimpleSQL/SQL2003.lhs b/tools/Language/SQL/SimpleSQL/SQL2003.lhs index 5b6e016..fcb2f51 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2003.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2003.lhs @@ -1039,13 +1039,13 @@ create a list of type name variations: > -- 1 scale > ,("decimal(15,2)", PrecScaleTypeName [Name "decimal"] 15 2) > -- lob prec + with multiname -> ,("blob(3M)", LobTypeName [Name "blob"] 3 (Just LobM) Nothing) +> ,("blob(3M)", PrecLengthTypeName [Name "blob"] 3 (Just PrecM) Nothing) > ,("blob(4M characters) " -> ,LobTypeName [Name "blob"] 4 (Just LobM) (Just LobCharacters)) +> ,PrecLengthTypeName [Name "blob"] 4 (Just PrecM) (Just PrecCharacters)) > ,("blob(6G octets) " -> ,LobTypeName [Name "blob"] 6 (Just LobG) (Just LobOctets)) +> ,PrecLengthTypeName [Name "blob"] 6 (Just PrecG) (Just PrecOctets)) > ,("national character large object(7K) " -> ,LobTypeName [Name "national character large object"] 7 (Just LobK) Nothing) +> ,PrecLengthTypeName [Name "national character large object"] 7 (Just PrecK) Nothing) > -- 1 with and without tz > ,("time with time zone" > ,TimeTypeName [Name "time"] Nothing True) diff --git a/tools/Language/SQL/SimpleSQL/SQL2011.lhs b/tools/Language/SQL/SimpleSQL/SQL2011.lhs index 0df8588..e0e106f 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011.lhs @@ -1014,10 +1014,13 @@ create a list of type name variations: > basicTypes = > -- example of every standard type name > map (\t -> (t,TypeName [Name t])) -> ["character" +> ["binary" +> ,"binary varying" +> ,"character" > ,"char" > ,"character varying" > ,"char varying" +> ,"varbinary" > ,"varchar" > ,"character large object" > ,"char large object" @@ -1059,16 +1062,18 @@ create a list of type name variations: > ,("char varying(5)", PrecTypeName [Name "char varying"] 5) > -- 1 scale > ,("decimal(15,2)", PrecScaleTypeName [Name "decimal"] 15 2) +> ,("char(3 octets)", PrecLengthTypeName [Name "char"] 3 Nothing (Just PrecOctets)) +> ,("varchar(50 characters)", PrecLengthTypeName [Name "varchar"] 50 Nothing (Just PrecCharacters)) > -- lob prec + with multiname -> ,("blob(3M)", LobTypeName [Name "blob"] 3 (Just LobM) Nothing) -> ,("blob(3T)", LobTypeName [Name "blob"] 3 (Just LobT) Nothing) -> ,("blob(3P)", LobTypeName [Name "blob"] 3 (Just LobP) Nothing) +> ,("blob(3M)", PrecLengthTypeName [Name "blob"] 3 (Just PrecM) Nothing) +> ,("blob(3T)", PrecLengthTypeName [Name "blob"] 3 (Just PrecT) Nothing) +> ,("blob(3P)", PrecLengthTypeName [Name "blob"] 3 (Just PrecP) Nothing) > ,("blob(4M characters) " -> ,LobTypeName [Name "blob"] 4 (Just LobM) (Just LobCharacters)) +> ,PrecLengthTypeName [Name "blob"] 4 (Just PrecM) (Just PrecCharacters)) > ,("blob(6G octets) " -> ,LobTypeName [Name "blob"] 6 (Just LobG) (Just LobOctets)) +> ,PrecLengthTypeName [Name "blob"] 6 (Just PrecG) (Just PrecOctets)) > ,("national character large object(7K) " -> ,LobTypeName [Name "national character large object"] 7 (Just LobK) Nothing) +> ,PrecLengthTypeName [Name "national character large object"] 7 (Just PrecK) Nothing) > -- 1 with and without tz > ,("time with time zone" > ,TimeTypeName [Name "time"] Nothing True) @@ -2499,7 +2504,6 @@ Specify construction of a multiset. > queryExpressions :: TestItem > queryExpressions = Group "query expressions" > [rowValueConstructor -> ,rowValueExpression > ,tableValueConstructor > ,fromClause > ,tableReference @@ -2562,7 +2566,11 @@ Specify a value or list of values to be constructed into a row. > rowValueConstructor :: TestItem > rowValueConstructor = Group "row value constructor" -> [-- TODO: row value constructor +> $ map (uncurry TestValueExpr) +> [("(a,b)" +> ,SpecialOp [Name "rowctor"] [Iden [Name "a"], Iden [Name "b"]]) +> ,("row(1)",App [Name "row"] [NumLit "1"]) +> ,("row(1,2)",App [Name "row"] [NumLit "1",NumLit "2"]) > ] == 7.2 @@ -2588,10 +2596,7 @@ Specify a row value. ::= -> rowValueExpression :: TestItem -> rowValueExpression = Group "row value expression" -> [-- todo: row value expression -> ] +There is nothing new here. == 7.3 @@ -2612,7 +2617,15 @@ Specify a set of s to be constructed into a table. > tableValueConstructor :: TestItem > tableValueConstructor = Group "table value constructor" -> [-- TODO: table value constructor +> $ map (uncurry TestQueryExpr) +> [("values (1,2), (a+b,(select count(*) from t));" +> ,Values [[NumLit "1", NumLit "2"] +> ,[BinOp (Iden [Name "a"]) [Name "+"] +> (Iden [Name "b"]) +> ,SubQueryExpr SqSq +> (makeSelect +> {qeSelectList = [(App [Name "count"] [Star],Nothing)] +> ,qeFrom = [TRSimple [Name "t"]]})]]) > ] == 7.4
@@ -3123,8 +3136,29 @@ Specify a table derived from the result of a
. > querySpecification :: TestItem > querySpecification = Group "query specification" -> [-- todo: query specification +> $ map (uncurry TestQueryExpr) +> [("select a from t",qe) +> ,("select all a from t",qe {qeSetQuantifier = All}) +> ,("select distinct a from t",qe {qeSetQuantifier = Distinct}) +> ,("select * from t", qe {qeSelectList = [(Star,Nothing)]}) +> ,("select a.* from t" +> ,qe {qeSelectList = [(BinOp (Iden [Name "a"]) [Name "."] Star +> ,Nothing)]}) +> ,("select a b from t" +> ,qe {qeSelectList = [(Iden [Name "a"], Just $ Name "b")]}) +> ,("select a as b from t" +> ,qe {qeSelectList = [(Iden [Name "a"], Just $ Name "b")]}) +> ,("select a,b from t" +> ,qe {qeSelectList = [(Iden [Name "a"], Nothing) +> ,(Iden [Name "b"], Nothing)]}) +> -- todo: all field reference alias +> --,("select * as (a,b) from t",undefined) > ] +> where +> qe = makeSelect +> {qeSelectList = [(Iden [Name "a"], Nothing)] +> ,qeFrom = [TRSimple [Name "t"]] +> } == 7.13 @@ -3170,9 +3204,29 @@ Specify a table. > setOpQueryExpression :: TestItem > setOpQueryExpression= Group "set operation query expression" -> [-- todo: set operation query expression +> $ map (uncurry TestQueryExpr) +> -- todo: complete setop query expression tests +> [{-("select * from t union select * from t" +> ,undefined) +> ,("select * from t union all select * from t" +> ,undefined) +> ,("select * from t union distinct select * from t" +> ,undefined) +> ,("select * from t union corresponding select * from t" +> ,undefined) +> ,("select * from t union corresponding by (a,b) select * from t" +> ,undefined) +> ,("select * from t except select * from t" +> ,undefined) +> ,("select * from t in intersect select * from t" +> ,undefined)-} > ] +TODO: tests for the associativity and precendence + +TODO: not sure exactly where parens are allowed, we will allow them +everywhere + ::= |
@@ -3187,7 +3241,8 @@ Specify a table. > explicitTableQueryExpression :: TestItem > explicitTableQueryExpression= Group "explicit table query expression" -> [-- todo: explicit table query expression +> $ map (uncurry TestQueryExpr) +> [("table t", Table [Name "t"]) > ] @@ -3208,7 +3263,14 @@ Specify a table. > orderOffsetFetchQueryExpression :: TestItem > orderOffsetFetchQueryExpression = Group "order, offset, fetch query expression" -> [-- todo: order, offset, fetch query expression +> $ map (uncurry TestQueryExpr) +> [-- todo: finish tests for order offset and fetch +> {- ("select * from t order by a", undefined) +> ,("select * from t offset 5 row", undefined) +> ,("select * from t offset 5 rows", undefined) +> ,("select * from t fetch first 5 row only", undefined) +> ,("select * from t fetch next 5 rows with ties", undefined) +> ,("select * from t fetch first 5 percent rows only", undefined)-} > ] == 7.14 @@ -4185,5 +4247,11 @@ Specify a sort order. > sortSpecificationList :: TestItem > sortSpecificationList = Group "sort specification list" -> [-- todo: sort specification list +> $ map (uncurry TestQueryExpr) +> -- todo: finish test for sort specs +> [{-("select * from t order by a,b", undefined) +> ,("select * from t order by a asc", undefined) +> ,("select * from t order by a desc", undefined) +> ,("select * from t order by a nulls first", undefined) +> ,("select * from t order by a nulls first", undefined)-} > ]