feat: add conservation effort from edn

This commit is contained in:
Fey Naomi Schrewe 2025-10-03 13:24:15 +02:00
parent fd93400b14
commit 27ae3b6404
4 changed files with 79 additions and 58 deletions

1
conservation.edn Normal file

File diff suppressed because one or more lines are too long

View File

@ -9,7 +9,8 @@
hiccup/hiccup {:mvn/version "2.0.0"} hiccup/hiccup {:mvn/version "2.0.0"}
cheshire/cheshire {:mvn/version "6.1.0"} cheshire/cheshire {:mvn/version "6.1.0"}
camel-snake-kebab/camel-snake-kebab {:mvn/version "0.4.3"} camel-snake-kebab/camel-snake-kebab {:mvn/version "0.4.3"}
io.github.paintparty/bling {:mvn/version "0.8.8"}} io.github.paintparty/bling {:mvn/version "0.8.8"}
borkdude/edamame {:mvn/version "1.4.32"}}
:aliases {:repl/conjure :aliases {:repl/conjure
{:extra-deps {nrepl/nrepl {:mvn/version "1.0.0"} {:extra-deps {nrepl/nrepl {:mvn/version "1.0.0"}
cider/cider-nrepl {:mvn/version "0.42.1"}} cider/cider-nrepl {:mvn/version "0.42.1"}}

View File

@ -1,22 +1,27 @@
(ns core (ns core
(:require (:require
[bling.core :as bling] [bling.core :as bling]
[bling.hifi] [bling.hifi]
[cheshire.core :as json] [cheshire.core :as json]
[clojure.java.io :refer [reader]] [clojure.java.io :refer [reader]]
[clojure.math :as math] [clojure.math :as math]
[clojure.string :refer [lower-case]] [clojure.string :refer [lower-case]]
[ebird] [ebird]
[hiccup.page :refer [html5]] [hiccup.page :refer [html5]]
[reitit.ring :as ring] [reitit.ring :as ring]
[ring.adapter.jetty] [ring.adapter.jetty]
[ring.logger :refer [wrap-with-logger]] [ring.logger :refer [wrap-with-logger]]
[ring.middleware.reload] [ring.middleware.reload]
[wikidata :as wd])) [edamame.core :as soy :refer [parse-next]]
[wikidata :as wd]
[clojure.core :as c]))
(def known-species (atom {})) (def known-species (atom {}))
(def observations (atom [])) (def observations (atom []))
(def nearby (atom {})) (def nearby (atom {}))
(def last-update (atom nil))
(def conservation-info (with-open [f (reader "./conservation.edn")] (parse-next (soy/reader f))))
(defn get-nearby [species] (defn get-nearby [species]
(let [species (lower-case (species :latin)) (let [species (lower-case (species :latin))
@ -50,6 +55,7 @@
(let [body (json/parse-stream (reader (:body request)) true) (let [body (json/parse-stream (reader (:body request)) true)
birds (:birds body) birds (:birds body)
now (java.time.LocalDateTime/now)] now (java.time.LocalDateTime/now)]
(reset! last-update now)
(add-observations birds now) (add-observations birds now)
{:status 200})) {:status 200}))
@ -59,6 +65,7 @@
:certainty (apply max (map :certainty s)) :certainty (apply max (map :certainty s))
:count (count s) :count (count s)
:nearby (get-nearby bird) :nearby (get-nearby bird)
:rote-liste (get-in conservation-info [(:latin bird) :status])
:first-seen (apply min (map #(.toEpochSecond (.atZone (:time %) (java.time.ZoneId/of "Europe/Berlin"))) s))})) :first-seen (apply min (map #(.toEpochSecond (.atZone (:time %) (java.time.ZoneId/of "Europe/Berlin"))) s))}))
(defn summarise-observations [observations since] (defn summarise-observations [observations since]
@ -104,51 +111,62 @@
"li.open::marker {content: '⚝ '; font-size: 1.2em; color:" (colours :blue) "}")] "li.open::marker {content: '⚝ '; font-size: 1.2em; color:" (colours :blue) "}")]
[:script {:type "text/javascript"} script] [:script {:type "text/javascript"} script]
[:title "🐦 Vogel-Himbeere 🍓"]]) [:title "🐦 Vogel-Himbeere 🍓"]])
(defn template-concern*
([colour-name key] (template-concern* colour-name nil key))
([colour-name ?background-colour key]
[:span {:style (str "color:" (colours colour-name) ";" (when ?background-colour (str "background-color:" (colours ?background-colour))))}
(str "(" key ")")]))
(def template-concern (def template-concern
{:least-concern [:span {:style (str "color:" (colours :dark-green))} "(♪♪)"] (-> {:common [:dark-green "♪♪"]
:near-threatened [:span {:style (str "color:" (colours :green))} "(♪)"] :least-concern [:dark-green "lc"]
:vulnerable [:span {:style (str "color:" (colours :yellow))} "(〜)"] :somewhat-common [:green "♪"]
:endangered [:span {:style (str "color:" (colours :light-orange))} "(!)"] :near-threatened [:green "nt"]
:critical [:span {:style (str "color:" (colours :orange))} "(!!)"]}) :rare [:text :yellow "〜"]
(defn template-observation [{bird :bird certainty :certainty count :count nearby :nearby}] :vulnerable [:text :yellow "v"]
:very-rare [:light-orange "!"]
:endangered [:light-orange "e"]
:extremely-rare [:orange "!!"]
:critical [:orange "c"]}
(update-vals (partial apply template-concern*))))
(defn template-observation [{bird :bird certainty :certainty count :count nearby :nearby concern :rote-liste}]
(let [observation-count (:observation-count nearby)] (let [observation-count (:observation-count nearby)]
[:li.closed [:li.closed
{:onclick "onExpand(this)" {:onclick "onExpand(this)"}
} [:span {:style (when (or (not observation-count) (= 0 observation-count))
[:span {:style (when (or (not observation-count) (= 0 observation-count)) "text-decoration-style:double;text-decoration-line:underline;text-decoration-skip-ink:all;")}
"text-decoration-style:double;text-decoration-line:underline;text-decoration-skip-ink:all;")} (or (get-in bird [:name :de])
(or (get-in bird [:name :de]) (ebird/get-name (:latin bird))
(ebird/get-name (:latin bird)) (get-in bird [:name :en]))]
(get-in bird [:name :en]))] " "
" " [:span.latin
[:span.latin {:style (str
{:style (str "font-variant: small-caps;"
"font-variant: small-caps;" "font-family: Cinzel;"
"font-family: Cinzel;" "font-weight: 600;"
"font-weight: 600;" "text-decoration-style: dashed;"
"text-decoration-style: dashed;" "text-decoration-line: underline;"
"text-decoration-line: underline;" "color:" (:brown colours) ";")}
"color:" (:brown colours) ";")} (:latin bird)]
(:latin bird)] " "
" " (template-concern (if (contains? template-concern concern) concern (:iucn bird)))
(template-concern (:iucn bird)) [:div.info {:style "display: none;font-size: 0.8em;"}
[:div.info {:style "display: none;font-size: 0.8em;"} (str (or observation-count "no") " nearby observations")]
(str (or observation-count "no") " nearby observations")] [:br]
[:br] [:span.certainty
[:span.certainty {:style (str
{:style (str "font-size: 0.8em;"
"font-size: 0.8em;" "font-style: italic;")}
"font-style: italic;")} (str "Seen " count " times with maximum likelihood ")
(str "Seen " count " times with maximum likelihood ") [:span {:style (condp < certainty
[:span {:style (condp < certainty 0.8 (str "color:" (:orange colours) ";")
0.8 (str "color:" (:orange colours) ";") 0.5 (str "color:" (:light-orange colours) ";")
0.5 (str "color:" (:light-orange colours) ";") nil)} (double (/ (math/round (* 10000 certainty)) 100.0))]
nil)} (double (/ (math/round (* 10000 certainty)) 100.0))] "&nbsp;%"]]))
"&nbsp;%"]])) (def date-formatter (java.time.format.DateTimeFormatter/ofPattern "dd MMM HH:mm"))
(defn list-observation [_] (defn list-observation [_]
(let [since (.minusDays (java.time.LocalDateTime/now) 1) (let [since (.minusDays (java.time.LocalDateTime/now) 1)
observations (summarise-observations @observations since)] observations (summarise-observations @observations since)]
(print @nearby)
{:status 200 {:status 200
:headers {"charset" "utf-8" :headers {"charset" "utf-8"
"Content-Type" "text/html; charset=utf-8"} "Content-Type" "text/html; charset=utf-8"}
@ -162,9 +180,11 @@
"font-family: \"B612 Mono\";" "font-family: \"B612 Mono\";"
"background-color:" (:background colours) ";" "background-color:" (:background colours) ";"
"color:" (:text colours) ";")} "color:" (:text colours) ";")}
[:h1 "Birds today 🐦"] [:h1 "Birds today 🐦"
[:ul [:span {:style (str "font-size:0.3em;margin-left:3em;color:" (colours :brown))}
(map template-observation observations)]]))})) (str "last updated " (if @last-update (.format @last-update date-formatter) "never"))]]
[:ul
(map template-observation observations)]]))}))
(def router (def router
(wrap-with-logger (wrap-with-logger

View File

@ -39,7 +39,6 @@
(json/parse-string true) (json/parse-string true)
(:results) (:results)
(:bindings))] (:bindings))]
(print bindings)
{:name (apply hash-map (flatten (map (fn [{name :name}] [(keyword (:xml:lang name)) (:value name)]) bindings))) {:name (apply hash-map (flatten (map (fn [{name :name}] [(keyword (:xml:lang name)) (:value name)]) bindings)))
:latin latin :latin latin
:iucn (concerns (get-in (first bindings) [:concern :value]))})) :iucn (concerns (get-in (first bindings) [:concern :value]))}))