feat: add conservation info

.Gitignore

@@ -0,0 +1,5 @@
+.clj-kondo/
+target/
+.cpcache
+.nrepl-port
+.lsp

deps.edn

@@ -8,6 +8,7 @@
         com.taoensso/telemere-slf4j {:mvn/version "1.1.0"}
         hiccup/hiccup {:mvn/version "2.0.0"}
         cheshire/cheshire {:mvn/version "6.1.0"}
+        camel-snake-kebab/camel-snake-kebab {:mvn/version "0.4.3"}
         io.github.paintparty/bling {:mvn/version "0.8.8"}}
  :aliases {:repl/conjure
            {:extra-deps {nrepl/nrepl       {:mvn/version "1.0.0"}

src/core.clj

@@ -1,18 +1,35 @@
 (ns core
-  (:require [wikidata :as wd]
+  (:require
-            [cheshire.core :as json]
+   [bling.core :as bling]
-            [reitit.ring :as ring]
+   [bling.hifi]
-            [ring.adapter.jetty]
+   [cheshire.core :as json]
-            [ring.middleware.reload]
+   [clojure.java.io :refer [reader]]
-            [ring.logger :refer [wrap-with-logger]]
+   [clojure.math :as math]
-            [clojure.java.io :refer [reader]]
+   [clojure.string :refer [lower-case]]
-            [bling.core :as bling]
+   [ebird]
-            [bling.hifi]
+   [hiccup.page :refer [html5]]
-            [hiccup.page :refer [html5]]
+   [reitit.ring :as ring]
-            [taoensso.telemere :as tel]))
+   [ring.adapter.jetty]
+   [ring.logger :refer [wrap-with-logger]]
+   [ring.middleware.reload]
+   [wikidata :as wd]))
 
 (def known-species (atom {}))
 (def observations (atom []))
+(def nearby (atom {}))
+
+(defn get-nearby [species] 
+  (let [species (lower-case (species :latin))
+        nearby-info (@nearby species)
+        since (.minusDays (java.time.LocalDateTime/now) 1)]
+    (if (and nearby-info (.isBefore since (:time nearby-info)))
+      nearby-info
+      (let [nearby-info (-> species
+                            (ebird/get-recent)
+                            (ebird/summarise-recent)
+                            (assoc :time (java.time.LocalDateTime/now)))]
+        (swap! nearby #(assoc % species nearby-info))
+        nearby-info))))
 
 (defn add-observation* [bird time certainty]
   (swap! observations #(conj % {:bird bird :time time :certainty certainty}))
@@ -36,18 +53,13 @@
     (add-observations birds now)
     {:status 200}))
 
-(defn head []
-  [:head
-   [:link {:rel "preconnect" :href "https://fonts.googleapis.com"}]
-   [:link {:rel "preconnect" :href "https://fonts.gstatic" :crossorigin true}]
-   [:link {:rel "stylesheet" :href "https://fonts.googleapis.com/css2?family=B612+Mono:ital,wght@0,400;0,700;1,400;1,700&family=Cinzel:wght@400..900&display=swap"}]
-   [:title "Bird observations"]])
-
 (defn summarise-species [s]
-  {:bird (:bird (first s))
+  (let [bird (:bird (first s))] 
-   :certainty (apply max (map :certainty s))
+    {:bird bird
-   :count (count s)
+     :certainty (apply max (map :certainty s))
-   :first-seen (apply min (map #(.toEpochSecond (.atZone (:time %) (java.time.ZoneId/of "Europe/Berlin"))) s))})
+     :count (count s)
+     :nearby (get-nearby bird)
+     :first-seen (apply min (map #(.toEpochSecond (.atZone (:time %) (java.time.ZoneId/of "Europe/Berlin"))) s))}))
 
 (defn summarise-observations [observations since]
   (->> observations
@@ -69,9 +81,45 @@
               :green "#bccb88"
               :dark-green "#528026"
               :blue "#31A0C5"})
-(defn template-observation [{bird :bird certainty :certainty count :count}]
+(def script 
-  [:li 
+  (str 
-   (get-in bird [:name :en])
+    "function onExpand(element) {"
+    "const info = element.querySelector('.info');"
+    "const classes = element.classList;"
+    "if (classes.contains('open')) {"
+    "classes.replace('open', 'closed');"
+    "info.style.display = 'none';"
+    "} else {"
+    "classes.replace('closed', 'open');"
+    "info.style.removeProperty('display');"
+    "}"
+    "}"))
+
+(defn head []
+  [:head
+   [:link {:rel "preconnect" :href "https://fonts.googleapis.com"}]
+   [:link {:rel "preconnect" :href "https://fonts.gstatic" :crossorigin true}]
+   [:link {:rel "stylesheet" :href "https://fonts.googleapis.com/css2?family=B612+Mono:ital,wght@0,400;0,700;1,400;1,700&family=Cinzel:wght@400..900&display=swap"}]
+   [:style (str "li.closed::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]
+   [:title "🐦  Vogel-Himbeere  🍓"]])
+(def template-concern
+  {:least-concern [:span {:style (str "color:" (colours :dark-green))} "(♪♪)"]
+   :near-threatened [:span {:style (str "color:" (colours :green))} "(♪)"]
+   :vulnerable [:span {:style (str "color:" (colours :yellow))} "(〜)"]
+   :endangered [:span {:style (str "color:" (colours :light-orange))} "(!)"]
+   :critical [:span {:style (str "color:" (colours :orange))} "(!!)"]})
+(defn template-observation [{bird :bird certainty :certainty count :count nearby :nearby}]
+  (let [observation-count (:observation-count nearby)]
+   [:li.closed
+   {:onclick "onExpand(this)"
+    }
+   [:span {:style (when (or (not observation-count) (= 0 observation-count))
+                    "text-decoration-style:double;text-decoration-line:underline;text-decoration-skip-ink:all;")}
+    (or (get-in bird [:name :de])
+        (ebird/get-name (:latin bird))
+        (get-in bird [:name :en]))]
    " "
    [:span.latin 
     {:style (str 
@@ -82,36 +130,41 @@
               "text-decoration-line: underline;"
               "color:" (:brown colours) ";")}
     (:latin bird)]
+   " "
+   (template-concern (:iucn bird))
+   [:div.info {:style "display: none;font-size: 0.8em;"}
+    (str (or observation-count "no") " nearby observations")]
    [:br]
    [:span.certainty
     {:style (str
               "font-size: 0.8em;"
-              "font-style: italic;"
+              "font-style: italic;")}
-              )}
     (str "Seen " count " times with maximum likelihood ") 
     [:span {:style (condp < certainty
                      0.8 (str "color:" (:orange colours) ";")
                      0.5 (str "color:" (:light-orange colours) ";")
-                     nil)} certainty]]])
+                     nil)} (double (/ (math/round (* 10000 certainty)) 100.0))]
+    "&nbsp;%"]]))
 (defn list-observation [_]
   (let [since (.minusDays (java.time.LocalDateTime/now) 1)
         observations (summarise-observations @observations since)]
+    (print @nearby)
     {:status 200
-     :body (str (html5 {:mode :html}
+     :headers {"charset" "utf-8"
-                       [:html 
+               "Content-Type" "text/html; charset=utf-8"}
-                        (head)
+     :body (str (html5
-                        [:body
+                  (head)
-                         {:style 
+                  [:body
-                          (str "max-width: 800px;"
+                   {:style 
-                               "margin-left: auto;"
+                    (str "max-width: 800px;"
-                               "margin-right: auto;"
+                         "margin-left: auto;"
-                               "font-family: \"B612 Mono\";"
+                         "margin-right: auto;"
-                               "background-color:" (:background colours) ";"
+                         "font-family: \"B612 Mono\";"
-                               "color:" (:text colours) ";")}
+                         "background-color:" (:background colours) ";"
-                         [:section
+                         "color:" (:text colours) ";")}
-                          [:h1 "Birds today"]
+                    [:h1 "Birds today 🐦"]
-                          [:ul
+                    [:ul
-                           (map template-observation observations)]]]]))}))
+                     (map template-observation observations)]]))}))
 
 (def router
   (wrap-with-logger
@@ -121,6 +174,4 @@
          ["/observation" {:post post-observation}]])
       (ring/create-default-handler))))
 
-(ring.middleware.reload/wrap-reload (ring.adapter.jetty/run-jetty #'router {:port 8080}))
+(ring.adapter.jetty/run-jetty #'router {:port 8080})
-
-

src/ebird.clj

@@ -0,0 +1,49 @@
+(ns ebird
+  (:require [clojure.string :refer [lower-case]])
+  (:require [camel-snake-kebab.core :as camel])
+  (:require [babashka.http-client :as http])
+  (:require [cheshire.core :as json]))
+
+(def api-key "a2bhg726mt4r")
+(def headers {"x-ebirdapitoken" api-key})
+(def latitude "52.29")
+(def longitude "8.04")
+
+(defn- call-api
+  ([url] (call-api url {}))
+  ([url query-params] (-> (str "https://api.ebird.org/v2/" url)
+                          (http/get {:headers headers
+                                     :query-params query-params})
+                          (:body)
+                          (json/parse-string (comp camel/->kebab-case keyword)))))
+
+(defn- associate-by [f coll]
+  (into {} (map (juxt f identity) coll)))
+(def taxonomy (->> (call-api "ref/taxonomy/ebird" {"fmt" "json"
+                                                   "locale" "de"})
+                   (filter #(= "species" (:category %)))
+                   (associate-by (comp lower-case :sci-name))))
+
+(defn get-name [species]
+  (-> species
+      (lower-case)
+      (taxonomy)
+      (:com-name)))
+
+(defn get-code [latin] 
+  (get-in taxonomy [(lower-case latin) :species-code]))
+
+(defn get-recent 
+  ([lat lng] (call-api "data/obs/geo/recent" {"lat" lat "lng" lng "dist" 50}))
+  ([species] (get-recent species latitude longitude))
+  ([species lat lng] 
+   (call-api (str "data/obs/geo/recent/" (get-code species))
+             {"lat" lat "lng" lng "dist" 50})))
+(defn summarise-recent [recent]
+  (reduce 
+    (fn [acc obs] {:bird-count (+ (or 1 (:how-many obs)) (:bird-count acc))
+                   :observation-count (inc (:observation-count acc))
+                   :locations (conj (:locations acc) (:loc-name obs))})
+    {:bird-count 0 :observation-count 0 :locations #{}}
+    recent))
+

src/wikidata.clj

@@ -5,25 +5,41 @@
 
 (def wikidata-query-url "https://query.wikidata.org/sparql")
 
+(defn entity-url [name] (str "http://www.wikidata.org/entity/" name))
+
+(def concerns 
+  (-> {"Q211005" :least-concern
+       "Q719675" :near-threatened
+       "Q278113" :vulnerable
+       "Q96377276" :endangered
+       "Q219127" :critical}
+      (update-keys entity-url)))
+
 (defn- query [latin] 
   (-> `{:prefixes {:wdt "<http://www.wikidata.org/prop/direct/>"
                    :wd "<http://www.wikidata.org/entity/>"
                    :bd "<http://www.bigdata.com/rdf#>"
+                   :rdfs "<http://www.w3.org/2000/01/rdf-schema#>"
+                   :wdno "<http://www.wikidata.org/prop/novalue/>"
+                   :p "<http://www.wikidata.org/prop/>"
+                   :ps "<http://www.wikidata.org/prop/staement/>"
+                   :psv "<http://www.wikidata.org/prop/staement/value/>"
                    :wikibase "<http://wikiba.se/ontology#>"}
-        :select [~'?name]
+        :select [~'?name ~'?concern]
         :where [[~'?bird :wdt/P31 :wd/Q16521]
+                [~'?bird :wdt/P105 :wd/Q7432]
                 [~'?bird :wdt/P225 ~latin]
                 [~'?bird :wdt/P1843 ~'?name]
-                [:service :wikibase/label [[:bd/serviceParam :wikibase/language "en,de,fr"]]]]
+                [~'?bird :wdt/P141 ~'?concern]]}
-        }
       (f/format-query :pretty true)))
 
-
 (defn get-bird [latin]
   (let [bindings (-> (http/get wikidata-query-url {:query-params {:query (query latin) :format "json"}})
                      (:body)
                      (json/parse-string true)
                      (:results)
                      (:bindings))]
-    {:name (apply hash-map (flatten (map (fn [{name :name}] [(keyword (:xml:lang name)) (:value name)]) bindings))) :latin latin}))
+    (print bindings)
-
+    {:name (apply hash-map (flatten (map (fn [{name :name}] [(keyword (:xml:lang name)) (:value name)]) bindings)))
+     :latin latin
+     :iucn (concerns (get-in (first bindings) [:concern :value]))}))

todos.md

@@ -4,3 +4,4 @@
 - Tidy memory periodically
 - Split log and notification
 - Get user for fun & profit
+- persistence