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 (srfi srfi-1)
  23   #:use-module (system repl server)
  24   #:use-module (system repl coop-server)
  25   #:export (<repl-manager>))
  26
  27 (define-actor <repl-manager> (<actor>)
  28   ((*cleanup* repl-manager-cleanup)
  29    (*init* repl-manager-init)
  30    (add-subscriber repl-manager-add-subscriber)
  31    (remove-subscriber repl-manager-remove-subscriber))
  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 (repl-manager-cleanup repl-manager message)
  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 (repl-manager-init repl-manager message)
  53   (define socket
  54     (make-unix-domain-server-socket #:path (.path repl-manager)))
  55   (define server
  56     (spawn-coop-repl-server socket))
  57   (define (inform-subscribers)
  58     (for-each
  59      (lambda (subscriber)
  60        (<- subscriber 'repl-update))
  61      (.subscribers repl-manager)))
  62   (set! (.socket repl-manager) socket)
  63   (while (actor-alive? repl-manager)
  64     (poll-coop-repl-server server)
  65     (inform-subscribers)
  66     (8sleep (.poll-every repl-manager))))
  67
  68 (define (repl-manager-add-subscriber repl-manager message)
  69   (define from (message-from message))
  70   (unless (member from (.subscribers repl-manager))
  71     (set! (.subscribers repl-manager)
  72           (cons from (.subscribers repl-manager)))))
  73
  74 (define (repl-manager-remove-subscriber repl-manager message)
  75   (define from (message-from message))
  76   (set! (.subscribers repl-manager)
  77         (remove (lambda (x) (equal? x (message-from message)))
  78                 (.subscribers repl-manager))))