forumy stuff

goblins.scm

@@ -0,0 +1,4 @@
+(use-modules (goblins))
+(use-modules (goblins actor-lib methods))
+(use-modules (forum))
+(use-modules (goblins vrun)) ; gives us ,vrun | ,vr for running things in a vat

guile-modules/forum.scm

@@ -0,0 +1,109 @@
+(define-module (forum)
+  #:use-module (goblins)
+  #:use-module (goblins actor-lib methods)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:export (^cell ^user spawn-user spawn-forum-and-admin make-board)
+)
+
+;; (define a-vat (spawn-vat))
+;; (define-vat-run a-run a-vat)
+
+(define (^cell bcom val)
+  (methods
+    ((get)
+      val)
+    ((set new-val)
+     (bcom (^cell bcom new-val))
+     )
+    ((add new-val)
+     (define current-val val)
+     (bcom (^cell bcom (cons new-val current-val)))
+    )
+  )
+)
+
+(define (^cell-list-sealer bcom key value))
+
+(define* (^user bcom #:key name post-count)
+  (methods
+   ((get-name) name)
+   ((get-post-count) post-count)
+   ((inc-post-count) (bcom (^user bcom #:name name #:post-count (+ 1 post-count)))
+   )
+  )
+)
+
+(define* (spawn-user name)
+  (spawn ^user #:name name #:post-count 0)
+  )
+
+(define
+  (spawn-board name)
+  (define name (spawn ^cell name))
+  (define topics (spawn ^cell '()))
+  (define (^board)
+    (methods
+      ((list-topics)
+        ($ topics 'get))
+      ((new-topic #:key title author body)
+        ($ topics 'add (spawn-topic #:title title #:author author #:body body)))
+    )
+  )
+  (spawn ^board name)
+)
+
+(define*
+  (spawn-topic #:key title author body)
+  (define* (^post #:key title author body)
+    (methods
+      ((get) (list title author body))
+    )
+  )
+  (define* posts (spawn ^cell (spawn ^post #:key title author body)))
+  (methods
+    ((get) ($ posts 'get))
+    ((reply #:key title author body) ($ posts 'add (spawn ^post #:key title author body)))
+  )
+)
+
+
+(define* 
+  (spawn-forum-and-admin #:key name first-admin)
+  (define users (spawn ^cell '()))
+  (define admins (spawn ^cell first-admin))
+  (define boards (spawn ^cell '()))
+
+  (define (^forum bcom)
+    (methods
+      ((get-name) name)
+      ((list-boards) ($ boards 'get))
+      ((list-users) ($ users 'get))
+    )
+  )
+
+  (define (^admin bcom)
+    (methods
+      ((user-register new-user)
+        ($ users 'add new-user)
+      )
+      ((board-create new-board-name)
+        ($ boards 'add (spawn-board new-board-name))
+      )
+    )
+  )
+
+  (define forum (spawn ^forum))
+  (define admin (spawn ^admin))
+  (values forum admin)
+)
+
+(define (make-board name)
+  (list (spawn-forum-and-admin #:name name))
+)
+
+;; repl cheat sheet
+;; ,vr (define chest (spawn ^cell "sword"))
+;; ,vr ($ chest 'get)
+;; ,vr ($ chest 'set "beans")