From aeaa4454978433d68122599a02224d9932114f4f Mon Sep 17 00:00:00 2001
From: stefan-hoeck <hock@zhaw.ch>
Date: Wed, 8 Nov 2023 11:05:10 +0100
Subject: [PATCH] [ syntax ] infix ops to assemble queries

---
 sqlite3-rio/src/Control/RIO/Sqlite3.idr |  2 +-
 src/Sqlite3/Cmd.idr                     | 41 +++++++++++++++++++------
 src/Sqlite3/Parameter.idr               |  2 +-
 test/src/Schema.idr                     | 27 +++++-----------
 4 files changed, 42 insertions(+), 30 deletions(-)

diff --git a/sqlite3-rio/src/Control/RIO/Sqlite3.idr b/sqlite3-rio/src/Control/RIO/Sqlite3.idr
index 8cc232d..7750ca8 100644
--- a/sqlite3-rio/src/Control/RIO/Sqlite3.idr
+++ b/sqlite3-rio/src/Control/RIO/Sqlite3.idr
@@ -116,4 +116,4 @@ parameters {auto has : Has SqlError es}
 
   export %inline
   query : {auto db : DB} -> Query t -> Nat -> App es (List t)
-  query q@(SELECT {}) = selectRows (encodeQuery q)
+  query q = selectRows (encodeQuery q)
diff --git a/src/Sqlite3/Cmd.idr b/src/Sqlite3/Cmd.idr
index 3254795..3ffa6f6 100644
--- a/src/Sqlite3/Cmd.idr
+++ b/src/Sqlite3/Cmd.idr
@@ -209,16 +209,39 @@ record OrderingTerm (s : Schema) where
 
 ||| Different types of `SELECT` commands.
 public export
-data Query : Type -> Type where
-  SELECT :
-       {auto as   : AsRow t}
-    -> (xs        : LAll (Expr s) (RowTypes t))
-    -> (from      : From s)
-    -> (where_    : Expr s BOOL)
-    -> (group_by  : List (OrderingTerm s))
-    -> (order_by  : List (OrderingTerm s))
-    -> Query t
+record Query (t : Type) where
+  [noHints]
+  constructor Q
+  {auto asRow : AsRow t}
+  schema      : Schema
+  from        : From schema
+  columns     : LAll (Expr schema) (RowTypes t)
+  where_      : Expr schema BOOL
+  group_by    : List (OrderingTerm schema)
+  order_by    : List (OrderingTerm schema)
+
+public export %inline %hint
+queryAsRow : (q : Query t) => AsRow t
+queryAsRow = q.asRow
 
 public export
 0 LQuery : List Type -> Type
 LQuery = Query . HList
+
+infixl 7 `GROUP_BY`,`ORDER_BY`,`WHERE`
+
+public export %inline
+SELECT : {s : _} -> AsRow t => LAll (Expr s) (RowTypes t) -> From s -> Query t
+SELECT xs from = Q s from xs TRUE [] []
+
+public export %inline
+GROUP_BY : (q : Query t) -> List (OrderingTerm q.schema) -> Query t
+GROUP_BY q os = {group_by := os} q
+
+public export %inline
+WHERE : (q : Query t) -> Expr q.schema BOOL -> Query t
+WHERE q p = {where_ := p} q
+
+public export %inline
+ORDER_BY : (q : Query t) -> List (OrderingTerm q.schema) -> Query t
+ORDER_BY q os = {order_by := os} q
diff --git a/src/Sqlite3/Parameter.idr b/src/Sqlite3/Parameter.idr
index 1ec09d9..176ff6d 100644
--- a/src/Sqlite3/Parameter.idr
+++ b/src/Sqlite3/Parameter.idr
@@ -301,7 +301,7 @@ encodeOrd s xs = do
 ||| inserted as placeholders for literal values where appropriate.
 export
 encodeQuery : Query ts -> ParamStmt
-encodeQuery (SELECT vs from where_ group_by order_by) = do
+encodeQuery (Q _ from vs where_ group_by order_by) = do
   vstr <- exprs [<] vs
   fstr <- encodeFrom from
   wh   <- encodeExprP where_
diff --git a/test/src/Schema.idr b/test/src/Schema.idr
index ed55fba..ed9f4f7 100644
--- a/test/src/Schema.idr
+++ b/test/src/Schema.idr
@@ -173,13 +173,11 @@ mol x =
   SELECT
     ["molecule_id", "name", "casnr", "molweight", "type"]
     [<FROM Molecules]
-    x
-    []
-    []
+  `WHERE` x
 
 export
 file : Expr [<Files] BOOL -> Query (Item File)
-file x = SELECT ["file_id", "content"] [<FROM Files] x [] []
+file x = SELECT ["file_id", "content"] [<FROM Files] `WHERE` x
 
 export
 employee : Query (Item $ Employee String)
@@ -189,9 +187,8 @@ employee =
     [< FROM (Employees `AS` "e")
     ,  JOIN (Units `AS` "u") `USING` ["unit_id"]
     ]
-    ("e.salary" > 3000.0)
-    []
-    [O "e.salary" None ASC, O "e.name" NOCASE ASC]
+  `WHERE`    ("e.salary" > 3000.0)
+  `ORDER_BY` [O "e.salary" None ASC, O "e.name" NOCASE ASC]
 
 export
 unitStats : LQuery [String,Bits32,Double,Double,Double]
@@ -201,9 +198,7 @@ unitStats =
     [< FROM (Employees `AS` "e")
     ,  JOIN (Units `AS` "u") `USING` ["unit_id"]
     ]
-    TRUE
-    [O "e.unit_id" None NoAsc]
-    []
+    `GROUP_BY` [O "e.unit_id" None NoAsc]
 
 export
 heads : Query (OrgUnit String)
@@ -213,9 +208,6 @@ heads =
     [< FROM $ Employees `AS` "e"
     ,  JOIN (Units `AS` "u") `ON` ("e.employee_id" == "u.head")
     ]
-    TRUE
-    []
-    []
 
 export
 nonHeads : LQuery [Bits32, String]
@@ -225,9 +217,8 @@ nonHeads =
     [< FROM $ Employees `AS` "e"
     ,  OUTER_JOIN (Units `AS` "u") `ON` ("e.employee_id" == "u.head")
     ]
-    (IS NULL "u.head")
-    []
-    [O "e.name" None ASC]
+    `WHERE`    IS NULL "u.head"
+    `ORDER_BY` [O "e.name" None ASC]
 
 export
 tuples : LQuery [String,Double,Double,MolType]
@@ -238,6 +229,4 @@ tuples =
     ,  CROSS_JOIN $ Molecules `AS` "m1"
     ,  CROSS_JOIN $ Molecules `AS` "m2"
     ]
-    ("m1.molweight" < "m2.molweight")
-    []
-    []
+    `WHERE` ("m1.molweight" < "m2.molweight")