ORM

A simple ORM (Object-Relational Mapping) for CHICKEN Scheme with support for models, migrations, and relationships.

The orm egg is a lightweight ORM for CHICKEN Scheme built around a define-model macro that introspects an existing table at runtime and generates a full set of CRUD functions. It features a backend-agnostic database layer, a small migration system with a companion CLI runner, has-many relationships, and automatic kebab-case ↔ snake_case name conversion.

The egg bundles three modules so the lightweight, pure-Scheme pieces install as one unit:

orm — the core ORM: models, migrations, relationships
orm-db — the abstract, backend-agnostic database interface
orm-test — a mock backend for testing ORM code without a real database

A database backend is installed separately as its own egg, because each pulls heavy, mutually-exclusive dependencies:

orm-db-sqlite — SQLite3 backend
orm-db-rqlite — rqlite (HTTP-based distributed SQLite) backend

Requirements

CHICKEN Scheme 5.0 or later
Dependencies: srfi-1, srfi-13, srfi-133, logger, sql-null
A backend egg (orm-db-sqlite or orm-db-rqlite) to connect to a real database

Installation

chicken-install orm
chicken-install orm-db-sqlite   ; if using SQLite
chicken-install orm-db-rqlite   ; if using rqlite

Basic Usage

(import orm-db orm-db-sqlite orm)

;; Configure and connect to a database
(db/backend (sqlite3-backend))
(db/path "myapp.db")
(db/connect)

;; Define a model bound to an existing table
(define-model users)

;; Query
(users/all)                    ; => #(((id . 1) (name . "Alice") ...) ...)
(users/find '(= id ?) '(1))    ; => ((id . 1) (name . "Alice") ...)

Naming Conventions

The ORM automatically converts between Scheme's kebab-case and SQL's snake_case:

Table name user-sessions maps to user_sessions
Column created-at maps to created_at
Query results are returned with kebab-case keys

Data Representations

Query results: a vector of alists, one alist per row
Single row: an alist with symbol keys
SQL NULL: represented as the symbol null
Metadata columns: a TEXT column storing an s-expression alist, read/written via row-metadata / row-metadata-set!

API: Database Layer (orm-db)

The orm-db module defines a backend-agnostic interface using CHICKEN parameters. A backend is an alist mapping the symbols connect, close, query, and execute to procedures; the backend eggs provide constructors (sqlite3-backend, rqlite-backend) that return such an alist.

[parameter] (db/backend [backend])

Get or set the current backend alist. Must be set before connecting.

[parameter] (db/path [path])

Get or set the database path or connection string. Must be set before connecting.

[parameter] (db/connection [conn])

Get or set the current (opaque, backend-specific) connection. Normally managed by db/connect / db/close.

[procedure] (db/connect)

Open a connection using the current backend and path. Errors if either is unset.

(db/backend (sqlite3-backend))
(db/path "myapp.db")
(db/connect)

[procedure] (db/close)

Close the current connection (no-op if none is open).

[procedure] (db/query ssql-or-string [params])

Run a SELECT. ssql-or-string is either a raw SQL string or an ssql S-expression form; params is a list bound to ? placeholders. Returns a vector of alists.

[procedure] (db/execute ssql-or-string [params] [out-key])

Run an INSERT/UPDATE/DELETE/DDL statement. out-key selects which value the backend returns (default rows_affected; e.g. last_insert_rowid).

API: Models (define-model)

[syntax] (define-model name)

Defines a model bound to the existing table name. The macro introspects the table schema at runtime (via PRAGMA table_info) and generates the following functions. A live connection must exist when the generated functions are first called.

(define-model users)

For a model named users, the generated functions are listed below. Each example shows the SQL that is produced (the SQLite dialect; rqlite renders identically). Assume users has columns id, name, email.

