grokking simplicity and refactoring

packages/lab-tool/utils/config/accessor.scm

@@ -0,0 +1,74 @@
+;; utils/config/accessor.scm - Configuration value access (pure functions)
+
+(define-module (utils config accessor)
+  #:use-module (srfi srfi-1)
+  #:export (get-config-value-pure
+            get-machine-config-pure
+            get-all-machines-pure
+            get-ssh-config-pure
+            validate-machine-name-pure))
+
+;; Pure function: Get configuration value by path
+;; Input: config alist, path list, optional default value
+;; Output: configuration value or default
+(define (get-config-value-pure config path . default)
+  "Pure function to get configuration value by path"
+  (let ((result (fold (lambda (key acc)
+                        (if (and acc (list? acc))
+                            (assoc-ref acc key)
+                            #f))
+                      config path)))
+    (if result 
+        result 
+        (if (null? default) #f (car default)))))
+
+;; Pure function: Get machine configurations
+;; Input: config alist
+;; Output: machines alist
+(define (get-machine-configs-pure config)
+  "Pure function to get machine configurations"
+  (get-config-value-pure config '(machines)))
+
+;; Pure function: Get configuration for specific machine
+;; Input: config alist, machine-name (string or symbol)
+;; Output: machine configuration alist or #f
+(define (get-machine-config-pure config machine-name)
+  "Pure function to get machine configuration"
+  (let ((machine-symbol (if (symbol? machine-name)
+                            machine-name
+                            (string->symbol machine-name)))
+        (machines (get-machine-configs-pure config)))
+    (assoc-ref machines machine-symbol)))
+
+;; Pure function: Get list of all machine names
+;; Input: config alist
+;; Output: list of machine name strings
+(define (get-all-machines-pure config)
+  "Pure function to get all machine names"
+  (map (lambda (machine-entry)
+         (symbol->string (car machine-entry)))
+       (get-machine-configs-pure config)))
+
+;; Pure function: Validate machine name exists
+;; Input: config alist, machine-name string
+;; Output: #t if valid, #f otherwise
+(define (validate-machine-name-pure config machine-name)
+  "Pure function to validate machine name"
+  (let ((machines (get-all-machines-pure config)))
+    (member machine-name machines)))
+
+;; Pure function: Get SSH configuration for machine
+;; Input: config alist, machine-name (string or symbol)
+;; Output: SSH configuration alist or #f
+(define (get-ssh-config-pure config machine-name)
+  "Pure function to get SSH configuration for machine"
+  (let ((machine-config (get-machine-config-pure config machine-name)))
+    (if machine-config
+        (let ((type (assoc-ref machine-config 'type))
+              (hostname (assoc-ref machine-config 'hostname))
+              (ssh-alias (assoc-ref machine-config 'ssh-alias)))
+          `((type . ,type)
+            (hostname . ,hostname)
+            (ssh-alias . ,ssh-alias)
+            (is-local . ,(eq? type 'local))))
+        #f)))

packages/lab-tool/utils/config/defaults.scm

@@ -0,0 +1,35 @@
+;; utils/config/defaults.scm - Configuration defaults (pure data)
+
+(define-module (utils config defaults)
+  #:export (default-config))
+
+;; Pure data: Default configuration structure
+(define default-config
+  `((homelab-root . "/home/geir/Home-lab")
+    (machines . ((congenital-optimist 
+                  (type . local)
+                  (hostname . "localhost")
+                  (services . (workstation development)))
+                 (sleeper-service
+                  (type . remote)
+                  (hostname . "sleeper-service.tail807ea.ts.net")
+                  (ssh-alias . "admin-sleeper")
+                  (services . (nfs zfs storage)))
+                 (grey-area
+                  (type . remote)
+                  (hostname . "grey-area.tail807ea.ts.net")
+                  (ssh-alias . "admin-grey")
+                  (services . (ollama forgejo git)))
+                 (reverse-proxy
+                  (type . remote)
+                  (hostname . "reverse-proxy.tail807ea.ts.net")
+                  (ssh-alias . "admin-reverse")
+                  (services . (nginx proxy ssl)))))
+    (deployment . ((default-mode . "boot")
+                   (timeout . 300)
+                   (retry-count . 3)))
+    (monitoring . ((interval . 30)
+                   (timeout . 10)))
+    (mcp . ((port . 3001)
+            (host . "localhost")
+            (log-level . "info")))))

packages/lab-tool/utils/config/loader.scm

@@ -0,0 +1,60 @@
+;; utils/config/loader.scm - Configuration loading (file I/O operations)
+
+(define-module (utils config loader)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (utils logging)
+  #:use-module (utils json)
+  #:use-module (utils config defaults)
+  #:export (load-config-from-file
+            load-config))
+
+;; Pure function: Parse configuration from JSON string
+;; Input: json-string
+;; Output: parsed configuration alist or #f if invalid
+(define (parse-config-json json-string)
+  "Pure function to parse configuration from JSON string"
+  (catch #t
+    (lambda () (json-string->scm-safe json-string))
+    (lambda (key . args) #f)))
+
+;; Pure function: Validate configuration structure
+;; Input: config alist
+;; Output: #t if valid, #f otherwise
+(define (validate-config config)
+  "Pure function to validate configuration structure"
+  (and (list? config)
+       (assoc-ref config 'homelab-root)
+       (assoc-ref config 'machines)))
+
+;; Impure function: Load configuration from file
+;; Input: file-path string
+;; Output: configuration alist or default-config if file doesn't exist/invalid
+(define (load-config-from-file file-path)
+  "Load configuration from file (with side effects: file I/O, logging)"
+  (if (file-exists? file-path)
+      (catch #t
+        (lambda ()
+          (log-debug "Loading configuration from ~a" file-path)
+          (let* ((json-data (call-with-input-file file-path get-string-all))
+                 (parsed-config (parse-config-json json-data)))
+            (if (and parsed-config (validate-config parsed-config))
+                (begin
+                  (log-info "Configuration loaded successfully")
+                  parsed-config)
+                (begin
+                  (log-warn "Invalid configuration file, using defaults")
+                  default-config))))
+        (lambda (key . args)
+          (log-warn "Failed to load config file, using defaults: ~a" key)
+          default-config))
+      (begin
+        (log-debug "No config file found at ~a, using defaults" file-path)
+        default-config)))
+
+;; Impure function: Load configuration with default path
+(define (load-config . args)
+  "Load configuration with optional file path"
+  (let ((config-file (if (null? args) 
+                         (string-append (getenv "HOME") "/.config/homelab/config.json")
+                         (car args))))
+    (load-config-from-file config-file)))

packages/lab-tool/utils/config/state.scm

@@ -0,0 +1,69 @@
+;; utils/config/state.scm - Configuration state management
+
+(define-module (utils config state)
+  #:use-module (utils config defaults)
+  #:use-module (utils config loader)
+  #:use-module (utils config accessor)
+  #:use-module (utils logging)
+  #:export (get-current-config
+            set-current-config!
+            reload-config!
+            get-config-value
+            get-machine-config
+            get-all-machines
+            get-ssh-config
+            validate-machine-name
+            get-homelab-root))
+
+;; Mutable state: Current loaded configuration
+(define current-config default-config)
+
+;; Impure function: Get current configuration
+(define (get-current-config)
+  "Get current loaded configuration"
+  current-config)
+
+;; Impure function: Set current configuration
+(define (set-current-config! config)
+  "Set current configuration (impure)"
+  (set! current-config config))
+
+;; Impure function: Reload configuration from file
+(define (reload-config! . args)
+  "Reload configuration from file"
+  (let ((new-config (apply load-config args)))
+    (set-current-config! new-config)
+    new-config))
+
+;; Impure wrappers for pure accessor functions
+(define (get-config-value path . default)
+  "Get configuration value from current config"
+  (apply get-config-value-pure current-config path default))
+
+(define (get-machine-config machine-name)
+  "Get machine configuration from current config"
+  (get-machine-config-pure current-config machine-name))
+
+(define (get-all-machines)
+  "Get all machine names from current config"
+  (get-all-machines-pure current-config))
+
+(define (get-ssh-config machine-name)
+  "Get SSH configuration from current config"
+  (get-ssh-config-pure current-config machine-name))
+
+(define (validate-machine-name machine-name)
+  "Validate machine name against current config"
+  (if (validate-machine-name-pure current-config machine-name)
+      #t
+      (begin
+        (log-error "Unknown machine: ~a" machine-name)
+        (log-error "Available machines: ~a" (string-join (get-all-machines) ", "))
+        #f)))
+
+(define (get-homelab-root)
+  "Get home lab root directory from current config"
+  (get-config-value '(homelab-root) "/home/geir/Home-lab"))
+
+;; Initialize configuration on module load
+(reload-config!)