@@ -1,411 +0,0 @@
1−module Yoga.Postgres.Client where
2−
3−import Prelude
4−
5−import Data.Array (intercalate, mapWithIndex)
6−import Data.Maybe (Maybe)
7−import Data.Symbol (class IsSymbol, reflectSymbol)
8−import Effect.Aff (Aff)
9−import Prim.Boolean (True, False)
10−import Prim.Row (class Cons, class Lacks, class Union) as Row
11−import Prim.RowList as RL
12−import Prim.RowList (class RowToList)
13−import Prim.TypeError (class Fail, Text)
14−import Type.Proxy (Proxy(..))
15−import Type.RowList (class ListToRow)
16−import Yoga.JSON (class ReadForeign)
17−import Yoga.Postgres as PG
18−import Yoga.Postgres.Schema
19− ( class ColumnCountRL, class ColumnNamesRL, class ExtractType
20− , class FieldToPGValue, class InsertableColumnsRL, class RecordValuesRL
21− , class RequiredColumnsRL, class SetClauseRL, class StripColumnsRL
22− , class ValidateSetColumnsRL
23− , Table, PrimaryKey, AutoIncrement, Unique, Default
24− , ForeignKey, References, Nullable
25− , columnCountRL, columnNamesRL, fieldToPGValue, recordValuesRL, setClauseRL
26− , unsafeDecodeRow, unsafeDecodeRows
27− )
28−
29−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
30−-- Type extraction from tables
31−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
32−
33−class TableRow :: Type -> Row Type -> Constraint
34−class TableRow table row | table -> row
35−
36−instance
37− ( RowToList cols rl
38− , StripColumnsRL rl outRL
39− , ListToRow outRL row
40− ) =>
41− TableRow (Table name cols) row
42−
43−class InsertableRow :: Type -> Row Type -> Constraint
44−class InsertableRow table row | table -> row
45−
46−instance
47− ( RowToList cols rl
48− , InsertableColumnsRL rl insertRL
49− , ListToRow insertRL row
50− ) =>
51− InsertableRow (Table name cols) row
52−
53−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
54−-- Primary key extraction
55−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
56−
57−class HasPrimaryKeyConstraint :: Type -> Boolean -> Constraint
58−class HasPrimaryKeyConstraint a result | a -> result
59−
60−instance HasPrimaryKeyConstraint (PrimaryKey a) True
61−else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (AutoIncrement a) result
62−else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (Unique a) result
63−else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (Default s a) result
64−else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (ForeignKey t r c a) result
65−else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (Nullable a) result
66−else instance HasPrimaryKeyConstraint a False
67−
68−class FindPrimaryKeyRL :: RL.RowList Type -> Symbol -> Type -> Constraint
69−class FindPrimaryKeyRL rl colName colType | rl -> colName colType
70−
71−instance Fail (Text "Table has no primary key column") => FindPrimaryKeyRL RL.Nil "" Unit
72−
73−instance
74− ( HasPrimaryKeyConstraint entry isPK
75− , FindPrimaryKeyDecide isPK name entry tail colName colType
76− ) =>
77− FindPrimaryKeyRL (RL.Cons name entry tail) colName colType
78−
79−class FindPrimaryKeyDecide :: Boolean -> Symbol -> Type -> RL.RowList Type -> Symbol -> Type -> Constraint
80−class FindPrimaryKeyDecide isPK name entry tail colName colType | isPK name entry tail -> colName colType
81−
82−instance ExtractType entry colType => FindPrimaryKeyDecide True name entry tail name colType
83−instance FindPrimaryKeyRL tail colName colType => FindPrimaryKeyDecide False name entry tail colName colType
84−
85−class FindPrimaryKey :: Type -> Symbol -> Type -> Constraint
86−class FindPrimaryKey table colName colType | table -> colName colType
87−
88−instance
89− ( RowToList cols rl
90− , FindPrimaryKeyRL rl colName colType
91− ) =>
92− FindPrimaryKey (Table name cols) colName colType
93−
94−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
95−-- Foreign key detection for auto-joins
96−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
97−
98−class HasForeignKeyTo :: Type -> Symbol -> Boolean -> Constraint
99−class HasForeignKeyTo colType tableName result | colType tableName -> result
100−
101−instance HasForeignKeyTo (ForeignKey table References col a) table True
102−else instance HasForeignKeyTo a tn result => HasForeignKeyTo (PrimaryKey a) tn result
103−else instance HasForeignKeyTo a tn result => HasForeignKeyTo (AutoIncrement a) tn result
104−else instance HasForeignKeyTo a tn result => HasForeignKeyTo (Unique a) tn result
105−else instance HasForeignKeyTo a tn result => HasForeignKeyTo (Default s a) tn result
106−else instance HasForeignKeyTo a tn result => HasForeignKeyTo (Nullable a) tn result
107−else instance HasForeignKeyTo a tn False
108−
109−class ExtractForeignKeyCol :: Type -> Symbol -> Symbol -> Constraint
110−class ExtractForeignKeyCol colType tableName refCol | colType tableName -> refCol
111−
112−instance ExtractForeignKeyCol (ForeignKey table References col a) table col
113−else instance ExtractForeignKeyCol a tn col => ExtractForeignKeyCol (PrimaryKey a) tn col
114−else instance ExtractForeignKeyCol a tn col => ExtractForeignKeyCol (AutoIncrement a) tn col
115−else instance ExtractForeignKeyCol a tn col => ExtractForeignKeyCol (Unique a) tn col
116−else instance ExtractForeignKeyCol a tn col => ExtractForeignKeyCol (Default s a) tn col
117−else instance ExtractForeignKeyCol a tn col => ExtractForeignKeyCol (Nullable a) tn col
118−
119−class FindForeignKeyToRL :: RL.RowList Type -> Symbol -> Symbol -> Symbol -> Constraint
120−class FindForeignKeyToRL childRL parentName localCol parentCol | childRL parentName -> localCol parentCol
121−
122−instance
123− Fail (Text "No foreign key found referencing the target table")
124− => FindForeignKeyToRL RL.Nil parentName "" ""
125−
126−instance
127− ( HasForeignKeyTo entry parentName hasFK
128− , FindForeignKeyToDecide hasFK name entry tail parentName localCol parentCol
129− ) =>
130− FindForeignKeyToRL (RL.Cons name entry tail) parentName localCol parentCol
131−
132−class FindForeignKeyToDecide :: Boolean -> Symbol -> Type -> RL.RowList Type -> Symbol -> Symbol -> Symbol -> Constraint
133−class FindForeignKeyToDecide hasFK name entry tail parentName localCol parentCol
134− | hasFK name entry tail parentName -> localCol parentCol
135−
136−instance
137− ExtractForeignKeyCol entry parentName parentCol
138− => FindForeignKeyToDecide True name entry tail parentName name parentCol
139−
140−instance
141− FindForeignKeyToRL tail parentName localCol parentCol
142− => FindForeignKeyToDecide False name entry tail parentName localCol parentCol
143−
144−class FindForeignKeyTo :: Type -> Symbol -> Symbol -> Symbol -> Constraint
145−class FindForeignKeyTo childTable parentTableName localCol parentCol
146− | childTable parentTableName -> localCol parentCol
147−
148−instance
149− ( RowToList cols rl
150− , FindForeignKeyToRL rl parentName localCol parentCol
151− ) =>
152− FindForeignKeyTo (Table name cols) parentName localCol parentCol
153−
154−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
155−-- CRUD operations
156−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
157−
158−findAll
159− :: forall name cols row
160− . IsSymbol name
161− => TableRow (Table name cols) row
162− => ReadForeign { | row }
163− => Proxy (Table name cols)
164− -> PG.Connection
165− -> Aff (Array { | row })
166−findAll _ conn = do
167− result <- PG.query (PG.SQL sql) [] conn
168− pure (unsafeDecodeRows result.rows)
169− where
170− sql = "SELECT * FROM " <> reflectSymbol (Proxy :: Proxy name)
171−
172−findById
173− :: forall name cols row pkCol pkType
174− . IsSymbol name
175− => IsSymbol pkCol
176− => TableRow (Table name cols) row
177− => FindPrimaryKey (Table name cols) pkCol pkType
178− => FieldToPGValue pkType
179− => ReadForeign { | row }
180− => Proxy (Table name cols)
181− -> PG.Connection
182− -> pkType
183− -> Aff (Maybe { | row })
184−findById _ conn pk = do
185− result <- PG.queryOne (PG.SQL sql) [ fieldToPGValue pk ] conn
186− pure (result <#> unsafeDecodeRow)
187− where
188− sql = "SELECT * FROM " <> reflectSymbol (Proxy :: Proxy name)
189− <> " WHERE " <> reflectSymbol (Proxy :: Proxy pkCol) <> " = $1"
190−
191−create
192− :: forall name cols colsRL insertableRL insertable requiredRL required
193− optionalProvided missing userRow userRowRL row
194− . IsSymbol name
195− => RowToList cols colsRL
196− => InsertableColumnsRL colsRL insertableRL
197− => ListToRow insertableRL insertable
198− => RequiredColumnsRL insertableRL requiredRL
199− => ListToRow requiredRL required
200− => Row.Union required optionalProvided userRow
201− => Row.Union userRow missing insertable
202− => RowToList userRow userRowRL
203− => ColumnNamesRL userRowRL
204− => RecordValuesRL userRowRL userRow
205− => TableRow (Table name cols) row
206− => ReadForeign { | row }
207− => Proxy (Table name cols)
208− -> PG.Connection
209− -> { | userRow }
210− -> Aff (Maybe { | row })
211−create _ conn rec = do
212− result <- PG.queryOne (PG.SQL sql) values conn
213− pure (result <#> unsafeDecodeRow)
214− where
215− colNames = columnNamesRL (Proxy :: Proxy userRowRL)
216− placeholders = colNames # mapWithIndex \i _ -> "$" <> show (i + 1)
217− sql = "INSERT INTO " <> reflectSymbol (Proxy :: Proxy name)
218− <> " (" <> intercalate ", " colNames <> ")"
219− <> " VALUES (" <> intercalate ", " placeholders <> ")"
220− <> " RETURNING *"
221− values = recordValuesRL (Proxy :: Proxy userRowRL) rec
222−
223−updateById
224− :: forall name cols row pkCol pkType setRow setRL
225− . IsSymbol name
226− => IsSymbol pkCol
227− => TableRow (Table name cols) row
228− => FindPrimaryKey (Table name cols) pkCol pkType
229− => RowToList setRow setRL
230− => ValidateSetColumnsRL setRL cols
231− => SetClauseRL setRL
232− => ColumnCountRL setRL
233− => RecordValuesRL setRL setRow
234− => FieldToPGValue pkType
235− => ReadForeign { | row }
236− => Proxy (Table name cols)
237− -> PG.Connection
238− -> pkType
239− -> { | setRow }
240− -> Aff (Maybe { | row })
241−updateById _ conn pk rec = do
242− result <- PG.queryOne (PG.SQL sql) values conn
243− pure (result <#> unsafeDecodeRow)
244− where
245− setClauses = setClauseRL (Proxy :: Proxy setRL) 1
246− setCount = columnCountRL (Proxy :: Proxy setRL)
247− sql = "UPDATE " <> reflectSymbol (Proxy :: Proxy name)
248− <> " SET " <> intercalate ", " setClauses
249− <> " WHERE " <> reflectSymbol (Proxy :: Proxy pkCol) <> " = $" <> show (setCount + 1)
250− <> " RETURNING *"
251− values = recordValuesRL (Proxy :: Proxy setRL) rec <> [ fieldToPGValue pk ]
252−
253−deleteById
254− :: forall name cols pkCol pkType
255− . IsSymbol name
256− => IsSymbol pkCol
257− => FindPrimaryKey (Table name cols) pkCol pkType
258− => FieldToPGValue pkType
259− => Proxy (Table name cols)
260− -> PG.Connection
261− -> pkType
262− -> Aff Int
263−deleteById _ conn pk =
264− PG.execute (PG.SQL sql) [ fieldToPGValue pk ] conn
265− where
266− sql = "DELETE FROM " <> reflectSymbol (Proxy :: Proxy name)
267− <> " WHERE " <> reflectSymbol (Proxy :: Proxy pkCol) <> " = $1"
268−
269−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
270−-- Belongs-to join (many-to-one via row_to_json)
271−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
272−
273−findWith
274− :: forall childName childCols parentName parentCols
275− childRow parentRow localCol parentCol rest result
276− . IsSymbol childName
277− => IsSymbol parentName
278− => IsSymbol localCol
279− => IsSymbol parentCol
280− => TableRow (Table childName childCols) childRow
281− => TableRow (Table parentName parentCols) parentRow
282− => FindForeignKeyTo (Table childName childCols) parentName localCol parentCol
283− => Row.Cons parentName { | parentRow } () rest
284− => Row.Cons childName { | childRow } rest result
285− => ReadForeign { | result }
286− => Proxy (Table childName childCols)
287− -> Proxy (Table parentName parentCols)
288− -> PG.Connection
289− -> Aff (Array { | result })
290−findWith _ _ conn = do
291− result <- PG.query (PG.SQL sql) [] conn
292− pure (unsafeDecodeRows result.rows)
293− where
294− childTbl = reflectSymbol (Proxy :: Proxy childName)
295− parentTbl = reflectSymbol (Proxy :: Proxy parentName)
296− localC = reflectSymbol (Proxy :: Proxy localCol)
297− parentC = reflectSymbol (Proxy :: Proxy parentCol)
298− sql = "SELECT row_to_json(c.*) AS \"" <> childTbl
299− <> "\", row_to_json(p.*) AS \"" <> parentTbl <> "\""
300− <> " FROM " <> childTbl <> " c"
301− <> " INNER JOIN " <> parentTbl <> " p ON c." <> localC <> " = p." <> parentC
302−
303−findByIdWith
304− :: forall childName childCols parentName parentCols
305− childRow parentRow localCol parentCol pkCol pkType rest result
306− . IsSymbol childName
307− => IsSymbol parentName
308− => IsSymbol localCol
309− => IsSymbol parentCol
310− => IsSymbol pkCol
311− => TableRow (Table childName childCols) childRow
312− => TableRow (Table parentName parentCols) parentRow
313− => FindForeignKeyTo (Table childName childCols) parentName localCol parentCol
314− => FindPrimaryKey (Table childName childCols) pkCol pkType
315− => FieldToPGValue pkType
316− => Row.Cons parentName { | parentRow } () rest
317− => Row.Cons childName { | childRow } rest result
318− => ReadForeign { | result }
319− => Proxy (Table childName childCols)
320− -> Proxy (Table parentName parentCols)
321− -> PG.Connection
322− -> pkType
323− -> Aff (Maybe { | result })
324−findByIdWith _ _ conn pk = do
325− result <- PG.queryOne (PG.SQL sql) [ fieldToPGValue pk ] conn
326− pure (result <#> unsafeDecodeRow)
327− where
328− childTbl = reflectSymbol (Proxy :: Proxy childName)
329− parentTbl = reflectSymbol (Proxy :: Proxy parentName)
330− localC = reflectSymbol (Proxy :: Proxy localCol)
331− parentC = reflectSymbol (Proxy :: Proxy parentCol)
332− pkColName = reflectSymbol (Proxy :: Proxy pkCol)
333− sql = "SELECT row_to_json(c.*) AS \"" <> childTbl
334− <> "\", row_to_json(p.*) AS \"" <> parentTbl <> "\""
335− <> " FROM " <> childTbl <> " c"
336− <> " INNER JOIN " <> parentTbl <> " p ON c." <> localC <> " = p." <> parentC
337− <> " WHERE c." <> pkColName <> " = $1"
338−
339−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
340−-- Has-many include (one-to-many via json_agg subquery)
341−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
342−
343−findIncluding
344− :: forall @label parentName parentCols childName childCols
345− parentRow childRow localCol parentCol result
346− . IsSymbol label
347− => IsSymbol parentName
348− => IsSymbol childName
349− => IsSymbol localCol
350− => IsSymbol parentCol
351− => TableRow (Table parentName parentCols) parentRow
352− => TableRow (Table childName childCols) childRow
353− => FindForeignKeyTo (Table childName childCols) parentName localCol parentCol
354− => Row.Cons label (Array { | childRow }) parentRow result
355− => Row.Lacks label parentRow
356− => ReadForeign { | result }
357− => Proxy (Table parentName parentCols)
358− -> Proxy (Table childName childCols)
359− -> PG.Connection
360− -> Aff (Array { | result })
361−findIncluding _ _ conn = do
362− result <- PG.query (PG.SQL sql) [] conn
363− pure (unsafeDecodeRows result.rows)
364− where
365− parentTbl = reflectSymbol (Proxy :: Proxy parentName)
366− childTbl = reflectSymbol (Proxy :: Proxy childName)
367− localC = reflectSymbol (Proxy :: Proxy localCol)
368− parentC = reflectSymbol (Proxy :: Proxy parentCol)
369− lbl = reflectSymbol (Proxy :: Proxy label)
370− sql = "SELECT p.*, COALESCE((SELECT json_agg(to_jsonb(c.*)) FROM "
371− <> childTbl <> " c WHERE c." <> localC <> " = p." <> parentC
372− <> "), '[]'::json) AS \"" <> lbl <> "\""
373− <> " FROM " <> parentTbl <> " p"
374−
375−findByIdIncluding
376− :: forall @label parentName parentCols childName childCols
377− parentRow childRow localCol parentCol pkCol pkType result
378− . IsSymbol label
379− => IsSymbol parentName
380− => IsSymbol childName
381− => IsSymbol localCol
382− => IsSymbol parentCol
383− => IsSymbol pkCol
384− => TableRow (Table parentName parentCols) parentRow
385− => TableRow (Table childName childCols) childRow
386− => FindForeignKeyTo (Table childName childCols) parentName localCol parentCol
387− => FindPrimaryKey (Table parentName parentCols) pkCol pkType
388− => FieldToPGValue pkType
389− => Row.Cons label (Array { | childRow }) parentRow result
390− => Row.Lacks label parentRow
391− => ReadForeign { | result }
392− => Proxy (Table parentName parentCols)
393− -> Proxy (Table childName childCols)
394− -> PG.Connection
395− -> pkType
396− -> Aff (Maybe { | result })
397−findByIdIncluding _ _ conn pk = do
398− result <- PG.queryOne (PG.SQL sql) [ fieldToPGValue pk ] conn
399− pure (result <#> unsafeDecodeRow)
400− where
401− parentTbl = reflectSymbol (Proxy :: Proxy parentName)
402− childTbl = reflectSymbol (Proxy :: Proxy childName)
403− localC = reflectSymbol (Proxy :: Proxy localCol)
404− parentC = reflectSymbol (Proxy :: Proxy parentCol)
405− pkColName = reflectSymbol (Proxy :: Proxy pkCol)
406− lbl = reflectSymbol (Proxy :: Proxy label)
407− sql = "SELECT p.*, COALESCE((SELECT json_agg(to_jsonb(c.*)) FROM "
408− <> childTbl <> " c WHERE c." <> localC <> " = p." <> parentC
409− <> "), '[]'::json) AS \"" <> lbl <> "\""
410− <> " FROM " <> parentTbl <> " p"
411− <> " WHERE p." <> pkColName <> " = $1"