;;; Weeb --- Web microframework for GNU Guile
;;; Copyright © 2026 Jakob Kreuze <zerodaysfordays@sdf.org>
;;;
;;; This file is part of Weeb.
;;;
;;; Weeb is free software: you can redistribute it and/or modify it
;;; under the terms of the GNU Affero General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; Weeb is distributed in the hope that it will be useful, but WITHOUT
;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General
;;; Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with Weeb. If not, see <https://www.gnu.org/licenses/>.

(define-module (weeb sxml)
  #:use-module (ice-9 match)
  #:use-module (ice-9 string-fun)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:export (sxml->html
            sxml->html-document))

(define (self-closing? tag-name)
  (memq tag-name '(img br hr input)))

(define (emit-raw? tag-name)
  (memq tag-name '(style script)))

(define (sxml-tag? elt)
  (match elt
    ((_tag-name ('@ _attr ...) _content ...) #t)
    ((_tag-name _content ...) #t)
    (_ #f)))

(define (extract-tag-name tag)
  (first tag))

(define (extract-attributes tag)
  (match tag
    ((_tag-name ('@ attrs ...) _content ...) attrs)
    (_ '())))

(define (extract-children tag)
  (match tag
    ((_tag-name ('@ _attrs ...) content ...) content)
    ((_tag-name content ...) content)
    (_ '())))

;; TODO: We should probably encode other entities as well, but there are
;; hundreds, so we need a more efficient way of substituting first.
(define (html-encode str)
  (define %entities
    '((#\& . "&amp;")
      (#\< . "&lt;")
      (#\> . "&gt;")
      (#\" . "&quot;")
      (#\' . "&#39;")))
  (define (iter s replace)
    (match replace
      (((char . entity) rest ...)
       (iter (string-replace-substring s (string char) entity) rest))
      (() s)))
  (iter str %entities))

(define (emit-sxml-tree tree)
  (match tree
    ((? sxml-tag?)
     (let ((tag-name (extract-tag-name tree)))
       (display "<")
       (display tag-name)
       (for-each (match-lambda
                   ((key value)
                    (display " ")
                    (display key)
                    (display "=\"")
                    (display value)
                    (display "\"")))
                 (extract-attributes tree))
       (display ">")
       (unless (self-closing? tag-name)
         (if (emit-raw? tag-name)
             (display (second tree))
             (for-each emit-sxml-tree (extract-children tree)))
         (display "</")
         (display tag-name)
         (display ">"))))
    ((? string?) (begin (display (html-encode tree))))
    ((? number?) (begin (display tree)))))

(define (emit-sxml-document document)
  (display "<!DOCTYPE html>")
  (emit-sxml-tree document))

(define (sxml->html tree)
  (with-output-to-string (cut emit-sxml-tree tree)))
(define (sxml->html-document tree)
  (with-output-to-string (cut emit-sxml-document tree)))