Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[#7] Verify dependencies #9

Merged
merged 10 commits into from
Jul 22, 2024
2 changes: 1 addition & 1 deletion Makefile
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
build-jar:
clj -T:build uberjar

test:
run-tests:
clj -M:test -m kaocha.runner

PATH_TO_JAR := $(project_dir)/$(jar_path)
Expand Down
7 changes: 4 additions & 3 deletions deps.edn
Original file line number Diff line number Diff line change
Expand Up @@ -8,10 +8,11 @@
:aliases
{:dev {:extra-paths ["dev"]}

:test {:extra-paths ["tests"]
:test {:extra-paths ["test"]
:exec-fn kaocha.runner/exec-fn
:extra-deps {com.health-samurai/matcho {:mvn/version "0.3.11"}
lambdaisland/kaocha {:mvn/version "1.91.1392"}}}
:extra-deps {com.health-samurai/matcho {:mvn/version "0.3.11"}
lambdaisland/kaocha {:mvn/version "1.91.1392"}
nubank/matcher-combinators {:mvn/version "3.9.1"}}}

:build {:deps {io.github.clojure/tools.build {:mvn/version "0.10.5"}}
:ns-default build}}}
11 changes: 6 additions & 5 deletions dev/user.clj
Original file line number Diff line number Diff line change
@@ -1,17 +1,19 @@
(ns user
(:require [aidbox-sdk.generator :as gen]
[aidbox-sdk.schema.verify :refer [fhir-version-pattern]]
[clojure.data]
[clojure.java.io :as io]))
[clojure.java.io :as io]
[clojure.string :as str]))

(def source' (io/file "resources/schemas"))

(def target (io/file "/tmp/sdk"))
(def target (io/file "out/"))

(defn vector-to-map [v]
(->> (map (fn [item] (hash-map (:url item) item)) v)
(into {})))

(apply merge [{:a 1 :b 2} {:a 3 :c 4}])
;; (apply merge [{:a 1 :b 2} {:a 3 :c 4}])

(comment

Expand Down Expand Up @@ -71,5 +73,4 @@

(gen/build-all! source' target)

;;
)
:rcf)
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file added resources/schemas/us.nlm.vsac#0.3.0.ndjson.gz
Binary file not shown.
8 changes: 5 additions & 3 deletions src/aidbox_sdk/core.clj
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,8 @@
(println "Error: please provide an output argument"))

:else
(generator/build-all!
(resource input)
(io/as-file output)))))
(do
(println "Building FHIR SDK...")
(generator/build-all!
(resource input)
(io/as-file output))))))
71 changes: 13 additions & 58 deletions src/aidbox_sdk/generator.clj
Original file line number Diff line number Diff line change
@@ -1,16 +1,15 @@
(ns aidbox-sdk.generator
(:refer-clojure :exclude [namespace])
(:require
[clojure.data.json :as json]
[aidbox-sdk.generator.dotnet.templates :as dotnettpl]
[aidbox-sdk.generator.helpers :refer [->pascal-case safe-conj
uppercase-first-letter vector-to-map]]
[clojure.java.io :as io]
[clojure.set :as set]
[clojure.string :as str]
[clojure.walk])
(:import
[java.util.zip ZipEntry ZipOutputStream]))
(:require [aidbox-sdk.generator.dotnet.templates :as dotnettpl]
[aidbox-sdk.generator.helpers :refer [->pascal-case safe-conj
uppercase-first-letter
vector-to-map]]
[aidbox-sdk.schema :as schema]
[clojure.java.io :as io]
[clojure.set :as set]
[clojure.string :as str]
[clojure.walk])
(:import [java.util.zip ZipEntry ZipOutputStream]))

;;
;; FHIR
Expand Down Expand Up @@ -646,6 +645,7 @@
(delete-directory! dir)
(create-directory! dir))

;; FIXME do we need it?
(defn zip-dir! [path zip-name]
(with-open [zip (ZipOutputStream. (io/output-stream zip-name))]
(doseq [f (file-seq (io/file path)) :when (.isFile f)]
Expand All @@ -654,6 +654,7 @@
(.closeEntry zip)))
(io/file zip-name))

;; FIXME do we need it?
(defn copy-files! [src-dir target-dir]
(doseq [file (remove #(.isDirectory %) (file-seq src-dir))]
(io/copy file (io/file target-dir (.getName file)))))
Expand Down Expand Up @@ -691,61 +692,15 @@
(conj schema {:backbone-elements
(flat-backbones (:backbone-elements schema) [])})))))

