From ab82249523cd6a68ca9481b2de8436f89eca56db Mon Sep 17 00:00:00 2001
From: prescientmoon <git@moonythm.dev>
Date: Fri, 10 Jan 2025 18:48:30 +0100
Subject: [PATCH] Implement explain (query plan) statements, ala sqlite

---
 Language/SQL/SimpleSQL/Parse.hs               |  9 +++++++++
 Language/SQL/SimpleSQL/Pretty.hs              |  4 ++++
 Language/SQL/SimpleSQL/Syntax.hs              | 11 +++++++++++
 tests/Language/SQL/SimpleSQL/SQL2011Schema.hs | 12 ++++++++++++
 4 files changed, 36 insertions(+)

diff --git a/Language/SQL/SimpleSQL/Parse.hs b/Language/SQL/SimpleSQL/Parse.hs
index 6776889..86ccec8 100644
--- a/Language/SQL/SimpleSQL/Parse.hs
+++ b/Language/SQL/SimpleSQL/Parse.hs
@@ -1712,6 +1712,7 @@ statementWithoutSemicolon =
     ,rollback
     ,grant
     ,revoke
+    ,explain
     ,SelectStatement <$> queryExpr
     ]
 
@@ -2168,6 +2169,14 @@ privilegeObject = choice
     ,optional (keyword_ "table") >> PrivTable <$> names "table name"
     ]
 
+explain :: Parser Statement
+explain = do
+  keyword_ "explain" >>
+    Explain
+      <$> isJust <$> optional (keywords_ ["query", "plan"])
+      <*> statementWithoutSemicolon
+
+
 
 {-
 ----------------------------
diff --git a/Language/SQL/SimpleSQL/Pretty.hs b/Language/SQL/SimpleSQL/Pretty.hs
index 634efc7..1c2ddd9 100644
--- a/Language/SQL/SimpleSQL/Pretty.hs
+++ b/Language/SQL/SimpleSQL/Pretty.hs
@@ -681,6 +681,10 @@ statement _ (RevokeRole ao rs trs db) =
     adminOptFor AdminOptionFor = texts ["admin","option","for"]
     adminOptFor NoAdminOptionFor = mempty
 
+statement dialect (Explain explainQueryPlan inner) =
+  pretty "explain"
+  <+> (if explainQueryPlan then pretty "query plan" else mempty)
+  <+> statement dialect inner
 
 statement _ (StatementComment cs) = vsep $ map comment cs
 statement _ EmptyStatement = mempty
diff --git a/Language/SQL/SimpleSQL/Syntax.hs b/Language/SQL/SimpleSQL/Syntax.hs
index f6e3e80..b5f1e68 100644
--- a/Language/SQL/SimpleSQL/Syntax.hs
+++ b/Language/SQL/SimpleSQL/Syntax.hs
@@ -523,10 +523,20 @@ data Statement =
   | SetNames
   | SetTransform
   | SetCollation -}
+  | Explain
+      -- When enabled, this corresponds to the higher level
+      -- "EXPLAIN QUERY PLAN" statement
+      {esExplainQueryPlan :: Bool
+      -- Technically a sqlite "explain" cannot be followed by another explain
+      -- statement, but I think this representation is good enough...
+      ,esStatement :: Statement
+      }
   | StatementComment [Comment]
   | EmptyStatement
     deriving (Eq,Show,Read,Data,Typeable)
 
+
+
 data DropBehaviour =
     Restrict
   | Cascade
@@ -720,6 +730,7 @@ data PrivilegeAction =
     | PrivExecute
     deriving (Eq,Show,Read,Data,Typeable)
 
+
 -- | Comment. Useful when generating SQL code programmatically. The
 -- parser doesn't produce these.
 newtype Comment = BlockComment Text
diff --git a/tests/Language/SQL/SimpleSQL/SQL2011Schema.hs b/tests/Language/SQL/SimpleSQL/SQL2011Schema.hs
index 783b356..f8c4d33 100644
--- a/tests/Language/SQL/SimpleSQL/SQL2011Schema.hs
+++ b/tests/Language/SQL/SimpleSQL/SQL2011Schema.hs
@@ -775,6 +775,18 @@ defintely skip
          $ ColDefaultClause
          $ DefaultClause $ NumLit "2"]]
        False
+    ,testStatement ansi2011
+      "explain create table t (a int);"
+     $ Explain False
+     $ CreateTable [Name Nothing "t"]
+       [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"])) []]
+       False
+    ,testStatement ansi2011
+      "explain query plan create table t (a int);"
+     $ Explain True
+     $ CreateTable [Name Nothing "t"]
+       [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"])) []]
+       False
 
 
 {-