1 ;;; 8sync --- Asynchronous programming for Guile
2 ;;; Copyright © 2015, 2016, 2017 Christopher Allan Webber <cwebber@dustycloud.org>
4 ;;; This file is part of 8sync.
6 ;;; 8sync is free software: you can redistribute it and/or modify it
7 ;;; under the terms of the GNU Lesser General Public License as
8 ;;; published by the Free Software Foundation, either version 3 of the
9 ;;; License, or (at your option) any later version.
11 ;;; 8sync is distributed in the hope that it will be useful,
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU Lesser General Public License for more details.
16 ;;; You should have received a copy of the GNU Lesser General Public
17 ;;; License along with 8sync. If not, see <http://www.gnu.org/licenses/>.
19 (define-module (8sync repl)
20 #:use-module (oop goops)
23 #:use-module (8sync daydream)
24 #:use-module (srfi srfi-1)
25 #:use-module (ice-9 atomic)
26 #:use-module (system repl server)
27 #:use-module (system repl coop-server)
28 #:export (<repl-manager>
31 (define-actor <repl-manager> (<actor>)
32 ((add-subscriber repl-manager-add-subscriber)
33 (remove-subscriber repl-manager-remove-subscriber)
34 (main-loop repl-manager-main-loop))
35 (path #:init-keyword #:path
36 #:init-value "/tmp/8sync-socket"
38 (socket #:init-value #f
40 (poll-every #:init-keyword #:poll-every
43 (subscribers #:init-keyword #:subscribers
45 #:accessor .subscribers))
47 (define-method (actor-cleanup! (repl-manager <repl-manager>))
48 ;; Close the socket, if open
49 (and=> (.socket repl-manager)
51 ;; Delete the file, if it exists
52 (when (file-exists? (.path repl-manager))
53 (delete-file (.path repl-manager))))
55 (define-method (actor-init! (repl-manager <repl-manager>))
56 (<- (actor-id repl-manager) 'main-loop))
58 (define-method (repl-manager-main-loop repl-manager message)
60 (make-unix-domain-server-socket #:path (.path repl-manager)))
62 (spawn-coop-repl-server socket))
63 (define (inform-subscribers)
66 (<- subscriber 'repl-update))
67 (.subscribers repl-manager)))
68 (set! (.socket repl-manager) socket)
70 (daydream (.poll-every repl-manager))
71 (poll-coop-repl-server server)
72 (inform-subscribers)))
74 (define (repl-manager-add-subscriber repl-manager message)
75 (define from (message-from message))
76 (unless (member from (.subscribers repl-manager))
77 (set! (.subscribers repl-manager)
78 (cons from (.subscribers repl-manager)))))
80 (define (repl-manager-remove-subscriber repl-manager message)
81 (define from (message-from message))
82 (set! (.subscribers repl-manager)
83 (remove (lambda (x) (equal? x (message-from message)))
84 (.subscribers repl-manager))))
88 (define* (spawn-repl #:key (path "/tmp/8sync-socket")
89 (socket (make-unix-domain-server-socket #:path path))
91 (stop? (make-atomic-box #f))
93 "Spawn a cooperative REPL in a new fiber."
95 (spawn-coop-repl-server socket))
98 (while (not (atomic-box-ref stop?))
100 (poll-coop-repl-server server)
101 ;; Call update hook, if any
102 (and on-update (on-update))