(defn get-directory-files [path]
(->> path
file-seq
(remove #(.isDirectory %))))

(defn fetch-packages [source-path]
(->> source-path
(get-directory-files)
(remove #(.isDirectory %))
(filter #(str/includes? (.getName %) "hl7.fhir"))))

(defn create-gzip-reader [path]
(-> path
(io/input-stream)
(java.util.zip.GZIPInputStream.)
(io/reader)))

(defn parse-ndjson-gz [path]
(with-open [rdr (create-gzip-reader path)]
(->> rdr
line-seq
(mapv (fn [line]
(json/read-str line :key-fn keyword))))))

(defn merge-duplicates [schemas]
(->> schemas
(group-by :url)
(map (fn [[_url same-url-schemas]]
(apply merge same-url-schemas)))))

(defmulti retrieve-schemas class)

(defmethod retrieve-schemas java.io.File
[source]
(->> (fetch-packages source)
(map parse-ndjson-gz)
(flatten)
(remove #(nil? (:package-meta %)))
(map (fn [schema]
(assoc schema :package (get-in schema [:package-meta :name]))))
(merge-duplicates)))

(defmethod retrieve-schemas java.net.URL
[source] (do "something"))

(defn build-all! [input output]
(let [search-parameters-dir (io/file output "search")
all-schemas (retrieve-schemas input)
all-schemas (schema/retrieve input)
;; search-params-schemas (retrieve-search-params source-dir)
search-params-schemas all-schemas
constraints (->> all-schemas
(filter #(and
(constraint? %)
(not (from-extension? %)))))]

(prepare-target-directory! output)

;; create base namespace (all FHIR datatypes) file
Expand Down
70 changes: 70 additions & 0 deletions src/aidbox_sdk/schema.clj
Original file line number Diff line number Diff line change
@@ -0,0 +1,70 @@
(ns aidbox-sdk.schema
(:require [aidbox-sdk.schema.verify :as verify]
[clojure.data.json :as json]
[clojure.java.io :as io]
[clojure.string :as str]))

(defn get-packages-from-directory
"Returns all packages in the given directory, including files in subdirectories.
NOTE: right now it'll filter out all files which do not contains hl7.fhir
in their name."
[path]
(let [packages (->> path
file-seq
(remove #(.isDirectory %))
;; FIXME only gzip, but there is no problem to accept unpacked ndjson
;; see https://github.com/Aidbox/aidbox-sdk/issues/11
(filter #(str/ends-with? (.getName %) ".gz")))]
(println "✅ Found packages:" (count packages))
packages))

(defn create-gzip-reader [path]
(-> path
(io/input-stream)
(java.util.zip.GZIPInputStream.)
(io/reader)))

;; TODO derive some criteria to determine whether it's a package (is it valid?)
;; see https://github.com/Aidbox/aidbox-sdk/issues/10
(defn parse-package [path]
(println "Parsing package:" (str path))
(with-open [rdr (create-gzip-reader path)]
(->> rdr
line-seq
(mapv (fn [line]
(json/read-str line :key-fn keyword))))))

(defn remove-invalid-schemas [schemas]
(remove #(nil? (:package-meta %)) schemas))

(defn merge-duplicates [schemas]
(->> schemas
(group-by :url)
(map (fn [[_url same-url-schemas]]
(apply merge same-url-schemas)))))

(defn prepare-schemas [schemas]
(map #(->> (get-in % [:package-meta :name])
(assoc % :package))
schemas))


(defmulti retrieve class)

;; ! According to an example here:
;; ! https://clojuredocs.org/clojure.java.io/file
;; ! it's possible to create a File instance from url, which may lead to bugs
(defmethod retrieve java.io.File
[source]
(println "Retrieving packages from: " (str source))
(->> (get-packages-from-directory source)
(mapv parse-package)
(verify/check-compatibility!)
(flatten)
(remove-invalid-schemas)
(prepare-schemas)
(merge-duplicates)))

(defmethod retrieve java.net.URL
[source]
(do "something"))
144 changes: 144 additions & 0 deletions src/aidbox_sdk/schema/verify.clj
Original file line number Diff line number Diff line change
@@ -0,0 +1,144 @@
(ns aidbox-sdk.schema.verify
(:require [clojure.string :as str]))

(def fhir-version-pattern
#"^(0|[1-9]\d*)\.(0|[1-9]\d*)(?:\.(0|[1-9]\d*))?(?:-((?:0|[1-9]\d*|\d*[a-zA-Z-][0-9a-zA-Z-]*))?)?$")

(defn versions-match? [v1 v2]
(let [->groups (fn [v] (->> v (re-matcher fhir-version-pattern) re-find))
->map (fn [[_ major minor patch label]]
{:major major, :minor minor, :patch patch, :label label})

v1-groups (-> v1 ->groups ->map)
v2-groups (-> v2 ->groups ->map)]

(if (and v1-groups v2-groups)
(and (= (:major v1-groups) (:major v2-groups))
(= (:minor v1-groups) (:minor v2-groups)))
false)))

(defn simplify-package-meta [package]
(select-keys package [:name :version]))


;; FIXME: is it reliable to use first element of the list?
;; ! seems like it's not for original packages (without Aidbox processing).
(defn extract-meta-from-package
"Extracts meta information from the package."
[package]
(first package))

(defn find-core-package
"Finds core package in the list of packages.
Throws an exception if there are more then one core package."
[packages]
(let [cores (filter #(= "fhir.core" (:type %)) packages)
core (first cores)]
(cond
(= (count cores) 0)
(throw (ex-info "No core package found" {}))

(> (count cores) 1)
(throw (ex-info "Found more then one core package"
{:packages (mapv #(simplify-package-meta %) cores)}))

:else
core)))

(defn find-extra-packages
"Finds extra packages in the list of packages.
Throws an exception if there are a few packages with same name."
[packages]
(let [extra (remove #(= "fhir.core" (:type %)) packages)

duplicates (reduce (fn [duplicates [k v]]
(if (= (count v) 1)
duplicates
(assoc duplicates k v)))
{} (group-by :name extra))]
(cond
(> (count duplicates) 0)
(throw (ex-info "Found more then one package with same name"
{:packages (keys duplicates)}))

:else
extra))

(remove #(= "fhir.core" (:type %)) packages))

(defn find-core-package-mismatch
"Finds packages which do not support a core package version."
[version packages]
(->> packages
(mapv (fn [package]
(assoc package :match-with-core?
(if (> (count (:fhirVersions package)) 0)
(->> (:fhirVersions package)
(map #(versions-match? version %))
(some #{true})
(boolean))
true))))

(filterv #(not (:match-with-core? %)))))

(defn- find-failed-dependencies
"Finds failed dependencies for the package looking up in all packages.
In case of failure will return a vec of failed dependencies."
[packages {:keys [dependencies]}]
(reduce (fn [mismatch dependency]
(let [dependency
(if (str/starts-with? dependency ":")
(subs dependency 1)
dependency)

[dep-name dep-version]
(str/split dependency #"#")

found
(->> packages
(filterv #(= (:name %) dep-name))
(mapv #(simplify-package-meta %)))]

(if (and (= (count found) 1)
(every? #(= (:version %) dep-version) found))
mismatch
(conj mismatch {:required {:name dep-name
:version dep-version}
:found found}))))
[] dependencies))

(defn find-dependencies-mismatch
"Finds packages with failed dependencies check."
[packages]
(reduce (fn [mismatches package]
(let [failed-dependencies (find-failed-dependencies packages package)]
(if-not (empty? failed-dependencies)
(->> failed-dependencies
(assoc package :failed-dependencies)
(conj mismatches))
mismatches)))
[] packages))

(defn check-compatibility! [packages]
(println "Verifying compatibility...")
(let [all (map extract-meta-from-package packages)
core (find-core-package all)
extra (find-extra-packages all)]
(println "✅ Core package found:" (simplify-package-meta core))

(println "Checking core version match...")
(let [core-mismatch (find-core-package-mismatch (:version core) extra)]
(when-not (empty? core-mismatch)
(throw (ex-info "Some packages do not match with core version"
{:version (:version core)
:packages (mapv :name core-mismatch)}))))
(println "✅ Core version match check passed")

(println "Checking dependencies match...")
(let [deps-mismatch (find-dependencies-mismatch all)]
(when-not (empty? deps-mismatch)
(throw (ex-info "Some packages failed dependencies check"
{:packages (mapv #(select-keys % [:name :failed-dependencies])
deps-mismatch)}))))
(println "✅ Dependencies match check passed"))
packages)
File renamed without changes.
Loading