-(defun soap-sample-value-for-basic-type (type)
- "Provide a sample value for TYPE which is a basic type.
-This is a specific function which should not be called directly,
-use `soap-sample-value' instead."
- (case (soap-basic-type-kind type)
- (string "a string value")
- (boolean t) ; could be nil as well
- ((long int) (random 4200))
- ;; TODO: we need better sample values for more types.
- (t (format "%s" (soap-basic-type-kind type)))))
-
-(defun soap-sample-value-for-seqence-type (type)
- "Provide a sample value for TYPE which is a sequence type.
-Values for sequence types are ALISTS of (slot-name . VALUE) for
-each sequence element.
-
-This is a specific function which should not be called directly,
-use `soap-sample-value' instead."
- (let ((sample-value nil))
- (dolist (element (soap-sequence-type-elements type))
- (push (cons (soap-sequence-element-name element)
- (soap-sample-value (soap-sequence-element-type element)))
- sample-value))
- (when (soap-sequence-type-parent type)
- (setq sample-value
- (append (soap-sample-value (soap-sequence-type-parent type))
- sample-value)))
- sample-value))
-
-(defun soap-sample-value-for-array-type (type)
- "Provide a sample value for TYPE which is an array type.
-Values for array types are LISP vectors of values which are
-array's element type.
-
-This is a specific function which should not be called directly,
-use `soap-sample-value' instead."
- (let* ((element-type (soap-array-type-element-type type))
- (sample1 (soap-sample-value element-type))
- (sample2 (soap-sample-value element-type)))
- ;; Our sample value is a vector of two elements, but any number of
- ;; elements are permissible
- (vector sample1 sample2 '&etc)))
+(defun soap-sample-value-for-xs-basic-type (type)
+ "Provide a sample value for TYPE, an xs-basic-type.
+This is a specialization of `soap-sample-value' for xs-basic-type
+objects."
+ (case (soap-xs-basic-type-kind type)
+ (string "a string")
+ (anyURI "an URI")
+ (QName "a QName")
+ (dateTime "a time-value-p or string")
+ (boolean "t or nil")
+ ((long int integer byte unsignedInt) 42)
+ ((float double) 3.14)
+ (base64Binary "a string")
+ (t (format "%s" (soap-xs-basic-type-kind type)))))
+
+(defun soap-sample-value-for-xs-element (element)
+ "Provide a sample value for ELEMENT, a WSDL element.
+This is a specialization of `soap-sample-value' for xs-element
+objects."
+ (if (soap-xs-element-name element)
+ (cons (intern (soap-xs-element-name element))
+ (soap-sample-value (soap-xs-element-type element)))
+ (soap-sample-value (soap-xs-element-type element))))
+
+(defun soap-sample-value-for-xs-attribute (attribute)
+ "Provide a sample value for ATTRIBUTE, a WSDL attribute.
+This is a specialization of `soap-sample-value' for
+soap-xs-attribute objects."
+ (if (soap-xs-attribute-name attribute)
+ (cons (intern (soap-xs-attribute-name attribute))
+ (soap-sample-value (soap-xs-attribute-type attribute)))
+ (soap-sample-value (soap-xs-attribute-type attribute))))
+
+(defun soap-sample-value-for-xs-attribute-group (attribute-group)
+ "Provide a sample value for ATTRIBUTE-GROUP, a WSDL attribute group.
+This is a specialization of `soap-sample-value' for
+soap-xs-attribute objects."
+ (let ((sample-values nil))
+ (dolist (attribute (soap-xs-attribute-group-attributes attribute-group))
+ (if (soap-xs-attribute-name attribute)
+ (setq sample-values
+ (append sample-values
+ (cons (intern (soap-xs-attribute-name attribute))
+ (soap-sample-value (soap-xs-attribute-type
+ attribute)))))
+ (setq sample-values
+ (append sample-values
+ (soap-sample-value
+ (soap-xs-attribute-type attribute))))))))
+
+(defun soap-sample-value-for-xs-simple-type (type)
+ "Provide a sample value for TYPE, a `soap-xs-simple-type'.
+This is a specialization of `soap-sample-value' for
+`soap-xs-simple-type' objects."
+ (append
+ (mapcar 'soap-sample-value-for-xs-attribute
+ (soap-xs-type-attributes type))
+ (cond
+ ((soap-xs-simple-type-enumeration type)
+ (let ((enumeration (soap-xs-simple-type-enumeration type)))
+ (nth (random (length enumeration)) enumeration)))
+ ((soap-xs-simple-type-pattern type)
+ (format "a string matching %s" (soap-xs-simple-type-pattern type)))
+ ((soap-xs-simple-type-length-range type)
+ (destructuring-bind (low . high) (soap-xs-simple-type-length-range type)
+ (cond
+ ((and low high)
+ (format "a string between %d and %d chars long" low high))
+ (low (format "a string at least %d chars long" low))
+ (high (format "a string at most %d chars long" high))
+ (t (format "a string OOPS")))))
+ ((soap-xs-simple-type-integer-range type)
+ (destructuring-bind (min . max) (soap-xs-simple-type-integer-range type)
+ (cond
+ ((and min max) (+ min (random (- max min))))
+ (min (+ min (random 10)))
+ (max (random max))
+ (t (random 100)))))
+ ((consp (soap-xs-simple-type-base type)) ; an union of values
+ (let ((base (soap-xs-simple-type-base type)))
+ (soap-sample-value (nth (random (length base)) base))))
+ ((soap-xs-basic-type-p (soap-xs-simple-type-base type))
+ (soap-sample-value (soap-xs-simple-type-base type))))))
+
+(defun soap-sample-value-for-xs-complex-type (type)
+ "Provide a sample value for TYPE, a `soap-xs-complex-type'.
+This is a specialization of `soap-sample-value' for
+`soap-xs-complex-type' objects."
+ (append
+ (mapcar 'soap-sample-value-for-xs-attribute
+ (soap-xs-type-attributes type))
+ (case (soap-xs-complex-type-indicator type)
+ (array
+ (let* ((element-type (soap-xs-complex-type-base type))
+ (sample1 (soap-sample-value element-type))
+ (sample2 (soap-sample-value element-type)))
+ ;; Our sample value is a vector of two elements, but any number of
+ ;; elements are permissible
+ (vector sample1 sample2 '&etc)))
+ ((sequence choice all)
+ (let ((base (soap-xs-complex-type-base type)))
+ (let ((value (append (and base (soap-sample-value base))
+ (mapcar #'soap-sample-value
+ (soap-xs-complex-type-elements type)))))
+ (if (eq (soap-xs-complex-type-indicator type) 'choice)
+ (cons '***choice-of*** value)
+ value)))))))