diff --git a/clinic/package-lock.json b/clinic/package-lock.json index 2899bbc..ad423a5 100644 --- a/clinic/package-lock.json +++ b/clinic/package-lock.json @@ -5,6 +5,7 @@ "packages": { "": { "dependencies": { + "highlight.js": "11.5.1", "react": "^17.0.2", "react-dom": "^17.0.2" }, @@ -527,6 +528,14 @@ "minimalistic-assert": "^1.0.1" } }, + "node_modules/highlight.js": { + "version": "11.5.1", + "resolved": "https://registry.npmjs.org/highlight.js/-/highlight.js-11.5.1.tgz", + "integrity": "sha512-LKzHqnxr4CrD2YsNoIf/o5nJ09j4yi/GcH5BnYz9UnVpZdS4ucMgvP61TDty5xJcFGRjnH4DpujkS9bHT3hq0Q==", + "engines": { + "node": ">=12.0.0" + } + }, "node_modules/hmac-drbg": { "version": "1.0.1", "resolved": "https://registry.npmjs.org/hmac-drbg/-/hmac-drbg-1.0.1.tgz", diff --git a/clinic/package.json b/clinic/package.json index b6e7fb2..3f0946b 100644 --- a/clinic/package.json +++ b/clinic/package.json @@ -3,6 +3,7 @@ "shadow-cljs": "^2.25.6" }, "dependencies": { + "highlight.js": "11.5.1", "react": "^17.0.2", "react-dom": "^17.0.2" } diff --git a/clinic/shadow-cljs.edn b/clinic/shadow-cljs.edn index d68066c..42140b7 100644 --- a/clinic/shadow-cljs.edn +++ b/clinic/shadow-cljs.edn @@ -3,6 +3,8 @@ [binaryage/devtools "1.0.7"] [cljs-ajax "0.7.5"] [day8.re-frame/http-fx "0.2.4"] + [day8.re-frame/re-frame-10x "1.8.1"] + [day8.re-frame/tracing "0.6.2"] [kibu/pushy "0.3.8"] [nrepl "1.0.0"] [re-frame "1.3.0"] @@ -12,4 +14,12 @@ :output-dir "resources/public/js" :asset-path "/js" :modules {:app {:entries [clinic.core]}} - :devtools {:after-load clinic.core/mount-root}}}} + :devtools {:preloads [day8.re-frame-10x.preload] + :after-load clinic.core/mount-root} + :dev {:compiler-options + {:closure-defines + {re-frame.trace.trace-enabled? true + day8.re-frame.tracing.trace-enabled? true}}} + :release {:build-options + {:ns-aliases + {day8.re-frame.tracing day8.re-frame.tracing-stubs}}}}}} diff --git a/clinic/src/clj/clinic/fhir/client.clj b/clinic/src/clj/clinic/fhir/client.clj index b0740fa..5ef78ef 100644 --- a/clinic/src/clj/clinic/fhir/client.clj +++ b/clinic/src/clj/clinic/fhir/client.clj @@ -6,7 +6,7 @@ "Performs a HTTP POST request on a FHIR server at the given `base-url` for a given `resource` with given HTTP `headers`. - Returns HTTP response of the server after JSON parsing its body." + Returns the HTTP response of the server after JSON parsing its body." [base-url resource headers] (-> (if (= "Bundle" (resource :resourceType)) base-url ; Bundle resources should POST at the server root @@ -15,3 +15,31 @@ :body (json/generate-string resource) :throw-exceptions false}) (update :body json/parse-string true))) + +(defn get-all + "Searches the given `resource-type` on a FHIR server at the given `base-url` + and appends the given `query-params` to the request for filtering the search + results. + + Returns the HTTP response of the server (FHIR Bundle with `searchset` type) + after JSON parsing its body." + [base-url resource-type query-params] + (-> base-url + (str "/" resource-type) + (http/get {:headers {"Accept" "application/fhir+json"} + :query-params query-params + :throw-exceptions false}) + (update :body json/parse-string true))) + +(defn get-by-id + "Looks up a FHIR resource of the given `resource-type` with the given `id` on + a FHIR server at the given `base-url`. + + Returns the HTTP response of the server (Patient resource) after JSON parsing + its body." + [base-url resource-type id] + (-> base-url + (str "/" resource-type "/" id) + (http/get {:headers {"Accept" "application/fhir+json"} + :throw-exceptions false}) + (update :body json/parse-string true))) diff --git a/clinic/src/clj/clinic/routes/patient.clj b/clinic/src/clj/clinic/routes/patient.clj index 6183040..584fac5 100644 --- a/clinic/src/clj/clinic/routes/patient.clj +++ b/clinic/src/clj/clinic/routes/patient.clj @@ -1,6 +1,6 @@ (ns clinic.routes.patient (:require [clinic.service.patient :as svc] - [compojure.core :refer [defroutes POST]] + [compojure.core :refer [defroutes GET POST]] [ring.util.response :as r])) (defn- create-patient! [{{fhir-server-url :fhir-server-base-url} :config @@ -19,5 +19,34 @@ :invalid-params (r/status 400) (throw e)))))) +(defn- list-patients [{{fhir-server-url :fhir-server-base-url} :config + {:keys [phone offset count]} :params}] + (try + ;; `params` in request contains form + query params. Therefore, destructure + ;; only what is needed. + (-> (svc/get-all fhir-server-url {:phone phone + :offset offset + :count count}) + (r/response) + (r/status 200)) + (catch Exception e + (case (:type (ex-data e)) + :invalid-params (r/status 400) + (throw e))))) + +(defn- get-patient [{{fhir-server-url :fhir-server-base-url} :config + {:keys [id]} :params}] + (try + (-> (svc/get-by-id fhir-server-url id) + (r/response) + (r/status 200)) + (catch Exception e + (case (:type (ex-data e)) + :invalid-params (r/status 400) + :patient-not-found (r/status 404) + (throw e))))) + (defroutes handler - (POST "/" _ create-patient!)) + (POST "/" _ create-patient!) + (GET "/" _ list-patients) + (GET "/:id" _ get-patient)) diff --git a/clinic/src/clj/clinic/service/patient.clj b/clinic/src/clj/clinic/service/patient.clj index 308db14..15607a0 100644 --- a/clinic/src/clj/clinic/service/patient.clj +++ b/clinic/src/clj/clinic/service/patient.clj @@ -2,6 +2,7 @@ (:require [clinic.fhir.client :as fc] [clinic.fhir.utils :as fu] [clinic.specs.patient :as specs] + [clinic.utils :as u] [clojure.spec.alpha :as s] [clojure.string :as string])) @@ -54,12 +55,66 @@ (throw (ex-info "invalid create params" {:type :invalid-params :details (s/explain-data ::specs/create-params params)}))) - (let [{status :status - body :body} (fc/create! fhir-server-url - (domain->fhir params) - nil)] + (let [{:keys [status body]} (fc/create! fhir-server-url + (-> params + ;; ignore phone number formatting + ;; characters and only keep its + ;; digits. + (update :phone u/extract-digits) + (domain->fhir)) + nil)] (cond (= status 201) (fhir->domain body) :else (throw (ex-info "upstream service error" {:type :upstream-error :response {:status status :body body}}))))) + +(defn get-all + "Lists patient resources from a FHIR server at the given `fhir-server-url` and + uses the given `params` to apply filters to the search. + + The accepted `params` are: + - `:phone` (optional): The phone number of the Patient. + - `:offset` (optional, default 0): The number of Patient resources to skip in + the result set. + - `:count` (optional, default 10): The maximum count of Patient resources to + return with the result. + " + [fhir-server-url params] + (when-not (s/valid? ::specs/get-all-params params) + (throw (ex-info "invalid get-all params" + {:type :invalid-params + :details (s/explain-data ::specs/get-all-params params)}))) + (let [{:keys [phone offset count]} params + query-params (cond-> {:_offset "0" + :_count "10"} + phone (assoc :phone (u/extract-digits phone)) + offset (assoc :_offset offset) + count (assoc :_count count)) + {:keys [status body]} (fc/get-all fhir-server-url "Patient" query-params)] + (cond + (= status 200) (->> body + (:entry) + (map :resource) + (map fhir->domain)) + :else (throw (ex-info "upstream service error" + {:type :upstream-error + :response {:status status :body body}}))))) + +(defn get-by-id + "Gets a Patient resource by its `id` from a FHIR server at the given + `fhir-server-url`." + [fhir-server-url id] + (when-not (s/valid? ::specs/id id) + (throw (ex-info "invalid `id` path param" + {:type :invalid-params + :details (s/explain-data ::specs/id id)}))) + (let [{:keys [status body]} (fc/get-by-id fhir-server-url "Patient" id)] + (cond + (= status 200) (fhir->domain body) + (= status 404) (throw (ex-info "patient not found" + {:type :patient-not-found + :patient-id id})) + :else (throw (ex-info "upstream service error" + {:type :upstream-error + :response {:status status :body body}}))))) diff --git a/clinic/src/cljc/clinic/specs/patient.cljc b/clinic/src/cljc/clinic/specs/patient.cljc index 3041249..d501dd4 100644 --- a/clinic/src/cljc/clinic/specs/patient.cljc +++ b/clinic/src/cljc/clinic/specs/patient.cljc @@ -3,6 +3,14 @@ [clojure.string :as string])) (def ^:private not-blank? (complement string/blank?)) +(def ^:private int-string? (partial re-matches #"\d+")) + +(defn phone-number? [v] + ;; Not strictly checking the input sequence for digits and allowing room for + ;; phone number formatting characters. Taking the number of digits in a phone + ;; number from the E.164 standard. https://en.wikipedia.org/wiki/E.164 + (and (re-matches #"\+?[\d-()x\[\]\. ]+" v) + (<= 8 (count (re-seq #"\d" v)) 15))) (defn- date? [v] #?(:clj (try (java.time.LocalDate/parse v) @@ -19,12 +27,17 @@ (s/def ::gender #{"male" "female" "other" "unknown"}) (s/def ::marital-status (s/nilable #{"A" "D" "I" "L" "M" "P" "S" "T" "U" "W" "UNK"})) (s/def ::email (s/nilable (s/and string? not-blank?))) -(s/def ::phone (s/nilable (s/and string? not-blank?))) +(s/def ::phone (s/nilable (s/and string? phone-number?))) +(s/def ::offset (s/nilable int-string?)) +(s/def ::count (s/nilable (s/and int-string? #(<= 1 (parse-long %) 20)))) (s/def ::create-params - (s/keys :req-un [::first-name ::last-name ::birth-date ::gender] - :opt-un [::marital-status ::email ::phone])) + (s/keys :req-un [::first-name ::last-name ::birth-date ::gender ::phone] + :opt-un [::marital-status ::email])) (s/def ::patient - (s/keys :req-un [::id ::first-name ::last-name ::birth-date ::gender] - :opt-un [::marital-status ::email ::phone])) + (s/keys :req-un [::id ::first-name ::last-name ::birth-date ::gender ::phone] + :opt-un [::marital-status ::email])) + +(s/def ::get-all-params + (s/keys :opt-un [::offset ::count ::phone])) diff --git a/clinic/src/cljc/clinic/utils.cljc b/clinic/src/cljc/clinic/utils.cljc new file mode 100644 index 0000000..c8829b4 --- /dev/null +++ b/clinic/src/cljc/clinic/utils.cljc @@ -0,0 +1,4 @@ +(ns clinic.utils) + +(defn extract-digits [s] + (apply str (re-seq #"\d" s))) diff --git a/clinic/src/cljs/clinic/components.cljs b/clinic/src/cljs/clinic/components.cljs index 599194d..f350a0c 100644 --- a/clinic/src/cljs/clinic/components.cljs +++ b/clinic/src/cljs/clinic/components.cljs @@ -1,22 +1,25 @@ (ns clinic.components (:require [reagent.core :as r])) -(defn heading-1 [text] - [:h1 {:class "text-3xl md:text-4xl"} text]) +(defn heading-1 [] + (into [:h1 {:class "text-3xl md:text-4xl"}] + (r/children (r/current-component)))) -(defn heading-2 [text] - [:h2 {:class ["text-xl" "md:text-2xl"]} text]) +(defn heading-2 [] + (into [:h2 {:class ["text-xl" "md:text-2xl"]}] + (r/children (r/current-component)))) (defn page [] (let [this (r/current-component) props (r/props this) - logout-enabled (props :logout-enabled) - logout-handler (props :on-logout-click #())] + title-href (:title-href props) + logout-enabled (:logout-enabled props) + logout-handler (get props :on-logout-click #())] (into [:main {:class ["flex" "flex-col gap-12 md:gap-16" "w-full max-w-4xl" "mx-auto p-8 md:p-12"]} [:header {:class ["flex" "flex-row" "gap-12"]} - [heading-1 "Acme Orthopedic Clinic"] + [:a {:href title-href} [heading-1 "Acme Orthopedic Clinic"]] (when logout-enabled [:<> [:div {:class "flex-grow"}] @@ -29,12 +32,12 @@ (r/children this)))) (defn text-field [] - (let [{name :name - label :label - placeholder :placeholder - error-msg :error-msg - touched? :touched? - invalid? :invalid?} (r/props (r/current-component))] + (let [{:keys [name + label + placeholder + error-msg + touched? + invalid?]} (r/props (r/current-component))] [:div {:class ["w-full" "flex" "flex-col" "gap-2"]} [:label {:for name :class ["block" "uppercase" "tracking-wide" "text-gray-600" @@ -53,73 +56,81 @@ "text-red-500" "text-xs" "italic"]} error-msg]])) -(defn select-field [name label default-value options] - [:div {:class ["w-full" "flex" "flex-col" "gap-2"]} - [:label {:for name - :class ["block" "uppercase" "tracking-wide" "text-gray-600" - "text-xs" "font-bold"]} - label] - [:div {:class ["relative"]} - (into [:select {:id name - :name name - :defaultValue default-value - :class ["appearance-none" "block" "w-full" "bg-gray-200" - "text-gray-700" "border" "border-gray-200" - "rounded" "py-3" "px-4" "pr-8" "leading-tight" - "focus:outline-none" "focus:bg-white" - "focus:border-gray-500"]}] - (for [[name value] options] - [:option {:value value} name])) - [:div - {:class ["pointer-events-none" "absolute" "inset-y-0" "right-0" "flex" - "items-center" "px-2" "text-gray-700"]} - [:svg - {:class "fill-current h-4 w-4", - :xmlns "http://www.w3.org/2000/svg", - :viewBox "0 0 20 20"} - [:path - {:d "M9.293 12.95l.707.707L15.657 8l-1.414-1.414L10 10.828 5.757 6.586 4.343 8z"}]]]]]) +(defn select-field [] + (let [{:keys [name + label + default-value + options]} (r/props (r/current-component))] + [:div {:class ["w-full" "flex" "flex-col" "gap-2"]} + [:label {:for name + :class ["block" "uppercase" "tracking-wide" "text-gray-600" + "text-xs" "font-bold"]} + label] + [:div {:class ["relative"]} + (into [:select {:id name + :name name + :defaultValue default-value + :class ["appearance-none" "block" "w-full" "bg-gray-200" + "text-gray-700" "border" "border-gray-200" + "rounded" "py-3" "px-4" "pr-8" "leading-tight" + "focus:outline-none" "focus:bg-white" + "focus:border-gray-500"]}] + (for [[name value] options] + [:option {:value value} name])) + [:div + {:class ["pointer-events-none" "absolute" "inset-y-0" "right-0" "flex" + "items-center" "px-2" "text-gray-700"]} + [:svg + {:class "fill-current h-4 w-4", + :xmlns "http://www.w3.org/2000/svg", + :viewBox "0 0 20 20"} + [:path + {:d "M9.293 12.95l.707.707L15.657 8l-1.414-1.414L10 10.828 5.757 6.586 4.343 8z"}]]]]])) + +(defn spinner [] + (let [props (r/props (r/current-component))] + [:svg {:class (into ["animate-spin"] (:class props)) + :aria-hidden "true" + :role "status" + :viewBox "0 0 100 101" + :fill "none" + :xmlns "http://www.w3.org/2000/svg"} + [:path + {:d "M100 50.5908C100 78.2051 77.6142 100.591 50 100.591C22.3858 100.591 0 + 78.2051 0 50.5908C0 22.9766 22.3858 0.59082 50 0.59082C77.6142 0.59082 + 100 22.9766 100 50.5908ZM9.08144 50.5908C9.08144 73.1895 27.4013 + 91.5094 50 91.5094C72.5987 91.5094 90.9186 73.1895 90.9186 + 50.5908C90.9186 27.9921 72.5987 9.67226 50 9.67226C27.4013 9.67226 + 9.08144 27.9921 9.08144 50.5908Z" + :fill "#E5E7EB"}] + [:path + {:d "M93.9676 39.0409C96.393 38.4038 97.8624 35.9116 97.0079 + 33.5539C95.2932 28.8227 92.871 24.3692 89.8167 20.348C85.8452 + 15.1192 80.8826 10.7238 75.2124 7.41289C69.5422 4.10194 63.2754 + 1.94025 56.7698 1.05124C51.7666 0.367541 46.6976 0.446843 41.7345 + 1.27873C39.2613 1.69328 37.813 4.19778 38.4501 6.62326C39.0873 + 9.04874 41.5694 10.4717 44.0505 10.1071C47.8511 9.54855 51.7191 + 9.52689 55.5402 10.0491C60.8642 10.7766 65.9928 12.5457 70.6331 + 15.2552C75.2735 17.9648 79.3347 21.5619 82.5849 25.841C84.9175 + 28.9121 86.7997 32.2913 88.1811 35.8758C89.083 38.2158 91.5421 + 39.6781 93.9676 39.0409Z" + :fill "currentColor"}]])) -(defn button [type text loading] - [:button - {:disabled loading - :type type - :class [(if loading "bg-blue-400" "bg-blue-600") - (if loading "hover:bg-blue-400" "hover:bg-blue-800") - "text-white" "font-medium" "py-2" "px-4" "rounded-full" - "focus:ring-4" "focus:outline-none" "focus:ring-blue-300" - "rounded-full" "text-md" "text-center" "dark:bg-blue-600" - "dark:hover:bg-blue-700" "dark:focus:ring-blue-800" - "inline-flex" "items-center" "justify-center"]} - [:svg - {:class [(if loading "visible" "invisible") - "inline" "w-6" "h-6" "-ml-9" "mr-3" "text-white" "animate-spin"] - :aria-hidden "true" - :role "status" - :viewBox "0 0 100 101" - :fill "none" - :xmlns "http://www.w3.org/2000/svg"} - [:path - {:d "M100 50.5908C100 78.2051 77.6142 100.591 50 100.591C22.3858 100.591 0 - 78.2051 0 50.5908C0 22.9766 22.3858 0.59082 50 0.59082C77.6142 0.59082 - 100 22.9766 100 50.5908ZM9.08144 50.5908C9.08144 73.1895 27.4013 - 91.5094 50 91.5094C72.5987 91.5094 90.9186 73.1895 90.9186 - 50.5908C90.9186 27.9921 72.5987 9.67226 50 9.67226C27.4013 9.67226 - 9.08144 27.9921 9.08144 50.5908Z" - :fill "#E5E7EB"}] - [:path - {:d "M93.9676 39.0409C96.393 38.4038 97.8624 35.9116 97.0079 - 33.5539C95.2932 28.8227 92.871 24.3692 89.8167 20.348C85.8452 - 15.1192 80.8826 10.7238 75.2124 7.41289C69.5422 4.10194 63.2754 - 1.94025 56.7698 1.05124C51.7666 0.367541 46.6976 0.446843 41.7345 - 1.27873C39.2613 1.69328 37.813 4.19778 38.4501 6.62326C39.0873 - 9.04874 41.5694 10.4717 44.0505 10.1071C47.8511 9.54855 51.7191 - 9.52689 55.5402 10.0491C60.8642 10.7766 65.9928 12.5457 70.6331 - 15.2552C75.2735 17.9648 79.3347 21.5619 82.5849 25.841C84.9175 - 28.9121 86.7997 32.2913 88.1811 35.8758C89.083 38.2158 91.5421 - 39.6781 93.9676 39.0409Z", - :fill "currentColor"}]] - text]) +(defn button [] + (let [{:keys [type text loading?]} (r/props (r/current-component))] + [:button + {:disabled loading? + :type type + :class [(if loading? "bg-blue-400" "bg-blue-600") + (if loading? "hover:bg-blue-400" "hover:bg-blue-800") + "text-white" "font-medium" "py-2" "px-4" "rounded-full" + "focus:ring-4" "focus:outline-none" "focus:ring-blue-300" + "rounded-full" "text-md" "text-center" "dark:bg-blue-600" + "dark:hover:bg-blue-700" "dark:focus:ring-blue-800" + "inline-flex" "items-center" "justify-center"]} + [spinner {:class [(if loading? "visible" "invisible") + "inline" "w-6" "h-6" "-ml-9" "mr-3" "text-white"]}] + text])) (defn danger-alert [] (into [:div diff --git a/clinic/src/cljs/clinic/router.cljs b/clinic/src/cljs/clinic/router.cljs index 11d5209..a34161e 100644 --- a/clinic/src/cljs/clinic/router.cljs +++ b/clinic/src/cljs/clinic/router.cljs @@ -1,26 +1,47 @@ (ns clinic.router (:require [bidi.bidi :as bidi] + [clinic.utils :as u] [pushy.core :as pushy] [re-frame.core :as rf])) (def ^:private routes - ["/" {"" ::home - "patients/" {"new" ::create-patient - [:id] ::view-patient}}]) + ["" {"/" ::home + "/patients" {"/new" ::create-patient + ["/" :id] ::view-patient + "" ::search-patients}}]) (def ^:private history - (pushy/pushy #(rf/dispatch [::set-current-view (:handler %)]) - (partial bidi/match-route routes))) + (pushy/pushy #(rf/dispatch [::set-current-view + (:handler %) + (merge (:route-params %) + (:query-params %))]) + #(-> (bidi/match-route routes %) + (assoc :query-params (u/query-params %))))) + +(def path-for (partial bidi/path-for routes)) (defn start! [] (pushy/start! history)) -(defn replace-token! [token] - (pushy/replace-token! history token)) +(rf/reg-event-fx ::set-current-view + (fn [{db :db} [_ view-id params]] + {:db (assoc db ::current-view {::id view-id ::params params}) + :dispatch [::on-current-view-changed]})) -(defn set-token! [token] - (pushy/set-token! history token)) +(rf/reg-sub ::current-view get-in) (rf/reg-fx ::set-token (fn router-set-token-effect [token] - (set-token! token))) + (pushy/set-token! history token))) + +(rf/reg-fx ::replace-token + (fn router-replace-token-effect [token] + (pushy/replace-token! history token))) + +(rf/reg-event-fx ::set-token + (fn [_ [_ token]] + {::set-token token})) + +(rf/reg-event-fx ::replace-token + (fn [_ [_ token]] + {::replace-token token})) diff --git a/clinic/src/cljs/clinic/utils.cljs b/clinic/src/cljs/clinic/utils.cljs index a901e27..5be7e2d 100644 --- a/clinic/src/cljs/clinic/utils.cljs +++ b/clinic/src/cljs/clinic/utils.cljs @@ -1,5 +1,6 @@ (ns clinic.utils - (:require [clojure.spec.alpha :as s])) + (:require [clojure.spec.alpha :as s] + [clojure.string :as string])) (defn form-data->map "Converts DOM FormData to a Clojure map. Also keywordizes keys in the @@ -23,3 +24,22 @@ (map :in) (flatten) (set))) + +(defn query-params + "Returns a keywordized map of query parameters in the given `url`." + [url] + (->> (js/URL. url + (-> js/window + (.-location) + (.-origin))) + (.-searchParams) + (map (fn [[k v]] [(keyword k) v])) + (into {}))) + +(defn url [path query-params] + (->> query-params + (map #(str (-> % (first) (name)) + "=" + (-> % (second) (js/encodeURIComponent)))) + (string/join "&") + (str path "?"))) diff --git a/clinic/src/cljs/clinic/views/core.cljs b/clinic/src/cljs/clinic/views/core.cljs index 7b47b63..939f497 100644 --- a/clinic/src/cljs/clinic/views/core.cljs +++ b/clinic/src/cljs/clinic/views/core.cljs @@ -4,34 +4,41 @@ [clinic.user-role.core :as user-role] [clinic.views.create-patient :as create-patient] [clinic.views.home :as home] + [clinic.views.list-patients :as list-patients] [clinic.views.not-found :as not-found] + [clinic.views.view-patient :as view-patient] [re-frame.core :as rf])) -(def ^:private views {::router/home home/root - ::router/create-patient create-patient/root}) - -(def ^:private titles {::router/home "Home" - ::router/create-patient "Add Patient"}) - (rf/reg-fx ::set-window-title - (fn [view-id] + (fn [title] (set! (.-title js/document) - (-> titles - (get view-id "Page Not Found") + (-> title + (or "Page Not Found") (str " - Acme Clinic"))))) -(rf/reg-event-fx ::router/set-current-view - (fn [{db :db} [_ view-id]] - {:db (assoc db ::current-view-id view-id) - ::set-window-title view-id})) - -(rf/reg-sub ::current-view-id :-> ::current-view-id) +(rf/reg-event-fx ::router/on-current-view-changed + (fn [{db :db} _] + (let [{view-id ::router/id + params ::router/params} (::router/current-view db)] + (case view-id + ::router/home {::set-window-title "Home"} + ::router/create-patient {::set-window-title "Add Patient"} + ::router/view-patient {::set-window-title "Patient Info" + :dispatch [::view-patient/fetch-patient params]} + ::router/search-patients {::set-window-title "Search Patients" + :dispatch [::list-patients/fetch-patients params]})))) (defn root [] - (let [current-role (user-role/get) - current-view (rf/subscribe [::current-view-id])] - (fn [] - [components/page {:logout-enabled @current-role - :on-logout-click #(do (user-role/clear) - (router/replace-token! "/"))} - [(get views @current-view not-found/root)]]))) + (let [current-role @(user-role/get) + current-view-id @(rf/subscribe [::router/current-view ::router/id])] + [components/page {:title-href (router/path-for ::router/home) + :logout-enabled current-role + :on-logout-click #(do (user-role/clear) + (rf/dispatch [::router/replace-token + (router/path-for ::router/home)]))} + [(case current-view-id + ::router/home home/root + ::router/create-patient create-patient/root + ::router/view-patient view-patient/root + ::router/search-patients list-patients/root + not-found/root)]])) diff --git a/clinic/src/cljs/clinic/views/create_patient.cljs b/clinic/src/cljs/clinic/views/create_patient.cljs index 1599040..a224a30 100644 --- a/clinic/src/cljs/clinic/views/create_patient.cljs +++ b/clinic/src/cljs/clinic/views/create_patient.cljs @@ -8,34 +8,33 @@ [re-frame.core :as rf] [reagent.core :as r])) -(rf/reg-event-fx ::submit-form-success +(rf/reg-event-fx ::submit-form-data-success (fn [{db :db} [_ result]] - {:db (assoc db ::submitting-form false) - ::router/set-token (str "/patients/" (result :id))})) + {:db (assoc db ::submit-form {::loading false}) + ::router/set-token (router/path-for ::router/view-patient :id (result :id))})) -(rf/reg-event-db ::submit-form-failure - (fn [db [_ result]] - (into db {::submitting-form false - ::submit-form-error-code (result :status)}))) +(rf/reg-event-db ::submit-form-data-failure + (fn [db [_ {error-code :status}]] + (assoc db ::submit-form {::loading false + ::error-code error-code}))) -(rf/reg-event-fx ::submit-form +(rf/reg-event-fx ::submit-form-data (fn [{db :db} [_ form-data]] - {:db (assoc db ::submitting-form true) + {:db (assoc-in db [::submit-form ::loading] true) :http-xhrio {:method :post :uri "/api/v1/patients/" :params form-data :format (ajax/json-request-format) :response-format (ajax/json-response-format {:keywords? true}) - :on-success [::submit-form-success] - :on-failure [::submit-form-failure]}})) + :on-success [::submit-form-data-success] + :on-failure [::submit-form-data-failure]}})) -(rf/reg-sub ::submitting-form :-> ::submitting-form) -(rf/reg-sub ::submit-form-error-code :-> ::submit-form-error-code) +(rf/reg-sub ::submit-form get-in) (defn form-data [form] (-> form (js/FormData.) - (u/form-data->map #{:marital-status :email :phone}))) + (u/form-data->map #{:marital-status :email}))) (defn find-invalid-keys [form] (->> form @@ -46,14 +45,13 @@ (let [form-ref (atom nil) touched? (r/atom #{}) invalid? (r/atom #{}) - submitting? (rf/subscribe [::submitting-form]) - submit-error-code (rf/subscribe [::submit-form-error-code])] + loading? (rf/subscribe [::submit-form ::loading]) + error-code (rf/subscribe [::submit-form ::error-code])] (fn [] - [:section {:class ["flex" "flex-col" "gap-12"]} + [:section {:class ["flex" "flex-col" "gap-12" "items-center"]} [components/heading-2 "Add a Patient"] [:form {:ref (partial reset! form-ref) :method "POST" - :action "/api/v1/patients/" :class ["w-full" "flex" "flex-col" "gap-4"] :on-blur #(do (swap! touched? conj (-> % (.-target) @@ -71,11 +69,11 @@ (reset! touched? (set (keys form-data))) (reset! invalid? (find-invalid-keys @form-ref)) (when (empty? @invalid?) - (rf/dispatch [::submit-form form-data]))))} + (rf/dispatch [::submit-form-data form-data]))))} - (when @submit-error-code + (when @error-code [components/danger-alert - (case @submit-error-code + (case @error-code 400 "Something doesn't seem right. Are you sure the form input is correct?" "There was an error while adding patient. Please try again!")]) @@ -84,14 +82,14 @@ [components/text-field {:name :first-name :label "First Name *" :placeholder "Jane" - :error-msg "Please enter a valid first name!" + :error-msg "Please enter a first name!" :touched? (contains? @touched? :first-name) :invalid? (contains? @invalid? :first-name)}] [components/text-field {:name :last-name :label "Last Name *" :placeholder "Doe" - :error-msg "Please enter a valid last name!" + :error-msg "Please enter a last name!" :touched? (contains? @touched? :last-name) :invalid? (contains? @invalid? :last-name)}]] @@ -99,41 +97,42 @@ [components/text-field {:name :birth-date :label "Date of Birth *" :placeholder "1999-12-30" - :error-msg "Please enter a valid date of birth in YYYY-MM-DD format!" + :error-msg "Please enter a date in YYYY-MM-DD format!" :touched? (contains? @touched? :birth-date) :invalid? (contains? @invalid? :birth-date)}] - [components/select-field - :gender - "Gender *" - "unknown" - [["Male" "male"] - ["Female" "female"] - ["Other" "other"] - ["Unknown" "unknown"]]]] - - [components/select-field - :marital-status - "Marital Status" - "UNK" - [["Single" "S"] - ["Divorced" "D"] - ["Married" "M"] - ["Widowed" "W"] - ["Unknown" "UNK"]]] + [components/select-field {:name :gender + :label "Gender *" + :default-value "unknown" + :options [["Male" "male"] + ["Female" "female"] + ["Other" "other"] + ["Unknown" "unknown"]]}]] + + [components/text-field {:name :phone + :label "Phone *" + :placeholder "+0 0000-000-000" + :error-msg "Please enter a phone number!" + :touched? (contains? @touched? :phone) + :invalid? (contains? @invalid? :phone)}] [components/text-field {:name :email :label "Email" :placeholder "jane@doe.org" - :error-msg "Please enter a valid email!" + :error-msg "Please enter an email address!" :touched? (contains? @touched? :email) :invalid? (contains? @invalid? :email)}] - [components/text-field {:name :phone - :label "Phone" - :placeholder "0000-000-000" - :error-msg "Please enter a valid phone!" - :touched? (contains? @touched? :phone) - :invalid? (contains? @invalid? :phone)}] - - [components/button "submit" "Add Patient" @submitting?]]]))) + [components/select-field {:name :marital-status + :label "Marital Status" + :default-value "UNK" + :options [["Single" "S"] + ["Divorced" "D"] + ["Married" "M"] + ["Widowed" "W"] + ["Unknown" "UNK"]]}] + + [:div {:class ["h-4"]}] + [components/button {:type "submit" + :text "Add Patient" + :loading? @loading?}]]]))) diff --git a/clinic/src/cljs/clinic/views/home.cljs b/clinic/src/cljs/clinic/views/home.cljs index af91ccf..c2b6438 100644 --- a/clinic/src/cljs/clinic/views/home.cljs +++ b/clinic/src/cljs/clinic/views/home.cljs @@ -1,5 +1,6 @@ (ns clinic.views.home (:require [clinic.components :as components] + [clinic.router :as router] [clinic.user-role.core :as user-role])) (defn- role-selector [] @@ -17,7 +18,7 @@ [:option {:value "doctor"} "Doctor"] [:option {:value "nurse"} "Nurse"] [:option {:value "patient"} "Patient"]] - [:button {:class ["bg-blue-500" "hover:bg-blue-700" "text-white" + [:button {:class ["bg-blue-600" "hover:bg-blue-800" "text-white" "font-bold" "py-2" "px-4" "rounded-full"] :on-click #(-> @!select (.-value) @@ -26,18 +27,18 @@ (defn- nurse-fn-list [] (let [list-item #(vector :li - [:a {:href %2 + [:a {:href (router/path-for %2) :class ["text-blue-600" "hover:underline"]} %1])] - [:section {:class ["flex" "flex-col" "gap-8"]} + [:section {:class ["flex" "flex-col" "gap-12" "items-center"]} [components/heading-2 "Operations"] - [:ol {:class ["list-decimal" "list-inside"]} - [list-item "Add patient" "/patients/new"]]])) + [:ol {:class ["list-decimal" "list-inside" "self-start"]} + [list-item "Add patient" ::router/create-patient] + [list-item "Search Patients" ::router/search-patients]]])) (defn root [] - (let [current-role (user-role/get)] - (fn [] - (case @current-role - "nurse" [nurse-fn-list] - [role-selector])))) + (let [current-role @(user-role/get)] + (case current-role + "nurse" [nurse-fn-list] + [role-selector]))) diff --git a/clinic/src/cljs/clinic/views/list_patients.cljs b/clinic/src/cljs/clinic/views/list_patients.cljs new file mode 100644 index 0000000..9257b31 --- /dev/null +++ b/clinic/src/cljs/clinic/views/list_patients.cljs @@ -0,0 +1,111 @@ +(ns clinic.views.list-patients + (:require [ajax.core :as ajax] + [clinic.components :as components] + [clinic.router :as router] + [clinic.utils :as u] + [re-frame.core :as rf] + [reagent.core :as r])) + +(rf/reg-event-db ::fetch-patients-success + (fn [db [_ result]] + (assoc db ::patients {::loading false ::data result}))) + +(rf/reg-event-db ::fetch-patients-failure + (fn [db [_ {error-code :status}]] + (assoc db ::patients {::loading false ::error-code error-code}))) + +(rf/reg-event-fx ::fetch-patients + (fn [{db :db} [_ {:keys [phone page] :or {page "1"}}]] + (let [page-num (parse-long page)] + {:db (assoc db ::patients {::loading true}) + :http-xhrio {:method :get + :uri (str "/api/v1/patients/") + :params (cond-> {:count 10 + :offset (* 10 (dec page-num))} + phone (assoc :phone phone)) + :response-format (ajax/json-response-format {:keywords? true}) + :on-success [::fetch-patients-success] + :on-failure [::fetch-patients-failure]}}))) + +(rf/reg-sub ::patients get-in) + +(defn- patient-row [] + (let [{:keys [index patient]} (r/props (r/current-component))] + [:tr {:class [(if (odd? index) "bg-gray-50" "bg-white") + "hover:bg-gray-100" "hover:cursor-pointer"] + :on-click #(rf/dispatch [::router/set-token + (router/path-for ::router/view-patient :id (:id patient))])} + [:td {:class ["px-6" "py-2"]} (inc index)] + [:td {:class ["px-6" "py-2"]} (:first-name patient) " " (:last-name patient)] + [:td {:class ["px-6" "py-2"]} (:birth-date patient)] + [:td {:class ["px-6" "py-2"]} (:phone patient)]])) + +(defn root [] + (let [params @(rf/subscribe [::router/current-view ::router/params]) + page (parse-long (get params :page "1")) + phone (:phone params) + loading? @(rf/subscribe [::patients ::loading]) + patients @(rf/subscribe [::patients ::data]) + error-code @(rf/subscribe [::patients ::error-code])] + [:section {:class ["flex" "flex-col" "gap-12" "items-center"]} + [components/heading-2 "Search Patients"] + [:form {:class ["flex" "flex-row" "items-center" "gap-6"] + :on-submit #(do (.preventDefault %) + (let [phone (-> js/document + (.getElementById "phone") + (.-value))] + (when-not (empty? phone) + (rf/dispatch [::router/set-token + (-> ::router/search-patients + (router/path-for) + (u/url {:phone phone}))]))))} + [:input {:id "phone" + :name "phone" + :placeholder "Search by phone" + :defaultValue phone + :class ["appearance-none" "block" "w-full" "bg-gray-200" + "text-gray-700" "border" "border-gray-200" + "rounded" "py-2.5" "px-4" "leading-tight" + "focus:outline-none" "focus:bg-white" + "focus:border-gray-500"]}] + [:input {:type "submit" + :value "Search" + :class ["bg-blue-600" "hover:bg-blue-800" "text-white" + "font-bold" "py-2" "px-4" "rounded-full"]}]] + + (cond + loading? + [components/spinner {:class ["block" "self-center" "w-8" "h-8" "m-16" "text-blue-600"]}] + + error-code + [components/danger-alert "There was an error while fetching patient data. Please try again!"] + + (empty? patients) + [:p {:class ["self-center" "text-center"]} "No patients found matching this criteria!"] + + patients + [:<> + [:table {:class ["w-full" "table-auto" "text-center"]} + [:thead + [:tr {:class ["border-b"]} + [:th {:class ["px-6" "py-2"]} "#"] + [:th {:class ["px-6" "py-2"]} "Name"] + [:th {:class ["px-6" "py-2"]} "Date of Birth"] + [:th {:class ["px-6" "py-2"]} "Phone Number"]]] + (into [:tbody] (map-indexed #(do [patient-row {:index %1 + :patient %2}]) + patients))] + [:div {:class ["flex" "flex-row" "justify-center" "gap-8"]} + [:a {:class ["text-blue-600" "hover:underline" + (when (<= page 1) "invisible")] + :href (-> (router/path-for ::search-patients) + (u/url (cond-> {:page (dec page)} + phone (assoc :phone phone))))} + "Prev"] + [:p {:class ["font-medium"]} "Page" " " page] + [:a {:class ["text-blue-600" "hover:underline" + (when (< (count patients) 10) "invisible")] + :href (-> (router/path-for ::search-patients) + (u/url (cond-> {:page (inc page)} + phone (assoc :phone phone))))} + "Next"]]])])) diff --git a/clinic/src/cljs/clinic/views/not_found.cljs b/clinic/src/cljs/clinic/views/not_found.cljs index eabca18..b331d7d 100644 --- a/clinic/src/cljs/clinic/views/not_found.cljs +++ b/clinic/src/cljs/clinic/views/not_found.cljs @@ -1,8 +1,13 @@ (ns clinic.views.not-found - (:require [clinic.components :as components])) + (:require [clinic.components :as components] + [reagent.core :as r])) (defn root [] - [:section {:class ["flex" "flex-col" "gap-4" "items-center"]} - [components/heading-1 "( ͡° ͜ʖ ͡°)_/¯"] - [components/heading-2 "Page Not Found!"] - [:p "Not sure what you're looking for, but it isn't here."]]) + (let [{:keys [title message] + :or {title "Page Not Found!" + message "Not sure what you're looking for, but it isn't here."}} + (r/props (r/current-component))] + [:section {:class ["flex" "flex-col" "gap-6" "items-center"]} + [components/heading-1 "( ͡° ͜ʖ ͡°)_/¯"] + [components/heading-2 title] + [:p message]])) diff --git a/clinic/src/cljs/clinic/views/view_patient.cljs b/clinic/src/cljs/clinic/views/view_patient.cljs new file mode 100644 index 0000000..06c0462 --- /dev/null +++ b/clinic/src/cljs/clinic/views/view_patient.cljs @@ -0,0 +1,83 @@ +(ns clinic.views.view-patient + (:require [ajax.core :as ajax] + [clinic.components :as components] + [clinic.views.not-found :as not-found] + [re-frame.core :as rf] + [reagent.core :as r])) + + +(rf/reg-event-db ::fetch-patient-success + (fn [db [_ result]] + (assoc db ::patient {::loading false ::data result}))) + +(rf/reg-event-db ::fetch-patient-failure + (fn [db [_ {error-code :status}]] + (assoc db ::patient {::loading false ::error-code error-code}))) + +(rf/reg-event-fx ::fetch-patient + (fn [{db :db} [_ {patient-id :id}]] + {:db (assoc-in db [::patient patient-id] {::loading true}) + :http-xhrio {:method :get + :uri (str "/api/v1/patients/" patient-id) + :response-format (ajax/json-response-format {:keywords? true}) + :on-success [::fetch-patient-success] + :on-failure [::fetch-patient-failure]}})) + +(rf/reg-sub ::patient get-in) + +(defn- row [] + (into [:tr {:class ["border-b"]}] + (r/children (r/current-component)))) + +(defn- cell [] + (let [this (r/current-component) + props (r/props this)] + (into [:td {:class (into ["px-6" "py-2"] + (get props :class []))}] + (r/children this)))) + +(defn- marital-status-text [status] + (case status + "A" "Annulled" + "D" "Divorced" + "I" "Interlocutory" + "L" "Legally Separated" + "M" "Married" + "P" "Polygamous" + "S" "Never Married" + "T" "Domestic partner" + "U" "Unmarried" + "W" "Widowed" + "Unknown")) + +(defn root [] + (let [loading? @(rf/subscribe [::patient ::loading]) + patient @(rf/subscribe [::patient ::data]) + error-code @(rf/subscribe [::patient ::error-code])] + [:section {:class ["flex" "flex-col" "gap-12" "items-center"]} + [components/heading-2 "Patient Info"] + (cond + loading? [components/spinner {:class ["block" "self-center" "w-8" "h-8" "m-16" "text-blue-600"]}] + (= 404 error-code) [not-found/root {:title "Patient Not Found" + :message "This patient doesn't exist in our records!"}] + error-code [components/danger-alert "There was an error while fetching patient data. Please try again!"] + patient [:table {:class ["table-auto"]} + [:tbody + [row + [cell {:class ["text-gray-500"]} "Name"] + [cell (:first-name patient) " " (:last-name patient)]] + [row + [cell {:class ["text-gray-500"]} "Date of Birth"] + [cell (:birth-date patient)]] + [row + [cell {:class ["text-gray-500"]} "Gender"] + [cell {:class ["capitalize"]} (:gender patient)]] + [row + [cell {:class ["text-gray-500"]} "Phone"] + [cell (:phone patient)]] + [row + [cell {:class ["text-gray-500"]} "Email"] + [cell (:email patient)]] + [row + [cell {:class ["text-gray-500"]} "Marital Status"] + [cell (marital-status-text (:marital-status patient))]]]])])) diff --git a/clinic/test/clj/clinic/factory.clj b/clinic/test/clj/clinic/factory.clj index e1e1090..bc6a28d 100644 --- a/clinic/test/clj/clinic/factory.clj +++ b/clinic/test/clj/clinic/factory.clj @@ -1,20 +1,74 @@ (ns clinic.factory (:require [clinic.specs.patient :as specs] [clojure.spec.alpha :as s] - [clojure.spec.gen.alpha :as gen])) + [clojure.spec.gen.alpha :as gen]) + (:import java.time.LocalDate)) -(defn- generate-date [] - (String/format "%04d-%02d-%02d" - (into-array [(+ 1970 (rand-int 52)) - (inc (rand-int 12)) - (inc (rand-int 28))]))) +(defn- rand-date [] + (->> 30000 ; ~ 82 years + (rand-int) + (.minusDays (LocalDate/now)) + (.toString))) -(defn- with-generator-fn [gen-fn] +(defn rand-phone [] + ;; the goal here is NOT to generate a phone number that conforms to a + ;; national/international formatting standard. We just need seemingly valid + ;; phone numbers for all intents and purposes. + (String/format (rand-nth ["(%03d) %03d-%04d" + "%03d-%03d-%04d" + "+01 %03d %03d %04d" + "%03d%03d%04d"]) + (into-array [(rand-int 999) + (rand-int 999) + (rand-int 9999)]))) + +(defn- rand-int-str + ([] (rand-int-str 0 Integer/MAX_VALUE)) + ([start end] (String/format "%d" (into-array [(->> start + (- end) + (rand-int) + (+ start))])))) + +(defn- with-generating-fn [gen-fn] (-> (fn [& _] (gen-fn)) (gen/fmap (gen/return nil)) (constantly))) -(defn create-params [] - (->> {::specs/birth-date (with-generator-fn generate-date)} - (s/gen ::specs/create-params) - (gen/generate))) +(defn- generate + ([spec] (generate spec {})) + ([spec overrides] + (-> spec + (s/gen overrides) + (gen/generate)))) + +(defn create-params [& {:as overrides}] + (merge (generate ::specs/create-params + {::specs/birth-date (with-generating-fn rand-date) + ::specs/phone (with-generating-fn rand-phone)}) + overrides)) + +(defn get-all-params [& {:as overrides}] + (merge (generate ::specs/get-all-params + {::specs/offset (with-generating-fn rand-int-str) + ::specs/count (with-generating-fn #(rand-int-str 1 21)) + ::specs/phone (with-generating-fn rand-phone)}) + overrides)) + + +(defn fhir-patient [& {:keys [id phone]}] + {:resourceType "Patient" + :id (or id (rand-int-str)) + :name [{:family (generate ::specs/last-name) + :given [(generate ::specs/first-name)]}] + :birthDate (rand-date) + :gender (generate ::specs/gender) + :telecom [{:system "email" + :value (generate ::specs/email)} + {:system "phone" + :value (or phone + (String/format "%010d" + (into-array [(rand-int Integer/MAX_VALUE)])))}] + :maritalStatus {:coding [{:system "http://hl7.org/fhir/ValueSet/marital-status" + :code (generate ::specs/marital-status)}]} + + :active true}) diff --git a/clinic/test/clj/clinic/fhir/client_test.clj b/clinic/test/clj/clinic/fhir/client_test.clj index 896bbf1..36aa3ef 100644 --- a/clinic/test/clj/clinic/fhir/client_test.clj +++ b/clinic/test/clj/clinic/fhir/client_test.clj @@ -1,29 +1,58 @@ (ns clinic.fhir.client-test (:require [clinic.fhir.client :as client] [clj-http.client :as c] - [clojure.test :refer [deftest is testing]])) + [clojure.test :refer [deftest is testing]] + [clinic.test-utils :as tu] + [cheshire.core :as json])) (deftest create-test - (let [post-params (atom [])] - (with-redefs [c/post (fn [& args] - (reset! post-params (vec args)) - {:status 201 - :headers (get-in @post-params [1 :headers]) - :body (get-in @post-params [1 :body])})] + (let [[call-args response-fn mocked-fn] (tu/mock-fn)] + (reset! response-fn (fn [_ params] {:status 201 + :body (params :body)})) + (with-redefs [c/post mocked-fn] (testing "with Test resource" (let [resp (client/create! "http://test.base.url/fhir" {:resourceType "Test" :key "resource-val"} {:header "header-val"})] - (is (= "http://test.base.url/fhir/Test" (@post-params 0))) + (is (= "http://test.base.url/fhir/Test" (@call-args 0))) (is (= "resource-val" (get-in resp [:body :key]))) - (is (= "header-val" (get-in @post-params [1 :headers :header]))))) + (is (= "header-val" (get-in @call-args [1 :headers :header]))))) (testing "with Bundle resource" (let [resp (client/create! "http://test.base.url/fhir" {:resourceType "Bundle" :key "resource-val"} {:header "header-val"})] - (is (= "http://test.base.url/fhir" (@post-params 0))) + (is (= "http://test.base.url/fhir" (@call-args 0))) (is (= "resource-val" (get-in resp [:body :key]))) - (is (= "header-val" (get-in @post-params [1 :headers :header])))))))) + (is (= "header-val" (get-in @call-args [1 :headers :header])))))))) + +(deftest get-all-test + (let [[call-args response-fn mocked-fn] (tu/mock-fn)] + (reset! response-fn (->> {:key "response-val"} + (json/generate-string) + (assoc {:status 200} :body) + (constantly))) + (with-redefs [c/get mocked-fn] + (testing "with Test resource" + (let [resp (client/get-all "http://test.base.url/fhir" + "Test" + {:key "query-val"})] + (is (= "http://test.base.url/fhir/Test" (@call-args 0))) + (is (= "query-val" (get-in @call-args [1 :query-params :key]))) + (is (= "response-val" (get-in resp [:body :key])))))))) + +(deftest get-by-id-test + (let [[call-args response-fn mocked-fn] (tu/mock-fn)] + (reset! response-fn (->> {:key "response-val"} + (json/generate-string) + (assoc {:status 200} :body) + (constantly))) + (with-redefs [c/get mocked-fn] + (testing "with Test resource" + (let [resp (client/get-by-id "http://test.base.url/fhir" + "Test" + "1")] + (is (= "http://test.base.url/fhir/Test/1" (@call-args 0))) + (is (= "response-val" (get-in resp [:body :key])))))))) diff --git a/clinic/test/clj/clinic/routes/patient_integration_test.clj b/clinic/test/clj/clinic/routes/patient_integration_test.clj index c61858f..f160fd9 100644 --- a/clinic/test/clj/clinic/routes/patient_integration_test.clj +++ b/clinic/test/clj/clinic/routes/patient_integration_test.clj @@ -1,28 +1,43 @@ (ns clinic.routes.patient-integration-test - (:require [clinic.factory :as factory] + (:require [cheshire.core :as json] + [clinic.factory :as factory] [clinic.routes.core :as routes] [clinic.test-utils :as tu] + [clinic.utils :as u] [clojure.test :refer [deftest is testing use-fixtures]] - [ring.mock.request :as mr] - [cheshire.core :as json])) + [ring.mock.request :as mr])) + +(use-fixtures :once tu/load-config-fixture) (defn- create-patient-request [body] (-> (mr/request :post "/api/v1/patients/") (mr/json-body body))) -(use-fixtures :once tu/load-config-fixture) -(use-fixtures :each tu/expunge-fhir-data-fixture) - (deftest create-patient-test - (testing "with invalid request body" + (testing "with missing params in request body" + (tu/expunge-fhir-data!) (doseq [missing-field [:first-name :last-name :birth-date :gender]] (is (= 400 (-> (factory/create-params) (dissoc missing-field) (create-patient-request) (routes/handler) - (get :status)))))) + (:status)))))) + + (testing "with invalid params in request body" + (tu/expunge-fhir-data!) + (doseq [[key & invalid-vals] [[:first-name " " ""] + [:last-name " " ""] + [:birth-date " " ""] + [:gender "" " " "abc" "123"] + [:phone "" " " "abc" "---"]] + invalid-val invalid-vals] + (is (= 400 (-> (factory/create-params key invalid-val) + (create-patient-request) + (routes/handler) + (:status)))))) (testing "with valid request body" + (tu/expunge-fhir-data!) (let [params (factory/create-params) {status :status body :body} (-> params @@ -36,5 +51,81 @@ (is (= (params :birth-date) (body :birth-date))) (is (= (params :gender) (body :gender))) (is (= (params :marital-status) (body :marital-status))) - (is (= (params :phone) (body :phone))) + (is (tu/digits-equal? (params :phone) (body :phone))) (is (= (params :email) (body :email)))))) + +(defn- list-patients-request [params] + (-> (mr/request :get "/api/v1/patients" params))) + +(deftest list-patients-test + (testing "with invalid query params" + (tu/expunge-fhir-data!) + (doseq [[key & invalid-vals] [[:phone "" " "] + [:offset "" " " "abc" "-"] + [:count "" " " "abc" "-"]] + invalid-val invalid-vals] + (is (= 400 (-> (factory/get-all-params key invalid-val) + (list-patients-request) + (routes/handler) + (:status)))))) + + (testing "with valid phone filter in query params" + (tu/expunge-fhir-data!) + (let [phones (repeatedly 5 factory/rand-phone)] + (doseq [phone phones] + (tu/create-fhir-patient! (factory/fhir-patient :phone + (u/extract-digits phone)))) + (doseq [phone phones] + (let [{:keys [status body]} (-> {:phone phone} + (list-patients-request) + (routes/handler) + (update :body json/parse-string true))] + (is (= 200 status)) + (doseq [patient body] + (is (= (u/extract-digits phone) (patient :phone)))))))) + + (testing "with valid offset and count in query params" + (tu/expunge-fhir-data!) + (doseq [patient (repeatedly 5 factory/fhir-patient)] + (tu/create-fhir-patient! patient)) + + (doseq [[params expected-result-count] [[{:offset 0 :count 1} 1] + [{:offset 10 :count 10} 0] + [{:offset 4 :count 10} 1] + [{:offset 3 :count 10} 2]]] + (let [{:keys [status body]} (-> params + (list-patients-request) + (routes/handler) + (update :body json/parse-string true))] + (is (= 200 status)) + (is (= expected-result-count (count body))))))) + +(defn- get-patient-request [id] + (->> (str "/api/v1/patients/" id) + (mr/request :get))) + +(deftest get-patient-test + (testing "with invalid resource id in path param" + (tu/expunge-fhir-data!) + (is (= 400 (-> "%20%20" + (get-patient-request) + (routes/handler) + (:status))))) + + (testing "with non-existing resource id in path param" + (tu/expunge-fhir-data!) + (is (= 404 (-> (get-patient-request "1") + (routes/handler) + (:status))))) + + (testing "with valid resource id in path param" + (tu/expunge-fhir-data!) + (let [patient-id (-> (factory/fhir-patient) + (tu/create-fhir-patient!) + (get-in [:body :id])) + {:keys [status body]} (-> patient-id + (get-patient-request) + (routes/handler) + (update :body json/parse-string true))] + (is (= 200 status)) + (is (= patient-id (body :id)))))) diff --git a/clinic/test/clj/clinic/routes/patient_test.clj b/clinic/test/clj/clinic/routes/patient_test.clj index 662d86a..9316aa1 100644 --- a/clinic/test/clj/clinic/routes/patient_test.clj +++ b/clinic/test/clj/clinic/routes/patient_test.clj @@ -1,35 +1,83 @@ (ns clinic.routes.patient-test - (:require [clinic.routes.core :as routes] + (:require [cheshire.core :as json] + [clinic.routes.core :as routes] [clinic.service.patient :as svc] + [clinic.test-utils :as tu] [clojure.test :refer [deftest is testing]] [clojure.tools.logging :as log] [clojure.tools.logging.impl :as log-impl] [ring.mock.request :as mr])) -(defn- create-patient-request [] - (-> (mr/request :post "/api/v1/patients/") - (mr/json-body {:key "request-val"}) - (assoc :config {:fhir-server-base-url "test-fhir-server-url"}))) - (deftest create-patient-test - (let [call-args (atom []) - response-fn (atom (constantly nil))] - (with-redefs [svc/create! (fn [& args] - (reset! call-args (vec args)) - (@response-fn))] + (let [[call-args response-fn mocked-fn] (tu/mock-fn) + create-patient-req (-> (mr/request :post "/api/v1/patients/") + (mr/json-body {:key "request-val"}) + (assoc :config {:fhir-server-base-url "test-fhir-server-url"}))] + (with-redefs [svc/create! mocked-fn] (testing "with no service errors" - (reset! response-fn (fn [] {:key "response-val"})) - (let [response (routes/handler (create-patient-request))] + (reset! response-fn (constantly {:key "response-val"})) + (let [response (routes/handler create-patient-req)] (is (= "test-fhir-server-url" (@call-args 0))) (is (= {:key "request-val"} (@call-args 1))) - (is (= 201 (response :status))))) + (is (= 201 (response :status))) + (is (= {:key "response-val"} (-> (response :body) + (json/parse-string true)))))) + + (testing "with invalid params service error" + (reset! response-fn (fn [& _] (throw (ex-info "test-error" + {:type :invalid-params})))) + (is (= 400 (:status (routes/handler create-patient-req))))) + + (testing "with unknown service error" + (reset! response-fn (fn [& _] (throw (RuntimeException. "test-error")))) + (is (= 500 (binding [log/*logger-factory* log-impl/disabled-logger-factory] + (:status (routes/handler create-patient-req))))))))) + +(deftest list-patients-test + (let [[call-args response-fn mocked-fn] (tu/mock-fn) + query-params {:phone "0" :offset "1" :count "2"} + list-patients-req (-> (mr/request :get "/api/v1/patients/" query-params) + (assoc :config {:fhir-server-base-url "test-fhir-server-url"}))] + (with-redefs [svc/get-all mocked-fn] + (testing "with no service errors" + (reset! response-fn (constantly {:key "response-val"})) + (let [response (routes/handler list-patients-req)] + (is (= "test-fhir-server-url" (@call-args 0))) + (is (= query-params (@call-args 1))) + (is (= 200 (response :status))) + (is (= {:key "response-val"} (-> (response :body) + (json/parse-string true)))))) + + (testing "with invalid params service error" + (reset! response-fn (fn [& _] (throw (ex-info "test-error" + {:type :invalid-params})))) + (is (= 400 (:status (routes/handler list-patients-req))))) + + (testing "with unknown service error" + (reset! response-fn (fn [& _] (throw (RuntimeException. "test-error")))) + (is (= 500 (binding [log/*logger-factory* log-impl/disabled-logger-factory] + (:status (routes/handler list-patients-req))))))))) + +(deftest get-patient-test + (let [[call-args response-fn mocked-fn] (tu/mock-fn) + get-patient-req (-> (mr/request :get "/api/v1/patients/123") + (assoc :config {:fhir-server-base-url "test-fhir-server-url"}))] + (with-redefs [svc/get-by-id mocked-fn] + (testing "with no service errors" + (reset! response-fn (constantly {:key "response-val"})) + (let [response (routes/handler get-patient-req)] + (is (= "test-fhir-server-url" (@call-args 0))) + (is (= "123" (@call-args 1))) + (is (= 200 (response :status))) + (is (= {:key "response-val"} (-> (response :body) + (json/parse-string true)))))) (testing "with invalid params service error" - (reset! response-fn #(throw (ex-info "test-error" - {:type :invalid-params}))) - (is (= 400 (:status (routes/handler (create-patient-request)))))) + (reset! response-fn (fn [& _] (throw (ex-info "test-error" + {:type :invalid-params})))) + (is (= 400 (:status (routes/handler get-patient-req))))) (testing "with unknown service error" - (reset! response-fn #(throw (RuntimeException. "test-error"))) + (reset! response-fn (fn [& _] (throw (RuntimeException. "test-error")))) (is (= 500 (binding [log/*logger-factory* log-impl/disabled-logger-factory] - (:status (routes/handler (create-patient-request)))))))))) + (:status (routes/handler get-patient-req))))))))) diff --git a/clinic/test/clj/clinic/service/patient_test.clj b/clinic/test/clj/clinic/service/patient_test.clj index 3d43662..b09b76d 100644 --- a/clinic/test/clj/clinic/service/patient_test.clj +++ b/clinic/test/clj/clinic/service/patient_test.clj @@ -2,30 +2,36 @@ (:require [clinic.factory :as factory] [clinic.fhir.client :as fc] [clinic.service.patient :as svc] + [clinic.test-utils :as tu] [clojure.test :refer [deftest is testing]])) -(defmacro catch-thrown-data [& body] - `(try ~@body - (catch clojure.lang.ExceptionInfo e# (ex-data e#)))) - (deftest create-test - (let [call-args (atom []) - response-fn (atom (constantly nil))] - (with-redefs [fc/create! (fn [& args] - (reset! call-args (vec args)) - (@response-fn (second args)))] + (let [[call-args response-fn mocked-fn] (tu/mock-fn)] + (with-redefs [fc/create! mocked-fn] (testing "with missing required param fields" - (doseq [missing-field [:first-name :last-name :birth-date :gender]] + (doseq [missing-field [:first-name :last-name :birth-date :gender :phone]] (is (= :invalid-params (-> (factory/create-params) (dissoc missing-field) ((partial svc/create! "test-server-url")) - (catch-thrown-data) + (tu/catch-thrown-data) (get :type)))))) + (testing "with invalid params" + (doseq [[key & invalid-vals] [[:first-name " " ""] + [:last-name " " ""] + [:birth-date " " ""] + [:gender "" " " "abc" "123"] + [:phone "" " " "abc" "---"]] + invalid-val invalid-vals] + (is (= :invalid-params (->> (factory/create-params key invalid-val) + (svc/create! "test-server-url") + (tu/catch-thrown-data) + (:type)))))) + (testing "with valid params" - (reset! response-fn (fn [resource] {:status 201 - :body (assoc resource :id "test-id")})) - (doseq [missing-field [:marital-status :email :phone nil]] + (reset! response-fn (fn [_ resource & _] {:status 201 + :body (assoc resource :id "test-id")})) + (doseq [missing-field [:marital-status :email nil]] (let [params (-> (factory/create-params) (dissoc missing-field)) patient (svc/create! "test-server-url" params)] @@ -37,11 +43,79 @@ (is (= (params :gender) (patient :gender))) (is (= (params :marital-status) (patient :marital-status))) (is (= (params :email) (patient :email))) - (is (= (params :phone) (patient :phone)))))) + (is (tu/digits-equal? (params :phone) (patient :phone)))))) (testing "with upstream service non-20x response" (reset! response-fn (constantly {:status 400})) - (is (= :upstream-error (-> (factory/create-params) - ((partial svc/create! "test-server-url")) - (catch-thrown-data) - (get :type)))))))) + (is (= :upstream-error (->> (factory/create-params) + (svc/create! "test-server-url") + (tu/catch-thrown-data) + (:type)))))))) + +(deftest get-all-test + (let [[call-args response-fn mocked-fn] (tu/mock-fn)] + (with-redefs [fc/get-all mocked-fn] + (testing "with invalid params" + (doseq [[key & invalid-vals] [[:phone "" " "] + [:offset "" " " "abc" "-"] + [:count "" " " "abc" "-"]] + invalid-val invalid-vals] + (is (= :invalid-params (->> (factory/get-all-params key invalid-val) + (svc/get-all "test-fhir-server") + (tu/catch-thrown-data) + (:type)))))) + + (testing "with valid params" + (reset! response-fn (fn [_ _ {count :_count}] + {:status 200 + :body {:resourceType "Bundle" + :entry (->> (repeatedly (parse-long count) + factory/fhir-patient) + (map #(do {:resource %})))}})) + (doseq [missing-field [:phone :offset :count nil]] + (let [params (-> (factory/get-all-params) + (dissoc missing-field)) + patients (svc/get-all "test-server-url" params)] + (is (= "test-server-url" (@call-args 0))) + (is (= (-> params + (get :count "10") + (parse-long)) + (count patients)))))) + + (testing "with upstream service error" + (reset! response-fn (constantly {:status 400})) + (is (= :upstream-error (->> (factory/get-all-params) + (svc/get-all "test-server-url") + (tu/catch-thrown-data) + (:type)))))))) + +(deftest get-by-id-test + (let [[call-args response-fn mocked-fn] (tu/mock-fn)] + (with-redefs [fc/get-by-id mocked-fn] + (testing "with invalid params" + (doseq [invalid-id ["" " " "abc"]] + (is (= :invalid-params (->> (factory/get-all-params key invalid-id) + (svc/get-by-id "test-fhir-server") + (tu/catch-thrown-data) + (:type)))))) + + (testing "with valid params" + (reset! response-fn (fn [_ _ id] + {:status 200 + :body (factory/fhir-patient :id id)})) + (let [patient (svc/get-by-id "test-server-url" "123")] + (is (= "test-server-url" (@call-args 0))) + (is (= "123" (@call-args 2))) + (is (= "123" (patient :id))))) + + (testing "with Patient not found error" + (reset! response-fn (constantly {:status 404})) + (is (= :patient-not-found (->> (svc/get-by-id "test-server-url" "123") + (tu/catch-thrown-data) + (:type))))) + + (testing "with upstream service error" + (reset! response-fn (constantly {:status 400})) + (is (= :upstream-error (->> (svc/get-by-id "test-server-url" "123") + (tu/catch-thrown-data) + (:type)))))))) diff --git a/clinic/test/clj/clinic/test_utils.clj b/clinic/test/clj/clinic/test_utils.clj index e236a77..9dd8978 100644 --- a/clinic/test/clj/clinic/test_utils.clj +++ b/clinic/test/clj/clinic/test_utils.clj @@ -1,7 +1,7 @@ (ns clinic.test-utils (:require [cheshire.core :as json] - [clj-http.client :as http] [clinic.config :as config] + [clj-http.client :as http] [mount.core :as mount])) (defn load-config-fixture [f] @@ -9,17 +9,41 @@ (f) (mount/stop)) -(defn expunge-fhir-data! [server-url] - (-> server-url +(defn expunge-fhir-data! [] + (-> (config/get-value :fhir-server-base-url) (str "/$expunge") (http/post {:headers {"Content-Type" "application/fhir+json"} :body (json/generate-string {:resourceType "Parameters" :parameter [{:name "expungeEverything" - :valueBoolean true}]}) - :throw-exceptions false}))) + :valueBoolean true}]})}))) + +(defn create-fhir-patient! [patient] + (-> (config/get-value :fhir-server-base-url) + (str "/Patient") + (http/post {:headers {"Content-Type" "application/fhir+json"} + :body (json/generate-string patient)}) + (update :body json/parse-string true))) + +(defn digits-equal? + "Checks if digits in the given strings are in the same order and equal, + ignoring all other characters. + + (digits-equal? \"a1b2c3\" \"123abc\") ;=> true + (digits-equal? \"a3b2c1\" \"123abc\") ;=> false + " + [this other] + (= (re-seq #"\d" this) + (re-seq #"\d" other))) + +(defn mock-fn [] + (let [call-args (atom []) + response-fn (atom (constantly nil))] + [call-args + response-fn + (fn [& args] + (reset! call-args (vec args)) + (apply @response-fn args))])) -(defn expunge-fhir-data-fixture [f] - (-> :fhir-server-base-url - (config/get-value) - (expunge-fhir-data!)) - (f)) +(defmacro catch-thrown-data [& body] + `(try ~@body + (catch clojure.lang.ExceptionInfo e# (ex-data e#))))