(import /src/base :as b)

(defn- get-line [source line]
 ((string/split "\n" source) (dec line)))

(defn- caret [source line start]
 (def lines (string/split "\n" source))
 (def the-line (lines (dec line)))
 (def prev-lines (slice lines 0 (dec line)))
 (def char-counts (map (fn [x] (-> x length inc)) prev-lines))
 (def prev-line-chars (sum char-counts))
 (def offset (- start prev-line-chars))
 (def indent (string/repeat "." (+ 6 offset)))
 (string indent "^")
)


(defn scan-error [e] 
 (def {:line line-num :input input :source source :start start :msg msg} e)
 (print "Syntax error: " msg)
 (print "  on line " line-num " in " input ":")
 (def source-line (get-line source line-num))
 (print "  >>> " source-line)
 (print (caret source line-num start))
 e)

(defn parse-error [e] 
 (def msg (e :msg))
 (def {:line line-num :input input :source source :start start} (e :token))
 (def source-line (get-line source line-num))
 (print "Syntax error: " msg)
 (print "  on line " line-num " in " input ":")
 (print "  >>> " source-line)
 (print (caret source line-num start))
 e)

(defn validation-error [e]
 (def msg (e :msg))
 (def {:line line-num :input input :source source :start start} (get-in e [:node :token]))
 (def source-line (get-line source line-num))
 (case msg
  "unbound name"
  (do
   (print "Validation error: " msg " " (get-in e [:node :data]))
   (print "  on line " line-num " in " input ":")
   (print "  >>> " source-line)
   (print (caret source line-num start)))
  (do
   (print "Validation error: " msg)
   (print "  on line " line-num " in " input ":")
   (print "  >>> " source-line)
   (print (caret source line-num start))))
 e)

(defn- fn-no-match [e]
 (print "Ludus panicked! no match")
 (def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
 (def source-line (get-line source line-num))
 (print "  on line " line-num " in " input ", ")
 (def called (e :called))
 (print "  calling: " (slice (b/show called) 3))
 (def value (e :value))
 (print "  with arguments: " (b/show value))
 (print "  expected match with one of:")
 (def patterns (b/pretty-patterns called))
 (def fmt-patt (do
  (def lines (string/split "\n" patterns))
  (def indented (map (fn [x] (string "    " x)) lines))
  (string/join indented "\n")
  ))
 (print fmt-patt)
 (print "  >>> " source-line)
 (print (caret source line-num start))
 )

(defn- let-no-match [e]
 (print "Ludus panicked! no match")
 (def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
 (def source-line (get-line source line-num))
 (print "  on line " line-num " in " input ", ")
 (print "  binding " (b/show (e :value)))
 (def pattern (get-in e [:node :data 0]))
 (print "  to " (b/show-patt pattern))
 (print "  >>> " source-line)
 (print (caret source line-num start))
 e)

(defn- generic-panic [e]
 (def msg (e :msg))
 (def {:line line-num :source source :input input} (get-in e [:node :token]))
 (def source-line (get-line source line-num))
 (print "Ludus panicked! " msg)
 (print "  on line " line-num " in " input ":")
 (print "  >>> " source-line))

(defn- unbound-name [e]
 (def {:line line-num :source source :lexeme name :input input} (get-in e [:node :token]))
 (def source-line (get-line source line-num))
 (print "Ludus panicked! unbound name " name)
 (print "  on line " line-num " in " input ":")
 (print "  >>> " source-line))

(defn runtime-error [e]
 (when (= :string (type e)) 
  (print (string "Internal Ludus error: " e)) 
  (print "Please file an issue at https://alea.ludus.dev/twc/ludus/issues")
  (break e))
 (def msg (e :msg))
 (case msg
  "no match: function call" (fn-no-match e)
  "no match: let binding" (let-no-match e)
  "unbound name" (unbound-name e)
  (generic-panic e))
 e)