270 lines
8.5 KiB
Clojure
270 lines
8.5 KiB
Clojure
(ns pmagnus.elprice.web.routes.ui
|
|
(:require
|
|
[integrant.core :as ig]
|
|
[pmagnus.elprice.web.controllers.eloverblik :as eloverblik]
|
|
[pmagnus.elprice.web.controllers.prices :as prices]
|
|
[pmagnus.elprice.web.controllers.tariffs :as tariffs]
|
|
[pmagnus.elprice.web.htmx :refer [page fragment]]
|
|
[pmagnus.elprice.web.middleware.exception :as exception]
|
|
[pmagnus.elprice.web.middleware.formats :as formats]
|
|
[pmagnus.elprice.web.routes.utils :as utils]
|
|
[reitit.ring.middleware.muuntaja :as muuntaja]
|
|
[reitit.ring.middleware.parameters :as parameters])
|
|
(:import
|
|
(java.time
|
|
LocalDateTime
|
|
ZoneId)
|
|
(java.time.format
|
|
DateTimeFormatter)))
|
|
|
|
|
|
(def ^:private dk-zone (ZoneId/of "Europe/Copenhagen"))
|
|
(def ^:private hour-fmt (DateTimeFormatter/ofPattern "HH:00"))
|
|
(def ^:private date-fmt (DateTimeFormatter/ofPattern "yyyy-MM-dd"))
|
|
|
|
|
|
(defn- ->ldt
|
|
[time-dk]
|
|
(cond
|
|
(instance? LocalDateTime time-dk) time-dk
|
|
(instance? java.sql.Timestamp time-dk)
|
|
(.toLocalDateTime ^java.sql.Timestamp time-dk)
|
|
:else (LocalDateTime/parse (str time-dk))))
|
|
|
|
|
|
(defn- format-hour
|
|
[time-dk]
|
|
(.format (->ldt time-dk) hour-fmt))
|
|
|
|
|
|
(defn- dkk-mwh->ore-kwh
|
|
"Convert DKK/MWh to øre/kWh (divide by 10)."
|
|
[price-dkk]
|
|
(when price-dkk
|
|
(/ (double price-dkk) 10.0)))
|
|
|
|
|
|
(defn- format-ore
|
|
"Format price as total(net) where total = net + tariff, or just net if no tariff."
|
|
([price-dkk]
|
|
(if-let [ore (dkk-mwh->ore-kwh price-dkk)]
|
|
(format "%.1f" ore)
|
|
"-"))
|
|
([price-dkk tariff]
|
|
(if-let [ore (dkk-mwh->ore-kwh price-dkk)]
|
|
(format "%.1f(%.1f)" (+ ore tariff) ore)
|
|
"-")))
|
|
|
|
|
|
(defn- group-by-hour
|
|
[prices]
|
|
(->> prices
|
|
(group-by #(.getHour (->ldt (:time_dk %))))
|
|
(sort-by key)))
|
|
|
|
|
|
(defn- avg-ore
|
|
[quarters]
|
|
(let [vals (keep :price_dkk quarters)]
|
|
(when (seq vals)
|
|
(/ (reduce + 0.0 (map double vals)) (count vals) 10.0))))
|
|
|
|
|
|
(def ^:private red-gradient
|
|
["bg-red-50" "bg-red-100" "bg-red-200" "bg-red-300"
|
|
"bg-red-400" "bg-red-500" "bg-red-600" "bg-red-700"])
|
|
|
|
|
|
(def ^:private green-gradient
|
|
["bg-green-700" "bg-green-600" "bg-green-500" "bg-green-400"
|
|
"bg-green-300" "bg-green-200" "bg-green-100" "bg-green-50"])
|
|
|
|
|
|
(defn- rank-bg
|
|
[rank total]
|
|
(cond
|
|
(<= rank 8) (get green-gradient (dec rank))
|
|
(> rank (- total 8)) (get red-gradient (- rank (- total 7)))
|
|
:else nil))
|
|
|
|
|
|
(defn- hour-block
|
|
[hour quarters rank total-hours]
|
|
(let [sorted (sort-by #(.getMinute (->ldt (:time_dk %))) quarters)
|
|
avg (avg-ore quarters)
|
|
month (.getMonthValue (->ldt (:time_dk (first quarters))))
|
|
tariff (tariffs/tariff-for-hour month hour)
|
|
bg (rank-bg rank total-hours)
|
|
dark? (and bg (or (<= rank 4) (>= rank (- total-hours 3))))]
|
|
[:details {:class (str "border-2 border-blue-400 rounded-lg mb-2 " bg)}
|
|
[:summary {:class (str "flex justify-between py-2 px-3 cursor-pointer font-medium "
|
|
(if dark? "text-white" "text-gray-900"))}
|
|
[:span (format "%02d:00" hour)]
|
|
[:span {:class (str "text-sm " (if dark? "text-white/80" "text-gray-500"))} (str "#" rank)]
|
|
[:span {:class "font-mono"}
|
|
(if avg (format "%.1f(%.1f)" (+ avg tariff) avg) "-")]]
|
|
[:div {:class (str "border-t-2 border-blue-400 px-3 pb-2 "
|
|
(if dark? "text-white/80" "text-gray-500"))}
|
|
(for [q sorted]
|
|
[:div {:class "flex justify-between py-1 ml-4"}
|
|
[:span (format "%02d:%02d" hour (.getMinute (->ldt (:time_dk q))))]
|
|
[:span {:class "font-mono"} (format-ore (:price_dkk q) tariff)]])]]))
|
|
|
|
|
|
(defn- hour-ranks
|
|
"Compute a map of hour -> rank (1 = cheapest) based on total price (avg + tariff)."
|
|
[grouped-hours]
|
|
(let [totals (for [[hour quarters] grouped-hours]
|
|
(let [avg (avg-ore quarters)
|
|
month (.getMonthValue (->ldt (:time_dk (first quarters))))
|
|
tariff (tariffs/tariff-for-hour month hour)]
|
|
[hour (if avg (+ avg tariff) Double/MAX_VALUE)]))]
|
|
(->> totals
|
|
(sort-by second)
|
|
(map-indexed (fn [i [hour _]] [hour (inc i)]))
|
|
(into {}))))
|
|
|
|
|
|
(defn- price-table
|
|
[prices]
|
|
[:div
|
|
(if (seq prices)
|
|
(let [grouped (group-by-hour prices)
|
|
ranks (hour-ranks grouped)
|
|
total-hours (count grouped)]
|
|
[:div
|
|
(for [[hour quarters] grouped]
|
|
(hour-block hour quarters (get ranks hour) total-hours))])
|
|
[:p {:class "mt-2 text-sm text-gray-400"} "Not available yet"])])
|
|
|
|
|
|
(def ^:private tab-base
|
|
"px-4 py-2 font-medium text-sm rounded-t-lg border-2 border-b-0 ")
|
|
|
|
|
|
(def ^:private tab-active
|
|
(str tab-base "border-blue-400 bg-white text-gray-900"))
|
|
|
|
|
|
(def ^:private tab-inactive
|
|
(str tab-base "border-gray-200 bg-gray-100 text-gray-500 hover:text-gray-700 cursor-pointer"))
|
|
|
|
|
|
(defn- tabs
|
|
[active-tab has-tomorrow?]
|
|
(let [today (java.time.LocalDate/now dk-zone)
|
|
tomorrow (.plusDays today 1)]
|
|
[:div {:class "flex gap-1 mt-4"}
|
|
[:button {:class (if (= active-tab :today) tab-active tab-inactive)
|
|
:hx-get "/prices/today"
|
|
:hx-target "#price-panel"
|
|
:hx-swap "innerHTML"}
|
|
(str "Today " (.format today date-fmt))]
|
|
(when has-tomorrow?
|
|
[:button {:class (if (= active-tab :tomorrow) tab-active tab-inactive)
|
|
:hx-get "/prices/tomorrow"
|
|
:hx-target "#price-panel"
|
|
:hx-swap "innerHTML"}
|
|
(str "Tomorrow " (.format tomorrow date-fmt))])]))
|
|
|
|
|
|
(defn- price-content
|
|
[tab prices has-tomorrow?]
|
|
[:div
|
|
(tabs tab has-tomorrow?)
|
|
[:div {:id "price-content"
|
|
:class "border-2 border-blue-400 rounded-b-lg rounded-tr-lg p-4 bg-white"}
|
|
(price-table prices)]])
|
|
|
|
|
|
(defn- has-tomorrow?
|
|
[query-fn]
|
|
(seq (prices/get-tomorrow-prices query-fn)))
|
|
|
|
|
|
(defn home
|
|
[query-fn request]
|
|
(prices/fetch-and-save! query-fn)
|
|
(page {:lang "en"}
|
|
[:h1 {:class "text-2xl font-bold text-gray-900 cursor-pointer hover:text-blue-600 transition-colors"
|
|
:hx-post "/prices/fetch"
|
|
:hx-target "#price-panel"
|
|
:hx-swap "innerHTML"}
|
|
"Electricity Prices"]
|
|
[:p {:class "mt-1 text-sm text-gray-500"}
|
|
"Day-ahead prices for DK1 — total(spot) in øre/kWh incl. N1 tariff"]
|
|
[:div {:id "price-panel"}
|
|
(price-content :today (prices/get-today-prices query-fn) (has-tomorrow? query-fn))]))
|
|
|
|
|
|
(defn prices-today
|
|
[query-fn request]
|
|
(fragment
|
|
(price-content :today (prices/get-today-prices query-fn) (has-tomorrow? query-fn))))
|
|
|
|
|
|
(defn prices-tomorrow
|
|
[query-fn request]
|
|
(fragment
|
|
(price-content :tomorrow (prices/get-tomorrow-prices query-fn) (has-tomorrow? query-fn))))
|
|
|
|
|
|
(defn fetch-prices
|
|
[query-fn request]
|
|
(prices/fetch-and-save! query-fn)
|
|
(fragment
|
|
(price-content :today (prices/get-today-prices query-fn) (has-tomorrow? query-fn))))
|
|
|
|
|
|
(defn sync-eloverblik
|
|
[query-fn request]
|
|
(let [date-str (get-in request [:params :date])
|
|
date (if date-str
|
|
(java.time.LocalDate/parse date-str)
|
|
(java.time.LocalDate/now dk-zone))
|
|
result (eloverblik/fetch-and-save-all! query-fn date)]
|
|
(fragment
|
|
(cond
|
|
(:error result)
|
|
[:p {:class "text-red-600 font-medium"} (:error result)]
|
|
(:no-data result)
|
|
[:p {:class "text-gray-400"} (str "No data to fetch for " (:date result))]
|
|
(:exists result)
|
|
[:p {:class "text-gray-500"} (str "Data exists for " (:date result))]
|
|
:else
|
|
[:p {:class "text-green-700 font-medium"}
|
|
(str "Synced " (:metering-points result)
|
|
" metering points (" (:from result) " to " (:to result) ")")]))))
|
|
|
|
|
|
;; Routes
|
|
(defn ui-routes
|
|
[{:keys [query-fn]}]
|
|
[["/" {:get (partial home query-fn)}]
|
|
["/prices/today" {:get (partial prices-today query-fn)}]
|
|
["/prices/tomorrow" {:get (partial prices-tomorrow query-fn)}]
|
|
["/prices/fetch" {:post (partial fetch-prices query-fn)}]
|
|
["/eloverblik/sync" {:post (partial sync-eloverblik query-fn)}]])
|
|
|
|
|
|
(def route-data
|
|
{:muuntaja formats/instance
|
|
:middleware
|
|
[;; Default middleware for ui
|
|
;; query-params & form-params
|
|
parameters/parameters-middleware
|
|
;; encoding response body
|
|
muuntaja/format-response-middleware
|
|
;; exception handling
|
|
exception/wrap-exception]})
|
|
|
|
|
|
(derive :reitit.routes/ui :reitit/routes)
|
|
|
|
|
|
(defmethod ig/init-key :reitit.routes/ui
|
|
[_ {:keys [base-path]
|
|
:or {base-path ""}
|
|
:as opts}]
|
|
(fn [] [base-path route-data (ui-routes opts)]))
|