;;;; rpc-demo.scm
;;;; Simple database server / client

(require-extension (srfi 18) extras tcp rpc sqlite3)

;;; Common things

(define operation (string->symbol (car (command-line-arguments))))
(define param (cadr (command-line-arguments)))

(define rpc:listener
  (if (eq? operation 'server)
      (tcp-listen (rpc:default-server-port))
      (tcp-listen 0)))

;; Start server thread
(define rpc:server
  (make-thread
   (cute (rpc:make-server rpc:listener) "rpc:server")
   'rpc:server))

(thread-start! rpc:server)

;;; Server side

(define (server)
  (rpc:publish-procedure!
   'change-response-port
   (lambda (port)
     (rpc:default-server-port port))
   #f)
  (let ((db (sqlite3:open param)))
    (set-finalizer! db sqlite3:finalize!)
    (rpc:publish-procedure!
     'query
     (lambda (sql callback)
       (print "Executing query '" sql "' ...")
       (sqlite3:for-each-row
	callback
	db sql))))
  (thread-join! rpc:server))

;;; Client side

(define (callback1 . columns)
  (let loop ((c columns) (i 0))
    (unless (null? c)
      (printf "~a=~s " i (car c))
      (loop (cdr c) (+ i 1))))
  (newline))

(define callback2-results '())

(define (callback2 . columns)
  (set! callback2-results (cons columns callback2-results)))

(define (client)
  ((rpc:procedure 'change-response-port "localhost")
   (tcp-listener-port rpc:listener))
  ((rpc:procedure 'query "localhost") param callback1)
  (rpc:publish-procedure! 'callback2 callback2)
  ((rpc:procedure 'query "localhost") param callback2)
  (pp callback2-results))

;;; Run it

(if (eq? operation 'server)
    (server)
    (client))