2eeb96b · rowtype-yoga/purescript-yoga-postgres

git.iko.soy/rowtype-yoga/purescript-yoga-postgres

Add delete, orderBy, limit, offset builder functions

commit2eeb96b2d1316859948180bde80cae243d8763a7 authorMark <mark.eibes@gmail.com> dateFri 13 Feb 2026, 18:54 (8 months ago) parent8fd793e

2 files changed+257

compare with main

unifiedsplit

src/Yoga/Postgres/Schema.purs+157 test/Schema.purs+100

src/Yoga/Postgres/Schema.purs+157

@@ -1073,6 +1073,163 @@ set rec _ = Q { sql, values }

10731073 sql = "UPDATE " <> tableName <> " SET " <> intercalate ", " setClauses

10741074 values = recordValuesRL (Proxy :: Proxy setRL) rec

10751075

1076+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

1077+-- DELETE builder

1078+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

1079+

1080+delete

1081+ :: forall name cols r p

1082+ . IsSymbol name

1083+ => Q name cols r p

1084+ -> Q name cols () ()

1085+delete _ = Q { sql: "DELETE FROM " <> reflectSymbol (Proxy :: Proxy name), values: [] }

1086+

1087+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

1088+-- ORDER BY / LIMIT / OFFSET

1089+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

1090+

1091+orderBy

1092+ :: forall @cols name tableCols result params

1093+ . IsSymbol cols

1094+ => ValidateOrderBy cols tableCols

1095+ => Q name tableCols result params

1096+ -> Q name tableCols result params

1097+orderBy (Q q) = Q (q { sql = q.sql <> " ORDER BY " <> reflectSymbol (Proxy :: Proxy cols) })

1098+

1099+limit

1100+ :: forall name cols result params

1101+ . Int

1102+ -> Q name cols result params

1103+ -> Q name cols result params

1104+limit n (Q q) = Q (q { sql = q.sql <> " LIMIT " <> show n })

1105+

1106+offset

1107+ :: forall name cols result params

1108+ . Int

1109+ -> Q name cols result params

1110+ -> Q name cols result params

1111+offset n (Q q) = Q (q { sql = q.sql <> " OFFSET " <> show n })

1112+

1113+-- Validate ORDER BY columns: "name, age DESC" → validate name, age exist

1114+class ValidateOrderBy :: Symbol -> Row Type -> Constraint

1115+class ValidateOrderBy sym cols

1116+

1117+instance ValidateOrderBy "" cols

1118+else instance

1119+ ( Symbol.Cons h t sym

1120+ , ValidateOrderByGo h t "" cols

1121+ ) =>

1122+ ValidateOrderBy sym cols

1123+

1124+class ValidateOrderByGo :: Symbol -> Symbol -> Symbol -> Row Type -> Constraint

1125+class ValidateOrderByGo head tail acc cols

1126+

1127+-- Comma: flush column, continue

1128+instance

1129+ ( FlushOrderByWord acc cols

1130+ , SkipSpaces tail rest

1131+ , ValidateOrderBy rest cols

1132+ ) =>

1133+ ValidateOrderByGo "," tail acc cols

1134+

1135+-- Space: flush column, skip modifiers (ASC/DESC/NULLS FIRST/NULLS LAST)

1136+else instance

1137+ ( SkipSpaces tail rest

1138+ , FlushOrderByThenSkipModifiers acc rest cols

1139+ ) =>

1140+ ValidateOrderByGo " " tail acc cols

1141+

1142+-- End of string: flush final column

1143+else instance

1144+ ( Symbol.Append acc h acc'

1145+ , FlushOrderByWord acc' cols

1146+ ) =>

1147+ ValidateOrderByGo h "" acc cols

1148+

1149+-- Regular char: accumulate

1150+else instance

1151+ ( Symbol.Append acc h acc'

1152+ , Symbol.Cons nextH nextT tail

1153+ , ValidateOrderByGo nextH nextT acc' cols

1154+ ) =>

1155+ ValidateOrderByGo h tail acc cols

1156+

1157+class FlushOrderByWord :: Symbol -> Row Type -> Constraint

1158+class FlushOrderByWord word cols

1159+

1160+instance FlushOrderByWord "" cols

1161+else instance FlushOrderByWord "ASC" cols

1162+else instance FlushOrderByWord "asc" cols

