utils.rkt 1.12 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
#lang racket

(provide (all-defined-out))

(require json
         html-writing
         racket/runtime-path
         web-server/http/response-structs)

;;; Utilities
;;; =========

;; current working directory... used for serving static content
(define-runtime-path cwd ".")

(define (ok body #:content-type [content-type #"application/octet-stream"])
  (response
   200 #"OK"
   (current-seconds) content-type
   '()
   (lambda (out-port)
     (write-bytes body out-port))))

(define (render-ok sxml)
  (ok (xexp->html-bytes sxml)
      #:content-type #"text/html"))

(define (not-found)
  (response 404 #"Not Found"
            (current-seconds) #"text/plain"
            '()
            (lambda (out-port)
              (display #"404 Not Found X_X" out-port))))

(define (json->string json)
  (call-with-output-string
   (lambda (p)
     (write-json json p))))

(define (json->bytes json)
  (call-with-output-bytes
   (lambda (p)
     (write-json json p))))

(define (not-allowed)
  (response
   405 #"Method Not Allowed"
   (current-seconds) #"text/plain"
   '()
   (lambda (out-port)
     (write-bytes #"405 Method Not Allowed :P" out-port))))