;;; journalctl.el --- Query journalctl -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2022 Óscar Nájera
;;
;; Author: Óscar Nájera <hi@oscarnajera.com>
;; Maintainer: Óscar Nájera <hi@oscarnajera.com>
;; Created: September 07, 2022
;; Modified: September 07, 2022
;; Version: 0.0.1
;; Homepage: https://git.oscarnajera.com/dotfiles/tree/elisp/journalctl.el
;; Package-Requires: ((emacs "28.1"))
;;
;; This file is not part of GNU Emacs.
;;
;;; Commentary:
;;
;;  Query journalctl
;;
;;; Code:
(require 'org)
(require 'cl-extra)
(require 'transient)

(defvar-local journalctl-current-host nil
  "Keeps the optetes of the last call to journalctl.")

(defvar-local journalctl-current-opts nil
  "Keeps the optetes of the last call to journalctl.")

(defcustom journalctl-warn-keywords
  '("Warning" "warn" "debug")
  "Keywords that mark warnings in journalctl output."
  :group 'journalctl
  :type 'string)

(defcustom journalctl-error-keywords
  '("Failed" "failed" "Error" "error" "critical" "couldn't" "Can't" "not" "Not" "unreachable" "FATAL")
  "Keywords that mark errors in journalctl output."
  :group 'journalctl
  :type 'string)

(defcustom journalctl-starting-keywords
  '("Starting" "Activating" "Listening" "Reloading" "connect")
  "Keywords that mark start of processes or steps in journalctl output."
  :group 'journalctl
  :type 'string)

(defcustom journalctl-finished-keywords
  '("Stopped" "Stopping" "Reached" "Closed" "finished" "Started" "Successfully activated"
    "Received" "opened" "success" "enabled" "removed" "active" "Created" "loaded" "detected")
  "Keywords that mark finished processes or steps in journalctl output."
  :group 'journalctl
  :type 'string)

;;; faces
(defface journalctl-warning-face
  '((t :inherit warning))
  "Face to mark warnings in journalctl's output."
  :group 'journalctl)

(defface journalctl-error-face
  '((t :inherit error))
  "Face to mark errors in journalctl's output."
  :group 'journalctl)

(defface journalctl-starting-face
  '((t :inherit success))
  "Face to mark starting units in journalctl's output."
  :group 'journalctl)

(defface journalctl-finished-face
  '((t :inherit success :bold t))
  "Face to mark finished units in journalctl's output."
  :group 'journalctl)

(defface journalctl-timestamp-face
  '((t :inherit font-lock-type-face))
  "Face for timestamps in journalctl's output."
  :group 'journalctl)

(defface journalctl-host-face
  '((t :inherit font-lock-constant-face))
  "Face for hosts in journalctl's output."
  :group 'journalctl)

(defface journalctl-process-face
  '((t :inherit font-lock-function-name-face))
  "Face for hosts in journalctl's output."
  :group 'journalctl)

(defvar journalctl-font-lock-keywords
  ;; note: order matters, because once colored, that part won't change.
  ;; in general, put longer words first
  `((,(regexp-opt journalctl-warn-keywords 'words) . 'journalctl-warning-face)
    (,(regexp-opt journalctl-error-keywords 'words) . 'journalctl-error-face)
    (,(regexp-opt journalctl-starting-keywords 'words) . 'journalctl-starting-face)
    (,(regexp-opt journalctl-finished-keywords 'words) . 'journalctl-finished-face)
    (,(rx bol (group (= 3 alpha) " " (= 2 digit) " " (1+ (in digit ":"))) " " ; timestamp
          (group (+ (in alphanumeric ?.))) " "                 ; host
          (group (+? not-newline)) "[" (group (+ digit)) "]:") ; service[PID]
     (1 'journalctl-timestamp-face)
     (2 'journalctl-host-face)
     (3 'journalctl-process-face)
     (4 'font-lock-comment-face))))

(defcustom journalctl-hosts
  '("/sudo::"
    "/ssh:ingrid|sudo::"
    "/ssh:sarah|sudo::")
  "Valid hosts to connect for journal data."
  :type (list 'string)
  :group 'file)

(defconst journalctl-list-of-options
  '("--unit"
    "--follow"
    "--lines"
    "--reverse"
    "--pager-end"
    "--catalog"
    "--grep"
    "--boot"
    "--since"
    "--until"
    "--user"
    "--priority")
  "List of possible options to be given to journalctl." )

(transient-define-prefix journalct-opts ()
  "Prefix for opts."
  ["infixes"
   ("f" "follow" "--follow")
   ("h" "host" "--host=" :choices journalctl-hosts :prompt "hus: ")
   ("u" "unit" "--unit="
    :prompt "a unit: "
    :reader journalctl-read-system-units
    ;; :always-read t
    )])
;; (journalct-opts)

(defun journalctl--clean-buffer ()
  "Produce a clean buffer for the log.
It seems I must kill the buffer for tramp to behave correctly on the new calls."
  (let* ((name-buffer "JOURNAL LOG")
         (buffer (get-buffer name-buffer)))
    (when (buffer-live-p buffer)
      (kill-buffer buffer))
    (get-buffer-create name-buffer)))

(defun journalctl--system-units (host-location)
  "Query HOST-LOCATION (a tramp path) for its systemd units."
  (let ((default-directory host-location))
    (with-temp-buffer
      (start-file-process "units" (current-buffer) "systemctl" "list-units" "--all" "--quiet" "--full")
      (sit-for 0.1)
      (thread-last (split-string (buffer-string) "\n")
                   (mapcar (lambda (line) (car (split-string line)) ))
                   (delq nil)))))

(defun journalctl-read-system-units (_prompt host-location history)
  "Query HOST-LOCATION (a tramp path) for its systemd units, given command HISTORY."
  (completing-read "Unit: "
                   (journalctl--system-units host-location)
                   nil nil nil history))

(defun journalctl-remove-opt (opt)
  "Remove an OPT flag from the journal query."
  (interactive (list (completing-read "remove option" (mapcar #'car journalctl-current-opts) nil t)))
  (let ((new-opts (delq (assoc opt journalctl-current-opts) journalctl-current-opts))
        (host journalctl-current-host))
    (journalctl host new-opts)))

(defun journalctl-add-opt (opt)
  "Remove option from journalctl call.

If OPT is set, remove this option."
  (interactive (list (completing-read "add option: " journalctl-list-of-options nil t)))
  (let ((opts (delq (assoc opt journalctl-current-opts) journalctl-current-opts))
        (host journalctl-current-host))
    (thread-last
      (pcase opt
        ((or "--since" "--until") (org-read-date t))
        ((or "--follow" "--reverse" "--user" "--pager-end" "--catalog"))
        ("--unit" (journalctl-read-system-units nil host nil))
        (_ (read-string (concat opt "= "))))
      (list opt)
      (list)
      (append opts)
      (journalctl host))))

(defun  journalctl-edit-opts ()
  "Edit the value of `journalctl-current-opts'."
  (interactive)
  (let* ((host journalctl-current-host)
         (opts journalctl-current-opts)
         (edit-buff (get-buffer-create "Edit Journalctl options")))
    (with-current-buffer edit-buff
      (emacs-lisp-mode)
      (cl-prettyprint opts)
      (local-set-key "\C-c\C-c"
                     (lambda ()
                       (interactive)
                       (goto-char (point-min))
                       (journalctl host (read (current-buffer)))
                       (kill-buffer edit-buff)))
      (switch-to-buffer (current-buffer)))))


;;; keymap
(defvar journalctl-mode-map
  (let ((map (make-keymap "journalctl")))
    (define-key map (kbd "n") 'journalctl-next-chunk)
    (define-key map (kbd "p") 'journalctl-previous-chunk)
    (define-key map (kbd "+")  'journalctl-add-opt)
    (define-key map (kbd "-")  'journalctl-remove-opt)
    (define-key map (kbd "e") 'journalctl-edit-opts)
    (define-key map (kbd "q")  'kill-current-buffer)
    map)
  "Keymap for journalctl mode.")

(defun journalctl (host options)
  "Query the log of HOST given OPTIONS."
  (interactive
   (let ((picked-host (completing-read "Tramp host: " journalctl-hosts)))
     (list picked-host
           `(("--unit" ,(journalctl-read-system-units nil picked-host nil)) ("--follow")
             ("--lines" "100")))))
  (let ((buffer (journalctl--clean-buffer))
        (default-directory host))
    (apply #'start-file-process "Journal" buffer "journalctl" (flatten-tree options))
    (with-current-buffer buffer
      (journalctl-mode)
      (setq-local journalctl-current-host host)
      (setq-local journalctl-current-opts options))
    (switch-to-buffer buffer)))

;;;###autoload
(define-derived-mode journalctl-mode fundamental-mode "journalctl"
  "Major mode for viewing journalctl output."
  ;; code for syntax highlighting
  (setq font-lock-defaults '((journalctl-font-lock-keywords))))

(provide 'journalctl)
;;; journalctl.el ends here