diff --git a/resources/templates/base.html b/resources/templates/base.html index ae47c7c..5796192 100644 --- a/resources/templates/base.html +++ b/resources/templates/base.html @@ -12,6 +12,27 @@ + {% if messages %} +
+ {% for message in messages %} + + {% endfor %} +
+ {% endif %}

plauna

- {% block content %} - {% endblock %} + {% block content %} + {% endblock %}
diff --git a/src/plauna/markup.clj b/src/plauna/markup.clj index e020ec6..084732d 100644 --- a/src/plauna/markup.clj +++ b/src/plauna/markup.clj @@ -18,7 +18,25 @@ nil (. LocalDateTime ofEpochSecond timestamp 0 ZoneOffset/UTC))) -(defn administration [] (render-file "admin.html" {})) +(defn type->toast-role [message] + (cond + (= :alert (:type message)) (conj message {:path "M10 .5a9.5 9.5 0 1 0 9.5 9.5A9.51 9.51 0 0 0 10 .5Zm3.707 11.793a1 1 0 1 1-1.414 1.414L10 11.414l-2.293 2.293a1 1 0 0 1-1.414-1.414L8.586 10 6.293 7.707a1 1 0 0 1 1.414-1.414L10 8.586l2.293-2.293a1 1 0 0 1 1.414 1.414L11.414 10l2.293 2.293Z" + :color "text-red-500" + :bg-color "bg-red-100" + :id (str "toast-" (hash message))}) + (= :success (:type message)) (conj message {:path "M10 .5a9.5 9.5 0 1 0 9.5 9.5A9.51 9.51 0 0 0 10 .5Zm3.707 8.207-4 4a1 1 0 0 1-1.414 0l-2-2a1 1 0 0 1 1.414-1.414L9 10.586l3.293-3.293a1 1 0 0 1 1.414 1.414Z" + :color "text-green-500" + :bg-color "bg-green-100" + :id (str "toast-" (hash message))}) + (= :info (:type message)) (conj message {:path "M10 .5a9.5 9.5 0 1 0 9.5 9.5A9.51 9.51 0 0 0 10 .5ZM10 15a1 1 0 1 1 0-2 1 1 0 0 1 0 2Zm1-4a1 1 0 0 1-2 0V6a1 1 0 0 1 2 0v5Z" + :color "text-orange-500" + :bg-color "bg-orange-100" + :id (str "toast-" (hash message))}) + :else message)) + +(defn administration + ([] (render-file "admin.html" {})) + ([messages] (render-file "admin.html" {:messages (mapv type->toast-role messages)}))) (defn concat-string [contact] (if (nil? (:name contact)) @@ -54,10 +72,15 @@ (format (str "%." (if decimal-places decimal-places "1") "f") n))))) -(defn list-emails [emails page-info categories] - (let [last-page {:last-page (quot (:total page-info) (:size page-info))} - emails-with-java-date (map #(update-in % [:header :date] timestamp->date) emails)] - (render-file "emails.html" {:emails emails-with-java-date :page (conj page-info last-page) :header "Emails" :categories categories}))) +(defn list-emails + ([emails page-info categories] + (let [last-page {:last-page (quot (:total page-info) (:size page-info))} + emails-with-java-date (map #(update-in % [:header :date] timestamp->date) emails)] + (render-file "emails.html" {:emails emails-with-java-date :page (conj page-info last-page) :header "Emails" :categories categories}))) + ([emails page-info categories messages] + (let [last-page {:last-page (quot (:total page-info) (:size page-info))} + emails-with-java-date (map #(update-in % [:header :date] timestamp->date) emails)] + (render-file "emails.html" {:emails emails-with-java-date :page (conj page-info last-page) :header "Emails" :categories categories :messages (mapv type->toast-role messages)})))) (defn list-email-contents [email-data categories] (render-file "email.html" {:email (update-in email-data [:header :date] timestamp->date) :categories categories})) @@ -135,7 +158,9 @@ (let [watchers (map (fn [client] {:id (-> client first first :id) :logged-in (-> client first second :connected) :folder-open (-> client first second :folder) :string (str (-> client first first :host) " - " (-> client first first :user))}) clients)] (render-file "watchers.html" {:watchers watchers}))) -(defn watcher [client folders] (render-file "watcher.html" {:id (-> client first :id) :host (:host (first client)) :user (:user (first client)) :folders folders})) +(defn watcher + ([client folders] (render-file "watcher.html" {:id (-> client first :id) :host (:host (first client)) :user (:user (first client)) :folders folders})) + ([client folders messages] (println messages) (render-file "watcher.html" {:id (-> client first :id) :host (:host (first client)) :user (:user (first client)) :folders folders :messages (mapv type->toast-role messages)}))) (defn preferences-page [data] (let [log-levels {:log-level-options [{:key :error :name "Error"} {:key :info :name "Info"} {:key :debug :name "Debug"}]}] (render-file "admin-preferences.html" (conj data log-levels)))) diff --git a/src/plauna/server.clj b/src/plauna/server.clj index 3eb5a5a..1c9fb4f 100644 --- a/src/plauna/server.clj +++ b/src/plauna/server.clj @@ -29,6 +29,8 @@ (def html-headers {"Content-Type" "text/html; charset=UTF-8"}) +(defonce global-messages (atom [])) + (defn interleave-all [& seqs] (reduce (fn [acc index] (into acc (map #(get % index) seqs))) [] @@ -68,11 +70,18 @@ (defn find-running-clients [] (map (fn [watcher] {(first watcher) (client/monitor->map (second watcher))}) @client/watchers)) -(defn redirect-request [request] - (let [redirect-url (-> request :params :redirect-url)] - (if (some? redirect-url) - {:status 301 :headers {"Location" redirect-url}} - {:status 301 :headers {"Location" (-> request :uri)}}))) +(defn redirect-request + ([request] + (let [redirect-url (-> request :params :redirect-url)] + (if (some? redirect-url) + {:status 301 :headers {"Location" redirect-url}} + {:status 301 :headers {"Location" (-> request :uri)}}))) + ([request messages] + (swap! global-messages (fn [m] (conj m messages))) + (let [redirect-url (-> request :params :redirect-url)] + (if (some? redirect-url) + {:status 301 :headers {"Location" redirect-url}} + {:status 301 :headers {"Location" (-> request :uri)}})))) (defn language-preferences [] (let [preferences (db/get-language-preferences) @@ -104,10 +113,12 @@ (core-email/iterate-over-all-pages db/fetch-data write-func entity-query sql-query false))) (defn write-emails-to-training-files-and-train [] - (write-all-categorized-emails-to-training-files) - (doseq [training-model (analysis/train-data (files/training-files))] - (let [os (io/output-stream (files/model-file (:language training-model)))] - (analysis/serialize-model! (:model training-model) os)))) + (if (seq (languages-to-use-in-training)) + (do (write-all-categorized-emails-to-training-files) + (doseq [training-model (analysis/train-data (files/training-files))] + (let [os (io/output-stream (files/model-file (:language training-model)))] + (analysis/serialize-model! (:model training-model) os)))) + {:type :alert :content "There are no selected languages to train in. Cannot proceed."})) (defn categorize-content [content language] ;; FIXME This kills the process if content is nil (let [category (analysis/categorize content (files/model-file language))] @@ -207,12 +218,16 @@ (comp/GET "/" {} (success-html-with-body (markup/administration))) (comp/GET "/admin" {} - (success-html-with-body (markup/administration))) + (if (seq @global-messages) + (let [messages @global-messages] + (swap! global-messages (fn [_] [])) + (success-html-with-body (markup/administration messages))) + (success-html-with-body (markup/administration)))) (comp/POST "/emails/parse" request (let [temp-file (:tempfile (:filename (:params request)))] (files/read-emails-from-mbox (io/input-stream temp-file) @messaging/main-chan) - (redirect-request request))) + (redirect-request request {:type :success :content (str "Starting to parse file: " temp-file)}))) (comp/GET "/admin/categories" {} (let [categories (db/get-categories)] @@ -229,7 +244,6 @@ (success-html-with-body (markup/preferences-page {:language-detection-threshold language-datection-threshold :categorization-threshold categorization-threshold :log-level log-level})))) (comp/POST "/admin/preferences" request - (doseq [param (dissoc (:params request) :redirect-url)] (db/update-preference (first param) (second param))) (t/set-min-level! (p/log-level)) @@ -323,8 +337,9 @@ (redirect-request request)) (comp/POST "/training" request - (write-emails-to-training-files-and-train) - (redirect-request request)) + (let [result (write-emails-to-training-files-and-train)] + (when (some? result) (swap! global-messages (fn [mess] (conj mess result)))) + (redirect-request request))) (comp/POST "/training/new" request (let [n (get (:route-params request) :new 20)] @@ -337,9 +352,11 @@ categories (conj (db/get-categories) {:id nil :name "n/a"}) sql-clause (filter->sql-clause filter) result (db/fetch-data {:entity :enriched-email :strict false :page (page/page-request page page-size)} sql-clause)] - {:status 200 - :header html-headers - :body (markup/list-emails (:data result) {:filter filter :total-pages (inc (int (ceil (quot (:total result) page-size)))) :size page-size :page (:page result) :total (:total result)} categories)})) + (if (seq @global-messages) + (let [messages @global-messages] + (swap! global-messages (fn [_] [])) + (success-html-with-body (markup/list-emails (:data result) {:filter filter :total-pages (inc (int (ceil (quot (:total result) page-size)))) :size page-size :page (:page result) :total (:total result)} categories messages))) + (success-html-with-body (markup/list-emails (:data result) {:filter filter :total-pages (inc (int (ceil (quot (:total result) page-size)))) :size page-size :page (:page result) :total (:total result)} categories))))) (comp/GET "/emails/:id" [id] (let [decoded-id (url-decode id) @@ -355,17 +372,21 @@ :body (markup/watcher-list (find-running-clients))}) (comp/GET "/connections/:id" [id] - {:status 200 - :header html-headers - :body (markup/watcher (first (client/find-by-id-in-watchers id)) - (client/folders-in-store (:store (second (first (client/find-by-id-in-watchers id))))))}) + (if (seq @global-messages) + (let [messages @global-messages] + (swap! global-messages (fn [_] [])) + (success-html-with-body (markup/watcher (first (client/find-by-id-in-watchers id)) + (client/folders-in-store (:store (second (first (client/find-by-id-in-watchers id))))) messages))) + (success-html-with-body (markup/watcher (first (client/find-by-id-in-watchers id)) + (client/folders-in-store (:store (second (first (client/find-by-id-in-watchers id))))))))) (comp/POST "/connections/:id" request (let [params (:params request) id (:id params) folder (:folder params) refolder (some? (:move params))] - (client/read-all-emails id folder {:refolder refolder})) + (client/read-all-emails id folder {:refolder refolder}) + (swap! global-messages (fn [mess] (conj mess {:type :success :content (str "Started parsing " folder " asynchronously. Move folders after parsing: " refolder)})))) (redirect-request request)) (comp/GET "/connections/:id/restart" request