kitty server

kitty-gen-server.lfe

(defmodule kitty-gen-server
  (export all)
  (behavior 'gen_server))

(defrecord cat
  name
  (color 'green)
  description)

(defun start-link ()
  (gen_server:start_link (MODULE) '() '()))

(defun order-cat (pid name color description)
  (gen_server:call pid `#(order ,name ,color ,description)))

(defun return-cat
  ((pid (= (match-cat) cat))
   (gen_server:cast pid `#(return ,cat))))

(defun close-shop (pid)
  (gen_server:call pid 'terminate))

(defun init
  (('()) `#(ok ,())))

(defun handle_call
  ((`#(order ,name ,color ,description) _from cats)
   (if (=:= cats '())
     `#(reply ,(make_cat name color description) ,cats)
     `#(reply ,(hd cats) ,(tl cats))))
  (('terminate _from cats)
   `#(stop normal ok ,cats)))

(defun handle_cast
  ((`#(return ,(= (match-cat) cat)) cats)
   `#(noreply ,(cons cat cats))))

(defun handle_info (msg cats)
  (io:format "Unexpected message ~p~n" `(,msg))
  `#(noreply ,cats))

(defun terminate
  (('normal cats)
   (lists:map (lambda (cat)
                (io:format "~p was set free.~n" `(,(cat-name cat)))) cats)
   'ok))

(defun code_change (_oldvsn state _extra)
  `#(ok ,state))

(defun make_cat (name col desc)
  (make-cat name name color col description desc))

(defun test ()
  (let* (((tuple 'ok pid) (start-link))
         (cat (order-cat pid "Steaven" 'white "Fooooo")))
    (! pid "TEST")
    (return-cat pid cat)
    (order-cat pid "Hoo" 'black "hooooo")
    (order-cat pid "Hoo" 'black "hooooo")
    (return-cat pid cat)
    (close-shop pid)))