;; Copyright 2020 Idiomdrottning.
;; This is free software (3-clause BSD, see COPYING for details).
(import (chicken string) fmt html-parser srfi-1 brev-separate utf8)
(define (ws? str)
  (and (string? str)
       (every char-whitespace? (string->list str))))
(define (cnw x) (remove ws? (cdr x)))
(define js
  (o (as-list flatten
	      (over (case x ((#\" #\/ #\\) (list #\\ x))
			  ((#\delete) '(#\\ #\u #\0 #\0 #\7 #\F)) (else x)))
	      (over (aif-with-result
		     (< (save (char->integer x)) 32)
		     (cons #\\ (if (or (< 7 it 11) (< 11 it 14))
				   (list (string-ref "btnvfr" (- it 8)))
				   (string->list
				    (fmt #f (cat "u00" (if (> 16 it) "0" "")
						 (num it 16))))))
		     x))) ->string))
(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 x) (cat "\"" (if (pair? x) (string-chomp (js (car x))) "") "\""))
(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) (if (number? x) (wrt x) (w (list 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)