From 0ccdb4217359fc55f0a6eb6287d39b4f18155699 Mon Sep 17 00:00:00 2001
From: Victor Fors <krakow89@gmail.com>
Date: Sat, 22 Jan 2022 21:09:44 +0100
Subject: [PATCH] wtf

---
 database.scm | 90 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 90 insertions(+)
 create mode 100644 database.scm

diff --git a/database.scm b/database.scm
new file mode 100644
index 0000000..e5c0825
--- /dev/null
+++ b/database.scm
@@ -0,0 +1,90 @@
+;;; Database module, serializing kv stores associated with symbols
+;;; to and from s-expressions on file.
+
+(module database (database-set database-get database-save *database* database-load database-remove get-all-objects object-exists? has-property? toggle-flag database-null)
+  (import scheme)
+  (import chicken.io)
+  (import util)
+
+  ;; The global database.
+  (define *database* '())
+
+  ;; This has to exist and be exported in order for the test suite
+  ;; not to trigger warnings.
+  (define (database-null)
+    (set! *database* '()))
+
+  ;; Set KEY associated with symbol NAME to VALUE.
+  (define (database-set name key value)
+    (set! *database* (let loop ((kv *database*))
+		       (if (null? kv)
+			   (list (cons name (list (cons key value))))
+			   (if (equal? name (caar kv))
+			       (cons (cons name (let loop ((kv (cdar kv)))
+						  (if (null? kv)
+						      (list (cons key value))
+						      (if (equal? key (caar kv))
+							  (cons (cons key value) (cdr kv))
+							  (cons (car kv) (loop (cdr kv))))))) (cdr kv))
+			       (cons (car kv) (loop (cdr kv))))))))
+
+  ;; Get KEY associated with symbol NAME, returning DEFAULT if it doesn't exist.
+  (define (database-get name key default)
+    (let loop ((kv *database*))
+      (if (null? kv)
+	  default
+	  (if (equal? name (caar kv))
+	      (let loop ((kv (cdar kv)))
+		(if (null? kv)
+		    default
+		    (if (equal? key (caar kv))
+			(cdar kv)
+			(loop (cdr kv)))))
+	      (loop (cdr kv))))))
+
+  ;; Save database to a file, in s-expression format.
+  (define (database-save filename)
+    (with-output-to-file filename (thunk (write *database*))))
+
+  ;; Load database from a file.
+  (define (database-load filename)
+    (with-input-from-file filename (thunk (set! *database* (car (read-list))))))
+
+  ;; Remove all associations from symbol NAME from database.
+  (define (database-remove name)
+    (set! *database* (let loop ((kv *database*))
+		       (if (null? kv)
+			   '()
+			   (if (equal? name (caar kv))
+			       (cdr kv)
+			       (cons (car kv) (loop (cdr kv))))))))
+
+  ;; Get a list of all symbols in the database.
+  (define (get-all-objects)
+    (map car *database*))
+
+  ;; Does a symbol exist in the database, e.g. is there
+  ;; a symbol that has values associated with it in the database?
+  (define (object-exists? object)
+    (list? (member object (get-all-objects))))
+
+  ;; Is there a value PROPERTY associated with the symbol OBJECT?
+  (define (has-property? object property)
+    (let loop ((kv *database*))
+      (if (null? kv)
+	  #f
+	  (if (eq? (caar kv) object)
+	      (let loop ((kv (cdar kv)))
+		(if (null? kv)
+		    #f
+		    (if (eq? (caar kv) property)
+			#t
+			(loop (cdr kv)))))
+	      (loop (cdr kv))))))
+
+  ;; If OBJECT has a value FLAG that is unset or false, set it to true.
+  ;; Else set it to false.
+  (define (toggle-flag object flag)
+    (if (database-get object flag #f)
+	(database-set object flag #f)
+	(database-set object flag #t))))