diff of 76ebaf758f894f4afa4701a172a88ba583cb0628
76ebaf758f894f4afa4701a172a88ba583cb0628
diff --git a/elm-frontti/src/Logs.elm b/elm-frontti/src/Logs.elm
index e1fe6eb..1ff7e55 100644
--- a/elm-frontti/src/Logs.elm
+++ b/elm-frontti/src/Logs.elm
@@ -11,22 +11,24 @@ type alias Log =
type alias Group =
{ name: String
- , alarmy: Bool
+ , alarmy: Bool
+ , sound_alarm: Bool
, members: List Log}
type alias ParsedGroup =
{ name: String
, regex: Regex
- , alarmy: Bool
+ , alarmy: Bool
+ , sound_alarm: Bool
, members: List Log}
regex_to_parsedgroup str =
case Regex.fromString str of
- Just re -> Just <| ParsedGroup str re False []
+ Just re -> Just <| ParsedGroup str re False False []
Nothing -> Nothing
str_to_group str =
- Group str False []
+ Group str False False []
parsedGroup_to_group pg =
Group pg.name pg.alarmy pg.members
@@ -44,10 +46,12 @@ groupsEncoder groups =
nameDecoder = Decode.field "name" Decode.string
alarmyDecoder = Decode.field "alarmy" Decode.bool
+sound_alarm_decoder = Decode.field "sound-alarm" Decode.bool
groupDecoder = Decode.succeed Group
|> decodeApply nameDecoder
|> decodeApply alarmyDecoder
+ |> decodeApply sound_alarm_decoder
|> decodeApply (Decode.succeed [])
groupsDecoder = Decode.list groupDecoder
diff --git a/elm-frontti/src/Logviewer.elm b/elm-frontti/src/Logviewer.elm
index 03d4832..66b2a12 100644
--- a/elm-frontti/src/Logviewer.elm
+++ b/elm-frontti/src/Logviewer.elm
@@ -25,7 +25,7 @@ listify group
details []
[ summary [ class "loggroup-summary" ] [
span [ class "loggroup-summary-container" ]
- [ text <| group.name ++ " (" ++ (String.fromInt (List.length group.members)) ++ ")"
+ [ text <| group.name ++ " (" ++ (String.fromInt (List.length group.members)) ++ ")" ++ (if group.sound_alarm then " ALERT! " else "")
, if not is_ungrouped then
button [ onClick <| DeleteLogGroup group.name ] [ text "Delete log group" ]
else div [] []
@@ -42,7 +42,7 @@ listify group
parseRegex: Group -> Maybe ParsedGroup
parseRegex r =
case Regex.fromString r.name of
- Just rr -> Just (ParsedGroup r.name rr r.alarmy r.members)
+ Just rr -> Just (ParsedGroup r.name rr r.alarmy r.sound_alarm r.members)
Nothing -> Nothing
tab: List Log -> List Group -> String -> Html Msg
@@ -60,7 +60,7 @@ tab logs groups edited_group =
|> List.filter (\l -> regexes
|> List.filter (\r -> Regex.contains r.regex l.row)
|> (==) [])
- |> ParsedGroup "Ungrouped" Regex.never False
+ |> ParsedGroup "Ungrouped" Regex.never False False
|> listify
in
div []
diff --git a/resources/sql/024-loggroup-read-count.sql b/resources/sql/024-loggroup-read-count.sql
new file mode 100644
index 0000000..bc6fe9e
--- /dev/null
+++ b/resources/sql/024-loggroup-read-count.sql
@@ -0,0 +1,13 @@
+CREATE TABLE blog.loggroup_reads
+(
+ group_id int not null,
+ user_id int not null,
+ read_count int not null default 0,
+ PRIMARY KEY (group_id, user_id),
+ FOREIGN KEY (group_id) references blog.log_group(ID)
+ ON DELETE CASCADE
+ ON UPDATE CASCADE,
+ FOREIGN KEY (user_id) references blog.Users(ID)
+ ON DELETE CASCADE
+ ON UPDATE CASCADE
+);
diff --git a/resources/sql/log-fns.sql b/resources/sql/log-fns.sql
new file mode 100644
index 0000000..4d35e53
--- /dev/null
+++ b/resources/sql/log-fns.sql
@@ -0,0 +1,29 @@
+-- name: get-log-group-counts*
+-- returns: :array-hash
+SELECT name, read_count
+FROM blog.loggroup_reads
+JOIN blog.log_group ON group_id = blog.log_group.ID
+WHERE user_id = $1;
+
+-- name: group-id*
+-- count: single
+SELECT id from blog.log_group where name = $1;
+
+-- name: update-readcount* @execute
+UPDATE blog.loggroup_reads r
+SET read_count = $1
+FROM blog.log_group g
+WHERE r.group_id = g.id AND r.user_id = $2 AND g.name = $3;
+
+-- name: insert-readcount* @execute
+insert into blog.loggroup_reads
+select g.id, $2, $1
+from blog.log_group g
+WHERE g.name = $3;
+
+-- name: readcount-exists?
+-- count: single
+select exists (select *
+ from blog.loggroup_reads
+ JOIN blog.log_group gr ON group_id = gr.ID
+ where user_id = $1 and gr.name = $2);
diff --git a/src/migration-list.lisp b/src/migration-list.lisp
index 69b6d35..5449004 100644
--- a/src/migration-list.lisp
+++ b/src/migration-list.lisp
@@ -28,6 +28,7 @@
(defmigration "021-more-rss-reader-stuff")
(defmigration "022-fix-rss-cache")
(defmigration "023-loggroups")
+(defmigration "024-loggroup-read-count")
(defun prepare-e2e-migration ()
(postmodern:execute "DELETE FROM blog.Users")
diff --git a/src/routes/settings-routes.lisp b/src/routes/settings-routes.lisp
index 2ec5783..c3e06ec 100644
--- a/src/routes/settings-routes.lisp
+++ b/src/routes/settings-routes.lisp
@@ -1,5 +1,7 @@
(defpackage murja.routes.settings-routes
(:use :cl)
+ (:import-from :halisql :defqueries)
+ (:import-from :lisp-fixup :partial)
(:import-from :com.inuoe.jzon :stringify :parse)
(:import-from :binding-arrows :->>)
(:import-from :murja.middleware.auth :@authenticated :*user* :@can?)
@@ -41,6 +43,11 @@
(defvar *log-file* (asdf:system-relative-pathname :aggressive-murja "murja.log"))
+(defun get-logs ()
+ (->>
+ (lisp-fixup:slurp-utf-8 *log-file*)
+ (str:lines)))
+
(defroute api-logs ("/api/logs" :method :get
:decorators (@transaction
@json
@@ -53,8 +60,7 @@
ht)))
(if (uiop:file-exists-p *log-file*)
(->>
- (lisp-fixup:slurp-utf-8 *log-file*)
- (str:lines)
+ (get-logs)
(mapcar #'logify)
stringify)
(->>
@@ -79,10 +85,69 @@
(setf (hunchentoot:return-code*) 204)
""))
+(defun get-groups ()
+ (coerce
+ (postmodern:query "SELECT name, alarmy FROM blog.log_group" :array-hash)
+ 'list))
+
+(defun count-reads (groups logs)
+ "Takes in whatever groups there are in the database, current logs and returns counts of each group in a hashmap"
+ (reduce (lambda (acc group-regex)
+ (let ((count (->>
+ logs
+ (remove-if-not (partial #'cl-ppcre:scan group-regex))
+ length)))
+ (setf (gethash group-regex acc)
+ count)
+ acc))
+ (->>
+ groups
+ (mapcar (partial #'gethash "name")))
+ :initial-value (make-hash-table)))
+
+(defqueries "log-fns")
+
+(defun db-counts (user-id)
+ (let ((counts (coerce (get-log-group-counts* user-id) 'list)))
+ (format t "counts: ~a~&" (mapcar #'alexandria:hash-table-alist counts))
+ (reduce (lambda (acc hash-table)
+ (setf (gethash (gethash "name" hash-table) acc)
+ (gethash "read_count" hash-table))
+ acc)
+ counts
+ :initial-value (make-hash-table :test 'equal))))
+
+
(defroute get-logs-groups ("/api/logs/groups" :method :get
- :decorators (@transaction
- @json
- @authenticated
- (@can? "update-settings"))) ()
- (let ((groups (postmodern:query "SELECT name, alarmy FROM blog.log_group" :array-hash)))
- (stringify groups)))
+ :decorators (@transaction
+ @json
+ @authenticated
+ (@can? "update-settings"))) ()
+ (let ((user-id (gethash "id" *user*)))
+ (assert user-id)
+ (let* ((groups (get-groups))
+ (read-counts (count-reads groups (get-logs)))
+ (db-counts (db-counts user-id))
+ (alarmy-groups (->>
+ groups
+ (remove-if-not (partial #'gethash "alarmy"))
+ (remove-if (lambda (group)
+ (let ((name (gethash "name" group)))
+ (= (or (gethash name db-counts) 0)
+ (gethash name read-counts)))))
+ (mapcar (partial #'gethash "name")))))
+
+ (dolist (group groups)
+ (let ((name (gethash "name" group)))
+ (if (member name alarmy-groups)
+ (setf (gethash "sound-alarm" group) t)
+ (setf (gethash "sound-alarm" group) nil))))
+
+ (dolist (k (alexandria:hash-table-alist read-counts))
+ (destructuring-bind (group . count) k
+ (log:info "Updating ~a to ~d~%" group count)
+ (if (readcount-exists? user-id group)
+ (update-readcount* count user-id group)
+ (insert-readcount* count user-id group))))
+
+ (stringify groups))))