fork download
  1. ; your code goes here
  2.  
  3. (defparameter *config* (make-hash-table))
  4.  
  5. (define-condition value-not-found (error)
  6. ((text :initarg :text :reader text :initform "")))
  7.  
  8. (defmethod print-object ((obj value-not-found) stream)
  9. (print-unreadable-object (obj stream :type t)
  10. (format stream "~s" (slot-value obj 'text))))
  11.  
  12. (defun get-single-value (name)
  13. (multiple-value-bind (v exist) (gethash name *config*)
  14. (if exist v (error 'value-not-found :text (format nil "no config value for ~a" name)))))
  15.  
  16. (defun select-any (names)
  17. (loop for name in names
  18. do (let ((value (handler-case (get-single-value name)
  19. (value-not-found () nil))))
  20. (when value
  21. (return-from select-any value))))
  22. (error 'value-not-found :text (format nil "no config values in ANY ~a" names)))
  23.  
  24. (defun select-all (names)
  25. (loop for name in names
  26. collect (handler-case (get-single-value name)
  27. (value-not-found ()
  28. (error 'value-not-found
  29. :text (format nil "no config value for ~a in ALL ~a" name names))))))
  30.  
  31. (defun select-values (spec)
  32. (if (= (length spec) 1)
  33. (get-single-value (car spec))
  34. (case (car spec)
  35. ((:any) (select-any (cdr spec)))
  36. ((:all) (cons 'list (select-all (cdr spec))))
  37. (t (error 'config-spec-unsupported "spec ~a unsupported" spec)))))
  38.  
  39. (defmacro get-value (&rest body)
  40. (select-values body))
  41.  
  42. (defun set-value (name value)
  43. (setf (gethash name *config*) value))
  44.  
  45. (set-value 'shard 5)
  46. (set-value 'host "super-host.com")
  47.  
  48. (defun test ()
  49. (get-value :any shard host)
  50. (get-value :any host shard)
  51. (get-value :all host shard)
  52. (get-value :any shard unknown-value)
  53. (get-value :all host unknown-value))
  54.  
Runtime error #stdin #stdout #stderr 0.01s 10888KB
stdin
Standard input is empty
stdout
Standard output is empty
stderr
*** - #<VALUE-NOT-FOUND
      "no config value for UNKNOWN-VALUE in ALL (HOST UNKNOWN-VALUE)">