(in-package :parse)

(defparameter *error* nil)

(defparameter *root-scope* nil
  "The first scope")

(defparameter *active-scope* nil
  "The scope that will receive the next command")

(defclass scope ()
  ((parent
     :initform nil
     :initarg :parent
     :reader parent)
   (errors
     :initform nil
     :accessor errors)))

(defmethod scope-name ((scope scope))
  (class-name (class-of scope)))

(defmethod empty-p ((scope scope)) nil)

(defmethod grandparent ((scope scope))
  (parent (parent scope)))

(defmethod great-grandparent ((scope scope))
  (parent (grandparent scope)))

(defmethod has-errors-p ((scope scope))
  (not (null (errors scope))))

(defmethod add-error ((scope scope) (scope-error scope-error))
  (setf (errors scope)
    (cons scope-error (errors scope)))
  (setf *error* t)
  scope)

(defmethod close-scope ((scope scope) &optional command)
  (setf *active-scope* (parent scope))
  scope)

(defmethod execute-command ((scope scope) command)
  (case command
    (t (add-error scope (make-no-function-error (scope-name scope) command)))))

(defun print-scope-errors (errors level)
  (when errors
    (let
      ((scope-error (first errors)))
      (format t "~%~A error: ~A"
        (make-string (* 2 level) :initial-element #\\-)
        (value scope-error)))
      (print-scope-errors (rest errors) level)))

(defmethod print-scope ((scope scope) &key (level 0))
  (format t "~%~A ~A"
    (make-string (* 2 level) :initial-element #\\-)
    (scope-name scope))
  (when (has-errors-p scope)
    (let*
      ((errors (errors scope))
       (number (length errors)))
      (format t ": (~A error~A)"
        number
        (if (= 1 number) "" "s"))
      (print-scope-errors (reverse errors) (+ 1 level)))))

(defclass content-scope (scope)
  ((content
     :initform nil
     :accessor content)))

(defmethod empty-p ((content-scope content-scope))
  (null (content content-scope)))

(defmethod append-content ((content-scope content-scope) char)
  (setf (content content-scope) (cons char (content content-scope))))

(defmethod print-scope ((content-scope content-scope) &key)
  (call-next-method)
  (unless (has-errors-p content-scope)
    (format t ": ~A" (reverse (content content-scope)))))

(defclass container-scope (scope)
  ((children
     :initform nil
     :accessor children)))

(defmethod empty-p ((container-scope container-scope))
  (null (children container-scope)))

(defmethod open-child ((container-scope container-scope) &optional scope-type)
  (let
    ((new-child
       (make-instance (or scope-type (quote scope)) :parent container-scope)))
    (setf (children container-scope) (cons new-child (children container-scope)))
    (setf *active-scope* new-child)
    new-child))

(defun print-child-scopes (child-scopes level)
  (when child-scopes
    (let
      ((child (first child-scopes)))
      (print-scope child :level (+ 1 level))
      (print-child-scopes (rest child-scopes) level))))

(defmethod print-scope ((container-scope container-scope) &key (level 0))
  (call-next-method)
  (unless (has-errors-p container-scope)
    (print-child-scopes (reverse (children container-scope)) level)))