1163+else instance FlushOrderByWord "DESC" cols

1164+else instance FlushOrderByWord "desc" cols

1165+else instance FlushOrderByWord "NULLS" cols

1166+else instance FlushOrderByWord "FIRST" cols

1167+else instance FlushOrderByWord "LAST" cols

1168+else instance Row.Cons word (Column typ constraints) rest cols => FlushOrderByWord word cols

1169+

1170+class FlushOrderByThenSkipModifiers :: Symbol -> Symbol -> Row Type -> Constraint

1171+class FlushOrderByThenSkipModifiers colName rest cols

1172+

1173+-- End of input

1174+instance FlushOrderByWord colName cols => FlushOrderByThenSkipModifiers colName "" cols

1175+

1176+-- Non-empty: branch on first char

1177+else instance

1178+ ( FlushOrderByWord colName cols

1179+ , Symbol.Cons h t rest

1180+ , FlushOrderByThenSkipModifiersByHead h t cols

1181+ ) =>

1182+ FlushOrderByThenSkipModifiers colName rest cols

1183+

1184+class FlushOrderByThenSkipModifiersByHead :: Symbol -> Symbol -> Row Type -> Constraint

1185+class FlushOrderByThenSkipModifiersByHead head tail cols

1186+

1187+-- Comma: continue with next column

1188+instance

1189+ ( SkipSpaces tail rest

1190+ , ValidateOrderBy rest cols

1191+ ) =>

1192+ FlushOrderByThenSkipModifiersByHead "," tail cols

1193+

1194+-- Other: word is a modifier (ASC/DESC/etc), keep consuming

1195+else instance

1196+ ( Symbol.Append h t rest

1197+ , ExtractWord rest word afterWord

1198+ , FlushOrderByWord word cols

1199+ , SkipSpaces afterWord rest'

1200+ , ValidateOrderByContinue rest' cols

1201+ ) =>

1202+ FlushOrderByThenSkipModifiersByHead h t cols

1203+

1204+class ValidateOrderByContinue :: Symbol -> Row Type -> Constraint

1205+class ValidateOrderByContinue sym cols

1206+

1207+instance ValidateOrderByContinue "" cols

1208+else instance

1209+ ( Symbol.Cons h t sym

1210+ , ValidateOrderByContinueByHead h t cols

1211+ ) =>

1212+ ValidateOrderByContinue sym cols

1213+

1214+class ValidateOrderByContinueByHead :: Symbol -> Symbol -> Row Type -> Constraint

1215+class ValidateOrderByContinueByHead head tail cols

1216+

1217+instance

1218+ ( SkipSpaces tail rest

1219+ , ValidateOrderBy rest cols

1220+ ) =>

1221+ ValidateOrderByContinueByHead "," tail cols

1222+

1223+-- More modifiers (e.g. "NULLS FIRST" after "DESC")

1224+else instance

1225+ ( Symbol.Append h t rest

1226+ , ExtractWord rest word afterWord

1227+ , FlushOrderByWord word cols

1228+ , SkipSpaces afterWord rest'

1229+ , ValidateOrderByContinue rest' cols

1230+ ) =>

1231+ ValidateOrderByContinueByHead h t cols

1232+

10761233-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

10771234-- ON CONFLICT

10781235-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

test/Schema.purs+100

@@ -198,6 +198,41 @@ builderSetWhere = typedSetWhere # toSQL

198198builderUpsert :: String

199199builderUpsert = typedUpsert # toSQL

200200

201+typedDelete

202+ :: Q "users" _ () (id :: Int)

203+typedDelete = from usersTable # delete # where_ @"id = $id"

204+

205+typedDeleteReturning

206+ :: Q "users" _ (name :: String, email :: String) (id :: Int)

207+typedDeleteReturning = from usersTable # delete # where_ @"id = $id" # returning @"name, email"

208+

209+typedOrderBy

210+ :: Q "users" _ (age :: Maybe Int, email :: String, id :: Int, name :: String) ()

211+typedOrderBy = from usersTable # selectAll # orderBy @"name"

212+

213+typedOrderByDesc

214+ :: Q "users" _ (age :: Maybe Int, email :: String, id :: Int, name :: String) ()

215+typedOrderByDesc = from usersTable # selectAll # orderBy @"name DESC, age ASC"

216+

217+typedLimitOffset

