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)-} > ]