From 05481371dd8bbb903d80c5aaf93e6a3da6fa09f8 Mon Sep 17 00:00:00 2001
From: Jake <jakewheat@tutanota.com>
Date: Tue, 19 Oct 2021 16:32:25 +0100
Subject: [PATCH] add schema support for create index referenced table, and add
 some tests

---
 Language/SQL/SimpleSQL/Parse.lhs             |  2 +-
 Language/SQL/SimpleSQL/Pretty.lhs            |  9 +++++++++
 Language/SQL/SimpleSQL/Syntax.lhs            |  2 +-
 simple-sql-parser.cabal                      |  4 +++-
 tools/Language/SQL/SimpleSQL/CreateIndex.lhs | 17 +++++++++++++++++
 tools/Language/SQL/SimpleSQL/Tests.lhs       |  3 +++
 6 files changed, 34 insertions(+), 3 deletions(-)
 create mode 100644 tools/Language/SQL/SimpleSQL/CreateIndex.lhs

diff --git a/Language/SQL/SimpleSQL/Parse.lhs b/Language/SQL/SimpleSQL/Parse.lhs
index 7e152d0..76eefab 100644
--- a/Language/SQL/SimpleSQL/Parse.lhs
+++ b/Language/SQL/SimpleSQL/Parse.lhs
@@ -1511,7 +1511,7 @@ TODO: change style
 >     <$> ((keyword_ "index" >> pure False) <|>
 >          (keywords_ ["unique", "index"] >> pure True))
 >     <*> names
->     <*> (keyword_ "on" >> name)
+>     <*> (keyword_ "on" >> names)
 >     <*> parens (commaSep1 name)
 
 > columnDef :: Parser ColumnDef
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index f611cb4..b085e83 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -531,6 +531,15 @@ Try to do this when this code is ported to a modern pretty printing lib.
 > statement _ (DropAssertion nm db) =
 >     text "drop" <+> text "assertion" <+> names nm <+> dropBehav db
 
+> statement _ (CreateIndex un nm tbl cols) =
+>   texts (if un
+>          then ["create","unique","index"]
+>          else  ["create","index"])
+>   <+> names nm
+>   <+> text "on"
+>   <+> names tbl
+>   <+> parens (commaSep $ map name cols)
+
 == dml
 
 > statement d (SelectStatement q) = queryExpr d q
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index 7d1c0be..5c669da 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -454,7 +454,7 @@ I'm not sure if this is valid syntax or not.
 >   | CreateTable [Name] [TableElement]
 >   | AlterTable [Name] AlterTableAction
 >   | DropTable [Name] DropBehaviour
->   | CreateIndex Bool [Name] Name [Name]
+>   | CreateIndex Bool [Name] [Name] [Name]
 >   | CreateView Bool [Name] (Maybe [Name])
 >         QueryExpr (Maybe CheckOption)
 >   | DropView [Name]  DropBehaviour
diff --git a/simple-sql-parser.cabal b/simple-sql-parser.cabal
index a7e1427..afe4a4f 100644
--- a/simple-sql-parser.cabal
+++ b/simple-sql-parser.cabal
@@ -86,7 +86,9 @@ Test-Suite Tests
                        Language.SQL.SimpleSQL.ScalarExprs,
                        Language.SQL.SimpleSQL.LexerTests,
                        Language.SQL.SimpleSQL.CustomDialect,
-                       Language.SQL.SimpleSQL.EmptyStatement
+                       Language.SQL.SimpleSQL.EmptyStatement,
+                       Language.SQL.SimpleSQL.CreateIndex
+                       
   ghc-options:         -threaded
 
 executable SimpleSqlParserTool
diff --git a/tools/Language/SQL/SimpleSQL/CreateIndex.lhs b/tools/Language/SQL/SimpleSQL/CreateIndex.lhs
new file mode 100644
index 0000000..cfb38be
--- /dev/null
+++ b/tools/Language/SQL/SimpleSQL/CreateIndex.lhs
@@ -0,0 +1,17 @@
+
+> module Language.SQL.SimpleSQL.CreateIndex where
+>
+> import Language.SQL.SimpleSQL.Syntax
+> import Language.SQL.SimpleSQL.TestTypes
+>
+> createIndexTests :: TestItem
+> createIndexTests = Group "create index tests"
+>     [TestStatement ansi2011 "create index a on tbl(c1)"
+>       $ CreateIndex False [nm "a"] [nm "tbl"] [nm "c1"]
+>     ,TestStatement ansi2011 "create index a.b on sc.tbl (c1, c2)"
+>       $ CreateIndex False [nm "a", nm "b"] [nm "sc", nm "tbl"] [nm "c1", nm "c2"]
+>     ,TestStatement ansi2011 "create unique index a on tbl(c1)"
+>       $ CreateIndex True [nm "a"] [nm "tbl"] [nm "c1"]
+>     ]
+>   where
+>     nm = Name Nothing
diff --git a/tools/Language/SQL/SimpleSQL/Tests.lhs b/tools/Language/SQL/SimpleSQL/Tests.lhs
index 44c0a89..1cc5c2e 100644
--- a/tools/Language/SQL/SimpleSQL/Tests.lhs
+++ b/tools/Language/SQL/SimpleSQL/Tests.lhs
@@ -30,6 +30,7 @@ test data to the Test.Framework tests.
 > import Language.SQL.SimpleSQL.Tpch
 > import Language.SQL.SimpleSQL.LexerTests
 > import Language.SQL.SimpleSQL.EmptyStatement
+> import Language.SQL.SimpleSQL.CreateIndex
 
 > import Language.SQL.SimpleSQL.SQL2011Queries
 > import Language.SQL.SimpleSQL.SQL2011AccessControl
@@ -41,6 +42,7 @@ test data to the Test.Framework tests.
 > import Language.SQL.SimpleSQL.Oracle
 > import Language.SQL.SimpleSQL.CustomDialect
 
+
 Order the tests to start from the simplest first. This is also the
 order on the generated documentation.
 
@@ -66,6 +68,7 @@ order on the generated documentation.
 >     ,oracleTests
 >     ,customDialectTests
 >     ,emptyStatementTests
+>     ,createIndexTests
 >     ]
 
 > tests :: T.TestTree