;;
;; problem: work out where a starting column of a form on its starting line, need to add
;; this amount to its indent if it is broken
;;
;; TODO:
;;
;; alternative approach: given a form <expr>, ask <expr> recursively
;; to provide the following:
;;
;; { inline: (... <sub-expr> <sub-expr> ...)
;;   broken: (... <newline "  "> <sub-expr> <newline "  "> <sub-expr> ...)  }
;;
;; printer returns <inline> if acceptable, otherwise produces <broken>, recursively deciding on <inline>
;; for each <sub-expr>
;;
;; each <newline "  "> carries the amount of indent required for the containing form, needs to be added to
;; the amount of indent required for outer forms
;;
;;
;;
;; also TODO:
;;
;; use (module pp ...) and remove all those prefixes...
;;

(assign pp/special-forms (hash))
(assign pp/syntaxes      (hash))
(assign pp/newline       (uniq 'newline))
(assign pp/newline/noi   (uniq 'newline/noi))

;; (eq? char "\n") "\\n"
(def pp/esc-ch (char)
  (if (eq? char "\"") "\\\""
      (eq? char "\~") "\\\~"
      (eq? char "\\") "\\\\"
      char))

(def pp/esc-str-literal (txt)
  (joinstr "" (map pp/esc-ch (string-split txt))))

(def pp/string-piece (pp)
  (fn (thing)
      (if (isa 'string thing)
          (pp/esc-str-literal thing)
          "\~~(pp thing)")))

(def pp/string-pieces (pp things) "\"~(joinstr "" (map (pp/string-piece pp) things))\"")

(def pp/kv (hsh)
  (map λk(joinstr " "
                  (pp k)
                  (pp hsh.,k))
       (hash-keys hsh)))

(def pp/literal (thing indent)
  (if (eq? thing '||)            "||"
      (eq? thing pp/newline)     "\n~(joinstr " " indent)"
      (eq? thing pp/newline/noi) "\n~(joinstr " " (cdr indent)) "
      (isa 'string thing)        "\"~(pp/esc-str-literal thing)\""
      (isa 'hash thing)          "{ ~(joinstr " " (pp/kv thing)) }"
      (inspect thing)))

;; define a pretty-printer function for forms beginning with the
;; given name. 'args are usually (form indent), form being the
;; complete form for pretty-printing, and indent being the current
;; indent level.
(mac pp/def (name args . body)
  `(do (hash-set pp/special-forms ',name
                 (fun ,args ,@body))
       (dox-add-doc ',name
                    'pp/def
                    (list "pretty-printer for forms starting with ~(quote ,name)")
                    ',args
                    '(pp/def ,name ,args ,@body))))


(pp/def string-pieces    (pp form indent) (pp/string-pieces pp (cdr form)))
(pp/def quasiquote       (pp form indent) "`~(pp (cadr form) (cons "" indent))" )
(pp/def quote            (pp form indent) "'~(pp (cadr form) (cons "" indent))" )
(pp/def unquote          (pp form indent) ",~(pp (cadr form) (cons "" indent))" )
(pp/def unquote-splicing (pp form indent) ",@~(pp (cadr form) (cons " " indent))")
(pp/def comment          (pp form indent) "; ~(cadr form)\n")
(pp/def prefix-list      (pp form indent) "~(cadr form)~(pp (caddr form))")


(def pp/brace-list-pair (pp (k v) indent) "~k ~(pp v indent)")

(pp/def brace-list (pp form indent)
  "{ ~(joinstr " " (map λe(pprint e (cons " " indent)) (intersperse-splicing pp/newline (pairs:cdr form)))) }")

(def pp/unsyntax (form)
  (if (pair? form)
      (let syntax (hash-get pp/syntaxes (car form))
        (if syntax
            (sym:joinstr syntax (map pp/unsyntax (cdr form)))
            (map pp/unsyntax form)))
      form))

(hash-set pp/syntaxes 'percent-syntax     "%"  )
(hash-set pp/syntaxes 'colon-syntax       ":"  )
(hash-set pp/syntaxes 'dot-syntax         "."  )
(hash-set pp/syntaxes 'bang-syntax        "!"  )
(hash-set pp/syntaxes 'ampersand-syntax   "&"  )
(hash-set pp/syntaxes 'dollar-syntax      "$"  )
(hash-set pp/syntaxes 'colon-colon-syntax "::" )
(hash-set pp/syntaxes 'arrow-syntax       "->" )
(hash-set pp/syntaxes 'rocket-syntax      "=>" )
(hash-set pp/syntaxes 'at-syntax          "@"  )

(def pp/dotify (form)
  (if (pair? form)
      (cons (pp/dotify:car form)
            (if (pair? (cdr form))
                (pp/dotify (cdr form))
                (no:cdr form)
                nil
                (list '. (cdr form))))
      form))

(def pp/split-form (form n)
  (cons (firstn n form)
        (map list (nthcdr n form))))

(def pp/flatly (form)
  (if (pair? form)
      (let special (hash-get pp/special-forms (car form))
        (if special
            (special pp/flatly form nil)
            "(~(joinstr " " (map pp/flatly form)))"))
      (pp/literal form nil)))

(def pp/breaks? (form)
  (and (pair? form)
       (> (len:pp/flatly form) 40)))

(def pp/breaker (form)
  (if (pair? form)
      (let key (car form)
        (if (or (eq? 'if key)
                (eq? 'cond key))
            (pp/split-form form 2)
            (and (hash-get macs key)
                 (!proper? (dox-args key)))
            (pp/split-form form (list-length:dox-args key))
            (pp/split-form form 2)))
      form))

(def pp/break-pair (form)
  (if (pair? form)
      (if (hash-get pp/special-forms (car form))
          form
          (pp/breaks? form)
          (intersperse-splicing pp/newline
                                (pp/breaker (map pp/break-pair form)))
          form)
      form))

(def pp/cleanup (str)
  (string-replace "\\s+\\n" "\n" (string-replace "\\s+\\Z" "" str)))

(def pp/indent (sym indent)
  (if (or (no sym) (pair? sym))
      indent
      (cons (string-replace "." " " " ~sym") indent)))

(def pprint (form indent)
  (if (pair? form)
      (let special-form (hash-get pp/special-forms (car form))
        (if special-form
            (special-form pp/printer form indent)
            (let new-indent (pp/indent (car form) indent)
              (let contents (joinstr " " (map λe(pprint e new-indent) form))
                "(~contents)"))))
      (pp/literal form indent)))

(def pp/with-args (wargs)
  (if (> (len (pp/flatly wargs)) 40)
      (intersperse-splicing pp/newline/noi
                            (pairs wargs))
      wargs))

(pp/def with (pp form indent)
        (let wargs (pp/with-args (cadr form))
          (let broken (intersperse pp/newline
                                   (map pp/break-pair
                                        (cddr form)))
            (let wbody `(,wargs ,pp/newline ,@broken)
              "(with ~(joinstr " " (map λe(pprint e (cons "     " indent)) wbody)))"))))

(def pp/printer (form indent)
  (if (pair? form)
      (pprint (pp/break-pair form) indent)
      (pp/literal form indent)))

;; better than (def pp (form) (inspect form))
(def pp (form) (pp/cleanup:pp/printer (pp/dotify:pp/unsyntax form) nil))

;; use the pretty-printer to elegantly display the given source code
(def dox-show-src (src)
  (pp src))

;; use 'pp/unsyntax to convert 'def and 'mac names back to a symbol
;; so (mac dsl.foo (a1 a2) ...) will be documented as "dsl.foo"
(def dox-build-def-name (name)
  (pp/unsyntax name))