e61cf57 · rowtype-yoga/purescript-yoga-sqlite-om

git.iko.soy/rowtype-yoga/purescript-yoga-sqlite-om

Expand ORM helpers

commite61cf572c788bc1f62b64d118ca127052c837ee8 authorMark <mark.eibes@gmail.com> dateTue 30 Jun 2026, 13:27 (3 months ago) parentd2a4e1c

6 files changed+228−24

compare with main

unifiedsplit

src/Yoga/SQLite/ClientOm.purs+141−13 src/Yoga/SQLite/Om.purs+28 test/Test/SQLiteOm/ClientReadSpec.purs+1−1 test/Test/SQLiteOm/OrmSpec.purs+35 test/Test/SQLiteOm/RawSqlSpec.purs+9 test/Test/SQLiteOm/Support.purs+14−10

src/Yoga/SQLite/ClientOm.purs+141−13

@@ -45,6 +45,11 @@ module Yoga.SQLite.ClientOm

4545 , findWhereOrdered

4646 , findWhereLimited

4747 , findAfter

48+ , findAfterWithKey

49+ , create

50+ , createReturningAll

51+ , updateWhere

52+ , deleteWhere

4853 , countWhere

4954 , countAll

5055 , module Schema

@@ -52,7 +57,7 @@ module Yoga.SQLite.ClientOm

5257

5358import Prelude

5459

55−import Data.Array (head, intercalate, length, take)

60+import Data.Array (head, intercalate, length, mapWithIndex, take)

5661import Data.Either (Either(..))

5762import Data.Maybe (Maybe(..))

5863import Data.Symbol (class IsSymbol, reflectSymbol)

@@ -67,12 +72,11 @@ import Prim.TypeError (class Fail, Text)

6772import Record as Record

6873import Type.Proxy (Proxy(..))

6974import Type.RowList (class ListToRow)

70−import Unsafe.Coerce (unsafeCoerce)

7175import Yoga.JSON (class ReadForeign)

7276import Yoga.JSON as JSON

7377import Yoga.Om as Om

7478import Yoga.SQLite.Schema as Schema

75−import Yoga.SQLite.Schema (class ExtractType, class FieldToSQLiteValue, class InsertableColumnsRL, class ParamsToArray, class StripColumnsRL, AutoIncrement, Default, ForeignKey, Nullable, PrimaryKey, References, Table, Unique, fieldToSQLiteValue)

79+import Yoga.SQLite.Schema (class ExtractType, class FieldToSQLiteValue, class InsertableColumnsRL, class ParamsToArray, class RecordValuesRL, class SetClauseRL, class StripColumnsRL, AutoIncrement, Default, ForeignKey, Nullable, PrimaryKey, Table, Unique, fieldToSQLiteValue, setClauseRL)

7680import Yoga.SQLite.SQLite (Connection)

7781import Yoga.SQLite.SQLite as SQLite

7882

@@ -470,7 +474,7 @@ findWhereLimited whereRec dir opts _ = do

470474 <> " ORDER BY " <> reflectSymbol (Proxy :: Proxy col) <> " " <> orderDirSQL dir

471475 <> " LIMIT ?" <> show limitIdx

472476 <> " OFFSET ?" <> show offsetIdx

473− values = whereResult.values <> [ unsafeCoerce opts.limit, unsafeCoerce opts.offset ]

477+ values = whereResult.values <> [ fieldToSQLiteValue opts.limit, fieldToSQLiteValue opts.offset ]

474478

475479findAfter

476480 :: forall @col name cols colEntry rest row colType r err

@@ -487,7 +491,7 @@ findAfter

487491 -> Om.Om { sqlite :: Connection | r } (parseError :: MultipleErrors | err) (PageRecord row)

488492findAfter cursor limit _ = do

489493 { sqlite } <- Om.ask

490− result <- SQLite.query (SQLite.SQL sql) [ fieldToSQLiteValue cursor, unsafeCoerce (limit + 1) ] sqlite # liftAff

494+ result <- SQLite.query (SQLite.SQL sql) [ fieldToSQLiteValue cursor, fieldToSQLiteValue (limit + 1) ] sqlite # liftAff

491495 allRows <- traverse parseRow result.rows

492496 pure { items: take limit allRows, hasMore: length allRows > limit }

493497 where

@@ -496,7 +500,113 @@ findAfter cursor limit _ = do

496500 <> " ORDER BY " <> reflectSymbol (Proxy :: Proxy col) <> " ASC"

