1 files changed, 48 insertions, 0 deletions
diff --git a/guix.scm b/guix.scm
new file mode 100644
index 0000000..fbdbcca
--- /dev/null
+++ b/guix.scm
@@ -0,0 +1,48 @@
+(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"
+                                 (string-append name "[0]")
+                                 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 "."))))))