;;; 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))