497501 <> " LIMIT ?2"

498502

499−countWhere

503+findAfterWithKey

504+ :: forall @col @key name cols colEntry keyEntry colRest keyRest row colType keyType r err

505+ . IsSymbol name

506+ => IsSymbol col

507+ => IsSymbol key

508+ => Row.Cons col colEntry colRest cols

509+ => Row.Cons key keyEntry keyRest cols

510+ => ExtractType colEntry colType

511+ => ExtractType keyEntry keyType

512+ => FieldToSQLiteValue colType

513+ => FieldToSQLiteValue keyType

514+ => TableRow (Table name cols) row

515+ => ReadForeign { | row }

516+ => { cursor :: colType, key :: keyType }

517+ -> Int

518+ -> Proxy (Table name cols)

519+ -> Om.Om { sqlite :: Connection | r } (parseError :: MultipleErrors | err) (PageRecord row)

520+findAfterWithKey cursor limit _ = do

521+ { sqlite } <- Om.ask

522+ result <- SQLite.query (SQLite.SQL sql) [ fieldToSQLiteValue cursor.cursor, fieldToSQLiteValue cursor.cursor, fieldToSQLiteValue cursor.key, fieldToSQLiteValue (limit + 1) ] sqlite # liftAff

523+ allRows <- traverse parseRow result.rows

524+ pure { items: take limit allRows, hasMore: length allRows > limit }

525+ where

526+ table = reflectSymbol (Proxy :: Proxy name)

527+ orderColumn = reflectSymbol (Proxy :: Proxy col)

528+ keyColumn = reflectSymbol (Proxy :: Proxy key)

529+ sql = "SELECT * FROM " <> table

530+ <> " WHERE (" <> orderColumn <> " > ?1 OR (" <> orderColumn <> " = ?2 AND " <> keyColumn <> " > ?3))"

531+ <> " ORDER BY " <> orderColumn <> " ASC, " <> keyColumn <> " ASC"

532+ <> " LIMIT ?4"

533+

534+create

535+ :: forall name cols tables row rowRL r err

536+ . IsSymbol name

537+ => Row.Cons name cols () tables

538+ => RowToList row rowRL

539+ => InsertableRow (Table name cols) row

540+ => RecordValuesRL rowRL row

541+ => Schema.ColumnNamesRL rowRL

542+ => { | row }

543+ -> Proxy (Table name cols)

544+ -> Om.Om { sqlite :: Connection | r } err Int

545+create row _ = do

546+ { sqlite } <- Om.ask

547+ SQLite.execute (SQLite.SQL sql) values sqlite # liftAff

548+ where

549+ tableName = reflectSymbol (Proxy :: Proxy name)

550+ colNames = Schema.columnNamesRL (Proxy :: Proxy rowRL)

551+ placeholders = mapWithIndex (\i _ -> "?" <> show (i + 1)) colNames

552+ sql =

553+ if length colNames == 0 then "INSERT INTO " <> tableName <> " DEFAULT VALUES"

554+ else "INSERT INTO " <> tableName <> " (" <> intercalate ", " colNames <> ") VALUES (" <> intercalate ", " placeholders <> ")"

555+ values = Schema.recordValuesRL (Proxy :: Proxy rowRL) row

556+

557+createReturningAll

558+ :: forall name cols tables row rowRL result r err

559+ . IsSymbol name

560+ => Row.Cons name cols () tables

561+ => RowToList row rowRL

562+ => InsertableRow (Table name cols) row

563+ => RecordValuesRL rowRL row

564+ => Schema.ColumnNamesRL rowRL

565+ => TableRow (Table name cols) result

566+ => ReadForeign { | result }

567+ => { | row }

568+ -> Proxy (Table name cols)

569+ -> Om.Om { sqlite :: Connection | r } (parseError :: MultipleErrors | err) (Maybe { | result })

570+createReturningAll row _ = do

571+ { sqlite } <- Om.ask

572+ maybeRow <- SQLite.queryOne (SQLite.SQL sql) values sqlite # liftAff

573+ traverse parseRow maybeRow

574+ where

575+ tableName = reflectSymbol (Proxy :: Proxy name)

576+ colNames = Schema.columnNamesRL (Proxy :: Proxy rowRL)

577+ placeholders = mapWithIndex (\i _ -> "?" <> show (i + 1)) colNames

578+ insertSql =

