wsf/docroot-server.lisp at master · neverblued/wsf · GitHub

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
;; (c) www.neverblued.info
;; LLGPL -> http://opensource.franz.com/preamble.html

(in-package #:wsf)

(defgeneric server-pathname (docroot-server))

(defun from-docroot (server &rest relative-path-chunks)
  (awith (apply #'join relative-path-chunks)
    (join (server-pathname server)
          (if (begins-with? it "/") "" "/")
          it)))

(define-symbol-macro docroot
    (from-docroot *server*))

(defun docroot/ (&rest relative-path-chunks)
  (apply #'from-docroot *server* relative-path-chunks))

(defun text-docroot/ (&rest relative-path-chunks)
  (pathname-content (apply #'docroot/ relative-path-chunks)))

(defun list-docroot/ (&rest relative-path-chunks)
  (eval-list (load-from-file (apply #'docroot/ relative-path-chunks))))

(defclass docroot-server (lisp-server)
  ((data-pathname-format :initarg :data-pathname-format
                         :accessor server-data-pathname-format
                         :initform "data/~a.lisp")))

(defmethod server-pathname ((server docroot-server))
  (system-directory (server-system server)))