;;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
;;;
;;; Copyright (c) 2009 by the authors.
;;;
;;; See LICENCE for details.

(in-package :hu.dwim.projectional-editor)

;;;;;;;;
;;;; JSON domain provides:
;;;;  - null, boolean, number, string, array, object

;;;;;;
;;; JSON document classes

(def class* json/base ()
  ())

(def class* json/null (json/base)
  ())

(def class* json/boolean (json/base)
  ((value :type boolean)))

(def class* json/number (json/base)
  ((value :type number)))

(def class* json/string (json/base)
  ((text :type string)))

(def class* json/array (json/base)
  ((elements :type sequence)))

(def class* json/object (json/base)
  ((key-value-map :type hash-table)))

;;;;;;
;;; JSON document constructors

(def (function e) make-json/null ()
  (make-instance 'json/null))

(def (function e) make-json/boolean (value)
  (make-instance 'json/boolean :value value))

(def (function e) make-json/number (value)
  (make-instance 'json/number :value value))

(def (function e) make-json/string (text)
  (make-instance 'json/string :text text))

(def (function e) make-json/array (elements)
  (make-instance 'json/array :elements elements))

(def (function e) make-json/object (key-value-map)
  (make-instance 'json/object :key-value-map key-value-map))

;;;;;;
;;; JSON provider

(def (function e) json-color-provider (iomap reference)
  (map-backward iomap reference
                (lambda (iomap reference)
                  (declare (ignore iomap))
                  (pattern-case reference
                    ((the character (elt (the string (?or (opening-delimiter ?a)
                                                          (closing-delimiter ?a))) ?b))
                     (return-from json-color-provider
                       (sdl:color :r 196 :g 196 :b 196)))
                    ((the character (elt (the string (name-of (the json/null ?a))) ?b))
                     (return-from json-color-provider
                       (sdl:color :r 196 :g 0 :b 0)))
                    ((the character (elt (the string (name-of (the json/boolean ?a))) ?b))
                     (return-from json-color-provider
                       (sdl:color :r 0 :g 0 :b 196)))
                    ((the character (elt (the string (write-to-string (the number (value-of (the json/number ?a))))) ?b))
                     (return-from json-color-provider
                       (sdl:color :r 196 :g 196 :b 0)))
                    ((the character (elt (the string (text-of (the json/string ?a))) ?b))
                     (return-from json-color-provider
                       (sdl:color :r 0 :g 196 :b 0)))
                    ((the character (elt (the string (entry-key ?a)) ?b))
                     (return-from json-color-provider
                       (sdl:color :r 0 :g 196 :b 0)))))))

(def (function e) json-delimiter-provider (iomap reference)
  (pattern-case reference
    ((?or (opening-delimiter ?node)
          (closing-delimiter ?node))
     (bind ((delimiter (first reference)))
       (map-backward iomap ?node
                     (lambda (iomap reference)
                       (declare (ignore iomap))
                       (pattern-case reference
                         ;; [ and ] around arrays
                         ((the json/array ?a)
                          (return-from json-delimiter-provider
                            (ecase delimiter
                              (opening-delimiter "[")
                              (closing-delimiter "]"))))
                         ;; { and } around objects
                         ((the json/object ?a)
                          (return-from json-delimiter-provider
                            (ecase delimiter
                              (opening-delimiter "{")
                              (closing-delimiter "}")))))))))))

(def (function e) json-separator-provider (iomap previous-child-reference next-child-reference)
  (declare (ignore previous-child-reference))
  (map-backward iomap next-child-reference
                (lambda (iomap reference)
                  (declare (ignore iomap))
                  (pattern-case reference
                    ;; , between array elements and object entries
                    ((?or (the ?a (gethash-entry ?b (the json/object ?c)))
                          (the ?a (elt (the list (elements-of (the json/array ?b))) ?c)))
                     (return-from json-separator-provider ", "))
                    ;; : between object entry name and value
                    ((the ?a (gethash ?b (key-value-map-of (the json/object ?c))))
                     (return-from json-separator-provider " : "))))))

(def (function e) json-indentation-provider (iomap previous-child-reference next-child-reference)
  (declare (ignore previous-child-reference))
  (map-backward iomap next-child-reference
                (lambda (iomap reference)
                  (declare (ignore iomap))
                  (pattern-case reference
                    ;; new line after array elements
                    ((the ?a (elt (the list (elements-of (the json/array ?b))) ?c))
                     (when (> ?c 0)
                       (return-from json-indentation-provider 1)))
                    ;; new line after object entries
                    ((the t (gethash-entry ?a (the json/object ?b)))
                     ;; TODO: no indentation after the first element
                     (return-from json-indentation-provider 1))))))