From bc83c64067f5ef2b7e6e1bf9b7b49dbb12b9ddba Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Tue, 12 May 2020 21:48:36 -0700
Subject: PEG parsing of nodes

---
 z.scm | 60 +++++++++++++++++++++++++++++++++---------------------------
 1 file changed, 33 insertions(+), 27 deletions(-)

diff --git a/z.scm b/z.scm
index b24ded8..1739d34 100644
--- a/z.scm
+++ b/z.scm
@@ -3,8 +3,9 @@
 (import (srfi srfi-1))
 (import (sxml simple))
 (import (oop goops))
+(import (ice-9 peg))
 (import (only (srfi srfi-19) date->string current-date))
-(import (only (ice-9 match) match))
+(import (only (ice-9 match) match match-lambda))
 (import (prefix (dict) dict.))
 (import (prefix (re) re.))
 (import (prefix (web server) http.))
@@ -105,6 +106,7 @@
                      (id->path (id self)))))
 
 (define-generic save!)
+
 (define-method (save! (node <node>))
   (call-with-output-file (path node)
     (fn [file]
@@ -117,36 +119,40 @@
 (define-generic render-li)
 (define-generic render-full)
 
-(define (parse-title node-data)
-  (-> node-data
-      (re.match "title: ([^\n]*)")
-      (re.group 1)))
-
-(define (parse-tags node-data)
-  (-> node-data
-      (re.match "tags: ([^\n]*)")
-      (re.group 1)
-      (string.split #\space)
-      seq))
-
-(define (parse-created node-data)
-  (-> node-data
-      (re.match "created: ([^\n]*)")
-      (re.group 1)))
-
-(define (parse-content node-data)
-  (-> node-data
-      (re.match "---\n(.*)$")
-      (re.group 1)))
+ ;; Parsing Nodes
+
+(define-peg-string-patterns "\
+node <- meta* content !.
+meta <-- key SEP value NL
+key <-- 'title' / 'created' / 'tag'
+value <-- (!NL !SEP  .)*
+content <-- HR .*
+HR < '---'
+SEP < ':'
+NL < '\n'
+")
+
+(define (parse-meta node-tree)
+  (turn (first node-tree)
+        (match-lambda
+          [('meta ('key key) ('value ret))
+           `(,key . ,(string.strip ret #\space))]
+          [_ '()])))
+
+(define (parse-content node-tree)
+  (-> tree second second))
 
 (define (load-node id)
-  (let ([data (readlines (id->path id))])
+  (let* ([node-tree (->> id id->path readlines (match-pattern node) peg:tree)]
+         [meta (parse-meta node-tree)])
     (make <node>
       #:id id
-      #:title (parse-title data)
-      #:created (parse-created data)
-      #:tags (parse-tags data)
-      #:content (parse-content data))))
+      #:title (assoc "title" meta)
+      #:created (assoc "created" meta)
+      #:tags (->> meta
+                  (filter (/. P (equal? car P "tag")))
+                  (map cdr))
+      #:content (parse-content node-tree))))
 
  ;; Indexing
 
-- 
cgit v1.2.3