5
5
[clojure.string :as str]
6
6
[clojure.set :as set]))
7
7
8
+ (def constraint-count (atom 0 ))
9
+
8
10
(defn compile-backbone [parent_name property_name definition ]
9
11
(let [name (str parent_name " _" (help/uppercase-first-letter (name property_name)))
10
12
data (help/get-typings-and-imports name (or (:required definition ) []) (help/elements-to-vector definition ))
58
60
(safe-conj (hash-map :base (get schema :base ) :url (get schema :url ))))) schemas))
59
61
60
62
(defn combine-elements [schemas]
61
- (map (fn [schema]
63
+ (map (fn [[name, schema] ]
62
64
(->> schema
63
65
(mix-parents-elements-circular schemas)
64
- (mix-parents-backbones-circular schemas))) schemas))
66
+ #_ (mix-parents-backbones-circular schemas))) schemas))
65
67
66
68
(defn apply-excluded [excluded schema]
67
69
(filter (fn [field-schema]
79
81
(filter #(not (contains? choises-to-exclude (:name %))) schema)))))
80
82
81
83
(defn pattern-codeable-concept [name schema]
82
- (print )
83
84
(->> (str " \t coding: list[" (str/join " , " (map #(str " Coding" (str/join (str/split (:code %) #"-" ))) (get-in schema [:pattern :coding ] []))) " ] = [" (str/join " , " (map #(str " Coding" (str/join (str/split (:code %) #"-" )) " ()" ) (get-in schema [:pattern :coding ] []))) " ]\n " )
84
85
(str " class " name " (CodeableConcept):\n " )
85
86
(str (when-let [coding (:coding (:pattern schema))]
89
90
(str " \n class Coding" (str/join (str/split (:code code) #"-" )) " (Coding):\n " ))) coding))) " \n " )))
90
91
91
92
(defn create-single-pattern [constraint-name, [name, schema]]
92
- (case (help/get-resource-name (:type schema))
93
- " CodeableConcept" (pattern-codeable-concept (str (help/uppercase-first-letter (help/get-resource-name constraint-name)) (help/uppercase-first-letter (subs (str name) 1 ))) schema)
94
- " default" " " ))
93
+ (println constraint-name name schema)
94
+ " "
95
+ #_ (case (help/get-resource-name (:type schema))
96
+ " CodeableConcept" (pattern-codeable-concept (str (help/uppercase-first-letter (help/get-resource-name constraint-name)) (help/uppercase-first-letter (subs (str name) 1 ))) schema)
97
+ " default" " " ))
95
98
96
99
(defn apply-patterns [constraint-name patterns schema]
97
100
(->> (map (fn [item]
106
109
107
110
108
111
(defn apply-single-constraint [constraint parent-schema]
109
- (println parent-schema )
112
+ (println ( :url constraint) ( reset! constraint-count ( + 1 ( deref constraint-count))) )
110
113
(->> (:elements parent-schema)
111
114
(apply-required (:required constraint))
112
115
(apply-excluded (:excluded constraint))
113
116
(apply-choises (filter #(contains? (last %) :choices ) (:elements constraint)))
114
117
(hash-map :elements )
115
118
(conj parent-schema)
116
- (apply-patterns (:url constraint) (filter #(contains? (last %) :pattern ) (:elements constraint)))))
119
+ #_(apply-patterns (:url constraint) (filter #(contains? (last %) :pattern ) (:elements constraint)))))
120
+
121
+ #_(reduce (fn [_, constraint-schema]
122
+ (when (not (get result (:url constraint-schema))) (reduced true ))) false constraint-schemas)
117
123
118
124
(defn apply-constraints [constraint-schemas result base-schemas]
119
- (if ( reduce ( fn [_, constraint-schema]
120
- ( when (not (get result ( :url constraint-schema))) ( reduced true ))) false constraint-schemas )
125
+ (println " run " ( count result))
126
+ ( if (not (= ( count constraint-schemas) ( count result)) )
121
127
(apply-constraints
122
128
constraint-schemas
123
129
(reduce (fn [acc constraint-schema]
124
- (if (contains? result (:base constraint-schema))
130
+ (if (and ( contains? result (:base constraint-schema)) ( not ( contains? result ( :url constraint-schema)) ))
125
131
(conj acc (hash-map (:url constraint-schema) (apply-single-constraint constraint-schema (get result (:base constraint-schema)))))
126
132
127
- (if (contains? base-schemas (:base constraint-schema))
133
+ (if (and ( contains? base-schemas (:base constraint-schema)) ( not ( contains? result ( :url constraint-schema)) ))
128
134
(conj acc (hash-map (:url constraint-schema) (apply-single-constraint constraint-schema (get base-schemas (:base constraint-schema))))) acc))) result constraint-schemas) base-schemas) result))
129
135
136
+ (defn get-class-name [profile-name]
137
+ (str/join " " (map help/uppercase-first-letter (clojure.string/split (help/get-resource-name profile-name) #"-" ))))
138
+
130
139
(defn combine-single-class [name elements]
131
140
(->> (map (fn [item]
132
141
(when (not (contains? item :choices ))
138
147
(str " \t " (:name item) " : " )
139
148
(str " \n " )))) elements)
140
149
(str/join " " )
141
- (str " \n\n class " (help/uppercase-first-letter ( help/ get-resource -name name) ) " (BaseModel):" )))
150
+ (str " \n\n class " (get-class -name name) " (BaseModel):" )))
142
151
143
152
(defn save-to-file [[name, definition ]]
144
153
(->> (str (combine-single-class name (:elements definition )))
153
162
154
163
(defn main []
155
164
(let [schemas (help/parse-ndjson-gz " /Users/gena.razmakhnin/Documents/aidbox-python-tooklit/fhir-schema-2/1.0.0_hl7.fhir.r4.core#4.0.1_package.ndjson.gz" )
156
- base-schemas (->> schemas (filter #(= (:derivation %) " specialization" )))
165
+ base-schemas (->> schemas (filter #(or ( = (:url %) " http://hl7.org/fhir/StructureDefinition/headcircum " ) ( = ( : derivation %) " specialization" ) )))
157
166
constraint-schemas (->> schemas
158
167
(filter #(= (:derivation %) " constraint" ))
159
- (filter #(or (= (:url %) " http://hl7.org/fhir/StructureDefinition/vitalsigns" ) (= (:url %) " http://hl7.org/fhir/StructureDefinition/triglyceride" ) (= (:url %) " http://hl7.org/fhir/StructureDefinition/bmi" ))))]
168
+ (filter #(not (= (:url %) " http://fhir-registry.smarthealthit.org/StructureDefinition/oauth-uris" ))))
169
+ us-core (->> (help/parse-ndjson-gz " /Users/gena.razmakhnin/Documents/aidbox-python-tooklit/fhir-schema-2/1.0.0_hl7.fhir.us.core#4.0.0_package.ndjson.gz" )
170
+ (filter #(= (:derivation %) " constraint" )))
171
+ mcode (->> (help/parse-ndjson-gz " /Users/gena.razmakhnin/Documents/aidbox-python-tooklit/fhir-schema-2/1.0.0_hl7.fhir.us.mcode#2.1.0_package.ndjson.gz" )
172
+ (filter #(= (:derivation %) " constraint" )))
173
+ codex (->> (help/parse-ndjson-gz " /Users/gena.razmakhnin/Documents/aidbox-python-tooklit/fhir-schema-2/1.0.0_hl7.fhir.us.codex-radiation-therapy#1.0.0_package.ndjson.gz" )
174
+ (filter #(= (:derivation %) " constraint" )))]
160
175
161
176
(->> base-schemas
162
177
(compile-elements )
178
+ (filter #(not (nil? (:url %))))
179
+ (map (fn [item] (hash-map (:url item) item)))
180
+ (into {})
163
181
(combine-elements )
164
182
(filter #(not (nil? (:url %))))
165
183
(map (fn [item] (hash-map (:url item) item)))
166
184
(into {})
167
- (apply-constraints constraint-schemas {})
168
- (map save-to-file ))))
185
+ (apply-constraints ( concat us-core constraint-schemas mcode codex) {})
186
+ (doallmap ))))
169
187
170
- (main )
188
+ (main )
189
+ ; ; 479 -> 521
0 commit comments