;;; Arl Standard Library - Display Helpers

(module display
  (export format-value display println string-concat trace)

  (import strings :refer (string-join))
  (import dict :refer (dict? dict-keys dict-get))
  (import set :refer (set?))
  (import core :refer (r-call values?))

  ;; Format atomic values to a single string.
  ;; Character strings are quoted so they are distinguishable from symbols.
  (define _format-atomic
    (lambda (x)
      (define parts (as.character x))
      (if (= (length parts) 0)
        ""
        (if (is.character x)
          (if (= (length parts) 1)
            (string-join (list "\"" (r-call "[[" (list parts 1)) "\"") "")
            (string-join (lapply (_as-list parts)
                           (lambda (s) (string-join (list "\"" s "\"") ""))) " "))
          (if (= (length parts) 1)
            (as.character parts)
            (string-join parts " "))))))

  ;; Format list/call contents with spaces.
  (define _format-seq
    (lambda (items)
      (define parts (lapply (_as-list items) format-value))
      (if (= (length parts) 0)
        ""
        (string-join parts " "))))

  ;; Format functions/macros/closures.
  (define _format-function
    (lambda (x)
      (if (r-call "inherits" (list x "arl_closure"))
        "<closure>"
        (if (r-call "is.function" (list x))
          (if (r-call "is.null" (list (r-call "attr" (list x "arl_macro" :exact #t))))
            "<function>"
            "<macro>")
          #nil))))

  ;; Format environments (excluding dict, set, promise).
  (define _format-environment
    (lambda (x)
      (if (and (r-call "is.environment" (list x))
               (not (dict? x))
               (not (set? x))
               (not (promise? x)))
        (begin
          (define classes (r-call "class" (list x)))
          (define class-str (if (> (length classes) 0)
                              (r-call "paste" (list classes :collapse ", "))
                              "environment"))
          (string-join (list "<" class-str ">") ""))
        #nil)))

  ;; Format named lists with keyword-style keys: (:key1 val1 :key2 val2).
  (define _format-named-list
    (lambda (x)
      (define nms (r-call "names" (list x)))
      (if (or (r-call "is.null" (list nms))
              (r-call "all" (list (r-call "==" (list nms "")))))
        #nil
        (begin
          (define parts (list))
          (define i 1)
          (while (<= i (length x))
            (begin
              (define nm (r-call "[[" (list nms i)))
              (define val (r-call "[[" (list x i)))
              (if (!= nm "")
                (set! parts (c parts (list (string-join (list ":" nm) "")
                                           (format-value val))))
                (set! parts (c parts (list (format-value val)))))
              (set! i (+ i 1))))
          (string-join (list "(" (string-join parts " ") ")") "")))))

  ;; Helper: capture R print output as character vector.
  (define _capture-print
    (r-call "eval" (list (r-call "parse" (list :text "function(obj) capture.output(print(obj))")))))

  ;; Format S3 objects with non-trivial class using R's print method.
  ;; Output is truncated at arl.display.max.lines (default 20, Inf to disable).
  (define _format-s3-object
    (lambda (x)
      (define cls (r-call "class" (list x)))
      ;; Only apply to lists with real S3 classes (not just "list" or "data.frame")
      (if (and (is.list x)
               (not (r-call "is.null" (list cls)))
               (not (r-call "all" (list (r-call "%in%" (list cls (c "list" "data.frame")))))))
        (begin
          (define lines (_capture-print x))
          (define max-lines-opt (r-call "getOption" (list "arl.display.max.lines" #nil)))
          (define max-lines-env (r-call "Sys.getenv" (list "ARL_DISPLAY_MAX_LINES" "")))
          (define max-lines
            (if (not (r-call "is.null" (list max-lines-opt)))
              max-lines-opt
              (if (!= max-lines-env "")
                (r-call "as.numeric" (list max-lines-env))
                20)))
          (if (or (r-call "is.infinite" (list max-lines))
                  (<= (length lines) max-lines))
            (string-join lines "\n")
            (string-join
              (c (r-call "head" (list lines max-lines))
                 (string-join (list "... (output truncated at " (as.character max-lines)
                                    " lines; set options(arl.display.max.lines=) to change)") ""))
              "\n")))
        #nil)))

  ;;' @description Format value for display.
  ;;' @param x Value to format as a string
  (define format-value
    (lambda (x)
      (define fn-tag (_format-function x))
      (if (not (is.null fn-tag))
        fn-tag
        (begin
          ;; Check dotted pair before environment
          ;; (R6 instances are environments in R)
          (if (pair? x)
              (begin
                (define parts (.__cons-parts x))
                (define prefix (r-call "[[" (list parts "prefix")))
                (define tail (r-call "[[" (list parts "tail")))
                (define head-str (if (= (length prefix) 0)
                  ""
                  (string-join (lapply prefix format-value) " ")))
                (define tail-str (format-value tail))
                (string-join (list "(" head-str " . " tail-str ")") ""))
              (begin
                (define env-tag (_format-environment x))
                (if (not (is.null env-tag))
                  env-tag
                  (if (values? x)
                (begin
                  (define inner (r-call "unclass" (list x)))
                  (if (= (length inner) 0)
                    "(values)"
                    (string-join (append (list "(values") (lapply inner format-value) (list ")")) " ")))
                (if (dict? x)
                  (begin
                    (define keys (dict-keys x))
                    (define values (lapply keys (lambda (k) (dict-get x k))))
                    (_format-seq values))
                  (if (set? x)
                    (_format-seq (r-call "as.list" (list x :all.names #t)))
                    (if (promise? x)
                      "<promise>"
                      (if (is.symbol x)
                        (as.character x)
                        (begin
                          ;; Check S3 object before named-list before generic list
                          (define s3-tag (_format-s3-object x))
                          (if (not (is.null s3-tag))
                            s3-tag
                            (begin
                              (define named-tag (_format-named-list x))
                              (if (not (is.null named-tag))
                                named-tag
                                (if (or (is.call x) (is.list x))
                                  (string-join (list "(" (_format-seq x) ")") "")
                                  (_format-atomic x))))))))))))))))))

  ;;' @section Display and Output
  ;;' Functions for formatting and printing values.

  ;;' @description Print value with newline.
  ;;' @param x Value to print
  ;;' @examples
  ;;' (display 42)             ; prints "42" with newline
  ;;' (display "hello")        ; prints "hello" with newline
  ;;' (display (list 1 2 3))   ; prints "(1 2 3)" with newline
  ;;' @seealso println, trace
  (define display
    (lambda (x)
      (define quiet-env (r-call "Sys.getenv" (list "ARL_QUIET" "")))
      (define quiet-opt (r-call "getOption" (list "arl.quiet" #f)))
      (if (or (!= quiet-env "") (= quiet-opt #t))
        #nil
        (r-call "cat" (list (format-value x) "\n")))))

  ;;' @description Alias for display.
  ;;' @param x Value to print
  ;;' @examples
  ;;' (println 42)               ; prints "42\n"
  ;;' (println (list 1 2 3))     ; prints "(1 2 3)\n"
  ;;' @seealso display
  (define println
    (lambda (x)
      (display x)))

  ;;' @description Concatenate values into a string.
  ;;' Strings are included as-is (unquoted); other values are formatted.
  ;;' @param args Values to concatenate together
  ;;' @examples
  ;;' (string-concat "hello" " " "world")  ; => "hello world"
  ;;' (string-concat 1 "+" 2)              ; => "1+2"
  ;;' @assert
  ;;' (assert-equal "hello world" (string-concat "hello" " " "world"))
  ;;' (assert-equal "1+2" (string-concat 1 "+" 2))
  ;;' @seealso string-join, string-format
  (define string-concat
    (lambda (. args)
      (define parts (lapply (_as-list args)
                      (lambda (x)
                        (if (is.character x)
                          (as.character x)
                          (format-value x)))))
      (if (= (length parts) 0)
        ""
        (string-join parts ""))))

  ;;' @description Print value and return it.
  ;;' @param x Value to print and return
  ;;' @param rest Optional label string to prefix the output
  ;;' @examples
  ;;' (trace 42)               ; prints "42", returns 42
  ;;' (trace 42 "result")      ; prints "result: 42", returns 42
  ;;' @seealso warn, display
  (define trace
    (lambda (x . rest)
      (define label (if (> (length rest) 0) (car rest) #nil))
      (define quiet-env (r-call "Sys.getenv" (list "ARL_QUIET" "")))
      (define quiet-opt (r-call "getOption" (list "arl.quiet" #f)))
      (if (or (!= quiet-env "") (= quiet-opt #t))
        x
        (begin
          (if (is.null label)
            #nil
            (r-call "cat" (list (format-value label) ": ")))
          (r-call "cat" (list (format-value x) "\n"))
          x))))
)
