Christopher Baines
5b0e6397dc
All checks were successful
/ test (push) Successful in 9s
Safsaf is a Guile web framework, written using Claude Code running Claude Opus 4.6, based off of the Guix Data Service, Nar Herder and Guix Build Coordinator codebases.
144 lines
4.3 KiB
Scheme
144 lines
4.3 KiB
Scheme
(define-module (model)
|
|
#:use-module (knots thread-pool)
|
|
#:use-module (sqlite3)
|
|
#:export (make-db
|
|
call-with-db
|
|
db-init!
|
|
db-list-posts
|
|
db-get-post
|
|
db-create-post!
|
|
db-update-post!
|
|
db-delete-post!))
|
|
|
|
;;;
|
|
;;; Connection pool
|
|
;;;
|
|
|
|
(define* (make-db database-file #:key (pool-size 4))
|
|
"Create a thread pool where each thread holds an open SQLite
|
|
connection to DATABASE-FILE."
|
|
(make-fixed-size-thread-pool
|
|
pool-size
|
|
#:name "sqlite"
|
|
#:thread-initializer
|
|
(lambda ()
|
|
(let ((db (sqlite-open database-file
|
|
(logior SQLITE_OPEN_READWRITE
|
|
SQLITE_OPEN_CREATE))))
|
|
(sqlite-busy-timeout db 5000)
|
|
(sqlite-exec db "PRAGMA journal_mode=WAL")
|
|
(sqlite-exec db "PRAGMA foreign_keys=ON")
|
|
(list db)))
|
|
#:thread-destructor
|
|
(lambda (db)
|
|
(sqlite-close db))))
|
|
|
|
(define (call-with-db pool proc)
|
|
"Run (PROC db) on a thread from POOL, where DB is the thread's
|
|
SQLite connection. Returns whatever PROC returns."
|
|
(call-with-thread pool
|
|
(lambda (db)
|
|
(proc db))))
|
|
|
|
;;;
|
|
;;; Schema
|
|
;;;
|
|
|
|
(define (db-init! pool)
|
|
"Create the schema if it doesn't exist."
|
|
(call-with-db pool
|
|
(lambda (db)
|
|
(sqlite-exec db "
|
|
CREATE TABLE IF NOT EXISTS posts (
|
|
id INTEGER PRIMARY KEY AUTOINCREMENT,
|
|
title TEXT NOT NULL,
|
|
body TEXT NOT NULL,
|
|
image_url TEXT,
|
|
created_at TEXT NOT NULL DEFAULT (datetime('now'))
|
|
)"))))
|
|
|
|
;;;
|
|
;;; Row conversions
|
|
;;;
|
|
|
|
(define (row->post-summary row)
|
|
"Convert a list-view row (vector) to an alist."
|
|
`((id . ,(vector-ref row 0))
|
|
(title . ,(vector-ref row 1))
|
|
(created-at . ,(vector-ref row 2))))
|
|
|
|
(define (row->post row)
|
|
"Convert a detail-view row (vector) to an alist."
|
|
`((id . ,(vector-ref row 0))
|
|
(title . ,(vector-ref row 1))
|
|
(body . ,(vector-ref row 2))
|
|
(image-url . ,(vector-ref row 3))
|
|
(created-at . ,(vector-ref row 4))))
|
|
|
|
;;;
|
|
;;; Queries
|
|
;;;
|
|
|
|
(define (db-list-posts pool)
|
|
"Return all posts as a list of alists (id, title, created-at),
|
|
newest first."
|
|
(call-with-db pool
|
|
(lambda (db)
|
|
(let ((stmt (sqlite-prepare db
|
|
"SELECT id, title, created_at FROM posts ORDER BY id DESC")))
|
|
(let ((rows (sqlite-map row->post-summary stmt)))
|
|
(sqlite-finalize stmt)
|
|
rows)))))
|
|
|
|
(define (db-get-post pool id)
|
|
"Return the post with ID as an alist, or #f if not found."
|
|
(call-with-db pool
|
|
(lambda (db)
|
|
(let ((stmt (sqlite-prepare db
|
|
"SELECT id, title, body, image_url, created_at
|
|
FROM posts WHERE id = ?")))
|
|
(sqlite-bind stmt 1 id)
|
|
(let ((row (sqlite-step stmt)))
|
|
(sqlite-finalize stmt)
|
|
(and row (row->post row)))))))
|
|
|
|
(define (db-create-post! pool title body image-url)
|
|
"Insert a new post and return its ID."
|
|
(call-with-db pool
|
|
(lambda (db)
|
|
(let ((stmt (sqlite-prepare db
|
|
"INSERT INTO posts (title, body, image_url) VALUES (?, ?, ?)")))
|
|
(sqlite-bind stmt 1 title)
|
|
(sqlite-bind stmt 2 body)
|
|
(sqlite-bind stmt 3 image-url)
|
|
(sqlite-step stmt)
|
|
(sqlite-finalize stmt)
|
|
(let ((stmt (sqlite-prepare db "SELECT last_insert_rowid()")))
|
|
(let ((row (sqlite-step stmt)))
|
|
(sqlite-finalize stmt)
|
|
(vector-ref row 0)))))))
|
|
|
|
(define (db-update-post! pool id title body image-url)
|
|
"Update the post with ID. Returns #t if a row was changed, #f otherwise."
|
|
(call-with-db pool
|
|
(lambda (db)
|
|
(let ((stmt (sqlite-prepare db
|
|
"UPDATE posts SET title = ?, body = ?, image_url = ?
|
|
WHERE id = ?")))
|
|
(sqlite-bind stmt 1 title)
|
|
(sqlite-bind stmt 2 body)
|
|
(sqlite-bind stmt 3 image-url)
|
|
(sqlite-bind stmt 4 id)
|
|
(sqlite-step stmt)
|
|
(sqlite-finalize stmt)
|
|
(> (sqlite-changes db) 0)))))
|
|
|
|
(define (db-delete-post! pool id)
|
|
"Delete the post with ID. Returns #t if a row was deleted, #f otherwise."
|
|
(call-with-db pool
|
|
(lambda (db)
|
|
(let ((stmt (sqlite-prepare db "DELETE FROM posts WHERE id = ?")))
|
|
(sqlite-bind stmt 1 id)
|
|
(sqlite-step stmt)
|
|
(sqlite-finalize stmt)
|
|
(> (sqlite-changes db) 0)))))
|