breezewiki/archiver/archiver-database.rkt

83 lines
3.1 KiB
Racket
Raw Permalink Normal View History

#lang racket/base
(require racket/file
racket/list
racket/path
racket/string
json
json-pointer
db
"../lib/syntax.rkt")
(provide
get-slc
query-exec*
query-rows*
query-list*
query-value*
query-maybe-value*
query-maybe-row*)
(define storage-path (anytime-path ".." "storage"))
(define database-file (build-path storage-path "archiver.db"))
(define slc (box #f))
(define (get-slc)
(define slc* (unbox slc))
(cond
[slc* slc*]
[else
(make-directory* storage-path)
(define slc* (sqlite3-connect #:database database-file #:mode 'create))
(query-exec slc* "PRAGMA journal_mode=WAL")
(define database-version
(with-handlers ([exn:fail:sql?
(λ (exn)
; need to set up the database
(query-exec slc* "create table database_version (version integer, primary key (version))")
(query-exec slc* "insert into database_version values (0)")
0)])
(query-value slc* "select version from database_version")))
2023-03-20 10:32:31 +00:00
(define migrations
(wrap-sql
((query-exec slc* "create table page (wikiname TEXT NOT NULL, basename TEXT NOT NULL, progress INTEGER NOT NULL, PRIMARY KEY (wikiname, basename))")
(query-exec slc* "create table wiki (wikiname TEXT NOT NULL, progress INTEGER, PRIMARY KEY (wikiname))"))
((query-exec slc* "create table special_page (wikiname TEXT NOT NULL, key TEXT NOT NULL, basename TEXT NOT NULL, PRIMARY KEY (wikiname, key))"))
((query-exec slc* "update wiki set progress = 2 where wikiname in (select wikiname from wiki inner join page using (wikiname) group by wikiname having min(page.progress) = 1)"))
((query-exec slc* "create table image (wikiname TEXT NOT NULL, hash TEXT NTO NULL, url TEXT NOT NULL, ext TEXT, source INTEGER NOT NULL, progress INTEGER NOT NULL, PRIMARY KEY (wikiname, hash))"))
((query-exec slc* "alter table wiki add column sitename TEXT")
(query-exec slc* "alter table wiki add column basepage TEXT")
(query-exec slc* "alter table wiki add column license_text TEXT")
2023-12-11 22:10:47 +00:00
(query-exec slc* "alter table wiki add column license_url TEXT"))
((query-exec slc* "alter table page add column redirect"))))
2023-03-20 10:32:31 +00:00
(let do-migrate-step ()
(when (database-version . < . (length migrations))
(call-with-transaction
slc*
(list-ref migrations database-version))
(set! database-version (add1 database-version))
(query-exec slc* "update database_version set version = $1" database-version)
(do-migrate-step)))
(set-box! slc slc*)
slc*]))
(define (query-exec* . args)
(apply query-exec (get-slc) args))
(define (query-rows* . args)
(apply query-rows (get-slc) args))
(define (query-list* . args)
(apply query-list (get-slc) args))
(define (query-value* . args)
(apply query-value (get-slc) args))
(define (query-maybe-value* . args)
(apply query-maybe-value (get-slc) args))
(define (query-maybe-row* . args)
(apply query-maybe-row (get-slc) args))