summary refs log tree commit diff stats
path: root/boudin.scm
blob: 9135a9e5fe838166ffff5de64f28c74995cfac6e (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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
;;; boudin

(import (boudin page)
        (boudin page post)
        (boudin page index)
        (boudin page style)
        (boudin page write)
        (boudin site)
        (boudin util)
        (chicken file)
        (chicken pathname)
        (chicken process-context))

;; State variables

(define site-posts
  (make-parameter '()))

(define site-files
  (make-parameter '()))

(define (copy-static file)
  (copy-file file (pathname-replace-directory file (site-dest))))

(define (with-progress message thunk)
  (edisplay message)
  (edisplay "...")
  (thunk)
  (eprint "Ok."))

(define (go!)
  (eprint "Building " (site-name) "...")
  (for-each (lambda (f)
              (with-progress (string-append "Copying " f " to " (site-output))
                             (lambda () (copy-static f)))) (site-files))
  (let ((posts (map make-post (site-posts))))
    (for-each (lambda (pg)
                (with-progress (string-append "Writing " (page-output pg))
                               (lambda () (write-page pg))))
              (append posts
                      (list (apply make-style (site-style))
                            (make-index posts)
                            (make-feed posts)))))
  (eprint "Done!"))

(define (main args)
  (define *current #f)
  (define glob? #t)
  (when (null? args)
    (exit 1))
  (let loop ((args args))
    (cond
     ((null? args)
      (when (file-exists? (site-config))
        (with-progress (string-append "Loading " (site-config))
                       (lambda () (load (site-config)))))
      (go!))
     ;; Configuration file: -c FILE
     ((equal? (car args) "-c")
      (site-config (cadr args))
      (loop (cddr args)))
     ;; Change directory: -C DIRECTORY
     ((equal? (car args) "-C")
      (change-directory (cadr args))
      (loop (cddr args)))
     ;; Don't glob filenames: -r (raw)
     ((equal? (car args) "-r")
      (set! glob? #f)
      (loop (cdr args)))
     ;; Posts follow -p
     ((equal? (car args) "-p")
      (set! *current site-posts)
      (loop (cdr args)))
     ;; Files follow -f
     ((equal? (car args) "-f")
      (set! *current site-files)
      (loop (cdr args)))
     ;; Append current path to *current
     (else
      (let ((*current (or *current site-posts))) ; posts by default
        (*current (append ((if glob? glob list) (car args))
                          (*current))))
      (loop (cdr args))))))

(cond-expand
  ((or chicken-script compiling)
   (import (chicken process-context))
   (main (command-line-arguments)))
  (else))