diff options
Diffstat (limited to 'src/config.lisp')
| -rw-r--r-- | src/config.lisp | 97 |
1 files changed, 70 insertions, 27 deletions
diff --git a/src/config.lisp b/src/config.lisp index 55575bb..03ded98 100644 --- a/src/config.lisp +++ b/src/config.lisp | |||
| @@ -1,33 +1,76 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | 1 | ;; SPDX-License-Identifier: EUPL-1.2 |
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> |
| 3 | (defpackage :ukkoclot/config | 3 | (defpackage :ukkoclot/config |
| 4 | (:use :c2cl :ukkoclot/hash-tables) | 4 | (:documentation "Stuff for loading the configuration of the bot") |
| 5 | (:documentation | 5 | (:nicknames :conf) |
| 6 | "Stuff for loading the configuration of the bot") | 6 | (:use :c2cl :iterate) |
| 7 | (:export | 7 | (:export |
| 8 | :config-load :config-merge | 8 | #:*config* |
| 9 | :config-p | 9 | #:config |
| 10 | :config-bot-name :config-bot-token :config-db-path :config-dev-group :config-owner)) | 10 | #:make-config |
| 11 | #:config-p | ||
| 12 | #:copy-config | ||
| 13 | #:load-config | ||
| 14 | #:print-default | ||
| 15 | #:bot-name | ||
| 16 | #:bot-token | ||
| 17 | #:db-path | ||
| 18 | #:dev-group | ||
| 19 | #:owner)) | ||
| 11 | (in-package :ukkoclot/config) | 20 | (in-package :ukkoclot/config) |
| 12 | 21 | ||
| 13 | (defmacro defconfig (&rest slots-and-types) | 22 | (defstruct config |
| 14 | "Macro to make the config struct creation easier." | 23 | (bot-name "Ukko's Clot" :type string) |
| 15 | `(defstruct config | 24 | (bot-token "123456789:ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghi" :type string) |
| 16 | ,@(loop for (name type) on slots-and-types by #'cddr | 25 | (db-path #P"./data.db" :type (or pathname string)) |
| 17 | collect `(,(intern (symbol-name name)) (error "No value given for ~A" ,name) :type ,type :read-only t)))) | 26 | (dev-group -1001234567890 :type integer) |
| 18 | 27 | (owner 12345678 :type integer)) | |
| 19 | (defconfig | 28 | |
| 20 | :bot-name string | 29 | (defvar *config* (make-config) |
| 21 | :bot-token string | 30 | "Bot's configuration") |
| 22 | :db-path string | 31 | |
| 23 | :dev-group integer | 32 | (defun bot-name (&optional (config *config*)) |
| 24 | :owner integer) | 33 | "Get the desired name for the bot" |
| 25 | 34 | (config-bot-name config)) | |
| 26 | (defun config-load (filename) | 35 | |
| 27 | "Load the config from the given `filename'. All entries must be specified." | 36 | (defun bot-token (&optional (config *config*)) |
| 28 | (apply #'make-config (with-open-file (f filename) (read f)))) | 37 | "Get the API token for the bot" |
| 29 | 38 | (config-bot-token config)) | |
| 30 | (defun config-merge (config filename) | 39 | |
| 31 | "Merge the current config with new entries from `filename'." | 40 | (defun db-path (&optional (config *config*)) |
| 32 | (loop for (name value) on (with-open-file (f filename) (read f)) by #'cddr do | 41 | "Get the path to the bot's database" |
| 33 | (setf (slot-value config (intern (symbol-name name) :ukkoclot/config)) value))) | 42 | (config-db-path config)) |
| 43 | |||
| 44 | (defun dev-group (&optional (config *config*)) | ||
| 45 | "Get the ID of the dev/testing group" | ||
| 46 | (config-dev-group config)) | ||
| 47 | |||
| 48 | (defun owner (&optional (config *config*)) | ||
| 49 | "Get the ID of the bot's owner" | ||
| 50 | (config-owner config)) | ||
| 51 | |||
| 52 | (defun load-config (filename &optional (config *config*)) | ||
| 53 | "Load config from the given `filename'." | ||
| 54 | (prog1 config | ||
| 55 | (let ((data (with-open-file (f filename) (read f)))) | ||
| 56 | (iter | ||
| 57 | (for (kw-name value) on data by #'cddr) | ||
| 58 | (let ((name (intern (symbol-name kw-name) :ukkoclot/config))) | ||
| 59 | (setf (slot-value config name) value)))))) | ||
| 60 | |||
| 61 | (defun serialize (config) | ||
| 62 | "Serializes the config to a plist." | ||
| 63 | (iter | ||
| 64 | (for slot in (class-direct-slots (class-of config))) | ||
| 65 | (appending | ||
| 66 | (let* ((name (slot-definition-name slot)) | ||
| 67 | (kw-name (intern (symbol-name name) :keyword))) | ||
| 68 | (list kw-name (slot-value config name)))))) | ||
| 69 | |||
| 70 | (defun print-default (filename) | ||
| 71 | "Prints the default config to the given `filename'." | ||
| 72 | (with-open-file (f filename :direction :output :if-exists :supersede) | ||
| 73 | (format f ";; lint:suppress in-package spdx-license-identifier~%") | ||
| 74 | (format f ";; Copy this file to config.lisp and modify it there~%") | ||
| 75 | (let ((data (serialize (make-config)))) | ||
| 76 | (format f "~<(~;~@{~(~W~) ~W~^ ~_~}~;)~:>~%" data)))) | ||