src/model/settings.lisp

(in-package :murja.model.settings)

(named-readtables:in-readtable :murja.ps)

(eval-when (:compile-toplevel :load-toplevel :execute)

  (defclass Setting ()
    ((setting-name :initarg :name :accessor setting-name-access :initform (error "Name needed"))
     (default-value :initarg :default-value :initform (error "Value needed"))))

  ;; (defmethod print-object ((obj person) stream)
  ;;     (print-unreadable-object (obj stream :type t)
  ;;       (with-accessors ((name name)
  ;;                        (lisper lisper))
  ;;           obj
  ;;         (format stream "~a, lisper: ~a" name lisper))))

  (defmethod print-object ((s Setting) output)
    (print-unreadable-object (s output :type t) 
      (with-slots (setting-name default-value) s
	(format output "~a - default: ~a" setting-name default-value))))
  
  (defvar *setting-fields* nil
    "A list that's used to populate Settings-class")
  (defvar *setting->getter* (make-hash-table :test 'equal))
  (defvar *inside-defsetting?* nil))

(defun update-setting (k v)
  (postmodern:execute "INSERT INTO blog.Settings (key, value) VALUES ($1, $2) ON CONFLICT (key) DO UPDATE SET value = excluded.value" k (stringify v)))

(defparameter setting-name-cleaner (alexandria:compose (alexandria:curry #'str:replace-all ":" "")
						       #'string-downcase
						       #'prin1-to-string
						       #'setting-name-access))

(defparameter setting-name-kwcleaner (alexandria:compose (alexandria:curry #'str:replace-all ":" "")
							 #'string-downcase
							 #'prin1-to-string))

(defun all-setting-names ()
  "Returns all known setting names as \"strings\""
  (map 'list setting-name-cleaner
       *setting-fields*))

(defun setting-getter (setting-name-str)
  (gethash setting-name-str *setting->getter*))

;; a stupid hack
(defun kw-to-sym (kw)
  (read-from-string (str:replace-all ":" "" (prin1-to-string kw))))

(defmacro defsetting (name default-value)
  "Sets up a setting and its default value. Please call this inside (define-settings)"
  (unless (some (lambda (setting)
		  (with-slots (setting-name) setting
		    (equalp name setting-name)))
		*setting-fields*)
    (push (make-instance 'Setting :name (read-from-string (format nil ":~a" name)) :default-value default-value) *setting-fields*))
  `(progn
     (assert *inside-defsetting?* nil "Please wrap `(defsetting ~a ~a)` inside a define-settings macro" ,(prin1-to-string name) ,(prin1-to-string default-value))
     (quote ,name)))

(defmacro create-settings ()
  `(progn
     ,@(map 'list
	    (lambda (setting)
	      (with-slots (setting-name default-value) setting
		`(progn
		   (defun ,(kw-to-sym setting-name) (&optional value)
		     ,(format nil "If called without parameters, returns current value of ~a. If with parameters, update's setting's value both in-app and in db" setting-name)
		     (murja.middleware.db:with-db
		       (postmodern:execute "INSERT INTO blog.settings VALUES ($1, $2) ON CONFLICT DO NOTHING" ,(prin1-to-string (kw-to-sym setting-name)) ,(format nil "~s" default-value))
		       (if value
			   (progn
			     (update-setting ,(prin1-to-string (kw-to-sym setting-name)) value)
			     value)
			   (parse 
			    (caar (postmodern:query "SELECT value FROM blog.settings WHERE key = $1" ,(prin1-to-string (kw-to-sym setting-name))))))))
		   (setf (gethash ,(funcall setting-name-kwcleaner setting-name)
				  *setting->getter*)
			 (function ,(kw-to-sym setting-name))))))
		
	    *setting-fields*)

     'Settings))

(defmacro define-settings (&body body)
  "Resets the settings (it's an error to call define-settings twice, but it doesn't throw as resetting the old settings in REPL is a feature) and after running through defsettings, creates the final setting getters and setters. Refer to package :documentation on example how to use this"
  (setf *setting-fields* nil
	*setting->getter* (make-hash-table :test 'equal))

  (let ((*inside-defsetting?* t))
    `(let ((*inside-defsetting?* t))
	 ,@(map 'list
		(lambda (config)
		  (destructuring-bind (name value . _) config
		    (declare (ignore _))
		    `(defsetting ,name ,value)))
		body)
       (create-settings))))
  

;; (defsetting random-size 45)

;; (page-size) => 45
;; (page-size 23456)
;; (page-size) => 23456

  ;; (setf *setting-fields* nil)