ZelphirKaltstahl
/
guile-examples


			
				
					
						
						
							1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677
							(use-modules (web server))
(use-modules (web request)
             (web response)
             (web uri))
(use-modules (sxml simple))

;; =========================
;; REQUEST/RESPONSE HANDLING
;; =========================
(define* (respond #:optional body #:key
                  (status 200)
                  (title "This is my title!")
                  (doctype "<!DOCTYPE html>\n")
                  (content-type-params '((charset . "utf-8")))
                  (content-type 'text/html)
                  (extra-headers '())
                  ;; if a body is provided use its templatized form
                  (sxml (and body (templatize title body))))
  ;; as before, answer in two parts, headers and body
  (values (build-response #:code status
                          ;; headers are an alist
                          #:headers `((content-type . (,content-type ,@content-type-params))
                                      ,@extra-headers))
          ;; instead of returning the body as a string, respond gives
          ;; a procedure, which will be called by the web server to
          ;; write out the response to the client.
          ;; So you have 2 options: return string or return procedure which takes a port.
          (λ (port)
            (if sxml
                (begin
                  (if doctype (display doctype port))
                  (sxml->xml sxml port))))))

(define (request-path-components request)
  ;; just for showing what the functions do
  (display (simple-format #f "(request-uri request): ~a\n"
                          (request-uri request)))
  (display (simple-format #f "(uri-path ...): ~a\n"
                          (uri-path (request-uri request))))
  (display (simple-format #f "(split-and-decode-uri-path ...): ~a\n"
                          (split-and-decode-uri-path (uri-path (request-uri request)))))
  ;; actual logic
  ;; split the string that represents the uri and decode any url-endoced things
  (split-and-decode-uri-path
   ;; get the uri path as a string from the request struct
   (uri-path
    ;; get the request struct
    (request-uri request))))

(define (debug-page request body)
  ;; use respond helper
  (respond
   ;; will be templatized
   `((h1 "hello world!")
     (table
      (tr (th "header") (th "value"))
      ;; splice in all request headers
      ,@(map (lambda (pair)
               `(tr (td (tt ,(with-output-to-string
                               (lambda () (display (car pair))))))
                    (td (tt ,(with-output-to-string
                               (lambda ()
                                 (write (cdr pair))))))))
             (request-headers request))))))

;; =========
;; TEMPLATES
;; =========
(define (templatize title body)
  `(html (head (title ,title))
         (body ,@body)))

;; ======
;; SERVER
;; ======
(run-server debug-page)