[procedure] (users/all #!key limit order offset)

Return all rows as a vector of alists.

(users/all)
;; SQL: SELECT id, name, email FROM users

(users/all limit: 10)
;; SQL: SELECT id, name, email FROM users LIMIT 10

(users/all order: 'name)               ; ascending
;; SQL: SELECT id, name, email FROM users ORDER BY name

(users/all order: '(desc created-at))  ; descending
;; SQL: SELECT id, name, email FROM users ORDER BY created_at DESC

Note how the column list comes from the introspected schema, and kebab-case names in order are converted to snake_case.

[procedure] (users/find [conditions] [values] #!key order)

Return a single row (alist) matching conditions, or #f if none. conditions is an ssql WHERE form with ? placeholders, values the bound values.

(users/find '(= id ?) '(1))
;; SQL: SELECT id, name, email FROM users WHERE (id = ?) LIMIT 1

(users/find '(= email ?) '("bob@example.com"))
;; SQL: SELECT id, name, email FROM users WHERE (email = ?) LIMIT 1

(users/find '(= id ?) '(999))   ; => #f

find is just where with limit: 1, returning the single row or #f.

[procedure] (users/where [conditions] [values] #!key limit order offset)

Return all rows matching conditions as a vector of alists.

(users/where '(= status ?) '("active"))
;; SQL: SELECT id, name, email, status FROM users WHERE (status = ?)

(users/where '(and (= status ?) (> age ?)) '("active" 18))
;; SQL: SELECT ... FROM users WHERE ((status = ?) AND (age > ?))

(users/where '(>= age ?) '(21))
;; SQL: SELECT ... FROM users WHERE (age >= ?)

(users/where '(like name ?) '("%alice%"))
;; SQL: SELECT ... FROM users WHERE (name LIKE ?)

(users/where '(is deleted-at ?) '(null))
;; SQL: SELECT ... FROM users WHERE (deleted_at IS ?)

(users/where '(= status ?) '("active") limit: 10 order: '(desc created-at))
;; SQL: SELECT ... FROM users WHERE (status = ?) ORDER BY created_at DESC LIMIT 10

Comparison operators: =, <>, <, >, <=, >=, like, is. The conditions form is an ssql expression; ? placeholders are bound positionally from values.

[procedure] (users/count [conditions] [values])

Return the number of matching rows (all rows if no conditions).

(users/count)                       ; => 42
;; SQL: SELECT COUNT(*) AS _count FROM users

(users/count '(= status ?) '("active"))  ; => 15
;; SQL: SELECT COUNT(*) AS _count FROM users WHERE (status = ?)

[procedure] (users/create row-alist)

Insert a new row and return it (re-fetched by rowid).

(users/create '((name . "Charlie") (email . "charlie@example.com")))
; => ((id . 3) (name . "Charlie") ...)
;; SQL: INSERT INTO users (name, email) VALUES (?, ?)
;;      then re-fetched: SELECT ... FROM users WHERE (rowid = ?) LIMIT 1

Pairs whose value is '() are dropped, so only supplied columns are inserted.

[procedure] (users/save row-alist)

Update an existing row, matched by primary key, and return the fresh row. Sets updated_at to CURRENT_TIMESTAMP and ignores created-at / updated-at in the input.

(let* ((user (users/find '(= id ?) '(1)))
       (updated (alist-update 'name "Alicia" user)))
  (users/save updated))
;; SQL: UPDATE users SET name = ?, updated_at = CURRENT_TIMESTAMP WHERE (id = ?)
;;      then re-fetched: SELECT ... FROM users WHERE (id = ?) LIMIT 1

Only non-primary-key, non-timestamp columns appear in the SET list; updated_at is always set to CURRENT_TIMESTAMP.

[procedure] (users/update id updates)

Convenience wrapper: find the row by id, apply the updates alist, and save. Returns the updated row, or #f if the id is not found.

(users/update 1 '((name . "Alicia") (status . "inactive")))
(users/update 999 '((name . "Nobody")))   ; => #f

[procedure] (users/delete row-alist)

Delete the row identified by the primary key in row-alist. Returns #t.

(let ((user (users/find '(= id ?) '(1))))
  (users/delete user))
;; SQL: DELETE FROM users WHERE (id = ?)

[procedure] (users/columns)

Return the table's column metadata.

[procedure] (users/pkey)

Return the primary key column name(s) as a list.

API: Relationships (model/has-many)

[syntax] (model/has-many parent child)

Declare a has-many relationship between two existing models. Assumes the convention that the child table has a <singular-parent>-id foreign key column (e.g. posts.user_id → users.id).

(define-model users)
(define-model posts)
(model/has-many users posts)   ; posts.user_id -> users.id

This generates three functions:

[procedure] (users/posts parent-row [conditions] [values] #!key limit order offset)

Return all child rows belonging to parent-row, optionally further filtered.

(let ((user (users/find '(= id ?) '(1))))
  (users/posts user))
;; SQL: SELECT id, user_id, title FROM posts WHERE (user_id = ?)

;; with extra conditions
(let ((user (users/find '(= id ?) '(1))))
  (users/posts user '(= published ?) '(#t)))
;; SQL: SELECT ... FROM posts WHERE ((user_id = ?) AND (published = ?))

[procedure] (posts/users child-row)

Return the parent row for child-row.

(let ((post (posts/find '(= id ?) '(1))))
  (posts/users post))   ; => ((id . 1) (name . "Alice") ...)
;; SQL: SELECT id, name, email FROM users WHERE (id = ?) LIMIT 1

[procedure] (users/add-posts parent-row child-row)

Associate child-row with parent-row by setting the foreign key, and save the child (issuing the same UPDATE posts SET ... WHERE (id = ?) as posts/save).

API: Migrations

A migration registers an up procedure and a down procedure under a name. Migrations are applied in registration order; the current version is tracked in a schema_migrations table that is created automatically.

[procedure] (model/migration name up-proc down-proc)

Register a migration. name is a string (e.g. "001-create-users"); up-proc and down-proc are zero-argument thunks.

(model/migration "001-create-users"
  (lambda ()
    (model/schema/create-table 'users
      '(id integer (primary-key #t) (autoincrement #t))
      '(name text (not-null #t))
      '(email text (unique #t))
      '(created-at datetime (default CURRENT_TIMESTAMP))
      '(updated-at datetime (default CURRENT_TIMESTAMP))))
  (lambda ()
    (model/schema/drop-table 'users)))

(model/migration "002-add-status-to-users"
  (lambda () (model/schema/add-columns 'users '(status text (default "active"))))
  (lambda () (model/schema/drop-columns 'users 'status)))

[procedure] (model/migrate [target-version])

Apply migrations. With no argument, migrate up to the latest registered migration. With a target name, migrate up or down to that version, applying the necessary up/down procedures in order.

(model/migrate)                    ; up to latest
(model/migrate "001-create-users") ; up or down to this version

[procedure] (model/rollback-all!)

Roll back every applied migration, returning the schema to a clean state.

Running Migrations from the CLI

The egg installs an orm-migrate program that runs migrations without a driver script. Point it at a migrations file — a plain Scheme file containing (model/migration ...) forms (no imports needed; orm is already in scope) — and choose the backend at runtime.

# Apply all migrations up to the latest
orm-migrate -b sqlite -path myapp.db -f migrations.scm

# Migrate up or down to a specific version
orm-migrate -b sqlite -path myapp.db -f migrations.scm -m 001-create-users

# Roll everything back to a clean state
orm-migrate -b sqlite -path myapp.db -f migrations.scm --rollback

# rqlite: -path is the HTTP connection string (keep credentials off disk)
orm-migrate -b rqlite -path "https://user:pass@host:4001" -f migrations.scm

Flags:

-b, --backend — backend to use: sqlite or rqlite (required)
-path, --path — database path / connection string (required)
-f, --file — migrations file with (model/migration ...) forms (required)
-m, --migration — target version; migrates up or down to it (default: latest)
--rollback — roll back all migrations
-h, --help — show usage

The chosen backend egg (orm-db-sqlite or orm-db-rqlite) is imported dynamically at runtime, so it must be installed, but the orm egg keeps no static dependency on either.

API: Schema Helpers

These helpers generate and run DDL; they are normally called from inside migration thunks.

[procedure] (model/schema/create-table table-name column-spec ...)

Create a table. Each column-spec is (name type option ...).

(model/schema/create-table 'posts
  '(id integer (primary-key #t) (autoincrement #t))
  '(user-id integer (foreign-key users id))
  '(title text (not-null #t))
  '(body text)
  '(published boolean (default #f))
  '(created-at datetime (default CURRENT_TIMESTAMP)))

[procedure] (model/schema/drop-table table-name)

Drop a table.

[procedure] (model/schema/add-columns table-name column-spec ...)

Add one or more columns. Honors the same options as create-table.

(model/schema/add-columns 'posts
  '(slug text)
  '(view-count integer (default 0)))

[procedure] (model/schema/drop-columns table-name column-name ...)

Drop one or more columns (subject to the backend's ALTER TABLE support).

[procedure] (column-spec->sql spec [alter?])

Render a single column spec to its SQL fragment. Exposed for reuse; create-table and add-columns build on it.

Column Options

Column Types

Supported types: integer, text, string, real, float, blob, datetime, boolean.

API: Helper Functions

[procedure] (row-ref/default key row [default])

Read key from row, returning default when the value is SQL NULL (the symbol null). Signals an error if the key is absent. default is #f when omitted.

(row-ref/default 'name user)            ; => "Alice"
(row-ref/default 'nickname user "N/A")  ; => "N/A" if NULL

[procedure] (row-metadata row [default])

For a row with a metadata TEXT column holding an s-expression alist, parse and return that alist (or default, default '(), when NULL or unparseable).

(row-metadata user)   ; => ((theme . "dark") (language . "en"))

[procedure] (row-metadata-set! row alist)

Write alist to the row's metadata column and return the updated row alist.

(row-metadata-set! user '((theme . "light")))

[procedure] (symbol->db-column sym)
[procedure] (db-column->symbol sym-or-string)

Convert names between Scheme kebab-case and SQL snake_case.

(symbol->db-column 'created-at)   ; => created_at
(db-column->symbol 'created_at)   ; => created-at
(db-column->symbol "created_at")  ; => created-at

The module also exports the lower-level helpers load-table-metadata, register-model!, get-model-metadata, convert-result-keys, convert-results-vector, get-primary-key-columns, build-pk-where, and map-field-names->columns, used internally by the generated functions.

API: Testing (orm-test)

The orm-test module — bundled in the orm egg, no separate install — provides a mock backend for testing code that uses orm-db without a real database.

[procedure] (make-mock-backend)

Returns two values: a backend alist (compatible with db/backend) and a spy procedure for inspecting and controlling the mock.

(import orm-db orm-test)

(receive (backend spy) (make-mock-backend)
  (db/backend backend)
  (db/path "ignored")
  (db/connect)

  ;; Configure responses
  (spy 'on-query (list (vector '((id . 1) (name . "Alice")))))

  (users/all)        ; => #(((id . 1) (name . "Alice")))
  (spy 'queries))    ; => (("SELECT ..." ()))

The spy procedure responds to these messages:

(spy 'queries) — list of (sql params) pairs from all queries
(spy 'executions) — list of (sql params out-key) from all executions
(spy 'on-query responses-or-proc) — set query responses: a list (consumed in order, last item repeats) or a (lambda (sql params) ...)
(spy 'on-execute responses-or-proc) — set execute responses: a list or a (lambda (sql params out-key) ...)
(spy 'reset!) — clear recorded queries and executions

;; Static list of responses (last item repeats forever)
(spy 'on-query (list
  (vector '((id . 1) (name . "Alice")))   ; first query
  (vector)))                               ; all subsequent queries

;; Dynamic responses
(spy 'on-query (lambda (sql params)
  (if (string-contains sql "users")
      (vector '((id . 1) (name . "Alice")))
      (vector))))

Complete Example

(import orm-db orm-db-sqlite orm)

;; 1. Connect
(db/backend (sqlite3-backend))
(db/path "blog.db")
(db/connect)

;; 2. Migrate the schema
(model/migration "001-init"
  (lambda ()
    (model/schema/create-table 'users
      '(id integer (primary-key #t) (autoincrement #t))
      '(name text (not-null #t))
      '(updated-at datetime (default CURRENT_TIMESTAMP)))
    (model/schema/create-table 'posts
      '(id integer (primary-key #t) (autoincrement #t))
      '(user-id integer (foreign-key users id))
      '(title text (not-null #t))
      '(updated-at datetime (default CURRENT_TIMESTAMP))))
  (lambda ()
    (model/schema/drop-table 'posts)
    (model/schema/drop-table 'users)))

(model/migrate)

;; 3. Define models and a relationship
(define-model users)
(define-model posts)
(model/has-many users posts)

;; 4. Use them
(define alice (users/create '((name . "Alice"))))
(users/add-posts alice (posts/create `((title . "Hello") (user-id . ,(alist-ref 'id alice)))))

(users/posts alice)   ; => #(((id . 1) (title . "Hello") ...))

(db/close)

License

Repository

Part of the chicken-orm-egg project.

ORM

Description