579+ if length colNames == 0 then "INSERT INTO " <> tableName <> " DEFAULT VALUES"

580+ else "INSERT INTO " <> tableName <> " (" <> intercalate ", " colNames <> ") VALUES (" <> intercalate ", " placeholders <> ")"

581+ sql = insertSql <> " RETURNING *"

582+ values = Schema.recordValuesRL (Proxy :: Proxy rowRL) row

583+

584+updateWhere

585+ :: forall name cols setRow setRL whereRow whereRL r err

586+ . IsSymbol name

587+ => RowToList setRow setRL

588+ => RowToList whereRow whereRL

589+ => Schema.ValidateSetColumnsRL setRL cols

590+ => SetClauseRL setRL

591+ => RecordValuesRL setRL setRow

592+ => ValidateWhereColumnsRL whereRL cols

593+ => OmWhereClauseRL whereRL whereRow

594+ => { | whereRow }

595+ -> { | setRow }

596+ -> Proxy (Table name cols)

597+ -> Om.Om { sqlite :: Connection | r } err Int

598+updateWhere whereRec setRec _ = do

599+ { sqlite } <- Om.ask

600+ SQLite.execute (SQLite.SQL sql) (setValues <> whereResult.values) sqlite # liftAff

601+ where

602+ tableName = reflectSymbol (Proxy :: Proxy name)

603+ setValues = Schema.recordValuesRL (Proxy :: Proxy setRL) setRec

604+ whereResult = whereClauseFragments (Proxy :: Proxy whereRL) whereRec (length setValues + 1)

605+ sql = "UPDATE " <> tableName

606+ <> " SET " <> intercalate ", " (setClauseRL (Proxy :: Proxy setRL) 1)

607+ <> " WHERE " <> intercalate " AND " whereResult.sql

608+

609+deleteWhere

500610 :: forall name cols whereRow whereRL r err

501611 . IsSymbol name

502612 => RowToList whereRow whereRL

@@ -505,12 +615,27 @@ countWhere

505615 => { | whereRow }

506616 -> Proxy (Table name cols)

507617 -> Om.Om { sqlite :: Connection | r } err Int

618+deleteWhere whereRec _ = do

619+ { sqlite } <- Om.ask

620+ SQLite.execute (SQLite.SQL sql) whereResult.values sqlite # liftAff

621+ where

622+ whereResult = whereClauseFragments (Proxy :: Proxy whereRL) whereRec 1

623+ sql = "DELETE FROM " <> reflectSymbol (Proxy :: Proxy name)

624+ <> " WHERE " <> intercalate " AND " whereResult.sql

625+

626+countWhere

627+ :: forall name cols whereRow whereRL r err

628+ . IsSymbol name

629+ => RowToList whereRow whereRL

630+ => ValidateWhereColumnsRL whereRL cols

631+ => OmWhereClauseRL whereRL whereRow

632+ => { | whereRow }

633+ -> Proxy (Table name cols)

634+ -> Om.Om { sqlite :: Connection | r } (parseError :: MultipleErrors | err) Int

508635countWhere whereRec _ = do

509636 { sqlite } <- Om.ask

510637 maybeRow <- SQLite.queryOne (SQLite.SQL sql) whereResult.values sqlite # liftAff

511− pure case maybeRow of

512− Nothing -> 0

513− Just row -> (unsafeCoerce row).result

638+ countFrom maybeRow

514639 where

515640 whereResult = whereClauseFragments (Proxy :: Proxy whereRL) whereRec 1

516641 sql = "SELECT COUNT(*) AS result FROM " <> reflectSymbol (Proxy :: Proxy name)

@@ -520,12 +645,15 @@ countAll

520645 :: forall name cols r err

521646 . IsSymbol name

522647 => Proxy (Table name cols)

523− -> Om.Om { sqlite :: Connection | r } err Int

648+ -> Om.Om { sqlite :: Connection | r } (parseError :: MultipleErrors | err) Int

524649countAll _ = do

525650 { sqlite } <- Om.ask

526651 maybeRow <- SQLite.queryOne (SQLite.SQL sql) [] sqlite # liftAff

527− pure case maybeRow of

528− Nothing -> 0

529− Just row -> (unsafeCoerce row).result

652+ countFrom maybeRow

530653 where

531654 sql = "SELECT COUNT(*) AS result FROM " <> reflectSymbol (Proxy :: Proxy name)

655+

