grokking simplicity and refactoring

packages/lab-tool/utils/json/file-io.scm

@@ -0,0 +1,57 @@
+;; utils/json/file-io.scm - JSON file I/O operations
+
+(define-module (utils json file-io)
+  #:use-module (json)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (utils logging)
+  #:export (read-json-file-pure
+            write-json-file-pure
+            read-json-file
+            write-json-file))
+
+;; Pure function: Read JSON from file without logging
+;; Input: filename string
+;; Output: parsed object or #f if failed
+(define (read-json-file-pure filename)
+  "Pure function to read JSON from file"
+  (catch #t
+    (lambda ()
+      (call-with-input-file filename
+        (lambda (port) (json->scm port))))
+    (lambda (key . args) #f)))
+
+;; Pure function: Write JSON to file without logging
+;; Input: filename string, obj (scheme object), pretty boolean
+;; Output: #t if successful, #f if failed
+(define (write-json-file-pure filename obj pretty)
+  "Pure function to write JSON to file"
+  (catch #t
+    (lambda ()
+      (call-with-output-file filename
+        (lambda (port)
+          (if pretty
+              (scm->json obj port #:pretty #t)
+              (scm->json obj port))))
+      #t)
+    (lambda (key . args) #f)))
+
+;; Impure wrapper: Read JSON file with logging
+(define (read-json-file filename)
+  "Read JSON from file with logging"
+  (log-debug "Reading JSON file: ~a" filename)
+  (let ((result (read-json-file-pure filename)))
+    (if result
+        (log-debug "Successfully read JSON file: ~a" filename)
+        (log-error "Failed to read JSON file: ~a" filename))
+    result))
+
+;; Impure wrapper: Write JSON file with logging
+(define (write-json-file filename obj . options)
+  "Write JSON to file with logging"
+  (let ((pretty (if (null? options) #t (car options))))
+    (log-debug "Writing JSON file: ~a" filename)
+    (let ((result (write-json-file-pure filename obj pretty)))
+      (if result
+          (log-debug "Successfully wrote JSON file: ~a" filename)
+          (log-error "Failed to write JSON file: ~a" filename))
+      result)))

packages/lab-tool/utils/json/manipulation.scm

@@ -0,0 +1,63 @@
+;; utils/json/manipulation.scm - Pure JSON manipulation functions
+
+(define-module (utils json manipulation)
+  #:use-module (srfi srfi-1)
+  #:export (merge-json-objects
+            flatten-json-paths
+            json-path-ref
+            json-path-set))
+
+;; Pure function: Merge two JSON objects
+;; Input: obj1 (alist), obj2 (alist)
+;; Output: merged alist with obj2 values taking precedence
+(define (merge-json-objects obj1 obj2)
+  "Pure function to merge two JSON objects"
+  (let ((merged (copy-tree obj1)))
+    (fold (lambda (pair acc)
+            (let ((key (car pair))
+                  (value (cdr pair)))
+              (assoc-set! acc key value)))
+          merged
+          obj2)))
+
+;; Pure function: Convert nested alist to flat key paths
+;; Input: obj (nested alist), optional prefix (list of keys)
+;; Output: list of (path . value) pairs
+(define (flatten-json-paths obj . prefix)
+  "Pure function to flatten nested object to path-value pairs"
+  (let ((current-prefix (if (null? prefix) '() (car prefix))))
+    (fold (lambda (pair acc)
+            (let ((key (car pair))
+                  (value (cdr pair)))
+              (let ((new-path (append current-prefix (list key))))
+                (if (and (list? value) (not (null? value)) (pair? (car value)))
+                    ;; Nested object - recurse
+                    (append (flatten-json-paths value new-path) acc)
+                    ;; Leaf value
+                    (cons (cons new-path value) acc)))))
+          '()
+          obj)))
+
+;; Pure function: Get nested value using path
+;; Input: obj (nested alist), path (list of keys)
+;; Output: value at path or #f if not found
+(define (json-path-ref obj path)
+  "Pure function to get value from nested object using key path"
+  (fold (lambda (key acc)
+          (if (and acc (list? acc))
+              (assoc-ref acc key)
+              #f))
+        obj path))
+
+;; Pure function: Set nested value using path
+;; Input: obj (nested alist), path (list of keys), value
+;; Output: new alist with value set at path
+(define (json-path-set obj path value)
+  "Pure function to set value in nested object using key path"
+  (if (null? path)
+      value
+      (let* ((key (car path))
+             (rest-path (cdr path))
+             (current-value (assoc-ref obj key))
+             (new-value (json-path-set (or current-value '()) rest-path value)))
+        (assoc-set! (copy-tree obj) key new-value))))

packages/lab-tool/utils/json/parse.scm

@@ -0,0 +1,21 @@
+;; utils/json/parse.scm - Pure JSON parsing functions
+
+(define-module (utils json parse)
+  #:use-module (json)
+  #:export (json-string->scm-safe
+            parse-json-pure))
+
+;; Pure function: Safely parse JSON string
+;; Input: json-string
+;; Output: parsed scheme object or #f if invalid
+(define (parse-json-pure json-string)
+  "Pure function to parse JSON string without side effects"
+  (catch #t
+    (lambda () 
+      (if (string? json-string)
+          (json-string->scm json-string)
+          #f))
+    (lambda (key . args) #f)))
+
+;; Alias for compatibility
+(define json-string->scm-safe parse-json-pure)

packages/lab-tool/utils/json/pretty-print.scm

@@ -0,0 +1,13 @@
+;; utils/json/pretty-print.scm - JSON pretty printing
+
+(define-module (utils json pretty-print)
+  #:use-module (json)
+  #:export (json-pretty-print))
+
+;; Impure function: Pretty print JSON to current output port
+;; Input: obj (scheme object)
+;; Output: unspecified (side effect: prints to current-output-port)
+(define (json-pretty-print obj)
+  "Pretty print JSON object to current output port"
+  (scm->json obj (current-output-port) #:pretty #t)
+  (newline))

packages/lab-tool/utils/json/serialize.scm

@@ -0,0 +1,27 @@
+;; utils/json/serialize.scm - Pure JSON serialization functions
+
+(define-module (utils json serialize)
+  #:use-module (json)
+  #:use-module (ice-9 textual-ports)
+  #:export (scm->json-string-pure
+            scm->json-string))
+
+;; Pure function: Convert scheme object to JSON string
+;; Input: obj (scheme object), pretty (boolean)
+;; Output: JSON string or #f if conversion fails
+(define (scm->json-string-pure obj pretty)
+  "Pure function to convert scheme object to JSON string"
+  (catch #t
+    (lambda ()
+      (call-with-output-string
+        (lambda (port)
+          (if pretty
+              (scm->json obj port #:pretty #t)
+              (scm->json obj port)))))
+    (lambda (key . args) #f)))
+
+;; Wrapper with optional pretty parameter
+(define (scm->json-string obj . options)
+  "Convert scheme object to JSON string with optional pretty printing"
+  (let ((pretty (if (null? options) #f (car options))))
+    (scm->json-string-pure obj pretty)))

packages/lab-tool/utils/json/validation.scm

@@ -0,0 +1,67 @@
+;; utils/json/validation.scm - Pure JSON validation functions
+
+(define-module (utils json validation)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-1)
+  #:export (validate-required-keys
+            validate-types
+            validate-json-schema))
+
+;; Pure function: Check for required keys
+;; Input: obj (alist), required-keys (list of symbols)
+;; Output: list of missing keys (empty if all present)
+(define (get-missing-keys obj required-keys)
+  "Pure function to find missing required keys"
+  (filter (lambda (key)
+            (not (assoc-ref obj key)))
+          required-keys))
+
+;; Pure function: Validate required keys
+;; Input: obj (alist), required-keys (list of symbols)
+;; Output: #t if all present, #f otherwise
+(define (validate-required-keys obj required-keys)
+  "Pure function to validate required keys are present"
+  (null? (get-missing-keys obj required-keys)))
+
+;; Pure function: Check type specifications
+;; Input: obj (alist), type-specs (list of (key expected-type) pairs)
+;; Output: list of type error messages (empty if all valid)
+(define (get-type-errors obj type-specs)
+  "Pure function to find type validation errors"
+  (filter-map
+   (lambda (type-spec)
+     (let ((key (car type-spec))
+           (expected-type (cadr type-spec)))
+       (let ((value (assoc-ref obj key)))
+         (if (and value (not (eq? (type-of value) expected-type)))
+             (format #f "Key ~a: expected ~a, got ~a" 
+                     key expected-type (type-of value))
+             #f))))
+   type-specs))
+
+;; Pure function: Validate types
+;; Input: obj (alist), type-specs (list of (key expected-type) pairs)
+;; Output: #t if all types valid, #f otherwise
+(define (validate-types obj type-specs)
+  "Pure function to validate object types"
+  (null? (get-type-errors obj type-specs)))
+
+;; Pure function: Complete schema validation
+;; Input: obj (alist), schema (list with required-keys, optional-keys, types)
+;; Output: (values valid? error-messages)
+(define (validate-json-schema obj schema)
+  "Pure function to validate JSON object against schema"
+  (let ((required-keys (car schema))
+        (optional-keys (if (> (length schema) 1) (cadr schema) '()))
+        (type-specs (if (> (length schema) 2) (caddr schema) '())))
+    
+    (let ((missing-keys (get-missing-keys obj required-keys))
+          (type-errors (get-type-errors obj type-specs)))
+      
+      (if (or (not (null? missing-keys)) (not (null? type-errors)))
+          (values #f (append 
+                      (if (not (null? missing-keys))
+                          (list (format #f "Missing required keys: ~a" missing-keys))
+                          '())
+                      type-errors))
+          (values #t '())))))