;; Reader macros.
;;
;; This file is part of Beastie <https://purl.org/nxg/dist/beastie>
;; SPDX-FileCopyrightText: 2023 Norman Gray <https://nxg.me.uk>
;; SPDX-License-Identifier: BSD-2-Clause

;; Support reading #"""multiple lines...""" as a string.
;;
;; The dedentation is Julia-style: we remove the shortest all-space
;; prefix from each non-blank line other than the first and last ones.
;; If the first line starts with a newline, that's removed.
;; https://docs.julialang.org/en/v1/manual/strings/
;;
;; The triple-quotes-remainder* function is called _after_ the #"""
;; sequence has been read from the input, either by
;; triple-quotes-only* or unicode.scm:dquotes-reader*
(define (triple-quotes-remainder*)
  (define (line-join lines)             ;at least one line
    (apply string-append
           (let loop ((ll lines))
             (if (null? (cdr ll))
                 (list (car ll))
                 `(,(car ll) "\n" . ,(loop (cdr ll)))))))
  (define (reassemble-lines lines)
    ;; The first line is special, because we discard it if it's
    ;; empty (ie, it starts with a newline).
    ;; The last line is special, because we don't ignore it,
    ;; when calculating the dedent, if it's all-blank.
    (if (null? lines)
        ""
        (let* ((dedent                   ;calculate shortest prefix, ignoring line 1
               (let loop ((ll (cdr lines))
                          (d -1))
                 (cond ((null? ll)
                        (if (< d 0) 0 d))
                       ((and (car ll)
                             (or (< d 0)
                                 (< (caar ll) d)))
                        (loop (cdr ll) (caar ll)))
                       (else
                        (loop (cdr ll) d)))))
               (ll-dedented
                (cons (and (car lines)
                           (cdar lines))
                      (map (lambda (l)
                             (if l
                                 (substring (cdr l) dedent)
                                 ""))
                           (cdr lines)))))
          (cond ((car ll-dedented)
                 (line-join ll-dedented))
                ((null? (cdr ll-dedented))
                 "")
                (else
                 (line-join (cdr ll-dedented)))))))
  (let loop ((c (read-char))       ;the current character
             (lines '())           ;lines so far
             (cl '())              ;characters in this line (reversed)
             (bol? #t)             ;at bol?
             (leadspace 0)         ;number of leading spaces
             (qcount 0))           ;number of quotes seen
    (cond ((char=? c #\")
           (if (= qcount 2)
               (reassemble-lines
                ;; The current line, cl, is currently '(#\" #\" char char...),
                ;; so discard the two quotes preceding this third one.
                (reverse!
                 (cons (cons leadspace (list->string (reverse! (cddr cl))))
                       lines)))
               (loop (read-char)
                     lines
                     (cons c cl)
                     bol?
                     leadspace
                     (+ qcount 1))))
          ((char=? c #\newline)
           (loop (read-char)
                 (if bol?
                     (cons #f lines)    ;empty line
                     (cons (cons leadspace (list->string (reverse! cl)))
                           lines))
                 '()
                 #t
                 0
                 0))
          (bol?
           (if (char=? c #\space)
               (loop (read-char)
                     lines
                     (cons c cl)
                     #t
                     (+ leadspace 1)
                     0)
               (loop (read-char)
                     lines
                     (cons c cl)
                     #f
                     leadspace
                     0)))
          (else
           (loop (read-char)
                 lines
                 (cons c cl)
                 #f
                 leadspace
                 0)))))

(define (ustring-read-handler-remainder* iter)
  (let ((u (make-ustring)))
    (let loop ((escape? #f))
      (let ((c (iter)))
        ;; c is an integer?
        (cond ((eof-object? c)
               (beastie-error "EOF while reading #\"...\""))
              (escape?
               (case c
                 ((#x22 #x5c)           ;'"' or '\'
                  (ustring-append! u c)
                  (loop #f))
                 ((#x6e)                ; #\n
                  (ustring-append! u #\newline)
                  (loop #f))
                 (else
                  (print-warning "#\"...\" escape \\~a ignored" (integer->char c))
                  (loop #f))))
              (else
               (case c
                 ((#x22)                ;'"', end of string
                  u)
                 ((#x5c)                ;#\\
                  (loop #t))
                 (else
                  (ustring-append! u c)
                  (loop #f)))))))))

;; Support #\" as a reader macro.
;;
;;    #"..."      reads as a ustring
;;    #""         reads as an empty ustring
;;    #"""..."""  reads as a multi-line Julia-style dedented string
(define (dquotes-reader* str)
  (define (compose-iterators* . iters)
    #"""`(compose-iterators* iter ...)` : produces an iterator which returns
  items from the given iterators, returning `#<eof>` only when all are exhausted."""
    (let ((+iterator+ #t))
      (lambda ()
        (if (null? iters)
            #<eof>
            (let ((i0 ((car iters))))
              (if (eof-object? i0)
                  (if (null? (set! iters (cdr iters)))
                      #<eof>
                      ((car iters)))
                  i0))))))
  ;(format (current-error-port) "dquotes-reader*: arg=~s~%" str)
  (if (string=? str "\"")               ;this may be #"(..)", #"" or #"""..."""
      (let ((c2 (peek-char)))
        (if (char=? c2 #\")
            (begin
              (read-char)
              (let ((c3 (peek-char)))
                (if (char=? c3 #\")
                    (begin              ;#"""..."""
                      (read-char)
                      (triple-quotes-remainder*))
                    (make-ustring))))   ;#""
            (ustring-read-handler-remainder* ;#"..."
             unicode-decode1/port/utf8)))
      (ustring-read-handler-remainder*
       ;; this is #"...", but with the initial part in str
       (compose-iterators* (let ((p (open-input-string str)))
                             (read-byte p) ;gobble initial #\"
                             (lambda ()
                               (unicode-decode1/port/utf8 p)))
                           unicode-decode1/port/utf8))))

;;SRFI-62 comments; this implementation from the s7 docs
(define (srfi62-comments str)
  (if (string=? str ";") (read))
  (values))