656+countFrom :: forall ctx err. Maybe Foreign -> Om.Om ctx (parseError :: MultipleErrors | err) Int

657+countFrom = case _ of

658+ Nothing -> pure 0

659+ Just row -> _.result <$> (parseRow row :: Om.Om ctx (parseError :: MultipleErrors | err) { result :: Int })

src/Yoga/SQLite/Om.purs+28

@@ -6,10 +6,15 @@ module Yoga.SQLite.Om

66 , executeSimple

77 , executeMultiple

88 , batch

9+ , transaction

10+ , readTransaction

11+ , writeTransaction

12+ , deferredTransaction

913 ) where

1014

1115import Prelude

1216

17+import Control.Monad.Error.Class (catchError, throwError)

1318import Data.Maybe (Maybe)

1419import Effect.Aff.Class (liftAff)

1520import Yoga.Om as Om

@@ -50,3 +55,26 @@ batch :: forall r err. TransactionMode -> Array BatchStatement -> Om.Om { sqlite

5055batch mode statements = do

5156 { sqlite } <- Om.ask

5257 SQLite.batch mode statements sqlite # liftAff

58+

59+transaction :: forall r err a. TransactionMode -> (SQLite.Transaction -> Om.Om { sqlite :: Connection | r } err a) -> Om.Om { sqlite :: Connection | r } err a

60+transaction mode run = do

61+ { sqlite } <- Om.ask

62+ tx <- SQLite.beginWithMode mode sqlite # liftAff

63+ catchError

64+ (do

65+ result <- run tx

66+ SQLite.commit tx # liftAff

67+ pure result

68+ )

69+ \err -> do

70+ SQLite.rollback tx # liftAff

71+ throwError err

72+

73+readTransaction :: forall r err a. (SQLite.Transaction -> Om.Om { sqlite :: Connection | r } err a) -> Om.Om { sqlite :: Connection | r } err a

74+readTransaction = transaction SQLite.Read

75+

76+writeTransaction :: forall r err a. (SQLite.Transaction -> Om.Om { sqlite :: Connection | r } err a) -> Om.Om { sqlite :: Connection | r } err a

77+writeTransaction = transaction SQLite.Write

78+

79+deferredTransaction :: forall r err a. (SQLite.Transaction -> Om.Om { sqlite :: Connection | r } err a) -> Om.Om { sqlite :: Connection | r } err a

80+deferredTransaction = transaction SQLite.Deferred

test/Test/SQLiteOm/ClientReadSpec.purs+1−1

@@ -46,7 +46,7 @@ spec = describe "typed ClientOm reads" do

4646 map _.name rows `shouldEqual` [ "Ada" ] # liftAff

4747

4848 it "counts rows through ORM-style helpers" do

49− withDb do

49+ withDbParsed do

5050 createUsersTable

5151 let exec = Client.execCount {}

5252 _ <- from usersTable # insert { name: "Ada", email: "ada@example.com", role: "admin" } # exec

test/Test/SQLiteOm/OrmSpec.purs+35

@@ -65,6 +65,41 @@ spec = describe "ORM-style SQLite ClientOm helpers" do

6565 map _.name page.items `shouldEqual` [ "Grace" ] # liftAff

6666 page.hasMore `shouldEqual` true # liftAff

6767

68+ it "pages after a non-unique cursor with primary-key tie breaker" do

69+ withMembers do

70+ page <- Client.findAfterWithKey @"role" @"id" { cursor: "admin", key: 1 } 2 membersTable

71+ map _.name page.items `shouldEqual` [ "Grace", "Linus" ] # liftAff

72+ page.hasMore `shouldEqual` false # liftAff

73+

74+ it "creates rows through the ORM helper" do

75+ withDbParsed do

76+ createMembersTable

77+ created <- Client.create { name: "Margaret", email: "margaret@example.com", role: "admin", age: 36, nickname: Just "hamilton" } membersTable

78+ row <- Client.findOneWhere { email: Client.eq_ "margaret@example.com" } membersTable

79+ created `shouldEqual` 1 # liftAff

80+ map _.name row `shouldEqual` Just "Margaret" # liftAff

81+

82+ it "creates rows with RETURNING * through the ORM helper" do

83+ withDbParsed do

84+ createMembersTable

85+ row <- Client.createReturningAll { name: "Barbara", email: "barbara@example.com", role: "engineer", age: 38, nickname: Nothing } membersTable

86+ map _.name row `shouldEqual` Just "Barbara" # liftAff

87+

88+ it "updates rows through typed where helpers" do

89+ withMembers do

90+ changed <- Client.updateWhere { email: Client.eq_ "grace@example.com" } { role: "admin", nickname: Just "hopper" } membersTable

91+ row <- Client.findOneWhere { email: Client.eq_ "grace@example.com" } membersTable

92+ changed `shouldEqual` 1 # liftAff

93+ map _.role row `shouldEqual` Just "admin" # liftAff

94+ map _.nickname row `shouldEqual` Just (Just "hopper") # liftAff

95+

96+ it "deletes rows through typed where helpers" do

97+ withMembers do

98+ deleted <- Client.deleteWhere { role: Client.eq_ "member" } membersTable

99+ rows <- Client.findAll membersTable

100+ deleted `shouldEqual` 1 # liftAff

101+ map _.name rows `shouldEqual` [ "Ada", "Linus" ] # liftAff

102+

68103withMembers :: Om.Om { sqlite :: SQLite.Connection } (parseError :: MultipleErrors) Unit -> Aff Unit

69104withMembers body = withDbParsed do

70105 createMembersTable

test/Test/SQLiteOm/RawSqlSpec.purs+9

@@ -28,3 +28,12 @@ spec = describe "raw SQLite Om operations" do

2828 result <- SQLiteOm.querySimple (SQLite.SQL "SELECT name FROM users")

2929 Array.length result.rows `shouldEqual` 1 # liftAff

3030 result.columns `shouldEqual` [ "name" ] # liftAff

31+

32+ it "runs work inside a write transaction helper" do

33+ withDb do

34+ rowsInTransaction <- SQLiteOm.writeTransaction \tx -> do

35+ _ <- SQLite.txExecute (SQLite.SQL "CREATE TABLE users (name TEXT NOT NULL)") [] tx # liftAff

36+ _ <- SQLite.txExecute (SQLite.SQL "INSERT INTO users (name) VALUES (?1)") (SQLite.params [ "Ada" ]) tx # liftAff

37+ rows <- SQLite.txQuery (SQLite.SQL "SELECT name FROM users") [] tx # liftAff

38+ pure (Array.length rows.rows)

39+ rowsInTransaction `shouldEqual` 1 # liftAff

test/Test/SQLiteOm/Support.purs+14−10

@@ -9,9 +9,9 @@ module Test.SQLiteOm.Support

1010import Prelude

1111

12−import Effect.Aff (Aff, throwError)

13−import Effect.Exception as Exception

12+import Effect.Aff (Aff, bracket, throwError)

1413import Effect.Class (liftEffect)

14+import Effect.Exception as Exception

1515import Foreign (MultipleErrors)

1616import Type.Function (type (#))

1717import Type.Proxy (Proxy(..))

@@ -32,16 +32,20 @@ usersTable :: Proxy UsersTable

3232usersTable = Proxy

3333

3434withDb :: Om.Om { sqlite :: SQLite.Connection } () Unit -> Aff Unit

35−withDb om = do

36− conn <- liftEffect $ SQLite.sqlite { url: ":memory:" }

37− _ <- Om.runOm { sqlite: conn } { exception: throwError } om

38− SQLite.close conn # liftEffect

35+withDb om = bracket

36+ (SQLite.sqlite { url: ":memory:" } # liftEffect)

37+ (\conn -> SQLite.close conn # liftEffect)

38+ \conn -> do

39+ _ <- Om.runOm { sqlite: conn } { exception: throwError } om

40+ pure unit

3941

4042withDbParsed :: Om.Om { sqlite :: SQLite.Connection } (parseError :: MultipleErrors) Unit -> Aff Unit

41−withDbParsed om = do

42− conn <- liftEffect $ SQLite.sqlite { url: ":memory:" }

43− _ <- Om.runOm { sqlite: conn } { exception: throwError, parseError: show >>> Exception.error >>> throwError } om

44− SQLite.close conn # liftEffect

43+withDbParsed om = bracket

44+ (SQLite.sqlite { url: ":memory:" } # liftEffect)

45+ (\conn -> SQLite.close conn # liftEffect)

46+ \conn -> do

47+ _ <- Om.runOm { sqlite: conn } { exception: throwError, parseError: show >>> Exception.error >>> throwError } om

48+ pure unit

4549

4650createUsersTable :: forall err. Om.Om { sqlite :: SQLite.Connection } err Unit

4751createUsersTable = do