Compare commits
1
Commits
main
..
7f41c560a2
| Author | SHA1 | Date | |
|---|---|---|---|
 magnus
|
7f41c560a2 |
-23
@@ -1,23 +0,0 @@
|
||||
kit.git-config.edn
|
||||
.DS_Store
|
||||
.nrepl-port
|
||||
hs_err_pid*.log
|
||||
.cpcache/
|
||||
target
|
||||
log/
|
||||
.shadow-cljs/
|
||||
node_modules/
|
||||
modules/
|
||||
resources/public/css/output.css
|
||||
|
||||
# IntelliJ
|
||||
*.iml
|
||||
.idea/
|
||||
*.bak
|
||||
|
||||
# clj-kondo
|
||||
.clj-kondo/.cache/
|
||||
.calva/output-window/
|
||||
.lsp/.cache/
|
||||
.token
|
||||
.env
|
||||
@@ -1,92 +0,0 @@
|
||||
# CLAUDE.md
|
||||
|
||||
This file provides guidance to Claude Code (claude.ai/code) when working with code in this repository.
|
||||
|
||||
## Build & Development Commands
|
||||
|
||||
```bash
|
||||
# Development
|
||||
make run # Start dev server (port 3000)
|
||||
make repl # Start nREPL
|
||||
npm run css:watch # Watch/rebuild Tailwind CSS
|
||||
|
||||
# Testing
|
||||
make test # Run all tests
|
||||
clj -M:test # Alternative
|
||||
|
||||
# Build
|
||||
make uberjar # Build production JAR (target/elprice-standalone.jar)
|
||||
make clean # Remove target/
|
||||
|
||||
# Formatting
|
||||
bb format # Format source with cljstyle
|
||||
|
||||
# Docker
|
||||
docker compose up -d # Start PostgreSQL (port 5432)
|
||||
```
|
||||
|
||||
### REPL Commands
|
||||
|
||||
```clojure
|
||||
(dev-prep!) (go) ;; Start system in REPL
|
||||
(reset) ;; Reload code and restart system
|
||||
(halt) ;; Stop system
|
||||
(migrate) ;; Run database migrations
|
||||
(rollback) ;; Rollback last migration
|
||||
(reset-db) ;; Drop and re-migrate database
|
||||
;; Testing in REPL:
|
||||
(test-prep!) (go) (run-tests)
|
||||
```
|
||||
|
||||
## Architecture
|
||||
|
||||
**Kit framework** web application: Clojure, PostgreSQL, HTMX, Hiccup, Tailwind CSS.
|
||||
|
||||
### System Initialization
|
||||
|
||||
Integrant manages the component lifecycle. Configuration is in `resources/system.edn`, which defines components for the HTTP server (Undertow), database connection pool, migrations, routes, and middleware. The entry point is `pmagnus.elprice.core`, which loads the system config via `pmagnus.elprice.config`.
|
||||
|
||||
### Routing
|
||||
|
||||
Two separate route groups registered as Integrant components:
|
||||
|
||||
- **API routes** (`web/routes/api.clj`) — mounted at `/api`, returns JSON, has Swagger docs at `/api/swagger.json`
|
||||
- **UI routes** (`web/routes/ui.clj`) — mounted at `/`, returns HTML via HTMX + Hiccup
|
||||
|
||||
Routes are combined in `web/handler.clj` which builds the Ring handler with the full middleware stack.
|
||||
|
||||
### Frontend Pattern
|
||||
|
||||
Server-side rendered HTML using Hiccup data structures. Interactive behavior via HTMX (no client-side JS framework). Two macros in `web/htmx.clj`:
|
||||
|
||||
- `page` — renders a full HTML5 document (includes Tailwind CSS and HTMX script tags)
|
||||
- `fragment` — renders an HTML fragment for HTMX partial responses
|
||||
|
||||
Tailwind CSS v4 scans `.clj` and `.html` files for utility classes. Source: `resources/css/input.css` → Output: `resources/public/css/output.css`.
|
||||
|
||||
### Database
|
||||
|
||||
PostgreSQL via kit-postgres and conman (connection pooling). SQL queries defined with HugSQL in `resources/queries.sql`. Migrations via Migratus in `resources/migrations/`. Migrations run automatically on system startup (`migrate-on-init? true`).
|
||||
|
||||
- Dev/Test DB: `jdbc:postgresql://localhost:5432/elprice?user=elprice&password=elprice`
|
||||
- Prod DB: via `JDBC_URL` environment variable
|
||||
|
||||
### Middleware
|
||||
|
||||
Defined in `web/middleware/core.clj`. Cookie-based sessions (http-only, same-site strict). CSRF is disabled. Static assets served from `resources/public/`.
|
||||
|
||||
### Source Layout
|
||||
|
||||
```
|
||||
src/clj/pmagnus/elprice/
|
||||
├── core.clj # App entry point, system lifecycle
|
||||
├── config.clj # Integrant config loader
|
||||
└── web/
|
||||
├── handler.clj # Ring handler + route composition
|
||||
├── htmx.clj # page/fragment Hiccup macros
|
||||
├── controllers/ # Request handlers (business logic)
|
||||
├── middleware/ # Ring middleware (core, exception, formats)
|
||||
└── routes/ # Reitit route definitions (api, ui)
|
||||
```
|
||||
|
||||
Environment-specific code lives in `env/{dev,prod,test}/`. Dev REPL utilities are in `env/dev/clj/pmagnus/elprice/user.clj`.
|
||||
-22
@@ -1,22 +0,0 @@
|
||||
FROM node:22-alpine AS css
|
||||
WORKDIR /app
|
||||
COPY package.json package-lock.json ./
|
||||
RUN npm ci
|
||||
COPY resources/css resources/css
|
||||
COPY src src
|
||||
RUN npx @tailwindcss/cli -i resources/css/input.css -o resources/public/css/output.css --minify
|
||||
|
||||
FROM clojure:temurin-21-tools-deps-alpine AS build
|
||||
WORKDIR /app
|
||||
COPY deps.edn build.clj ./
|
||||
RUN clojure -P && clojure -P -T:build
|
||||
COPY . .
|
||||
COPY --from=css /app/resources/public/css/output.css resources/public/css/output.css
|
||||
RUN clojure -T:build all
|
||||
|
||||
FROM eclipse-temurin:21-jre-alpine
|
||||
WORKDIR /app
|
||||
COPY --from=build /app/target/elprice-standalone.jar app.jar
|
||||
EXPOSE 3030
|
||||
ENV PORT=3030
|
||||
ENTRYPOINT ["java", "-jar", "app.jar"]
|
||||
@@ -1,20 +0,0 @@
|
||||
include .env
|
||||
export
|
||||
|
||||
clean:
|
||||
rm -rf target
|
||||
|
||||
run:
|
||||
clj -M:dev -e "(dev-prep!) (go)" -r
|
||||
|
||||
repl:
|
||||
clj -M:dev:nrepl
|
||||
|
||||
tailwind:
|
||||
npm run css:watch
|
||||
|
||||
test:
|
||||
clj -M:test
|
||||
|
||||
uberjar:
|
||||
clj -T:build all
|
||||
@@ -1,37 +1,2 @@
|
||||
# elprice
|
||||
|
||||
Start a [REPL](#repls) in your editor or terminal of choice.
|
||||
|
||||
Start the server with:
|
||||
|
||||
```clojure
|
||||
(go)
|
||||
```
|
||||
|
||||
The default API is available under http://localhost:3000/api
|
||||
|
||||
System configuration is available under `resources/system.edn`.
|
||||
|
||||
To reload changes:
|
||||
|
||||
```clojure
|
||||
(reset)
|
||||
```
|
||||
|
||||
## REPLs
|
||||
|
||||
### Cursive
|
||||
|
||||
Configure a [REPL following the Cursive documentation](https://cursive-ide.com/userguide/repl.html). Using the default "Run with IntelliJ project classpath" option will let you select an alias from the ["Clojure deps" aliases selection](https://cursive-ide.com/userguide/deps.html#refreshing-deps-dependencies).
|
||||
|
||||
### CIDER
|
||||
|
||||
Use the `cider` alias for CIDER nREPL support (run `clj -M:dev:cider`). See the [CIDER docs](https://docs.cider.mx/cider/basics/up_and_running.html) for more help.
|
||||
|
||||
Note that this alias runs nREPL during development. To run nREPL in production (typically when the system starts), use the kit-nrepl library through the +nrepl profile as described in [the documentation](https://kit-clj.github.io/docs/profiles.html#profiles).
|
||||
|
||||
### Command Line
|
||||
|
||||
Run `clj -M:dev:nrepl` or `make repl`.
|
||||
|
||||
Note that, just like with [CIDER](#cider), this alias runs nREPL during development. To run nREPL in production (typically when the system starts), use the kit-nrepl library through the +nrepl profile as described in [the documentation](https://kit-clj.github.io/docs/profiles.html#profiles).
|
||||
|
||||
-435
@@ -1,435 +0,0 @@
|
||||
;; Copyright © 2015-2017, JUXT LTD.
|
||||
|
||||
(ns aero.core
|
||||
(:require
|
||||
[aero.alpha.core :refer
|
||||
[expand expand-scalar-repeatedly expand-case eval-tagged-literal
|
||||
reassemble kv-seq]]
|
||||
[aero.impl.walk :refer [postwalk]]
|
||||
#?@(:clj [[clojure.edn :as edn]
|
||||
[aero.impl.macro :as macro]]
|
||||
:cljs [[cljs.tools.reader.edn :as edn]
|
||||
[cljs.tools.reader :refer [default-data-readers *data-readers*]]
|
||||
[cljs.tools.reader.reader-types
|
||||
:refer [source-logging-push-back-reader]
|
||||
:as tools.reader.reader-types]])
|
||||
#?@(:clj [[clojure.java.io :as io]]
|
||||
:cljs [[goog.string :as gstring]
|
||||
goog.string.format
|
||||
[goog.object :as gobj]
|
||||
["fs" :as fs]
|
||||
["path" :as path] ["os" :as os]]))
|
||||
#?(:clj (:import (java.io StringReader)))
|
||||
#?(:cljs (:require-macros [aero.impl.macro :as macro])))
|
||||
|
||||
(defrecord Deferred [delegate])
|
||||
|
||||
(macro/usetime
|
||||
(declare read-config)
|
||||
|
||||
(defmulti reader (fn [opts tag value] tag))
|
||||
|
||||
(defmethod reader :default
|
||||
[_ tag value]
|
||||
(cond
|
||||
;; Given tagification, we now must check data-readers
|
||||
(contains? *data-readers* tag)
|
||||
((get *data-readers* tag) value)
|
||||
|
||||
(contains? default-data-readers tag)
|
||||
((get default-data-readers tag) value)
|
||||
:else
|
||||
(throw (ex-info (#?(:clj format :cljs gstring/format) "No reader for tag %s" tag) {:tag tag :value value}))))
|
||||
|
||||
(defn- get-env [s]
|
||||
#?(:clj (System/getenv (str s)))
|
||||
#?(:cljs (gobj/get js/process.env s)))
|
||||
|
||||
(defmethod reader 'env
|
||||
[opts tag value]
|
||||
(get-env value))
|
||||
|
||||
(defmethod reader 'envf
|
||||
[opts tag value]
|
||||
(let [[fmt & args] value]
|
||||
(apply #?(:clj format :cljs gstring/format) fmt
|
||||
(map #(str (get-env (str %))) args))))
|
||||
|
||||
(defmethod reader 'prop
|
||||
[opts tag value]
|
||||
#?(:clj (System/getProperty (str value))
|
||||
:cljs nil))
|
||||
|
||||
(defmethod reader 'long
|
||||
[opts tag value]
|
||||
#?(:clj (Long/parseLong (str value)))
|
||||
#?(:cljs (js/parseInt (str value))))
|
||||
|
||||
(defmethod reader 'double
|
||||
[opts tag value]
|
||||
#?(:clj (Double/parseDouble (str value)))
|
||||
#?(:cljs (js/parseFloat (str value))))
|
||||
|
||||
(defmethod reader 'keyword
|
||||
[opts tag value]
|
||||
(if (keyword? value)
|
||||
value
|
||||
(keyword (str value))))
|
||||
|
||||
(defmethod reader 'boolean
|
||||
[opts tag value]
|
||||
#?(:clj (Boolean/parseBoolean (str value)))
|
||||
#?(:cljs (= "true" (.toLowerCase (str value)))))
|
||||
|
||||
(defmethod reader 'include
|
||||
[{:keys [resolver source] :as opts} tag value]
|
||||
(read-config
|
||||
(if (map? resolver)
|
||||
(get resolver value)
|
||||
(resolver source value))
|
||||
opts))
|
||||
|
||||
(defmethod reader 'join
|
||||
[opts tag value]
|
||||
(apply str value))
|
||||
|
||||
(defmethod reader 'read-edn
|
||||
[opts tag value]
|
||||
(some-> value str edn/read-string))
|
||||
|
||||
(defmethod reader 'merge
|
||||
[opts tag values]
|
||||
(apply merge values))
|
||||
|
||||
#?(:clj
|
||||
(defn relative-resolver [source include]
|
||||
(let [fl
|
||||
(if (.isAbsolute (io/file include))
|
||||
(io/file include)
|
||||
(when-let [source-file
|
||||
(try (io/file source)
|
||||
;; Handle the case where the source isn't file compatible:
|
||||
(catch java.lang.IllegalArgumentException _ nil))]
|
||||
(io/file (.getParent ^java.io.File source-file) include)))]
|
||||
(if (and fl (.exists fl))
|
||||
fl
|
||||
(StringReader. (pr-str {:aero/missing-include include}))))))
|
||||
|
||||
#?(:clj
|
||||
(defn resource-resolver [_ include]
|
||||
(or
|
||||
(io/resource include)
|
||||
(StringReader. (pr-str {:aero/missing-include include})))))
|
||||
|
||||
#?(:clj
|
||||
(defn root-resolver [_ include]
|
||||
include))
|
||||
|
||||
#?(:clj
|
||||
(defn adaptive-resolver [source include]
|
||||
(let [include (or (io/resource include)
|
||||
include)]
|
||||
(if (string? include)
|
||||
(relative-resolver source include)
|
||||
include)))
|
||||
:cljs
|
||||
(defn adaptive-resolver [source include]
|
||||
(let [fl (if (path/isAbsolute include)
|
||||
include
|
||||
(path/join source ".." include))]
|
||||
(if (fs/existsSync fl)
|
||||
fl
|
||||
(source-logging-push-back-reader
|
||||
(pr-str {:aero/missing-include include}))))))
|
||||
|
||||
|
||||
(def default-opts
|
||||
{:profile :default
|
||||
:resolver adaptive-resolver})
|
||||
|
||||
;; The rationale for deferreds is to realise some values after the
|
||||
;; config has been read. This allows certain expensive operations to
|
||||
;; be performed only after #profile has had a chance to filter out all
|
||||
;; other environments. For example, a :prod profile my do some
|
||||
;; expensive decryption of secrets (which may not be cheap to run for
|
||||
;; all environments which don't need them, and probably won't be
|
||||
;; possible to decrypt, therefore you want to defer until needed).
|
||||
|
||||
(defn- realize-deferreds
|
||||
[config]
|
||||
(postwalk (fn [x] (if (instance? Deferred x) @(:delegate x) x)) config))
|
||||
|
||||
(defn- ref-meta-to-tagged-literal
|
||||
[config]
|
||||
(postwalk
|
||||
(fn [v]
|
||||
(cond
|
||||
(tagged-literal? v)
|
||||
(tagged-literal (:tag v) (ref-meta-to-tagged-literal (:form v)))
|
||||
|
||||
(contains? (meta v) :ref)
|
||||
(tagged-literal 'ref v)
|
||||
|
||||
:else
|
||||
v))
|
||||
config))
|
||||
|
||||
(defn- read-pr-into-tagged-literal
|
||||
[pr]
|
||||
(ref-meta-to-tagged-literal
|
||||
(edn/read
|
||||
{:eof nil
|
||||
;; Make a wrapper of all known readers, this permits mixing of
|
||||
;; post-processed tags with declared data readers
|
||||
:readers (into
|
||||
{}
|
||||
(map (fn [[k v]] [k #(tagged-literal k %)])
|
||||
(merge default-data-readers *data-readers*)))
|
||||
:default tagged-literal}
|
||||
pr)))
|
||||
|
||||
(defn read-config-into-tagged-literal
|
||||
[source]
|
||||
#?(:clj
|
||||
(with-open [pr (-> source io/reader clojure.lang.LineNumberingPushbackReader.)]
|
||||
(try
|
||||
(read-pr-into-tagged-literal pr)
|
||||
(catch Exception e
|
||||
(let [line (.getLineNumber pr)]
|
||||
(throw (ex-info (#?(:clj format :cljs gstring/format) "Config error on line %s" line) {:line line} e))))))
|
||||
:cljs
|
||||
(read-pr-into-tagged-literal
|
||||
(cond
|
||||
(tools.reader.reader-types/source-logging-reader? source)
|
||||
source
|
||||
|
||||
(implements? tools.reader.reader-types/Reader source)
|
||||
(source-logging-push-back-reader source)
|
||||
|
||||
:else
|
||||
(source-logging-push-back-reader
|
||||
(fs/readFileSync source "utf-8")
|
||||
1
|
||||
source)))))
|
||||
|
||||
(defn- rewrap
|
||||
[tl]
|
||||
(fn [v]
|
||||
(tagged-literal (:tag tl) v)))
|
||||
|
||||
(defmethod eval-tagged-literal :default
|
||||
[tl opts env ks]
|
||||
(let [{:keys [:aero.core/incomplete?] :as expansion}
|
||||
(expand (:form tl) opts env ks)]
|
||||
(if incomplete?
|
||||
(update expansion ::value (rewrap tl))
|
||||
(update expansion ::value #(reader opts (:tag tl) %)))))
|
||||
|
||||
(defmethod eval-tagged-literal 'ref
|
||||
[tl opts env ks]
|
||||
(let [{:keys [:aero.core/incomplete? :aero.core/env :aero.core/value
|
||||
:aero.core/incomplete]
|
||||
:or {env env}
|
||||
:as expansion} (expand (:form tl) opts env ks)]
|
||||
(if (or incomplete? (not (contains? env value)))
|
||||
(-> expansion
|
||||
(assoc ::incomplete? true)
|
||||
(update ::value (rewrap tl))
|
||||
(assoc ::incomplete (or incomplete
|
||||
{::path (pop ks)
|
||||
::value tl})))
|
||||
(assoc expansion ::value (get env value)))))
|
||||
|
||||
(defmethod eval-tagged-literal 'profile
|
||||
[tl opts env ks]
|
||||
(expand-case (:profile opts) tl opts env ks))
|
||||
|
||||
(defmethod eval-tagged-literal 'hostname
|
||||
[tl {:keys [hostname] :as opts} env ks]
|
||||
(expand-case (or hostname #?(:clj (env "HOSTNAME")
|
||||
:cljs (os/hostname)))
|
||||
tl opts env ks))
|
||||
|
||||
(defmethod eval-tagged-literal 'user
|
||||
[tl {:keys [user] :as opts} env ks]
|
||||
(expand-case (or user (get-env "USER"))
|
||||
tl opts env ks))
|
||||
|
||||
(defmethod eval-tagged-literal 'or
|
||||
[tl opts env ks]
|
||||
(let [{:keys [:aero.core/incomplete? :aero.core/value] :as expansion}
|
||||
(expand-scalar-repeatedly (:form tl) opts env ks)]
|
||||
(if incomplete?
|
||||
(update expansion ::value rewrap)
|
||||
(loop [[x & xs] value
|
||||
idx 0]
|
||||
(let [{:keys [:aero.core/incomplete? :aero.core/value]
|
||||
:as expansion}
|
||||
(expand x opts env (conj ks idx))]
|
||||
(cond
|
||||
;; We skipped a value, we cannot be sure whether it will be true in the future, so return with the remainder to check (including the skipped)
|
||||
incomplete?
|
||||
{::value (tagged-literal (:tag tl) (cons value xs))
|
||||
::incomplete? true
|
||||
::incomplete (::incomplete expansion)}
|
||||
|
||||
;; We found a value, and it's truthy, and we aren't skipped (because order), we successfully got one!
|
||||
value
|
||||
expansion
|
||||
|
||||
;; Run out of things to check
|
||||
(not (seq xs))
|
||||
nil
|
||||
|
||||
:else
|
||||
;; Falsey value, but not skipped, recur with the rest to try
|
||||
(recur xs (inc idx))))))))
|
||||
|
||||
(defn- assoc-in-kv-seq
|
||||
[x ks v]
|
||||
(let [[k & ks] ks]
|
||||
(let [steps (if (tagged-literal? x)
|
||||
(with-meta
|
||||
[[:tag (:tag x)]
|
||||
[:form (:form x)]]
|
||||
{`reassemble (fn [this queue]
|
||||
(let [{:keys [tag form]} (into {} queue)]
|
||||
(tagged-literal tag form)))})
|
||||
(kv-seq x))]
|
||||
(reassemble
|
||||
steps
|
||||
(map (fn [[stepk stepv :as kv]]
|
||||
(cond
|
||||
(and (not= (first ks) ::k)
|
||||
(= stepk k))
|
||||
(if (seq ks)
|
||||
[stepk (assoc-in-kv-seq stepv ks v)]
|
||||
[stepk v])
|
||||
|
||||
(and (= (first ks) ::k)
|
||||
(= stepk k))
|
||||
(if (seq (rest ks))
|
||||
[(assoc-in-kv-seq stepk (rest ks) v) stepv]
|
||||
[v stepv])
|
||||
|
||||
:else
|
||||
kv))
|
||||
steps)))))
|
||||
|
||||
(defn- dissoc-in-kv-seq
|
||||
[x ks]
|
||||
(let [[k & ks] ks]
|
||||
(if
|
||||
(or (not (seq ks))
|
||||
(= [::k] ks))
|
||||
(let [steps (kv-seq x)]
|
||||
(reassemble
|
||||
steps
|
||||
(filter (fn [[stepk stepv :as kv]]
|
||||
(not= stepk k))
|
||||
steps)) )
|
||||
|
||||
(let [steps (if (tagged-literal? x)
|
||||
(with-meta
|
||||
[[:tag (:tag x)]
|
||||
[:form (:form x)]]
|
||||
{`reassemble (fn [this queue]
|
||||
(let [{:keys [tag form]} (into {} queue)]
|
||||
(tagged-literal tag form)))})
|
||||
(kv-seq x))]
|
||||
(reassemble
|
||||
steps
|
||||
(map (fn [[stepk stepv :as kv]]
|
||||
(cond
|
||||
(and (not= (first ks) ::k)
|
||||
(= stepk k))
|
||||
(if (seq ks)
|
||||
[stepk (dissoc-in-kv-seq stepv ks)]
|
||||
[stepk stepv])
|
||||
|
||||
(and (= (first ks) ::k)
|
||||
(= stepk k))
|
||||
(if (seq (rest ks))
|
||||
[(dissoc-in-kv-seq stepk (rest ks)) stepv]
|
||||
[stepk stepv])
|
||||
|
||||
:else
|
||||
kv))
|
||||
steps))))))
|
||||
|
||||
(defn resolve-tagged-literals
|
||||
[wrapped-config opts]
|
||||
(let [{:keys [:aero.core/incomplete?
|
||||
:aero.core/value]
|
||||
:as expansion}
|
||||
(loop [attempts 0
|
||||
x {::value wrapped-config
|
||||
::incomplete? true}]
|
||||
(let [{:keys [:aero.core/incomplete]
|
||||
:as expansion}
|
||||
(expand (::value x)
|
||||
opts
|
||||
(::env x {})
|
||||
[])]
|
||||
(cond
|
||||
(not (::incomplete? x))
|
||||
expansion
|
||||
|
||||
(and (> attempts 0)
|
||||
(= (-> incomplete ::value :tag) 'ref))
|
||||
(do
|
||||
(binding [*out* #?(:clj *err*
|
||||
:cljs *out*)]
|
||||
(println "WARNING: Unable to resolve"
|
||||
(str \" (pr-str (-> incomplete ::value)) \")
|
||||
"at"
|
||||
(pr-str (-> incomplete ::path))))
|
||||
(recur
|
||||
0
|
||||
(if (= ::k (-> incomplete ::path last))
|
||||
(update expansion
|
||||
::value
|
||||
dissoc-in-kv-seq
|
||||
(-> incomplete ::path))
|
||||
(update expansion
|
||||
::value
|
||||
assoc-in-kv-seq
|
||||
(-> incomplete ::path)
|
||||
nil))))
|
||||
|
||||
(> attempts 1)
|
||||
(throw (ex-info "Max attempts exhausted"
|
||||
{:progress x
|
||||
:attempts attempts}))
|
||||
|
||||
:else
|
||||
(recur (if (= x expansion)
|
||||
(inc attempts)
|
||||
0)
|
||||
expansion))))]
|
||||
(if incomplete?
|
||||
(throw (ex-info "Incomplete resolution" expansion))
|
||||
value)))
|
||||
|
||||
(defn read-config
|
||||
"First argument is a string URL to the file. To read from the
|
||||
current directory just put the file name. To read from the classpath
|
||||
call clojure.java.io/resource on the string before passing it into
|
||||
this function.
|
||||
Optional second argument is a map that can include
|
||||
the following keys:
|
||||
:profile - indicates the profile to use for #profile extension
|
||||
:user - manually set the user for the #user extension
|
||||
:resolver - a function or map used to resolve includes."
|
||||
([source given-opts]
|
||||
(let [opts (merge default-opts given-opts {:source source})
|
||||
wrapped-config (read-config-into-tagged-literal source)]
|
||||
(-> wrapped-config
|
||||
(resolve-tagged-literals opts)
|
||||
(realize-deferreds))))
|
||||
([source] (read-config source {})))
|
||||
)
|
||||
|
||||
(macro/deftime
|
||||
(defmacro deferred [& expr]
|
||||
`(->Deferred (delay ~@expr))))
|
||||
@@ -1,27 +0,0 @@
|
||||
{:min-bb-version "0.8.156"
|
||||
:deps {failjure/failjure {:mvn/version "2.3.0"}}
|
||||
:tasks {:requires ([babashka.fs :as fs]
|
||||
[babashka.tasks :refer [shell]])
|
||||
|
||||
run {:doc "starts the app"
|
||||
:task (if (fs/windows?)
|
||||
(clojure {:dir "."} "-M:dev")
|
||||
(shell {:dir "."} "clj -M:dev"))}
|
||||
|
||||
nrepl {:doc "starts the nREPL"
|
||||
:task (clojure {:dir "."} "-M:dev:nrepl")}
|
||||
|
||||
cider {:doc "starts the cider"
|
||||
:task (clojure {:dir "."} "-M:dev:cider")}
|
||||
|
||||
test {:doc "runs tests"
|
||||
:task (clojure {:dir "."} "-M:test")}
|
||||
|
||||
uberjar {:doc "builds the uberjar"
|
||||
:task (clojure {:dir "."} "-T:build all")}
|
||||
|
||||
format {:doc "Formats codebase"
|
||||
:task (try
|
||||
(shell {:dir "src"} "cljstyle fix")
|
||||
(catch Exception _
|
||||
(clojure {:dir "src"} "-M:dev -m cljstyle.main fix")))}}}
|
||||
@@ -1,41 +0,0 @@
|
||||
(ns build
|
||||
(:require [clojure.string :as string]
|
||||
[clojure.tools.build.api :as b]))
|
||||
|
||||
(def lib 'pmagnus/elprice)
|
||||
(def main-cls (string/join "." (filter some? [(namespace lib) (name lib) "core"])))
|
||||
(def version (format "0.0.1-SNAPSHOT"))
|
||||
(def target-dir "target")
|
||||
(def class-dir (str target-dir "/" "classes"))
|
||||
(def uber-file (format "%s/%s-standalone.jar" target-dir (name lib)))
|
||||
(def basis (b/create-basis {:project "deps.edn"}))
|
||||
|
||||
(defn clean
|
||||
"Delete the build target directory"
|
||||
[_]
|
||||
(println (str "Cleaning " target-dir))
|
||||
(b/delete {:path target-dir}))
|
||||
|
||||
(defn prep [_]
|
||||
(println "Writing Pom...")
|
||||
(b/write-pom {:class-dir class-dir
|
||||
:lib lib
|
||||
:version version
|
||||
:basis basis
|
||||
:src-dirs ["src/clj"]})
|
||||
(b/copy-dir {:src-dirs ["src/clj" "resources" "env/prod/resources" "env/prod/clj"]
|
||||
:target-dir class-dir}))
|
||||
|
||||
(defn uber [_]
|
||||
(println "Compiling Clojure...")
|
||||
(b/compile-clj {:basis basis
|
||||
:src-dirs ["src/clj" "resources" "env/prod/resources" "env/prod/clj"]
|
||||
:class-dir class-dir})
|
||||
(println "Making uberjar...")
|
||||
(b/uber {:class-dir class-dir
|
||||
:uber-file uber-file
|
||||
:main main-cls
|
||||
:basis basis}))
|
||||
|
||||
(defn all [_]
|
||||
(do (clean nil) (prep nil) (uber nil)))
|
||||
-196
@@ -1,196 +0,0 @@
|
||||
(ns conman.core
|
||||
(:require [clojure.java.io :as io]
|
||||
[clojure.set :refer [rename-keys]]
|
||||
[hikari-cp.core :refer [make-datasource]]
|
||||
[hugsql.core :as hugsql]
|
||||
[hugsql.adapter.next-jdbc :as next-adapter]
|
||||
[to-jdbc-uri.core :refer [to-jdbc-uri]])
|
||||
(:import [clojure.lang IDeref]))
|
||||
|
||||
(hugsql/set-adapter! (next-adapter/hugsql-adapter-next-jdbc))
|
||||
|
||||
(defn validate-files [filenames]
|
||||
(doseq [file filenames]
|
||||
(when-not (or (instance? java.io.File file) (io/resource file))
|
||||
(throw (Exception. (str "conman could not find the query file:" file))))))
|
||||
|
||||
(defn try-snip [[id snip]]
|
||||
[id
|
||||
(update snip :fn
|
||||
(fn [snip]
|
||||
(fn [& args]
|
||||
(try (apply snip args)
|
||||
(catch Exception e
|
||||
(throw (ex-info (ex-message e) {:snip-id id} e)))))))])
|
||||
|
||||
(defn try-query [[id query]]
|
||||
[id
|
||||
(update query :fn
|
||||
(fn [query]
|
||||
(fn
|
||||
([conn params]
|
||||
(try (query conn params)
|
||||
(catch Exception e
|
||||
(throw (ex-info (ex-message e) {:query-id id} e)))))
|
||||
([conn params opts & command-opts]
|
||||
(try (apply query conn params opts command-opts)
|
||||
(catch Exception e
|
||||
(throw (ex-info (ex-message e) {:query-id id} e))))))))])
|
||||
|
||||
(defn load-queries [& args]
|
||||
(let [options? (map? (first args))
|
||||
options (if options? (first args) {})
|
||||
filenames (if options? (rest args) args)]
|
||||
(validate-files filenames)
|
||||
(reduce
|
||||
(fn [queries file]
|
||||
(let [{snips true
|
||||
fns false}
|
||||
(group-by
|
||||
#(-> % second :meta :snip? boolean)
|
||||
(hugsql/map-of-db-fns file options))]
|
||||
(-> queries
|
||||
(update :snips (fnil into {}) (mapv try-snip snips))
|
||||
(update :fns (fnil into {}) (mapv try-query fns)))))
|
||||
{}
|
||||
filenames)))
|
||||
|
||||
(defn intern-fn [ns id meta f]
|
||||
(intern ns (with-meta (symbol (name id)) meta) f))
|
||||
|
||||
(defmacro bind-connection [conn & filenames]
|
||||
`(let [{snips# :snips fns# :fns :as queries#} (conman.core/load-queries ~@filenames)]
|
||||
(doseq [[id# {fn# :fn meta# :meta}] snips#]
|
||||
(conman.core/intern-fn *ns* id# meta# fn#))
|
||||
(doseq [[id# {query# :fn meta# :meta}] fns#]
|
||||
(conman.core/intern-fn *ns* id#
|
||||
;; Need to explicitly set :arglists since we don't use defn.
|
||||
;; Another option would be to generate defns.
|
||||
(assoc meta#
|
||||
:arglists (quote ~'([] [params] [db params options & command-options])))
|
||||
(fn f#
|
||||
([] (query# ~conn {}))
|
||||
([params#] (query# ~conn params#))
|
||||
([conn# params# & args#] (apply query# conn# params# args#)))))
|
||||
queries#))
|
||||
|
||||
(defmacro bind-connection-deref [conn & filenames]
|
||||
`(let [{snips# :snips fns# :fns :as queries#} (conman.core/load-queries ~@filenames)]
|
||||
(doseq [[id# {fn# :fn meta# :meta}] snips#]
|
||||
(conman.core/intern-fn *ns* id# meta# fn#))
|
||||
(doseq [[id# {query# :fn meta# :meta}] fns#]
|
||||
(conman.core/intern-fn *ns* id#
|
||||
(assoc meta#
|
||||
:arglists (quote ~'([] [params] [db params options & command-options])))
|
||||
(fn f#
|
||||
([] (query# (deref ~conn) {}))
|
||||
([params#] (query# (deref ~conn) params#))
|
||||
([conn# params# & args#] (apply query# conn# params# args#)))))
|
||||
queries#))
|
||||
|
||||
(defn bind-connection-map [conn & args]
|
||||
(-> (apply load-queries args)
|
||||
(update :snips
|
||||
(fn [snips]
|
||||
(reduce (fn [acc [id snip]] (assoc acc id snip)) {} snips)))
|
||||
(update :fns
|
||||
(fn [queries]
|
||||
(reduce
|
||||
(fn [acc [id query]]
|
||||
(assoc acc id
|
||||
(update query
|
||||
:fn
|
||||
(fn [query]
|
||||
(fn fn#
|
||||
([] (query conn {}))
|
||||
([params]
|
||||
(query conn params))
|
||||
([conn params & args] (apply query conn params args)))))))
|
||||
{}
|
||||
queries)))))
|
||||
|
||||
(defn find-fn [connection-map query-type k]
|
||||
(or (get-in connection-map [query-type k :fn])
|
||||
(throw (IllegalArgumentException.
|
||||
(str (if (= query-type :snips) "no snippet" "no query")
|
||||
" found for the key: " k
|
||||
"', available queries: " (keys (get connection-map query-type)))))))
|
||||
|
||||
(defn snip [connection-map snip-key & args]
|
||||
"runs a SQL query snippet
|
||||
queries - a map of queries
|
||||
id - keyword indicating the name of the query
|
||||
args - arguments that will be passed to the query"
|
||||
(apply (find-fn connection-map :snips snip-key) args))
|
||||
|
||||
(defn query
|
||||
"runs a database query and returns the result
|
||||
conn - database connection
|
||||
queries - a map of queries
|
||||
id - keyword indicating the name of the query
|
||||
args - arguments that will be passed to the query"
|
||||
([connection-map query-key]
|
||||
((find-fn connection-map :fns query-key)))
|
||||
([connection-map query-key params]
|
||||
((find-fn connection-map :fns query-key) params))
|
||||
([conn connection-map query-key params & opts]
|
||||
(apply (find-fn connection-map :fns query-key) conn params opts)))
|
||||
|
||||
(defn- format-url [pool-spec]
|
||||
(if (:jdbc-url pool-spec)
|
||||
(update pool-spec :jdbc-url to-jdbc-uri)
|
||||
pool-spec))
|
||||
|
||||
(defn make-config [{:keys [jdbc-url adapter datasource datasource-classname] :as pool-spec}]
|
||||
(when (not (or jdbc-url adapter datasource datasource-classname))
|
||||
(throw (Exception. "one of :jdbc-url, :adapter, :datasource, or :datasource-classname is required to initialize the connection!")))
|
||||
(-> pool-spec
|
||||
(format-url)
|
||||
(rename-keys
|
||||
{:auto-commit? :auto-commit
|
||||
:conn-timeout :connection-timeout
|
||||
:min-idle :minimum-idle
|
||||
:max-pool-size :maximum-pool-size})))
|
||||
|
||||
(defn connect!
|
||||
"attempts to create a new connection and set it as the value of the conn atom,
|
||||
does nothing if conn atom is already populated"
|
||||
[pool-spec]
|
||||
(make-datasource (make-config pool-spec)))
|
||||
|
||||
(defn disconnect!
|
||||
"checks if there's a connection and closes it
|
||||
resets the conn to nil"
|
||||
[conn]
|
||||
(when (and (instance? com.zaxxer.hikari.HikariDataSource conn)
|
||||
(not (.isClosed conn)))
|
||||
(.close conn)))
|
||||
|
||||
(defn reconnect!
|
||||
"calls disconnect! to ensure the connection is closed
|
||||
then calls connect! to establish a new connection"
|
||||
[conn pool-spec]
|
||||
(disconnect! conn)
|
||||
(connect! pool-spec))
|
||||
|
||||
(extend-protocol next.jdbc.protocols/Sourceable
|
||||
IDeref
|
||||
(get-datasource [this]
|
||||
(next.jdbc.protocols/get-datasource (deref this))))
|
||||
|
||||
(defmacro with-transaction
|
||||
"Runs the body in a transaction where t-conn is the name of the transaction connection.
|
||||
The body will be evaluated within a binding where conn is set to the transactional
|
||||
connection. The isolation level and readonly status of the transaction may also be specified.
|
||||
(with-transaction [conn {:isolation level :read-only? true}]
|
||||
... t-conn ...)
|
||||
See next.jdbc/transact for more details on the semantics of the :isolation and
|
||||
:read-only options."
|
||||
[[dbsym & opts] & body]
|
||||
`(if (instance? IDeref ~dbsym)
|
||||
(next.jdbc/with-transaction [t-conn# (deref ~dbsym) ~@opts]
|
||||
(binding [~dbsym (delay t-conn#)]
|
||||
~@body))
|
||||
(next.jdbc/with-transaction [t-conn# ~dbsym ~@opts]
|
||||
(binding [~dbsym t-conn#]
|
||||
~@body))))
|
||||
@@ -1,43 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
set -euo pipefail
|
||||
|
||||
HOST="${ELPRICE_DEPLOY_HOST:-citadel}"
|
||||
APP_DIR="${ELPRICE_DEPLOY_DIR:-/home/pmp/apps/elprice}"
|
||||
IMAGE_NAME="${ELPRICE_IMAGE_NAME:-$(basename "$APP_DIR")-app:latest}"
|
||||
PLATFORM="${ELPRICE_PLATFORM:-}"
|
||||
FILES=(docker-compose.yml .env .token)
|
||||
|
||||
if [[ -z "$PLATFORM" ]]; then
|
||||
remote_arch="$(ssh "$HOST" uname -m)"
|
||||
case "$remote_arch" in
|
||||
x86_64 | amd64) PLATFORM="linux/amd64" ;;
|
||||
aarch64 | arm64) PLATFORM="linux/arm64" ;;
|
||||
*)
|
||||
echo "Unsupported target architecture: $remote_arch" >&2
|
||||
echo "Set ELPRICE_PLATFORM manually, e.g. ELPRICE_PLATFORM=linux/amd64" >&2
|
||||
exit 1
|
||||
;;
|
||||
esac
|
||||
fi
|
||||
|
||||
for file in "${FILES[@]}"; do
|
||||
if [[ ! -f "$file" ]]; then
|
||||
echo "Missing required file: $file" >&2
|
||||
exit 1
|
||||
fi
|
||||
done
|
||||
|
||||
echo "Building $IMAGE_NAME locally for $PLATFORM..."
|
||||
docker build --platform "$PLATFORM" -t "$IMAGE_NAME" .
|
||||
|
||||
echo "Preparing $APP_DIR on $HOST..."
|
||||
ssh "$HOST" "mkdir -p '$APP_DIR'"
|
||||
|
||||
echo "Copying docker-compose.yml, .env, and .token to $HOST:$APP_DIR..."
|
||||
scp "${FILES[@]}" "$HOST:$APP_DIR/"
|
||||
|
||||
echo "Copying Docker image $IMAGE_NAME to $HOST..."
|
||||
docker save "$IMAGE_NAME" | ssh "$HOST" docker load
|
||||
|
||||
echo "Starting docker compose on $HOST in $APP_DIR..."
|
||||
ssh "$HOST" "cd '$APP_DIR' && docker compose up -d --no-build"
|
||||
@@ -1,70 +0,0 @@
|
||||
{:paths ["src/clj"
|
||||
"resources"]
|
||||
|
||||
:deps {org.clojure/clojure {:mvn/version "1.12.3"}
|
||||
|
||||
;; Routing
|
||||
metosin/reitit {:mvn/version "0.9.2"}
|
||||
|
||||
;; Ring
|
||||
metosin/ring-http-response {:mvn/version "0.9.5"}
|
||||
ring/ring-core {:mvn/version "1.15.3"}
|
||||
ring/ring-defaults {:mvn/version "0.7.0"}
|
||||
|
||||
;; Logging
|
||||
ch.qos.logback/logback-classic {:mvn/version "1.5.20"}
|
||||
|
||||
;; Data coercion
|
||||
luminus-transit/luminus-transit {:mvn/version "0.1.6"
|
||||
:exclusions [com.cognitect/transit-clj]}
|
||||
metosin/muuntaja {:mvn/version "0.6.11"}
|
||||
|
||||
;; kit Libs
|
||||
io.github.kit-clj/kit-core {:mvn/version "1.0.9"}
|
||||
io.github.kit-clj/kit-undertow {:mvn/version "1.0.10"}
|
||||
io.github.kit-clj/kit-postgres {:mvn/version "1.0.7"}
|
||||
io.github.kit-clj/kit-sql-conman {:mvn/version "1.10.5"}
|
||||
io.github.kit-clj/kit-sql-migratus {:mvn/version "1.0.5"}
|
||||
hiccup/hiccup {:mvn/version "2.0.0"}
|
||||
org.clojure/data.json {:mvn/version "2.5.1"}}
|
||||
:aliases {:build {:deps {io.github.clojure/tools.build {:mvn/version "0.10.11"}}
|
||||
:ns-default build}
|
||||
|
||||
|
||||
:dev {:extra-deps {com.lambdaisland/classpath {:mvn/version "0.6.58"}
|
||||
criterium/criterium {:mvn/version "0.4.6"}
|
||||
expound/expound {:mvn/version "0.9.0"}
|
||||
integrant/repl {:mvn/version "0.5.0"}
|
||||
mvxcvi/cljstyle {:mvn/version "0.17.642"}
|
||||
pjstadig/humane-test-output {:mvn/version "0.11.0"}
|
||||
ring/ring-devel {:mvn/version "1.15.3"}
|
||||
ring/ring-mock {:mvn/version "0.6.2"}
|
||||
io.github.kit-clj/kit-generator {:mvn/version "0.2.5"}
|
||||
org.clojure/tools.namespace {:mvn/version "1.5.0"}
|
||||
}
|
||||
:extra-paths ["env/dev/clj" "env/dev/resources" "test/clj"]}
|
||||
:nrepl {:extra-deps {nrepl/nrepl {:mvn/version "1.5.1"}}
|
||||
:main-opts ["-m" "nrepl.cmdline" "-i"]}
|
||||
:cider {:extra-deps {nrepl/nrepl {:mvn/version "1.5.1"}
|
||||
cider/cider-nrepl {:mvn/version "0.58.0"}}
|
||||
:main-opts ["-m" "nrepl.cmdline" "--middleware" "[cider.nrepl/cider-middleware]" "-i"]}
|
||||
|
||||
:test {:extra-deps {criterium/criterium {:mvn/version "0.4.6"}
|
||||
expound/expound {:mvn/version "0.9.0"}
|
||||
integrant/repl {:mvn/version "0.5.0"}
|
||||
io.github.cognitect-labs/test-runner {:git/url "https://github.com/cognitect-labs/test-runner.git"
|
||||
:git/tag "v0.5.1"
|
||||
:git/sha "dfb30dd"}
|
||||
pjstadig/humane-test-output {:mvn/version "0.11.0"}
|
||||
ring/ring-devel {:mvn/version "1.15.3"}
|
||||
ring/ring-mock {:mvn/version "0.6.2"}
|
||||
io.github.kit-clj/kit-generator {:mvn/version "0.2.5"}
|
||||
org.clojure/tools.namespace {:mvn/version "1.5.0"}
|
||||
peridot/peridot {:mvn/version "0.5.4"}
|
||||
org.clj-commons/byte-streams {:mvn/version "0.3.4"}
|
||||
com.lambdaisland/classpath {:mvn/version "0.6.58"}}
|
||||
:exec-fn cognitect.test-runner.api/test
|
||||
:extra-paths ["env/dev/clj" "env/dev/resources" "env/test/resources" "test/clj"]
|
||||
:main-opts ["-e" "(require 'pjstadig.humane-test-output) (pjstadig.humane-test-output/activate!)"
|
||||
"-m" "cognitect.test-runner"]}}
|
||||
}
|
||||
@@ -1,10 +0,0 @@
|
||||
services:
|
||||
app:
|
||||
build: .
|
||||
ports:
|
||||
- "3030:3030"
|
||||
env_file:
|
||||
- .env
|
||||
volumes:
|
||||
- ./.token:/app/.token:ro
|
||||
restart: unless-stopped
|
||||
@@ -1,5 +0,0 @@
|
||||
(ns pmagnus.elprice.dev-middleware)
|
||||
|
||||
(defn wrap-dev [handler _opts]
|
||||
(-> handler
|
||||
))
|
||||
Vendored
-14
@@ -1,14 +0,0 @@
|
||||
(ns pmagnus.elprice.env
|
||||
(:require
|
||||
[clojure.tools.logging :as log]
|
||||
[pmagnus.elprice.dev-middleware :refer [wrap-dev]]))
|
||||
|
||||
(def defaults
|
||||
{:init (fn []
|
||||
(log/info "\n-=[elprice starting using the development or test profile]=-"))
|
||||
:start (fn []
|
||||
(log/info "\n-=[elprice started successfully using the development or test profile]=-"))
|
||||
:stop (fn []
|
||||
(log/info "\n-=[elprice has shut down successfully]=-"))
|
||||
:middleware wrap-dev
|
||||
:opts {:profile :dev}})
|
||||
Vendored
-59
@@ -1,59 +0,0 @@
|
||||
(ns user
|
||||
"Userspace functions you can run by default in your local REPL."
|
||||
(:require
|
||||
[clojure.pprint]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.tools.namespace.repl :as repl]
|
||||
[criterium.core :as c] ;; benchmarking
|
||||
[expound.alpha :as expound]
|
||||
[integrant.core :as ig]
|
||||
[integrant.repl :refer [clear go halt prep init reset reset-all]]
|
||||
[integrant.repl.state :as state]
|
||||
[kit.api :as kit]
|
||||
[lambdaisland.classpath.watch-deps :as watch-deps] ;; hot loading for deps
|
||||
[pmagnus.elprice.core :refer [start-app]]))
|
||||
|
||||
;; uncomment to enable hot loading for deps
|
||||
(watch-deps/start! {:aliases [:dev :test]})
|
||||
|
||||
(alter-var-root #'s/*explain-out* (constantly expound/printer))
|
||||
|
||||
(add-tap (bound-fn* clojure.pprint/pprint))
|
||||
|
||||
(defn dev-prep!
|
||||
[]
|
||||
(integrant.repl/set-prep! (fn []
|
||||
(-> (pmagnus.elprice.config/system-config {:profile :dev})
|
||||
(ig/expand)))))
|
||||
|
||||
(defn test-prep!
|
||||
[]
|
||||
(integrant.repl/set-prep! (fn []
|
||||
(-> (pmagnus.elprice.config/system-config {:profile :test})
|
||||
(ig/expand)))))
|
||||
|
||||
;; Can change this to test-prep! if want to run tests as the test profile in your repl
|
||||
;; You can run tests in the dev profile, too, but there are some differences between
|
||||
;; the two profiles.
|
||||
(dev-prep!)
|
||||
|
||||
(repl/set-refresh-dirs "src/clj")
|
||||
|
||||
(def refresh repl/refresh)
|
||||
|
||||
|
||||
(defn reset-db []
|
||||
(migratus.core/reset (:db.sql/migrations state/system)))
|
||||
|
||||
(defn rollback []
|
||||
(migratus.core/rollback (:db.sql/migrations state/system)))
|
||||
|
||||
(defn migrate []
|
||||
(migratus.core/migrate (:db.sql/migrations state/system)))
|
||||
|
||||
(def query-fn (:db.sql/query-fn state/system))
|
||||
|
||||
|
||||
(comment
|
||||
(go)
|
||||
(reset))
|
||||
Vendored
-38
@@ -1,38 +0,0 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<configuration scan="true" scanPeriod="10 seconds">
|
||||
<statusListener class="ch.qos.logback.core.status.NopStatusListener" />
|
||||
<appender name="STDOUT" class="ch.qos.logback.core.ConsoleAppender">
|
||||
<!-- encoders are assigned the type
|
||||
ch.qos.logback.classic.encoder.PatternLayoutEncoder by default -->
|
||||
<encoder>
|
||||
<charset>UTF-8</charset>
|
||||
<pattern>%date{ISO8601} [%thread] %-5level %logger{36} - %msg %n</pattern>
|
||||
</encoder>
|
||||
</appender>
|
||||
<appender name="FILE" class="ch.qos.logback.core.rolling.RollingFileAppender">
|
||||
<file>log/pmagnus.elprice.log</file>
|
||||
<rollingPolicy class="ch.qos.logback.core.rolling.TimeBasedRollingPolicy">
|
||||
<fileNamePattern>log/pmagnus.elprice.%d{yyyy-MM-dd}.%i.log</fileNamePattern>
|
||||
<timeBasedFileNamingAndTriggeringPolicy class="ch.qos.logback.core.rolling.SizeAndTimeBasedFNATP">
|
||||
<maxFileSize>100MB</maxFileSize>
|
||||
</timeBasedFileNamingAndTriggeringPolicy>
|
||||
<!-- keep 30 days of history -->
|
||||
<maxHistory>30</maxHistory>
|
||||
</rollingPolicy>
|
||||
<encoder>
|
||||
<charset>UTF-8</charset>
|
||||
<pattern>%date{ISO8601} [%thread] %-5level %logger{36} - %msg %n</pattern>
|
||||
</encoder>
|
||||
</appender>
|
||||
<logger name="org.eclipse.aether" level="warn" />
|
||||
<logger name="io.methvin.watcher" level="warn" />
|
||||
<logger name="org.eclipse.jgit" level="warn" />
|
||||
<logger name="com.zaxxer.hikari" level="warn" />
|
||||
<logger name="org.apache.http" level="warn" />
|
||||
<logger name="org.xnio.nio" level="warn" />
|
||||
<logger name="io.undertow" level="warn" />
|
||||
<root level="DEBUG">
|
||||
<appender-ref ref="STDOUT" />
|
||||
<appender-ref ref="FILE" />
|
||||
</root>
|
||||
</configuration>
|
||||
Vendored
-12
@@ -1,12 +0,0 @@
|
||||
(ns pmagnus.elprice.env
|
||||
(:require [clojure.tools.logging :as log]))
|
||||
|
||||
(def defaults
|
||||
{:init (fn []
|
||||
(log/info "\n-=[elprice starting]=-"))
|
||||
:start (fn []
|
||||
(log/info "\n-=[elprice started successfully]=-"))
|
||||
:stop (fn []
|
||||
(log/info "\n-=[elprice has shut down successfully]=-"))
|
||||
:middleware (fn [handler _] handler)
|
||||
:opts {:profile :prod}})
|
||||
Vendored
-16
@@ -1,16 +0,0 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<configuration>
|
||||
<statusListener class="ch.qos.logback.core.status.NopStatusListener" />
|
||||
<appender name="STDOUT" class="ch.qos.logback.core.ConsoleAppender">
|
||||
<encoder>
|
||||
<pattern>%-5relative %-5level %logger{35} - %msg%n</pattern>
|
||||
</encoder>
|
||||
</appender>
|
||||
<logger name="com.zaxxer.hikari" level="error" />
|
||||
<logger name="org.apache.http" level="error" />
|
||||
<logger name="org.xnio.nio" level="error" />
|
||||
<logger name="io.undertow" level="error" />
|
||||
<root level="INFO">
|
||||
<appender-ref ref="STDOUT" />
|
||||
</root>
|
||||
</configuration>
|
||||
Vendored
-16
@@ -1,16 +0,0 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<configuration>
|
||||
<statusListener class="ch.qos.logback.core.status.NopStatusListener" />
|
||||
<appender name="STDOUT" class="ch.qos.logback.core.ConsoleAppender">
|
||||
<encoder>
|
||||
<pattern>%-5relative %-5level %logger{35} - %msg%n</pattern>
|
||||
</encoder>
|
||||
</appender>
|
||||
<logger name="com.zaxxer.hikari" level="error" />
|
||||
<logger name="org.apache.http" level="error" />
|
||||
<logger name="org.xnio.nio" level="error" />
|
||||
<logger name="io.undertow" level="error" />
|
||||
<root level="INFO">
|
||||
<appender-ref ref="STDOUT" />
|
||||
</root>
|
||||
</configuration>
|
||||
@@ -1,13 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
# Kill any process listening on port 3000.
|
||||
# Usage: ./kill-server.sh
|
||||
set -euo pipefail
|
||||
|
||||
pids=$(lsof -ti:3000 2>/dev/null || true)
|
||||
|
||||
if [ -z "$pids" ]; then
|
||||
echo "No process on port 3000"
|
||||
else
|
||||
echo "$pids" | xargs kill
|
||||
echo "Killed: $pids"
|
||||
fi
|
||||
@@ -1,8 +0,0 @@
|
||||
{:full-name "pmagnus/elprice"
|
||||
:ns-name "pmagnus.elprice"
|
||||
:sanitized "pmagnus/elprice"
|
||||
:name "elprice"
|
||||
:modules {:root "modules"
|
||||
:repositories [{:url "https://github.com/kit-clj/modules.git"
|
||||
:tag "master"
|
||||
:name "kit-modules"}]}}
|
||||
@@ -1,70 +0,0 @@
|
||||
(ns kit.edge.db.postgres
|
||||
(:require
|
||||
[cheshire.core :as cheshire]
|
||||
[next.jdbc]
|
||||
[next.jdbc.prepare :as prepare]
|
||||
[next.jdbc.result-set :as result-set])
|
||||
(:import
|
||||
[clojure.lang IPersistentMap IPersistentVector]
|
||||
[java.sql Array PreparedStatement Timestamp]
|
||||
[java.time Instant LocalDate LocalDateTime]
|
||||
[org.postgresql.util PGobject]))
|
||||
|
||||
(def ->json cheshire/generate-string)
|
||||
(def <-json #(cheshire/parse-string % true))
|
||||
|
||||
(defn ->pgobject
|
||||
"Transforms Clojure data to a PGobject that contains the data as
|
||||
JSON. PGObject type defaults to `jsonb` but can be changed via
|
||||
metadata key `:pgtype`"
|
||||
[x]
|
||||
(let [pgtype (:pgtype (meta x) "jsonb")]
|
||||
(doto (PGobject.)
|
||||
(.setType pgtype)
|
||||
(.setValue (->json x)))))
|
||||
|
||||
(defn <-pgobject
|
||||
"Transform PGobject containing `json` or `jsonb` value to Clojure data"
|
||||
[^PGobject v]
|
||||
(let [type (.getType v)
|
||||
value (.getValue v)]
|
||||
(if (#{"jsonb" "json"} type)
|
||||
(when value
|
||||
(with-meta (<-json value) {:pgtype type}))
|
||||
value)))
|
||||
|
||||
(extend-protocol result-set/ReadableColumn
|
||||
Array
|
||||
(read-column-by-label [^Array v _] (vec (.getArray v)))
|
||||
(read-column-by-index [^Array v _2 _3] (vec (.getArray v)))
|
||||
|
||||
PGobject
|
||||
(read-column-by-label [^PGobject v _] (<-pgobject v))
|
||||
(read-column-by-index [^PGobject v _2 _3] (<-pgobject v)))
|
||||
|
||||
(extend-protocol prepare/SettableParameter
|
||||
Instant
|
||||
(set-parameter [^Instant v ^PreparedStatement ps ^long i]
|
||||
(.setTimestamp ps i (Timestamp/from v)))
|
||||
|
||||
LocalDate
|
||||
(set-parameter [^LocalDate v ^PreparedStatement ps ^long i]
|
||||
(.setTimestamp ps i (Timestamp/valueOf (.atStartOfDay v))))
|
||||
|
||||
LocalDateTime
|
||||
(set-parameter [^LocalDateTime v ^PreparedStatement ps ^long i]
|
||||
(.setTimestamp ps i (Timestamp/valueOf v)))
|
||||
|
||||
IPersistentMap
|
||||
(set-parameter [m ^PreparedStatement s i]
|
||||
(.setObject s i (->pgobject m)))
|
||||
|
||||
IPersistentVector
|
||||
(set-parameter [^clojure.lang.IPersistentVector v ^java.sql.PreparedStatement stmt ^long idx]
|
||||
(let [conn (.getConnection stmt)
|
||||
meta (.getParameterMetaData stmt)
|
||||
type-name (.getParameterTypeName meta idx)]
|
||||
(if-let [elem-type (when (= (first type-name) \_)
|
||||
(apply str (rest type-name)))]
|
||||
(.setObject stmt idx (.createArrayOf conn elem-type (to-array v)))
|
||||
(.setObject stmt idx (->pgobject v))))))
|
||||
@@ -1,59 +0,0 @@
|
||||
(ns kit.edge.db.sql.conman
|
||||
(:require
|
||||
[clojure.tools.logging :as log]
|
||||
[conman.core :as conman]
|
||||
[integrant.core :as ig]
|
||||
[kit.ig-utils :as ig-utils]))
|
||||
|
||||
(defmethod ig/init-key :db.sql/connection
|
||||
[_ pool-spec]
|
||||
(conman/connect! pool-spec))
|
||||
|
||||
(defmethod ig/suspend-key! :db.sql/connection [_ _])
|
||||
|
||||
(defmethod ig/halt-key! :db.sql/connection
|
||||
[_ conn]
|
||||
(conman/disconnect! conn))
|
||||
|
||||
(defmethod ig/resume-key :db.sql/connection
|
||||
[key opts old-opts old-impl]
|
||||
(ig-utils/resume-handler key opts old-opts old-impl))
|
||||
|
||||
(defn queries-dev [load-queries]
|
||||
(fn
|
||||
([query params]
|
||||
(conman/query (load-queries) query params))
|
||||
([conn query params & opts]
|
||||
(conman/query conn (load-queries) query params opts))))
|
||||
|
||||
(defn queries-prod [load-queries]
|
||||
(let [queries (load-queries)]
|
||||
(fn
|
||||
([query params]
|
||||
(conman/query queries query params))
|
||||
([conn query params & opts]
|
||||
(conman/query conn queries query params opts)))))
|
||||
|
||||
(defmethod ig/init-key :db.sql/query-fn
|
||||
[_ {:keys [conn options filename filenames env]
|
||||
:or {options {}}}]
|
||||
(let [filenames (or filenames [filename])
|
||||
load-queries #(apply conman/bind-connection-map conn options filenames)]
|
||||
(with-meta
|
||||
(if (= env :dev)
|
||||
(queries-dev load-queries)
|
||||
(queries-prod load-queries))
|
||||
{:mtimes (mapv ig-utils/last-modified filenames)})))
|
||||
|
||||
(defmethod ig/suspend-key! :db.sql/query-fn [_ _])
|
||||
|
||||
(defmethod ig/resume-key :db.sql/query-fn
|
||||
[k {:keys [filename filenames] :as opts} old-opts old-impl]
|
||||
(let [check-res (and (= opts old-opts)
|
||||
(= (mapv ig-utils/last-modified (or filenames [filename]))
|
||||
(:mtimes (meta old-impl))))]
|
||||
(log/info k "resume check. Same?" check-res)
|
||||
(if check-res
|
||||
old-impl
|
||||
(do (ig/halt-key! k old-impl)
|
||||
(ig/init-key k opts)))))
|
||||
Generated
-1055
File diff suppressed because it is too large
Load Diff
@@ -1,21 +0,0 @@
|
||||
{
|
||||
"name": "elprice",
|
||||
"version": "1.0.0",
|
||||
"description": "Start a [REPL](#repls) in your editor or terminal of choice.",
|
||||
"main": "index.js",
|
||||
"directories": {
|
||||
"test": "test"
|
||||
},
|
||||
"scripts": {
|
||||
"css:build": "npx @tailwindcss/cli -i resources/css/input.css -o resources/public/css/output.css --minify",
|
||||
"css:watch": "npx @tailwindcss/cli -i resources/css/input.css -o resources/public/css/output.css --watch"
|
||||
},
|
||||
"keywords": [],
|
||||
"author": "",
|
||||
"license": "ISC",
|
||||
"type": "commonjs",
|
||||
"devDependencies": {
|
||||
"@tailwindcss/cli": "^4.1.18",
|
||||
"tailwindcss": "^4.1.18"
|
||||
}
|
||||
}
|
||||
@@ -1,2 +0,0 @@
|
||||
@import "tailwindcss";
|
||||
@source "../../src/**/*.clj";
|
||||
@@ -1 +0,0 @@
|
||||
DROP TABLE IF EXISTS day_ahead_prices;
|
||||
@@ -1,8 +0,0 @@
|
||||
CREATE TABLE day_ahead_prices (
|
||||
time_utc TIMESTAMPTZ NOT NULL,
|
||||
time_dk TIMESTAMP NOT NULL,
|
||||
price_area VARCHAR(3) NOT NULL,
|
||||
price_dkk NUMERIC(10,2),
|
||||
price_eur NUMERIC(10,6),
|
||||
PRIMARY KEY (time_utc, price_area)
|
||||
);
|
||||
@@ -1 +0,0 @@
|
||||
DROP INDEX IF EXISTS idx_day_ahead_prices_time_dk_area;
|
||||
@@ -1 +0,0 @@
|
||||
CREATE UNIQUE INDEX idx_day_ahead_prices_time_dk_area ON day_ahead_prices (time_dk, price_area);
|
||||
@@ -1 +0,0 @@
|
||||
DROP TABLE IF EXISTS metering_points;
|
||||
@@ -1,15 +0,0 @@
|
||||
CREATE TABLE metering_points (
|
||||
metering_point_id VARCHAR(18) PRIMARY KEY,
|
||||
type_of_mp VARCHAR(50),
|
||||
balance_supplier VARCHAR(100),
|
||||
street_name VARCHAR(200),
|
||||
building_number VARCHAR(20),
|
||||
postcode VARCHAR(10),
|
||||
city_name VARCHAR(100),
|
||||
has_relation BOOLEAN,
|
||||
settlement_method VARCHAR(50),
|
||||
reading_occurrence VARCHAR(50),
|
||||
consumer_start_date DATE,
|
||||
first_consumer_name VARCHAR(200),
|
||||
fetched_at TIMESTAMPTZ NOT NULL DEFAULT now()
|
||||
);
|
||||
@@ -1 +0,0 @@
|
||||
DROP TABLE IF EXISTS meter_readings;
|
||||
@@ -1,9 +0,0 @@
|
||||
CREATE TABLE meter_readings (
|
||||
metering_point_id VARCHAR(18) NOT NULL REFERENCES metering_points(metering_point_id),
|
||||
time_dk TIMESTAMP NOT NULL,
|
||||
quantity_kwh NUMERIC(10,3),
|
||||
quality VARCHAR(50),
|
||||
PRIMARY KEY (metering_point_id, time_dk)
|
||||
);
|
||||
--;;
|
||||
CREATE INDEX idx_meter_readings_time_dk ON meter_readings(time_dk);
|
||||
@@ -1 +0,0 @@
|
||||
DROP TABLE IF EXISTS charges;
|
||||
@@ -1,16 +0,0 @@
|
||||
CREATE TABLE charges (
|
||||
id SERIAL,
|
||||
metering_point_id VARCHAR(18) NOT NULL REFERENCES metering_points(metering_point_id),
|
||||
charge_type VARCHAR(20) NOT NULL,
|
||||
name VARCHAR(200) NOT NULL,
|
||||
description VARCHAR(500),
|
||||
owner VARCHAR(100) NOT NULL,
|
||||
valid_from_date DATE NOT NULL,
|
||||
valid_to_date DATE,
|
||||
period_type VARCHAR(50),
|
||||
price NUMERIC(12,6),
|
||||
quantity INTEGER,
|
||||
position INTEGER NOT NULL DEFAULT 0,
|
||||
fetched_at TIMESTAMPTZ NOT NULL DEFAULT now(),
|
||||
UNIQUE (metering_point_id, charge_type, name, owner, valid_from_date, position)
|
||||
);
|
||||
@@ -1 +0,0 @@
|
||||
DROP TABLE production;
|
||||
@@ -1,6 +0,0 @@
|
||||
CREATE TABLE production (
|
||||
time_start TIMESTAMPTZ NOT NULL,
|
||||
hour INTEGER NOT NULL,
|
||||
kwh DOUBLE PRECISION,
|
||||
PRIMARY KEY (time_start, hour)
|
||||
);
|
||||
@@ -1 +0,0 @@
|
||||
DROP TABLE consumption;
|
||||
@@ -1,6 +0,0 @@
|
||||
CREATE TABLE consumption (
|
||||
time_start TIMESTAMPTZ NOT NULL,
|
||||
hour INTEGER NOT NULL,
|
||||
kwh DOUBLE PRECISION,
|
||||
PRIMARY KEY (time_start, hour)
|
||||
);
|
||||
@@ -1 +0,0 @@
|
||||
DROP TABLE solar;
|
||||
@@ -1,10 +0,0 @@
|
||||
CREATE TABLE solar (
|
||||
period_start TIMESTAMPTZ PRIMARY KEY,
|
||||
pv_yield_kwh DOUBLE PRECISION NOT NULL,
|
||||
inverter_yield_kwh DOUBLE PRECISION NOT NULL,
|
||||
export_kwh DOUBLE PRECISION NOT NULL,
|
||||
import_kwh DOUBLE PRECISION NOT NULL,
|
||||
charge_kwh DOUBLE PRECISION NOT NULL,
|
||||
discharge_kwh DOUBLE PRECISION NOT NULL,
|
||||
revenue_eur DOUBLE PRECISION NOT NULL
|
||||
);
|
||||
@@ -1 +0,0 @@
|
||||
DROP TABLE elprice;
|
||||
@@ -1,6 +0,0 @@
|
||||
CREATE TABLE elprice (
|
||||
time_dk TIMESTAMP NOT NULL,
|
||||
price_area VARCHAR(3) NOT NULL,
|
||||
price_dkk NUMERIC(10,2) NOT NULL,
|
||||
PRIMARY KEY (time_dk, price_area)
|
||||
);
|
||||
@@ -1,3 +0,0 @@
|
||||
ALTER TABLE elprice DROP COLUMN total_dkk;
|
||||
--;;
|
||||
ALTER TABLE elprice DROP COLUMN tariff_dkk;
|
||||
@@ -1,21 +0,0 @@
|
||||
ALTER TABLE elprice ADD COLUMN tariff_dkk NUMERIC(10,2);
|
||||
--;;
|
||||
ALTER TABLE elprice ADD COLUMN total_dkk NUMERIC(10,2);
|
||||
--;;
|
||||
UPDATE elprice
|
||||
SET tariff_dkk = CASE
|
||||
WHEN EXTRACT(MONTH FROM time_dk) BETWEEN 4 AND 9 THEN
|
||||
CASE
|
||||
WHEN EXTRACT(HOUR FROM time_dk) < 6 THEN 109.80
|
||||
WHEN EXTRACT(HOUR FROM time_dk) >= 17 AND EXTRACT(HOUR FROM time_dk) < 21 THEN 428.30
|
||||
ELSE 164.70
|
||||
END
|
||||
ELSE
|
||||
CASE
|
||||
WHEN EXTRACT(HOUR FROM time_dk) < 6 THEN 109.80
|
||||
WHEN EXTRACT(HOUR FROM time_dk) >= 17 AND EXTRACT(HOUR FROM time_dk) < 21 THEN 988.40
|
||||
ELSE 329.50
|
||||
END
|
||||
END;
|
||||
--;;
|
||||
UPDATE elprice SET total_dkk = price_dkk + tariff_dkk WHERE tariff_dkk IS NOT NULL;
|
||||
@@ -1,2 +0,0 @@
|
||||
CREATE UNIQUE INDEX IF NOT EXISTS idx_day_ahead_prices_time_dk_area
|
||||
ON day_ahead_prices (time_dk, price_area);
|
||||
@@ -1 +0,0 @@
|
||||
DROP INDEX IF EXISTS idx_day_ahead_prices_time_dk_area;
|
||||
@@ -1 +0,0 @@
|
||||
See https://github.com/yogthos/migratus
|
||||
@@ -1,97 +0,0 @@
|
||||
-- :name insert-price! :! :n
|
||||
-- :doc Insert/update a day-ahead price record
|
||||
INSERT INTO day_ahead_prices (time_utc, time_dk, price_area, price_dkk, price_eur)
|
||||
VALUES (:time-utc, :time-dk, :price-area, :price-dkk, :price-eur)
|
||||
ON CONFLICT (time_utc, price_area) DO UPDATE SET
|
||||
time_dk = EXCLUDED.time_dk,
|
||||
price_dkk = EXCLUDED.price_dkk,
|
||||
price_eur = EXCLUDED.price_eur;
|
||||
|
||||
-- :name get-prices-for-date :? :*
|
||||
-- :doc Get all prices for a given date (time_dk local date) and price area
|
||||
SELECT time_utc, time_dk, price_area, price_dkk, price_eur
|
||||
FROM day_ahead_prices
|
||||
WHERE time_dk::date = :date
|
||||
AND price_area = :price-area
|
||||
ORDER BY time_dk;
|
||||
|
||||
-- :name upsert-metering-point! :! :n
|
||||
-- :doc Upsert a metering point, refreshing data on re-sync
|
||||
INSERT INTO metering_points (metering_point_id, type_of_mp, balance_supplier, street_name,
|
||||
building_number, postcode, city_name, has_relation, settlement_method,
|
||||
reading_occurrence, consumer_start_date, first_consumer_name)
|
||||
VALUES (:metering-point-id, :type-of-mp, :balance-supplier, :street-name,
|
||||
:building-number, :postcode, :city-name, :has-relation, :settlement-method,
|
||||
:reading-occurrence, :consumer-start-date, :first-consumer-name)
|
||||
ON CONFLICT (metering_point_id) DO UPDATE SET
|
||||
type_of_mp = EXCLUDED.type_of_mp,
|
||||
balance_supplier = EXCLUDED.balance_supplier,
|
||||
street_name = EXCLUDED.street_name,
|
||||
building_number = EXCLUDED.building_number,
|
||||
postcode = EXCLUDED.postcode,
|
||||
city_name = EXCLUDED.city_name,
|
||||
has_relation = EXCLUDED.has_relation,
|
||||
settlement_method = EXCLUDED.settlement_method,
|
||||
reading_occurrence = EXCLUDED.reading_occurrence,
|
||||
consumer_start_date = EXCLUDED.consumer_start_date,
|
||||
first_consumer_name = EXCLUDED.first_consumer_name,
|
||||
fetched_at = now();
|
||||
|
||||
-- :name insert-meter-reading! :! :n
|
||||
-- :doc Insert a meter reading, skip if already exists
|
||||
INSERT INTO meter_readings (metering_point_id, time_dk, quantity_kwh, quality)
|
||||
VALUES (:metering-point-id, :time-dk, :quantity-kwh, :quality)
|
||||
ON CONFLICT (metering_point_id, time_dk) DO NOTHING;
|
||||
|
||||
-- :name insert-charge! :! :n
|
||||
-- :doc Insert a charge record, skip if already exists
|
||||
INSERT INTO charges (metering_point_id, charge_type, name, description, owner,
|
||||
valid_from_date, valid_to_date, period_type, price, quantity, position)
|
||||
VALUES (:metering-point-id, :charge-type, :name, :description, :owner,
|
||||
:valid-from-date, :valid-to-date, :period-type, :price, :quantity, :position)
|
||||
ON CONFLICT (metering_point_id, charge_type, name, owner, valid_from_date, position) DO NOTHING;
|
||||
|
||||
-- :name count-consumption-for-date :? :1
|
||||
-- :doc Count consumption records for a given UTC time_start
|
||||
SELECT count(*) AS cnt
|
||||
FROM consumption
|
||||
WHERE time_start = :time-start;
|
||||
|
||||
-- :name count-production-for-date :? :1
|
||||
-- :doc Count production records for a given UTC time_start
|
||||
SELECT count(*) AS cnt
|
||||
FROM production
|
||||
WHERE time_start = :time-start;
|
||||
|
||||
-- :name count-meter-readings-for-date :? :1
|
||||
-- :doc Count meter readings for a given UTC time_start (converted to DK date range)
|
||||
SELECT count(*) AS cnt
|
||||
FROM meter_readings
|
||||
WHERE time_dk >= :from-dk AND time_dk < :to-dk;
|
||||
|
||||
-- :name insert-production! :! :n
|
||||
-- :doc Insert a production record, skip if already exists
|
||||
INSERT INTO production (time_start, hour, kwh)
|
||||
VALUES (:time-start, :hour, :kwh)
|
||||
ON CONFLICT (time_start, hour) DO NOTHING;
|
||||
|
||||
-- :name insert-consumption! :! :n
|
||||
-- :doc Insert a consumption record, skip if already exists
|
||||
INSERT INTO consumption (time_start, hour, kwh)
|
||||
VALUES (:time-start, :hour, :kwh)
|
||||
ON CONFLICT (time_start, hour) DO NOTHING;
|
||||
|
||||
-- :name insert-elprice! :! :n
|
||||
-- :doc Upsert an hourly el-price row; refresh tariff/total on conflict
|
||||
INSERT INTO elprice (time_dk, price_area, price_dkk, tariff_dkk, total_dkk)
|
||||
VALUES (:time-dk, :price-area, :price-dkk, :tariff-dkk, :total-dkk)
|
||||
ON CONFLICT (time_dk, price_area) DO UPDATE SET
|
||||
tariff_dkk = EXCLUDED.tariff_dkk,
|
||||
total_dkk = EXCLUDED.total_dkk;
|
||||
|
||||
-- :name get-elprice-for-date :? :*
|
||||
-- :doc Hourly prices for a DK local date, both areas
|
||||
SELECT time_dk, price_area, price_dkk, tariff_dkk, total_dkk
|
||||
FROM elprice
|
||||
WHERE time_dk::date = :date
|
||||
ORDER BY time_dk, price_area;
|
||||
@@ -1,94 +0,0 @@
|
||||
{:system/env
|
||||
#profile {:dev :dev
|
||||
:test :test
|
||||
:prod :prod}
|
||||
|
||||
:server/http
|
||||
{:port #long #or [#env PORT 3000]
|
||||
:host #or [#env HTTP_HOST "0.0.0.0"]
|
||||
:handler #ig/ref :handler/ring}
|
||||
|
||||
:handler/ring
|
||||
{:router #ig/ref :router/core
|
||||
:api-path "/api"
|
||||
:cookie-secret #or [#env COOKIE_SECRET "JJCILTOQLMYRBFRU"]
|
||||
;; from ring.middleware.defaults. anti-forgery `false` by default because services may not require it
|
||||
:site-defaults-config {:params {:urlencoded true
|
||||
:multipart true
|
||||
:nested true
|
||||
:keywordize true}
|
||||
:cookies true
|
||||
:session {:flash true
|
||||
:cookie-name "pmagnus.elprice"
|
||||
:cookie-attrs {:max-age 86400
|
||||
:http-only true
|
||||
:same-site :strict}}
|
||||
:security {:anti-forgery false
|
||||
:xss-protection {:enable? true,
|
||||
:mode :block}
|
||||
:frame-options :sameorigin
|
||||
:content-type-options :nosniff}
|
||||
:static {:resources "public"}
|
||||
:responses {:not-modified-responses true
|
||||
:absolute-redirects true
|
||||
:content-types true
|
||||
:default-charset "utf-8"}}}
|
||||
|
||||
:reitit.routes/api
|
||||
{:base-path "/api"
|
||||
:env #ig/ref :system/env
|
||||
:query-fn #ig/ref :db.sql/query-fn}
|
||||
|
||||
:router/routes
|
||||
{:routes #ig/refset :reitit/routes}
|
||||
|
||||
:router/core
|
||||
{:routes #ig/ref :router/routes
|
||||
:env #ig/ref :system/env}
|
||||
|
||||
:db.sql/connection
|
||||
#profile {:dev {:jdbc-url #or [#env JDBC_URL
|
||||
#join ["jdbc:postgresql://"
|
||||
#or [#env TARGET_HOST "localhost"]
|
||||
":"
|
||||
#or [#env TARGET_PORT "5432"]
|
||||
"/"
|
||||
#or [#env TARGET_DB "elprice"]]]
|
||||
:username #or [#env TARGET_USER "elprice"]
|
||||
:password #or [#env TARGET_PASSWORD "elprice"]}
|
||||
:test {:jdbc-url #or [#env JDBC_URL
|
||||
#join ["jdbc:postgresql://"
|
||||
#or [#env TARGET_HOST "localhost"]
|
||||
":"
|
||||
#or [#env TARGET_PORT "5432"]
|
||||
"/"
|
||||
#or [#env TARGET_DB "elprice"]]]
|
||||
:username #or [#env TARGET_USER "elprice"]
|
||||
:password #or [#env TARGET_PASSWORD "elprice"]}
|
||||
:prod {:jdbc-url #or [#env JDBC_URL
|
||||
#join ["jdbc:postgresql://"
|
||||
#or [#env TARGET_HOST "localhost"]
|
||||
":"
|
||||
#or [#env TARGET_PORT "5432"]
|
||||
"/"
|
||||
#or [#env TARGET_DB "elprice"]]]
|
||||
:username #or [#env TARGET_USER "elprice"]
|
||||
:password #or [#env TARGET_PASSWORD "elprice"]
|
||||
:init-size 1
|
||||
:min-idle 1
|
||||
:max-idle 8
|
||||
:max-active 32}}
|
||||
|
||||
:db.sql/query-fn
|
||||
{:conn #ig/ref :db.sql/connection
|
||||
:options {}
|
||||
:filename "queries.sql"
|
||||
:env #ig/ref :system/env}
|
||||
|
||||
:db.sql/migrations
|
||||
{:store :database
|
||||
:db {:datasource #ig/ref :db.sql/connection}
|
||||
:migrate-on-init? true}
|
||||
:reitit.routes/ui {:base-path "",
|
||||
:env #ig/ref :system/env
|
||||
:query-fn #ig/ref :db.sql/query-fn}}
|
||||
@@ -1,68 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
set -euo pipefail
|
||||
|
||||
# Run the app locally without Docker.
|
||||
# Loads environment variables from .env and the Eloverblik refresh token from .token.
|
||||
|
||||
ROOT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)"
|
||||
cd "$ROOT_DIR"
|
||||
|
||||
load_env_file() {
|
||||
local file="$1"
|
||||
|
||||
[[ -f "$file" ]] || return 0
|
||||
|
||||
while IFS= read -r line || [[ -n "$line" ]]; do
|
||||
# Trim CR from CRLF files.
|
||||
line="${line%$'\r'}"
|
||||
|
||||
# Skip blank lines and full-line comments.
|
||||
[[ -z "${line//[[:space:]]/}" || "$line" =~ ^[[:space:]]*# ]] && continue
|
||||
|
||||
# Allow lines prefixed with "export ".
|
||||
line="${line#export }"
|
||||
|
||||
local key="${line%%=*}"
|
||||
local value="${line#*=}"
|
||||
|
||||
# Trim whitespace around the key only; preserve value contents (e.g. JDBC_URL query strings).
|
||||
key="$(printf '%s' "$key" | xargs)"
|
||||
|
||||
if [[ ! "$key" =~ ^[A-Za-z_][A-Za-z0-9_]*$ || "$line" != *=* ]]; then
|
||||
echo "Skipping invalid env line in $file: $line" >&2
|
||||
continue
|
||||
fi
|
||||
|
||||
# Remove one matching pair of surrounding quotes, if present.
|
||||
if [[ "$value" =~ ^\".*\"$ || "$value" =~ ^\'.*\'$ ]]; then
|
||||
value="${value:1:${#value}-2}"
|
||||
fi
|
||||
|
||||
export "$key=$value"
|
||||
done < "$file"
|
||||
}
|
||||
|
||||
load_env_file ".env"
|
||||
|
||||
if [[ -f ".token" && -z "${ELOVERBLIK_TOKEN:-}" ]]; then
|
||||
ELOVERBLIK_TOKEN="$(tr -d '\r\n' < .token)"
|
||||
export ELOVERBLIK_TOKEN
|
||||
fi
|
||||
|
||||
: "${PORT:=3000}"
|
||||
export PORT
|
||||
|
||||
# Energi Data Service currently serves only the leaf certificate. Allow the JVM
|
||||
# to fetch missing intermediate CA certificates from the certificate AIA URL.
|
||||
export JAVA_TOOL_OPTIONS="${JAVA_TOOL_OPTIONS:-} -Dcom.sun.security.enableAIAcaIssuers=true"
|
||||
|
||||
echo "Starting elprice locally on port $PORT (no Docker)..."
|
||||
|
||||
# `clj` requires rlwrap for REPL command editing. Fall back to `clojure`
|
||||
# when rlwrap is not installed so the app can still start.
|
||||
if command -v rlwrap >/dev/null 2>&1; then
|
||||
exec clj -M:dev -e "(dev-prep!) (go)" -r
|
||||
else
|
||||
echo "rlwrap not found; using clojure instead of clj (REPL editing disabled)." >&2
|
||||
exec clojure -M:dev -e "(dev-prep!) (go)" -r
|
||||
fi
|
||||
@@ -1,11 +0,0 @@
|
||||
(ns pmagnus.elprice.config
|
||||
(:require
|
||||
[kit.config :as config]))
|
||||
|
||||
|
||||
(def ^:const system-filename "system.edn")
|
||||
|
||||
|
||||
(defn system-config
|
||||
[options]
|
||||
(config/read-config system-filename options))
|
||||
@@ -1,48 +0,0 @@
|
||||
(ns pmagnus.elprice.core
|
||||
(:gen-class)
|
||||
(:require
|
||||
[clojure.tools.logging :as log]
|
||||
[integrant.core :as ig]
|
||||
[kit.edge.db.postgres]
|
||||
;; Edges
|
||||
[kit.edge.db.sql.conman]
|
||||
[kit.edge.db.sql.migratus]
|
||||
[kit.edge.server.undertow]
|
||||
[pmagnus.elprice.config :as config]
|
||||
[pmagnus.elprice.env :refer [defaults]]
|
||||
[pmagnus.elprice.web.handler]
|
||||
;; Routes
|
||||
[pmagnus.elprice.web.routes.api]
|
||||
[pmagnus.elprice.web.routes.ui]))
|
||||
|
||||
|
||||
;; log uncaught exceptions in threads
|
||||
(Thread/setDefaultUncaughtExceptionHandler
|
||||
(fn [thread ex]
|
||||
(log/error {:what :uncaught-exception
|
||||
:exception ex
|
||||
:where (str "Uncaught exception on" (.getName thread))})))
|
||||
|
||||
|
||||
(defonce system (atom nil))
|
||||
|
||||
|
||||
(defn stop-app
|
||||
[]
|
||||
((or (:stop defaults) (fn [])))
|
||||
(some-> (deref system) (ig/halt!)))
|
||||
|
||||
|
||||
(defn start-app
|
||||
[& [params]]
|
||||
((or (:start params) (:start defaults) (fn [])))
|
||||
(->> (config/system-config (or (:opts params) (:opts defaults) {}))
|
||||
(ig/expand)
|
||||
(ig/init)
|
||||
(reset! system)))
|
||||
|
||||
|
||||
(defn -main
|
||||
[& _]
|
||||
(start-app)
|
||||
(.addShutdownHook (Runtime/getRuntime) (Thread. (fn [] (stop-app) (shutdown-agents)))))
|
||||
@@ -1,333 +0,0 @@
|
||||
(ns pmagnus.elprice.web.controllers.eloverblik
|
||||
(:require
|
||||
[clojure.data.json :as json]
|
||||
[clojure.string :as str]
|
||||
[clojure.tools.logging :as log])
|
||||
(:import
|
||||
(java.net
|
||||
URI)
|
||||
(java.net.http
|
||||
HttpClient
|
||||
HttpRequest
|
||||
HttpRequest$BodyPublishers
|
||||
HttpResponse$BodyHandlers)
|
||||
(java.sql
|
||||
Date
|
||||
Timestamp)
|
||||
(java.time
|
||||
LocalDate
|
||||
LocalDateTime
|
||||
ZoneId)
|
||||
(java.time.format
|
||||
DateTimeFormatter)))
|
||||
|
||||
|
||||
(def ^:private base-url "https://api.eloverblik.dk/customerapi")
|
||||
(def ^:private dk-zone (ZoneId/of "Europe/Copenhagen"))
|
||||
(def ^:private date-fmt (DateTimeFormatter/ofPattern "yyyy-MM-dd"))
|
||||
|
||||
|
||||
;; --- Auth ---
|
||||
|
||||
(defn- read-refresh-token
|
||||
[]
|
||||
(or (System/getenv "ELOVERBLIK_TOKEN")
|
||||
(str/trim (slurp ".token"))))
|
||||
|
||||
|
||||
(defn- get-access-token
|
||||
"Exchange refresh token for a short-lived access token."
|
||||
[refresh-token]
|
||||
(let [client (HttpClient/newHttpClient)
|
||||
request (-> (HttpRequest/newBuilder)
|
||||
(.uri (URI/create (str base-url "/api/token")))
|
||||
(.header "Authorization" (str "Bearer " refresh-token))
|
||||
(.header "Accept" "application/json")
|
||||
(.GET)
|
||||
(.build))
|
||||
response (.send client request (HttpResponse$BodyHandlers/ofString))]
|
||||
(when (= 200 (.statusCode response))
|
||||
(let [body (json/read-str (.body response) :key-fn keyword)]
|
||||
(:result body)))))
|
||||
|
||||
|
||||
;; --- HTTP helpers ---
|
||||
|
||||
(defn- api-get
|
||||
"GET with Bearer access token, returns parsed JSON."
|
||||
[access-token path]
|
||||
(let [client (HttpClient/newHttpClient)
|
||||
request (-> (HttpRequest/newBuilder)
|
||||
(.uri (URI/create (str base-url path)))
|
||||
(.header "Authorization" (str "Bearer " access-token))
|
||||
(.header "Accept" "application/json")
|
||||
(.GET)
|
||||
(.build))
|
||||
response (.send client request (HttpResponse$BodyHandlers/ofString))]
|
||||
(log/info "GET" path "->" (.statusCode response))
|
||||
(when (= 200 (.statusCode response))
|
||||
(json/read-str (.body response) :key-fn keyword))))
|
||||
|
||||
|
||||
(defn- api-post
|
||||
"POST with Bearer access token + JSON body, returns parsed JSON."
|
||||
[access-token path body]
|
||||
(let [client (HttpClient/newHttpClient)
|
||||
json-str (json/write-str body)
|
||||
request (-> (HttpRequest/newBuilder)
|
||||
(.uri (URI/create (str base-url path)))
|
||||
(.header "Authorization" (str "Bearer " access-token))
|
||||
(.header "Content-Type" "application/json")
|
||||
(.header "Accept" "application/json")
|
||||
(.POST (HttpRequest$BodyPublishers/ofString json-str))
|
||||
(.build))
|
||||
response (.send client request (HttpResponse$BodyHandlers/ofString))]
|
||||
(log/info "POST" path "->" (.statusCode response))
|
||||
(when (= 200 (.statusCode response))
|
||||
(json/read-str (.body response) :key-fn keyword))))
|
||||
|
||||
|
||||
;; --- Metering Points ---
|
||||
|
||||
(defn- fetch-metering-points
|
||||
[access-token]
|
||||
(let [data (api-get access-token "/api/meteringpoints/meteringpoints?includeAll=true")]
|
||||
(:result data)))
|
||||
|
||||
|
||||
(defn- parse-date
|
||||
[s]
|
||||
(when (and s (not (str/blank? s)))
|
||||
(Date/valueOf (LocalDate/parse (subs s 0 10)))))
|
||||
|
||||
|
||||
(defn- upsert-mp!
|
||||
[query-fn mp]
|
||||
(query-fn :upsert-metering-point!
|
||||
{:metering-point-id (:meteringPointId mp)
|
||||
:type-of-mp (:typeOfMP mp)
|
||||
:balance-supplier (:balanceSupplierName mp)
|
||||
:street-name (:streetName mp)
|
||||
:building-number (:buildingNumber mp)
|
||||
:postcode (:postcode mp)
|
||||
:city-name (:cityName mp)
|
||||
:has-relation (:hasRelation mp)
|
||||
:settlement-method (:settlementMethod mp)
|
||||
:reading-occurrence (:meterReadingOccurrence mp)
|
||||
:consumer-start-date (parse-date (:consumerStartDate mp))
|
||||
:first-consumer-name (:firstConsumerPartyName mp)}))
|
||||
|
||||
|
||||
(defn- save-metering-points!
|
||||
[query-fn metering-points]
|
||||
(let [all-mps (mapcat (fn [mp]
|
||||
(cons mp (:childMeteringPoints mp)))
|
||||
metering-points)]
|
||||
(doseq [mp all-mps]
|
||||
(upsert-mp! query-fn mp))
|
||||
(log/info "Saved" (count all-mps) "metering points")))
|
||||
|
||||
|
||||
;; --- Time Series ---
|
||||
|
||||
(defn- fetch-time-series
|
||||
[access-token metering-point-ids from to]
|
||||
(api-post access-token
|
||||
(str "/api/meterdata/gettimeseries/"
|
||||
(.format from date-fmt) "/"
|
||||
(.format to date-fmt) "/Hour")
|
||||
{:meteringPoints {:meteringPoint metering-point-ids}}))
|
||||
|
||||
|
||||
(defn- parse-time-series
|
||||
"Parse the nested time series response into flat reading maps."
|
||||
[response metering-point-ids]
|
||||
(let [results (:result response)]
|
||||
(mapcat
|
||||
(fn [result mp-id]
|
||||
(let [doc (:MyEnergyData_MarketDocument result)
|
||||
series (or (:TimeSeries doc) [])]
|
||||
(mapcat
|
||||
(fn [ts]
|
||||
(mapcat
|
||||
(fn [period]
|
||||
(let [start-str (get-in period [:timeInterval :start])
|
||||
start (LocalDateTime/parse
|
||||
start-str
|
||||
(DateTimeFormatter/ofPattern "yyyy-MM-dd'T'HH:mm:ss'Z'"))
|
||||
start-dk (-> start
|
||||
(.atZone (ZoneId/of "UTC"))
|
||||
(.withZoneSameInstant dk-zone)
|
||||
(.toLocalDateTime))]
|
||||
(map (fn [point]
|
||||
(let [pos (dec (Long/parseLong (str (:position point))))
|
||||
time-dk (.plusHours start-dk pos)
|
||||
raw-qty (get point (keyword "out_Quantity.quantity"))
|
||||
quantity (when raw-qty (Double/parseDouble (str raw-qty)))]
|
||||
{:metering-point-id mp-id
|
||||
:time-dk (Timestamp/valueOf time-dk)
|
||||
:quantity-kwh quantity
|
||||
:quality (get point (keyword "out_Quantity.quality"))}))
|
||||
(:Point period))))
|
||||
(:Period ts)))
|
||||
series)))
|
||||
results
|
||||
metering-point-ids)))
|
||||
|
||||
|
||||
(def ^:private production-mp-id "571313113163368491")
|
||||
(def ^:private consumption-mp-id "571313113163368507")
|
||||
|
||||
|
||||
(defn- utc-start-for-date
|
||||
"Compute the UTC start of a Danish date (midnight DK -> UTC)."
|
||||
[^LocalDate date]
|
||||
(-> date
|
||||
(.atStartOfDay dk-zone)
|
||||
(.toInstant)
|
||||
(Timestamp/from)))
|
||||
|
||||
|
||||
(defn- save-time-series!
|
||||
[query-fn readings from]
|
||||
(doseq [r readings]
|
||||
(query-fn :insert-meter-reading! r))
|
||||
(let [time-start (utc-start-for-date from)]
|
||||
(doseq [r (filter #(= production-mp-id (:metering-point-id %)) readings)]
|
||||
(let [hour (.getHour (.toLocalDateTime ^Timestamp (:time-dk r)))]
|
||||
(query-fn :insert-production!
|
||||
{:time-start time-start :hour hour :kwh (:quantity-kwh r)})))
|
||||
(doseq [r (filter #(= consumption-mp-id (:metering-point-id %)) readings)]
|
||||
(let [hour (.getHour (.toLocalDateTime ^Timestamp (:time-dk r)))]
|
||||
(query-fn :insert-consumption!
|
||||
{:time-start time-start :hour hour :kwh (:quantity-kwh r)}))))
|
||||
(log/info "Saved" (count readings) "meter readings + production/consumption"))
|
||||
|
||||
|
||||
;; --- Charges ---
|
||||
|
||||
(defn- fetch-charges
|
||||
[access-token metering-point-ids]
|
||||
(api-post access-token
|
||||
"/api/meteringpoints/meteringpoint/getcharges"
|
||||
{:meteringPoints {:meteringPoint metering-point-ids}}))
|
||||
|
||||
|
||||
(defn- save-charges!
|
||||
[query-fn charges-response]
|
||||
(let [results (:result charges-response)]
|
||||
(doseq [result results]
|
||||
(let [mp-id (:id result)
|
||||
inner (:result result)]
|
||||
;; Subscriptions
|
||||
(doseq [sub (:subscriptions inner)]
|
||||
(query-fn :insert-charge!
|
||||
{:metering-point-id mp-id
|
||||
:charge-type "subscription"
|
||||
:name (:name sub)
|
||||
:description (:description sub)
|
||||
:owner (:owner sub)
|
||||
:valid-from-date (parse-date (:validFromDate sub))
|
||||
:valid-to-date (parse-date (:validToDate sub))
|
||||
:period-type (:periodType sub)
|
||||
:price (:price sub)
|
||||
:quantity (:quantity sub)
|
||||
:position 0}))
|
||||
;; Tariffs (one row per position/price)
|
||||
(doseq [tar (:tariffs inner)]
|
||||
(let [prices (or (:prices tar) [])]
|
||||
(if (seq prices)
|
||||
(doseq [p prices]
|
||||
(query-fn :insert-charge!
|
||||
{:metering-point-id mp-id
|
||||
:charge-type "tariff"
|
||||
:name (:name tar)
|
||||
:description (:description tar)
|
||||
:owner (:owner tar)
|
||||
:valid-from-date (parse-date (:validFromDate tar))
|
||||
:valid-to-date (parse-date (:validToDate tar))
|
||||
:period-type (:periodType tar)
|
||||
:price (:price p)
|
||||
:quantity (:quantity p)
|
||||
:position (some-> (:position p) str Long/parseLong)}))
|
||||
(query-fn :insert-charge!
|
||||
{:metering-point-id mp-id
|
||||
:charge-type "tariff"
|
||||
:name (:name tar)
|
||||
:description (:description tar)
|
||||
:owner (:owner tar)
|
||||
:valid-from-date (parse-date (:validFromDate tar))
|
||||
:valid-to-date (parse-date (:validToDate tar))
|
||||
:period-type (:periodType tar)
|
||||
:price nil
|
||||
:quantity nil
|
||||
:position 0}))))
|
||||
;; Fees
|
||||
(doseq [fee (:fees inner)]
|
||||
(query-fn :insert-charge!
|
||||
{:metering-point-id mp-id
|
||||
:charge-type "fee"
|
||||
:name (:name fee)
|
||||
:description (:description fee)
|
||||
:owner (:owner fee)
|
||||
:valid-from-date (parse-date (:validFromDate fee))
|
||||
:valid-to-date (parse-date (:validToDate fee))
|
||||
:period-type (:periodType fee)
|
||||
:price (:price fee)
|
||||
:quantity (:quantity fee)
|
||||
:position 0}))))))
|
||||
|
||||
|
||||
;; --- Orchestrator ---
|
||||
|
||||
(defn fetch-and-save-all!
|
||||
"Fetch all Eloverblik data and save to database.
|
||||
date is a LocalDate for which to fetch time series (one day)."
|
||||
[query-fn ^LocalDate date]
|
||||
(let [yesterday (.minusDays (LocalDate/now dk-zone) 1)
|
||||
time-start (utc-start-for-date date)
|
||||
from-dk (Timestamp/valueOf (.atStartOfDay date))
|
||||
to-dk (Timestamp/valueOf (.atStartOfDay (.plusDays date 1)))
|
||||
cons-cnt (:cnt (query-fn :count-consumption-for-date
|
||||
{:time-start time-start}))
|
||||
prod-cnt (:cnt (query-fn :count-production-for-date
|
||||
{:time-start time-start}))
|
||||
read-cnt (:cnt (query-fn :count-meter-readings-for-date
|
||||
{:from-dk from-dk :to-dk to-dk}))]
|
||||
(cond
|
||||
(not (.isBefore date yesterday))
|
||||
(do (log/info "No data to fetch for" (.format date date-fmt) "(too recent)")
|
||||
{:no-data true :date (.format date date-fmt)})
|
||||
|
||||
(and (some-> cons-cnt pos?) (some-> prod-cnt pos?) (some-> read-cnt pos?))
|
||||
(do (log/info "Data already exists for" (.format date date-fmt)
|
||||
"- consumption:" cons-cnt "production:" prod-cnt "readings:" read-cnt)
|
||||
{:exists true :date (.format date date-fmt)})
|
||||
:else
|
||||
(do
|
||||
(log/info "Starting Eloverblik fetch for" (.format date date-fmt))
|
||||
(let [refresh-token (read-refresh-token)
|
||||
access-token (get-access-token refresh-token)]
|
||||
(if-not access-token
|
||||
(do (log/error "Failed to get Eloverblik access token")
|
||||
{:error "Failed to get access token"})
|
||||
(let [mps (fetch-metering-points access-token)
|
||||
all-ids (->> mps
|
||||
(mapcat (fn [mp]
|
||||
(cons (:meteringPointId mp)
|
||||
(map :meteringPointId
|
||||
(:childMeteringPoints mp)))))
|
||||
(distinct)
|
||||
(vec))
|
||||
from date
|
||||
to (.plusDays date 1)]
|
||||
(log/info "Found" (count all-ids) "metering points:" all-ids)
|
||||
(save-metering-points! query-fn mps)
|
||||
(let [ts-resp (fetch-time-series access-token all-ids from to)
|
||||
readings (parse-time-series ts-resp all-ids)]
|
||||
(save-time-series! query-fn readings from))
|
||||
(let [ch-resp (fetch-charges access-token all-ids)]
|
||||
(save-charges! query-fn ch-resp))
|
||||
{:metering-points (count all-ids)
|
||||
:from (.format from date-fmt)
|
||||
:to (.format to date-fmt)})))))))
|
||||
@@ -1,112 +0,0 @@
|
||||
(ns pmagnus.elprice.web.controllers.elprice
|
||||
(:require
|
||||
[clojure.data.json :as json]
|
||||
[clojure.tools.logging :as log]
|
||||
[pmagnus.elprice.web.controllers.tariffs :as tariffs])
|
||||
(:import
|
||||
(java.net
|
||||
URI)
|
||||
(java.net.http
|
||||
HttpClient
|
||||
HttpRequest
|
||||
HttpResponse$BodyHandlers)
|
||||
(java.sql
|
||||
Timestamp)
|
||||
(java.time
|
||||
LocalDate
|
||||
LocalDateTime)))
|
||||
|
||||
|
||||
(def ^:private eur-dkk-rate 7.46)
|
||||
|
||||
|
||||
(defn- elprisen-url
|
||||
[^LocalDate date area]
|
||||
(format "https://www.elprisenligenu.dk/api/v1/prices/%04d/%02d-%02d_%s.json"
|
||||
(.getYear date) (.getMonthValue date) (.getDayOfMonth date) area))
|
||||
|
||||
|
||||
(defn- fetch-json
|
||||
[url]
|
||||
(let [client (HttpClient/newHttpClient)
|
||||
request (-> (HttpRequest/newBuilder)
|
||||
(.uri (URI/create url))
|
||||
(.header "Accept" "application/json")
|
||||
(.GET)
|
||||
(.build))
|
||||
response (.send client request (HttpResponse$BodyHandlers/ofString))]
|
||||
(when (= 200 (.statusCode response))
|
||||
(json/read-str (.body response) :key-fn keyword))))
|
||||
|
||||
|
||||
(defn- parse-timestamp
|
||||
[s]
|
||||
(when s
|
||||
(Timestamp/valueOf (.replace ^String s "T" " "))))
|
||||
|
||||
|
||||
(defn- dkk-price
|
||||
[price-dkk price-eur]
|
||||
(or price-dkk
|
||||
(when price-eur (* price-eur eur-dkk-rate))))
|
||||
|
||||
|
||||
(defn- fetch-area
|
||||
"Fetch hourly prices for one price area from elprisenligenu.dk."
|
||||
[^LocalDate date area]
|
||||
(let [url (elprisen-url date area)
|
||||
_ (log/info "Fetching" url)
|
||||
records (fetch-json url)]
|
||||
(when (sequential? records)
|
||||
(map (fn [r]
|
||||
;; time_start is "YYYY-MM-DDTHH:MM:SS+HH:MM" already in DK local;
|
||||
;; drop the 6-char offset suffix, keep the naive wall-clock stamp.
|
||||
(let [ts (subs (:time_start r) 0 19)]
|
||||
{:time-dk ts
|
||||
:area area
|
||||
:dkk (some-> (:DKK_per_kWh r) (* 1000.0)) ; kWh → MWh
|
||||
:eur (some-> (:EUR_per_kWh r) (* 1000.0))}))
|
||||
records))))
|
||||
|
||||
|
||||
(defn- fetch-from-api
|
||||
"Fetch hourly prices for both DK1 and DK2 from elprisenligenu.dk."
|
||||
[^LocalDate date]
|
||||
(concat (fetch-area date "DK1")
|
||||
(fetch-area date "DK2")))
|
||||
|
||||
|
||||
(defn- tariff-dkk-mwh
|
||||
"N1 time-of-use tariff converted from øre/kWh to DKK/MWh (×10)."
|
||||
[^LocalDateTime dt]
|
||||
(* 10.0 (tariffs/tariff-for-hour (.getMonthValue dt) (.getHour dt))))
|
||||
|
||||
|
||||
(defn- save-records!
|
||||
[query-fn records]
|
||||
(doseq [rec records]
|
||||
(when-let [dkk (dkk-price (:dkk rec) (:eur rec))]
|
||||
(let [ts (parse-timestamp (:time-dk rec))
|
||||
tariff (tariff-dkk-mwh (.toLocalDateTime ^Timestamp ts))
|
||||
total (+ (double dkk) tariff)]
|
||||
(query-fn :insert-elprice!
|
||||
{:time-dk ts
|
||||
:price-area (:area rec)
|
||||
:price-dkk dkk
|
||||
:tariff-dkk tariff
|
||||
:total-dkk total})))))
|
||||
|
||||
|
||||
(defn get-or-fetch!
|
||||
"Return hourly el-price rows for the given LocalDate (DK local), fetching
|
||||
from the upstream API and caching on a miss."
|
||||
[query-fn ^LocalDate date]
|
||||
(let [sql-date (java.sql.Date/valueOf date)
|
||||
rows (query-fn :get-elprice-for-date {:date sql-date})]
|
||||
(if (seq rows)
|
||||
rows
|
||||
(let [records (fetch-from-api date)]
|
||||
(when (seq records)
|
||||
(log/info "Saving" (count records) "el-price records")
|
||||
(save-records! query-fn records))
|
||||
(query-fn :get-elprice-for-date {:date sql-date})))))
|
||||
@@ -1,15 +0,0 @@
|
||||
(ns pmagnus.elprice.web.controllers.health
|
||||
(:require
|
||||
[ring.util.http-response :as http-response])
|
||||
(:import
|
||||
(java.util
|
||||
Date)))
|
||||
|
||||
|
||||
(defn healthcheck!
|
||||
[req]
|
||||
(http-response/ok
|
||||
{:time (str (Date. (System/currentTimeMillis)))
|
||||
:up-since (str (Date. (.getStartTime (java.lang.management.ManagementFactory/getRuntimeMXBean))))
|
||||
:app {:status "up"
|
||||
:message ""}}))
|
||||
@@ -1,135 +0,0 @@
|
||||
(ns pmagnus.elprice.web.controllers.prices
|
||||
(:require
|
||||
[clojure.data.json :as json]
|
||||
[clojure.tools.logging :as log])
|
||||
(:import
|
||||
(java.net
|
||||
URI
|
||||
URLEncoder)
|
||||
(java.net.http
|
||||
HttpClient
|
||||
HttpRequest
|
||||
HttpResponse$BodyHandlers)
|
||||
(java.sql
|
||||
Timestamp)
|
||||
(java.time
|
||||
LocalDate
|
||||
ZoneId)
|
||||
(java.time.format
|
||||
DateTimeFormatter)))
|
||||
|
||||
|
||||
(def ^:private dk-zone (ZoneId/of "Europe/Copenhagen"))
|
||||
|
||||
(def ^:private date-fmt (DateTimeFormatter/ofPattern "yyyy-MM-dd"))
|
||||
|
||||
|
||||
(defn- build-url
|
||||
"Build the Energi Data Service API URL for day-ahead prices."
|
||||
[start-date end-date price-area]
|
||||
(str "https://api.energidataservice.dk/dataset/DayAheadPrices"
|
||||
"?start=" start-date
|
||||
"&end=" end-date
|
||||
"&filter=" (URLEncoder/encode (json/write-str {"PriceArea" [price-area]}) "UTF-8")
|
||||
"&sort=TimeDK%20asc"
|
||||
"&limit=200"))
|
||||
|
||||
|
||||
(defn- fetch-json
|
||||
"Fetch JSON from a URL using JDK HttpClient."
|
||||
[url]
|
||||
(let [client (HttpClient/newHttpClient)
|
||||
request (-> (HttpRequest/newBuilder)
|
||||
(.uri (URI/create url))
|
||||
(.header "Accept" "application/json")
|
||||
(.GET)
|
||||
(.build))
|
||||
response (.send client request (HttpResponse$BodyHandlers/ofString))]
|
||||
(when (= 200 (.statusCode response))
|
||||
(json/read-str (.body response) :key-fn keyword))))
|
||||
|
||||
|
||||
(defn- fetch-area
|
||||
"Fetch today's and tomorrow's prices for a single price area."
|
||||
[start end price-area]
|
||||
(let [url (build-url start end price-area)]
|
||||
(log/info "Fetching day-ahead prices for" price-area "from" url)
|
||||
(when-let [data (fetch-json url)]
|
||||
(:records data))))
|
||||
|
||||
|
||||
(defn fetch-prices-from-api
|
||||
"Fetch today's and tomorrow's prices from Energi Data Service for DK1 and DK2."
|
||||
[]
|
||||
(let [today (LocalDate/now dk-zone)
|
||||
start (.format today date-fmt)
|
||||
end (.format (.plusDays today 2) date-fmt)]
|
||||
(concat (fetch-area start end "DK1")
|
||||
(fetch-area start end "DK2"))))
|
||||
|
||||
|
||||
(defn- parse-timestamp
|
||||
"Parse an ISO timestamp string to java.sql.Timestamp."
|
||||
[s]
|
||||
(when s
|
||||
(Timestamp/valueOf
|
||||
(.replace ^String s "T" " "))))
|
||||
|
||||
|
||||
(def ^:private eur-dkk-rate 7.46)
|
||||
|
||||
|
||||
(defn- dkk-price
|
||||
"Return DKK price, converting from EUR if DKK is nil."
|
||||
[price-dkk price-eur]
|
||||
(or price-dkk
|
||||
(when price-eur (* price-eur eur-dkk-rate))))
|
||||
|
||||
|
||||
(defn save-records!
|
||||
"Insert price records into the database, skipping existing ones."
|
||||
[query-fn records]
|
||||
(doseq [rec records]
|
||||
(query-fn :insert-price!
|
||||
{:time-utc (parse-timestamp (:TimeUTC rec))
|
||||
:time-dk (parse-timestamp (:TimeDK rec))
|
||||
:price-area (:PriceArea rec)
|
||||
:price-dkk (dkk-price (:DayAheadPriceDKK rec) (:DayAheadPriceEUR rec))
|
||||
:price-eur (:DayAheadPriceEUR rec)})))
|
||||
|
||||
|
||||
(defn fetch-and-save!
|
||||
"Fetch prices from API and save to database."
|
||||
[query-fn]
|
||||
(when-let [records (fetch-prices-from-api)]
|
||||
(log/info "Saving" (count records) "price records")
|
||||
(save-records! query-fn records)
|
||||
(count records)))
|
||||
|
||||
|
||||
(defn get-prices-for-date
|
||||
"Get prices for a given LocalDate and price area from the database."
|
||||
[query-fn date price-area]
|
||||
(query-fn :get-prices-for-date
|
||||
{:date (java.sql.Date/valueOf date)
|
||||
:price-area price-area}))
|
||||
|
||||
|
||||
(defn get-today-prices
|
||||
[query-fn]
|
||||
(get-prices-for-date query-fn (LocalDate/now dk-zone) "DK1"))
|
||||
|
||||
|
||||
(defn get-tomorrow-prices
|
||||
[query-fn]
|
||||
(get-prices-for-date query-fn (.plusDays (LocalDate/now dk-zone) 1) "DK1"))
|
||||
|
||||
|
||||
(defn ensure-current-prices!
|
||||
"Fetch prices only when today's DK1 prices are missing from the database."
|
||||
[query-fn]
|
||||
(if (seq (get-today-prices query-fn))
|
||||
(do
|
||||
(log/info "Day-ahead prices already exist; skipping API fetch")
|
||||
nil)
|
||||
(fetch-and-save! query-fn)))
|
||||
@@ -1,43 +0,0 @@
|
||||
(ns pmagnus.elprice.web.controllers.tariffs
|
||||
(:import
|
||||
(java.time
|
||||
LocalDateTime)))
|
||||
|
||||
|
||||
(def n1-tariffs
|
||||
"N1 network tariffs in øre/kWh (incl. VAT), effective 2026-01-01.
|
||||
Source: https://n1.dk/elnetkunder/gaeldende-priser"
|
||||
{:summer {:low 10.98 ; 00:00-06:00
|
||||
:high 16.47 ; 06:00-17:00, 21:00-24:00
|
||||
:peak 42.83} ; 17:00-21:00
|
||||
:winter {:low 10.98
|
||||
:high 32.95
|
||||
:peak 98.84}})
|
||||
|
||||
|
||||
(defn season
|
||||
"Returns :summer (Apr-Sep) or :winter (Oct-Mar) for a given month (1-12)."
|
||||
[month]
|
||||
(if (<= 4 month 9) :summer :winter))
|
||||
|
||||
|
||||
(defn load-level
|
||||
"Returns :low, :high, or :peak for a given hour (0-23).
|
||||
Low: 00:00-06:00
|
||||
High: 06:00-17:00, 21:00-24:00
|
||||
Peak: 17:00-21:00"
|
||||
[hour]
|
||||
(cond
|
||||
(< hour 6) :low
|
||||
(and (<= 6 hour) (< hour 17)) :high
|
||||
(and (<= 17 hour) (< hour 21)) :peak
|
||||
:else :high))
|
||||
|
||||
|
||||
(defn tariff-for-hour
|
||||
"Returns the applicable N1 tariff in øre/kWh.
|
||||
Can be called with (month, hour) or a LocalDateTime."
|
||||
([^LocalDateTime dt]
|
||||
(tariff-for-hour (.getMonthValue dt) (.getHour dt)))
|
||||
([month hour]
|
||||
(get-in n1-tariffs [(season month) (load-level hour)])))
|
||||
@@ -1,48 +0,0 @@
|
||||
(ns pmagnus.elprice.web.handler
|
||||
(:require
|
||||
[integrant.core :as ig]
|
||||
[pmagnus.elprice.web.middleware.core :as middleware]
|
||||
[reitit.ring :as ring]
|
||||
[reitit.swagger-ui :as swagger-ui]
|
||||
[ring.util.http-response :as http-response]))
|
||||
|
||||
|
||||
(defmethod ig/init-key :handler/ring
|
||||
[_ {:keys [router api-path] :as opts}]
|
||||
(ring/ring-handler
|
||||
(router)
|
||||
(ring/routes
|
||||
;; Handle trailing slash in routes - add it + redirect to it
|
||||
;; https://github.com/metosin/reitit/blob/master/doc/ring/slash_handler.md
|
||||
(ring/redirect-trailing-slash-handler)
|
||||
(ring/create-resource-handler {:path "/"})
|
||||
(when (some? api-path)
|
||||
(swagger-ui/create-swagger-ui-handler {:path api-path
|
||||
:url (str api-path "/swagger.json")}))
|
||||
(ring/create-default-handler
|
||||
{:not-found
|
||||
(constantly (-> {:status 404, :body "Page not found"}
|
||||
(http-response/content-type "text/plain")))
|
||||
:method-not-allowed
|
||||
(constantly (-> {:status 405, :body "Not allowed"}
|
||||
(http-response/content-type "text/plain")))
|
||||
:not-acceptable
|
||||
(constantly (-> {:status 406, :body "Not acceptable"}
|
||||
(http-response/content-type "text/plain")))}))
|
||||
{:middleware [(middleware/wrap-base opts)]}))
|
||||
|
||||
|
||||
(defmethod ig/init-key :router/routes
|
||||
[_ {:keys [routes]}]
|
||||
(mapv (fn [route]
|
||||
(if (fn? route)
|
||||
(route)
|
||||
route))
|
||||
routes))
|
||||
|
||||
|
||||
(defmethod ig/init-key :router/core
|
||||
[_ {:keys [routes env] :as opts}]
|
||||
(if (= env :dev)
|
||||
#(ring/router ["" opts routes])
|
||||
(constantly (ring/router ["" opts routes]))))
|
||||
@@ -1,29 +0,0 @@
|
||||
(ns pmagnus.elprice.web.htmx
|
||||
(:require
|
||||
[hiccup.core :as h]
|
||||
[hiccup.page :as p]
|
||||
[ring.util.http-response :as http-response]))
|
||||
|
||||
|
||||
(defmacro page
|
||||
[opts & content]
|
||||
`(-> (p/html5 ~opts
|
||||
[:head
|
||||
[:meta {:charset "UTF-8"}]
|
||||
[:meta {:name "viewport"
|
||||
:content "width=device-width, initial-scale=1, viewport-fit=cover"}]
|
||||
[:link {:rel "stylesheet" :href "/css/output.css"}]
|
||||
[:script {:src "https://unpkg.com/htmx.org@2.0.8/dist/htmx.min.js"
|
||||
:defer true}]]
|
||||
[:body {:class "bg-gray-50 min-h-screen"}
|
||||
[:div {:class "mx-auto max-w-[390px] px-4 py-6"}
|
||||
~@content]])
|
||||
http-response/ok
|
||||
(http-response/content-type "text/html")))
|
||||
|
||||
|
||||
(defmacro fragment
|
||||
[opts & content]
|
||||
`(-> (str (h/html ~opts ~@content))
|
||||
http-response/ok
|
||||
(http-response/content-type "text/html")))
|
||||
@@ -1,14 +0,0 @@
|
||||
(ns pmagnus.elprice.web.middleware.core
|
||||
(:require
|
||||
[pmagnus.elprice.env :as env]
|
||||
[ring.middleware.defaults :as defaults]
|
||||
[ring.middleware.session.cookie :as cookie]))
|
||||
|
||||
|
||||
(defn wrap-base
|
||||
[{:keys [metrics site-defaults-config cookie-secret] :as opts}]
|
||||
(let [cookie-store (cookie/cookie-store {:key (.getBytes ^String cookie-secret)})]
|
||||
(fn [handler]
|
||||
(cond-> ((:middleware env/defaults) handler opts)
|
||||
true (defaults/wrap-defaults
|
||||
(assoc-in site-defaults-config [:session :store] cookie-store))))))
|
||||
@@ -1,34 +0,0 @@
|
||||
(ns pmagnus.elprice.web.middleware.exception
|
||||
(:require
|
||||
[clojure.tools.logging :as log]
|
||||
[reitit.ring.middleware.exception :as exception]))
|
||||
|
||||
|
||||
(defn handler
|
||||
[message status exception request]
|
||||
(when (>= status 500)
|
||||
;; You can optionally use this to report error to an external service
|
||||
(log/error exception))
|
||||
{:status status
|
||||
:body {:message message
|
||||
:exception (.getClass exception)
|
||||
:data (ex-data exception)
|
||||
:uri (:uri request)}})
|
||||
|
||||
|
||||
(def wrap-exception
|
||||
(exception/create-exception-middleware
|
||||
(merge
|
||||
exception/default-handlers
|
||||
{:system.exception/internal (partial handler "internal exception" 500)
|
||||
:system.exception/business (partial handler "bad request" 400)
|
||||
:system.exception/not-found (partial handler "not found" 404)
|
||||
:system.exception/unauthorized (partial handler "unauthorized" 401)
|
||||
:system.exception/forbidden (partial handler "forbidden" 403)
|
||||
|
||||
;; override the default handler
|
||||
::exception/default (partial handler "default" 500)
|
||||
|
||||
;; print stack-traces for all exceptions
|
||||
::exception/wrap (fn [handler e request]
|
||||
(handler e request))})))
|
||||
@@ -1,15 +0,0 @@
|
||||
(ns pmagnus.elprice.web.middleware.formats
|
||||
(:require
|
||||
[luminus-transit.time :as time]
|
||||
[muuntaja.core :as m]))
|
||||
|
||||
|
||||
(def instance
|
||||
(m/create
|
||||
(-> m/default-options
|
||||
(update-in
|
||||
[:formats "application/transit+json" :decoder-opts]
|
||||
(partial merge time/time-deserialization-handlers))
|
||||
(update-in
|
||||
[:formats "application/transit+json" :encoder-opts]
|
||||
(partial merge time/time-serialization-handlers)))))
|
||||
@@ -1,85 +0,0 @@
|
||||
(ns pmagnus.elprice.web.routes.api
|
||||
(:require
|
||||
[integrant.core :as ig]
|
||||
[pmagnus.elprice.web.controllers.elprice :as elprice]
|
||||
[pmagnus.elprice.web.controllers.health :as health]
|
||||
[pmagnus.elprice.web.middleware.exception :as exception]
|
||||
[pmagnus.elprice.web.middleware.formats :as formats]
|
||||
[reitit.coercion.malli :as malli]
|
||||
[reitit.ring.coercion :as coercion]
|
||||
[reitit.ring.middleware.muuntaja :as muuntaja]
|
||||
[reitit.ring.middleware.parameters :as parameters]
|
||||
[reitit.swagger :as swagger]
|
||||
[ring.util.http-response :as http-response])
|
||||
(:import
|
||||
(java.time
|
||||
LocalDate)
|
||||
(java.time.format
|
||||
DateTimeParseException)))
|
||||
|
||||
|
||||
(def route-data
|
||||
{:coercion malli/coercion
|
||||
:muuntaja formats/instance
|
||||
:swagger {:id ::api}
|
||||
:middleware [;; query-params & form-params
|
||||
parameters/parameters-middleware
|
||||
;; content-negotiation
|
||||
muuntaja/format-negotiate-middleware
|
||||
;; encoding response body
|
||||
muuntaja/format-response-middleware
|
||||
;; exception handling
|
||||
coercion/coerce-exceptions-middleware
|
||||
;; decoding request body
|
||||
muuntaja/format-request-middleware
|
||||
;; coercing response bodys
|
||||
coercion/coerce-response-middleware
|
||||
;; coercing request parameters
|
||||
coercion/coerce-request-middleware
|
||||
;; exception handling
|
||||
exception/wrap-exception]})
|
||||
|
||||
|
||||
(defn- elprice-handler
|
||||
[query-fn {{{:keys [date]} :query} :parameters}]
|
||||
(try
|
||||
(let [d (LocalDate/parse date)
|
||||
rows (elprice/get-or-fetch! query-fn d)]
|
||||
(http-response/ok
|
||||
{:date date
|
||||
:prices (mapv (fn [r] {:time_dk (str (:time_dk r))
|
||||
:price_area (:price_area r)
|
||||
:price_dkk (:price_dkk r)
|
||||
:tariff_dkk (:tariff_dkk r)
|
||||
:total_dkk (:total_dkk r)})
|
||||
rows)}))
|
||||
(catch DateTimeParseException _
|
||||
(http-response/bad-request {:error "date must be YYYY-MM-DD"}))))
|
||||
|
||||
|
||||
;; Routes
|
||||
(defn api-routes
|
||||
[{:keys [query-fn]}]
|
||||
[["/swagger.json"
|
||||
{:get {:no-doc true
|
||||
:swagger {:info {:title "pmagnus.elprice API"}}
|
||||
:handler (swagger/create-swagger-handler)}}]
|
||||
["/health"
|
||||
;; note that use of the var is necessary
|
||||
;; for reitit to reload routes without
|
||||
;; restarting the system
|
||||
{:get #'health/healthcheck!}]
|
||||
["/elprice"
|
||||
{:get {:summary "Hourly DK1 + DK2 electricity prices for a date"
|
||||
:parameters {:query [:map [:date :string]]}
|
||||
:handler (partial elprice-handler query-fn)}}]])
|
||||
|
||||
|
||||
(derive :reitit.routes/api :reitit/routes)
|
||||
|
||||
|
||||
(defmethod ig/init-key :reitit.routes/api
|
||||
[_ {:keys [base-path]
|
||||
:or {base-path ""}
|
||||
:as opts}]
|
||||
(fn [] [base-path route-data (api-routes opts)]))
|
||||
@@ -1,269 +0,0 @@
|
||||
(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/ensure-current-prices! 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/ensure-current-prices! 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)]))
|
||||
@@ -1,13 +0,0 @@
|
||||
(ns pmagnus.elprice.web.routes.utils)
|
||||
|
||||
(def route-data-path [:reitit.core/match :data])
|
||||
|
||||
|
||||
(defn route-data
|
||||
[req]
|
||||
(get-in req route-data-path))
|
||||
|
||||
|
||||
(defn route-data-key
|
||||
[req k]
|
||||
(get-in req (conj route-data-path k)))
|
||||
@@ -1,32 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
# Sync Eloverblik data for a specific month.
|
||||
# Usage: ./sync-month.sh 2026-02
|
||||
set -euo pipefail
|
||||
|
||||
if [ $# -ne 1 ]; then
|
||||
echo "Usage: $0 YYYY-MM"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
MONTH="$1"
|
||||
BASE_URL="${BASE_URL:-http://localhost:3030}"
|
||||
|
||||
# Last day of the month
|
||||
days=$(date -d "${MONTH}-01 +1 month -1 day" "+%d")
|
||||
|
||||
echo "Syncing $MONTH ($days days)"
|
||||
|
||||
for day in $(seq 1 "$days"); do
|
||||
d=$(printf "%s-%02d" "$MONTH" "$day")
|
||||
resp=$(curl -s -X POST "${BASE_URL}/eloverblik/sync?date=${d}")
|
||||
text=$(echo "$resp" | sed 's/<[^>]*>//g' | xargs)
|
||||
|
||||
if [ -z "$text" ]; then
|
||||
echo "$d: no response (server down?)"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
echo "$d: $text"
|
||||
done
|
||||
|
||||
echo "Done."
|
||||
@@ -1,5 +0,0 @@
|
||||
module.exports = {
|
||||
content: ["./src/**/*.clj", "./resources/**/*.html"],
|
||||
theme: { extend: {} },
|
||||
plugins: []
|
||||
}
|
||||
@@ -1,8 +0,0 @@
|
||||
(ns pmagnus.elprice.core-test
|
||||
(:require
|
||||
[pmagnus.elprice.test-utils :as utils]
|
||||
[clojure.test :refer :all]))
|
||||
|
||||
(deftest example-test
|
||||
(is (= 1 2)))
|
||||
|
||||
@@ -1,32 +0,0 @@
|
||||
(ns pmagnus.elprice.test-utils
|
||||
(:require
|
||||
[pmagnus.elprice.core :as core]
|
||||
[peridot.core :as p]
|
||||
[byte-streams :as bs]
|
||||
[integrant.repl.state :as state]))
|
||||
|
||||
(defn system-state
|
||||
[]
|
||||
(or @core/system state/system))
|
||||
|
||||
(defn system-fixture
|
||||
[]
|
||||
(fn [f]
|
||||
(when (nil? (system-state))
|
||||
(core/start-app {:opts {:profile :test}}))
|
||||
(f)
|
||||
(core/stop-app)))
|
||||
|
||||
(defn get-response [ctx]
|
||||
(-> ctx
|
||||
:response
|
||||
(update :body (fnil bs/to-string ""))))
|
||||
|
||||
(defn GET [app path params headers]
|
||||
(-> (p/session app)
|
||||
(p/request path
|
||||
:request-method :get
|
||||
:content-type "application/edn"
|
||||
:headers headers
|
||||
:params params)
|
||||
(get-response)))
|
||||
@@ -1,13 +0,0 @@
|
||||
(ns pmagnus.elprice.web.request-test
|
||||
(:require [clojure.test :refer [deftest testing is use-fixtures]]
|
||||
[pmagnus.elprice.test-utils :refer [system-state system-fixture GET]]))
|
||||
|
||||
(use-fixtures :once (system-fixture))
|
||||
|
||||
(deftest health-request-test []
|
||||
(testing "happy path"
|
||||
(let [handler (:handler/ring (system-state))
|
||||
params {}
|
||||
headers {}
|
||||
response (GET handler "/api/health" params headers)]
|
||||
(is (= 200 (:status response))))))
|
||||
Reference in New Issue
Block a user