summaryrefslogtreecommitdiff
path: root/tempest.lisp
blob: 02bc03b3fda1bf13bca6eed11d892a9202ea9668 (plain)
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
52
53
54
55
56
57
58
59
(in-package #:tempest)

(defun read-tempest-string (filename)
  "Read file content as string. If it's not a .lisp file and does not have tempest comment at top, return NIL."
  (let ((content (uiop:read-file-string filename)))
    (if (str:starts-with-p ";;;; TEMPEST" content)
      content NIL)))

(defun compile-to-html (tempest-string)
  "Compiles spinneret string to HTML string. Redirects to standard output."
  (let ((*read-eval* nil))
        (-> (concatenate 'string "(spinneret:with-html " tempest-string ")")
             read-from-string 
             eval)))

(defun build-template (filename)
  (let ((raw (read-tempest-string filename)))
    (if raw 
      (let ((target-file (str:replace-all ".lisp" ".html" filename)))
        (with-open-file (*standard-output* target-file
                        :direction :output
                        :if-exists :supersede
                        :if-does-not-exist :create)
          (compile-to-html raw)
          target-file))
      NIL)))

(defun build (dir)
  (cl-fad:walk-directory dir
    (lambda (path-name)
      (let ((name (namestring path-name)))
        (when (str:ends-with-p ".lisp" name :ignore-case T)
          (build-template name))))))

;; TODO handle frequent/simultaneous events, only build once
;; TODO handle :MOVE event, delete old one and create new one 
;; TODO handle :DELETE event, delete template as well
(defun watch (dir)
  (file-notify:watch dir)
  (file-notify:with-events (file change :timeout T)
    (when (and (str:ends-with-p ".lisp" file :ignore-case T)
               (or (eql change :MODIFY)
                   (eql change :CREATE))) 
      (let ((built-file (build-template file)))
        (if built-file
          (format t "Built ~a, because of ~a~%" built-file change)
          nil)))))

(defun run (subcommand &rest args)
  (cond ((equal subcommand "build")
         (mapcar 'build args))
        ;; TODO support watching multiple dirs
        ((equal subcommand "watch")
         (watch (car args)))))

(defun main ()
  (let ((cli-args (cdr sb-ext:*posix-argv*)))
    (run (car cli-args) (cdr cli-args))))