~williewillus/public-inbox

3 2

[PATCH r16] Create JSON (symbol->)+string database module

Alwinfy
Details
Message ID
<a7475ce8-6196-63c0-d485-61467b382a94@gmail.com>
DKIM signature
pass
Download raw message
As of yet unintegrated, but here you go:


 From 1bfd596e70ae258872096d49bcda98b601114161 Mon Sep 17 00:00:00 2001
From: Alwinfy <20421383+Alwinfy@users.noreply.github.com>
Date: Mon, 1 Feb 2021 18:49:40 -0600
Subject: [PATCH] Create JSON (symbol->)+string database

---
  json-db.rkt | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++
  1 file changed, 76 insertions(+)
  create mode 100644 json-db.rkt

diff --git a/json-db.rkt b/json-db.rkt
new file mode 100644
index 0000000..8aea045
--- /dev/null
+++ b/json-db.rkt
@@ -0,0 +1,76 @@
+#lang racket
+
+(require json racket/contract)
+(define opt-string/c (or/c #f string?))
+(provide
+  (contract-out
+    (make-db (-> path-string? database?))
+    (read-entry (-> database? symbol? symbol? ... opt-string/c))
+    (make-entry! (-> database? (-> string?) symbol? symbol? ... 
opt-string/c))
+    (update-entry! (-> database? (-> string?) symbol? symbol? ... 
opt-string/c))
+    (remove-entry! (-> database? symbol? symbol? ... opt-string/c))
+    (commit-db! (->* (database?) ((or/c #f (-> exn? any/c))) boolean?))))
+
+(struct database (data file (dirty #:mutable) lock))
+
+(define (try-read-json file default)
+  (let ((data (with-handlers ([exn:fail? (thunk* (default))])
+                (hash-copy (read-json (open-input-file file))))))
+    (if (eof-object? data) (default) data)))
+
+(define (make-db filename)
+  (database
+    (try-read-json filename make-hash)
+    filename
+    #f
+    (make-semaphore 1)))
+
+(define (locate-entry! db path)
+  (let loop ((body (database-data db)) (path path))
+    (if (null? (cdr path))
+      (values body (car path))
+      (loop (hash-ref! body (car path) (make-hash)) (cdr path)))))
+
+(define-syntax-rule (with-db-lock db . body)
+  (call-with-semaphore (database-lock db) (thunk . body)))
+
+(define (read-entry db . path)
+  (with-db-lock db
+    (foldl
+      (lambda (path table)
+        (and table (hash-ref table path #f)))
+      (database-data db)
+      path)))
+
+(define (make-entry! db supplier . path)
+  (with-db-lock db
+    (let-values (((hash key) (locate-entry! db path)))
+      (and (not (hash-has-key? hash key))
+        (set-database-dirty! db #t)
+        (hash-ref! hash key supplier)))))
+
+(define (update-entry! db supplier . path)
+  (with-db-lock db
+    (let-values (((hash key) (locate-entry! db path)))
+      (let ((old-val (hash-ref hash key #f)))
+        (set-database-dirty! db #t)
+        (hash-set! hash key (supplier))
+        old-val))))
+
+(define (remove-entry! db supplier . path)
+  (with-db-lock db
+    (let-values (((hash key) (locate-entry! db path)))
+      (let ((old-val (hash-ref hash key #f)))
+        (set-database-dirty! db #t)
+        (hash-remove! hash key)
+        old-val))))
+
+(define (commit-db! db (error-callback #f))
+  (with-db-lock db
+    (and (database-dirty db)
+      (with-handlers ((exn:fail? (lambda (e) (when error-callback 
(error-callback e)) #f)))
+        (call-with-atomic-output-file (database-file db)
+          (lambda (port _)
+            (write-json (database-data db) port)
+            (set-database-dirty! db #f)
+            #t))))))
-- 
2.25.1
Details
Message ID
<87wnvrjl12.fsf@vincent-lee.net>
In-Reply-To
<a7475ce8-6196-63c0-d485-61467b382a94@gmail.com> (view parent)
DKIM signature
pass
Download raw message
Alwinfy writes:

> As of yet unintegrated, but here you go:
>
>
> From 1bfd596e70ae258872096d49bcda98b601114161 Mon Sep 17 00:00:00 2001
> From: Alwinfy <20421383+Alwinfy@users.noreply.github.com>
> Date: Mon, 1 Feb 2021 18:49:40 -0600
> Subject: [PATCH] Create JSON (symbol->)+string database
>
> ---
>  json-db.rkt | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++
>  1 file changed, 76 insertions(+)
>  create mode 100644 json-db.rkt
>
> diff --git a/json-db.rkt b/json-db.rkt
> new file mode 100644
> index 0000000..8aea045
> --- /dev/null
> +++ b/json-db.rkt
> @@ -0,0 +1,76 @@
> +#lang racket
> +
> +(require json racket/contract)
> +(define opt-string/c (or/c #f string?))
> +(provide
> +  (contract-out
> +    (make-db (-> path-string? database?))
> +    (read-entry (-> database? symbol? symbol? ... opt-string/c))
> +    (make-entry! (-> database? (-> string?) symbol? symbol?
> ... opt-string/c))
> +    (update-entry! (-> database? (-> string?) symbol? symbol?
> ... opt-string/c))
> +    (remove-entry! (-> database? symbol? symbol? ... opt-string/c))
> +    (commit-db! (->* (database?) ((or/c #f (-> exn? any/c))) boolean?))))
> +
> +(struct database (data file (dirty #:mutable) lock))
Let's call this `filename`
> +
> +(define (try-read-json file default)
> +  (let ((data (with-handlers ([exn:fail? (thunk* (default))])
> +                (hash-copy (read-json (open-input-file file))))))
> +    (if (eof-object? data) (default) data)))
> +
> +(define (make-db filename)
> +  (database
> +    (try-read-json filename make-hash)
> +    filename
> +    #f
> +    (make-semaphore 1)))
> +
> +(define (locate-entry! db path)
> +  (let loop ((body (database-data db)) (path path))
> +    (if (null? (cdr path))
> +      (values body (car path))
> +      (loop (hash-ref! body (car path) (make-hash)) (cdr path)))))
I don't really understand why there's a loop here, shouldn't the db just
be guild -> trickname -> trick body? I'd rather just write those two
levels of traversal out instead of a whole path loop.
In general, I'm not quite sure what the data model of the db is from
reading the code.

On a related note, tricks should probably be a struct instead of just a
string, so we can associate metadata with it (owner, etc.)
> +
> +(define-syntax-rule (with-db-lock db . body)
> +  (call-with-semaphore (database-lock db) (thunk . body)))
> +
> +(define (read-entry db . path)
> +  (with-db-lock db
> +    (foldl
> +      (lambda (path table)
> +        (and table (hash-ref table path #f)))
> +      (database-data db)
> +      path)))
> +
> +(define (make-entry! db supplier . path)
> +  (with-db-lock db
> +    (let-values (((hash key) (locate-entry! db path)))
> +      (and (not (hash-has-key? hash key))
> +        (set-database-dirty! db #t)
> +        (hash-ref! hash key supplier)))))
> +
> +(define (update-entry! db supplier . path)
why a supplier? (same for above)
> +  (with-db-lock db
> +    (let-values (((hash key) (locate-entry! db path)))
> +      (let ((old-val (hash-ref hash key #f)))
> +        (set-database-dirty! db #t)
> +        (hash-set! hash key (supplier))
> +        old-val))))
> +
> +(define (remove-entry! db supplier . path)
unused supplier param?
> +  (with-db-lock db
> +    (let-values (((hash key) (locate-entry! db path)))
> +      (let ((old-val (hash-ref hash key #f)))
> +        (set-database-dirty! db #t)
> +        (hash-remove! hash key)
> +        old-val))))
> +
> +(define (commit-db! db (error-callback #f))
> +  (with-db-lock db
> +    (and (database-dirty db)
> +      (with-handlers ((exn:fail? (lambda (e) (when error-callback
> (error-callback e)) #f)))
> +        (call-with-atomic-output-file (database-file db)
> +          (lambda (port _)
> +            (write-json (database-data db) port)
> +            (set-database-dirty! db #f)
> +            #t))))))
Alwinfy
Details
Message ID
<39711919-f343-0eb3-bf8c-db4bc33b9f63@gmail.com>
In-Reply-To
<87wnvrjl12.fsf@vincent-lee.net> (view parent)
DKIM signature
pass
Download raw message
 > Let's call this `filename`

gotcha


> I don't really understand why there's a loop here, shouldn't the db just
> be guild -> trickname -> trick body? I'd rather just write those two
> levels of traversal out instead of a whole path loop.
> In general, I'm not quite sure what the data model of the db is from
> reading the code.
The general idea here is that it's a subset of JSON: only objects and strings allowed.
Recursion is there because ~~I'm a mathematician~~something something extensibility.

> On a related note, tricks should probably be a struct instead of just a
> string, so we can associate metadata with it (owner, etc.)
Go three levels deep: `(read-entry db guild trickname 'name)` :tinypotato:
Perhaps functions for batched read/write wouldn't be amiss...

> why a supplier? (same for above)
`make` and `update` are both conditional, and it honestly costs callers nothing to just say `(thunk expr)`

> unused supplier param?
I am a dumb thank you very much
Details
Message ID
<87tuqvjjkq.fsf@vincent-lee.net>
In-Reply-To
<39711919-f343-0eb3-bf8c-db4bc33b9f63@gmail.com> (view parent)
DKIM signature
pass
Download raw message
Alwinfy writes:

>> Let's call this `filename`
>
> gotcha
>
>
>> I don't really understand why there's a loop here, shouldn't the db just
>> be guild -> trickname -> trick body? I'd rather just write those two
>> levels of traversal out instead of a whole path loop.
>> In general, I'm not quite sure what the data model of the db is from
>> reading the code.
> The general idea here is that it's a subset of JSON: only objects and strings allowed.
> Recursion is there because ~~I'm a mathematician~~something something extensibility.
>
I'd much rather keep it simple so we can understand it later:
the db is a map of guild id (int) -> map of trick name (string) -> trick
struct.
Also I'm not sure why trick names are symbols, they're going to be strings
at runtime so converting to symbols is just wasted effort.
(As an aside, idk how the json library works but racket/serialize should
be able to handle any Plain Old Racket Object thrown at it)
>> On a related note, tricks should probably be a struct instead of just a
>> string, so we can associate metadata with it (owner, etc.)
> Go three levels deep: `(read-entry db guild trickname 'name)` :tinypotato:
> Perhaps functions for batched read/write wouldn't be amiss...
>
Let's have it be typed/structured instead of a blob of junk inside the maps.
Reply to thread Export thread (mbox)