#|
raw.scm -- reader extension

Copyright © 2026 Hernán Ibarra Mejia.

This file is part of `raw`.

`raw` is free software: you can redistribute it and/or modify it under the terms
of the GNU General Public License as published by the Free Software Foundation,
version 3 of the License.

`raw` 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 General Public License for more details.

You should have received a copy of the GNU General Public License along with
`raw` If not, see <https://www.gnu.org/licenses/>.
|#

(module raw (_raw-post-process _raw-post-processor-name raw-read-syntax)
  (import scheme
          (chicken base)
          (chicken string)
          (chicken read-syntax))

  (include-relative "utils")
  (include-relative "hybrid")

  (define-constant sharp-char #\&)
  (define-constant default-escape-char #\&)

  (define (register-indent port)
    (case (peek-char port)
      ((#!eof) (error-eof))
      ((#\newline)
       (read-char port)
       (consume-indent port))
      (else '())))

  (define (check-indent port indent-list)
    (case (peek-char port)
      ((#\newline))
      (else (consume-char-list indent-list port))))

  (define (parse-command port hyb escape-char indent)
    (define (read-expression #!key sexpression?)
      (let ((res (read port)))
        (if sexpression?
          res
          (if (or (null? res) (not (null? (cdr res))))
            (error-invalid-expression res)
            (car res)))))
    (case (peek-char port)
      ((#!eof) (error-eof))
      ((#\() (add-expression-to-hybrid (read-expression sexpression?: #t) hyb))
      ((#\[) (add-expression-to-hybrid (read-expression sexpression?: #f) hyb))
      ((#\!) (read-char port)
             (case (peek-char port)
               ((#\() (add-expression-to-hybrid
                        (read-expression sexpression?: #t)
                        hyb
                        prefix?: #t))
               ((#\[) (add-expression-to-hybrid
                        (read-expression sexpression?: #f)
                        hyb
                        prefix?: #t))
               (else => error-unexpected-char)))
      ((#\&) (read-char port)
             (add-char-to-hybrid escape-char hyb))
      ((#\newline) (read-char port)
                   (check-indent port indent)
                   hyb)
      ((#\}) (read-char port) #f)))

  (define (parse-raw-content port escape-char indent)
    (let loop ((hyb (make-empty-hybrid))
               (char (read-char port)))
      (cond ((eof-object? char) (error-eof))
            ((char=? char escape-char)
             (let ((new-hyb (parse-command port hyb escape-char indent)))
               (if new-hyb
                 (loop new-hyb (read-char port))
                 (hybrid->tokens hyb))))
            (else (if (char=? char #\newline)
                    (check-indent port indent))
                  (loop (add-char-to-hybrid char hyb)
                        (read-char port))))))

  (define (parse-raw port)
    (case (read-char port)
      ((#!eof) (error-eof))
      ((#\{) (parse-raw-content port default-escape-char (register-indent port)))
      (else => (lambda (escape-char)
                 (consume-char #\{ port)
                 (parse-raw-content port escape-char (register-indent port))))))

  (define (apply-prefixes tokens)
    (define (prefix-lines lines prefix)
      (let ((sub (string-append "\n" prefix)))
        (string-translate* lines `(("\n" . ,sub)))))
    (define (process-non-prefix-expression tokens)
      (if (null? tokens)
        (error-fatal)
        (let ((user-expression (car tokens)))
          (if (not (string? user-expression))
            (error-string-expected user-expression)
            (values user-expression
                    (cdr tokens))))))
    (define (process-prefix-expression tokens)
      (if (or (null? tokens)
              (null? (cdr tokens))
              (not (string? (car tokens))))
        (error-fatal)
        (let ((prefix (car tokens))
              (user-expression (cadr tokens)))
          (if (not (string? user-expression))
            (error-string-expected user-expression)
            (values (prefix-lines user-expression prefix)
                    (cddr tokens))))))
    (let loop ((processed '())
               (unprocessed tokens))
      (if (null? unprocessed)
        processed
        (let ((token (car unprocessed)))
          (cond ((string? token) (loop (cons token processed)
                                       (cdr unprocessed)))
                ((boolean? token)
                 (let-values (((str rest-tokens)
                               ((if token
                                  process-prefix-expression
                                  process-non-prefix-expression)
                                (cdr unprocessed))))
                   (loop (cons str processed)
                         rest-tokens)))
                (else (error-fatal)))))))

  (define (_raw-post-process . tokens)
    (reverse-string-append (apply-prefixes tokens)))

  (define _raw-post-processor-name (make-parameter '_raw-post-process))

  (define (raw-read-syntax port)
    (let ((tokens (parse-raw port)))
        `(,(_raw-post-processor-name) ,@tokens)))

  (set-sharp-read-syntax! sharp-char raw-read-syntax))