218+ :: Q "users" _ (age :: Maybe Int, email :: String, id :: Int, name :: String) ()

219+typedLimitOffset = from usersTable # selectAll # orderBy @"name" # limit 10 # offset 5

220+

221+builderDelete :: String

222+builderDelete = typedDelete # toSQL

223+

224+builderDeleteReturning :: String

225+builderDeleteReturning = typedDeleteReturning # toSQL

226+

227+builderOrderBy :: String

228+builderOrderBy = typedOrderBy # toSQL

229+

230+builderOrderByDesc :: String

231+builderOrderByDesc = typedOrderByDesc # toSQL

232+

233+builderLimitOffset :: String

234+builderLimitOffset = typedLimitOffset # toSQL

235+

201236-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

202237-- Phase 10: Query execution (type annotations prove correctness)

203238-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

@@ -297,6 +332,20 @@ spec = do

297332 it "builds INSERT ON CONFLICT DO NOTHING" do

298333 builderUpsert `shouldSatisfy` contains (Pattern "ON CONFLICT (email) DO NOTHING")

299334

335+ describe "Builder DELETE" do

336+ it "builds DELETE with WHERE" do

337+ builderDelete `shouldEqual` "DELETE FROM users WHERE id = $id"

338+ it "builds DELETE with RETURNING" do

339+ builderDeleteReturning `shouldEqual` "DELETE FROM users WHERE id = $id RETURNING name, email"

340+

341+ describe "Builder ORDER BY / LIMIT / OFFSET" do

342+ it "builds ORDER BY" do

343+ builderOrderBy `shouldEqual` "SELECT * FROM users ORDER BY name"

344+ it "builds ORDER BY with DESC/ASC" do

345+ builderOrderByDesc `shouldEqual` "SELECT * FROM users ORDER BY name DESC, age ASC"

346+ it "builds LIMIT and OFFSET" do

347+ builderLimitOffset `shouldEqual` "SELECT * FROM users ORDER BY name LIMIT 10 OFFSET 5"

348+

300349integrationSpec :: PG.Connection -> Spec Unit

301350integrationSpec conn = do

302351 describe "Builder query execution" do

@@ -408,3 +457,54 @@ integrationSpec conn = do

408457 Array.length rows `shouldEqual` 1

409458 (map _.name rows) `shouldEqual` [ "Updated" ]

410459 (map _.age rows) `shouldEqual` [ Just 40 ]

460+

461+ describe "Builder order by / limit / offset execution" do

462+ it "ORDER BY sorts results" do

463+ rows <- from usersTable

464+ # select @"name"

465+ # orderBy @"name ASC"

466+ # runQuery conn {}

467+ let names = map _.name rows

468+ names `shouldEqual` (Array.sort names)

469+

470+ it "LIMIT restricts row count" do

471+ rows <- from usersTable

472+ # selectAll

473+ # orderBy @"name"

474+ # limit 1

475+ # runQuery conn {}

476+ Array.length rows `shouldEqual` 1

477+

478+ it "OFFSET skips rows" do

479+ rows <- from usersTable

480+ # select @"name"

481+ # orderBy @"name ASC"

482+ # limit 1

483+ # offset 1

484+ # runQuery conn {}

485+ Array.length rows `shouldEqual` 1

486+ allRows <- from usersTable

487+ # select @"name"

488+ # orderBy @"name ASC"

489+ # runQuery conn {}

490+ let allNames = map _.name allRows

491+ (map _.name rows) `shouldEqual` (Array.take 1 (Array.drop 1 allNames))

492+

493+ describe "Builder delete execution" do

494+ it "deletes with RETURNING" do

495+ _ <- from usersTable

496+ # insert { name: "ToDelete", email: "delete@example.com", age: Just 50 }

497+ # runExecute conn {}

498+ rows <- from usersTable

499+ # delete

500+ # where_ @"name = $name"

501+ # returning @"name, email"

502+ # runQuery conn { name: "ToDelete" }

503+ Array.length rows `shouldEqual` 1

504+ (map _.name rows) `shouldEqual` [ "ToDelete" ]

505+ -- Verify actually deleted

506+ result <- from usersTable

507+ # selectAll

508+ # where_ @"name = $name"

509+ # runQueryOne conn { name: "ToDelete" }

510+ result `shouldEqual` Nothing