1 files changed, 125 insertions, 0 deletions

@@ -0,0 +1,125 @@
+;;; Syntax
+;; an fff document translates to a key-value object containing lists or other
+;; objects.  Nesting objects are accomplished using references, which start with @.
+
+;; # comments start with '#' and go to the end of the line.
+;; fff-object::
+;; key: value
+;; key2: value2
+;; key3: @reference # a reference refers to another defined object
+;;
+;; # lists are similar to objects, just without keys
+;; fff-list::
+;; : item1
+;; : item2
+;; : item3
+;;
+;; name: something # this is okay too
+
+(import (scheme base)
+        (scheme case-lambda)
+        (utf8)
+        (comparse)
+        (srfi 14))
+
+(define anything
+  (in char-set:full))
+
+(define nl+ws
+  (sequence* ((_ (is #\newline))
+              (_ ws*))
+    (result " ")))
+
+(define end
+  (any-of nl+ws
+          end-of-input))
+
+(define end*
+  (any-of (one-or-more nl+ws)
+          end-of-input))
+
+(define (escaped parser)
+  (preceded-by (is #\\) parser))
+
+(define (unescaped parser)
+  (none-of* (escaped parser)
+            parser))
+
+(define ws
+  (in char-set:blank))
+
+(define ws*
+  (zero-or-more ws))
+
+(define nonl
+  (in (char-set-delete char-set:full #\newline)))
+
+(define fff-val
+  (sequence* ((@? (maybe (escaped (is #\@))))
+              (v (as-string
+                  (zero-or-more
+                   (any-of (escaped nl+ws)
+                           (none-of* nl+ws item))))))
+    (result (if @?
+                (string-append "@" v)
+                v))))
+
+(define fff-key
+  (as-string
+   (one-or-more
+    (all-of (any-of (escaped (is #\:))
+                    (escaped nl+ws)
+                    (none-of* (is #\:) nl+ws item))))))
+
+(define fff-ref
+  (sequence* ((_ (unescaped (is #\@)))
+              (k fff-key))
+    (result (cons 'ref k))))
+
+(define fff-comment
+  (sequence* ((_ (one-or-more (is #\#)))
+              (_ ws*)
+              (c (as-string (zero-or-more nonl)))
+              (_ end*))
+    (result (cons 'comment c))))
+
+(define fff-comment+
+  (bind (one-or-more fff-comment)
+        (lambda (xs)
+          (result (cons 'comment (map cdr xs))))))
+
+(define fff-item
+  (sequence* ((k (maybe fff-key))
+              (_ ws*)
+              (_ (is #\:))
+              (_ ws*)
+              (v (any-of fff-ref fff-val))
+              (_ end))
+    (result (cons k v))))
+
+(define fff-item*
+  (sequence* ((k fff-key)
+              (_ ws*)
+              (_ (is #\:))
+              (_ ws*)
+              (v (any-of fff-ref fff-val))
+              (_ end*))
+    (result (cons k v))))
+
+(define fff-object
+  (sequence* ((name fff-key)
+              (_ ws*)
+              (_ (sequence (is #\:) (is #\:) (is #\newline)))
+              (contents (one-or-more
+                         (any-of fff-comment+
+                                 fff-item)))
+              (_ end*))
+    (result (cons name contents))))
+
+(define fff-document
+  (zero-or-more (any-of fff-comment+
+                        fff-object
+                        fff-item*)))
+
+(define (parse-fff x)
+  (parse fff-document x))