fix: constraints generating algorithm

Aidbox · Aug 6, 2024 · e599c33 · e599c33
1 parent 1e7d48e
commit e599c33
Show file tree

Hide file tree

Showing 3 changed files with 31 additions and 52 deletions.
diff --git a/src/aidbox_sdk/fhir.clj b/src/aidbox_sdk/fhir.clj
@@ -14,10 +14,11 @@
 (def structure-definition? (resource-type-pred "StructureDefinition"))
 (def search-parameter?     (resource-type-pred "SearchParameter"))
 (def value-set?            (resource-type-pred "ValueSet"))
+(def fhir-schema?          (resource-type-pred "FHIRSchema"))
 
 ;; Derivations
 (defn constraint?     [schema] (= (:derivation schema) "constraint"))
-(defn specialization? [schema] (= (:derivation schema) "constraint"))
+(defn specialization? [schema] (= (:derivation schema) "specialization"))
 
 ;; Misc
 (defn extension? [schema] (= (:type schema) "Extension"))

diff --git a/src/aidbox_sdk/generator.clj b/src/aidbox_sdk/generator.clj
@@ -6,6 +6,7 @@
                                          safe-conj
                                          uppercase-first-letter
                                          vector-to-map]]
+   [aidbox-sdk.fhir :as fhir]
    [aidbox-sdk.schema :as schema]
    [clojure.java.io :as io]
    [clojure.set :as set]
@@ -558,35 +559,33 @@
        (apply-patterns (:url constraint) (filter #(contains? (last %) :pattern) (:elements constraint)))))
 
 (defn apply-constraints [constraint-schemas base-schemas]
-  (loop [result {}
-         i      0]
-    (if (or (= (count constraint-schemas) (count result))
-            (> i (count constraint-schemas)))
+  (loop [result {}]
+    (if (= (count constraint-schemas) (count result))
       result
-      (recur (reduce (fn [acc constraint-schema]
-                       (cond
-                         (contains? result (:url constraint-schema))
-                         acc
-
-                         (contains? result (:base constraint-schema))
-                         (assoc acc
-                                (:url constraint-schema)
-                                (assoc (apply-single-constraint constraint-schema
-                                                                (get result (:base constraint-schema)))
-                                       :package (:package constraint-schema)))
-
-                         (contains? base-schemas (:base constraint-schema))
-                         (assoc acc
-                                (:url constraint-schema)
-                                (assoc (apply-single-constraint constraint-schema
-                                                                (get base-schemas (:base constraint-schema)))
-                                       :package (:package constraint-schema)))
-
-                         :else acc))
-
-                     result
-                     constraint-schemas)
-             (inc i)))))
+      (recur
+       (reduce (fn [acc constraint-schema]
+                 (cond
+                   (contains? result (:url constraint-schema))
+                   acc
+
+                   (contains? result (:base constraint-schema))
+                   (assoc acc
+                          (:url constraint-schema)
+                          (assoc (apply-single-constraint constraint-schema
+                                                          (get result (:base constraint-schema)))
+                                 :package (:package constraint-schema)))
+
+                   (contains? base-schemas (:base constraint-schema))
+                   (assoc acc
+                          (:url constraint-schema)
+                          (assoc (apply-single-constraint constraint-schema
+                                                          (get base-schemas (:base constraint-schema)))
+                                 :package (:package constraint-schema)))
+
+                   :else acc))
+
+               result
+               constraint-schemas)))))
 
 ;;
 ;; Search Parameters
@@ -688,26 +687,6 @@
               (conj schema {:backbone-elements
                             (flat-backbones (:backbone-elements schema) [])})))))
 
-(defn generate-constraints [schemas]
-  (let [base-schemas (->> schemas
-                          (prepared-schemas)
-                          (map (fn [schema]
-                                 (conj schema {:backbone-elements
-                                               (flat-backbones (:backbone-elements schema) [])})))
-                          (vector-to-map))
-        constraints (filter #(and
-                              (constraint? %)
-                              (not (from-extension? %)))
-                            schemas)]
-    (->> (apply-constraints
-          constraints
-          base-schemas)
-         (mapv (fn [[name' schema]]
-                 {:name name'
-                  :schema schema
-                  :file-content (generate-constraint-namespace
-                                 (assoc schema
-                                        :url name'))})))))
 
 (defn build-all! [& {:keys [auth input output]}]
   (let [output                (io/file output)
@@ -721,7 +700,6 @@
                                              (constraint? %)
                                              (not (from-extension? %)))))]
 
-
     (prepare-target-directory! output)
 
     ;; create base namespace (all FHIR datatypes) file
@@ -779,7 +757,7 @@
     (println "Generating constraints classes")
     (doseq [{:keys [name schema file-content]}
             (->> (apply-constraints
-                  constraints
+                  (remove fhir/structure-definition? constraints)
                   (->> all-schemas
                        (prepared-schemas)
                        (map (fn [schema]

diff --git a/test/aidbox_sdk/generator_test.clj b/test/aidbox_sdk/generator_test.clj
@@ -3,7 +3,7 @@
              [matcho.core :as matcho]
              [aidbox-sdk.generator :as sut]))
 
-(deftest apply-constraints-test
+(deftest test-apply-constraints
   (testing "base schema is a specialization schema"
 
     (def constraints [{:package "hl7.fhir.r4.core",