(in-package :first-light.prefab)

(defclass node ()
  ((%name :reader name
          :initarg :name)
   (%prefab :reader prefab
            :initarg :prefab)
   (%data :reader data
          :initarg :data)
   (%path :reader path
          :initarg :path)
   (%components :reader components
                :initform (fl.util:dict #'eq))
   (%parent :reader parent
            :initarg :parent
            :initform nil)
   (%children :reader children
              :initform (fl.util:dict #'equal))
   (%merge-policy :reader merge-policy
                  :initarg :merge-policy)))

(fl.util:define-printer (node stream :type t)
  (format stream "~a" (path node)))

(defun make-node-path (parent name)
  (concatenate 'string (when parent (path parent)) "/" name))

(defun make-node (name data &key prefab parent merge-policy)
  (let* ((prefab (or prefab (prefab parent)))
         (path (make-node-path parent name))
         (node (make-instance 'node
                              :prefab prefab
                              :name name
                              :path path
                              :data data
                              :parent parent
                              :merge-policy merge-policy)))
    (check/node-path-unused prefab path)
    (setf (fl.util:href (paths prefab) path) node)))

(defun find-node (path library-name &optional error-p)
  (let* ((prefab-name (first (explode-path path)))
         (prefab (find-prefab prefab-name library-name)))
    (or (fl.util:href (paths prefab) path)
        (when error-p
          (error "Node path ~s not found in prefab ~s." path prefab-name)))))

(defgeneric add-child (mode parent data &key &allow-other-keys))

(defmethod add-child ((mode (eql :new)) parent data &key target)
  (let* ((path-parts (explode-path target))
         (name (first path-parts))
         (new-data (rest (reduce #'list
                                 (butlast path-parts)
                                 :initial-value (cons (car (last path-parts)) data)
                                 :from-end t)))
         (child (make-node name new-data :parent parent)))
    (parse-prefab child new-data)))

(defmethod add-child ((mode (eql :copy)) parent data &key from source target)
  (check/mode-source mode parent source)
  (let ((source-data (data (find-node source from t))))
    (add-child :new parent source-data :target target)))

(defun make-link (source-path source-library target target-library)
  (let* ((source-node (find-node source-path source-library t))
         (target-key (cons target-library (path target))))
    (with-slots (%prefab %path) source-node
      (symbol-macrolet ((targets (fl.util:href (source->targets %prefab) %path)))
        (setf (fl.util:href (target->source %prefab) target-key) %path)
        (unless targets
          (setf targets (fl.util:dict #'equalp)))
        (setf (fl.util:href targets target-key) target)))))

(defmethod add-child ((mode (eql :link)) parent data &key from to source target)
  (check/mode-source mode parent source)
  (let* ((source-data (data (find-node source from t)))
         (child (add-child :new parent source-data :target target))
         (target (find-node (make-node-path parent target) to t)))
    (make-link source from target to)
    child))

#++(defmethod add-child ((mode (eql :link)) parent data &key source target)
     (check/mode-source mode parent source)
     (destructuring-bind (source-library source-path) source
       (let ((source-node (find-node source-path source-library t))
             (target-path (make-node-path parent target)))
         (with-slots (%prefab) source-node
           (with-slots (%target->source %source->targets) %prefab
             (let ((child (add-child :new parent (data source-node) :target target)))
               (make-link source-node)
               (setf (fl.util:href %target->source target-path) source-path)
               (make-source->target-link source-node target-path)
               child))))))