Draft for warnings-effects aspect

fixes RDTK#57

changes.sexp

@@ -3,7 +3,10 @@
   (:enhancement
    "The parameters aspect now supports the parameter kind
     \"password\". However, a default value cannot be specified for
-    parameters of this kind.")
+    parameters of this kind. Consult the entry for"
+   (:verb "warnings-effect")
+   "in the output of" (:verb "build-generator info-aspects") "for
+    details.")
 
   (:enhancement
    "When a variant of the" (:verb "--on-error ") "commandline option is
@@ -23,7 +26,11 @@
 
   (:bugfix
    "The variables" (:verb "scm.username") "and" (:verb "scm.password")
-   "are handled correctly."))
+   "are handled correctly.")
+
+  (:enhancement
+   "The new aspect" (:verb "warnings-effects") "controls the effects of
+    identify warnings on the build status and health of generated jobs."))
 
  (:release "0.33" "2020-12-07"
 

lib/jenkins.api/src/api/model/job-publisher.lisp

@@ -207,6 +207,15 @@
 
 ;;; Publisher interface
 
+(define-model-class quality-gate ()
+    ((threshold :type  positive-integer
+                :xpath "threshold/text()")
+     (type1     :type  keyword
+                :xpath "type/text()")
+     (status    :type  keyword
+                :xpath "status/text()"))
+  (:name-slot nil))
+
 (define-interface-implementations (publisher)
   ((ssh "jenkins.plugins.publish__over__ssh.BapSshPublisherPlugin"
         :plugin "[email protected]")
@@ -273,10 +282,14 @@
                                      :xpath     "unhealthy/text()"
                                      :optional? nil
                                      :initform  0)
-    (minimum-severity                :type      string
+    (minimum-severity                :type      keyword ; (member :error :normal :low)
                                      :xpath     "minimumSeverity/name/text()"
                                      :optional? nil
-                                     :initform  "HIGH")
+                                     :initform  :high)
+    (quality-gates                   :type      quality-gate
+                                     :xpath     ("qualityGates/io.jenkins.plugins.analysis.core.util.QualityGate"
+                                                 :if-multiple-matches :all)
+                                     :initform  '())
     ;; Blame
     (blame-disabled?                 :type      boolean
                                      :xpath     "isBlameDisabled/text()"

lib/jenkins.api/src/api/package.lisp

@@ -1,6 +1,6 @@
 ;;;; package.lisp --- Package definition for api module.
 ;;;;
-;;;; Copyright (C) 2012-2019 Jan Moringen
+;;;; Copyright (C) 2012-2019, 2021 Jan Moringen
 ;;;;
 ;;;; Author: Jan Moringen <[email protected]>
 
@@ -293,6 +293,10 @@
 
    #:publisher/issues-recorder
    #:analysis-tools
+   #:healthy-threshold
+   #:unhealthy-threshold
+   #:minimum-severity
+   #:quality-gates
 
    #:analysis-tool/open-tasks
 
@@ -307,7 +311,12 @@
    #:analysis-tool/pmd
 
    #:analysis-tool/groovy
-   #:parser)
+   #:parser
+
+   #:quality-gate
+   #:threshold
+   #:type1
+   #:status)
 
   ;; Build
   (:export

src/model/aspects/aspects-publish.lisp

@@ -1,6 +1,6 @@
 ;;;; aspects-publish.lisp --- Definitions of publisher-creating aspects
 ;;;;
-;;;; Copyright (C) 2012-2020 Jan Moringen
+;;;; Copyright (C) 2012-2021 Jan Moringen
 ;;;;
 ;;;; Author: Jan Moringen <[email protected]>
 
@@ -168,6 +168,94 @@
                           :test #'string=
                           :key  #'jenkins.api:name))))))
 
+;;; Warnings health aspect
+
+(define-aspect (warnings-effects :job-var job :plugins ("warnings-ng"))
+    (publisher-defining-mixin)
+    (;; Build health computation.
+     ((healthy-threshold nil)         :type (or null (integer 0))
+      :documentation
+      "If the number of warnings (of relevant severity) is greater or equal
+       to this threshold, the build is considered not 100% healthy.")
+     ((unhealthy-threshold nil)       :type (or null (integer 0))
+      :documentation
+      "If the number of warnings (of relevant severity) is greater than this
+       threshold, the build is considered unhealthy (that is 0%
+       healthy).")
+     ((health-minimum-severity :high) :type (or (eql :high) (eql :normal) (eql :low))
+      :documentation
+      "Warnings the severity of which is greater than this minimum severity
+       are included in the warning count against which the healthy and
+       unhealthy threshold are checked.")
+     ;; Build result computation
+     ((result-threshold nil)          :type (or null (integer 1))
+      :documentation
+      "If the number of warnings matching the age and severity filters is
+       greater or equal to this threshold, the build status is set to
+       the configured failure status (unstable or failed).")
+     ((result-count-method :any)      :type (or null
+                                                (eql :any) (eql :new) (eql :delta))
+      :documentation
+      "Method for computing the warning count to compare against the
+       threshold.
+
+       Possible values are:
+
+       any
+         The number of warnings in the current build that match the
+         severity filter.
+
+       new
+         The number of warnings in the current build that match the
+         severity filter and were not present in the reference build.
+
+       delta
+         The difference between number of warnings in the current
+         build that match the severity filter and the number of
+         warnings in the previous build that match the severity
+         filter.")
+     ((result-severity-filter nil)    :type (or null (eql :any) (eql :error)
+                                                (eql :high) (eql :normal) (eql :low))
+      :documentation
+      "Only warnings of the configured severity or a higher severity count
+       towards the threshold that controls the build status.")
+     ((result-status :unstable)       :type (or (eql :unstable) (eql :failed))
+      :documentation
+      "The status to use if the number of warnings matching the filters
+       exceeds the configured threshold."))
+  "Configures warnings-based health and build result for the generated job."
+  (with-interface (jenkins.api:publishers job)
+      (issues-recorder (jenkins.api:publisher/issues-recorder))
+    ;; Configure health computation.
+    (setf (jenkins.api:healthy-threshold issues-recorder)
+          healthy-threshold
+          (jenkins.api:unhealthy-threshold issues-recorder)
+          unhealthy-threshold
+          (jenkins.api:minimum-severity issues-recorder)
+          health-minimum-severity)
+    ;; Configuration result computation as a single quality gate.
+    (let ((quality-gate (or (first (jenkins.api:quality-gates issues-recorder))
+                            (let ((quality-gate (make-instance 'jenkins.api:quality-gate)))
+                              (setf (jenkins.api:quality-gates issues-recorder)
+                                    (list quality-gate))
+                              quality-gate)))
+          ;; Map the combination of RESULT-AGE-FILTER and
+          ;; RESULT-SEVERITY-FILTER to a single "type".
+          (type         (cond ((and (eq result-count-method :any)
+                                    (eq result-severity-filter :any))
+                               :any)
+                              (t
+                               (find-symbol (format nil "~A_~A"
+                                                    result-count-method
+                                                    result-severity-filter)
+                                            '#:keyword))))
+          (status       (ecase result-status
+                          (:unstable :warning)
+                          (:failed   :failed))))
+      (setf (jenkins.api:threshold quality-gate) result-threshold
+            (jenkins.api:type1     quality-gate) type
+            (jenkins.api:status    quality-gate) status))))
+
 ;;; Checkstyle and PMD aspects
 
 (macrolet

src/model/variables/evaluation.lisp

@@ -1,6 +1,6 @@
 ;;;; evaluation.lisp --- Evaluation of value expressions.
 ;;;;
-;;;; Copyright (C) 2012-2019 Jan Moringen
+;;;; Copyright (C) 2012-2019, 2021 Jan Moringen
 ;;;;
 ;;;; Author: Jan Moringen <[email protected]>
 
@@ -191,6 +191,22 @@
   (declare (ignore if-type-mismatch))
   (values (make-keyword (string-upcase value)) t))
 
+(defmethod as ((value string) (type (eql 'integer)) &key if-type-mismatch)
+  (declare (ignore if-type-mismatch))
+  (handler-case
+      (values (parse-integer value) t)
+    (error ()
+      nil)))
+
+(defmethod as ((value string) (type cons) &key if-type-mismatch)
+  (declare (ignore if-type-mismatch))
+  (case (first type)
+    (integer
+     (when-let ((integer (as value 'integer)))
+       (as integer type)))
+    (t
+     (call-next-method))))
+
 (defmethod as ((value t) (type cons) &key if-type-mismatch)
   (declare (ignore if-type-mismatch))
   (case (first type)