(define-module (oni home services dunst)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-2)
  #:use-module (gnu services configuration)
  #:use-module (gnu packages wm)
  #:use-module (gnu home services)
  #:use-module (gnu home services shepherd)
  #:use-module (gnu home services utils)
  #:use-module (guix packages)
  #:use-module (guix gexp)

  #:export (home-dunst-service-type
            home-dunst-configuration
            home-dunst-default-service))

(define (color? value)
  (and (string? value)
       (= 7 (string-length value))
       (string-prefix? "#" value)))

(define (hyphen->underscore str)
  (string-join (string-split str #\-) "_"))

(define (integer-or-list-of-numbers? value)
  (or (integer? value)
      (list-of-numbers? value)))

(define (list-of-numbers? value)
  (and (list? value)
       (every integer? value)))

(define (list-of-strings? value)
  (and (list? value)
       (every string? value)))

(define (serialize-alist field value)
  (apply string-append (map serialize-rule value)))

(define (serialize-boolean field value)
  (serialize-string field (if value "true" "false")))

(define (serialize-color field value)
  (serialize-string field (string-append "\"" value "\"")))

(define (serialize-integer field value)
  (serialize-string field (number->string value)))

(define (serialize-integer-or-list-of-numbers field value)
  (match value
    ((? integer? _) (serialize-integer field value))
    ((? list? _) (serialize-list-of-numbers field value))
    (_ (error "Unknown type of value, not integer or list" value))))

(define (serialize-list-of-numbers field value)
  (match field
    ('offset (serialize-string field (string-join (map number->string value) "x")))
    (_ (serialize-string field (string-append "(" (string-join (map number->string value) ", ") ")")))))

(define (serialize-list-of-strings field value)
  (serialize-string field (string-join value ":")))

(define (serialize-rule value)
  (string-append "[" (car value) "]\n"
                 (string-join (map serialize-rule-property (cdr value)) "\n")
                 "\n"))

(define (serialize-rule-property value)
  (string-append (hyphen->underscore (symbol->string (car value))) " = " (object->string (cadr value))))

(define (serialize-string field value)
  (let ((field-key (hyphen->underscore (symbol->string field))))
    (string-append field-key " = " value "\n")))

(define (serialize-symbol field value)
  (serialize-string field (symbol->string value)))

(define (serialize-symbol-or-color field value)
  (match value
    ((? symbol? _) (serialize-symbol field value))
    ((? color? _) (serialize-color field value))
    (_ (error "Unknown type of value, not symbol or color" value))))

(define (symbol-or-color? value)
  (or (symbol? value)
      (color? value)))

(define-maybe color)
(define-maybe integer-or-list-of-numbers)
(define-maybe integer)
(define-maybe list-of-numbers)
(define-maybe list-of-strings)
(define-maybe string)

(define-configuration home-dunst-configuration
  (package
   (package dunst)
   "Package to use for setting Dunst")
  (font
   maybe-string
   "Display font")
  (markup
   (symbol 'no)
   "Allow pango markup")
  (format
   maybe-string
   "Specifies how various attributes of the notification should be formatted on
the notification window.")
  (sort
   (boolean #t)
   "If set to true, display notifications with higher urgency above the others.")
  (indicate-hidden
   (boolean #t)
   "If this is set to true, a notification indicating how many notifications are
not being displayed due to the notification limit will be shown in place of the
last notification slot.")
  (alignment
   (symbol 'left)
   "Defines how the text should be aligned within the notification.")
  (show-age-threshold
   (integer 60)
   "Show age of message if message is older than this time.")
  (word-wrap
   (boolean #t)
   "Specifies whether to wrap the text if the line gets longer than the maximum
notification width.")
  (ignore-newline
   (boolean #f)
   "If set to true, replace newline characters in notifications with whitespace.")
  (width
   maybe-integer-or-list-of-numbers
   "The width of the notification window in height.")
  (height
   maybe-integer
   "The maximum height of a single notification.")
  (notification-limit
   maybe-integer
   "The number of notifications that can appear at one time.")
  (origin
   (symbol 'top-right)
   "The origin of the notification window on the screen.")
  (offset
   maybe-list-of-numbers
   "Respectively the horizontal and vertical offset in pixels from the corner of
the screen specified by define.")
  (transparency
   maybe-integer
   "A 0-100 range on how transparent the notification window should be, with 0
being fully opaque and 100 invisible.")
  (idle-threshold
   maybe-integer
   "Don't timeout notifications if user is idle longer than this time.")
  (monitor
   maybe-integer
   "Specifies on which monitor the notifications should be displayed in, count
starts at 0.")
  (follow
   (symbol 'none)
   "Defines where the notifications should be placed in a multi-monitor setup.")
  (sticky-history
   (boolean #t)
   "If set to true, notifications that have been recalled from history will not
time out automatically.")
  (line-height
   (integer 0)
   "The amount of extra spacing between text lines in pixels.")
  (separator-height
   (integer 2)
   "The height in pixels of the separator between notifications, if set to 0 there
will be no separating line between notifications.")
  (padding
   (integer 8)
   "The distance in pixels from the content to the spearator/border of the window
in the vertical axis.")
  (horizontal-padding
   (integer 8)
   "The distance in pixels from the content to the border of the window in the
horizontal axis.")
  (separator-color
   (symbol-or-color 'frame)
   "Sets the color of the separator line between two notifications.")
  (dmenu
   maybe-string
   "The command that will be run when opening the context menu.")
  (browser
   maybe-string
   "The command that will be run when opening a URL.")
  (icon-position
   (symbol 'left)
   "Defines the position of the icon in the notification window.")
  (icon-path
   maybe-list-of-strings
   "Can be set to a list of paths to search for icons to use with notifications.")
  (frame-width
   (integer 3)
   "Defines width in pixels of frame around the notification window.")
  (frame-color
   maybe-color
   "The frame color of the notifications.")
  (max-icon-size
   (integer 128)
   "Defines the maximum size in pixels for the icons.")
  (corner-radius
   (integer 0)
   "Define the corner radius in pixels.")
  (rules
   (alist '())
   "Rules allow the conditional modification of notifications."))

(define (add-dunst-packages config)
  (list (home-dunst-configuration-package config)))

(define (serialize-dunst-configuration config)
  #~(string-append
     "[global]\n"
     #$(serialize-configuration config home-dunst-configuration-fields)))

(define (home-dunst-config-dunstrc config)
  (computed-file "dunstrc"
                 #~(call-with-output-file #$output
                     (λ (port)
                       (display #$(serialize-dunst-configuration config)
                                port)))))

(define (home-dunst-config-files config)
  `(("dunst/dunstrc" ,(home-dunst-config-dunstrc config))))

(define (home-dunst-shepherd-service config)
  (list
   (shepherd-service
    (documentation "Start dunst")
    (provision '(dunst))
    (auto-start? #t)
    (start
     #~(make-forkexec-constructor
        (list #$(file-append (home-dunst-configuration-package config) "/bin/dunst")
              "--config" #$(home-dunst-config-dunstrc config))
        #:log-file (format #f "~a/.local/var/log/dunst.log" (getenv "HOME"))))
    (stop #~(make-kill-destructor)))))

(define home-dunst-service-type
  (service-type (name 'home-dunst)
                (extensions
                 (list (service-extension
                        home-xdg-configuration-files-service-type
                        home-dunst-config-files)
                       (service-extension
                        home-profile-service-type
                        add-dunst-packages)
                       (service-extension
                        home-shepherd-service-type
                        home-dunst-shepherd-service)))
                (default-value (home-dunst-configuration))
                (description "Configure dunst")))

(define home-dunst-default-service
  (service home-dunst-service-type
           (home-dunst-configuration
            (font "Fantasque Sans Mono 15")
            (markup 'full)
            (format "<u>%s</u>\\n\\n%b")
            (width '(0 600))
            (origin 'top-center)
            (idle-threshold 120)
            (padding 15)
            (horizontal-padding 15)
            (separator-color 'auto)
            (dmenu "rofi -dmenu -p dunst:")
            (browser "firefox")
            (icon-path '("/usr/share/icons/gnome/24x24/status/"
                         "/usr/share/icons/gnome/24x24/devices/"
                         "/usr/share/icons/hicolor/24x24/apps/"))
            (frame-width 2)
            (frame-color "#3d3d3d")
            (max-icon-size 64)
            (corner-radius 10)
            (rules
             '(("urgency_low"
                (background "#405c2e")
                (foreground "#eeeeec")
                (timeout 10))
               ("urgency_normal"
                (background "#222224")
                (foreground "#eeeeec")
                (timeout 10))
               ("urgency_critical"
                (background "#973732")
                (foreground "#eeeeec")
                (timeout 0))
               ("Emacs"
                (appname "Emacs")
                (background "#7f5ab6")
                (foreground "#fafafa"))
               ("Metal Express Radio"
                (appname "Metal Express Radio")
                (background "#ef4136")
                (foreground "#ffffff"))
               ("Syncthing"
                (appname "Syncthing GTK")
                (background "#337ab7")
                (foreground "#ffffff"))
               ("Lollypop"
                (appname "Lollypop")
                (background "#fd3e75")
                (foreground "#ffffff"))
               ("gPodder"
                (appname "gPodder")
                (background "#7f5785")
                (foreground "#ffffff")))))))