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 <row value expression>
@@ -2588,10 +2596,7 @@ Specify a row value.
<row value special case> ::= <nonparenthesized value expression primary>
-> rowValueExpression :: TestItem
-> rowValueExpression = Group "row value expression"
-> [-- todo: row value expression
-> ]
+There is nothing new here.
== 7.3 <table value constructor>
@@ -2612,7 +2617,15 @@ Specify a set of <row value expression>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 <table expression>
@@ -3123,8 +3136,29 @@ Specify a table derived from the result of a <table expression>.
> 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 <query expression>
@@ -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
+
<simple table> ::=
<query specification>
| <table value constructor>
@@ -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 <search or cycle clause>
@@ -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)-}
> ]