db.cljs

(ns annotare.db
  (:require [cljs.reader]))

; TODO: Create schema for state

;; Initial state
(def default-value
  {:projects (sorted-map)  ;; All available projects
   :documents (sorted-map)
   :active-panel :front    ;; Currently active page/panel
   :active-form nil
   :active-modal nil
   :active-project nil
   :active-document nil
   :active-sentence nil
   :nav-collapsed? true    ;; Is the navigation bar collapsed, only relevant for mobile;
   :loading? false         ;; Are we waiting for data from the API?
   :error nil})            ;; Was there an error that needs to be displayed to the user?

handlers.cljs

(ns annotare.handlers
  (:require
    [annotare.db   :refer [default-value]]
    [re-frame.core :refer [dispatch register-handler path trim-v after debug]]
    [ajax.core     :refer [GET]]))


(def headers {"Accept" "application/transit+json"})

(register-handler
  :initialise-db
  (fn [_ _]
    default-value))

(register-handler
  :fetch-random-sentence
  [trim-v debug]
  (fn [app-db [proj-id]]
    (GET
      (str "/api/project/" proj-id "/random-untagged")
      {:headers headers
       :handler       #(dispatch [:process-sentence %])
       :error-handler #(dispatch [:bad-response %])})
    (assoc app-db :loading? true)))

(register-handler
  :fetch-projects
  [debug]
  (fn [app-db _]
    (GET "/api/project"
         {:headers headers
          :handler        #(dispatch [:process-projects %1])
          :error-handler  #(dispatch [:bad-response %1])})
    (assoc app-db :loading? true)))

(register-handler
  :process-sentence
  [debug]
  (fn [app-db [_ sentence]]
    (-> app-db
        (assoc :active-sentence sentence)
        (assoc :loading? false))))

(register-handler
  :process-projects
  [debug]
  (fn [app-db [_ projects]]
    (-> app-db
        (assoc :loading? false)
        (assoc :projects (reduce #(assoc %1 (:id %2) %2) {} projects)))))

(register-handler
  :bad-response
  (fn [app-db [_ error]]
    (.error js/console (str error))
    (assoc app-db :error {:message "There was a problem while communicating with the server."})))

(register-handler
  :set-panel
  [trim-v debug]
  (fn [app-db [new-panel]]
    (-> app-db
        (assoc :active-panel new-panel))))

(register-handler
  :toggle-nav
  [(path :nav-collapsed?)]
  (fn [collapsed? [_]]
    (not collapsed?)))

(register-handler
  :set-active-project
  [debug (path  :active-project)]
  (fn  [old-id [_ new-id]]
    new-id))

(register-handler
  :toggle-form
  [trim-v (path :active-form)]
  (fn [active-form [new-form]]
    new-form))

(register-handler
  :toggle-modal
  [trim-v (path :active-modal)]
  (fn [active-modal [new-modal]]
    new-modal))

tagging.cljs

(ns annotare.views.tagging
  (:require [reagent.core :as reagent :refer [atom]]
            [cljs.pprint :refer [pprint]]
            [re-frame.core :refer [subscribe dispatch]]
            [annotare.util :refer [indexed]]))

;; Offscreen-Canvas for determining text-width
(def offscreen-canvas (.createElement js/document "canvas"))

(defn get-text-width [text font font-size]
  "Utility function to determine the width of a given string when rendered
   in the browser. Uses an off-screen canvas."
  (let [ctx (.getContext offscreen-canvas "2d")]
    (set! (.-font ctx) (str font-size " " font))
    (.-width (.measureText ctx text))))

(defn tagging-token [token current-tag tag-set]
  "A single token that is to be tagged"
  (let [text-width (get-text-width token "Helvetica Neue" "56px")
        tag-width (get-text-width (apply (partial max-key count) tag-set) "Helvetica Neue" "14px")
        select-width (+ text-width tag-width)]
    [:div.tag-select {:style {:margin-right (str (* 1.25 tag-width) "px")}}
      [:select {:style {:width (str select-width "px")
                        :padding-left (str text-width "px")}
                :default-value current-tag}
        (for [[idx tag] (indexed tag-set)]
          ^{:key idx} [:option {:value tag} tag])]
      [:span.token {:style {:margin-left (str "-" select-width "px")}} token]]))

(defn tagging-toolbar [project-id]
  [:section>div.tagging-toolbar
   [:button.button.is-primary
    {:on-click #(dispatch [:fetch-random-sentence project-id])}
    "Next sentence"]])

(defn tagging-panel []
  (let [sentence (subscribe [:active-sentence])
        project (subscribe [:active-project])]
    (fn []
      (let [{:keys [tagset id]} @project]
        [:div.container
         [:pre (with-out-str (pprint @sentence))]
         [tagging-toolbar id]
         (doall (for [[idx [tok tag]] (indexed (map vector (:tokens @sentence) (:tags @sentence)))]
                   ^{:key idx} [tagging-token tok tag tagset]))]))))