;;;; cl-scopes/config

;;;; Utilities for configuration of scopes services.

(defpackage :scopes/config
  (:use :common-lisp)
  (:local-nicknames (:util :scopes/util))
  (:export #:base #:root #:*root* #:*current*
           #:env-data #:env-keys #:env-prefix #:env-path #:from-env
           #:actions #:add #:add-action #:add-actions #:children
           #:name #:setup #:parent #:shutdown))

(in-package :scopes/config)

;;;; common base class for all config classes

(defclass common ()
  ((children :accessor children
             :initarg children
             :initform nil)))

(defgeneric parent (cfg)
  (:method ((cfg common)) nil))

;;;; config root (top-level) class with no parent

(defvar *root* nil)
(defvar *current* nil)

(defclass root (common) 
  ((env-keys :reader env-keys :initarg :env-keys :initform nil)
   (env-prefix :reader env-prefix :initarg :env-prefix :initform "SCOPES_")
   (env-path :reader env-path :initarg :env-path :initform nil)
   (env-data :accessor env-data :initform (make-hash-table))))

(defmethod initialize-instance :after ((cfg root) &key &allow-other-keys)
  (let* ((data (env-data cfg))
         (prefix (env-prefix cfg))
         (ep (env-path cfg))
         (dotenv-data (if ep (dotenv:read-env ep))))
    (dolist (sl (env-keys cfg))
      (let* ((key (str:concat prefix (string sl)))
             (env-val (uiop:getenv key))
             (dotenv-val (if dotenv-data (gethash key dotenv-data))))
        (if env-val
          (setf (gethash sl data) env-val)
          (when dotenv-val 
            (setf (uiop:getenv key) dotenv-val)
            (setf (gethash sl data) dotenv-val)))))))

(defun root (&rest params &key (class 'root) &allow-other-keys)
  (setf *root* (apply #'make-instance class params)))

;;;; config base class

(defclass base (common)
  ((name :reader name :initarg :name)
   (parent :accessor parent :initarg :parent)
   (setup :reader setup :initarg :setup :initform #'(lambda (cfg)))
   (shutdown :reader shutdown :initarg :shutdown :initform #'(lambda (ctx)))
   (actions :accessor actions :initarg :actions :initform nil)))

(defmethod initialize-instance :after ((cfg base) &key parent &allow-other-keys)
  (if parent
    (push cfg (children parent))))

(defmethod (setf parent) ((cfg base) (parent common))
  (setf (parent cfg) parent)
  (push cfg (children parent)))

(defun add (name &rest params
                 &key (class 'base) (parent *root*)
                 &allow-other-keys)
  (setf *current* (apply #'make-instance class :parent parent :name name params)))

(defun add-action (pattern handler &rest params &key (cfg *current*))
  (if params
    (setf handler #'(lambda (ctx msg) (apply handler ctx msg params))))
  (push (list pattern handler) (actions cfg)))

(defun add-actions (&rest acts)
  (dolist (act acts)
    (apply #'add-action (car act) (cadr act) (cddr act))))

;;;; utility functions

(defun from-env (key &optional (default ""))
  (or (gethash key (env-data *root*)) default))

(defun hash-to-slots (ht obj slots)
  (if ht
    (dolist (sl slots)
      (let* ((key (intern (string sl) :keyword))
             (val (gethash key ht)))
        (if val
          (setf (slot-value obj sl) val))))))