@@ -0,0 +1,1089 @@
1+module Yoga.ScyllaDB.Schema where
2+
3+import Prelude
4+
5+import Control.Monad.Except (runExcept)
6+import Data.Array (intercalate)
7+import Data.DateTime (DateTime)
8+import Data.Either (Either(..))
9+import Data.Foldable (foldl)
10+import Data.Map as Map
11+import Data.Maybe (Maybe(..))
12+import Data.String.Regex as Regex
13+import Data.String.Regex.Flags as RegexFlags
14+import Data.Symbol (class IsSymbol, reflectSymbol)
15+import Data.Traversable (traverse)
16+import Effect.Aff (Aff, throwError)
17+import Effect.Exception as Exception
18+import Foreign (Foreign, unsafeToForeign)
19+import Prim.Row as Row
20+import Prim.RowList as RL
21+import Prim.RowList (class RowToList)
22+import Prim.Symbol as Symbol
23+import Prim.TypeError (class Fail, Text)
24+import Record as Record
25+import Type.Proxy (Proxy(..))
26+import Type.RowList (class ListToRow)
27+import Unsafe.Coerce (unsafeCoerce)
28+import Yoga.JSON (class ReadForeign, readImpl)
29+import Yoga.ScyllaDB.ScyllaDB as Scylla
30+
31+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
32+-- Core phantom types
33+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
34+
35+data Table :: Symbol -> Row Type -> Type
36+data Table name columns = Table
37+
38+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
39+-- Constraint wrappers (used with # operator from Type.Function)
40+-- Int # PartitionKey = PartitionKey Int
41+-- Int # ClusteringKey = ClusteringKey Int
42+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
43+
44+data PartitionKey :: Type -> Type
45+data PartitionKey a
46+
47+data ClusteringKey :: Type -> Type
48+data ClusteringKey a
49+
50+data Static :: Type -> Type
51+data Static a
52+
53+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
54+-- Nullability: inferred from Maybe
55+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
56+
57+class IsNullable a where
58+ isNullable :: Proxy a -> Boolean
59+
60+instance IsNullable (Maybe a) where
61+ isNullable _ = true
62+else instance IsNullable a where
63+ isNullable _ = false
64+
65+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
66+-- ExtractType: recursively unwrap constraint wrappers to get base type
67+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
68+
69+class ExtractType :: Type -> Type -> Constraint
70+class ExtractType wrapped typ | wrapped -> typ
71+
72+instance ExtractType a typ => ExtractType (PartitionKey a) typ
73+else instance ExtractType a typ => ExtractType (ClusteringKey a) typ
74+else instance ExtractType a typ => ExtractType (Static a) typ
75+else instance ExtractType a a
76+
77+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
78+-- PureScript type -> CQL type name
79+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
80+
81+class CQLTypeName a where
82+ cqlTypeName :: Proxy a -> String
83+
84+instance CQLTypeName Int where
85+ cqlTypeName _ = "int"
86+
87+instance CQLTypeName String where
88+ cqlTypeName _ = "text"
89+
90+instance CQLTypeName Boolean where
91+ cqlTypeName _ = "boolean"
92+
93+instance CQLTypeName Number where
94+ cqlTypeName _ = "double"
95+
96+instance CQLTypeName DateTime where
97+ cqlTypeName _ = "timestamp"
98+
99+instance CQLTypeName Scylla.UUID where
100+ cqlTypeName _ = "uuid"
101+
102+instance CQLTypeName a => CQLTypeName (Maybe a) where
103+ cqlTypeName _ = cqlTypeName (Proxy :: Proxy a)
104+
105+instance CQLTypeName a => CQLTypeName (Array a) where
106+ cqlTypeName _ = "list<" <> cqlTypeName (Proxy :: Proxy a) <> ">"
107+
108+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
109+-- Constraint rendering (STATIC only — PK/CK handled in PRIMARY KEY clause)
110+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
111+
112+class RenderConstraint a where
113+ renderConstraint :: Proxy a -> String
114+
115+instance RenderConstraint a => RenderConstraint (PartitionKey a) where
116+ renderConstraint _ = renderConstraint (Proxy :: Proxy a)
117+
118+else instance RenderConstraint a => RenderConstraint (ClusteringKey a) where
119+ renderConstraint _ = renderConstraint (Proxy :: Proxy a)
120+
121+else instance RenderConstraint a => RenderConstraint (Static a) where
122+ renderConstraint _ = joinConstraints "STATIC" (renderConstraint (Proxy :: Proxy a))
123+
124+else instance RenderConstraint a where
125+ renderConstraint _ = ""
126+
127+joinConstraints :: String -> String -> String
128+joinConstraints a b = case a, b of
129+ "", s -> s
130+ s, "" -> s
131+ s1, s2 -> s1 <> " " <> s2
132+
133+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
134+-- Primary key detection
135+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
136+
137+class IsPartitionKey a where
138+ isPartitionKey :: Proxy a -> Boolean
139+
140+instance IsPartitionKey (PartitionKey a) where
141+ isPartitionKey _ = true
142+else instance IsPartitionKey a => IsPartitionKey (Static a) where
143+ isPartitionKey _ = isPartitionKey (Proxy :: Proxy a)
144+else instance IsPartitionKey a where
145+ isPartitionKey _ = false
146+
147+class IsClusteringKey a where
148+ isClusteringKey :: Proxy a -> Boolean
149+
150+instance IsClusteringKey (ClusteringKey a) where
151+ isClusteringKey _ = true
152+else instance IsClusteringKey a => IsClusteringKey (Static a) where
153+ isClusteringKey _ = isClusteringKey (Proxy :: Proxy a)
154+else instance IsClusteringKey a where
155+ isClusteringKey _ = false
156+
157+class IsKeyColumn a where
158+ isKeyColumn :: Proxy a -> Boolean
159+
160+instance IsKeyColumn (PartitionKey a) where
161+ isKeyColumn _ = true
162+else instance IsKeyColumn (ClusteringKey a) where
163+ isKeyColumn _ = true
164+else instance IsKeyColumn a where
165+ isKeyColumn _ = false
166+
167+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
168+-- DDL generation: column definitions
169+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
170+
171+class RenderColumnsRL :: RL.RowList Type -> Constraint
172+class RenderColumnsRL rl where
173+ renderColumnsRL :: Proxy rl -> Array String
174+
175+instance RenderColumnsRL RL.Nil where
176+ renderColumnsRL _ = []
177+
178+instance
179+ ( IsSymbol name
180+ , ExtractType entry typ
181+ , CQLTypeName typ
182+ , RenderConstraint entry
183+ , RenderColumnsRL tail
184+ ) =>
185+ RenderColumnsRL (RL.Cons name entry tail) where
186+ renderColumnsRL _ = do
187+ let colName = reflectSymbol (Proxy :: Proxy name)
188+ let colType = cqlTypeName (Proxy :: Proxy typ)
189+ let constraints = renderConstraint (Proxy :: Proxy entry)
190+ let constraintsSuffix = if constraints == "" then "" else " " <> constraints
191+ [ colName <> " " <> colType <> constraintsSuffix ] <> renderColumnsRL (Proxy :: Proxy tail)
192+
193+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
194+-- DDL generation: PRIMARY KEY clause
195+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
196+
197+class PartitionKeysRL :: RL.RowList Type -> Constraint
198+class PartitionKeysRL rl where
199+ partitionKeysRL :: Proxy rl -> Array String
200+
201+instance PartitionKeysRL RL.Nil where
202+ partitionKeysRL _ = []
203+
204+instance
205+ ( IsSymbol name
206+ , IsPartitionKey entry
207+ , PartitionKeysRL tail
208+ ) =>
209+ PartitionKeysRL (RL.Cons name entry tail) where
210+ partitionKeysRL _ =
211+ let rest = partitionKeysRL (Proxy :: Proxy tail)
212+ in
213+ if isPartitionKey (Proxy :: Proxy entry) then [ reflectSymbol (Proxy :: Proxy name) ] <> rest
214+ else rest
215+
216+class ClusteringKeysRL :: RL.RowList Type -> Constraint
217+class ClusteringKeysRL rl where
218+ clusteringKeysRL :: Proxy rl -> Array String
219+
220+instance ClusteringKeysRL RL.Nil where
221+ clusteringKeysRL _ = []
222+
223+instance
224+ ( IsSymbol name
225+ , IsClusteringKey entry
226+ , ClusteringKeysRL tail
227+ ) =>
228+ ClusteringKeysRL (RL.Cons name entry tail) where
229+ clusteringKeysRL _ =
230+ let rest = clusteringKeysRL (Proxy :: Proxy tail)
231+ in
232+ if isClusteringKey (Proxy :: Proxy entry) then [ reflectSymbol (Proxy :: Proxy name) ] <> rest
233+ else rest
234+
235+renderPrimaryKey :: Array String -> Array String -> String
236+renderPrimaryKey partitionKeys clusteringKeys = case partitionKeys, clusteringKeys of
237+ [], [] -> ""
238+ pks, [] -> "PRIMARY KEY ((" <> intercalate ", " pks <> "))"
239+ pks, cks -> "PRIMARY KEY ((" <> intercalate ", " pks <> "), " <> intercalate ", " cks <> ")"
240+
241+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
242+-- CREATE TABLE
243+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
244+
245+class CreateTableDDL a where
246+ createTableDDL :: String
247+
248+instance
249+ ( IsSymbol name
250+ , RowToList cols rl
251+ , RenderColumnsRL rl
252+ , PartitionKeysRL rl
253+ , ClusteringKeysRL rl
254+ ) =>
255+ CreateTableDDL (Table name cols) where
256+ createTableDDL = do
257+ let tableName = reflectSymbol (Proxy :: Proxy name)
258+ let columns = renderColumnsRL (Proxy :: Proxy rl)
259+ let pks = partitionKeysRL (Proxy :: Proxy rl)
260+ let cks = clusteringKeysRL (Proxy :: Proxy rl)
261+ let pkClause = renderPrimaryKey pks cks
262+ let allParts = columns <> (if pkClause == "" then [] else [pkClause])
263+ "CREATE TABLE IF NOT EXISTS " <> tableName <> " (" <> intercalate ", " allParts <> ")"
264+
265+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
266+-- INSERT SQL generation
267+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
268+
269+class InsertColumnsRL :: RL.RowList Type -> Constraint
270+class InsertColumnsRL rl where
271+ insertColumnsRL :: Proxy rl -> Array String
272+
273+instance InsertColumnsRL RL.Nil where
274+ insertColumnsRL _ = []
275+
276+instance
277+ ( IsSymbol name
278+ , InsertColumnsRL tail
279+ ) =>
280+ InsertColumnsRL (RL.Cons name entry tail) where
281+ insertColumnsRL _ =
282+ [ reflectSymbol (Proxy :: Proxy name) ] <> insertColumnsRL (Proxy :: Proxy tail)
283+
284+class InsertSQLFor a where
285+ insertSQLFor :: String
286+
287+instance
288+ ( IsSymbol name
289+ , RowToList cols rl
290+ , InsertColumnsRL rl
291+ ) =>
292+ InsertSQLFor (Table name cols) where
293+ insertSQLFor = do
294+ let tableName = reflectSymbol (Proxy :: Proxy name)
295+ let cols = insertColumnsRL (Proxy :: Proxy rl)
296+ let placeholders = map (const "?") cols
297+ "INSERT INTO " <> tableName
298+ <> " (" <> intercalate ", " cols <> ")"
299+ <> " VALUES (" <> intercalate ", " placeholders <> ")"
300+
301+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
302+-- SELECT SQL generation
303+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
304+
305+class SelectAllSQLFor a where
306+ selectAllSQLFor :: String
307+
308+instance
309+ ( IsSymbol name
310+ ) =>
311+ SelectAllSQLFor (Table name cols) where
312+ selectAllSQLFor = "SELECT * FROM " <> reflectSymbol (Proxy :: Proxy name)
313+
314+class WhereClauseRL :: RL.RowList Type -> Constraint
315+class WhereClauseRL rl where
316+ whereClauseRL :: Proxy rl -> Array String
317+
318+instance WhereClauseRL RL.Nil where
319+ whereClauseRL _ = []
320+
321+instance (IsSymbol name, WhereClauseRL tail) => WhereClauseRL (RL.Cons name typ tail) where
322+ whereClauseRL _ =
323+ [ reflectSymbol (Proxy :: Proxy name) <> " = ?" ]
324+ <> whereClauseRL (Proxy :: Proxy tail)
325+
326+class SelectWhereSQLFor a whereRow where
327+ selectWhereSQLFor :: String
328+
329+instance
330+ ( IsSymbol name
331+ , RowToList whereRow whereRL
332+ , WhereClauseRL whereRL
333+ ) =>
334+ SelectWhereSQLFor (Table name cols) whereRow where
335+ selectWhereSQLFor = do
336+ let tableName = reflectSymbol (Proxy :: Proxy name)
337+ let conditions = whereClauseRL (Proxy :: Proxy whereRL)
338+ "SELECT * FROM " <> tableName <> " WHERE " <> intercalate " AND " conditions
339+
340+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
341+-- UPDATE SQL generation
342+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
343+
344+class ColumnCountRL :: RL.RowList Type -> Constraint
345+class ColumnCountRL rl where
346+ columnCountRL :: Proxy rl -> Int
347+
348+instance ColumnCountRL RL.Nil where
349+ columnCountRL _ = 0
350+
351+instance ColumnCountRL tail => ColumnCountRL (RL.Cons name typ tail) where
352+ columnCountRL _ = 1 + columnCountRL (Proxy :: Proxy tail)
353+
354+class SetClauseRL :: RL.RowList Type -> Constraint
355+class SetClauseRL rl where
356+ setClauseRL :: Proxy rl -> Array String
357+
358+instance SetClauseRL RL.Nil where
359+ setClauseRL _ = []
360+
361+instance (IsSymbol name, SetClauseRL tail) => SetClauseRL (RL.Cons name typ tail) where
362+ setClauseRL _ =
363+ [ reflectSymbol (Proxy :: Proxy name) <> " = ?" ]
364+ <> setClauseRL (Proxy :: Proxy tail)
365+
366+class UpdateSQLFor table setRow whereRow where
367+ updateSQLFor :: String
368+
369+instance
370+ ( IsSymbol name
371+ , RowToList setRow setRL
372+ , RowToList whereRow whereRL
373+ , SetClauseRL setRL
374+ , WhereClauseRL whereRL
375+ ) =>
376+ UpdateSQLFor (Table name cols) setRow whereRow where
377+ updateSQLFor = do
378+ let tableName = reflectSymbol (Proxy :: Proxy name)
379+ let setClauses = setClauseRL (Proxy :: Proxy setRL)
380+ let whereClauses = whereClauseRL (Proxy :: Proxy whereRL)
381+ "UPDATE " <> tableName
382+ <> " SET " <> intercalate ", " setClauses
383+ <> " WHERE " <> intercalate " AND " whereClauses
384+
385+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
386+-- DELETE SQL generation
387+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
388+
389+class DeleteSQLFor table whereRow where
390+ deleteSQLFor :: String
391+
392+instance
393+ ( IsSymbol name
394+ , RowToList whereRow whereRL
395+ , WhereClauseRL whereRL
396+ ) =>
397+ DeleteSQLFor (Table name cols) whereRow where
398+ deleteSQLFor = do
399+ let tableName = reflectSymbol (Proxy :: Proxy name)
400+ let conditions = whereClauseRL (Proxy :: Proxy whereRL)
401+ "DELETE FROM " <> tableName <> " WHERE " <> intercalate " AND " conditions
402+
403+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
404+-- StripColumns: (name :: String # PartitionKey, ...) -> (name :: String, ...)
405+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
406+
407+class StripColumnsRL :: RL.RowList Type -> RL.RowList Type -> Constraint
408+class StripColumnsRL rl out | rl -> out
409+
410+instance StripColumnsRL RL.Nil RL.Nil
411+instance (ExtractType entry typ, StripColumnsRL tail out') => StripColumnsRL (RL.Cons name entry tail) (RL.Cons name typ out')
412+
413+class StripColumns :: Row Type -> Row Type -> Constraint
414+class StripColumns cols result | cols -> result
415+
416+instance (RowToList cols rl, StripColumnsRL rl outRL, ListToRow outRL result) => StripColumns cols result
417+
418+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
419+-- InsertNonKeyColumnsRL: columns that are NOT part of the primary key
420+-- (useful for building insert params excluding auto-generated key columns)
421+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
422+
423+class NonKeyColumnsRL :: RL.RowList Type -> Constraint
424+class NonKeyColumnsRL rl where
425+ nonKeyColumnsRL :: Proxy rl -> Array String
426+
427+instance NonKeyColumnsRL RL.Nil where
428+ nonKeyColumnsRL _ = []
429+
430+instance
431+ ( IsSymbol name
432+ , IsKeyColumn entry
433+ , NonKeyColumnsRL tail
434+ ) =>
435+ NonKeyColumnsRL (RL.Cons name entry tail) where
436+ nonKeyColumnsRL _ =
437+ let rest = nonKeyColumnsRL (Proxy :: Proxy tail)
438+ in
439+ if isKeyColumn (Proxy :: Proxy entry) then rest
440+ else [ reflectSymbol (Proxy :: Proxy name) ] <> rest
441+
442+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
443+-- Q type: Builder phantom type for CQL queries
444+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
445+
446+newtype Q :: Row (Row Type) -> Row Type -> Row Type -> Row Type -> Type
447+newtype Q tables result params stage = Q { sql :: String, values :: Array Foreign }
448+
449+toSQL :: forall tables result params stage. Q tables result params stage -> String
450+toSQL (Q q) = q.sql
451+
452+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
453+-- SingleTable: extract name and cols from a one-entry tables row
454+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
455+
456+class SingleTable :: Row (Row Type) -> Symbol -> Row Type -> Constraint
457+class SingleTable tables name cols | tables -> name cols
458+
459+instance
460+ ( RowToList tables (RL.Cons name cols RL.Nil)
461+ , IsSymbol name
462+ ) =>
463+ SingleTable tables name cols
464+
465+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
466+-- HasClause / HasAnyDML: stage constraints
467+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
468+
469+class HasClause :: Symbol -> Row Type -> Constraint
470+class HasClause label row
471+
472+instance Row.Cons label Unit rest row => HasClause label row
473+
474+class HasAnyDML :: Row Type -> Constraint
475+class HasAnyDML stage
476+
477+instance (RL.RowToList stage rl, HasAnyDMLRL rl) => HasAnyDML stage
478+
479+class HasAnyDMLRL :: RL.RowList Type -> Constraint
480+class HasAnyDMLRL rl
481+
482+instance HasAnyDMLRL (RL.Cons "select" Unit rest)
483+else instance HasAnyDMLRL (RL.Cons "set" Unit rest)
484+else instance HasAnyDMLRL (RL.Cons "delete" Unit rest)
485+else instance HasAnyDMLRL rest => HasAnyDMLRL (RL.Cons label typ rest)
486+else instance Fail (Text "WHERE requires a preceding SELECT, UPDATE (set), or DELETE") => HasAnyDMLRL RL.Nil
487+
488+-- Values use the public Scylla.ToCQLValue extension point. Maybe must unwrap
489+-- through that instance so wrapped domain values keep their database encoding.
490+
491+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
492+-- RecordValuesRL: walk a RowList and extract values from a record
493+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
494+
495+class RecordValuesRL :: RL.RowList Type -> Row Type -> Constraint
496+class RecordValuesRL rl row where
497+ recordValuesRL :: Proxy rl -> { | row } -> Array Foreign
498+
499+instance RecordValuesRL RL.Nil row where
500+ recordValuesRL _ _ = []
501+
502+instance
503+ ( IsSymbol name
504+ , Row.Cons name typ rest row
505+ , Scylla.ToCQLValue typ
506+ , RecordValuesRL tail row
507+ ) =>
508+ RecordValuesRL (RL.Cons name typ tail) row where
509+ recordValuesRL _ rec =
510+ [ Scylla.toCQLValue (Record.get (Proxy :: Proxy name) rec) ]
511+ <> recordValuesRL (Proxy :: Proxy tail) rec
512+
513+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
514+-- ColumnNamesRL: extract column names from a RowList
515+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
516+
517+class ColumnNamesRL :: RL.RowList Type -> Constraint
518+class ColumnNamesRL rl where
519+ columnNamesRL :: Proxy rl -> Array String
520+
521+instance ColumnNamesRL RL.Nil where
522+ columnNamesRL _ = []
523+
524+instance (IsSymbol name, ColumnNamesRL tail) => ColumnNamesRL (RL.Cons name typ tail) where
525+ columnNamesRL _ =
526+ [ reflectSymbol (Proxy :: Proxy name) ] <> columnNamesRL (Proxy :: Proxy tail)
527+
528+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
529+-- ValidateSetColumnsRL: ensure SET columns exist in the table
530+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
531+
532+class ValidateSetColumnsRL :: RL.RowList Type -> Row Type -> Constraint
533+class ValidateSetColumnsRL rl cols
534+
535+instance ValidateSetColumnsRL RL.Nil cols
536+
537+instance
538+ ( IsSymbol name
539+ , Row.Cons name colType rest cols
540+ , ValidateSetColumnsRL tail cols
541+ ) =>
542+ ValidateSetColumnsRL (RL.Cons name typ tail) cols
543+
544+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
545+-- Builder: from
546+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
547+
548+from
549+ :: forall name cols tables
550+ . IsSymbol name
551+ => Row.Cons name cols () tables
552+ => Proxy (Table name cols)
553+ -> Q tables () () ()
554+from _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
555+
556+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
557+-- Builder: selectAll
558+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
559+
560+selectAll
561+ :: forall tables name cols result r p stage stage'
562+ . SingleTable tables name cols
563+ => StripColumns cols result
564+ => Row.Lacks "select" stage
565+ => Row.Lacks "insert" stage
566+ => Row.Lacks "set" stage
567+ => Row.Lacks "delete" stage
568+ => Row.Lacks "where" stage
569+ => Row.Lacks "orderBy" stage
570+ => Row.Lacks "limit" stage
571+ => Row.Cons "select" Unit stage stage'
572+ => Q tables r p stage
573+ -> Q tables result p stage'
574+selectAll (Q q) = Q (q { sql = "SELECT * FROM " <> q.sql })
575+
576+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
577+-- Builder: delete
578+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
579+
580+delete
581+ :: forall tables name cols r p stage stage'
582+ . SingleTable tables name cols
583+ => IsSymbol name
584+ => Row.Lacks "select" stage
585+ => Row.Lacks "insert" stage
586+ => Row.Lacks "set" stage
587+ => Row.Lacks "delete" stage
588+ => Row.Cons "delete" Unit stage stage'
589+ => Q tables r p stage
590+ -> Q tables () () stage'
591+delete (Q _) = Q { sql: "DELETE FROM " <> reflectSymbol (Proxy :: Proxy name), values: [] }
592+
593+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
594+-- Builder SetClauseRL (for builder pattern — uses bare ?)
595+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
596+
597+class BuilderSetClauseRL :: RL.RowList Type -> Constraint
598+class BuilderSetClauseRL rl where
599+ builderSetClauseRL :: Proxy rl -> Array String
600+
601+instance BuilderSetClauseRL RL.Nil where
602+ builderSetClauseRL _ = []
603+
604+instance (IsSymbol name, BuilderSetClauseRL tail) => BuilderSetClauseRL (RL.Cons name typ tail) where
605+ builderSetClauseRL _ =
606+ [ reflectSymbol (Proxy :: Proxy name) <> " = ?" ]
607+ <> builderSetClauseRL (Proxy :: Proxy tail)
608+
609+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
610+-- Builder: insert
611+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
612+
613+insert
614+ :: forall tables name cols userRow userRowRL stage stage'
615+ . SingleTable tables name cols
616+ => RowToList userRow userRowRL
617+ => ColumnNamesRL userRowRL
618+ => RecordValuesRL userRowRL userRow
619+ => IsSymbol name
620+ => Row.Lacks "select" stage
621+ => Row.Lacks "insert" stage
622+ => Row.Lacks "set" stage
623+ => Row.Lacks "delete" stage
624+ => Row.Cons "insert" Unit stage stage'
625+ => { | userRow }
626+ -> Q tables () () stage
627+ -> Q tables () () stage'
628+insert rec (Q _) = Q { sql, values }
629+ where
630+ tableName = reflectSymbol (Proxy :: Proxy name)
631+ colNames = columnNamesRL (Proxy :: Proxy userRowRL)
632+ placeholders = map (const "?") colNames
633+ sql = "INSERT INTO " <> tableName
634+ <> " (" <> intercalate ", " colNames <> ")"
635+ <> " VALUES (" <> intercalate ", " placeholders <> ")"
636+ values = recordValuesRL (Proxy :: Proxy userRowRL) rec
637+
638+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
639+-- Builder: set (UPDATE)
640+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
641+
642+set
643+ :: forall tables name cols setRow setRL stage stage'
644+ . SingleTable tables name cols
645+ => RowToList setRow setRL
646+ => IsSymbol name
647+ => ValidateSetColumnsRL setRL cols
648+ => BuilderSetClauseRL setRL
649+ => RecordValuesRL setRL setRow
650+ => Row.Lacks "select" stage
651+ => Row.Lacks "insert" stage
652+ => Row.Lacks "set" stage
653+ => Row.Lacks "delete" stage
654+ => Row.Cons "set" Unit stage stage'
655+ => { | setRow }
656+ -> Q tables () () stage
657+ -> Q tables () () stage'
658+set rec (Q q) = Q { sql, values }
659+ where
660+ setClauses = builderSetClauseRL (Proxy :: Proxy setRL)
661+ sql = "UPDATE " <> q.sql <> " SET " <> intercalate ", " setClauses
662+ values = recordValuesRL (Proxy :: Proxy setRL) rec
663+
664+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
665+-- ParseWhere: extract $paramName tokens from WHERE clause
666+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
667+
668+class ParseWhere :: Symbol -> Row (Row Type) -> Row Type -> Constraint
669+class ParseWhere sym tables params | sym tables -> params
670+
671+instance
672+ ( Symbol.Cons h t sym
673+ , ParseWhereGo h t tables RL.Nil outRL
674+ , ListToRow outRL params
675+ ) =>
676+ ParseWhere sym tables params
677+
678+class ParseWhereGo :: Symbol -> Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
679+class ParseWhereGo head tail tables paramsIn paramsOut | head tail tables paramsIn -> paramsOut
680+
681+-- When we see $, collect the param name and resolve its type
682+instance
683+ ( CollectParamName rest "" paramName restAfter
684+ , SingleTable tables tableName cols
685+ , RowToList cols colsRL
686+ , ResolveParamType paramName colsRL typ
687+ , EndOrContinue restAfter tables (RL.Cons paramName typ paramsIn) paramsOut
688+ ) =>
689+ ParseWhereGo "$" rest tables paramsIn paramsOut
690+
691+-- End of string: done
692+else instance ParseWhereGo h "" tables paramsIn paramsIn
693+
694+-- Default: skip regular characters and continue
695+else instance
696+ ( Symbol.Cons h2 t2 rest
697+ , ParseWhereGo h2 t2 tables paramsIn paramsOut
698+ ) =>
699+ ParseWhereGo h rest tables paramsIn paramsOut
700+
701+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
702+-- CollectParamName: accumulate identifier chars after $
703+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
704+
705+class CollectParamName :: Symbol -> Symbol -> Symbol -> Symbol -> Constraint
706+class CollectParamName input acc name rest | input acc -> name rest
707+
708+instance CollectParamName "" acc acc ""
709+else instance
710+ ( Symbol.Cons h t input
711+ , CollectParamNameChar h t acc name rest
712+ ) =>
713+ CollectParamName input acc name rest
714+
715+class CollectParamNameChar :: Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> Constraint
716+class CollectParamNameChar char tail acc name rest | char tail acc -> name rest
717+
718+instance
719+ ( Symbol.Cons " " tail rest
720+ ) =>
721+ CollectParamNameChar " " tail acc acc rest
722+
723+else instance
724+ ( Symbol.Cons ")" tail rest
725+ ) =>
726+ CollectParamNameChar ")" tail acc acc rest
727+
728+else instance
729+ ( Symbol.Cons "," tail rest
730+ ) =>
731+ CollectParamNameChar "," tail acc acc rest
732+
733+else instance
734+ ( Symbol.Append acc char acc'
735+ , CollectParamName tail acc' name rest
736+ ) =>
737+ CollectParamNameChar char tail acc name rest
738+
739+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
740+-- EndOrContinue: handle end-of-string or continue parsing
741+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
742+
743+class EndOrContinue :: Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
744+class EndOrContinue rest tables paramsIn paramsOut | rest tables paramsIn -> paramsOut
745+
746+instance EndOrContinue "" tables paramsIn paramsIn
747+else instance
748+ ( Symbol.Cons h t rest
749+ , ParseWhereGo h t tables paramsIn paramsOut
750+ ) =>
751+ EndOrContinue rest tables paramsIn paramsOut
752+
753+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
754+-- ResolveParamType: look up a param name in table columns
755+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
756+
757+class ResolveParamType :: Symbol -> RL.RowList Type -> Type -> Constraint
758+class ResolveParamType name rl typ | name rl -> typ
759+
760+instance Fail (Text "Column not found in table") => ResolveParamType name RL.Nil typ
761+else instance (ExtractType entry typ) => ResolveParamType name (RL.Cons name entry tail) typ
762+else instance ResolveParamType name tail typ => ResolveParamType name (RL.Cons other entry tail) typ
763+
764+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
765+-- Builder: where_
766+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
767+
768+where_
769+ :: forall @whr tables result params p stage stage'
770+ . IsSymbol whr
771+ => ParseWhere whr tables params
772+ => HasAnyDML stage
773+ => Row.Lacks "where" stage
774+ => Row.Lacks "insert" stage
775+ => Row.Lacks "orderBy" stage
776+ => Row.Lacks "limit" stage
777+ => Row.Cons "where" Unit stage stage'
778+ => Q tables result p stage
779+ -> Q tables result params stage'
780+where_ (Q q) = Q (q { sql = q.sql <> " WHERE " <> reflectSymbol (Proxy :: Proxy whr) })
781+
782+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
783+-- Builder: orderBy
784+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
785+
786+orderBy
787+ :: forall @cols tables result params stage stage'
788+ . IsSymbol cols
789+ => HasClause "select" stage
790+ => Row.Lacks "orderBy" stage
791+ => Row.Lacks "limit" stage
792+ => Row.Cons "orderBy" Unit stage stage'
793+ => Q tables result params stage
794+ -> Q tables result params stage'
795+orderBy (Q q) = Q (q { sql = q.sql <> " ORDER BY " <> reflectSymbol (Proxy :: Proxy cols) })
796+
797+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
798+-- ParseLimitOffset: accept numeric literal or $paramName
799+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
800+
801+class ParseLimitOffset :: Symbol -> Row Type -> Row Type -> Constraint
802+class ParseLimitOffset sym paramsIn paramsOut | sym paramsIn -> paramsOut
803+
804+instance
805+ ( Symbol.Cons h t sym
806+ , ParseLimitOffsetChar h t paramsIn paramsOut
807+ ) =>
808+ ParseLimitOffset sym paramsIn paramsOut
809+
810+class ParseLimitOffsetChar :: Symbol -> Symbol -> Row Type -> Row Type -> Constraint
811+class ParseLimitOffsetChar head tail paramsIn paramsOut | head tail paramsIn -> paramsOut
812+
813+instance
814+ ( Symbol.Append "" tail paramName
815+ , Row.Cons paramName Int paramsIn paramsOut
816+ ) =>
817+ ParseLimitOffsetChar "$" tail paramsIn paramsOut
818+
819+else instance ParseLimitOffsetChar h tail paramsIn paramsIn
820+
821+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
822+-- Builder: limit
823+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
824+
825+limit
826+ :: forall @sym tables result params params' stage stage'
827+ . ParseLimitOffset sym params params'
828+ => IsSymbol sym
829+ => HasClause "select" stage
830+ => Row.Lacks "limit" stage
831+ => Row.Cons "limit" Unit stage stage'
832+ => Q tables result params stage
833+ -> Q tables result params' stage'
834+limit (Q q) = Q (q { sql = q.sql <> " LIMIT " <> reflectSymbol (Proxy :: Proxy sym) })
835+
836+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
837+-- CQL-specific: ifNotExists (after INSERT)
838+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
839+
840+ifNotExists
841+ :: forall tables result params stage stage'
842+ . HasClause "insert" stage
843+ => Row.Lacks "ifNotExists" stage
844+ => Row.Cons "ifNotExists" Unit stage stage'
845+ => Q tables result params stage
846+ -> Q tables result params stage'
847+ifNotExists (Q q) = Q (q { sql = q.sql <> " IF NOT EXISTS" })
848+
849+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
850+-- CQL-specific: ifExists (after UPDATE/DELETE WHERE)
851+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
852+
853+ifExists
854+ :: forall tables result params stage stage'
855+ . HasClause "where" stage
856+ => Row.Lacks "ifExists" stage
857+ => Row.Cons "ifExists" Unit stage stage'
858+ => Q tables result params stage
859+ -> Q tables result params stage'
860+ifExists (Q q) = Q (q { sql = q.sql <> " IF EXISTS" })
861+
862+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
863+-- CQL-specific: usingTTL (after INSERT)
864+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
865+
866+usingTTL
867+ :: forall @ttl tables result params stage stage'
868+ . IsSymbol ttl
869+ => HasClause "insert" stage
870+ => Row.Lacks "usingTTL" stage
871+ => Row.Cons "usingTTL" Unit stage stage'
872+ => Q tables result params stage
873+ -> Q tables result params stage'
874+usingTTL (Q q) = Q (q { sql = q.sql <> " USING TTL " <> reflectSymbol (Proxy :: Proxy ttl) })
875+
876+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
877+-- CQL-specific: withTTL (before set, produces UPDATE t USING TTL n)
878+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
879+
880+withTTL
881+ :: forall @ttl tables result params stage stage'
882+ . IsSymbol ttl
883+ => Row.Lacks "set" stage
884+ => Row.Lacks "select" stage
885+ => Row.Lacks "insert" stage
886+ => Row.Lacks "delete" stage
887+ => Row.Lacks "withTTL" stage
888+ => Row.Cons "withTTL" Unit stage stage'
889+ => Q tables result params stage
890+ -> Q tables result params stage'
891+withTTL (Q q) = Q (q { sql = q.sql <> " USING TTL " <> reflectSymbol (Proxy :: Proxy ttl) })
892+
893+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
894+-- CQL-specific: allowFiltering (after SELECT WHERE)
895+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
896+
897+allowFiltering
898+ :: forall tables result params stage stage'
899+ . HasClause "select" stage
900+ => Row.Lacks "allowFiltering" stage
901+ => Row.Cons "allowFiltering" Unit stage stage'
902+ => Q tables result params stage
903+ -> Q tables result params stage'
904+allowFiltering (Q q) = Q (q { sql = q.sql <> " ALLOW FILTERING" })
905+
906+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
907+-- ParseSelect: parse "col1, col2" into a result row
908+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
909+
910+class ParseSelect :: Symbol -> Row (Row Type) -> Row Type -> Constraint
911+class ParseSelect sym tables result | sym tables -> result
912+
913+instance ParseSelect "" tables ()
914+else instance
915+ ( Symbol.Cons h t sym
916+ , ParseSelectGo h t "" tables RL.Nil outRL
917+ , ListToRow outRL result
918+ ) =>
919+ ParseSelect sym tables result
920+
921+class ParseSelectGo :: Symbol -> Symbol -> Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
922+class ParseSelectGo head tail acc tables resultIn resultOut | head tail acc tables resultIn -> resultOut
923+
924+-- Comma with accumulated column name: flush column and continue
925+instance
926+ ( SingleTable tables tableName cols
927+ , RowToList cols colsRL
928+ , ResolveParamType acc colsRL typ
929+ , Symbol.Cons h2 t2 rest
930+ , SkipSpaces h2 t2 h3 t3
931+ , ParseSelectGo h3 t3 "" tables (RL.Cons acc typ resultIn) resultOut
932+ ) =>
933+ ParseSelectGo "," rest acc tables resultIn resultOut
934+
935+-- Space: skip and continue accumulating
936+else instance
937+ ( Symbol.Cons h2 t2 rest
938+ , ParseSelectGo h2 t2 acc tables resultIn resultOut
939+ ) =>
940+ ParseSelectGo " " rest acc tables resultIn resultOut
941+
942+-- End of string: flush final column
943+else instance
944+ ( Symbol.Append acc h acc'
945+ , SingleTable tables tableName cols
946+ , RowToList cols colsRL
947+ , ResolveParamType acc' colsRL typ
948+ ) =>
949+ ParseSelectGo h "" acc tables resultIn (RL.Cons acc' typ resultIn)
950+
951+-- Regular character with more input: accumulate
952+else instance
953+ ( Symbol.Append acc h acc'
954+ , Symbol.Cons h2 t2 rest
955+ , ParseSelectGo h2 t2 acc' tables resultIn resultOut
956+ ) =>
957+ ParseSelectGo h rest acc tables resultIn resultOut
958+
959+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
960+-- SkipSpaces: skip leading spaces
961+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
962+
963+class SkipSpaces :: Symbol -> Symbol -> Symbol -> Symbol -> Constraint
964+class SkipSpaces head tail outHead outTail | head tail -> outHead outTail
965+
966+instance (Symbol.Cons h2 t2 rest, SkipSpaces h2 t2 outHead outTail) => SkipSpaces " " rest outHead outTail
967+else instance SkipSpaces h t h t
968+
969+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
970+-- Builder: select @"col1, col2"
971+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
972+
973+select
974+ :: forall @sel tables result r p stage stage'
975+ . IsSymbol sel
976+ => ParseSelect sel tables result
977+ => Row.Lacks "select" stage
978+ => Row.Lacks "insert" stage
979+ => Row.Lacks "set" stage
980+ => Row.Lacks "delete" stage
981+ => Row.Lacks "where" stage
982+ => Row.Lacks "orderBy" stage
983+ => Row.Lacks "limit" stage
984+ => Row.Cons "select" Unit stage stage'
985+ => Q tables r p stage
986+ -> Q tables result p stage'
987+select (Q q) = Q (q { sql = "SELECT " <> reflectSymbol (Proxy :: Proxy sel) <> " FROM " <> q.sql })
988+
989+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
990+-- ParamsToArray: convert params record to Array { name, value }
991+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
992+
993+class ParamsToArray :: RL.RowList Type -> Row Type -> Constraint
994+class ParamsToArray rl row where
995+ paramsToArray :: Proxy rl -> { | row } -> Array { name :: String, value :: Foreign }
996+
997+instance ParamsToArray RL.Nil row where
998+ paramsToArray _ _ = []
999+
1000+instance
1001+ ( IsSymbol name
1002+ , Row.Cons name typ rest row
1003+ , Row.Lacks name rest
1004+ , ParamsToArray tail row
1005+ ) =>
1006+ ParamsToArray (RL.Cons name typ tail) row where
1007+ paramsToArray _ rec =
1008+ [ { name: reflectSymbol (Proxy :: Proxy name)
1009+ , value: unsafeToForeign (Record.get (Proxy :: Proxy name) rec)
1010+ }
1011+ ]
1012+ <> paramsToArray (Proxy :: Proxy tail) rec
1013+
1014+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1015+-- replaceNamedParams: replace $name with ? and build values array
1016+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1017+
1018+namedParamRegex :: Regex.Regex
1019+namedParamRegex = case Regex.regex "\\$[a-zA-Z_][a-zA-Z0-9_]*" RegexFlags.global of
1020+ Right r -> r
1021+ Left _ -> unsafeCoerce unit
1022+
1023+replaceNamedParams :: Array { name :: String, value :: Foreign } -> String -> { sql :: String, values :: Array Foreign }
1024+replaceNamedParams entries sql = do
1025+ let replacements = entries # foldl (\m e -> Map.insert ("$" <> e.name) "?" m) Map.empty
1026+ let
1027+ sql' = Regex.replace' namedParamRegex
1028+ ( \match_ _ -> case Map.lookup match_ replacements of
1029+ Nothing -> match_
1030+ Just v -> v
1031+ )
1032+ sql
1033+ { sql: sql', values: map (\e -> e.value) entries }
1034+
1035+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1036+-- Query execution
1037+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1038+
1039+decodeRows :: forall a. ReadForeign a => Array Foreign -> Either String (Array a)
1040+decodeRows rows = case traverse (\r -> readImpl r # runExcept) rows of
1041+ Left errs -> Left (show errs)
1042+ Right a -> Right a
1043+
1044+runQuery
1045+ :: forall tables result params paramsRL stage
1046+ . RowToList params paramsRL
1047+ => ParamsToArray paramsRL params
1048+ => ReadForeign { | result }
1049+ => Scylla.Client
1050+ -> { | params }
1051+ -> Q tables result params stage
1052+ -> Aff (Array { | result })
1053+runQuery client params (Q q) = do
1054+ let entries = paramsToArray (Proxy :: Proxy paramsRL) params
1055+ let { sql, values } = replaceNamedParams entries q.sql
1056+ let allValues = q.values <> values
1057+ result <- Scylla.execute (Scylla.CQL sql) allValues client
1058+ case decodeRows result.rows of
1059+ Left errs -> throwError (Exception.error ("Row decode failed: " <> errs))
1060+ Right rows -> pure rows
1061+
1062+runQueryOne
1063+ :: forall tables result params paramsRL stage
1064+ . RowToList params paramsRL
1065+ => ParamsToArray paramsRL params
1066+ => ReadForeign { | result }
1067+ => Scylla.Client
1068+ -> { | params }
1069+ -> Q tables result params stage
1070+ -> Aff (Maybe { | result })
1071+runQueryOne client params q = do
1072+ rows <- runQuery client params q
1073+ pure case rows of
1074+ [ x ] -> Just x
1075+ _ -> Nothing
1076+
1077+runExecute
1078+ :: forall tables params paramsRL stage
1079+ . RowToList params paramsRL
1080+ => ParamsToArray paramsRL params
1081+ => Scylla.Client
1082+ -> { | params }
1083+ -> Q tables () params stage
1084+ -> Aff Unit
1085+runExecute client params (Q q) = do
1086+ let entries = paramsToArray (Proxy :: Proxy paramsRL) params
1087+ let { sql, values } = replaceNamedParams entries q.sql
1088+ let allValues = q.values <> values
1089+ void $ Scylla.execute (Scylla.CQL sql) allValues client