;; Copyright 2020 Idiomdrottning.
;; This is free software (3-clause BSD, see COPYING for details).
(import (chicken string) fmt html-parser srfi-1 utf8)
(define (ws? str)
  (and (string? str)
       (every char-whitespace? (string->list str))))
(define (cnw x) (remove ws? (cdr x)))
(define (as? x)
  (eq? #\* (string-ref (->string x) 0)))
(define (gtm x)
  (if (or (as? (car x)) (as? (caar x))) (gtm (cnw x)) x))
(define w (o wrt string-chomp ->string car))
(define ((i l) st)
  (if (= l (fmt-col st)) st ((cat nl (space-to l)) st)))
(define (vk x l)
  (cat (w x) #\: (w (cnw x))))
(define (ob x p lt gt l)
  (cat #\{ (w x) #\: (i (+ 2 l))
       lt (fmt-join (cute p <> (+ 2 l))
		    (cnw x) (cat #\, (i (+ 3 l))))
       gt #\}))
(define (j x l)
  (cond
   ((atom? x) (wrt (if (number? x) x (->string x))))
   ((= 1 (length x))
    (if (atom? (car x))
	(cat #\{ (w x) ": []}")
	(j (car x) l)))
   ((eq? '@ (car x)) (ob x vk #\{ #\} l))
   (else (ob x j #\[ #\] l))))
(fmt #t (j (gtm (cnw (html->sxml))) 0 ) nl)