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 (8sync daydream)
  23   #:use-module (srfi srfi-1)
  24   #:use-module (system repl server)
  25   #:use-module (system repl coop-server)
  26   #:export (<repl-manager>))
  27
  28 (define-actor <repl-manager> (<actor>)
  29   ((add-subscriber repl-manager-add-subscriber)
  30    (remove-subscriber repl-manager-remove-subscriber)
  31    (main-loop repl-manager-main-loop))
  32   (path #:init-keyword #:path
  33         #:init-value "/tmp/8sync-socket"
  34         #:getter .path)
  35   (socket #:init-value #f
  36           #:accessor .socket)
  37   (poll-every #:init-keyword #:poll-every
  38               #:init-value (/ 1 30)
  39               #:getter .poll-every)
  40   (subscribers #:init-keyword #:subscribers
  41                #:init-value '()
  42                #:accessor .subscribers))
  43
  44 (define-method (actor-cleanup! (repl-manager <repl-manager>))
  45   ;; Close the socket, if open
  46   (and=> (.socket repl-manager)
  47          close)
  48   ;; Delete the file, if it exists
  49   (when (file-exists? (.path repl-manager))
  50     (delete-file (.path repl-manager))))
  51
  52 (define-method (actor-init! (repl-manager <repl-manager>))
  53   (<- (actor-id repl-manager) 'main-loop))
  54
  55 (define-method (repl-manager-main-loop repl-manager message)
  56   (define socket
  57     (make-unix-domain-server-socket #:path (.path repl-manager)))
  58   (define server
  59     (spawn-coop-repl-server socket))
  60   (define (inform-subscribers)
  61     (for-each
  62      (lambda (subscriber)
  63        (<- subscriber 'repl-update))
  64      (.subscribers repl-manager)))
  65   (set! (.socket repl-manager) socket)
  66   (while (actor-alive? repl-manager)
  67     (daydream (.poll-every repl-manager))
  68     (poll-coop-repl-server server)
  69     (inform-subscribers)))
  70
  71 (define (repl-manager-add-subscriber repl-manager message)
  72   (define from (message-from message))
  73   (unless (member from (.subscribers repl-manager))
  74     (set! (.subscribers repl-manager)
  75           (cons from (.subscribers repl-manager)))))
  76
  77 (define (repl-manager-remove-subscriber repl-manager message)
  78   (define from (message-from message))
  79   (set! (.subscribers repl-manager)
  80         (remove (lambda (x) (equal? x (message-from message)))
  81                 (.subscribers repl-manager))))