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

@@ -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"
+>         x <- choice [Just PrecK <$ keyword_ "k"
->                     ,Just LobM <$ keyword_ "m"
+>                     ,Just PrecM <$ keyword_ "m"
->                     ,Just LobG <$ keyword_ "g"
+>                     ,Just PrecG <$ keyword_ "g"
->                     ,Just LobT <$ keyword_ "t"
+>                     ,Just PrecT <$ keyword_ "t"
->                     ,Just LobP <$ keyword_ "p"
+>                     ,Just PrecP <$ keyword_ "p"
 >                     ,return Nothing]
 >         return (p,x)
->     lobUnits = choice [LobCharacters <$ keyword_ "characters"
+>     lobUnits = choice [PrecCharacters <$ keyword_ "characters"
->                       ,LobOctets <$ keyword_ "octets"]
+>                       ,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"
 >     ]
 
 --------------------------------------------

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"
+>                            PrecK -> text "K"
->                            LobM -> text "M"
+>                            PrecM -> text "M"
->                            LobG -> text "G"
+>                            PrecG -> text "G"
->                            LobT -> text "T"
+>                            PrecT -> text "T"
->                            LobP -> text "P") m
+>                            PrecP -> text "P") m
 >                <+> me (\x -> case x of
->                        LobCharacters -> text "CHARACTERS"
+>                        PrecCharacters -> text "CHARACTERS"
->                        LobOctets -> text "OCTETS") u)
+>                        PrecOctets -> text "OCTETS") u)
 > typeName (CharTypeName t i cs col) =
 >     names t
 >     <> me (\x -> parens (text $ show x)) i

Language/SQL/SimpleSQL/Syntax.lhs

@@ -7,8 +7,8 @@
 >     ,Name(..)
 >     ,TypeName(..)
 >     ,IntervalTypeField(..)
->     ,LobMultiplier(..)
+>     ,PrecMultiplier(..)
->     ,LobUnits(..)
+>     ,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
+> data PrecMultiplier = PrecK | PrecM | PrecG | PrecT | PrecP
->                      deriving (Eq,Show,Read,Data,Typeable)
+>                       deriving (Eq,Show,Read,Data,Typeable)
-> data LobUnits = LobCharacters
+> data PrecUnits = PrecCharacters
->               | LobOctets
+>                | PrecOctets
 >                 deriving (Eq,Show,Read,Data,Typeable)
 
 > -- | Used for 'expr in (value expression list)', and 'expr in

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
 

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
+>      -- postgres: disabled, will add back when postgres
->     ,("select a from t limit 10 offset 5"
+>      -- dialect is added
->      ,ms (Just $ NumLit "5") (Just $ NumLit "10"))
+>     --,("select a from t limit 10 offset 5"
+>     -- ,ms (Just $ NumLit "5") (Just $ NumLit "10"))
 >     ]
 >   where
 >     ms o l = makeSelect

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)

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(3M)", PrecLengthTypeName [Name "blob"] 3 (Just PrecM) Nothing)
->          ,("blob(3T)", LobTypeName [Name "blob"] 3 (Just LobT) Nothing)
+>          ,("blob(3T)", PrecLengthTypeName [Name "blob"] 3 (Just PrecT) Nothing)
->          ,("blob(3P)", LobTypeName [Name "blob"] 3 (Just LobP) 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
+There is nothing new here.
-> rowValueExpression = Group "row value expression"
->     [-- todo: row value expression
->     ]
 
 == 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)-}
 >     ]