;;;; cl-scopes/config

;;;; Utilities for configuration of scopes services.

(defpackage :scopes/config
  (:use :common-lisp)
  (:export #:base #:root
           #:env-data #:env-keys #:env-prefix #:env-path 
           #:add #:children #:parent
           #:hash-to-slots))

(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

(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)
          (setf (gethash sl data) dotenv-val))))))

;;;; config base class

(defclass base (common)
  ((parent :reader parent
           :initarg :parent)))

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

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

(defgeneric add (cfg child)
  (:method ((cfg common) (child base))
    (push child (children cfg))
    (setf (parent child) cfg)))

(defmethod env-data ((cfg base))
  (env-data (parent cfg)))

;;;; utility functions

(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))))))