#lang racket/base

(provide emit
         (struct-out vertical-mode)
         (struct-out separated)
         (struct-out grouped))

(require racket/match)
(require (only-in racket/string string-trim))
(require (only-in racket/pretty pretty-print-columns))
(require (only-in racket/port call-with-output-string))

;; mode ∈ {'never, 'variable, 'always, 'extra-newline}
;;
;; Things that don't know how to write themselves vertically always write horizontally.
;; Otherwise, mode is relevant:
;;
;;  - 'never: always horizontally
;;  - 'variable: horizontally, unless it doesn't fit, in which case vertically
;;  - 'always: always vertically
;;  - 'extra-newline: as 'normal, but with extra newlines separating items
;;
(struct vertical-mode (mode item) #:transparent)

(struct separated (items separator terminator) #:transparent)
(struct grouped separated (opener closer) #:transparent)

(struct emitter (port indentation) #:transparent)

(define (emit-seq vs sep ter e indent mode)
  (let loop ((vs vs) (need-sep #f))
    (match vs
      ['()
       (when need-sep (display ter (emitter-port e)))]
      [(cons v vs)
       (when need-sep (display sep (emitter-port e)))
       (emit* v e indent mode)
       (loop vs #t)])))

(define (emit-vertical print-indent-if-vertical? vs sep ter e indent mode)
  (when print-indent-if-vertical? (display indent (emitter-port e)))
  (emit-seq vs (string-append (trim-delimiter sep) indent) (trim-delimiter ter) e indent mode))

(define (trim-delimiter s)
  (string-trim #:left? #f s #px"[ \t\f\v]+"))

(define (try-horizontal vs sep ter e indent mode)
  (call-with-output-string
   (lambda (p)
     (emit-seq vs sep ter (emitter p (emitter-indentation e)) indent 'never))))

(define (emit-separated print-indent-if-vertical? vs sep ter e indent mode)
  (match mode
    ['never (emit-seq vs sep ter e indent mode) #f]
    ['variable (let ((s (try-horizontal vs sep ter e indent mode)))
                 (if (> (string-length s) (pretty-print-columns))
                     (begin (emit-vertical print-indent-if-vertical? vs sep ter e indent mode) #t)
                     (begin (display s (emitter-port e)) #f)))]
    ['always (emit-vertical print-indent-if-vertical? vs sep ter e indent mode) #t]
    ['extra-newline (emit-vertical print-indent-if-vertical?
                                   vs
                                   (and sep (string-append sep "\n"))
                                   ter
                                   e
                                   indent
                                   mode) #t]))

(define (emit* v e indent mode)
  (define (w v) (emit* v e indent mode))
  (match v
    [(? string? s) (display s (emitter-port e))]
    [(? list? vs) (map w vs)]
    [(grouped vs sep ter op cl)
     (display op (emitter-port e))
     (when (emit-separated #t vs sep ter e (string-append indent (emitter-indentation e)) mode)
       (display indent (emitter-port e)))
     (display cl (emitter-port e))]
    [(separated vs sep ter) (emit-separated #f vs sep ter e indent mode)]
    [(vertical-mode new-mode v) (emit* v e indent new-mode)]))

(define (emit v [o (current-output-port)]
              #:mode [initial-mode 'variable]
              #:indentation [indentation0 "    "]
              #:initial-indent [initial-indent "\n"])
  (define indentation (if (number? indentation0) (make-string indentation0 #\space) indentation0))
  (emit* v (emitter o indentation) initial-indent initial-mode))