Allow specifications to be projected from probed values.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
diff --git a/core/defs.lisp b/core/defs.lisp
index 92e319b..a395bd7 100644
--- a/core/defs.lisp
+++ b/core/defs.lisp
@@ -27,6 +27,8 @@
;; Properties
+(defgeneric compare-property-values (resource property value1 value2))
+
(defgeneric merge-property-values (resource property old new))
;; Probe
@@ -207,6 +209,7 @@
(defgeneric get-probed (resource property))
(defgeneric clear-probed% (resource properties))
(defgeneric describe-probed% (resource output))
+(defgeneric describe-probed-property-value (resource property value))
(defvar *resource*)
diff --git a/core/host.lisp b/core/host.lisp
index e6607ca..f5b0900 100644
--- a/core/host.lisp
+++ b/core/host.lisp
@@ -105,12 +105,6 @@
;; OS
-(defmethod print-object ((os os) stream)
- (print-unreadable-object (os stream :type t :identity (not *print-pretty*))
- (with-slots (machine name release version) os
- (format stream "~A ~A ~A ~A"
- name release machine version))))
-
(defmethod host-os ((host host))
(get-probed host :os))
diff --git a/core/os.lisp b/core/os.lisp
index e240c60..aeb9aa5 100644
--- a/core/os.lisp
+++ b/core/os.lisp
@@ -18,6 +18,19 @@
(in-package :adams)
+(defmethod print-object ((os os) stream)
+ (print-unreadable-object (os stream :type t :identity (not *print-pretty*))
+ (with-slots (machine name release version) os
+ (format stream "~A ~A ~A ~A"
+ name release version machine))))
+
+(defmethod describe-probed-property-value ((resource host)
+ (property (eql :os))
+ (os os))
+ (with-slots (machine name release version) os
+ (format nil "~A ~A ~A ~A"
+ name release version machine)))
+
;; UNIX
(defclass os-unix (os) ())
diff --git a/core/properties.lisp b/core/properties.lisp
index b1fab84..fd0cc75 100644
--- a/core/properties.lisp
+++ b/core/properties.lisp
@@ -40,8 +40,11 @@
(defmacro get-property (property properties)
`(getf ,properties ,property +undefined+))
+(defmethod compare-property-values (resource property value1 value2)
+ (equalp value1 value2))
+
(defmethod merge-property-values (resource property old new)
- (unless (equalp old new)
+ (unless (compare-property-values resource property old new)
(warn "Conflicting values for property ~A in
~A
old: ~S
diff --git a/core/resource.lisp b/core/resource.lisp
index 8fb4d2b..3c892a6 100644
--- a/core/resource.lisp
+++ b/core/resource.lisp
@@ -73,6 +73,11 @@
#+nil
(pprint-plist '(:a "aaa" :b "foo" :xyz "bar"))
+(defmethod describe-probed-property-value ((resource t)
+ (property t)
+ value)
+ value)
+
(defmethod describe-probed% ((res resource) (out (eql :form)))
(let* ((props (probe-all-properties res))
(sorted-keys (sort (iter (for* (k v) in props)
@@ -80,7 +85,8 @@
#'string<))
(sorted-props (iter (for key in sorted-keys)
(collect key)
- (collect (get-property key props)))))
+ (collect (describe-probed-property-value
+ res key (get-property key props))))))
`(resource ',(class-name (class-of res))
,(resource-id res)
,@sorted-props)))
diff --git a/core/spec.lisp b/core/spec.lisp
index 577f291..546bf3f 100644
--- a/core/spec.lisp
+++ b/core/spec.lisp
@@ -95,13 +95,10 @@
;; Methods for matching specified and probed values
-(defgeneric match-specified-value (specified probed))
+(defgeneric match-specified-value (resource property specified probed))
-(defmethod match-specified-value (specified probed)
- (equalp specified probed))
-
-(defmethod match-specified-value ((specified resource) probed)
- (equalp (resource-id specified) probed))
+(defmethod match-specified-value (resource property specified probed)
+ (equalp specified (describe-probed-property-value resource property probed)))
;; Methods to get current status of resource
@@ -115,7 +112,7 @@ Second value lists properties in line with spec. Format is
(defmethod resource-diff ((res resource))
(iter (for* (property specified) in (specified-properties res))
(for probed = (get-probed res property))
- (if (match-specified-value specified probed)
+ (if (match-specified-value res property specified probed)
(collect `(,property ,specified) into ok)
(collect `(,property ,specified ,probed) into diff))
(finally (return (values diff ok)))))