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
|
# 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