Initial commit

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.

examples/blog-site/model.scm

@@ -0,0 +1,144 @@
+(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)))))