diff --git a/Language/SQL/SimpleSQL/Lex.lhs b/Language/SQL/SimpleSQL/Lex.lhs index 99a924f..15e8f63 100644 --- a/Language/SQL/SimpleSQL/Lex.lhs +++ b/Language/SQL/SimpleSQL/Lex.lhs @@ -46,16 +46,11 @@ parsec > -- > = Symbol String > -> -- | This is an identifier or keyword. -> -- -> | Identifier String -> -> -- | This is a quoted identifier, the quotes can be " or u&, -> -- etc. or something dialect specific like [] -> -- the first two fields are the start and end quotes -> | QuotedIdentifier String -- start quote -> String -- end quote -> String -- content +> -- | This is an identifier or keyword. The first field is +> -- the quotes used, or nothing if no quotes were used. The quotes +> -- can be " or u& or something dialect specific like [] +> | Identifier (Maybe (String,String)) String + > -- | This is a host param symbol, e.g. :param > | HostParam String > @@ -88,10 +83,13 @@ parsec > -- print them, should should get back exactly the same string > prettyToken :: Dialect -> Token -> String > prettyToken _ (Symbol s) = s -> prettyToken _ (Identifier t) = t -> prettyToken _ (QuotedIdentifier q1 q2 t) = +> prettyToken _ (Identifier Nothing t) = t +> prettyToken _ (Identifier (Just (q1,q2)) t) = > q1 ++ > -- todo: a bit hacky, do a better design +> -- the dialect will know how to escape and unescape +> -- contents, but the parser here also needs to know +> -- about parsing escaped quotes > (if '"' `elem` q1 then doubleChars '"' t else t) > ++ q2 > --prettyToken _ (UQIdentifier t) = @@ -179,14 +177,14 @@ u&"unicode quoted identifier" > identifier :: Dialect -> Parser Token > identifier d = > choice -> [QuotedIdentifier "\"" "\"" <$> qiden +> [Identifier (Just ("\"","\"")) <$> qiden > -- try is used here to avoid a conflict with identifiers > -- and quoted strings which also start with a 'u' -> ,QuotedIdentifier "u&\"" "\"" <$> (try (string "u&") *> qiden) -> ,QuotedIdentifier "U&\"" "\"" <$> (try (string "U&") *> qiden) -> ,Identifier <$> identifierString +> ,Identifier (Just ("u&\"","\"")) <$> (try (string "u&") *> qiden) +> ,Identifier (Just ("U&\"","\"")) <$> (try (string "U&") *> qiden) +> ,Identifier Nothing <$> identifierString > -- todo: dialect protection -> ,QuotedIdentifier "`" "`" <$> mySqlQIden +> ,Identifier (Just ("`","`")) <$> mySqlQIden > ] > where > qiden = char '"' *> qidenSuffix "" diff --git a/Language/SQL/SimpleSQL/Parse.lhs b/Language/SQL/SimpleSQL/Parse.lhs index 0473b7d..893b508 100644 --- a/Language/SQL/SimpleSQL/Parse.lhs +++ b/Language/SQL/SimpleSQL/Parse.lhs @@ -330,9 +330,7 @@ u&"example quoted" > name :: Parser Name > name = do > d <- getState -> choice [Name <$> identifierTok (blacklist d) Nothing -> ,(\(s,e,t) -> QuotedName s e t) <$> qidentifierTok -> ] +> uncurry Name <$> identifierTok (blacklist d) todo: replace (:[]) with a named function all over @@ -506,7 +504,7 @@ factoring in this function, and it is a little dense. > -- this parser handles the fixed set of multi word > -- type names, plus all the type names which are > -- reserved words -> reservedTypeNames = (:[]) . Name . unwords <$> makeKeywordTree +> reservedTypeNames = (:[]) . Name Nothing . unwords <$> makeKeywordTree > ["double precision" > ,"character varying" > ,"char varying" @@ -598,7 +596,7 @@ value expression parens, row ctor and scalar subquery > ,ctor <$> commaSep1 valueExpr] > where > ctor [a] = Parens a -> ctor as = SpecialOp [Name "rowctor"] as +> ctor as = SpecialOp [Name Nothing "rowctor"] as == case, cast, exists, unique, array/multiset constructor, interval @@ -643,7 +641,7 @@ subquery expression: > arrayCtor = keyword_ "array" >> > choice > [ArrayCtor <$> parens queryExpr -> ,Array (Iden [Name "array"]) <$> brackets (commaSep valueExpr)] +> ,Array (Iden [Name Nothing "array"]) <$> brackets (commaSep valueExpr)] As far as I can tell, table(query expr) is just syntax sugar for multiset(query expr). It must be there for compatibility or something. @@ -689,7 +687,7 @@ this. also fix the monad -> applicative > q <- optionMaybe intervalQualifier > mkIt s lit q) > where -> mkIt Nothing val Nothing = pure $ TypedLit (TypeName [Name "interval"]) val +> mkIt Nothing val Nothing = pure $ TypedLit (TypeName [Name Nothing "interval"]) val > mkIt s val (Just (a,b)) = pure $ IntervalLit s val a b > mkIt (Just {}) _val Nothing = fail "cannot use sign without interval qualifier" @@ -718,7 +716,7 @@ all the value expressions which start with an identifier > -- this is a special case because set is a reserved keyword > -- and the names parser won't parse it > multisetSetFunction = -> App [Name "set"] . (:[]) <$> +> App [Name Nothing "set"] . (:[]) <$> > (try (keyword_ "set" *> openParen) > *> valueExpr <* closeParen) @@ -750,7 +748,7 @@ operatorname(firstArg keyword0 arg0 keyword1 arg1 etc.) > -- check we haven't parsed the first > -- keyword as an identifier > case (e,kws) of -> (Iden [Name i], (k,_):_) +> (Iden [Name Nothing i], (k,_):_) > | map toLower i == k -> > fail $ "cannot use keyword here: " ++ i > _ -> return () @@ -761,7 +759,7 @@ operatorname(firstArg keyword0 arg0 keyword1 arg1 etc.) > SOKMandatory -> Just <$> pfa > as <- mapM parseArg kws > void closeParen -> pure $ SpecialOpK [Name opName] fa $ catMaybes as +> pure $ SpecialOpK [Name Nothing opName] fa $ catMaybes as > where > parseArg (nm,mand) = > let p = keyword_ nm >> valueExpr @@ -833,7 +831,7 @@ in the source > ,"trailing" <$ keyword_ "trailing" > ,"both" <$ keyword_ "both"] > mkTrim fa ch fr = -> SpecialOpK [Name "trim"] Nothing +> SpecialOpK [Name Nothing "trim"] Nothing > $ catMaybes [Just (fa,StringLit "'" "'" ch) > ,Just ("from", fr)] @@ -959,7 +957,7 @@ and operator. This is the call to valueExprB. > betweenSuffix :: Parser (ValueExpr -> ValueExpr) > betweenSuffix = -> makeOp <$> Name <$> opName +> makeOp <$> Name Nothing <$> opName > <*> valueExprB > <*> (keyword_ "and" *> valueExprB) > where @@ -979,7 +977,7 @@ a = any (select * from t) > q <- parens queryExpr > pure $ \v -> QuantifiedComparison v [c] cq q > where -> comp = Name <$> choice (map symbol +> comp = Name Nothing <$> choice (map symbol > ["=", "<>", "<=", "<", ">", ">="]) > compQuan = choice > [CPAny <$ keyword_ "any" @@ -1009,7 +1007,10 @@ a match (select a from t) It is going to be really difficult to support an arbitrary character for the escape now there is a separate lexer ... -> escapeSuffix :: Parser (ValueExpr -> ValueExpr) +TODO: this needs fixing. Escape is only part of other nodes, and not a +separate suffix. + +> {-escapeSuffix :: Parser (ValueExpr -> ValueExpr) > escapeSuffix = do > ctor <- choice > [Escape <$ keyword_ "escape" @@ -1023,6 +1024,7 @@ for the escape now there is a separate lexer ... > oneOnly c = case c of > [c'] -> return c' > _ -> fail "escape char must be single char" +> -} === collate @@ -1060,7 +1062,6 @@ messages, but both of these are too important. > ,[binarySym "." E.AssocLeft] > ,[postfix' arraySuffix -> ,postfix' escapeSuffix > ,postfix' collateSuffix] > ,[prefixSym "+", prefixSym "-"] @@ -1129,14 +1130,14 @@ messages, but both of these are too important. > binaryKeywords p = > E.Infix (do > o <- try p -> pure (\a b -> BinOp a [Name $ unwords o] b)) +> pure (\a b -> BinOp a [Name Nothing $ unwords o] b)) > E.AssocNone > postfixKeywords p = > postfix' $ do > o <- try p -> pure $ PostfixOp [Name $ unwords o] +> pure $ PostfixOp [Name Nothing $ unwords o] > binary p nm assoc = -> E.Infix (p >> pure (\a b -> BinOp a [Name nm] b)) assoc +> E.Infix (p >> pure (\a b -> BinOp a [Name Nothing nm] b)) assoc > multisetBinOp = E.Infix (do > keyword_ "multiset" > o <- choice [Union <$ keyword_ "union" @@ -1147,7 +1148,7 @@ messages, but both of these are too important. > E.AssocLeft > prefixKeyword nm = prefix (keyword_ nm) nm > prefixSym nm = prefix (symbol_ nm) nm -> prefix p nm = prefix' (p >> pure (PrefixOp [Name nm])) +> prefix p nm = prefix' (p >> pure (PrefixOp [Name Nothing nm])) > -- hack from here > -- http://stackoverflow.com/questions/10475337/parsec-expr-repeated-prefix-postfix-operator-not-supported > -- not implemented properly yet @@ -1996,17 +1997,17 @@ It is only allowed when all the strings are quoted with ' atm. > (Just s, L.Symbol p) | s == p -> Just p > _ -> Nothing) -> identifierTok :: [String] -> Maybe String -> Parser String -> identifierTok blackList kw = mytoken (\tok -> -> case (kw,tok) of -> (Nothing, L.Identifier p) | map toLower p `notElem` blackList -> Just p -> (Just k, L.Identifier p) | k == map toLower p -> Just p +> identifierTok :: [String] -> Parser (Maybe (String,String), String) +> identifierTok blackList = mytoken (\tok -> +> case tok of +> L.Identifier q p | map toLower p `notElem` blackList -> Just (q,p) > _ -> Nothing) -> qidentifierTok :: Parser (String,String,String) -> qidentifierTok = mytoken (\tok -> -> case tok of -> L.QuotedIdentifier s e t -> Just (s,e,t) +> unquotedIdentifierTok :: [String] -> Maybe String -> Parser String +> unquotedIdentifierTok blackList kw = mytoken (\tok -> +> case (kw,tok) of +> (Nothing, L.Identifier Nothing p) | map toLower p `notElem` blackList -> Just p +> (Just k, L.Identifier Nothing p) | k == map toLower p -> Just p > _ -> Nothing) > mytoken :: (L.Token -> Maybe a) -> Parser a @@ -2052,7 +2053,7 @@ todo: work out the symbol parsing better = helper functions > keyword :: String -> Parser String -> keyword k = identifierTok [] (Just k) k +> keyword k = unquotedIdentifierTok [] (Just k) k helper function to improve error messages diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index f6c3560..bc2ca9a 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -100,13 +100,13 @@ which have been changed to try to improve the layout of the output. > fpd (Preceding e) = valueExpr d e <+> text "preceding" > fpd (Following e) = valueExpr d e <+> text "following" -> valueExpr dia (SpecialOp nm [a,b,c]) | nm `elem` [[Name "between"] -> ,[Name "not between"]] = +> valueExpr dia (SpecialOp nm [a,b,c]) | nm `elem` [[Name Nothing "between"] +> ,[Name Nothing "not between"]] = > sep [valueExpr dia a > ,names nm <+> valueExpr dia b > ,nest (length (unnames nm) + 1) $ text "and" <+> valueExpr dia c] -> valueExpr d (SpecialOp [Name "rowctor"] as) = +> valueExpr d (SpecialOp [Name Nothing "rowctor"] as) = > parens $ commaSep $ map (valueExpr d) as > valueExpr d (SpecialOp nm es) = @@ -119,7 +119,8 @@ which have been changed to try to improve the layout of the output. > valueExpr d (PrefixOp f e) = names f <+> valueExpr d e > valueExpr d (PostfixOp f e) = valueExpr d e <+> names f -> valueExpr d e@(BinOp _ op _) | op `elem` [[Name "and"], [Name "or"]] = +> valueExpr d e@(BinOp _ op _) | op `elem` [[Name Nothing "and"] +> ,[Name Nothing "or"]] = > -- special case for and, or, get all the ands so we can vcat them > -- nicely > case ands e of @@ -130,7 +131,7 @@ which have been changed to try to improve the layout of the output. > ands (BinOp a op' b) | op == op' = ands a ++ ands b > ands x = [x] > -- special case for . we don't use whitespace -> valueExpr d (BinOp e0 [Name "."] e1) = +> valueExpr d (BinOp e0 [Name Nothing "."] e1) = > valueExpr d e0 <> text "." <> valueExpr d e1 > valueExpr d (BinOp e0 f e1) = > valueExpr d e0 <+> names f <+> valueExpr d e1 @@ -211,11 +212,11 @@ which have been changed to try to improve the layout of the output. > Distinct -> text "distinct" > ,valueExpr d b] -> valueExpr d (Escape v e) = +> {-valueExpr d (Escape v e) = > valueExpr d v <+> text "escape" <+> text [e] > valueExpr d (UEscape v e) = -> valueExpr d v <+> text "uescape" <+> text [e] +> valueExpr d v <+> text "uescape" <+> text [e]-} > valueExpr d (Collate v c) = > valueExpr d v <+> text "collate" <+> names c @@ -239,8 +240,8 @@ which have been changed to try to improve the layout of the output. > unname :: Name -> String -> unname (Name n) = n -> unname (QuotedName s e n) = +> unname (Name Nothing n) = n +> unname (Name (Just (s,e)) n) = > s ++ (if '"' `elem` s then doubleUpDoubleQuotes n else n) ++ e > unnames :: [Name] -> String @@ -248,8 +249,8 @@ which have been changed to try to improve the layout of the output. > name :: Name -> Doc -> name (Name n) = text n -> name (QuotedName s e n) = +> name (Name Nothing n) = text n +> name (Name (Just (s,e)) n) = > text s <> text (if '"' `elem` s then doubleUpDoubleQuotes n else n) <> text e > names :: [Name] -> Doc diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index 78dc6cc..626b17e 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -206,8 +206,8 @@ todo: special syntax for like, similar with escape - escape cannot go in other places -> | Escape ValueExpr Char -> | UEscape ValueExpr Char +> -- | Escape ValueExpr Char +> -- | UEscape ValueExpr Char > | Collate ValueExpr [Name] > | MultisetBinOp ValueExpr CombineOp SetQuantifier ValueExpr > | MultisetCtor [ValueExpr] @@ -217,9 +217,13 @@ in other places > deriving (Eq,Show,Read,Data,Typeable) > -- | Represents an identifier name, which can be quoted or unquoted. -> data Name = Name String -> | QuotedName String String String -> -- ^ quoted name, the fields are start quote, end quote and the string itself, these will usually be ", others are possible e.g. `something` is parsed to QuotedName "`" "`" "something, and $a$ test $a$ is parsed to QuotedName "$a$" "$a$" " test " +> -- examples: +> -- +> -- * test -> Name Nothing "test" +> -- * "test" -> Name (Just "\"","\"") "test" +> -- * `something` -> Name (Just ("`","`") "something" +> -- * [ms] -> Name (Just ("[","]") "ms" +> data Name = Name (Maybe (String,String)) String > deriving (Eq,Show,Read,Data,Typeable) > -- | Represents a type name, used in casts. diff --git a/tools/Language/SQL/SimpleSQL/FullQueries.lhs b/tools/Language/SQL/SimpleSQL/FullQueries.lhs index af7daa5..a7a3052 100644 --- a/tools/Language/SQL/SimpleSQL/FullQueries.lhs +++ b/tools/Language/SQL/SimpleSQL/FullQueries.lhs @@ -11,8 +11,8 @@ Some tests for parsing full queries. > fullQueriesTests = Group "queries" $ map (uncurry (TestQueryExpr ansi2011)) > [("select count(*) from t" > ,makeSelect -> {qeSelectList = [(App [Name "count"] [Star], Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] +> {qeSelectList = [(App [Name Nothing "count"] [Star], Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]] > } > ) @@ -23,17 +23,17 @@ Some tests for parsing full queries. > \ having count(1) > 5\n\ > \ order by s" > ,makeSelect -> {qeSelectList = [(Iden [Name "a"], Nothing) -> ,(App [Name "sum"] -> [BinOp (Iden [Name "c"]) -> [Name "+"] (Iden [Name "d"])] -> ,Just $ Name "s")] -> ,qeFrom = [TRSimple [Name "t"], TRSimple [Name "u"]] -> ,qeWhere = Just $ BinOp (Iden [Name "a"]) [Name ">"] (NumLit "5") -> ,qeGroupBy = [SimpleGroup $ Iden [Name "a"]] -> ,qeHaving = Just $ BinOp (App [Name "count"] [NumLit "1"]) -> [Name ">"] (NumLit "5") -> ,qeOrderBy = [SortSpec (Iden [Name "s"]) DirDefault NullsOrderDefault] +> {qeSelectList = [(Iden [Name Nothing "a"], Nothing) +> ,(App [Name Nothing "sum"] +> [BinOp (Iden [Name Nothing "c"]) +> [Name Nothing "+"] (Iden [Name Nothing "d"])] +> ,Just $ Name Nothing "s")] +> ,qeFrom = [TRSimple [Name Nothing "t"], TRSimple [Name Nothing "u"]] +> ,qeWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5") +> ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]] +> ,qeHaving = Just $ BinOp (App [Name Nothing "count"] [NumLit "1"]) +> [Name Nothing ">"] (NumLit "5") +> ,qeOrderBy = [SortSpec (Iden [Name Nothing "s"]) DirDefault NullsOrderDefault] > } > ) > ] diff --git a/tools/Language/SQL/SimpleSQL/GroupBy.lhs b/tools/Language/SQL/SimpleSQL/GroupBy.lhs index 5b5e7e6..6edc6c7 100644 --- a/tools/Language/SQL/SimpleSQL/GroupBy.lhs +++ b/tools/Language/SQL/SimpleSQL/GroupBy.lhs @@ -17,19 +17,19 @@ Here are the tests for the group by component of query exprs > simpleGroupBy :: TestItem > simpleGroupBy = Group "simpleGroupBy" $ map (uncurry (TestQueryExpr ansi2011)) > [("select a,sum(b) from t group by a" -> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing) -> ,(App [Name "sum"] [Iden [Name "b"]],Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] -> ,qeGroupBy = [SimpleGroup $ Iden [Name "a"]] +> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing) +> ,(App [Name Nothing "sum"] [Iden [Name Nothing "b"]],Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]] +> ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]] > }) > ,("select a,b,sum(c) from t group by a,b" -> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing) -> ,(Iden [Name "b"],Nothing) -> ,(App [Name "sum"] [Iden [Name "c"]],Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] -> ,qeGroupBy = [SimpleGroup $ Iden [Name "a"] -> ,SimpleGroup $ Iden [Name "b"]] +> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing) +> ,(Iden [Name Nothing "b"],Nothing) +> ,(App [Name Nothing "sum"] [Iden [Name Nothing "c"]],Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]] +> ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"] +> ,SimpleGroup $ Iden [Name Nothing "b"]] > }) > ] @@ -41,15 +41,15 @@ sure which sql version they were introduced, 1999 or 2003 I think). > [("select * from t group by ()", ms [GroupingParens []]) > ,("select * from t group by grouping sets ((), (a))" > ,ms [GroupingSets [GroupingParens [] -> ,GroupingParens [SimpleGroup $ Iden [Name "a"]]]]) +> ,GroupingParens [SimpleGroup $ Iden [Name Nothing "a"]]]]) > ,("select * from t group by cube(a,b)" -> ,ms [Cube [SimpleGroup $ Iden [Name "a"], SimpleGroup $ Iden [Name "b"]]]) +> ,ms [Cube [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]]) > ,("select * from t group by rollup(a,b)" -> ,ms [Rollup [SimpleGroup $ Iden [Name "a"], SimpleGroup $ Iden [Name "b"]]]) +> ,ms [Rollup [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]]) > ] > where > ms g = makeSelect {qeSelectList = [(Star,Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] +> ,qeFrom = [TRSimple [Name Nothing "t"]] > ,qeGroupBy = g} > randomGroupBy :: TestItem diff --git a/tools/Language/SQL/SimpleSQL/LexerTests.lhs b/tools/Language/SQL/SimpleSQL/LexerTests.lhs index cc487fa..63499c5 100644 --- a/tools/Language/SQL/SimpleSQL/LexerTests.lhs +++ b/tools/Language/SQL/SimpleSQL/LexerTests.lhs @@ -17,16 +17,16 @@ Test for the lexer > ++ map (\s -> (s,[Symbol s])) [">=","<=","!=","<>","||"] > ++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"] > -- simple identifiers -> in map (\i -> (i, [Identifier i])) idens -> ++ map (\i -> ("\"" ++ i ++ "\"", [QuotedIdentifier "\"" "\"" i])) idens +> in map (\i -> (i, [Identifier Nothing i])) idens +> ++ map (\i -> ("\"" ++ i ++ "\"", [Identifier (Just ("\"","\"")) i])) idens > -- todo: in order to make lex . pretty id, need to > -- preserve the case of the u -> ++ map (\i -> ("u&\"" ++ i ++ "\"", [QuotedIdentifier "u&\"" "\"" i])) idens +> ++ map (\i -> ("u&\"" ++ i ++ "\"", [Identifier (Just ("u&\"","\"")) i])) idens > -- host param > ++ map (\i -> (':':i, [HostParam i])) idens > ) > -- quoted identifiers with embedded double quotes -> ++ [("\"normal \"\" iden\"", [QuotedIdentifier "\"" "\"" "normal \" iden"])] +> ++ [("\"normal \"\" iden\"", [Identifier (Just ("\"","\"")) "normal \" iden"])] > -- strings > ++ [("'string'", [SqlString "'" "'" "string"]) > ,("'normal '' quote'", [SqlString "'" "'" "normal ' quote"]) @@ -82,7 +82,7 @@ number number (todo: double check more carefully) > ,Group "adhoc lexer tests" $ > map (uncurry $ LexerTest ansi2011) > [("", []) -> ,("-- line com\nstuff", [LineComment "-- line com\n",Identifier "stuff"]) +> ,("-- line com\nstuff", [LineComment "-- line com\n",Identifier Nothing "stuff"]) > ] > ] @@ -121,11 +121,11 @@ number number (todo: double check more carefully) > ,(isHostParam, isNumber) > ,(isMinus, isLineComment) > ] -> isIdentifier (Identifier _) = True +> isIdentifier (Identifier Nothing _) = True > isIdentifier _ = False -> isDQIdentifier (QuotedIdentifier "\"" _ _) = True +> isDQIdentifier (Identifier (Just ("\"",_)) _) = True > isDQIdentifier _ = False -> isCQIdentifier (QuotedIdentifier (x:_) _ _) | isAlpha x = True +> isCQIdentifier (Identifier (Just ((x:_),_)) _) | isAlpha x = True > isCQIdentifier _ = False > isCsString (SqlString (x:_) _ _) | isAlpha x = True > isCsString _ = False diff --git a/tools/Language/SQL/SimpleSQL/MySQL.lhs b/tools/Language/SQL/SimpleSQL/MySQL.lhs index 4020de2..1c85f44 100644 --- a/tools/Language/SQL/SimpleSQL/MySQL.lhs +++ b/tools/Language/SQL/SimpleSQL/MySQL.lhs @@ -19,7 +19,7 @@ limit syntax > backtickQuotes :: TestItem > backtickQuotes = Group "backtickQuotes" (map (uncurry (TestValueExpr mysql)) -> [("`test`", Iden [QuotedName "`" "`" "test"]) +> [("`test`", Iden [Name (Just ("`","`")) "test"]) > ] > ++ [ParseValueExprFails ansi2011 "`test`"] > ) @@ -36,5 +36,5 @@ limit syntax > where > sel = makeSelect > {qeSelectList = [(Star, Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] +> ,qeFrom = [TRSimple [Name Nothing "t"]] > } diff --git a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs index ec82dbf..99b2d16 100644 --- a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs +++ b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs @@ -36,8 +36,8 @@ These are a few misc tests which don't fit anywhere else. > where > ms d = makeSelect > {qeSetQuantifier = d -> ,qeSelectList = [(Iden [Name "a"],Nothing)] -> ,qeFrom = [TRSimple [Name "t"]]} +> ,qeSelectList = [(Iden [Name Nothing "a"],Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]]} > selectLists :: TestItem > selectLists = Group "selectLists" $ map (uncurry (TestQueryExpr ansi2011)) @@ -45,29 +45,29 @@ These are a few misc tests which don't fit anywhere else. > makeSelect {qeSelectList = [(NumLit "1",Nothing)]}) > ,("select a" -> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)]}) +> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]}) > ,("select a,b" -> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing) -> ,(Iden [Name "b"],Nothing)]}) +> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing) +> ,(Iden [Name Nothing "b"],Nothing)]}) > ,("select 1+2,3+4" > ,makeSelect {qeSelectList = -> [(BinOp (NumLit "1") [Name "+"] (NumLit "2"),Nothing) -> ,(BinOp (NumLit "3") [Name "+"] (NumLit "4"),Nothing)]}) +> [(BinOp (NumLit "1") [Name Nothing "+"] (NumLit "2"),Nothing) +> ,(BinOp (NumLit "3") [Name Nothing "+"] (NumLit "4"),Nothing)]}) > ,("select a as a, /*comment*/ b as b" -> ,makeSelect {qeSelectList = [(Iden [Name "a"], Just $ Name "a") -> ,(Iden [Name "b"], Just $ Name "b")]}) +> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "a") +> ,(Iden [Name Nothing "b"], Just $ Name Nothing "b")]}) > ,("select a a, b b" -> ,makeSelect {qeSelectList = [(Iden [Name "a"], Just $ Name "a") -> ,(Iden [Name "b"], Just $ Name "b")]}) +> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "a") +> ,(Iden [Name Nothing "b"], Just $ Name Nothing "b")]}) > ,("select a + b * c" > ,makeSelect {qeSelectList = -> [(BinOp (Iden [Name "a"]) [Name "+"] -> (BinOp (Iden [Name "b"]) [Name "*"] (Iden [Name "c"])) +> [(BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] +> (BinOp (Iden [Name Nothing "b"]) [Name Nothing "*"] (Iden [Name Nothing "c"])) > ,Nothing)]}) > ] @@ -75,47 +75,47 @@ These are a few misc tests which don't fit anywhere else. > whereClause :: TestItem > whereClause = Group "whereClause" $ map (uncurry (TestQueryExpr ansi2011)) > [("select a from t where a = 5" -> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] -> ,qeWhere = Just $ BinOp (Iden [Name "a"]) [Name "="] (NumLit "5")}) +> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]] +> ,qeWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "5")}) > ] > having :: TestItem > having = Group "having" $ map (uncurry (TestQueryExpr ansi2011)) > [("select a,sum(b) from t group by a having sum(b) > 5" -> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing) -> ,(App [Name "sum"] [Iden [Name "b"]],Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] -> ,qeGroupBy = [SimpleGroup $ Iden [Name "a"]] -> ,qeHaving = Just $ BinOp (App [Name "sum"] [Iden [Name "b"]]) -> [Name ">"] (NumLit "5") +> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing) +> ,(App [Name Nothing "sum"] [Iden [Name Nothing "b"]],Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]] +> ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]] +> ,qeHaving = Just $ BinOp (App [Name Nothing "sum"] [Iden [Name Nothing "b"]]) +> [Name Nothing ">"] (NumLit "5") > }) > ] > orderBy :: TestItem > orderBy = Group "orderBy" $ map (uncurry (TestQueryExpr ansi2011)) > [("select a from t order by a" -> ,ms [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault]) +> ,ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault]) > ,("select a from t order by a, b" -> ,ms [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault -> ,SortSpec (Iden [Name "b"]) DirDefault NullsOrderDefault]) +> ,ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault +> ,SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault]) > ,("select a from t order by a asc" -> ,ms [SortSpec (Iden [Name "a"]) Asc NullsOrderDefault]) +> ,ms [SortSpec (Iden [Name Nothing "a"]) Asc NullsOrderDefault]) > ,("select a from t order by a desc, b desc" -> ,ms [SortSpec (Iden [Name "a"]) Desc NullsOrderDefault -> ,SortSpec (Iden [Name "b"]) Desc NullsOrderDefault]) +> ,ms [SortSpec (Iden [Name Nothing "a"]) Desc NullsOrderDefault +> ,SortSpec (Iden [Name Nothing "b"]) Desc NullsOrderDefault]) > ,("select a from t order by a desc nulls first, b desc nulls last" -> ,ms [SortSpec (Iden [Name "a"]) Desc NullsFirst -> ,SortSpec (Iden [Name "b"]) Desc NullsLast]) +> ,ms [SortSpec (Iden [Name Nothing "a"]) Desc NullsFirst +> ,SortSpec (Iden [Name Nothing "b"]) Desc NullsLast]) > ] > where -> ms o = makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] +> ms o = makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]] > ,qeOrderBy = o} > offsetFetch :: TestItem @@ -136,8 +136,8 @@ These are a few misc tests which don't fit anywhere else. > ] > where > ms o l = makeSelect -> {qeSelectList = [(Iden [Name "a"],Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] +> {qeSelectList = [(Iden [Name Nothing "a"],Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]] > ,qeOffset = o > ,qeFetchFirst = l} @@ -165,33 +165,33 @@ These are a few misc tests which don't fit anywhere else. > ] > where > ms1 = makeSelect -> {qeSelectList = [(Iden [Name "a"],Nothing)] -> ,qeFrom = [TRSimple [Name "t"]]} +> {qeSelectList = [(Iden [Name Nothing "a"],Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]]} > ms2 = makeSelect -> {qeSelectList = [(Iden [Name "b"],Nothing)] -> ,qeFrom = [TRSimple [Name "u"]]} +> {qeSelectList = [(Iden [Name Nothing "b"],Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "u"]]} > withQueries :: TestItem > withQueries = Group "with queries" $ map (uncurry (TestQueryExpr ansi2011)) > [("with u as (select a from t) select a from u" -> ,With False [(Alias (Name "u") Nothing, ms1)] ms2) +> ,With False [(Alias (Name Nothing "u") Nothing, ms1)] ms2) > ,("with u(b) as (select a from t) select a from u" -> ,With False [(Alias (Name "u") (Just [Name "b"]), ms1)] ms2) +> ,With False [(Alias (Name Nothing "u") (Just [Name Nothing "b"]), ms1)] ms2) > ,("with x as (select a from t),\n\ > \ u as (select a from x)\n\ > \select a from u" -> ,With False [(Alias (Name "x") Nothing, ms1), (Alias (Name "u") Nothing,ms3)] ms2) +> ,With False [(Alias (Name Nothing "x") Nothing, ms1), (Alias (Name Nothing "u") Nothing,ms3)] ms2) > ,("with recursive u as (select a from t) select a from u" -> ,With True [(Alias (Name "u") Nothing, ms1)] ms2) +> ,With True [(Alias (Name Nothing "u") Nothing, ms1)] ms2) > ] > where > ms c t = makeSelect -> {qeSelectList = [(Iden [Name c],Nothing)] -> ,qeFrom = [TRSimple [Name t]]} +> {qeSelectList = [(Iden [Name Nothing c],Nothing)] +> ,qeFrom = [TRSimple [Name Nothing t]]} > ms1 = ms "a" "t" > ms2 = ms "a" "u" > ms3 = ms "a" "x" @@ -205,5 +205,5 @@ These are a few misc tests which don't fit anywhere else. > tables :: TestItem > tables = Group "tables" $ map (uncurry (TestQueryExpr ansi2011)) -> [("table tbl", Table [Name "tbl"]) +> [("table tbl", Table [Name Nothing "tbl"]) > ] diff --git a/tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs b/tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs index 7de2f06..cc52215 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs @@ -76,125 +76,125 @@ grant, etc > (TestStatement ansi2011 > "grant all privileges on tbl1 to role1" > $ GrantPrivilege [PrivAll] -> (PrivTable [Name "tbl1"]) -> [Name "role1"] WithoutGrantOption) +> (PrivTable [Name Nothing "tbl1"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant all privileges on tbl1 to role1,role2" > $ GrantPrivilege [PrivAll] -> (PrivTable [Name "tbl1"]) -> [Name "role1",Name "role2"] WithoutGrantOption) +> (PrivTable [Name Nothing "tbl1"]) +> [Name Nothing "role1",Name Nothing "role2"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant all privileges on tbl1 to role1 with grant option" > $ GrantPrivilege [PrivAll] -> (PrivTable [Name "tbl1"]) -> [Name "role1"] WithGrantOption) +> (PrivTable [Name Nothing "tbl1"]) +> [Name Nothing "role1"] WithGrantOption) > ,(TestStatement ansi2011 > "grant all privileges on table tbl1 to role1" > $ GrantPrivilege [PrivAll] -> (PrivTable [Name "tbl1"]) -> [Name "role1"] WithoutGrantOption) +> (PrivTable [Name Nothing "tbl1"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant all privileges on domain mydom to role1" > $ GrantPrivilege [PrivAll] -> (PrivDomain [Name "mydom"]) -> [Name "role1"] WithoutGrantOption) +> (PrivDomain [Name Nothing "mydom"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant all privileges on type t1 to role1" > $ GrantPrivilege [PrivAll] -> (PrivType [Name "t1"]) -> [Name "role1"] WithoutGrantOption) +> (PrivType [Name Nothing "t1"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant all privileges on sequence s1 to role1" > $ GrantPrivilege [PrivAll] -> (PrivSequence [Name "s1"]) -> [Name "role1"] WithoutGrantOption) +> (PrivSequence [Name Nothing "s1"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant select on table t1 to role1" > $ GrantPrivilege [PrivSelect []] -> (PrivTable [Name "t1"]) -> [Name "role1"] WithoutGrantOption) +> (PrivTable [Name Nothing "t1"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant select(a,b) on table t1 to role1" -> $ GrantPrivilege [PrivSelect [Name "a", Name "b"]] -> (PrivTable [Name "t1"]) -> [Name "role1"] WithoutGrantOption) +> $ GrantPrivilege [PrivSelect [Name Nothing "a", Name Nothing "b"]] +> (PrivTable [Name Nothing "t1"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant delete on table t1 to role1" > $ GrantPrivilege [PrivDelete] -> (PrivTable [Name "t1"]) -> [Name "role1"] WithoutGrantOption) +> (PrivTable [Name Nothing "t1"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant insert on table t1 to role1" > $ GrantPrivilege [PrivInsert []] -> (PrivTable [Name "t1"]) -> [Name "role1"] WithoutGrantOption) +> (PrivTable [Name Nothing "t1"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant insert(a,b) on table t1 to role1" -> $ GrantPrivilege [PrivInsert [Name "a", Name "b"]] -> (PrivTable [Name "t1"]) -> [Name "role1"] WithoutGrantOption) +> $ GrantPrivilege [PrivInsert [Name Nothing "a", Name Nothing "b"]] +> (PrivTable [Name Nothing "t1"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant update on table t1 to role1" > $ GrantPrivilege [PrivUpdate []] -> (PrivTable [Name "t1"]) -> [Name "role1"] WithoutGrantOption) +> (PrivTable [Name Nothing "t1"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant update(a,b) on table t1 to role1" -> $ GrantPrivilege [PrivUpdate [Name "a", Name "b"]] -> (PrivTable [Name "t1"]) -> [Name "role1"] WithoutGrantOption) +> $ GrantPrivilege [PrivUpdate [Name Nothing "a", Name Nothing "b"]] +> (PrivTable [Name Nothing "t1"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant references on table t1 to role1" > $ GrantPrivilege [PrivReferences []] -> (PrivTable [Name "t1"]) -> [Name "role1"] WithoutGrantOption) +> (PrivTable [Name Nothing "t1"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant references(a,b) on table t1 to role1" -> $ GrantPrivilege [PrivReferences [Name "a", Name "b"]] -> (PrivTable [Name "t1"]) -> [Name "role1"] WithoutGrantOption) +> $ GrantPrivilege [PrivReferences [Name Nothing "a", Name Nothing "b"]] +> (PrivTable [Name Nothing "t1"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant usage on table t1 to role1" > $ GrantPrivilege [PrivUsage] -> (PrivTable [Name "t1"]) -> [Name "role1"] WithoutGrantOption) +> (PrivTable [Name Nothing "t1"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant trigger on table t1 to role1" > $ GrantPrivilege [PrivTrigger] -> (PrivTable [Name "t1"]) -> [Name "role1"] WithoutGrantOption) +> (PrivTable [Name Nothing "t1"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant execute on specific function f to role1" > $ GrantPrivilege [PrivExecute] -> (PrivFunction [Name "f"]) -> [Name "role1"] WithoutGrantOption) +> (PrivFunction [Name Nothing "f"]) +> [Name Nothing "role1"] WithoutGrantOption) > ,(TestStatement ansi2011 > "grant select,delete on table t1 to role1" > $ GrantPrivilege [PrivSelect [], PrivDelete] -> (PrivTable [Name "t1"]) -> [Name "role1"] WithoutGrantOption) +> (PrivTable [Name Nothing "t1"]) +> [Name Nothing "role1"] WithoutGrantOption) skipping for now: @@ -219,7 +219,7 @@ functions, etc., by argument types since they can be overloaded > ,(TestStatement ansi2011 > "create role rolee" -> $ CreateRole (Name "rolee")) +> $ CreateRole (Name Nothing "rolee")) 12.5 @@ -235,16 +235,16 @@ functions, etc., by argument types since they can be overloaded > ,(TestStatement ansi2011 > "grant role1 to public" -> $ GrantRole [Name "role1"] [Name "public"] WithoutAdminOption) +> $ GrantRole [Name Nothing "role1"] [Name Nothing "public"] WithoutAdminOption) > ,(TestStatement ansi2011 > "grant role1,role2 to role3,role4" -> $ GrantRole [Name "role1",Name "role2"] -> [Name "role3", Name "role4"] WithoutAdminOption) +> $ GrantRole [Name Nothing "role1",Name Nothing "role2"] +> [Name Nothing "role3", Name Nothing "role4"] WithoutAdminOption) > ,(TestStatement ansi2011 > "grant role1 to role3 with admin option" -> $ GrantRole [Name "role1"] [Name "role3"] WithAdminOption) +> $ GrantRole [Name Nothing "role1"] [Name Nothing "role3"] WithAdminOption) 12.6 @@ -254,7 +254,7 @@ functions, etc., by argument types since they can be overloaded > ,(TestStatement ansi2011 > "drop role rolee" -> $ DropRole (Name "rolee")) +> $ DropRole (Name Nothing "rolee")) 12.7 @@ -277,14 +277,14 @@ functions, etc., by argument types since they can be overloaded > ,(TestStatement ansi2011 > "revoke select on t1 from role1" > $ RevokePrivilege NoGrantOptionFor [PrivSelect []] -> (PrivTable [Name "t1"]) -> [Name "role1"] DefaultDropBehaviour) +> (PrivTable [Name Nothing "t1"]) +> [Name Nothing "role1"] DefaultDropBehaviour) > ,(TestStatement ansi2011 > "revoke grant option for select on t1 from role1,role2 cascade" > $ RevokePrivilege GrantOptionFor [PrivSelect []] -> (PrivTable [Name "t1"]) -> [Name "role1",Name "role2"] Cascade) +> (PrivTable [Name Nothing "t1"]) +> [Name Nothing "role1",Name Nothing "role2"] Cascade) ::= @@ -298,18 +298,18 @@ functions, etc., by argument types since they can be overloaded > ,(TestStatement ansi2011 > "revoke role1 from role2" -> $ RevokeRole NoAdminOptionFor [Name "role1"] -> [Name "role2"] DefaultDropBehaviour) +> $ RevokeRole NoAdminOptionFor [Name Nothing "role1"] +> [Name Nothing "role2"] DefaultDropBehaviour) > ,(TestStatement ansi2011 > "revoke role1,role2 from role3,role4" -> $ RevokeRole NoAdminOptionFor [Name "role1",Name "role2"] -> [Name "role3",Name "role4"] DefaultDropBehaviour) +> $ RevokeRole NoAdminOptionFor [Name Nothing "role1",Name Nothing "role2"] +> [Name Nothing "role3",Name Nothing "role4"] DefaultDropBehaviour) > ,(TestStatement ansi2011 > "revoke admin option for role1 from role2 cascade" -> $ RevokeRole AdminOptionFor [Name "role1"] [Name "role2"] Cascade) +> $ RevokeRole AdminOptionFor [Name Nothing "role1"] [Name Nothing "role2"] Cascade) > ] diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Bits.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Bits.lhs index 685820d..3e13a51 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011Bits.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011Bits.lhs @@ -79,7 +79,7 @@ BEGIN is not in the standard! > ,(TestStatement ansi2011 > "savepoint difficult_bit" -> $ Savepoint $ Name "difficult_bit") +> $ Savepoint $ Name Nothing "difficult_bit") 17.6 @@ -89,7 +89,7 @@ BEGIN is not in the standard! > ,(TestStatement ansi2011 > "release savepoint difficult_bit" -> $ ReleaseSavepoint $ Name "difficult_bit") +> $ ReleaseSavepoint $ Name Nothing "difficult_bit") 17.7 @@ -124,7 +124,7 @@ BEGIN is not in the standard! > ,(TestStatement ansi2011 > "rollback to savepoint difficult_bit" -> $ Rollback $ Just $ Name "difficult_bit") +> $ Rollback $ Just $ Name Nothing "difficult_bit") 19 Session management diff --git a/tools/Language/SQL/SimpleSQL/SQL2011DataManipulation.lhs b/tools/Language/SQL/SimpleSQL/SQL2011DataManipulation.lhs index 3c2149a..2f6ce48 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011DataManipulation.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011DataManipulation.lhs @@ -109,19 +109,19 @@ Section 14 in Foundation [ WHERE ] > (TestStatement ansi2011 "delete from t" -> $ Delete [Name "t"] Nothing Nothing) +> $ Delete [Name Nothing "t"] Nothing Nothing) > ,(TestStatement ansi2011 "delete from t as u" -> $ Delete [Name "t"] (Just (Name "u")) Nothing) +> $ Delete [Name Nothing "t"] (Just (Name Nothing "u")) Nothing) > ,(TestStatement ansi2011 "delete from t where x = 5" -> $ Delete [Name "t"] Nothing -> (Just $ BinOp (Iden [Name "x"]) [Name "="] (NumLit "5"))) +> $ Delete [Name Nothing "t"] Nothing +> (Just $ BinOp (Iden [Name Nothing "x"]) [Name Nothing "="] (NumLit "5"))) > ,(TestStatement ansi2011 "delete from t as u where u.x = 5" -> $ Delete [Name "t"] (Just (Name "u")) -> (Just $ BinOp (Iden [Name "u", Name "x"]) [Name "="] (NumLit "5"))) +> $ Delete [Name Nothing "t"] (Just (Name Nothing "u")) +> (Just $ BinOp (Iden [Name Nothing "u", Name Nothing "x"]) [Name Nothing "="] (NumLit "5"))) 14.10 @@ -133,13 +133,13 @@ Section 14 in Foundation | RESTART IDENTITY > ,(TestStatement ansi2011 "truncate table t" -> $ Truncate [Name "t"] DefaultIdentityRestart) +> $ Truncate [Name Nothing "t"] DefaultIdentityRestart) > ,(TestStatement ansi2011 "truncate table t continue identity" -> $ Truncate [Name "t"] ContinueIdentity) +> $ Truncate [Name Nothing "t"] ContinueIdentity) > ,(TestStatement ansi2011 "truncate table t restart identity" -> $ Truncate [Name "t"] RestartIdentity) +> $ Truncate [Name Nothing "t"] RestartIdentity) 14.11 @@ -176,35 +176,35 @@ Section 14 in Foundation > ,(TestStatement ansi2011 "insert into t select * from u" -> $ Insert [Name "t"] Nothing +> $ Insert [Name Nothing "t"] Nothing > $ InsertQuery makeSelect > {qeSelectList = [(Star, Nothing)] -> ,qeFrom = [TRSimple [Name "u"]]}) +> ,qeFrom = [TRSimple [Name Nothing "u"]]}) > ,(TestStatement ansi2011 "insert into t(a,b,c) select * from u" -> $ Insert [Name "t"] (Just [Name "a", Name "b", Name "c"]) +> $ Insert [Name Nothing "t"] (Just [Name Nothing "a", Name Nothing "b", Name Nothing "c"]) > $ InsertQuery makeSelect > {qeSelectList = [(Star, Nothing)] -> ,qeFrom = [TRSimple [Name "u"]]}) +> ,qeFrom = [TRSimple [Name Nothing "u"]]}) > ,(TestStatement ansi2011 "insert into t default values" -> $ Insert [Name "t"] Nothing DefaultInsertValues) +> $ Insert [Name Nothing "t"] Nothing DefaultInsertValues) > ,(TestStatement ansi2011 "insert into t values(1,2)" -> $ Insert [Name "t"] Nothing +> $ Insert [Name Nothing "t"] Nothing > $ InsertQuery $ Values [[NumLit "1", NumLit "2"]]) > ,(TestStatement ansi2011 "insert into t values (1,2),(3,4)" -> $ Insert [Name "t"] Nothing +> $ Insert [Name Nothing "t"] Nothing > $ InsertQuery $ Values [[NumLit "1", NumLit "2"] > ,[NumLit "3", NumLit "4"]]) > ,(TestStatement ansi2011 > "insert into t values (default,null,array[],multiset[])" -> $ Insert [Name "t"] Nothing -> $ InsertQuery $ Values [[Iden [Name "default"] -> ,Iden [Name "null"] -> ,Array (Iden [Name "array"]) [] +> $ Insert [Name Nothing "t"] Nothing +> $ InsertQuery $ Values [[Iden [Name Nothing "default"] +> ,Iden [Name Nothing "null"] +> ,Array (Iden [Name Nothing "array"]) [] > ,MultisetCtor []]]) @@ -448,30 +448,30 @@ FROM CentralOfficeAccounts; > ,(TestStatement ansi2011 "update t set a=b" -> $ Update [Name "t"] Nothing -> [Set [Name "a"] (Iden [Name "b"])] Nothing) +> $ Update [Name Nothing "t"] Nothing +> [Set [Name Nothing "a"] (Iden [Name Nothing "b"])] Nothing) > ,(TestStatement ansi2011 "update t set a=b, c=5" -> $ Update [Name "t"] Nothing -> [Set [Name "a"] (Iden [Name "b"]) -> ,Set [Name "c"] (NumLit "5")] Nothing) +> $ Update [Name Nothing "t"] Nothing +> [Set [Name Nothing "a"] (Iden [Name Nothing "b"]) +> ,Set [Name Nothing "c"] (NumLit "5")] Nothing) > ,(TestStatement ansi2011 "update t set a=b where a>5" -> $ Update [Name "t"] Nothing -> [Set [Name "a"] (Iden [Name "b"])] -> $ Just $ BinOp (Iden [Name "a"]) [Name ">"] (NumLit "5")) +> $ Update [Name Nothing "t"] Nothing +> [Set [Name Nothing "a"] (Iden [Name Nothing "b"])] +> $ Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5")) > ,(TestStatement ansi2011 "update t as u set a=b where u.a>5" -> $ Update [Name "t"] (Just $ Name "u") -> [Set [Name "a"] (Iden [Name "b"])] -> $ Just $ BinOp (Iden [Name "u",Name "a"]) -> [Name ">"] (NumLit "5")) +> $ Update [Name Nothing "t"] (Just $ Name Nothing "u") +> [Set [Name Nothing "a"] (Iden [Name Nothing "b"])] +> $ Just $ BinOp (Iden [Name Nothing "u",Name Nothing "a"]) +> [Name Nothing ">"] (NumLit "5")) > ,(TestStatement ansi2011 "update t set (a,b)=(3,5)" -> $ Update [Name "t"] Nothing -> [SetMultiple [[Name "a"],[Name "b"]] +> $ Update [Name Nothing "t"] Nothing +> [SetMultiple [[Name Nothing "a"],[Name Nothing "b"]] > [NumLit "3", NumLit "5"]] Nothing) diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs index 819056b..d437d80 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs @@ -523,7 +523,7 @@ ascii characters in strings and identifiers unless the current SQL character set allows them. > ,("_francais 'français'" -> ,TypedLit (TypeName [Name "_francais"]) "français") +> ,TypedLit (TypeName [Name Nothing "_francais"]) "français") > ] ::= @@ -551,10 +551,10 @@ character set allows them. > unicodeCharacterStringLiterals = Group "unicode character string literals" > $ map (uncurry (TestValueExpr ansi2011)) > [("U&'something'", StringLit "U&'" "'" "something") -> ,("u&'something' escape =" +> {-,("u&'something' escape =" > ,Escape (StringLit "u&'" "'" "something") '=') > ,("u&'something' uescape =" -> ,UEscape (StringLit "u&'" "'" "something") '=') +> ,UEscape (StringLit "u&'" "'" "something") '=')-} > ] TODO: unicode escape @@ -571,7 +571,7 @@ TODO: unicode escape > $ map (uncurry (TestValueExpr ansi2011)) > [--("B'101010'", CSStringLit "B" "101010") > ("X'7f7f7f'", StringLit "X'" "'" "7f7f7f") -> ,("X'7f7f7f' escape z", Escape (StringLit "X'" "'" "7f7f7f") 'z') +> --,("X'7f7f7f' escape z", Escape (StringLit "X'" "'" "7f7f7f") 'z') > ] ::= [ ] @@ -610,19 +610,19 @@ TODO: unicode escape > ,("11.11E+23", NumLit "11.11E+23") > ,("11.11E-23", NumLit "11.11E-23") -> ,("+11E23", PrefixOp [Name "+"] $ NumLit "11E23") -> ,("+11E+23", PrefixOp [Name "+"] $ NumLit "11E+23") -> ,("+11E-23", PrefixOp [Name "+"] $ NumLit "11E-23") -> ,("+11.11E23", PrefixOp [Name "+"] $ NumLit "11.11E23") -> ,("+11.11E+23", PrefixOp [Name "+"] $ NumLit "11.11E+23") -> ,("+11.11E-23", PrefixOp [Name "+"] $ NumLit "11.11E-23") +> ,("+11E23", PrefixOp [Name Nothing "+"] $ NumLit "11E23") +> ,("+11E+23", PrefixOp [Name Nothing "+"] $ NumLit "11E+23") +> ,("+11E-23", PrefixOp [Name Nothing "+"] $ NumLit "11E-23") +> ,("+11.11E23", PrefixOp [Name Nothing "+"] $ NumLit "11.11E23") +> ,("+11.11E+23", PrefixOp [Name Nothing "+"] $ NumLit "11.11E+23") +> ,("+11.11E-23", PrefixOp [Name Nothing "+"] $ NumLit "11.11E-23") -> ,("-11E23", PrefixOp [Name "-"] $ NumLit "11E23") -> ,("-11E+23", PrefixOp [Name "-"] $ NumLit "11E+23") -> ,("-11E-23", PrefixOp [Name "-"] $ NumLit "11E-23") -> ,("-11.11E23", PrefixOp [Name "-"] $ NumLit "11.11E23") -> ,("-11.11E+23", PrefixOp [Name "-"] $ NumLit "11.11E+23") -> ,("-11.11E-23", PrefixOp [Name "-"] $ NumLit "11.11E-23") +> ,("-11E23", PrefixOp [Name Nothing "-"] $ NumLit "11E23") +> ,("-11E+23", PrefixOp [Name Nothing "-"] $ NumLit "11E+23") +> ,("-11E-23", PrefixOp [Name Nothing "-"] $ NumLit "11E-23") +> ,("-11.11E23", PrefixOp [Name Nothing "-"] $ NumLit "11.11E23") +> ,("-11.11E+23", PrefixOp [Name Nothing "-"] $ NumLit "11.11E+23") +> ,("-11.11E-23", PrefixOp [Name Nothing "-"] $ NumLit "11.11E-23") > ,("11.11e23", NumLit "11.11e23") @@ -705,7 +705,7 @@ TODO: unicode escape > intervalLiterals :: TestItem > intervalLiterals = Group "intervalLiterals literals" > $ map (uncurry (TestValueExpr ansi2011)) -> [("interval '1'", TypedLit (TypeName [Name "interval"]) "1") +> [("interval '1'", TypedLit (TypeName [Name Nothing "interval"]) "1") > ,("interval '1' day" > ,IntervalLit Nothing "1" (Itf "day" Nothing) Nothing) > ,("interval '1' day(3)" @@ -728,9 +728,9 @@ TODO: unicode escape > booleanLiterals :: TestItem > booleanLiterals = Group "boolean literals" > $ map (uncurry (TestValueExpr ansi2011)) -> [("true", Iden [Name "true"]) -> ,("false", Iden [Name "false"]) -> ,("unknown", Iden [Name "unknown"]) +> [("true", Iden [Name Nothing "true"]) +> ,("false", Iden [Name Nothing "false"]) +> ,("unknown", Iden [Name Nothing "unknown"]) > ] == 5.4 Names and identifiers @@ -748,15 +748,15 @@ Specify names. > identifiers :: TestItem > identifiers = Group "identifiers" > $ map (uncurry (TestValueExpr ansi2011)) -> [("test",Iden [Name "test"]) -> ,("_test",Iden [Name "_test"]) -> ,("t1",Iden [Name "t1"]) -> ,("a.b",Iden [Name "a", Name "b"]) -> ,("a.b.c",Iden [Name "a", Name "b", Name "c"]) -> ,("\"quoted iden\"", Iden [QuotedName "\"" "\"" "quoted iden"]) -> ,("\"quoted \"\" iden\"", Iden [QuotedName "\"" "\"" "quoted \" iden"]) -> ,("U&\"quoted iden\"", Iden [QuotedName "U&\"" "\"" "quoted iden"]) -> ,("U&\"quoted \"\" iden\"", Iden [QuotedName "U&\"" "\"" "quoted \" iden"]) +> [("test",Iden [Name Nothing "test"]) +> ,("_test",Iden [Name Nothing "_test"]) +> ,("t1",Iden [Name Nothing "t1"]) +> ,("a.b",Iden [Name Nothing "a", Name Nothing "b"]) +> ,("a.b.c",Iden [Name Nothing "a", Name Nothing "b", Name Nothing "c"]) +> ,("\"quoted iden\"", Iden [Name (Just ("\"","\"")) "quoted iden"]) +> ,("\"quoted \"\" iden\"", Iden [Name (Just ("\"","\"")) "quoted \" iden"]) +> ,("U&\"quoted iden\"", Iden [Name (Just ("U&\"","\"")) "quoted iden"]) +> ,("U&\"quoted \"\" iden\"", Iden [Name (Just ("U&\"","\"")) "quoted \" iden"]) > ] TODO: more identifiers, e.g. unicode escapes?, mixed quoted/unquoted @@ -1034,7 +1034,7 @@ create a list of type name variations: > makeMultiset (s,t) = (s ++ " multiset", MultisetTypeName t) > basicTypes = > -- example of every standard type name -> map (\t -> (t,TypeName [Name t])) +> map (\t -> (t,TypeName [Name Nothing t])) > ["binary" > ,"binary varying" > ,"character" @@ -1078,92 +1078,92 @@ create a list of type name variations: > ++ > [-- 1 single prec + 1 with multiname -> ("char(5)", PrecTypeName [Name "char"] 5) -> ,("char varying(5)", PrecTypeName [Name "char varying"] 5) +> ("char(5)", PrecTypeName [Name Nothing "char"] 5) +> ,("char varying(5)", PrecTypeName [Name Nothing "char varying"] 5) > -- 1 scale -> ,("decimal(15,2)", PrecScaleTypeName [Name "decimal"] 15 2) +> ,("decimal(15,2)", PrecScaleTypeName [Name Nothing "decimal"] 15 2) > ,("char(3 octets)" -> ,PrecLengthTypeName [Name "char"] 3 Nothing (Just PrecOctets)) +> ,PrecLengthTypeName [Name Nothing "char"] 3 Nothing (Just PrecOctets)) > ,("varchar(50 characters)" -> ,PrecLengthTypeName [Name "varchar"] 50 Nothing (Just PrecCharacters)) +> ,PrecLengthTypeName [Name Nothing "varchar"] 50 Nothing (Just PrecCharacters)) > -- lob prec + with multiname -> ,("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(3M)", PrecLengthTypeName [Name Nothing "blob"] 3 (Just PrecM) Nothing) +> ,("blob(3T)", PrecLengthTypeName [Name Nothing "blob"] 3 (Just PrecT) Nothing) +> ,("blob(3P)", PrecLengthTypeName [Name Nothing "blob"] 3 (Just PrecP) Nothing) > ,("blob(4M characters) " -> ,PrecLengthTypeName [Name "blob"] 4 (Just PrecM) (Just PrecCharacters)) +> ,PrecLengthTypeName [Name Nothing "blob"] 4 (Just PrecM) (Just PrecCharacters)) > ,("blob(6G octets) " -> ,PrecLengthTypeName [Name "blob"] 6 (Just PrecG) (Just PrecOctets)) +> ,PrecLengthTypeName [Name Nothing "blob"] 6 (Just PrecG) (Just PrecOctets)) > ,("national character large object(7K) " -> ,PrecLengthTypeName [Name "national character large object"] +> ,PrecLengthTypeName [Name Nothing "national character large object"] > 7 (Just PrecK) Nothing) > -- 1 with and without tz > ,("time with time zone" -> ,TimeTypeName [Name "time"] Nothing True) +> ,TimeTypeName [Name Nothing "time"] Nothing True) > ,("datetime(3) without time zone" -> ,TimeTypeName [Name "datetime"] (Just 3) False) +> ,TimeTypeName [Name Nothing "datetime"] (Just 3) False) > -- chars: (single/multiname) x prec x charset x collate > -- 1111 > ,("char varying(5) character set something collate something_insensitive" -> ,CharTypeName [Name "char varying"] (Just 5) -> [Name "something"] [Name "something_insensitive"]) +> ,CharTypeName [Name Nothing "char varying"] (Just 5) +> [Name Nothing "something"] [Name Nothing "something_insensitive"]) > -- 0111 > ,("char(5) character set something collate something_insensitive" -> ,CharTypeName [Name "char"] (Just 5) -> [Name "something"] [Name "something_insensitive"]) +> ,CharTypeName [Name Nothing "char"] (Just 5) +> [Name Nothing "something"] [Name Nothing "something_insensitive"]) > -- 1011 > ,("char varying character set something collate something_insensitive" -> ,CharTypeName [Name "char varying"] Nothing -> [Name "something"] [Name "something_insensitive"]) +> ,CharTypeName [Name Nothing "char varying"] Nothing +> [Name Nothing "something"] [Name Nothing "something_insensitive"]) > -- 0011 > ,("char character set something collate something_insensitive" -> ,CharTypeName [Name "char"] Nothing -> [Name "something"] [Name "something_insensitive"]) +> ,CharTypeName [Name Nothing "char"] Nothing +> [Name Nothing "something"] [Name Nothing "something_insensitive"]) > -- 1101 > ,("char varying(5) collate something_insensitive" -> ,CharTypeName [Name "char varying"] (Just 5) -> [] [Name "something_insensitive"]) +> ,CharTypeName [Name Nothing "char varying"] (Just 5) +> [] [Name Nothing "something_insensitive"]) > -- 0101 > ,("char(5) collate something_insensitive" -> ,CharTypeName [Name "char"] (Just 5) -> [] [Name "something_insensitive"]) +> ,CharTypeName [Name Nothing "char"] (Just 5) +> [] [Name Nothing "something_insensitive"]) > -- 1001 > ,("char varying collate something_insensitive" -> ,CharTypeName [Name "char varying"] Nothing -> [] [Name "something_insensitive"]) +> ,CharTypeName [Name Nothing "char varying"] Nothing +> [] [Name Nothing "something_insensitive"]) > -- 0001 > ,("char collate something_insensitive" -> ,CharTypeName [Name "char"] Nothing -> [] [Name "something_insensitive"]) +> ,CharTypeName [Name Nothing "char"] Nothing +> [] [Name Nothing "something_insensitive"]) > -- 1110 > ,("char varying(5) character set something" -> ,CharTypeName [Name "char varying"] (Just 5) -> [Name "something"] []) +> ,CharTypeName [Name Nothing "char varying"] (Just 5) +> [Name Nothing "something"] []) > -- 0110 > ,("char(5) character set something" -> ,CharTypeName [Name "char"] (Just 5) -> [Name "something"] []) +> ,CharTypeName [Name Nothing "char"] (Just 5) +> [Name Nothing "something"] []) > -- 1010 > ,("char varying character set something" -> ,CharTypeName [Name "char varying"] Nothing -> [Name "something"] []) +> ,CharTypeName [Name Nothing "char varying"] Nothing +> [Name Nothing "something"] []) > -- 0010 > ,("char character set something" -> ,CharTypeName [Name "char"] Nothing -> [Name "something"] []) +> ,CharTypeName [Name Nothing "char"] Nothing +> [Name Nothing "something"] []) > -- 1100 > ,("char varying character set something" -> ,CharTypeName [Name "char varying"] Nothing -> [Name "something"] []) +> ,CharTypeName [Name Nothing "char varying"] Nothing +> [Name Nothing "something"] []) > -- single row field, two row field -> ,("row(a int)", RowTypeName [(Name "a", TypeName [Name "int"])]) +> ,("row(a int)", RowTypeName [(Name Nothing "a", TypeName [Name Nothing "int"])]) > ,("row(a int,b char)" -> ,RowTypeName [(Name "a", TypeName [Name "int"]) -> ,(Name "b", TypeName [Name "char"])]) +> ,RowTypeName [(Name Nothing "a", TypeName [Name Nothing "int"]) +> ,(Name Nothing "b", TypeName [Name Nothing "char"])]) > -- interval each type raw > ,("interval year" > ,IntervalTypeName (Itf "year" Nothing) Nothing) @@ -1216,8 +1216,8 @@ Define a field of a row type. > $ map (uncurry (TestValueExpr ansi2011)) > [("cast('(1,2)' as row(a int,b char))" > ,Cast (StringLit "'" "'" "(1,2)") -> $ RowTypeName [(Name "a", TypeName [Name "int"]) -> ,(Name "b", TypeName [Name "char"])])] +> $ RowTypeName [(Name Nothing "a", TypeName [Name Nothing "int"]) +> ,(Name Nothing "b", TypeName [Name Nothing "char"])])] == 6.3 @@ -1339,7 +1339,7 @@ Specify one or more values, host parameters, SQL parameters, dynamic parameters, > ,"USER" > ,"VALUE"] > where -> mkIden nm = (nm,Iden [Name nm]) +> mkIden nm = (nm,Iden [Name Nothing nm]) TODO: add the missing bits @@ -1421,10 +1421,10 @@ Specify a value whose data type is to be inferred from its context. > contextuallyTypedValueSpecification = > Group "contextually typed value specification" > $ map (uncurry (TestValueExpr ansi2011)) -> [("null", Iden [Name "null"]) -> ,("array[]", Array (Iden [Name "array"]) []) +> [("null", Iden [Name Nothing "null"]) +> ,("array[]", Array (Iden [Name Nothing "array"]) []) > ,("multiset[]", MultisetCtor []) -> ,("default", Iden [Name "default"]) +> ,("default", Iden [Name Nothing "default"]) > ] == 6.6 @@ -1439,7 +1439,7 @@ Disambiguate a -separated chain of identifiers. > identifierChain :: TestItem > identifierChain = Group "identifier chain" > $ map (uncurry (TestValueExpr ansi2011)) -> [("a.b", Iden [Name "a",Name "b"])] +> [("a.b", Iden [Name Nothing "a",Name Nothing "b"])] == 6.7 @@ -1453,7 +1453,7 @@ Reference a column. > columnReference :: TestItem > columnReference = Group "column reference" > $ map (uncurry (TestValueExpr ansi2011)) -> [("module.a.b", Iden [Name "module",Name "a",Name "b"])] +> [("module.a.b", Iden [Name Nothing "module",Name Nothing "a",Name Nothing "b"])] == 6.8 @@ -1481,13 +1481,13 @@ Specify a value derived by the application of a function to an argument. > \FROM Sales.SalesPerson\n\ > \GROUP BY ROLLUP(SalesQuota);" > ,makeSelect -> {qeSelectList = [(Iden [Name "SalesQuota"],Nothing) -> ,(App [Name "SUM"] [Iden [Name "SalesYTD"]] -> ,Just (Name "TotalSalesYTD")) -> ,(App [Name "GROUPING"] [Iden [Name "SalesQuota"]] -> ,Just (Name "Grouping"))] -> ,qeFrom = [TRSimple [Name "Sales",Name "SalesPerson"]] -> ,qeGroupBy = [Rollup [SimpleGroup (Iden [Name "SalesQuota"])]]}) +> {qeSelectList = [(Iden [Name Nothing "SalesQuota"],Nothing) +> ,(App [Name Nothing "SUM"] [Iden [Name Nothing "SalesYTD"]] +> ,Just (Name Nothing "TotalSalesYTD")) +> ,(App [Name Nothing "GROUPING"] [Iden [Name Nothing "SalesQuota"]] +> ,Just (Name Nothing "Grouping"))] +> ,qeFrom = [TRSimple [Name Nothing "Sales",Name Nothing "SalesPerson"]] +> ,qeGroupBy = [Rollup [SimpleGroup (Iden [Name Nothing "SalesQuota"])]]}) > ] == 6.10 @@ -1678,7 +1678,7 @@ Specify a data conversion. > castSpecification = Group "cast specification" > $ map (uncurry (TestValueExpr ansi2011)) > [("cast(a as int)" -> ,Cast (Iden [Name "a"]) (TypeName [Name "int"])) +> ,Cast (Iden [Name Nothing "a"]) (TypeName [Name Nothing "int"])) > ] == 6.14 @@ -1691,7 +1691,7 @@ Return the next value of a sequence generator. > nextValueExpression :: TestItem > nextValueExpression = Group "next value expression" > $ map (uncurry (TestValueExpr ansi2011)) -> [("next value for a.b", NextValueFor [Name "a", Name "b"]) +> [("next value for a.b", NextValueFor [Name Nothing "a", Name Nothing "b"]) > ] == 6.15 @@ -1705,9 +1705,9 @@ Reference a field of a row value. > fieldReference = Group "field reference" > $ map (uncurry (TestValueExpr ansi2011)) > [("f(something).a" -> ,BinOp (App [Name "f"] [Iden [Name "something"]]) -> [Name "."] -> (Iden [Name "a"])) +> ,BinOp (App [Name Nothing "f"] [Iden [Name Nothing "something"]]) +> [Name Nothing "."] +> (Iden [Name Nothing "a"])) > ] TODO: try all possible value expression syntax variations followed by @@ -1829,15 +1829,15 @@ Return an element of an array. > arrayElementReference = Group "array element reference" > $ map (uncurry (TestValueExpr ansi2011)) > [("something[3]" -> ,Array (Iden [Name "something"]) [NumLit "3"]) +> ,Array (Iden [Name Nothing "something"]) [NumLit "3"]) > ,("(something(a))[x]" -> ,Array (Parens (App [Name "something"] [Iden [Name "a"]])) -> [Iden [Name "x"]]) +> ,Array (Parens (App [Name Nothing "something"] [Iden [Name Nothing "a"]])) +> [Iden [Name Nothing "x"]]) > ,("(something(a))[x][y] " > ,Array ( -> Array (Parens (App [Name "something"] [Iden [Name "a"]])) -> [Iden [Name "x"]]) -> [Iden [Name "y"]]) +> Array (Parens (App [Name Nothing "something"] [Iden [Name Nothing "a"]])) +> [Iden [Name Nothing "x"]]) +> [Iden [Name Nothing "y"]]) > ] == 6.25 @@ -1852,7 +1852,7 @@ Return the sole element of a multiset of one element. > multisetElementReference = Group "multisetElementReference" > $ map (uncurry (TestValueExpr ansi2011)) > [("element(something)" -> ,App [Name "element"] [Iden [Name "something"]]) +> ,App [Name Nothing "element"] [Iden [Name Nothing "something"]]) > ] == 6.26 @@ -1909,8 +1909,8 @@ Specify a numeric value. > ,("-a", prefOp "-") > ] > where -> binOp o = BinOp (Iden [Name "a"]) [Name o] (Iden [Name "b"]) -> prefOp o = PrefixOp [Name o] (Iden [Name "a"]) +> binOp o = BinOp (Iden [Name Nothing "a"]) [Name Nothing o] (Iden [Name Nothing "b"]) +> prefOp o = PrefixOp [Name Nothing o] (Iden [Name Nothing "a"]) TODO: precedence and associativity tests (need to review all operators for what precendence and associativity tests to write) @@ -2358,21 +2358,21 @@ Specify a boolean value. > booleanValueExpression :: TestItem > booleanValueExpression = Group "booleab value expression" > $ map (uncurry (TestValueExpr ansi2011)) -> [("a or b", BinOp a [Name "or"] b) -> ,("a and b", BinOp a [Name "and"] b) -> ,("not a", PrefixOp [Name "not"] a) +> [("a or b", BinOp a [Name Nothing "or"] b) +> ,("a and b", BinOp a [Name Nothing "and"] b) +> ,("not a", PrefixOp [Name Nothing "not"] a) > ,("a is true", postfixOp "is true") > ,("a is false", postfixOp "is false") > ,("a is unknown", postfixOp "is unknown") > ,("a is not true", postfixOp "is not true") > ,("a is not false", postfixOp "is not false") > ,("a is not unknown", postfixOp "is not unknown") -> ,("(a or b)", Parens $ BinOp a [Name "or"] b) +> ,("(a or b)", Parens $ BinOp a [Name Nothing "or"] b) > ] > where -> a = Iden [Name "a"] -> b = Iden [Name "b"] -> postfixOp nm = PostfixOp [Name nm] a +> a = Iden [Name Nothing "a"] +> b = Iden [Name Nothing "b"] +> postfixOp nm = PostfixOp [Name Nothing nm] a TODO: review if more tests are needed. Should at least have precendence tests for mixed and, or and not without parens. @@ -2434,20 +2434,20 @@ Specify construction of an array. > arrayValueConstructor = Group "array value constructor" > $ map (uncurry (TestValueExpr ansi2011)) > [("array[1,2,3]" -> ,Array (Iden [Name "array"]) +> ,Array (Iden [Name Nothing "array"]) > [NumLit "1", NumLit "2", NumLit "3"]) > ,("array[a,b,c]" -> ,Array (Iden [Name "array"]) -> [Iden [Name "a"], Iden [Name "b"], Iden [Name "c"]]) +> ,Array (Iden [Name Nothing "array"]) +> [Iden [Name Nothing "a"], Iden [Name Nothing "b"], Iden [Name Nothing "c"]]) > ,("array(select * from t)" > ,ArrayCtor (makeSelect > {qeSelectList = [(Star,Nothing)] -> ,qeFrom = [TRSimple [Name "t"]]})) +> ,qeFrom = [TRSimple [Name Nothing "t"]]})) > ,("array(select * from t order by a)" > ,ArrayCtor (makeSelect > {qeSelectList = [(Star,Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] -> ,qeOrderBy = [SortSpec (Iden [Name "a"]) +> ,qeFrom = [TRSimple [Name Nothing "t"]] +> ,qeOrderBy = [SortSpec (Iden [Name Nothing "a"]) > DirDefault NullsOrderDefault]})) > ] @@ -2472,15 +2472,15 @@ Specify a multiset value. > multisetValueExpression = Group "multiset value expression" > $ map (uncurry (TestValueExpr ansi2011)) > [("a multiset union b" -> ,MultisetBinOp (Iden [Name "a"]) Union SQDefault (Iden [Name "b"])) +> ,MultisetBinOp (Iden [Name Nothing "a"]) Union SQDefault (Iden [Name Nothing "b"])) > ,("a multiset union all b" -> ,MultisetBinOp (Iden [Name "a"]) Union All (Iden [Name "b"])) +> ,MultisetBinOp (Iden [Name Nothing "a"]) Union All (Iden [Name Nothing "b"])) > ,("a multiset union distinct b" -> ,MultisetBinOp (Iden [Name "a"]) Union Distinct (Iden [Name "b"])) +> ,MultisetBinOp (Iden [Name Nothing "a"]) Union Distinct (Iden [Name Nothing "b"])) > ,("a multiset except b" -> ,MultisetBinOp (Iden [Name "a"]) Except SQDefault (Iden [Name "b"])) +> ,MultisetBinOp (Iden [Name Nothing "a"]) Except SQDefault (Iden [Name Nothing "b"])) > ,("a multiset intersect b" -> ,MultisetBinOp (Iden [Name "a"]) Intersect SQDefault (Iden [Name "b"])) +> ,MultisetBinOp (Iden [Name Nothing "a"]) Intersect SQDefault (Iden [Name Nothing "b"])) > ] TODO: check precedence and associativity @@ -2501,7 +2501,7 @@ special case term. > multisetValueFunction :: TestItem > multisetValueFunction = Group "multiset value function" > $ map (uncurry (TestValueExpr ansi2011)) -> [("set(a)", App [Name "set"] [Iden [Name "a"]]) +> [("set(a)", App [Name Nothing "set"] [Iden [Name Nothing "a"]]) > ] == 6.41 @@ -2529,14 +2529,14 @@ Specify construction of a multiset. > multisetValueConstructor :: TestItem > multisetValueConstructor = Group "multiset value constructor" > $ map (uncurry (TestValueExpr ansi2011)) -> [("multiset[a,b,c]", MultisetCtor[Iden [Name "a"] -> ,Iden [Name "b"], Iden [Name "c"]]) +> [("multiset[a,b,c]", MultisetCtor[Iden [Name Nothing "a"] +> ,Iden [Name Nothing "b"], Iden [Name Nothing "c"]]) > ,("multiset(select * from t)", MultisetQueryCtor qe) > ,("table(select * from t)", MultisetQueryCtor qe) > ] > where > qe = makeSelect {qeSelectList = [(Star,Nothing)] -> ,qeFrom = [TRSimple [Name "t"]]} +> ,qeFrom = [TRSimple [Name Nothing "t"]]} = 7 Query expressions @@ -2608,9 +2608,9 @@ Specify a value or list of values to be constructed into a row. > rowValueConstructor = Group "row value constructor" > $ map (uncurry (TestValueExpr ansi2011)) > [("(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"]) +> ,SpecialOp [Name Nothing "rowctor"] [Iden [Name Nothing "a"], Iden [Name Nothing "b"]]) +> ,("row(1)",App [Name Nothing "row"] [NumLit "1"]) +> ,("row(1,2)",App [Name Nothing "row"] [NumLit "1",NumLit "2"]) > ] == 7.2 @@ -2660,12 +2660,12 @@ Specify a set of s to be constructed into a table. > $ map (uncurry (TestQueryExpr ansi2011)) > [("values (1,2), (a+b,(select count(*) from t));" > ,Values [[NumLit "1", NumLit "2"] -> ,[BinOp (Iden [Name "a"]) [Name "+"] -> (Iden [Name "b"]) +> ,[BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] +> (Iden [Name Nothing "b"]) > ,SubQueryExpr SqSq > (makeSelect -> {qeSelectList = [(App [Name "count"] [Star],Nothing)] -> ,qeFrom = [TRSimple [Name "t"]]})]]) +> {qeSelectList = [(App [Name Nothing "count"] [Star],Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]]})]]) > ] == 7.4 @@ -2696,7 +2696,7 @@ Specify a table derived from one or more tables. > [("select * from tbl1,tbl2" > ,makeSelect > {qeSelectList = [(Star, Nothing)] -> ,qeFrom = [TRSimple [Name "tbl1"], TRSimple [Name "tbl2"]] +> ,qeFrom = [TRSimple [Name Nothing "tbl1"], TRSimple [Name Nothing "tbl2"]] > })] @@ -2829,18 +2829,18 @@ TODO: only > where > sel = makeSelect > {qeSelectList = [(Star, Nothing)] -> ,qeFrom = [TRSimple [Name "t"]]} +> ,qeFrom = [TRSimple [Name Nothing "t"]]} > af f s = s {qeFrom = map f (qeFrom s)} -> a s = af (\x -> TRAlias x $ Alias (Name "u") Nothing) s +> a s = af (\x -> TRAlias x $ Alias (Name Nothing "u") Nothing) s > sel1 = makeSelect > {qeSelectList = [(Star, Nothing)] -> ,qeFrom = [TRAlias (TRSimple [Name "t"]) -> $ Alias (Name "u") $ Just [Name "a", Name "b"]]} +> ,qeFrom = [TRAlias (TRSimple [Name Nothing "t"]) +> $ Alias (Name Nothing "u") $ Just [Name Nothing "a", Name Nothing "b"]]} > jsel = sel {qeFrom = -> [TRParens $ TRJoin (TRSimple [Name "a"]) +> [TRParens $ TRJoin (TRSimple [Name Nothing "a"]) > False > JInner -> (TRSimple [Name "b"]) +> (TRSimple [Name Nothing "b"]) > Nothing]} == 7.7 @@ -2893,25 +2893,25 @@ Specify a table derived from a Cartesian product, inner join, or outer join. > ,sel $ TRJoin a False JCross b Nothing) > ,("select * from a join b on true" > ,sel $ TRJoin a False JInner b -> (Just $ JoinOn $ Iden [Name "true"])) +> (Just $ JoinOn $ Iden [Name Nothing "true"])) > ,("select * from a join b using (c)" > ,sel $ TRJoin a False JInner b -> (Just $ JoinUsing [Name "c"])) +> (Just $ JoinUsing [Name Nothing "c"])) > ,("select * from a inner join b on true" > ,sel $ TRJoin a False JInner b -> (Just $ JoinOn $ Iden [Name "true"])) +> (Just $ JoinOn $ Iden [Name Nothing "true"])) > ,("select * from a left join b on true" > ,sel $ TRJoin a False JLeft b -> (Just $ JoinOn $ Iden [Name "true"])) +> (Just $ JoinOn $ Iden [Name Nothing "true"])) > ,("select * from a left outer join b on true" > ,sel $ TRJoin a False JLeft b -> (Just $ JoinOn $ Iden [Name "true"])) +> (Just $ JoinOn $ Iden [Name Nothing "true"])) > ,("select * from a right join b on true" > ,sel $ TRJoin a False JRight b -> (Just $ JoinOn $ Iden [Name "true"])) +> (Just $ JoinOn $ Iden [Name Nothing "true"])) > ,("select * from a full join b on true" > ,sel $ TRJoin a False JFull b -> (Just $ JoinOn $ Iden [Name "true"])) +> (Just $ JoinOn $ Iden [Name Nothing "true"])) > ,("select * from a natural join b" > ,sel $ TRJoin a True JInner b Nothing) > ,("select * from a natural inner join b" @@ -2929,8 +2929,8 @@ Specify a table derived from a Cartesian product, inner join, or outer join. > sel t = makeSelect > {qeSelectList = [(Star, Nothing)] > ,qeFrom = [t]} -> a = TRSimple [Name "a"] -> b = TRSimple [Name "b"] +> a = TRSimple [Name Nothing "a"] +> b = TRSimple [Name Nothing "b"] TODO: partitioned joins @@ -2949,8 +2949,8 @@ the result of the preceding . > [("select * from t where a = 5" > ,makeSelect > {qeSelectList = [(Star,Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] -> ,qeWhere = Just $ BinOp (Iden [Name "a"]) [Name "="] (NumLit "5")})] +> ,qeFrom = [TRSimple [Name Nothing "t"]] +> ,qeWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "5")})] == 7.9 @@ -3007,40 +3007,40 @@ clause> to the result of the previously specified clause. > groupByClause = Group "group by clause" > $ map (uncurry (TestQueryExpr ansi2011)) > [("select a,sum(x) from t group by a" -> ,qe [SimpleGroup $ Iden [Name "a"]]) +> ,qe [SimpleGroup $ Iden [Name Nothing "a"]]) > ,("select a,sum(x) from t group by a collate c" -> ,qe [SimpleGroup $ Collate (Iden [Name "a"]) [Name "c"]]) +> ,qe [SimpleGroup $ Collate (Iden [Name Nothing "a"]) [Name Nothing "c"]]) > ,("select a,b,sum(x) from t group by a,b" -> ,qex [SimpleGroup $ Iden [Name "a"] -> ,SimpleGroup $ Iden [Name "b"]]) +> ,qex [SimpleGroup $ Iden [Name Nothing "a"] +> ,SimpleGroup $ Iden [Name Nothing "b"]]) > -- todo: group by set quantifier > --,("select a,sum(x) from t group by distinct a" > --,undefined) > --,("select a,sum(x) from t group by all a" > -- ,undefined) > ,("select a,b,sum(x) from t group by rollup(a,b)" -> ,qex [Rollup [SimpleGroup $ Iden [Name "a"] -> ,SimpleGroup $ Iden [Name "b"]]]) +> ,qex [Rollup [SimpleGroup $ Iden [Name Nothing "a"] +> ,SimpleGroup $ Iden [Name Nothing "b"]]]) > ,("select a,b,sum(x) from t group by cube(a,b)" -> ,qex [Cube [SimpleGroup $ Iden [Name "a"] -> ,SimpleGroup $ Iden [Name "b"]]]) +> ,qex [Cube [SimpleGroup $ Iden [Name Nothing "a"] +> ,SimpleGroup $ Iden [Name Nothing "b"]]]) > ,("select a,b,sum(x) from t group by grouping sets((),(a,b))" > ,qex [GroupingSets [GroupingParens [] -> ,GroupingParens [SimpleGroup $ Iden [Name "a"] -> ,SimpleGroup $ Iden [Name "b"]]]]) +> ,GroupingParens [SimpleGroup $ Iden [Name Nothing "a"] +> ,SimpleGroup $ Iden [Name Nothing "b"]]]]) > ,("select sum(x) from t group by ()" > ,let x = qe [GroupingParens []] > in x {qeSelectList = tail $ qeSelectList x}) > ] > where > qe g = makeSelect -> {qeSelectList = [(Iden [Name "a"], Nothing) -> ,(App [Name "sum"] [Iden [Name "x"]], Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] +> {qeSelectList = [(Iden [Name Nothing "a"], Nothing) +> ,(App [Name Nothing "sum"] [Iden [Name Nothing "x"]], Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]] > ,qeGroupBy = g} > qex g = let x = qe g > in x {qeSelectList = let [a,b] = qeSelectList x -> in [a,(Iden [Name "b"],Nothing),b]} +> in [a,(Iden [Name Nothing "b"],Nothing),b]} == 7.10 @@ -3056,12 +3056,12 @@ not satisfy a . > $ map (uncurry (TestQueryExpr ansi2011)) > [("select a,sum(x) from t group by a having sum(x) > 1000" > ,makeSelect -> {qeSelectList = [(Iden [Name "a"], Nothing) -> ,(App [Name "sum"] [Iden [Name "x"]], Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] -> ,qeGroupBy = [SimpleGroup $ Iden [Name "a"]] -> ,qeHaving = Just $ BinOp (App [Name "sum"] [Iden [Name "x"]]) -> [Name ">"] +> {qeSelectList = [(Iden [Name Nothing "a"], Nothing) +> ,(App [Name Nothing "sum"] [Iden [Name Nothing "x"]], Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]] +> ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]] +> ,qeHaving = Just $ BinOp (App [Name Nothing "sum"] [Iden [Name Nothing "x"]]) +> [Name Nothing ">"] > (NumLit "1000")}) > ] @@ -3182,22 +3182,22 @@ Specify a table derived from the result of a
. > ,("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 +> ,qe {qeSelectList = [(BinOp (Iden [Name Nothing "a"]) [Name Nothing "."] Star > ,Nothing)]}) > ,("select a b from t" -> ,qe {qeSelectList = [(Iden [Name "a"], Just $ Name "b")]}) +> ,qe {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "b")]}) > ,("select a as b from t" -> ,qe {qeSelectList = [(Iden [Name "a"], Just $ Name "b")]}) +> ,qe {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "b")]}) > ,("select a,b from t" -> ,qe {qeSelectList = [(Iden [Name "a"], Nothing) -> ,(Iden [Name "b"], Nothing)]}) +> ,qe {qeSelectList = [(Iden [Name Nothing "a"], Nothing) +> ,(Iden [Name Nothing "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"]] +> {qeSelectList = [(Iden [Name Nothing "a"], Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]] > } == 7.13 @@ -3282,7 +3282,7 @@ everywhere > explicitTableQueryExpression :: TestItem > explicitTableQueryExpression= Group "explicit table query expression" > $ map (uncurry (TestQueryExpr ansi2011)) -> [("table t", Table [Name "t"]) +> [("table t", Table [Name Nothing "t"]) > ] @@ -3306,7 +3306,7 @@ everywhere > $ map (uncurry (TestQueryExpr ansi2011)) > [-- todo: finish tests for order offset and fetch > ("select a from t order by a" -> ,qe {qeOrderBy = [SortSpec (Iden [Name "a"]) +> ,qe {qeOrderBy = [SortSpec (Iden [Name Nothing "a"]) > DirDefault NullsOrderDefault]}) > ,("select a from t offset 5 row" > ,qe {qeOffset = Just $ NumLit "5"}) @@ -3320,8 +3320,8 @@ everywhere > ] > where > qe = makeSelect -> {qeSelectList = [(Iden [Name "a"], Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] +> {qeSelectList = [(Iden [Name Nothing "a"], Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]] > } @@ -3463,19 +3463,19 @@ Specify a comparison of two row values. > $ map (uncurry (TestValueExpr ansi2011)) > $ map mkOp ["=", "<>", "<", ">", "<=", ">="] > ++ [("ROW(a) = ROW(b)" -> ,BinOp (App [Name "ROW"] [a]) -> [Name "="] -> (App [Name "ROW"] [b])) +> ,BinOp (App [Name Nothing "ROW"] [a]) +> [Name Nothing "="] +> (App [Name Nothing "ROW"] [b])) > ,("(a,b) = (c,d)" -> ,BinOp (SpecialOp [Name "rowctor"] [a,b]) -> [Name "="] -> (SpecialOp [Name "rowctor"] [Iden [Name "c"], Iden [Name "d"]])) +> ,BinOp (SpecialOp [Name Nothing "rowctor"] [a,b]) +> [Name Nothing "="] +> (SpecialOp [Name Nothing "rowctor"] [Iden [Name Nothing "c"], Iden [Name Nothing "d"]])) > ] > where > mkOp nm = ("a " ++ nm ++ " b" -> ,BinOp a [Name nm] b) -> a = Iden [Name "a"] -> b = Iden [Name "b"] +> ,BinOp a [Name Nothing nm] b) +> a = Iden [Name Nothing "a"] +> b = Iden [Name Nothing "b"] TODO: what other tests, more complex expressions with comparisons? @@ -3667,20 +3667,20 @@ Specify a quantified comparison. > $ map (uncurry (TestValueExpr ansi2011)) > [("a = any (select * from t)" -> ,QuantifiedComparison (Iden [Name "a"]) [Name "="] CPAny qe) +> ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "="] CPAny qe) > ,("a <= some (select * from t)" -> ,QuantifiedComparison (Iden [Name "a"]) [Name "<="] CPSome qe) +> ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "<="] CPSome qe) > ,("a > all (select * from t)" -> ,QuantifiedComparison (Iden [Name "a"]) [Name ">"] CPAll qe) +> ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing ">"] CPAll qe) > ,("(a,b) <> all (select * from t)" > ,QuantifiedComparison -> (SpecialOp [Name "rowctor"] [Iden [Name "a"] -> ,Iden [Name "b"]]) [Name "<>"] CPAll qe) +> (SpecialOp [Name Nothing "rowctor"] [Iden [Name Nothing "a"] +> ,Iden [Name Nothing "b"]]) [Name Nothing "<>"] CPAll qe) > ] > where > qe = makeSelect > {qeSelectList = [(Star,Nothing)] -> ,qeFrom = [TRSimple [Name "t"]]} +> ,qeFrom = [TRSimple [Name Nothing "t"]]} == 8.10 @@ -3696,8 +3696,8 @@ Specify a test for a non-empty set. > ,SubQueryExpr SqExists > $ makeSelect > {qeSelectList = [(Star,Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] -> ,qeWhere = Just (BinOp (Iden [Name "a"]) [Name "="] (NumLit "4")) +> ,qeFrom = [TRSimple [Name Nothing "t"]] +> ,qeWhere = Just (BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "4")) > } > )] @@ -3715,8 +3715,8 @@ Specify a test for the absence of duplicate rows. > ,SubQueryExpr SqUnique > $ makeSelect > {qeSelectList = [(Star,Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] -> ,qeWhere = Just (BinOp (Iden [Name "a"]) [Name "="] (NumLit "4")) +> ,qeFrom = [TRSimple [Name Nothing "t"]] +> ,qeWhere = Just (BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "4")) > } > )] @@ -3748,20 +3748,20 @@ Specify a test for matching rows. > matchPredicate = Group "match predicate" > $ map (uncurry (TestValueExpr ansi2011)) > [("a match (select a from t)" -> ,Match (Iden [Name "a"]) False qe) +> ,Match (Iden [Name Nothing "a"]) False qe) > ,("(a,b) match (select a,b from t)" -> ,Match (SpecialOp [Name "rowctor"] -> [Iden [Name "a"], Iden [Name "b"]]) False qea) +> ,Match (SpecialOp [Name Nothing "rowctor"] +> [Iden [Name Nothing "a"], Iden [Name Nothing "b"]]) False qea) > ,("(a,b) match unique (select a,b from t)" -> ,Match (SpecialOp [Name "rowctor"] -> [Iden [Name "a"], Iden [Name "b"]]) True qea) +> ,Match (SpecialOp [Name Nothing "rowctor"] +> [Iden [Name Nothing "a"], Iden [Name Nothing "b"]]) True qea) > ] > where > qe = makeSelect -> {qeSelectList = [(Iden [Name "a"],Nothing)] -> ,qeFrom = [TRSimple [Name "t"]]} +> {qeSelectList = [(Iden [Name Nothing "a"],Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]]} > qea = qe {qeSelectList = qeSelectList qe -> ++ [(Iden [Name "b"],Nothing)]} +> ++ [(Iden [Name Nothing "b"],Nothing)]} TODO: simple, partial and full @@ -4100,7 +4100,7 @@ Specify a default collation. > collateClause = Group "collate clause" > $ map (uncurry (TestValueExpr ansi2011)) > [("a collate my_collation" -> ,Collate (Iden [Name "a"]) [Name "my_collation"])] +> ,Collate (Iden [Name Nothing "a"]) [Name Nothing "my_collation"])] == 10.8 and @@ -4210,25 +4210,25 @@ Specify a value computed from a collection of rows. > aggregateFunction :: TestItem > aggregateFunction = Group "aggregate function" > $ map (uncurry (TestValueExpr ansi2011)) $ -> [("count(*)",App [Name "count"] [Star]) +> [("count(*)",App [Name Nothing "count"] [Star]) > ,("count(*) filter (where something > 5)" -> ,AggregateApp [Name "count"] SQDefault [Star] [] fil) +> ,AggregateApp [Name Nothing "count"] SQDefault [Star] [] fil) gsf -> ,("count(a)",App [Name "count"] [Iden [Name "a"]]) +> ,("count(a)",App [Name Nothing "count"] [Iden [Name Nothing "a"]]) > ,("count(distinct a)" -> ,AggregateApp [Name "count"] +> ,AggregateApp [Name Nothing "count"] > Distinct -> [Iden [Name "a"]] [] Nothing) +> [Iden [Name Nothing "a"]] [] Nothing) > ,("count(all a)" -> ,AggregateApp [Name "count"] +> ,AggregateApp [Name Nothing "count"] > All -> [Iden [Name "a"]] [] Nothing) +> [Iden [Name Nothing "a"]] [] Nothing) > ,("count(all a) filter (where something > 5)" -> ,AggregateApp [Name "count"] +> ,AggregateApp [Name Nothing "count"] > All -> [Iden [Name "a"]] [] fil) +> [Iden [Name Nothing "a"]] [] fil) > ] ++ concatMap mkSimpleAgg > ["avg","max","min","sum" > ,"every", "any", "some" @@ -4247,41 +4247,41 @@ osf > ++ > [("rank(a,c) within group (order by b)" -> ,AggregateAppGroup [Name "rank"] -> [Iden [Name "a"], Iden [Name "c"]] +> ,AggregateAppGroup [Name Nothing "rank"] +> [Iden [Name Nothing "a"], Iden [Name Nothing "c"]] > ob)] > ++ map mkGp ["dense_rank","percent_rank" > ,"cume_dist", "percentile_cont" > ,"percentile_disc"] -> ++ [("array_agg(a)", App [Name "array_agg"] [Iden [Name "a"]]) +> ++ [("array_agg(a)", App [Name Nothing "array_agg"] [Iden [Name Nothing "a"]]) > ,("array_agg(a order by z)" -> ,AggregateApp [Name "array_agg"] +> ,AggregateApp [Name Nothing "array_agg"] > SQDefault -> [Iden [Name "a"]] -> [SortSpec (Iden [Name "z"]) +> [Iden [Name Nothing "a"]] +> [SortSpec (Iden [Name Nothing "z"]) > DirDefault NullsOrderDefault] > Nothing)] > where -> fil = Just $ BinOp (Iden [Name "something"]) [Name ">"] (NumLit "5") -> ob = [SortSpec (Iden [Name "b"]) DirDefault NullsOrderDefault] +> fil = Just $ BinOp (Iden [Name Nothing "something"]) [Name Nothing ">"] (NumLit "5") +> ob = [SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault] > mkGp nm = (nm ++ "(a) within group (order by b)" -> ,AggregateAppGroup [Name nm] -> [Iden [Name "a"]] +> ,AggregateAppGroup [Name Nothing nm] +> [Iden [Name Nothing "a"]] > ob) > mkSimpleAgg nm = -> [(nm ++ "(a)",App [Name nm] [Iden [Name "a"]]) +> [(nm ++ "(a)",App [Name Nothing nm] [Iden [Name Nothing "a"]]) > ,(nm ++ "(distinct a)" -> ,AggregateApp [Name nm] +> ,AggregateApp [Name Nothing nm] > Distinct -> [Iden [Name "a"]] [] Nothing)] +> [Iden [Name Nothing "a"]] [] Nothing)] > mkBsf nm = -> [(nm ++ "(a,b)",App [Name nm] [Iden [Name "a"],Iden [Name "b"]]) +> [(nm ++ "(a,b)",App [Name Nothing nm] [Iden [Name Nothing "a"],Iden [Name Nothing "b"]]) > ,(nm ++"(a,b) filter (where something > 5)" -> ,AggregateApp [Name nm] +> ,AggregateApp [Name Nothing nm] > SQDefault -> [Iden [Name "a"],Iden [Name "b"]] [] fil)] +> [Iden [Name Nothing "a"],Iden [Name Nothing "b"]] [] fil)] == 10.10 @@ -4306,28 +4306,28 @@ Specify a sort order. > sortSpecificationList = Group "sort specification list" > $ map (uncurry (TestQueryExpr ansi2011)) > [("select * from t order by a" -> ,qe {qeOrderBy = [SortSpec (Iden [Name "a"]) +> ,qe {qeOrderBy = [SortSpec (Iden [Name Nothing "a"]) > DirDefault NullsOrderDefault]}) > ,("select * from t order by a,b" -> ,qe {qeOrderBy = [SortSpec (Iden [Name "a"]) +> ,qe {qeOrderBy = [SortSpec (Iden [Name Nothing "a"]) > DirDefault NullsOrderDefault -> ,SortSpec (Iden [Name "b"]) +> ,SortSpec (Iden [Name Nothing "b"]) > DirDefault NullsOrderDefault]}) > ,("select * from t order by a asc,b" -> ,qe {qeOrderBy = [SortSpec (Iden [Name "a"]) +> ,qe {qeOrderBy = [SortSpec (Iden [Name Nothing "a"]) > Asc NullsOrderDefault -> ,SortSpec (Iden [Name "b"]) +> ,SortSpec (Iden [Name Nothing "b"]) > DirDefault NullsOrderDefault]}) > ,("select * from t order by a desc,b" -> ,qe {qeOrderBy = [SortSpec (Iden [Name "a"]) +> ,qe {qeOrderBy = [SortSpec (Iden [Name Nothing "a"]) > Desc NullsOrderDefault -> ,SortSpec (Iden [Name "b"]) +> ,SortSpec (Iden [Name Nothing "b"]) > DirDefault NullsOrderDefault]}) > ,("select * from t order by a collate x desc,b" > ,qe {qeOrderBy = [SortSpec -> (Collate (Iden [Name "a"]) [Name "x"]) +> (Collate (Iden [Name Nothing "a"]) [Name Nothing "x"]) > Desc NullsOrderDefault -> ,SortSpec (Iden [Name "b"]) +> ,SortSpec (Iden [Name Nothing "b"]) > DirDefault NullsOrderDefault]}) > ,("select * from t order by 1,2" > ,qe {qeOrderBy = [SortSpec (NumLit "1") @@ -4338,4 +4338,4 @@ Specify a sort order. > where > qe = makeSelect > {qeSelectList = [(Star,Nothing)] -> ,qeFrom = [TRSimple [Name "t"]]} +> ,qeFrom = [TRSimple [Name Nothing "t"]]} diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs index 65655f0..f2ca34d 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs @@ -21,7 +21,7 @@ This module covers the tests for parsing schema and DDL statements. [ ... ] > (TestStatement ansi2011 "create schema my_schema" -> $ CreateSchema [Name "my_schema"]) +> $ CreateSchema [Name Nothing "my_schema"]) todo: schema name can have . schema name can be quoted iden or unicode quoted iden @@ -80,11 +80,11 @@ add schema element support: > ,(TestStatement ansi2011 "drop schema my_schema" -> $ DropSchema [Name "my_schema"] DefaultDropBehaviour) +> $ DropSchema [Name Nothing "my_schema"] DefaultDropBehaviour) > ,(TestStatement ansi2011 "drop schema my_schema cascade" -> $ DropSchema [Name "my_schema"] Cascade) +> $ DropSchema [Name Nothing "my_schema"] Cascade) > ,(TestStatement ansi2011 "drop schema my_schema restrict" -> $ DropSchema [Name "my_schema"] Restrict) +> $ DropSchema [Name Nothing "my_schema"] Restrict) 11.3
@@ -95,9 +95,9 @@ add schema element support: [ ON COMMIT
ROWS ] > ,(TestStatement ansi2011 "create table t (a int, b int);" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] -> ,TableColumnDef $ ColumnDef (Name "b") (TypeName [Name "int"]) Nothing []]) +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing [] +> ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []])
::= @@ -312,26 +312,26 @@ todo: constraint characteristics > ,(TestStatement ansi2011 > "create table t (a int not null);" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing ColNotNullConstraint]]) > ,(TestStatement ansi2011 > "create table t (a int constraint a_not_null not null);" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ColConstraintDef (Just [Name "a_not_null"]) ColNotNullConstraint]]) +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing +> [ColConstraintDef (Just [Name Nothing "a_not_null"]) ColNotNullConstraint]]) > ,(TestStatement ansi2011 > "create table t (a int unique);" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing ColUniqueConstraint]]) > ,(TestStatement ansi2011 > "create table t (a int primary key);" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing ColPrimaryKeyConstraint]]) references t(a,b) @@ -341,99 +341,99 @@ references t(a,b) > ,(TestStatement ansi2011 > "create table t (a int references u);" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing $ ColReferencesConstraint -> [Name "u"] Nothing DefaultReferenceMatch +> [Name Nothing "u"] Nothing DefaultReferenceMatch > DefaultReferentialAction DefaultReferentialAction]]) > ,(TestStatement ansi2011 > "create table t (a int references u(a));" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing $ ColReferencesConstraint -> [Name "u"] (Just $ Name "a") DefaultReferenceMatch +> [Name Nothing "u"] (Just $ Name Nothing "a") DefaultReferenceMatch > DefaultReferentialAction DefaultReferentialAction]]) > ,(TestStatement ansi2011 > "create table t (a int references u match full);" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing $ ColReferencesConstraint -> [Name "u"] Nothing MatchFull +> [Name Nothing "u"] Nothing MatchFull > DefaultReferentialAction DefaultReferentialAction]]) > ,(TestStatement ansi2011 > "create table t (a int references u match partial);" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing $ ColReferencesConstraint -> [Name "u"] Nothing MatchPartial +> [Name Nothing "u"] Nothing MatchPartial > DefaultReferentialAction DefaultReferentialAction]]) > ,(TestStatement ansi2011 > "create table t (a int references u match simple);" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing $ ColReferencesConstraint -> [Name "u"] Nothing MatchSimple +> [Name Nothing "u"] Nothing MatchSimple > DefaultReferentialAction DefaultReferentialAction]]) > ,(TestStatement ansi2011 > "create table t (a int references u on update cascade );" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing $ ColReferencesConstraint -> [Name "u"] Nothing DefaultReferenceMatch +> [Name Nothing "u"] Nothing DefaultReferenceMatch > RefCascade DefaultReferentialAction]]) > ,(TestStatement ansi2011 > "create table t (a int references u on update set null );" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing $ ColReferencesConstraint -> [Name "u"] Nothing DefaultReferenceMatch +> [Name Nothing "u"] Nothing DefaultReferenceMatch > RefSetNull DefaultReferentialAction]]) > ,(TestStatement ansi2011 > "create table t (a int references u on update set default );" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing $ ColReferencesConstraint -> [Name "u"] Nothing DefaultReferenceMatch +> [Name Nothing "u"] Nothing DefaultReferenceMatch > RefSetDefault DefaultReferentialAction]]) > ,(TestStatement ansi2011 > "create table t (a int references u on update no action );" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing $ ColReferencesConstraint -> [Name "u"] Nothing DefaultReferenceMatch +> [Name Nothing "u"] Nothing DefaultReferenceMatch > RefNoAction DefaultReferentialAction]]) > ,(TestStatement ansi2011 > "create table t (a int references u on delete cascade );" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing $ ColReferencesConstraint -> [Name "u"] Nothing DefaultReferenceMatch +> [Name Nothing "u"] Nothing DefaultReferenceMatch > DefaultReferentialAction RefCascade]]) > ,(TestStatement ansi2011 > "create table t (a int references u on update cascade on delete restrict );" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing $ ColReferencesConstraint -> [Name "u"] Nothing DefaultReferenceMatch +> [Name Nothing "u"] Nothing DefaultReferenceMatch > RefCascade RefRestrict]]) > ,(TestStatement ansi2011 > "create table t (a int references u on delete restrict on update cascade );" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing $ ColReferencesConstraint -> [Name "u"] Nothing DefaultReferenceMatch +> [Name Nothing "u"] Nothing DefaultReferenceMatch > RefCascade RefRestrict]]) TODO: try combinations and permutations of column constraints and @@ -442,10 +442,10 @@ options > ,(TestStatement ansi2011 > "create table t (a int check (a>5));" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing > [ColConstraintDef Nothing -> (ColCheckConstraint $ BinOp (Iden [Name "a"]) [Name ">"] (NumLit "5"))]]) +> (ColCheckConstraint $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5"))]]) @@ -456,21 +456,21 @@ options [ ] > ,(TestStatement ansi2011 "create table t (a int generated always as identity);" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) > (Just $ IdentityColumnSpec GeneratedAlways []) []]) > ,(TestStatement ansi2011 "create table t (a int generated by default as identity);" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) > (Just $ IdentityColumnSpec GeneratedByDefault []) []]) > ,(TestStatement ansi2011 > "create table t (a int generated always as identity\n\ > \ ( start with 5 increment by 5 maxvalue 500 minvalue 5 cycle ));" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) > (Just $ IdentityColumnSpec GeneratedAlways > [SGOStartWith 5 > ,SGOIncrementBy 5 @@ -481,8 +481,8 @@ options > ,(TestStatement ansi2011 > "create table t (a int generated always as identity\n\ > \ ( start with -4 no maxvalue no minvalue no cycle ));" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) > (Just $ IdentityColumnSpec GeneratedAlways > [SGOStartWith (-4) > ,SGONoMaxValue @@ -509,11 +509,11 @@ generated always (valueexpr) > ,(TestStatement ansi2011 > "create table t (a int, \n\ > \ a2 int generated always as (a * 2));" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] -> ,TableColumnDef $ ColumnDef (Name "a2") (TypeName [Name "int"]) +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing [] +> ,TableColumnDef $ ColumnDef (Name Nothing "a2") (TypeName [Name Nothing "int"]) > (Just $ GenerationClause -> (BinOp (Iden [Name "a"]) [Name "*"] (NumLit "2"))) []]) +> (BinOp (Iden [Name Nothing "a"]) [Name Nothing "*"] (NumLit "2"))) []]) @@ -537,8 +537,8 @@ generated always (valueexpr) > ,(TestStatement ansi2011 "create table t (a int default 0);" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) > (Just $ DefaultClause $ NumLit "0") []]) @@ -570,37 +570,37 @@ generated always (valueexpr) > ,(TestStatement ansi2011 > "create table t (a int, unique (a));" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] -> ,TableConstraintDef Nothing $ TableUniqueConstraint [Name "a"] +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing [] +> ,TableConstraintDef Nothing $ TableUniqueConstraint [Name Nothing "a"] > ]) > ,(TestStatement ansi2011 > "create table t (a int, constraint a_unique unique (a));" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] -> ,TableConstraintDef (Just [Name "a_unique"]) $ -> TableUniqueConstraint [Name "a"] +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing [] +> ,TableConstraintDef (Just [Name Nothing "a_unique"]) $ +> TableUniqueConstraint [Name Nothing "a"] > ]) todo: test permutations of column defs and table constraints > ,(TestStatement ansi2011 > "create table t (a int, b int, unique (a,b));" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] -> ,TableColumnDef $ ColumnDef (Name "b") (TypeName [Name "int"]) Nothing [] +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing [] +> ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing [] > ,TableConstraintDef Nothing $ -> TableUniqueConstraint [Name "a", Name "b"] +> TableUniqueConstraint [Name Nothing "a", Name Nothing "b"] > ]) > ,(TestStatement ansi2011 > "create table t (a int, b int, primary key (a,b));" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] -> ,TableColumnDef $ ColumnDef (Name "b") (TypeName [Name "int"]) Nothing [] +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing [] +> ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing [] > ,TableConstraintDef Nothing $ -> TablePrimaryKeyConstraint [Name "a", Name "b"] +> TablePrimaryKeyConstraint [Name Nothing "a", Name Nothing "b"] > ]) @@ -621,26 +621,26 @@ defintely skip > ,(TestStatement ansi2011 > "create table t (a int, b int,\n\ > \ foreign key (a,b) references u(c,d) match full on update cascade on delete restrict );" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] -> ,TableColumnDef $ ColumnDef (Name "b") (TypeName [Name "int"]) Nothing [] +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing [] +> ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing [] > ,TableConstraintDef Nothing $ > TableReferencesConstraint -> [Name "a", Name "b"] -> [Name "u"] -> (Just [Name "c", Name "d"]) +> [Name Nothing "a", Name Nothing "b"] +> [Name Nothing "u"] +> (Just [Name Nothing "c", Name Nothing "d"]) > MatchFull RefCascade RefRestrict > ]) > ,(TestStatement ansi2011 > "create table t (a int,\n\ > \ constraint tfku1 foreign key (a) references u);" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] -> ,TableConstraintDef (Just [Name "tfku1"]) $ +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing [] +> ,TableConstraintDef (Just [Name Nothing "tfku1"]) $ > TableReferencesConstraint -> [Name "a"] -> [Name "u"] +> [Name Nothing "a"] +> [Name Nothing "u"] > Nothing DefaultReferenceMatch > DefaultReferentialAction DefaultReferentialAction > ]) @@ -703,24 +703,24 @@ defintely skip > ,(TestStatement ansi2011 > "create table t (a int, b int, \n\ > \ check (a > b));" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] -> ,TableColumnDef $ ColumnDef (Name "b") (TypeName [Name "int"]) Nothing [] +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing [] +> ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing [] > ,TableConstraintDef Nothing $ > TableCheckConstraint -> (BinOp (Iden [Name "a"]) [Name ">"] (Iden [Name "b"])) +> (BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (Iden [Name Nothing "b"])) > ]) > ,(TestStatement ansi2011 > "create table t (a int, b int, \n\ > \ constraint agtb check (a > b));" -> $ CreateTable [Name "t"] -> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] -> ,TableColumnDef $ ColumnDef (Name "b") (TypeName [Name "int"]) Nothing [] -> ,TableConstraintDef (Just [Name "agtb"]) $ +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing [] +> ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing [] +> ,TableConstraintDef (Just [Name Nothing "agtb"]) $ > TableCheckConstraint -> (BinOp (Iden [Name "a"]) [Name ">"] (Iden [Name "b"])) +> (BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (Iden [Name Nothing "b"])) > ]) @@ -755,8 +755,8 @@ alter table t add a int unique not null check (a>0) > ,(TestStatement ansi2011 > "alter table t add column a int" -> $ AlterTable [Name "t"] $ AddColumnDef -> $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] +> $ AlterTable [Name Nothing "t"] $ AddColumnDef +> $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing [] > ) todo: more add column @@ -787,7 +787,7 @@ todo: more add column > ,(TestStatement ansi2011 > "alter table t alter column c set default 0" -> $ AlterTable [Name "t"] $ AlterColumnSetDefault (Name "c") +> $ AlterTable [Name Nothing "t"] $ AlterColumnSetDefault (Name Nothing "c") > $ NumLit "0") 11.14 @@ -797,7 +797,7 @@ todo: more add column > ,(TestStatement ansi2011 > "alter table t alter column c drop default" -> $ AlterTable [Name "t"] $ AlterColumnDropDefault (Name "c")) +> $ AlterTable [Name Nothing "t"] $ AlterColumnDropDefault (Name Nothing "c")) 11.15 @@ -807,7 +807,7 @@ todo: more add column > ,(TestStatement ansi2011 > "alter table t alter column c set not null" -> $ AlterTable [Name "t"] $ AlterColumnSetNotNull (Name "c")) +> $ AlterTable [Name Nothing "t"] $ AlterColumnSetNotNull (Name Nothing "c")) 11.16 @@ -816,7 +816,7 @@ todo: more add column > ,(TestStatement ansi2011 > "alter table t alter column c drop not null" -> $ AlterTable [Name "t"] $ AlterColumnDropNotNull (Name "c")) +> $ AlterTable [Name Nothing "t"] $ AlterColumnDropNotNull (Name Nothing "c")) 11.17 @@ -835,8 +835,8 @@ todo: more add column > ,(TestStatement ansi2011 > "alter table t alter column c set data type int;" -> $ AlterTable [Name "t"] $ -> AlterColumnSetDataType (Name "c") (TypeName [Name "int"])) +> $ AlterTable [Name Nothing "t"] $ +> AlterColumnSetDataType (Name Nothing "c") (TypeName [Name Nothing "int"])) @@ -934,18 +934,18 @@ included in the generated plan above > ,(TestStatement ansi2011 > "alter table t drop column c" -> $ AlterTable [Name "t"] $ -> DropColumn (Name "c") DefaultDropBehaviour) +> $ AlterTable [Name Nothing "t"] $ +> DropColumn (Name Nothing "c") DefaultDropBehaviour) > ,(TestStatement ansi2011 > "alter table t drop c cascade" -> $ AlterTable [Name "t"] $ -> DropColumn (Name "c") Cascade) +> $ AlterTable [Name Nothing "t"] $ +> DropColumn (Name Nothing "c") Cascade) > ,(TestStatement ansi2011 > "alter table t drop c restrict" -> $ AlterTable [Name "t"] $ -> DropColumn (Name "c") Restrict) +> $ AlterTable [Name Nothing "t"] $ +> DropColumn (Name Nothing "c") Restrict) @@ -956,15 +956,15 @@ included in the generated plan above > ,(TestStatement ansi2011 > "alter table t add constraint c unique (a,b)" -> $ AlterTable [Name "t"] $ -> AddTableConstraintDef (Just [Name "c"]) -> $ TableUniqueConstraint [Name "a", Name "b"]) +> $ AlterTable [Name Nothing "t"] $ +> AddTableConstraintDef (Just [Name Nothing "c"]) +> $ TableUniqueConstraint [Name Nothing "a", Name Nothing "b"]) > ,(TestStatement ansi2011 > "alter table t add unique (a,b)" -> $ AlterTable [Name "t"] $ +> $ AlterTable [Name Nothing "t"] $ > AddTableConstraintDef Nothing -> $ TableUniqueConstraint [Name "a", Name "b"]) +> $ TableUniqueConstraint [Name Nothing "a", Name Nothing "b"]) 11.25 @@ -980,13 +980,13 @@ todo > ,(TestStatement ansi2011 > "alter table t drop constraint c" -> $ AlterTable [Name "t"] $ -> DropTableConstraintDef [Name "c"] DefaultDropBehaviour) +> $ AlterTable [Name Nothing "t"] $ +> DropTableConstraintDef [Name Nothing "c"] DefaultDropBehaviour) > ,(TestStatement ansi2011 > "alter table t drop constraint c restrict" -> $ AlterTable [Name "t"] $ -> DropTableConstraintDef [Name "c"] Restrict) +> $ AlterTable [Name Nothing "t"] $ +> DropTableConstraintDef [Name Nothing "c"] Restrict) 11.27 @@ -1038,11 +1038,11 @@ defintely skip > ,(TestStatement ansi2011 > "drop table t" -> $ DropTable [Name "t"] DefaultDropBehaviour) +> $ DropTable [Name Nothing "t"] DefaultDropBehaviour) > ,(TestStatement ansi2011 > "drop table t restrict" -> $ DropTable [Name "t"] Restrict) +> $ DropTable [Name Nothing "t"] Restrict) 11.32 @@ -1084,48 +1084,48 @@ defintely skip > ,(TestStatement ansi2011 > "create view v as select * from t" -> $ CreateView False [Name "v"] Nothing (makeSelect +> $ CreateView False [Name Nothing "v"] Nothing (makeSelect > {qeSelectList = [(Star, Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] +> ,qeFrom = [TRSimple [Name Nothing "t"]] > }) Nothing) > ,(TestStatement ansi2011 > "create recursive view v as select * from t" -> $ CreateView True [Name "v"] Nothing (makeSelect +> $ CreateView True [Name Nothing "v"] Nothing (makeSelect > {qeSelectList = [(Star, Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] +> ,qeFrom = [TRSimple [Name Nothing "t"]] > }) Nothing) > ,(TestStatement ansi2011 > "create view v(a,b) as select * from t" -> $ CreateView False [Name "v"] (Just [Name "a", Name "b"]) +> $ CreateView False [Name Nothing "v"] (Just [Name Nothing "a", Name Nothing "b"]) > (makeSelect > {qeSelectList = [(Star, Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] +> ,qeFrom = [TRSimple [Name Nothing "t"]] > }) Nothing) > ,(TestStatement ansi2011 > "create view v as select * from t with check option" -> $ CreateView False [Name "v"] Nothing (makeSelect +> $ CreateView False [Name Nothing "v"] Nothing (makeSelect > {qeSelectList = [(Star, Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] +> ,qeFrom = [TRSimple [Name Nothing "t"]] > }) (Just DefaultCheckOption)) > ,(TestStatement ansi2011 > "create view v as select * from t with cascaded check option" -> $ CreateView False [Name "v"] Nothing (makeSelect +> $ CreateView False [Name Nothing "v"] Nothing (makeSelect > {qeSelectList = [(Star, Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] +> ,qeFrom = [TRSimple [Name Nothing "t"]] > }) (Just CascadedCheckOption)) > ,(TestStatement ansi2011 > "create view v as select * from t with local check option" -> $ CreateView False [Name "v"] Nothing +> $ CreateView False [Name Nothing "v"] Nothing > (makeSelect > {qeSelectList = [(Star, Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] +> ,qeFrom = [TRSimple [Name Nothing "t"]] > }) (Just LocalCheckOption)) @@ -1137,11 +1137,11 @@ defintely skip > ,(TestStatement ansi2011 > "drop view v" -> $ DropView [Name "v"] DefaultDropBehaviour) +> $ DropView [Name Nothing "v"] DefaultDropBehaviour) > ,(TestStatement ansi2011 > "drop view v cascade" -> $ DropView [Name "v"] Cascade) +> $ DropView [Name Nothing "v"] Cascade) 11.34 @@ -1158,35 +1158,35 @@ defintely skip > ,(TestStatement ansi2011 > "create domain my_int int" -> $ CreateDomain [Name "my_int"] -> (TypeName [Name "int"]) +> $ CreateDomain [Name Nothing "my_int"] +> (TypeName [Name Nothing "int"]) > Nothing []) > ,(TestStatement ansi2011 > "create domain my_int as int" -> $ CreateDomain [Name "my_int"] -> (TypeName [Name "int"]) +> $ CreateDomain [Name Nothing "my_int"] +> (TypeName [Name Nothing "int"]) > Nothing []) > ,(TestStatement ansi2011 > "create domain my_int int default 0" -> $ CreateDomain [Name "my_int"] -> (TypeName [Name "int"]) +> $ CreateDomain [Name Nothing "my_int"] +> (TypeName [Name Nothing "int"]) > (Just (NumLit "0")) []) > ,(TestStatement ansi2011 > "create domain my_int int check (value > 5)" -> $ CreateDomain [Name "my_int"] -> (TypeName [Name "int"]) +> $ CreateDomain [Name Nothing "my_int"] +> (TypeName [Name Nothing "int"]) > Nothing [(Nothing -> ,BinOp (Iden [Name "value"]) [Name ">"] (NumLit "5"))]) +> ,BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "5"))]) > ,(TestStatement ansi2011 > "create domain my_int int constraint gt5 check (value > 5)" -> $ CreateDomain [Name "my_int"] -> (TypeName [Name "int"]) -> Nothing [(Just [Name "gt5"] -> ,BinOp (Iden [Name "value"]) [Name ">"] (NumLit "5"))]) +> $ CreateDomain [Name Nothing "my_int"] +> (TypeName [Name Nothing "int"]) +> Nothing [(Just [Name Nothing "gt5"] +> ,BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "5"))]) @@ -1208,7 +1208,7 @@ defintely skip > ,(TestStatement ansi2011 > "alter domain my_int set default 0" -> $ AlterDomain [Name "my_int"] +> $ AlterDomain [Name Nothing "my_int"] > $ ADSetDefault $ NumLit "0") @@ -1219,7 +1219,7 @@ defintely skip > ,(TestStatement ansi2011 > "alter domain my_int drop default" -> $ AlterDomain [Name "my_int"] +> $ AlterDomain [Name Nothing "my_int"] > $ ADDropDefault) @@ -1230,15 +1230,15 @@ defintely skip > ,(TestStatement ansi2011 > "alter domain my_int add check (value > 6)" -> $ AlterDomain [Name "my_int"] +> $ AlterDomain [Name Nothing "my_int"] > $ ADAddConstraint Nothing -> $ BinOp (Iden [Name "value"]) [Name ">"] (NumLit "6")) +> $ BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "6")) > ,(TestStatement ansi2011 > "alter domain my_int add constraint gt6 check (value > 6)" -> $ AlterDomain [Name "my_int"] -> $ ADAddConstraint (Just [Name "gt6"]) -> $ BinOp (Iden [Name "value"]) [Name ">"] (NumLit "6")) +> $ AlterDomain [Name Nothing "my_int"] +> $ ADAddConstraint (Just [Name Nothing "gt6"]) +> $ BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "6")) 11.39 @@ -1248,8 +1248,8 @@ defintely skip > ,(TestStatement ansi2011 > "alter domain my_int drop constraint gt6" -> $ AlterDomain [Name "my_int"] -> $ ADDropConstraint [Name "gt6"]) +> $ AlterDomain [Name Nothing "my_int"] +> $ ADDropConstraint [Name Nothing "gt6"]) 11.40 @@ -1258,11 +1258,11 @@ defintely skip > ,(TestStatement ansi2011 > "drop domain my_int" -> $ DropDomain [Name "my_int"] DefaultDropBehaviour) +> $ DropDomain [Name Nothing "my_int"] DefaultDropBehaviour) > ,(TestStatement ansi2011 > "drop domain my_int cascade" -> $ DropDomain [Name "my_int"] Cascade) +> $ DropDomain [Name Nothing "my_int"] Cascade) @@ -1334,13 +1334,13 @@ defintely skip > ,(TestStatement ansi2011 > "create assertion t1_not_empty CHECK ((select count(*) from t1) > 0);" -> $ CreateAssertion [Name "t1_not_empty"] +> $ CreateAssertion [Name Nothing "t1_not_empty"] > $ BinOp (SubQueryExpr SqSq $ > makeSelect -> {qeSelectList = [(App [Name "count"] [Star],Nothing)] -> ,qeFrom = [TRSimple [Name "t1"]] +> {qeSelectList = [(App [Name Nothing "count"] [Star],Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t1"]] > }) -> [Name ">"] (NumLit "0")) +> [Name Nothing ">"] (NumLit "0")) 11.48 @@ -1349,11 +1349,11 @@ defintely skip > ,(TestStatement ansi2011 > "drop assertion t1_not_empty;" -> $ DropAssertion [Name "t1_not_empty"] DefaultDropBehaviour) +> $ DropAssertion [Name Nothing "t1_not_empty"] DefaultDropBehaviour) > ,(TestStatement ansi2011 > "drop assertion t1_not_empty cascade;" -> $ DropAssertion [Name "t1_not_empty"] Cascade) +> $ DropAssertion [Name Nothing "t1_not_empty"] Cascade) 11.49 @@ -1990,18 +1990,18 @@ defintely skip > ,(TestStatement ansi2011 > "create sequence seq" -> $ CreateSequence [Name "seq"] []) +> $ CreateSequence [Name Nothing "seq"] []) > ,(TestStatement ansi2011 > "create sequence seq as bigint" -> $ CreateSequence [Name "seq"] -> [SGODataType $ TypeName [Name "bigint"]]) +> $ CreateSequence [Name Nothing "seq"] +> [SGODataType $ TypeName [Name Nothing "bigint"]]) > ,(TestStatement ansi2011 > "create sequence seq as bigint start with 5" -> $ CreateSequence [Name "seq"] +> $ CreateSequence [Name Nothing "seq"] > [SGOStartWith 5 -> ,SGODataType $ TypeName [Name "bigint"] +> ,SGODataType $ TypeName [Name Nothing "bigint"] > ]) @@ -2025,17 +2025,17 @@ defintely skip > ,(TestStatement ansi2011 > "alter sequence seq restart" -> $ AlterSequence [Name "seq"] +> $ AlterSequence [Name Nothing "seq"] > [SGORestart Nothing]) > ,(TestStatement ansi2011 > "alter sequence seq restart with 5" -> $ AlterSequence [Name "seq"] +> $ AlterSequence [Name Nothing "seq"] > [SGORestart $ Just 5]) > ,(TestStatement ansi2011 > "alter sequence seq restart with 5 increment by 5" -> $ AlterSequence [Name "seq"] +> $ AlterSequence [Name Nothing "seq"] > [SGORestart $ Just 5 > ,SGOIncrementBy 5]) @@ -2047,11 +2047,11 @@ defintely skip > ,(TestStatement ansi2011 > "drop sequence seq" -> $ DropSequence [Name "seq"] DefaultDropBehaviour) +> $ DropSequence [Name Nothing "seq"] DefaultDropBehaviour) > ,(TestStatement ansi2011 > "drop sequence seq restrict" -> $ DropSequence [Name "seq"] Restrict) +> $ DropSequence [Name Nothing "seq"] Restrict) > ] diff --git a/tools/Language/SQL/SimpleSQL/TableRefs.lhs b/tools/Language/SQL/SimpleSQL/TableRefs.lhs index cdd5b5a..84a69fe 100644 --- a/tools/Language/SQL/SimpleSQL/TableRefs.lhs +++ b/tools/Language/SQL/SimpleSQL/TableRefs.lhs @@ -11,95 +11,95 @@ expression > tableRefTests :: TestItem > tableRefTests = Group "tableRefTests" $ map (uncurry (TestQueryExpr ansi2011)) > [("select a from t" -> ,ms [TRSimple [Name "t"]]) +> ,ms [TRSimple [Name Nothing "t"]]) > ,("select a from f(a)" -> ,ms [TRFunction [Name "f"] [Iden [Name "a"]]]) +> ,ms [TRFunction [Name Nothing "f"] [Iden [Name Nothing "a"]]]) > ,("select a from t,u" -> ,ms [TRSimple [Name "t"], TRSimple [Name "u"]]) +> ,ms [TRSimple [Name Nothing "t"], TRSimple [Name Nothing "u"]]) > ,("select a from s.t" -> ,ms [TRSimple [Name "s", Name "t"]]) +> ,ms [TRSimple [Name Nothing "s", Name Nothing "t"]]) these lateral queries make no sense but the syntax is valid > ,("select a from lateral a" -> ,ms [TRLateral $ TRSimple [Name "a"]]) +> ,ms [TRLateral $ TRSimple [Name Nothing "a"]]) > ,("select a from lateral a,b" -> ,ms [TRLateral $ TRSimple [Name "a"], TRSimple [Name "b"]]) +> ,ms [TRLateral $ TRSimple [Name Nothing "a"], TRSimple [Name Nothing "b"]]) > ,("select a from a, lateral b" -> ,ms [TRSimple [Name "a"], TRLateral $ TRSimple [Name "b"]]) +> ,ms [TRSimple [Name Nothing "a"], TRLateral $ TRSimple [Name Nothing "b"]]) > ,("select a from a natural join lateral b" -> ,ms [TRJoin (TRSimple [Name "a"]) True JInner -> (TRLateral $ TRSimple [Name "b"]) +> ,ms [TRJoin (TRSimple [Name Nothing "a"]) True JInner +> (TRLateral $ TRSimple [Name Nothing "b"]) > Nothing]) > ,("select a from lateral a natural join lateral b" -> ,ms [TRJoin (TRLateral $ TRSimple [Name "a"]) True JInner -> (TRLateral $ TRSimple [Name "b"]) +> ,ms [TRJoin (TRLateral $ TRSimple [Name Nothing "a"]) True JInner +> (TRLateral $ TRSimple [Name Nothing "b"]) > Nothing]) > ,("select a from t inner join u on expr" -> ,ms [TRJoin (TRSimple [Name "t"]) False JInner (TRSimple [Name "u"]) -> (Just $ JoinOn $ Iden [Name "expr"])]) +> ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"]) +> (Just $ JoinOn $ Iden [Name Nothing "expr"])]) > ,("select a from t join u on expr" -> ,ms [TRJoin (TRSimple [Name "t"]) False JInner (TRSimple [Name "u"]) -> (Just $ JoinOn $ Iden [Name "expr"])]) +> ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"]) +> (Just $ JoinOn $ Iden [Name Nothing "expr"])]) > ,("select a from t left join u on expr" -> ,ms [TRJoin (TRSimple [Name "t"]) False JLeft (TRSimple [Name "u"]) -> (Just $ JoinOn $ Iden [Name "expr"])]) +> ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JLeft (TRSimple [Name Nothing "u"]) +> (Just $ JoinOn $ Iden [Name Nothing "expr"])]) > ,("select a from t right join u on expr" -> ,ms [TRJoin (TRSimple [Name "t"]) False JRight (TRSimple [Name "u"]) -> (Just $ JoinOn $ Iden [Name "expr"])]) +> ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JRight (TRSimple [Name Nothing "u"]) +> (Just $ JoinOn $ Iden [Name Nothing "expr"])]) > ,("select a from t full join u on expr" -> ,ms [TRJoin (TRSimple [Name "t"]) False JFull (TRSimple [Name "u"]) -> (Just $ JoinOn $ Iden [Name "expr"])]) +> ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JFull (TRSimple [Name Nothing "u"]) +> (Just $ JoinOn $ Iden [Name Nothing "expr"])]) > ,("select a from t cross join u" -> ,ms [TRJoin (TRSimple [Name "t"]) False -> JCross (TRSimple [Name "u"]) Nothing]) +> ,ms [TRJoin (TRSimple [Name Nothing "t"]) False +> JCross (TRSimple [Name Nothing "u"]) Nothing]) > ,("select a from t natural inner join u" -> ,ms [TRJoin (TRSimple [Name "t"]) True JInner (TRSimple [Name "u"]) +> ,ms [TRJoin (TRSimple [Name Nothing "t"]) True JInner (TRSimple [Name Nothing "u"]) > Nothing]) > ,("select a from t inner join u using(a,b)" -> ,ms [TRJoin (TRSimple [Name "t"]) False JInner (TRSimple [Name "u"]) -> (Just $ JoinUsing [Name "a", Name "b"])]) +> ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"]) +> (Just $ JoinUsing [Name Nothing "a", Name Nothing "b"])]) > ,("select a from (select a from t)" -> ,ms [TRQueryExpr $ ms [TRSimple [Name "t"]]]) +> ,ms [TRQueryExpr $ ms [TRSimple [Name Nothing "t"]]]) > ,("select a from t as u" -> ,ms [TRAlias (TRSimple [Name "t"]) (Alias (Name "u") Nothing)]) +> ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)]) > ,("select a from t u" -> ,ms [TRAlias (TRSimple [Name "t"]) (Alias (Name "u") Nothing)]) +> ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)]) > ,("select a from t u(b)" -> ,ms [TRAlias (TRSimple [Name "t"]) (Alias (Name "u") $ Just [Name "b"])]) +> ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") $ Just [Name Nothing "b"])]) > ,("select a from (t cross join u) as u" > ,ms [TRAlias (TRParens $ -> TRJoin (TRSimple [Name "t"]) False JCross (TRSimple [Name "u"]) Nothing) -> (Alias (Name "u") Nothing)]) +> TRJoin (TRSimple [Name Nothing "t"]) False JCross (TRSimple [Name Nothing "u"]) Nothing) +> (Alias (Name Nothing "u") Nothing)]) > -- todo: not sure if the associativity is correct > ,("select a from t cross join u cross join v", > ms [TRJoin -> (TRJoin (TRSimple [Name "t"]) False -> JCross (TRSimple [Name "u"]) Nothing) -> False JCross (TRSimple [Name "v"]) Nothing]) +> (TRJoin (TRSimple [Name Nothing "t"]) False +> JCross (TRSimple [Name Nothing "u"]) Nothing) +> False JCross (TRSimple [Name Nothing "v"]) Nothing]) > ] > where -> ms f = makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)] +> ms f = makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)] > ,qeFrom = f} diff --git a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs index 0b16e74..1eaf9d2 100644 --- a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs +++ b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs @@ -41,14 +41,14 @@ Tests for parsing value expressions > ,IntervalLit Nothing "3" (Itf "day" Nothing) Nothing) > ,("interval '3' day (3)" > ,IntervalLit Nothing "3" (Itf "day" $ Just (3,Nothing)) Nothing) -> ,("interval '3 weeks'", TypedLit (TypeName [Name "interval"]) "3 weeks") +> ,("interval '3 weeks'", TypedLit (TypeName [Name Nothing "interval"]) "3 weeks") > ] > identifiers :: TestItem > identifiers = Group "identifiers" $ map (uncurry (TestValueExpr ansi2011)) -> [("iden1", Iden [Name "iden1"]) +> [("iden1", Iden [Name Nothing "iden1"]) > --,("t.a", Iden2 "t" "a") -> ,("\"quoted identifier\"", Iden [QuotedName "\"" "\"" "quoted identifier"]) +> ,("\"quoted identifier\"", Iden [Name (Just ("\"","\"")) "quoted identifier"]) > ] > star :: TestItem @@ -66,41 +66,41 @@ Tests for parsing value expressions > dots :: TestItem > dots = Group "dot" $ map (uncurry (TestValueExpr ansi2011)) -> [("t.a", Iden [Name "t",Name "a"]) -> ,("t.*", BinOp (Iden [Name "t"]) [Name "."] Star) -> ,("a.b.c", Iden [Name "a",Name "b",Name "c"]) -> ,("ROW(t.*,42)", App [Name "ROW"] [BinOp (Iden [Name "t"]) [Name "."] Star, NumLit "42"]) +> [("t.a", Iden [Name Nothing "t",Name Nothing "a"]) +> ,("t.*", BinOp (Iden [Name Nothing "t"]) [Name Nothing "."] Star) +> ,("a.b.c", Iden [Name Nothing "a",Name Nothing "b",Name Nothing "c"]) +> ,("ROW(t.*,42)", App [Name Nothing "ROW"] [BinOp (Iden [Name Nothing "t"]) [Name Nothing "."] Star, NumLit "42"]) > ] > app :: TestItem > app = Group "app" $ map (uncurry (TestValueExpr ansi2011)) -> [("f()", App [Name "f"] []) -> ,("f(a)", App [Name "f"] [Iden [Name "a"]]) -> ,("f(a,b)", App [Name "f"] [Iden [Name "a"], Iden [Name "b"]]) +> [("f()", App [Name Nothing "f"] []) +> ,("f(a)", App [Name Nothing "f"] [Iden [Name Nothing "a"]]) +> ,("f(a,b)", App [Name Nothing "f"] [Iden [Name Nothing "a"], Iden [Name Nothing "b"]]) > ] > caseexp :: TestItem > caseexp = Group "caseexp" $ map (uncurry (TestValueExpr ansi2011)) > [("case a when 1 then 2 end" -> ,Case (Just $ Iden [Name "a"]) [([NumLit "1"] +> ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"] > ,NumLit "2")] Nothing) > ,("case a when 1 then 2 when 3 then 4 end" -> ,Case (Just $ Iden [Name "a"]) [([NumLit "1"], NumLit "2") +> ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"], NumLit "2") > ,([NumLit "3"], NumLit "4")] Nothing) > ,("case a when 1 then 2 when 3 then 4 else 5 end" -> ,Case (Just $ Iden [Name "a"]) [([NumLit "1"], NumLit "2") +> ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"], NumLit "2") > ,([NumLit "3"], NumLit "4")] > (Just $ NumLit "5")) > ,("case when a=1 then 2 when a=3 then 4 else 5 end" -> ,Case Nothing [([BinOp (Iden [Name "a"]) [Name "="] (NumLit "1")], NumLit "2") -> ,([BinOp (Iden [Name "a"]) [Name "="] (NumLit "3")], NumLit "4")] +> ,Case Nothing [([BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "1")], NumLit "2") +> ,([BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "3")], NumLit "4")] > (Just $ NumLit "5")) > ,("case a when 1,2 then 10 when 3,4 then 20 end" -> ,Case (Just $ Iden [Name "a"]) [([NumLit "1",NumLit "2"] +> ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1",NumLit "2"] > ,NumLit "10") > ,([NumLit "3",NumLit "4"] > ,NumLit "20")] @@ -117,48 +117,48 @@ Tests for parsing value expressions > binaryOperators :: TestItem > binaryOperators = Group "binaryOperators" $ map (uncurry (TestValueExpr ansi2011)) -> [("a + b", BinOp (Iden [Name "a"]) [Name "+"] (Iden [Name "b"])) +> [("a + b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"])) > -- sanity check fixities > -- todo: add more fixity checking > ,("a + b * c" -> ,BinOp (Iden [Name "a"]) [Name "+"] -> (BinOp (Iden [Name "b"]) [Name "*"] (Iden [Name "c"]))) +> ,BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] +> (BinOp (Iden [Name Nothing "b"]) [Name Nothing "*"] (Iden [Name Nothing "c"]))) > ,("a * b + c" -> ,BinOp (BinOp (Iden [Name "a"]) [Name "*"] (Iden [Name "b"])) -> [Name "+"] (Iden [Name "c"])) +> ,BinOp (BinOp (Iden [Name Nothing "a"]) [Name Nothing "*"] (Iden [Name Nothing "b"])) +> [Name Nothing "+"] (Iden [Name Nothing "c"])) > ] > unaryOperators :: TestItem > unaryOperators = Group "unaryOperators" $ map (uncurry (TestValueExpr ansi2011)) -> [("not a", PrefixOp [Name "not"] $ Iden [Name "a"]) -> ,("not not a", PrefixOp [Name "not"] $ PrefixOp [Name "not"] $ Iden [Name "a"]) -> ,("+a", PrefixOp [Name "+"] $ Iden [Name "a"]) -> ,("-a", PrefixOp [Name "-"] $ Iden [Name "a"]) +> [("not a", PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"]) +> ,("not not a", PrefixOp [Name Nothing "not"] $ PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"]) +> ,("+a", PrefixOp [Name Nothing "+"] $ Iden [Name Nothing "a"]) +> ,("-a", PrefixOp [Name Nothing "-"] $ Iden [Name Nothing "a"]) > ] > casts :: TestItem > casts = Group "operators" $ map (uncurry (TestValueExpr ansi2011)) > [("cast('1' as int)" -> ,Cast (StringLit "'" "'" "1") $ TypeName [Name "int"]) +> ,Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "int"]) > ,("int '3'" -> ,TypedLit (TypeName [Name "int"]) "3") +> ,TypedLit (TypeName [Name Nothing "int"]) "3") > ,("cast('1' as double precision)" -> ,Cast (StringLit "'" "'" "1") $ TypeName [Name "double precision"]) +> ,Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "double precision"]) > ,("cast('1' as float(8))" -> ,Cast (StringLit "'" "'" "1") $ PrecTypeName [Name "float"] 8) +> ,Cast (StringLit "'" "'" "1") $ PrecTypeName [Name Nothing "float"] 8) > ,("cast('1' as decimal(15,2))" -> ,Cast (StringLit "'" "'" "1") $ PrecScaleTypeName [Name "decimal"] 15 2) +> ,Cast (StringLit "'" "'" "1") $ PrecScaleTypeName [Name Nothing "decimal"] 15 2) > ,("double precision '3'" -> ,TypedLit (TypeName [Name "double precision"]) "3") +> ,TypedLit (TypeName [Name Nothing "double precision"]) "3") > ] > subqueries :: TestItem @@ -167,113 +167,113 @@ Tests for parsing value expressions > ,("(select a from t)", SubQueryExpr SqSq ms) > ,("a in (select a from t)" -> ,In True (Iden [Name "a"]) (InQueryExpr ms)) +> ,In True (Iden [Name Nothing "a"]) (InQueryExpr ms)) > ,("a not in (select a from t)" -> ,In False (Iden [Name "a"]) (InQueryExpr ms)) +> ,In False (Iden [Name Nothing "a"]) (InQueryExpr ms)) > ,("a > all (select a from t)" -> ,QuantifiedComparison (Iden [Name "a"]) [Name ">"] CPAll ms) +> ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing ">"] CPAll ms) > ,("a = some (select a from t)" -> ,QuantifiedComparison (Iden [Name "a"]) [Name "="] CPSome ms) +> ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "="] CPSome ms) > ,("a <= any (select a from t)" -> ,QuantifiedComparison (Iden [Name "a"]) [Name "<="] CPAny ms) +> ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "<="] CPAny ms) > ] > where > ms = makeSelect -> {qeSelectList = [(Iden [Name "a"],Nothing)] -> ,qeFrom = [TRSimple [Name "t"]] +> {qeSelectList = [(Iden [Name Nothing "a"],Nothing)] +> ,qeFrom = [TRSimple [Name Nothing "t"]] > } > miscOps :: TestItem > miscOps = Group "unaryOperators" $ map (uncurry (TestValueExpr ansi2011)) > [("a in (1,2,3)" -> ,In True (Iden [Name "a"]) $ InList $ map NumLit ["1","2","3"]) +> ,In True (Iden [Name Nothing "a"]) $ InList $ map NumLit ["1","2","3"]) -> ,("a is null", PostfixOp [Name "is null"] (Iden [Name "a"])) -> ,("a is not null", PostfixOp [Name "is not null"] (Iden [Name "a"])) -> ,("a is true", PostfixOp [Name "is true"] (Iden [Name "a"])) -> ,("a is not true", PostfixOp [Name "is not true"] (Iden [Name "a"])) -> ,("a is false", PostfixOp [Name "is false"] (Iden [Name "a"])) -> ,("a is not false", PostfixOp [Name "is not false"] (Iden [Name "a"])) -> ,("a is unknown", PostfixOp [Name "is unknown"] (Iden [Name "a"])) -> ,("a is not unknown", PostfixOp [Name "is not unknown"] (Iden [Name "a"])) -> ,("a is distinct from b", BinOp (Iden [Name "a"]) [Name "is distinct from"] (Iden [Name "b"])) +> ,("a is null", PostfixOp [Name Nothing "is null"] (Iden [Name Nothing "a"])) +> ,("a is not null", PostfixOp [Name Nothing "is not null"] (Iden [Name Nothing "a"])) +> ,("a is true", PostfixOp [Name Nothing "is true"] (Iden [Name Nothing "a"])) +> ,("a is not true", PostfixOp [Name Nothing "is not true"] (Iden [Name Nothing "a"])) +> ,("a is false", PostfixOp [Name Nothing "is false"] (Iden [Name Nothing "a"])) +> ,("a is not false", PostfixOp [Name Nothing "is not false"] (Iden [Name Nothing "a"])) +> ,("a is unknown", PostfixOp [Name Nothing "is unknown"] (Iden [Name Nothing "a"])) +> ,("a is not unknown", PostfixOp [Name Nothing "is not unknown"] (Iden [Name Nothing "a"])) +> ,("a is distinct from b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "is distinct from"] (Iden [Name Nothing "b"])) > ,("a is not distinct from b" -> ,BinOp (Iden [Name "a"]) [Name "is not distinct from"] (Iden [Name "b"])) +> ,BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not distinct from"] (Iden [Name Nothing "b"])) -> ,("a like b", BinOp (Iden [Name "a"]) [Name "like"] (Iden [Name "b"])) -> ,("a not like b", BinOp (Iden [Name "a"]) [Name "not like"] (Iden [Name "b"])) -> ,("a is similar to b", BinOp (Iden [Name "a"]) [Name "is similar to"] (Iden [Name "b"])) +> ,("a like b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "like"] (Iden [Name Nothing "b"])) +> ,("a not like b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "not like"] (Iden [Name Nothing "b"])) +> ,("a is similar to b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "is similar to"] (Iden [Name Nothing "b"])) > ,("a is not similar to b" -> ,BinOp (Iden [Name "a"]) [Name "is not similar to"] (Iden [Name "b"])) +> ,BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not similar to"] (Iden [Name Nothing "b"])) -> ,("a overlaps b", BinOp (Iden [Name "a"]) [Name "overlaps"] (Iden [Name "b"])) +> ,("a overlaps b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "overlaps"] (Iden [Name Nothing "b"])) special operators -> ,("a between b and c", SpecialOp [Name "between"] [Iden [Name "a"] -> ,Iden [Name "b"] -> ,Iden [Name "c"]]) +> ,("a between b and c", SpecialOp [Name Nothing "between"] [Iden [Name Nothing "a"] +> ,Iden [Name Nothing "b"] +> ,Iden [Name Nothing "c"]]) -> ,("a not between b and c", SpecialOp [Name "not between"] [Iden [Name "a"] -> ,Iden [Name "b"] -> ,Iden [Name "c"]]) +> ,("a not between b and c", SpecialOp [Name Nothing "not between"] [Iden [Name Nothing "a"] +> ,Iden [Name Nothing "b"] +> ,Iden [Name Nothing "c"]]) > ,("(1,2)" -> ,SpecialOp [Name "rowctor"] [NumLit "1", NumLit "2"]) +> ,SpecialOp [Name Nothing "rowctor"] [NumLit "1", NumLit "2"]) keyword special operators > ,("extract(day from t)" -> , SpecialOpK [Name "extract"] (Just $ Iden [Name "day"]) [("from", Iden [Name "t"])]) +> , SpecialOpK [Name Nothing "extract"] (Just $ Iden [Name Nothing "day"]) [("from", Iden [Name Nothing "t"])]) > ,("substring(x from 1 for 2)" -> ,SpecialOpK [Name "substring"] (Just $ Iden [Name "x"]) [("from", NumLit "1") +> ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1") > ,("for", NumLit "2")]) > ,("substring(x from 1)" -> ,SpecialOpK [Name "substring"] (Just $ Iden [Name "x"]) [("from", NumLit "1")]) +> ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1")]) > ,("substring(x for 2)" -> ,SpecialOpK [Name "substring"] (Just $ Iden [Name "x"]) [("for", NumLit "2")]) +> ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("for", NumLit "2")]) > ,("substring(x from 1 for 2 collate C)" -> ,SpecialOpK [Name "substring"] (Just $ Iden [Name "x"]) +> ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) > [("from", NumLit "1") -> ,("for", Collate (NumLit "2") [Name "C"])]) +> ,("for", Collate (NumLit "2") [Name Nothing "C"])]) this doesn't work because of a overlap in the 'in' parser > ,("POSITION( string1 IN string2 )" -> ,SpecialOpK [Name "position"] (Just $ Iden [Name "string1"]) [("in", Iden [Name "string2"])]) +> ,SpecialOpK [Name Nothing "position"] (Just $ Iden [Name Nothing "string1"]) [("in", Iden [Name Nothing "string2"])]) > ,("CONVERT(char_value USING conversion_char_name)" -> ,SpecialOpK [Name "convert"] (Just $ Iden [Name "char_value"]) -> [("using", Iden [Name "conversion_char_name"])]) +> ,SpecialOpK [Name Nothing "convert"] (Just $ Iden [Name Nothing "char_value"]) +> [("using", Iden [Name Nothing "conversion_char_name"])]) > ,("TRANSLATE(char_value USING translation_name)" -> ,SpecialOpK [Name "translate"] (Just $ Iden [Name "char_value"]) -> [("using", Iden [Name "translation_name"])]) +> ,SpecialOpK [Name Nothing "translate"] (Just $ Iden [Name Nothing "char_value"]) +> [("using", Iden [Name Nothing "translation_name"])]) OVERLAY(string PLACING embedded_string FROM start [FOR length]) > ,("OVERLAY(string PLACING embedded_string FROM start)" -> ,SpecialOpK [Name "overlay"] (Just $ Iden [Name "string"]) -> [("placing", Iden [Name "embedded_string"]) -> ,("from", Iden [Name "start"])]) +> ,SpecialOpK [Name Nothing "overlay"] (Just $ Iden [Name Nothing "string"]) +> [("placing", Iden [Name Nothing "embedded_string"]) +> ,("from", Iden [Name Nothing "start"])]) > ,("OVERLAY(string PLACING embedded_string FROM start FOR length)" -> ,SpecialOpK [Name "overlay"] (Just $ Iden [Name "string"]) -> [("placing", Iden [Name "embedded_string"]) -> ,("from", Iden [Name "start"]) -> ,("for", Iden [Name "length"])]) +> ,SpecialOpK [Name Nothing "overlay"] (Just $ Iden [Name Nothing "string"]) +> [("placing", Iden [Name Nothing "embedded_string"]) +> ,("from", Iden [Name Nothing "start"]) +> ,("for", Iden [Name Nothing "length"])]) TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ] target_string @@ -282,117 +282,117 @@ target_string > ,("trim(from target_string)" -> ,SpecialOpK [Name "trim"] Nothing +> ,SpecialOpK [Name Nothing "trim"] Nothing > [("both", StringLit "'" "'" " ") -> ,("from", Iden [Name "target_string"])]) +> ,("from", Iden [Name Nothing "target_string"])]) > ,("trim(leading from target_string)" -> ,SpecialOpK [Name "trim"] Nothing +> ,SpecialOpK [Name Nothing "trim"] Nothing > [("leading", StringLit "'" "'" " ") -> ,("from", Iden [Name "target_string"])]) +> ,("from", Iden [Name Nothing "target_string"])]) > ,("trim(trailing from target_string)" -> ,SpecialOpK [Name "trim"] Nothing +> ,SpecialOpK [Name Nothing "trim"] Nothing > [("trailing", StringLit "'" "'" " ") -> ,("from", Iden [Name "target_string"])]) +> ,("from", Iden [Name Nothing "target_string"])]) > ,("trim(both from target_string)" -> ,SpecialOpK [Name "trim"] Nothing +> ,SpecialOpK [Name Nothing "trim"] Nothing > [("both", StringLit "'" "'" " ") -> ,("from", Iden [Name "target_string"])]) +> ,("from", Iden [Name Nothing "target_string"])]) > ,("trim(leading 'x' from target_string)" -> ,SpecialOpK [Name "trim"] Nothing +> ,SpecialOpK [Name Nothing "trim"] Nothing > [("leading", StringLit "'" "'" "x") -> ,("from", Iden [Name "target_string"])]) +> ,("from", Iden [Name Nothing "target_string"])]) > ,("trim(trailing 'y' from target_string)" -> ,SpecialOpK [Name "trim"] Nothing +> ,SpecialOpK [Name Nothing "trim"] Nothing > [("trailing", StringLit "'" "'" "y") -> ,("from", Iden [Name "target_string"])]) +> ,("from", Iden [Name Nothing "target_string"])]) > ,("trim(both 'z' from target_string collate C)" -> ,SpecialOpK [Name "trim"] Nothing +> ,SpecialOpK [Name Nothing "trim"] Nothing > [("both", StringLit "'" "'" "z") -> ,("from", Collate (Iden [Name "target_string"]) [Name "C"])]) +> ,("from", Collate (Iden [Name Nothing "target_string"]) [Name Nothing "C"])]) > ,("trim(leading from target_string)" -> ,SpecialOpK [Name "trim"] Nothing +> ,SpecialOpK [Name Nothing "trim"] Nothing > [("leading", StringLit "'" "'" " ") -> ,("from", Iden [Name "target_string"])]) +> ,("from", Iden [Name Nothing "target_string"])]) > ] > aggregates :: TestItem > aggregates = Group "aggregates" $ map (uncurry (TestValueExpr ansi2011)) -> [("count(*)",App [Name "count"] [Star]) +> [("count(*)",App [Name Nothing "count"] [Star]) > ,("sum(a order by a)" -> ,AggregateApp [Name "sum"] SQDefault [Iden [Name "a"]] -> [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault] Nothing) +> ,AggregateApp [Name Nothing "sum"] SQDefault [Iden [Name Nothing "a"]] +> [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault] Nothing) > ,("sum(all a)" -> ,AggregateApp [Name "sum"] All [Iden [Name "a"]] [] Nothing) +> ,AggregateApp [Name Nothing "sum"] All [Iden [Name Nothing "a"]] [] Nothing) > ,("count(distinct a)" -> ,AggregateApp [Name "count"] Distinct [Iden [Name "a"]] [] Nothing) +> ,AggregateApp [Name Nothing "count"] Distinct [Iden [Name Nothing "a"]] [] Nothing) > ] > windowFunctions :: TestItem > windowFunctions = Group "windowFunctions" $ map (uncurry (TestValueExpr ansi2011)) -> [("max(a) over ()", WindowApp [Name "max"] [Iden [Name "a"]] [] [] Nothing) -> ,("count(*) over ()", WindowApp [Name "count"] [Star] [] [] Nothing) +> [("max(a) over ()", WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [] [] Nothing) +> ,("count(*) over ()", WindowApp [Name Nothing "count"] [Star] [] [] Nothing) > ,("max(a) over (partition by b)" -> ,WindowApp [Name "max"] [Iden [Name "a"]] [Iden [Name "b"]] [] Nothing) +> ,WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]] [] Nothing) > ,("max(a) over (partition by b,c)" -> ,WindowApp [Name "max"] [Iden [Name "a"]] [Iden [Name "b"],Iden [Name "c"]] [] Nothing) +> ,WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"],Iden [Name Nothing "c"]] [] Nothing) > ,("sum(a) over (order by b)" -> ,WindowApp [Name "sum"] [Iden [Name "a"]] [] -> [SortSpec (Iden [Name "b"]) DirDefault NullsOrderDefault] Nothing) +> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [] +> [SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault] Nothing) > ,("sum(a) over (order by b desc,c)" -> ,WindowApp [Name "sum"] [Iden [Name "a"]] [] -> [SortSpec (Iden [Name "b"]) Desc NullsOrderDefault -> ,SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault] Nothing) +> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [] +> [SortSpec (Iden [Name Nothing "b"]) Desc NullsOrderDefault +> ,SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] Nothing) > ,("sum(a) over (partition by b order by c)" -> ,WindowApp [Name "sum"] [Iden [Name "a"]] [Iden [Name "b"]] -> [SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault] Nothing) +> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]] +> [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] Nothing) > ,("sum(a) over (partition by b order by c range unbounded preceding)" -> ,WindowApp [Name "sum"] [Iden [Name "a"]] [Iden [Name "b"]] -> [SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault] +> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]] +> [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] > $ Just $ FrameFrom FrameRange UnboundedPreceding) > ,("sum(a) over (partition by b order by c range 5 preceding)" -> ,WindowApp [Name "sum"] [Iden [Name "a"]] [Iden [Name "b"]] -> [SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault] +> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]] +> [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] > $ Just $ FrameFrom FrameRange $ Preceding (NumLit "5")) > ,("sum(a) over (partition by b order by c range current row)" -> ,WindowApp [Name "sum"] [Iden [Name "a"]] [Iden [Name "b"]] -> [SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault] +> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]] +> [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] > $ Just $ FrameFrom FrameRange Current) > ,("sum(a) over (partition by b order by c rows 5 following)" -> ,WindowApp [Name "sum"] [Iden [Name "a"]] [Iden [Name "b"]] -> [SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault] +> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]] +> [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] > $ Just $ FrameFrom FrameRows $ Following (NumLit "5")) > ,("sum(a) over (partition by b order by c range unbounded following)" -> ,WindowApp [Name "sum"] [Iden [Name "a"]] [Iden [Name "b"]] -> [SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault] +> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]] +> [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] > $ Just $ FrameFrom FrameRange UnboundedFollowing) > ,("sum(a) over (partition by b order by c \n\ > \range between 5 preceding and 5 following)" -> ,WindowApp [Name "sum"] [Iden [Name "a"]] [Iden [Name "b"]] -> [SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault] +> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]] +> [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] > $ Just $ FrameBetween FrameRange > (Preceding (NumLit "5")) > (Following (NumLit "5"))) @@ -401,6 +401,6 @@ target_string > parens :: TestItem > parens = Group "parens" $ map (uncurry (TestValueExpr ansi2011)) -> [("(a)", Parens (Iden [Name "a"])) -> ,("(a + b)", Parens (BinOp (Iden [Name "a"]) [Name "+"] (Iden [Name "b"]))) +> [("(a)", Parens (Iden [Name Nothing "a"])) +> ,("(a + b)", Parens (BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"]))) > ]