diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | community-garden.scm | 11 | ||||
| -rw-r--r-- | community-garden/actors.scm | 29 | ||||
| -rw-r--r-- | community-garden/edit.scm | 38 | ||||
| -rw-r--r-- | configure.ac | 1 | ||||
| -rw-r--r-- | guix.scm | 4 | ||||
| -rwxr-xr-x | scripts/edit-garden | 6 | ||||
| -rwxr-xr-x | scripts/edit-garden.in | 6 |
8 files changed, 86 insertions, 10 deletions
diff --git a/Makefile.am b/Makefile.am index de95d08..a93a305 100644 --- a/Makefile.am +++ b/Makefile.am @@ -26,4 +26,5 @@ SOURCES = \ community-garden/garden-bed.scm \ community-garden/actors.scm \ community-garden/view.scm \ + community-garden/edit.scm \ community-garden.scm diff --git a/community-garden.scm b/community-garden.scm index a121b39..5c8c383 100644 --- a/community-garden.scm +++ b/community-garden.scm @@ -16,6 +16,9 @@ (community-garden view) (goblins) (goblins vrun) + (goblins ocapn ids) + (goblins ocapn captp) + (goblins ocapn netlayer onion) (ice-9 atomic) (oop goops)) @@ -25,7 +28,6 @@ (define-vat-run garden-run garden-vat) (define-vat-run catbird-run catbird-vat) (define-vat-run alice-run alice-vat) - (define the-botanist (garden-run (spawn ^botanist))) (define the-garden-gate (garden-run (spawn ^garden-gate the-botanist))) (define sunflower/approved @@ -38,6 +40,13 @@ "Spritely Institute Community Garden" (make-garden-bed 8 8) the-garden-gate))) +(define onion-netlayer (garden-run (new-onion-netlayer))) +(define mycapn + (garden-run + (let* ((mycapn (spawn-mycapn onion-netlayer)) + (garden-sref ($ mycapn 'register our-garden 'onion))) + (format #t "edit-garden Dave ~a\n" (ocapn-id->string garden-sref)) + mycapn))) (define alice (alice-run (spawn ^gardener "Alice" our-garden))) (alice-run ($ alice 'plant 1 1 sunflower/approved)) diff --git a/community-garden/actors.scm b/community-garden/actors.scm index b34d1f8..f0b3240 100644 --- a/community-garden/actors.scm +++ b/community-garden/actors.scm @@ -1,7 +1,10 @@ (define-module (community-garden actors) #:use-module (community-garden garden-bed) + #:use-module (community-garden plant) #:use-module (goblins) + #:use-module (goblins actor-lib cell) #:use-module (goblins actor-lib methods) + #:use-module (goblins actor-lib sealers) #:use-module (goblins utils simple-sealers) #:export (^botanist ^garden-gate @@ -9,36 +12,48 @@ ^visitor ^gardener)) -(define (^botanist bcom) +(define* (^botanist _bcom) + (define registry (spawn ^cell '())) (define-values (seal-plant unseal-plant approved-plant?) - (make-sealer-triplet)) + (spawn-sealer-triplet)) (methods ((approve-plant plant) - (seal-plant plant)) + (let ((sealed-plant ($ seal-plant plant))) + ($ registry (cons sealed-plant ($ registry))) + sealed-plant)) ((check-plant plant) - (if (approved-plant? plant) - (unseal-plant plant) - (error "plant is not allowed" plant))))) + (if ($ approved-plant? plant) + ($ unseal-plant plant) + (error "plant is not allowed" plant))) + ((approved-plants) + ($ registry)))) (define (^garden-gate bcom botanist) (methods ((check-plant plant) - ($ botanist 'check-plant plant)))) + ($ botanist 'check-plant plant)) + ((approved-plants) + ($ botanist 'approved-plants)))) (define (^garden bcom name garden-bed garden-gate) (define (ensure-empty x y) (when (garden-bed-ref garden-bed x y) + (format #t "tried to plant in occupied tile (~a, ~a)\n" x y) (error "tile already has something planted in it" x y))) (methods ((get-name) name) ((get-bed) garden-bed) + ((get-approved-plants) + ($ garden-gate 'approved-plants)) ((plant x y sealed-plant) (ensure-empty x y) (let* ((plant ($ garden-gate 'check-plant sealed-plant)) (new-bed (garden-bed-set garden-bed x y plant))) + (format #t "planted ~a in tile (~a, ~a)\n" (plant-name plant) x y) (bcom (^garden bcom name new-bed garden-gate)))) ((dig-up x y) (let ((new-bed (garden-bed-set garden-bed x y #f))) + (format #t "dug up tile (~a, ~a)\n" x y) (bcom (^garden bcom name new-bed garden-gate)))))) (define (^visitor bcom name garden) diff --git a/community-garden/edit.scm b/community-garden/edit.scm new file mode 100644 index 0000000..9e56f87 --- /dev/null +++ b/community-garden/edit.scm @@ -0,0 +1,38 @@ +(define-module (community-garden edit) + #:use-module (community-garden actors) + #:use-module (goblins) + #:use-module (goblins vrun) + #:use-module (goblins ocapn ids) + #:use-module (goblins ocapn captp) + #:use-module (goblins ocapn netlayer onion) + #:use-module (ice-9 match) + #:export (edit-garden)) + +(define (edit-garden name garden-address) + (define garden-sref (string->ocapn-id garden-address)) + (define vat (spawn-vat)) + (define-vat-run vat-run vat) + (define onion-netlayer (vat-run (new-onion-netlayer))) + (define mycapn (vat-run (spawn-mycapn onion-netlayer))) + (define garden-vow (vat-run ($ mycapn 'enliven garden-sref))) + (define approved-plants-vow (vat-run (<- garden-vow 'get-approved-plants))) + (define gardener (vat-run (spawn ^gardener name garden-vow))) + (define running? #t) + (while running? + (match (read) + (('quit) + (set! running? #f)) + (('get-garden-name) + (vat-run (on ($ gardener 'get-garden-name) + (lambda (name) + (format #t "~a\n" name))))) + (('dig-up x y) + (vat-run ($ gardener 'dig-up x y))) + (('plant x y) + (vat-run + (on approved-plants-vow + (match-lambda + ((plant . _) + ($ gardener 'plant plant x y)))))) + (exp + (format #t "unrecognized command: ~a\n" exp))))) diff --git a/configure.ac b/configure.ac index c2b17c8..a5c4ae3 100644 --- a/configure.ac +++ b/configure.ac @@ -7,6 +7,7 @@ AM_SILENT_RULES([yes]) AC_PATH_PROG([GUILE], [guile]) AC_CONFIG_FILES([Makefile]) AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env]) +AC_CONFIG_FILES([scripts/edit-garden], [chmod +x scripts/edit-garden]) GUILE_PKG([3.0]) GUILE_PROGS @@ -178,11 +178,11 @@ Scheme. It contains all of the basic components needed to develop (method git-fetch) (uri (git-reference (url "https://gitlab.com/spritely/guile-goblins.git") - (commit "43ab238443aca53ed8c935a9d2d2bf309416af5d"))) + (commit "5bd72a910ea16ad6179a6de03e326527f29fad3e"))) (file-name (string-append name "-" version)) (sha256 (base32 - "196pkmi0qmxjwfmfs039mk3vwz7n8g52r1ykfbfa9lvlsqgq8dni")))))) + "1vp0d73nkzg9fkpd992irdbysdifdd0gf8jx01jhhiy216xv8hp9")))))) (define %source-dir (dirname (current-filename))) diff --git a/scripts/edit-garden b/scripts/edit-garden new file mode 100755 index 0000000..d546526 --- /dev/null +++ b/scripts/edit-garden @@ -0,0 +1,6 @@ +#!/gnu/store/8ykipj6vnk7ykdcjd3p330312n9n49qc-profile/bin/guile --no-auto-compile +-*- scheme -*- +!# +(use-modules (community-garden edit)) + +(apply edit-garden (cdr (command-line))) diff --git a/scripts/edit-garden.in b/scripts/edit-garden.in new file mode 100755 index 0000000..f01d312 --- /dev/null +++ b/scripts/edit-garden.in @@ -0,0 +1,6 @@ +#!@GUILE@ --no-auto-compile +-*- scheme -*- +!# +(use-modules (community-garden edit)) + +(apply edit-garden (cdr (command-line))) |