@@ -0,0 +1,426 @@
1+module Yoga.ScyllaDB.Schema where
2+
3+import Prelude
4+
5+import Data.Array (intercalate)
6+import Data.DateTime (DateTime)
7+import Data.Maybe (Maybe)
8+import Data.Symbol (class IsSymbol, reflectSymbol)
9+import Type.Function (type (#))
10+import Type.Proxy (Proxy(..))
11+import Type.RowList (class ListToRow)
12+import Prim.Boolean (True, False)
13+import Prim.RowList as RL
14+import Prim.RowList (class RowToList)
15+import Yoga.ScyllaDB.ScyllaDB as Scylla
16+
17+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
18+-- Core phantom types
19+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
20+
21+data Table :: Symbol -> Row Type -> Type
22+data Table name columns = Table
23+
24+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
25+-- Constraint wrappers (used with # operator from Type.Function)
26+-- Int # PartitionKey = PartitionKey Int
27+-- Int # ClusteringKey = ClusteringKey Int
28+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
29+
30+data PartitionKey :: Type -> Type
31+data PartitionKey a
32+
33+data ClusteringKey :: Type -> Type
34+data ClusteringKey a
35+
36+data Static :: Type -> Type
37+data Static a
38+
39+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
40+-- Nullability: inferred from Maybe
41+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
42+
43+class IsNullable a where
44+ isNullable :: Proxy a -> Boolean
45+
46+instance IsNullable (Maybe a) where
47+ isNullable _ = true
48+else instance IsNullable a where
49+ isNullable _ = false
50+
51+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
52+-- ExtractType: recursively unwrap constraint wrappers to get base type
53+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
54+
55+class ExtractType :: Type -> Type -> Constraint
56+class ExtractType wrapped typ | wrapped -> typ
57+
58+instance ExtractType a typ => ExtractType (PartitionKey a) typ
59+else instance ExtractType a typ => ExtractType (ClusteringKey a) typ
60+else instance ExtractType a typ => ExtractType (Static a) typ
61+else instance ExtractType a a
62+
63+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
64+-- PureScript type -> CQL type name
65+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
66+
67+class CQLTypeName a where
68+ cqlTypeName :: Proxy a -> String
69+
70+instance CQLTypeName Int where
71+ cqlTypeName _ = "int"
72+
73+instance CQLTypeName String where
74+ cqlTypeName _ = "text"
75+
76+instance CQLTypeName Boolean where
77+ cqlTypeName _ = "boolean"
78+
79+instance CQLTypeName Number where
80+ cqlTypeName _ = "double"
81+
82+instance CQLTypeName DateTime where
83+ cqlTypeName _ = "timestamp"
84+
85+instance CQLTypeName Scylla.UUID where
86+ cqlTypeName _ = "uuid"
87+
88+instance CQLTypeName a => CQLTypeName (Maybe a) where
89+ cqlTypeName _ = cqlTypeName (Proxy :: Proxy a)
90+
91+instance CQLTypeName a => CQLTypeName (Array a) where
92+ cqlTypeName _ = "list<" <> cqlTypeName (Proxy :: Proxy a) <> ">"
93+
94+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
95+-- Constraint rendering (STATIC only — PK/CK handled in PRIMARY KEY clause)
96+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
97+
98+class RenderConstraint a where
99+ renderConstraint :: Proxy a -> String
100+
101+instance RenderConstraint a => RenderConstraint (PartitionKey a) where
102+ renderConstraint _ = renderConstraint (Proxy :: Proxy a)
103+
104+else instance RenderConstraint a => RenderConstraint (ClusteringKey a) where
105+ renderConstraint _ = renderConstraint (Proxy :: Proxy a)
106+
107+else instance RenderConstraint a => RenderConstraint (Static a) where
108+ renderConstraint _ = joinConstraints "STATIC" (renderConstraint (Proxy :: Proxy a))
109+
110+else instance RenderConstraint a where
111+ renderConstraint _ = ""
112+
113+joinConstraints :: String -> String -> String
114+joinConstraints a b = case a, b of
115+ "", s -> s
116+ s, "" -> s
117+ s1, s2 -> s1 <> " " <> s2
118+
119+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
120+-- Primary key detection
121+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
122+
123+class IsPartitionKey a where
124+ isPartitionKey :: Proxy a -> Boolean
125+
126+instance IsPartitionKey (PartitionKey a) where
127+ isPartitionKey _ = true
128+else instance IsPartitionKey a => IsPartitionKey (Static a) where
129+ isPartitionKey _ = isPartitionKey (Proxy :: Proxy a)
130+else instance IsPartitionKey a where
131+ isPartitionKey _ = false
132+
133+class IsClusteringKey a where
134+ isClusteringKey :: Proxy a -> Boolean
135+
136+instance IsClusteringKey (ClusteringKey a) where
137+ isClusteringKey _ = true
138+else instance IsClusteringKey a => IsClusteringKey (Static a) where
139+ isClusteringKey _ = isClusteringKey (Proxy :: Proxy a)
140+else instance IsClusteringKey a where
141+ isClusteringKey _ = false
142+
143+class IsKeyColumn a where
144+ isKeyColumn :: Proxy a -> Boolean
145+
146+instance IsKeyColumn (PartitionKey a) where
147+ isKeyColumn _ = true
148+else instance IsKeyColumn (ClusteringKey a) where
149+ isKeyColumn _ = true
150+else instance IsKeyColumn a where
151+ isKeyColumn _ = false
152+
153+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
154+-- DDL generation: column definitions
155+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
156+
157+class RenderColumnsRL :: RL.RowList Type -> Constraint
158+class RenderColumnsRL rl where
159+ renderColumnsRL :: Proxy rl -> Array String
160+
161+instance RenderColumnsRL RL.Nil where
162+ renderColumnsRL _ = []
163+
164+instance
165+ ( IsSymbol name
166+ , ExtractType entry typ
167+ , CQLTypeName typ
168+ , RenderConstraint entry
169+ , RenderColumnsRL tail
170+ ) =>
171+ RenderColumnsRL (RL.Cons name entry tail) where
172+ renderColumnsRL _ = do
173+ let colName = reflectSymbol (Proxy :: Proxy name)
174+ let colType = cqlTypeName (Proxy :: Proxy typ)
175+ let constraints = renderConstraint (Proxy :: Proxy entry)
176+ let constraintsSuffix = if constraints == "" then "" else " " <> constraints
177+ [ colName <> " " <> colType <> constraintsSuffix ] <> renderColumnsRL (Proxy :: Proxy tail)
178+
179+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
180+-- DDL generation: PRIMARY KEY clause
181+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
182+
183+class PartitionKeysRL :: RL.RowList Type -> Constraint
184+class PartitionKeysRL rl where
185+ partitionKeysRL :: Proxy rl -> Array String
186+
187+instance PartitionKeysRL RL.Nil where
188+ partitionKeysRL _ = []
189+
190+instance
191+ ( IsSymbol name
192+ , IsPartitionKey entry
193+ , PartitionKeysRL tail
194+ ) =>
195+ PartitionKeysRL (RL.Cons name entry tail) where
196+ partitionKeysRL _ =
197+ let rest = partitionKeysRL (Proxy :: Proxy tail)
198+ in
199+ if isPartitionKey (Proxy :: Proxy entry) then [ reflectSymbol (Proxy :: Proxy name) ] <> rest
200+ else rest
201+
202+class ClusteringKeysRL :: RL.RowList Type -> Constraint
203+class ClusteringKeysRL rl where
204+ clusteringKeysRL :: Proxy rl -> Array String
205+
206+instance ClusteringKeysRL RL.Nil where
207+ clusteringKeysRL _ = []
208+
209+instance
210+ ( IsSymbol name
211+ , IsClusteringKey entry
212+ , ClusteringKeysRL tail
213+ ) =>
214+ ClusteringKeysRL (RL.Cons name entry tail) where
215+ clusteringKeysRL _ =
216+ let rest = clusteringKeysRL (Proxy :: Proxy tail)
217+ in
218+ if isClusteringKey (Proxy :: Proxy entry) then [ reflectSymbol (Proxy :: Proxy name) ] <> rest
219+ else rest
220+
221+renderPrimaryKey :: Array String -> Array String -> String
222+renderPrimaryKey partitionKeys clusteringKeys = case partitionKeys, clusteringKeys of
223+ [], [] -> ""
224+ pks, [] -> "PRIMARY KEY ((" <> intercalate ", " pks <> "))"
225+ pks, cks -> "PRIMARY KEY ((" <> intercalate ", " pks <> "), " <> intercalate ", " cks <> ")"
226+
227+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
228+-- CREATE TABLE
229+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
230+
231+class CreateTableDDL a where
232+ createTableDDL :: String
233+
234+instance
235+ ( IsSymbol name
236+ , RowToList cols rl
237+ , RenderColumnsRL rl
238+ , PartitionKeysRL rl
239+ , ClusteringKeysRL rl
240+ ) =>
241+ CreateTableDDL (Table name cols) where
242+ createTableDDL = do
243+ let tableName = reflectSymbol (Proxy :: Proxy name)
244+ let columns = renderColumnsRL (Proxy :: Proxy rl)
245+ let pks = partitionKeysRL (Proxy :: Proxy rl)
246+ let cks = clusteringKeysRL (Proxy :: Proxy rl)
247+ let pkClause = renderPrimaryKey pks cks
248+ let allParts = columns <> (if pkClause == "" then [] else [pkClause])
249+ "CREATE TABLE IF NOT EXISTS " <> tableName <> " (" <> intercalate ", " allParts <> ")"
250+
251+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
252+-- INSERT SQL generation
253+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
254+
255+class InsertColumnsRL :: RL.RowList Type -> Constraint
256+class InsertColumnsRL rl where
257+ insertColumnsRL :: Proxy rl -> Array String
258+
259+instance InsertColumnsRL RL.Nil where
260+ insertColumnsRL _ = []
261+
262+instance
263+ ( IsSymbol name
264+ , InsertColumnsRL tail
265+ ) =>
266+ InsertColumnsRL (RL.Cons name entry tail) where
267+ insertColumnsRL _ =
268+ [ reflectSymbol (Proxy :: Proxy name) ] <> insertColumnsRL (Proxy :: Proxy tail)
269+
270+class InsertSQLFor a where
271+ insertSQLFor :: String
272+
273+instance
274+ ( IsSymbol name
275+ , RowToList cols rl
276+ , InsertColumnsRL rl
277+ ) =>
278+ InsertSQLFor (Table name cols) where
279+ insertSQLFor = do
280+ let tableName = reflectSymbol (Proxy :: Proxy name)
281+ let cols = insertColumnsRL (Proxy :: Proxy rl)
282+ let placeholders = map (const "?") cols
283+ "INSERT INTO " <> tableName
284+ <> " (" <> intercalate ", " cols <> ")"
285+ <> " VALUES (" <> intercalate ", " placeholders <> ")"
286+
287+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
288+-- SELECT SQL generation
289+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
290+
291+class SelectAllSQLFor a where
292+ selectAllSQLFor :: String
293+
294+instance
295+ ( IsSymbol name
296+ ) =>
297+ SelectAllSQLFor (Table name cols) where
298+ selectAllSQLFor = "SELECT * FROM " <> reflectSymbol (Proxy :: Proxy name)
299+
300+class WhereClauseRL :: RL.RowList Type -> Constraint
301+class WhereClauseRL rl where
302+ whereClauseRL :: Proxy rl -> Array String
303+
304+instance WhereClauseRL RL.Nil where
305+ whereClauseRL _ = []
306+
307+instance (IsSymbol name, WhereClauseRL tail) => WhereClauseRL (RL.Cons name typ tail) where
308+ whereClauseRL _ =
309+ [ reflectSymbol (Proxy :: Proxy name) <> " = ?" ]
310+ <> whereClauseRL (Proxy :: Proxy tail)
311+
312+class SelectWhereSQLFor a whereRow where
313+ selectWhereSQLFor :: String
314+
315+instance
316+ ( IsSymbol name
317+ , RowToList whereRow whereRL
318+ , WhereClauseRL whereRL
319+ ) =>
320+ SelectWhereSQLFor (Table name cols) whereRow where
321+ selectWhereSQLFor = do
322+ let tableName = reflectSymbol (Proxy :: Proxy name)
323+ let conditions = whereClauseRL (Proxy :: Proxy whereRL)
324+ "SELECT * FROM " <> tableName <> " WHERE " <> intercalate " AND " conditions
325+
326+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
327+-- UPDATE SQL generation
328+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
329+
330+class ColumnCountRL :: RL.RowList Type -> Constraint
331+class ColumnCountRL rl where
332+ columnCountRL :: Proxy rl -> Int
333+
334+instance ColumnCountRL RL.Nil where
335+ columnCountRL _ = 0
336+
337+instance ColumnCountRL tail => ColumnCountRL (RL.Cons name typ tail) where
338+ columnCountRL _ = 1 + columnCountRL (Proxy :: Proxy tail)
339+
340+class SetClauseRL :: RL.RowList Type -> Constraint
341+class SetClauseRL rl where
342+ setClauseRL :: Proxy rl -> Array String
343+
344+instance SetClauseRL RL.Nil where
345+ setClauseRL _ = []
346+
347+instance (IsSymbol name, SetClauseRL tail) => SetClauseRL (RL.Cons name typ tail) where
348+ setClauseRL _ =
349+ [ reflectSymbol (Proxy :: Proxy name) <> " = ?" ]
350+ <> setClauseRL (Proxy :: Proxy tail)
351+
352+class UpdateSQLFor table setRow whereRow where
353+ updateSQLFor :: String
354+
355+instance
356+ ( IsSymbol name
357+ , RowToList setRow setRL
358+ , RowToList whereRow whereRL
359+ , SetClauseRL setRL
360+ , WhereClauseRL whereRL
361+ ) =>
362+ UpdateSQLFor (Table name cols) setRow whereRow where
363+ updateSQLFor = do
364+ let tableName = reflectSymbol (Proxy :: Proxy name)
365+ let setClauses = setClauseRL (Proxy :: Proxy setRL)
366+ let whereClauses = whereClauseRL (Proxy :: Proxy whereRL)
367+ "UPDATE " <> tableName
368+ <> " SET " <> intercalate ", " setClauses
369+ <> " WHERE " <> intercalate " AND " whereClauses
370+
371+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
372+-- DELETE SQL generation
373+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
374+
375+class DeleteSQLFor table whereRow where
376+ deleteSQLFor :: String
377+
378+instance
379+ ( IsSymbol name
380+ , RowToList whereRow whereRL
381+ , WhereClauseRL whereRL
382+ ) =>
383+ DeleteSQLFor (Table name cols) whereRow where
384+ deleteSQLFor = do
385+ let tableName = reflectSymbol (Proxy :: Proxy name)
386+ let conditions = whereClauseRL (Proxy :: Proxy whereRL)
387+ "DELETE FROM " <> tableName <> " WHERE " <> intercalate " AND " conditions
388+
389+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
390+-- StripColumns: (name :: String # PartitionKey, ...) -> (name :: String, ...)
391+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
392+
393+class StripColumnsRL :: RL.RowList Type -> RL.RowList Type -> Constraint
394+class StripColumnsRL rl out | rl -> out
395+
396+instance StripColumnsRL RL.Nil RL.Nil
397+instance (ExtractType entry typ, StripColumnsRL tail out') => StripColumnsRL (RL.Cons name entry tail) (RL.Cons name typ out')
398+
399+class StripColumns :: Row Type -> Row Type -> Constraint
400+class StripColumns cols result | cols -> result
401+
402+instance (RowToList cols rl, StripColumnsRL rl outRL, ListToRow outRL result) => StripColumns cols result
403+
404+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
405+-- InsertNonKeyColumnsRL: columns that are NOT part of the primary key
406+-- (useful for building insert params excluding auto-generated key columns)
407+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
408+
409+class NonKeyColumnsRL :: RL.RowList Type -> Constraint
410+class NonKeyColumnsRL rl where
411+ nonKeyColumnsRL :: Proxy rl -> Array String
412+
413+instance NonKeyColumnsRL RL.Nil where
414+ nonKeyColumnsRL _ = []
415+
416+instance
417+ ( IsSymbol name
418+ , IsKeyColumn entry
419+ , NonKeyColumnsRL tail
420+ ) =>
421+ NonKeyColumnsRL (RL.Cons name entry tail) where
422+ nonKeyColumnsRL _ =
423+ let rest = nonKeyColumnsRL (Proxy :: Proxy tail)
424+ in
425+ if isKeyColumn (Proxy :: Proxy entry) then rest
426+ else [ reflectSymbol (Proxy :: Proxy name) ] <> rest