ORM-Less JSONAPI

json-api-formatter-test.clj

(ns vsa-portal-api.json-api-formatter-test
  (:require [vsa-portal-api.json-api-formatter :as sut]
            [cheshire.core :as json]
            [clojure.test :as t]))

(t/deftest ->toJsonAPI
  (t/testing "with an empty vector"
    (t/is
     (thrown? java.lang.Exception
              (sut/->toJsonAPI []))))
  (t/testing "with a wrong initial resource with id key "
    (t/is
     (thrown? java.lang.Exception
              (sut/->toJsonAPI [{:fuck "no"}]))))
  (t/testing "with a right initial resource with id key"
    (t/is
     (=
      {:data {:type "users"
              :id "123"
              :attributes {}
              :relationships {}}
       :included []}
      (sut/->toJsonAPI [{:user__id "123"}])))
    (t/is
     (=
      {:data {:type "questionnaire_templates"
              :id "12"
              :attributes {}
              :relationships {}}
       :included []}
      (sut/->toJsonAPI [{:questionnaire_template__id "12"}])))
    (t/testing "with an additional attribute key"
      (t/is
       (=
        {:data {:type "users"
                :id "123"
                :attributes {:name "joe schmo"}
                :relationships {}}
         :included []}
        (sut/->toJsonAPI [{:user__id "123" :user__name "joe schmo"}])))
      (t/testing "and an additional attribute key"
        (t/is
         (=
          {:data {:type "users"
                  :id "123"
                  :attributes {:first-name "joe schmo" :idiom 23}
                  :relationships {}}
           :included []}
          (sut/->toJsonAPI [{:user__id "123"
                             :user__first_name "joe schmo"
                             :user__idiom 23}]))))
      (t/testing "and a relationship key"
        (t/is
         (=
          {:data {:type "users"
                  :id "123"
                  :attributes {:name "joe schmo"}
                  :relationships {:posts
                                  {:data
                                   [{:type "posts" :id 23}
                                    ]}}}
           :included []}
          (sut/->toJsonAPI [{:user__id "123"
                             :user__name "joe schmo"
                             :user__posts__id 23}])))
        (t/testing "and another relationship key"
          (t/is
           (=
            {:data {:type "users"
                    :id "123"
                    :attributes {:first-name "joe schmo"}
                    :relationships {:posts
                                    {:data
                                     [{:type "posts" :id 23}
                                      {:type "posts" :id "34"}]}}}
             :included []}
            (sut/->toJsonAPI [{:user__id "123"
                               :user__first_name "joe schmo"
                               :user__posts__id 23}
                              {:user__id "123"
                               :user__first_name "joe schmo"
                               :user__posts__id "34"}]))))
        (t/testing "and a different relationship key"
          (t/is
           (=
            {:data {:type "users"
                    :id "123"
                    :attributes {:name "joe schmo"}
                    :relationships {:posts
                                    {:data
                                     [{:type "posts" :id 23}]}
                                    :pets
                                    {:data
                                     [{:type "pets" :id "34"}]}}}
             :included []}
            (sut/->toJsonAPI [{:user__id "123"
                               :user__name "joe schmo"
                               :user__posts__id 23
                               :user__pets__id "34"}]))))
        (t/testing "and a differently named relationship key that is singular"
          (t/is
           (=
            {:data {:type "users"
                    :id "123"
                    :attributes {:name "joe schmo"}
                    :relationships {:scribbles
                                    {:data
                                     [{:type "posts" :id 23}]}
                                    :pet
                                    {:data
                                     [{:type "pets" :id "34"}]}}}
             :included []}
            (sut/->toJsonAPI [{:user__id "123"
                               :user__name "joe schmo"
                               :user__posts__as__scribbles__id 23
                               :user__pet__id "34"}]))))
        (t/testing "and included resources"
          (t/is
           (=
            {:data {:type "users"
                    :id "123"
                    :attributes {:first-name "joe schmo"}
                    :relationships {:posts
                                    {:data
                                     [{:type "posts" :id 23}
                                      {:type "posts" :id "34"}]}}}
             :included [{:type "posts"
                         :id 23
                         :attributes {:title "hello"}}
                        {:type "posts"
                         :id "34"
                         :attributes {:title "good morning"}}]}
            (sut/->toJsonAPI [{:user__id "123"
                               :user__first_name "joe schmo"
                               :user__posts__id 23
                               :posts__title "hello"}
                              {:user__id "123"
                               :user__first_name "joe schmo"
                               :user__posts__id "34"
                               :posts__title "good morning"}])))))))
  (t/testing "with sample questionnaire template data"
    (t/is
     (thrown? java.lang.Exception
              (sut/->toJsonAPI [{:fuck "no"}])))))

json-api-formatter.clj

