237 lines
8.2 KiB
Clojure
237 lines
8.2 KiB
Clojure
(ns auto-ap.effects
|
|
(:require-macros [cljs.core.async.macros :refer [go]])
|
|
(:require
|
|
[auto-ap.history :as p]
|
|
[auto-ap.status :as status]
|
|
[auto-ap.views.utils :refer [date->str standard]]
|
|
[cemerick.url :as url]
|
|
[cljs-http.client :as http]
|
|
[cljs-time.coerce :as c]
|
|
[cljs-time.core :as time]
|
|
[cljs-time.format :as format]
|
|
[cljs.core.async :refer [<!] :as async]
|
|
[clojure.string :as str]
|
|
[clojure.walk :as walk]
|
|
[pushy.core :as pushy]
|
|
[re-frame.core :as re-frame]
|
|
[venia.core :as v]))
|
|
|
|
(re-frame/reg-fx
|
|
:redirect
|
|
(fn [uri]
|
|
(pushy/set-token! p/history uri)
|
|
(p/dispatch-route (p/parse-url uri))))
|
|
|
|
(re-frame/reg-fx
|
|
:set-uri-params
|
|
(fn [uri-params]
|
|
(pushy/set-token! p/history
|
|
(str (.-protocol (.-location js/window)) "//" (.-host (.-location js/window)) (.-pathname (.-location js/window))
|
|
"?"
|
|
(url/map->query (->> uri-params
|
|
(filter (fn [[_ v]] (and v
|
|
(or (not (seqable? v))
|
|
(not-empty v)))) )
|
|
(map
|
|
(fn [[k v]]
|
|
(if (string? v)
|
|
[k (str "\"" v "\"")]
|
|
[k v])))
|
|
(into {} )))))))
|
|
|
|
|
|
(re-frame/reg-fx
|
|
:set-local-storage
|
|
(fn [[name value]]
|
|
(if value
|
|
(.setItem js/localStorage name value)
|
|
(.removeItem js/localStorage name ))))
|
|
|
|
;; 2017-09-19T07:00:00.000Z
|
|
(def is-8601 #"^\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}\.\d{3}Z$")
|
|
|
|
(def is-year-month-day #"^\d{4}-\d{2}-\d{2}$")
|
|
|
|
(defn dates->date-times [x]
|
|
(walk/postwalk
|
|
(fn [node]
|
|
(cond
|
|
|
|
(and (string? node)
|
|
(re-matches is-8601 node))
|
|
(time/to-default-time-zone (format/parse (format/formatters :date-time) node))
|
|
|
|
(and (string? node)
|
|
(re-matches is-year-month-day node))
|
|
(time/from-default-time-zone (format/parse (format/formatters :year-month-day) node))
|
|
|
|
(instance? js/Date node)
|
|
(time/to-default-time-zone (c/from-date node))
|
|
|
|
:else
|
|
node))
|
|
x))
|
|
|
|
(re-frame/reg-fx
|
|
:http
|
|
(fn [{:keys [method uri on-success on-error body headers owns-state token]}]
|
|
|
|
(go
|
|
(when (:multi owns-state)
|
|
(re-frame/dispatch-sync [::status/loading-multi (:multi owns-state) (:which owns-state)]))
|
|
|
|
(when (:single owns-state)
|
|
(re-frame/dispatch-sync [::status/loading (:single owns-state)]))
|
|
(let [headers (if token
|
|
(assoc headers "Authorization" (str "Token " token))
|
|
headers)
|
|
response (<! (http/request {:method method
|
|
:body body
|
|
:headers headers
|
|
:url uri}))]
|
|
(if (>= (:status response) 400)
|
|
(do
|
|
(when (:multi owns-state)
|
|
(re-frame/dispatch [::status/error-multi (:multi owns-state) (:which owns-state) [(:body response)]]))
|
|
(when (:single owns-state)
|
|
(re-frame/dispatch [::status/error (:single owns-state) [(:body response)]]))
|
|
(when on-error
|
|
(->> response
|
|
:body
|
|
(dates->date-times)
|
|
(conj on-error)
|
|
(re-frame/dispatch))))
|
|
(do
|
|
(when (:multi owns-state)
|
|
(re-frame/dispatch [::status/completed-multi (:multi owns-state) (:which owns-state)]))
|
|
(when (:single owns-state)
|
|
(re-frame/dispatch [::status/completed (:single owns-state)]))
|
|
(->> response
|
|
:body
|
|
(dates->date-times)
|
|
(conj on-success)
|
|
(re-frame/dispatch))))))))
|
|
|
|
(defn kebab->snake [s]
|
|
(str/replace s #"-" "_"))
|
|
|
|
(defn snake [x]
|
|
(if (namespace x)
|
|
(keyword (namespace x) (kebab->snake (name x)))
|
|
(keyword (kebab->snake (name x)))))
|
|
|
|
(defn ->graphql [m]
|
|
(walk/postwalk
|
|
(fn [node]
|
|
(cond
|
|
|
|
(keyword? node)
|
|
(snake node)
|
|
|
|
(instance? goog.date.DateTime node )
|
|
(date->str node standard)
|
|
|
|
(instance? goog.date.Date node )
|
|
(date->str node standard)
|
|
|
|
|
|
:else
|
|
node))
|
|
m))
|
|
|
|
(defonce timeouts
|
|
(atom {}))
|
|
|
|
(re-frame/reg-fx
|
|
:dispatch-debounce
|
|
(fn [{:keys [event time key]}]
|
|
(js/clearTimeout (@timeouts key))
|
|
(swap! timeouts assoc key
|
|
(js/setTimeout (fn []
|
|
(re-frame/dispatch event)
|
|
(swap! timeouts dissoc key))
|
|
time))))
|
|
|
|
|
|
(re-frame/reg-fx
|
|
:graphql
|
|
(fn [{:keys [query on-success on-error token variables query-obj owns-state]}]
|
|
(go
|
|
(when (:multi owns-state)
|
|
(re-frame/dispatch-sync [::status/loading-multi (:multi owns-state) (:which owns-state)]))
|
|
|
|
(when (:single owns-state)
|
|
(re-frame/dispatch-sync [::status/loading (:single owns-state)]))
|
|
(let [headers (if token
|
|
{"Authorization" (str "Token " token)}
|
|
{})
|
|
on-success (if (fn? on-success)
|
|
on-success
|
|
(fn [result]
|
|
(conj on-success result)))
|
|
|
|
method (if (= (get-in query-obj [:venia/operation :operation/type]) :mutation)
|
|
:post
|
|
:get)
|
|
|
|
headers (if (= method :post)
|
|
(assoc headers "Content-Type" "text/plain")
|
|
headers)
|
|
|
|
query (or query (v/graphql-query (->graphql query-obj)))
|
|
response (<! (http/request {:method method
|
|
:headers headers
|
|
|
|
:body (when = (:post method) query)
|
|
:url (str "/api/graphql?query=" (when (= :get method) (js/encodeURIComponent query))
|
|
"&variables=" (pr-str (or variables {})))}))]
|
|
|
|
(cond
|
|
(= (:status response) 401)
|
|
(re-frame/dispatch [:auto-ap.events/logout "Your session has expired. Please log in again."])
|
|
|
|
|
|
(>= (:status response) 400)
|
|
(let [error (->> response
|
|
:body
|
|
:errors
|
|
(dates->date-times)
|
|
(map #(assoc % :status (:status response)))
|
|
)]
|
|
(when (:multi owns-state)
|
|
(re-frame/dispatch [::status/error-multi (:multi owns-state) (:which owns-state) error]))
|
|
(when (:single owns-state)
|
|
(re-frame/dispatch [::status/error (:single owns-state) error]))
|
|
(when on-error
|
|
(->> error
|
|
(conj on-error)
|
|
(re-frame/dispatch))))
|
|
:else
|
|
(do
|
|
(when (:multi owns-state)
|
|
(re-frame/dispatch [::status/completed-multi (:multi owns-state) (:which owns-state)]))
|
|
(when (:single owns-state)
|
|
(re-frame/dispatch [::status/completed (:single owns-state)]))
|
|
(->> response
|
|
:body
|
|
:data
|
|
(dates->date-times)
|
|
(on-success)
|
|
(re-frame/dispatch))))))))
|
|
|
|
(defonce interval-handler
|
|
(let [live-intervals (atom {})]
|
|
(fn handler [{:keys [action id frequency event]}]
|
|
(condp = action
|
|
:clean (doall
|
|
(map #(handler {:action :end :id %1}) (keys @live-intervals)))
|
|
:start (swap! live-intervals assoc id (js/setInterval #(re-frame/dispatch event) frequency))
|
|
:end (do (js/clearInterval (get @live-intervals id))
|
|
(swap! live-intervals dissoc id))))))
|
|
(interval-handler {:action :clean})
|
|
(re-frame.core/reg-fx ;; the re-frame API for registering effect handlers
|
|
:interval ;; the effect id
|
|
interval-handler)
|
|
|
|
|