Welcome to the CHICKEN Scheme pasting service

(import (server socket)
        (prefix (route-mux path) mux:)
        (prefix (route-mux radix) mux:)
        (prefix (route-mux route) mux:)
        intarweb
        uri-common
        matchable
        comparse
        (chicken format)
        (chicken io)
        (chicken port)
        (srfi 13)
        (srfi 18))

;; ignore this garbage

(define (alist->radix-tree pairs)
  (let ((root (mux:make-node #f #())))
    (for-each
     (lambda (pair)
       (match pair
         ((s . handler)
          (let ((path (mux:route->path (parse mux:route-uri s))))
            (mux:path-insert! root path handler)))))
     pairs)
    root))

(define (chunked-write s out)
  (let ((len (string-length s)))
    (fprintf out "~X\r\n" len)
    (display s out)
    (display "\r\n" out)))

(define (chunked-eom out)
  (display "0\r\n\r\n" out))

;; the api, +/- polish

(define (hi-handler request in out params)
  (let* ((headers (headers '((connection . (close))
                             (transfer-encoding . (chunked)))))
         (response (make-response port: out
                                  status: 'ok
                                  headers: headers)))
    (write-response response)
    (let ((body (with-output-to-string (lambda () (write params)))))
      (chunked-write body out))
    (chunked-eom out)
    response))

(define +root+
  (alist->radix-tree
   `(("/hi/:mom/" . ,hi-handler))))

(define (mux-handler request in out)
  ;; bleh, not seeing the value of uri-common
  (let* ((u-path (uri-path (request-uri request)))
         (s (string-append "/" (string-join (cdr u-path) "/"))))
    (receive (node match? params) (mux:path-search +root+ s)
      (cond
       ((not match?)
        (print "should 404"))
       (else
        (let ((handler (mux:node-value node)))
          (handler request in out params)))))))

(define ((http-handler request-handler) in out)
  (let ((request (read-request in)))
    (let ((response (request-handler request in out)))
      (and (keep-alive? request)
           (keep-alive? response)))))

(define ((http-stream-handler request-handler) in out)
  (request-stream-handler request-handler in out))


(let ((stream-handler (http-stream-handler (http-handler mux-handler))))
  (start-server stream-handler port: 8080))