(ns vsa-portal-api.json-api-formatter
  (:require [cheshire.core :as json]
            [clojure.set :as set]
            [inflections.core :as inflections]
            [camel-snake-kebab.core :refer :all]
            [clojure.string :as string]))

(defn- filter-attributes
  [sql-row data-resource-type]
  "filter out the keys that relate to attributes of the data resource type"
  (filter
   (fn
     [[key value]]
     (let [match (or
                  (last (re-find
                         (re-pattern
                          (str data-resource-type
                               "__"
                               "(.*)$"))
                         (str key)))
                  (str key))]
       (and
        (not (= match "id"))
        (not (re-find #"__" match)))))
   sql-row))

(defn- extract-included-alias
  [included-type]
  "return type unless there is an as"
  (let [aliases (re-find #"(.*)__as__(.*)" included-type)]
    (if aliases
      (last aliases)
      included-type)))

(defn- extract-included-type
  [included-type]
  "return type unless there is an as"
  (let [aliases (re-find #"(.*)__as__(.*)" included-type)]
    (if aliases
      (second aliases)
      included-type)))

(defn- format-data-attributes
  [attributes data-resource-type]
  "format attributes with the proper JSON API formatting"
  (map
   (fn [[key value]]
     {(->kebab-case-keyword
       (string/replace
        (str key)
        (re-pattern (str ":"
                         data-resource-type
                         "__"))
        ""))
      value})
   attributes))

(defn- formatted-data-attributes
  [sql-row data-resource-type]
  (reduce
   conj
   {}
   (format-data-attributes
    (filter-attributes sql-row data-resource-type)
    data-resource-type)))

(defn- filter-relationships
  [sql-row data-resource-type]
  "filter out the keys that relate to relationship ids"
  (filter
   (fn
     [[key value]]
     (let [match (or
                  (last (re-find
                         (re-pattern
                          (str data-resource-type
                               "__"
                               "(.*)$"))
                         (str key)))
                  (str key))]
       (re-find #"__id" match)))
   sql-row))

(defn- format-data-relationships
  [relationships data-resource-type]
  "formats a sequence of relationship ids into the data/relationships node of a
  JSON API hash"
  (reduce
   (fn [relationship-collection relationship]
     (let [relationship-key (->kebab-case-keyword
                             (extract-included-alias (:type relationship)))
           relationship-node [relationship-key :data]
           previous-data (or
                          (get-in
                           relationship-collection
                           relationship-node)
                          [])]
       (assoc-in
        relationship-collection
        relationship-node
        (conj
         previous-data
         (assoc relationship
                :type
                (inflections/plural
                 (extract-included-type
                  (:type relationship))))))))
   {}
   (map
    (fn [[key value]]
      (let [included-resource (string/replace
                               (str key)
                               (re-pattern
                                (str ":"
                                     data-resource-type
                                     "__"
                                     "(.*)"
                                     "__id$"))
                               "$1")]
        {:type included-resource
         :id value}))
    relationships)))

(defn- map-conj
  [first-map second-map]
  "combines two maps by conjing the arrays at [(key in keys) :data]"
  (if (not (empty? first-map))
    (reduce
     (fn [new-map key-in-first-map]
       (assoc-in
        new-map
        [key-in-first-map :data]
        (set/union
         (get-in first-map [key-in-first-map :data])
         (get-in second-map [key-in-first-map :data]))))
     {}
     (keys first-map))
    second-map))

(defn- included-conj
  [json-api-response included-resource]
  "adds the included resource to the array if it's unique"
  (assoc json-api-response
         :included
         (distinct (conj (:included json-api-response)
                         included-resource))))

(defn- extract-primary-resource-name
  [sql-row]
  "extract the primary resource name by looking at the first id"
  (let [primary-resource-type (re-find
                               #":(.*)__id$"
                               (str (first (keys sql-row))))]
    (if primary-resource-type
      primary-resource-type
      (throw
       (Exception.
        "first column name must be a data resource ID name")))))

(defn- extract-unique-primary-resource-ids
  [list-of-sql-rows primary-key-column]
  "extract the unique primary resource ids"
  (distinct (map #(primary-key-column %1) list-of-sql-rows)))

(defn- filter-included-resources
  [sql-row primary-resource-type]
  "extract the unique primary resource ids"
  (filter (fn [formatted-key]
            (not (= formatted-key primary-resource-type)))
          (map (fn [key]
                 (last
                  (re-find
                   #":(.*?)__"
                   (str key))))
               (keys sql-row))))

(defn- extract-included-resource-type-id
  [sql-row included-resource-type]
  (get
   sql-row
   (first
    (filter
     (fn [key] (re-find
               (re-pattern
                (str included-resource-type
                     "__"
                     "id$"))
               (str key)))
     (keys sql-row)))))

(defn- format-included-resources
  [sql-row data-resource-type]
  "format included resources for the included array of a JSON API response"
  (reduce
   (fn [included-array included-resource-type]
     (let [included-id (extract-included-resource-type-id sql-row
                                                          included-resource-type)]
       (if included-id
         (conj included-array
               {:id (extract-included-resource-type-id sql-row included-resource-type)
                :type (inflections/plural (extract-included-type included-resource-type))
                :attributes (formatted-data-attributes sql-row included-resource-type)})
         included-array)))
   []
   (filter-included-resources sql-row data-resource-type)))

(defn ->toJsonAPI
  [list-of-sql-rows]
  "turns an opinionated, named sql query into json api 1.0 for one primary
  resource"
  (let [primary-resource-type (extract-primary-resource-name
                               (first list-of-sql-rows))
        data-resource-type (last primary-resource-type)]
    (if (empty? list-of-sql-rows)
      (if (= data-resource-type (inflections/singular data-resource-type))
        {:data nil :included []}
        {:data [] :included []})
      (let [unique-primary-resource-ids (extract-unique-primary-resource-ids
                                         list-of-sql-rows
                                         (keyword
                                          (string/replace
                                           (first primary-resource-type)
                                           #":"
                                           "")))]
        (if (= data-resource-type (inflections/singular data-resource-type))
          (let [id (first unique-primary-resource-ids)]
            (reduce-kv
             (fn [json _ sql-row]
               (let [attributes (formatted-data-attributes sql-row data-resource-type)
                     relationships (format-data-relationships
                                    (filter-relationships sql-row data-resource-type)
                                    data-resource-type)
                     previous-attributes (get-in json [:data :attributes])
                     previous-relationships (get-in json [:data :relationships])]
                 (as-> json j
                   (assoc-in
                    j
                    [:data :attributes]
                    (conj previous-attributes attributes))
                   (assoc-in
                    j
                    [:data :relationships]
                    (map-conj previous-relationships relationships))
                   (assoc
                    j
                    :included
                    (vec (flatten (distinct (conj (:included j)
                                                  (format-included-resources
                                                   sql-row
                                                   data-resource-type)))))))))
             {:data {:type (inflections/plural data-resource-type)
                     :id id
                     :attributes {}
                     :relationships {}}
              :included []}
             list-of-sql-rows))
          (reduce-kv
           (fn [json _ sql-row]
             (let [attributes (reduce
                               conj
                               {}
                               (format-data-attributes
                                (filter-attributes sql-row data-resource-type)
                                data-resource-type))
                   relationships (reduce
                                  (fn [relationship-collection relationship]
                                    (let [relationship-key (keyword (:type relationship))
                                          relationship-node [relationship-key :data]
                                          previous-data (or
                                                         (get-in
                                                          relationship-collection
                                                          relationship-node)
                                                         [])]
                                      (assoc-in
                                       relationship-collection
                                       relationship-node
                                       (conj
                                        previous-data
                                        relationship))))
                                  {}
                                  (format-data-relationships
                                   (filter-relationships sql-row data-resource-type)
                                   data-resource-type))
                   id (get sql-row (first (first sql-row)))]

               (let [previous-data-resource (first
                                             (filter #(= (:id %) id)
                                                     (:data json)))
                     previous-data-index (if previous-data-resource
                                           (.indexOf (:data json)
                                                     previous-data-resource))]
                 (as-> json j
                   (if previous-data-resource
                     (assoc-in
                      j
                      [:data previous-data-index]
                      {:id id
                       :type (inflections/plural (:type previous-data-resource))
                       :attributes (:attributes previous-data-resource)
                       :relationships (map-conj
                                       (:relationships previous-data-resource)
                                       relationships)})
                     (assoc
                      j
                      :data
                      (conj (:data j)
                            {:id id
                             :type (inflections/plural data-resource-type)
                             :attributes attributes
                             :relationships relationships})))
                   (assoc
                    j
                    :included
                    (vec (flatten (distinct (conj (:included j)
                                                  (format-included-resources
                                                   sql-row
                                                   data-resource-type))))))))))
           {:data [] :included []}
           list-of-sql-rows))))))

questionnaire_templates.sql

-- :name questionnaire-templates-include-questions
-- :doc All the VSA questions
SELECT
  qt.id as questionnaire_templates__id,
  qt.name as questionnaire_templates__name,
  qt.version as questionnaire_templates__version,
  q.id as questionnaire_templates__questions__id,
  q.prompt as questions__prompt,
  q.question_type as questions__question_type,
  q.question_order as questions__question_order

from questionnaire_templates qt
inner join questions q
on qt.id = q.questionnaire_template_id;

user_by_id.sql

-- :name select-user-by-id
-- :doc select user by id and all related records
select u.id as user__id,
p.id as user__person__id,
p.name as person__name,
p.email as person__email
from users u
inner join people p on p.id = u.person_id
where u.id = :id