simple kitty-server

kitty-server.lfe

(defmodule kitty-server
  (export all))

(defrecord cat
  name
  (color 'green)
  description)

;; Client API
(defun start-link ()
  (spawn_link (fun init 0)))

(defun order-cat (pid name color description)
  (let ((ref (monitor 'process pid)))
    (! pid (tuple (self) ref (tuple 'order name color description)))
    (receive
      ((tuple ref cat)
       (progn
         (demonitor ref (list 'flush))
         cat))
      ((tuple 'DOWN ref 'process pid reason)
       (error reason))
      (after 5000
        (error 'timeout)))))

(defun init ()
  (loop '()))

(defun loop (cats)
  (receive
    ((tuple pid ref (tuple 'order name color description))
     (if (=:= cats '())
       (progn
         (! pid (tuple ref (make-cat name name color color description description)))
         (loop cats))
       (progn
         (! pid (tuple ref (hd cats)))
         (loop (tl cats)))))
    ((tuple 'return (= (match-cat) cat))
     (loop (cons cat cats)))
    ((tuple pid ref 'terminate)
     (progn
       (! pid (tuple ref 'ok))
       (terminate cats)))
    (unknown
     (io:format "Unknown message: ~p~n" (list unknown))
     (loop cats))))

(defun return-cat
  ((pid (= (match-cat) cat))
   (! pid (tuple 'return cat))))

(defun close-shop (pid)
  (let ((ref (monitor 'process pid)))
    (! pid (tuple (self) ref 'terminate ))
    (receive
      ((tuple ref 'ok)
       (progn
         (demonitor ref (list 'flush))
         'ok))
      ((tuple 'DOWN ref 'process pid reason)
       (error reason))
      (after 5000
        (error 'timeout)))))

(defun terminate (cats)
  (lc ((<- c cats)
       (io:format "~p was set free.~n" (list (cat-name c))))
    'ok))