turtle-r7rs/server/start-guile-server.scm

(import
  (scheme base)
  (scheme read)
  (scheme write)
  (scheme process-context)
  (scheme load)
  (scheme cxr)
  (web server)
  (web request)
  (web response)
  (web uri)
  (ice-9 iconv)
  (macduffie sxml)
  (macduffie json))

(include "./web-server.scm")
(include "./canvas.js")

(define default-port 43334)

(define (not-found request)
  (values (build-response #:code 404)
          (string-append "Resource not found: "
                         (uri->string (request-uri request)))))

(define (request-path-components request)
  (split-and-decode-uri-path (uri-path (request-uri request))))

(define (hello-hacker-handler request body)
  (define path-components (request-path-components request))

  (when (null? path-components)
    (set! path-components '("index.html")))

  (case (string->symbol (string-downcase (car path-components)))
    ((index.html)
     (values '((content-type . (text/html)))
             (sxml->xml index-page)))
    ((draw.js)
     (values '((content-type . (application/javascript)))
             script-page))
    ((api)
     (if (null? (cdr path-components))
         (not-found request)
         (case (string->symbol (string-downcase (cadr path-components)))
           ((newid)
            (values '((content-type . (application/json)))
                    (api-new-id!)))
           ((pushbuffer)
            (values '((content-type . (application/json)))
                    (api-push-buffer! (bytevector->string body "utf-8"))))

           ((pushbulkbuffer)
            (values '((content-type . (application/json)))
                    (api-push-bulk-buffer! (bytevector->string body "utf-8"))))
           ((pullbuffer)
            (values '((content-type . (application/json)))
                    (json-write-string (api-pull-buffer! (bytevector->string body "utf-8")))))
           ((clearbuffer)
            (values '((content-type . (text/plain)))
                    (api-clear-buffer!)))
           (else
            (not-found request)))))
    (else
     (not-found request))))

(define (main args)
  (define current-port
    (if (null? (cdr args))
        default-port
        (string->number (cadr args))))

  (run-server hello-hacker-handler 'http `(#:port ,current-port)))

(main (command-line))