summaryrefslogtreecommitdiff
path: root/guix.scm
blob: b63cf6596c02f501e321f4da8445e96aebebe92b (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
(use-modules (guix gexp)
             (guix modules)
             (gnu packages music)
             (gnu packages imagemagick))

(computed-file
 "copirate-site"
 (with-imported-modules
  (source-module-closure '((guix build utils)))
  #~(begin
      (use-modules (guix build utils) (ice-9 ftw))
      (mkdir-p #$output)
      (copy-recursively
       #$(local-file "." "copirate-site-source"
                     #:recursive? #t
                     #:select?
                     (lambda (file stat)
                       (or (string-suffix? "/index.html" file)
                           (string-suffix? "/index.css" file)
                           (string-suffix? ".ly" file))))
       #$output)
      (with-directory-excursion
       #$output
       (let ((enter? (lambda (name stat result) #t))
             (leaf (lambda (name stat result)
                     (when (string-suffix? ".ly" name)
                       (invoke #$(file-append lilypond "/bin/lilypond") name))))
             (down (lambda (name stat result) #t))
             (up (lambda (name stat result) #t))
             (skip (lambda (name stat result) #t))
             (error (lambda (name stat errno result) #t)))
         (file-system-fold enter? leaf down up skip error #t "."))
       (let ((enter? (lambda (name stat result) #t))
             (leaf (lambda (name stat result)
                     (when (string-suffix? ".pdf" name)
                       (let ((miniature-name
                              (string-append
                               (substring name 0 (- (string-length name) (string-length ".pdf")))
                               "-miniature.png")))
                         (invoke #$(file-append imagemagick "/bin/convert")
                                 "-resize" "210x297"
                                 "+append"
                                 (string-append name "[0-4]")
                                 miniature-name)))))
             (down (lambda (name stat result) #t))
             (up (lambda (name stat result) #t))
             (skip (lambda (name stat result) #t))
             (error (lambda (name stat errno result) #t)))
         (file-system-fold enter? leaf down up skip error #t "."))))))