1 files changed, 150 insertions, 0 deletions
diff --git a/src/main.lisp b/src/main.lisp
new file mode 100644
index 0000000..8e47016
--- /dev/null
+++ b/src/main.lisp
@@ -0,0 +1,150 @@
+; Helpers
+
+(defun lines (str)
+  (split str #\linefeed))
+
+(defun split (str c)
+  (loop
+    for i = 0 then (1+ j)
+    as j = (position c str :start i)
+    collect (subseq str i j)
+    while j))
+
+(defun write-file (filename s)
+  (ensure-directories-exist filename)
+  (with-open-file (str filename
+                       :direction :output
+                       :if-exists :supersede
+                       :if-does-not-exist :create)
+    (format str "~A" s)))
+
+; Data
+
+(defun song-key (key song)
+  (let ((tuple (car song)))
+    (cond
+      ((eql tuple nil) nil)
+      ((eql (car tuple) key) (cdr tuple))
+      (t (song-key key (cdr song))))))
+
+; HTML
+
+(defun page (title body)
+    (format 
+      nil
+      "<!doctype html><html lang=\"fr\"><meta charset=\"utf-8\"><meta name=\"viewport\" content=\"width=device-width\"><title>~A</title><link rel=\"stylesheet\" href=\"/main.css\"><link rel=\"icon\" href=\"/icon.png\">~A"
+      title
+      body))
+
+(defun h (node attrs children)
+  (format
+    nil
+    "<~A ~A>~A</~A>"
+    node
+    (apply #'concatenate 'string (mapcar (lambda (x) (format nil " ~A=\"~A\"" (car x) (car (cdr x)))) attrs))
+    (apply #'concatenate 'string children)
+    node))
+
+; Title
+
+(defun title-tags (title from)
+  (h "section" nil
+     (list
+       (h "h1" '(("class" "g-Title")) (list title))
+       (h "div" '(("class" "g-Author")) (list from)))))
+
+; Part
+
+(defun part-name (key)
+  (ecase key
+    ('intro "Intro")
+    ('verse "Couplet")
+    ('chorus "Refrain")
+    ('interlude "Interlude")))
+
+(defun part-tags (key children)
+  (h "div" 
+     '(("class" "g-Part"))
+     (list
+       (if
+         (eql key 'all)
+         nil
+         (h "h3" nil (list (part-name key))))
+       children)))
+
+; Chords
+
+(defun chord-row (chords)
+  (h "tr" nil (mapcar (lambda (x) (h "td" nil (list (string x)))) chords)))
+
+(defun chord-rows (xs)
+  (if
+    (eql xs nil)
+    nil
+    (cons (chord-row (car xs)) (chord-rows (cdr xs)))))
+
+(defun chord-table (key row)
+  (part-tags 
+    key 
+    (h "table" '(("class" "g-Chords")) (chord-rows row))))
+
+(defun chord-tables (xs)
+  (if
+    (eql xs nil)
+    nil
+    (let ((key (car (car xs)))
+          (rows (cdr (car xs))))
+      (cons (chord-table key rows) (chord-tables (cdr xs))))))
+
+(defun chord-tags (chords)
+  (h "section" nil
+     (list
+       (h "h2" '(("class" "g-Subtitle")) '("Accords"))
+       (h "div" '(("class" "g-Parts")) (chord-tables chords)))))
+
+; Lyrics
+
+(defun emph (str cs)
+  (apply #'concatenate 'string
+    (loop for c across str collect
+      (if (member c cs) (h "emph" nil (list (make-string 1 :initial-element c))) (make-string 1 :initial-element c)))))
+
+(defun lyrics-line (line)
+  (h "div" nil (list (emph line (list #\, #\. #\? #\!)))))
+
+(defun lyrics-section (s)
+  (let ((p (car (cdr s))))
+    (part-tags 
+      (car s)
+      (if p 
+        (h "div" '(("class" "g-Lyrics__Paragraph")) (mapcar #'lyrics-line (lines p)))
+        nil))))
+
+(defun lyrics-tags (lyrics)
+  (h "section" nil
+     (list
+       (h "h2" '(("class" "g-Subtitle")) '("Paroles"))
+       (h "div" '(("class" "g-Parts")) (mapcar #'lyrics-section lyrics)))))
+
+; Main
+
+(defun export-song (path)
+  (let ((data (with-open-file (in path) (read in))))
+    (let ((output (concatenate 'string "public/" (car (split path #\.)) ".html"))
+          (title (car (song-key 'title (cdr data))))
+          (from (car (song-key 'from (cdr data))))
+          (chords (song-key 'chords (cdr data)))
+          (lyrics (song-key 'lyrics (cdr data))))
+      (write-file output (page
+        (format nil "~A – ~A" title from)
+        (h
+          "body"
+          nil
+          (list
+            (h "a" '(("class" "g-Back") ("href" "/")) '("Retour à l’accueil"))
+            (title-tags title from)
+            (chord-tags chords)
+            (lyrics-tags lyrics))))))))
+
+(export-song "songs/graeme-allwright/petit-garcon.lisp")
+(export-song "songs/ben-e-king/stand-by-me.lisp")