8sync/repl.scm

   1 ;;; 8sync --- Asynchronous programming for Guile
   2 ;;; Copyright © 2015, 2016, 2017 Christopher Allan Webber <cwebber@dustycloud.org>
   3 ;;;
   4 ;;; This file is part of 8sync.
   5 ;;;
   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.
  10 ;;;
  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.
  15 ;;;
  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/>.
  18
  19 (define-module (8sync repl)
  20   #:use-module (oop goops)
  21   #:use-module (8sync)
  22   #:use-module (fibers)
  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>
  29             spawn-repl))
  30
  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"
  37         #:getter .path)
  38   (socket #:init-value #f
  39           #:accessor .socket)
  40   (poll-every #:init-keyword #:poll-every
  41               #:init-value (/ 1 30)
  42               #:getter .poll-every)
  43   (subscribers #:init-keyword #:subscribers
  44                #:init-value '()
  45                #:accessor .subscribers))
  46
  47 (define-method (actor-cleanup! (repl-manager <repl-manager>))
  48   ;; Close the socket, if open
  49   (and=> (.socket repl-manager)
  50          close)
  51   ;; Delete the file, if it exists
  52   (when (file-exists? (.path repl-manager))
  53     (delete-file (.path repl-manager))))
  54
  55 (define-method (actor-init! (repl-manager <repl-manager>))
  56   (<- (actor-id repl-manager) 'main-loop))
  57
  58 (define-method (repl-manager-main-loop repl-manager message)
  59   (define socket
  60     (make-unix-domain-server-socket #:path (.path repl-manager)))
  61   (define server
  62     (spawn-coop-repl-server socket))
  63   (define (inform-subscribers)
  64     (for-each
  65      (lambda (subscriber)
  66        (<- subscriber 'repl-update))
  67      (.subscribers repl-manager)))
  68   (set! (.socket repl-manager) socket)
  69   (while #t
  70     (daydream (.poll-every repl-manager))
  71     (poll-coop-repl-server server)
  72     (inform-subscribers)))
  73
  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)))))
  79
  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))))
  85
  86 \f
  87
  88 (define* (spawn-repl #:key (path "/tmp/8sync-socket")
  89                      (socket (make-unix-domain-server-socket #:path path))
  90                      (poll-every 1/30)
  91                      (stop? (make-atomic-box #f))
  92                      (on-update #f))
  93   "Spawn a cooperative REPL in a new fiber."
  94   (define server
  95     (spawn-coop-repl-server socket))
  96   (spawn-fiber
  97    (lambda ()
  98      (while (not (atomic-box-ref stop?))
  99        ;; Poll the server
 100        (poll-coop-repl-server server)
 101        ;; Call update hook, if any
 102        (and on-update (on-update))
 103        ;; Take a break!
 104        (sleep poll-every))
 105      (close socket))))