;; NOTE this script will most likely not work on your computer as
;; everything using /sys or /proc is hardcoded

(import scheme)
(import (chicken base))
(import (chicken condition))
(import (chicken io))
(import (chicken port))
(import (chicken pretty-print))
(import (chicken string))
(import (chicken time posix))
(import (srfi 1))
(import (srfi 18))
(import format)
(import matchable)
(import medea)
(import (prefix mpd-client mpd-))

(define sleep-time 1)

(define (format-seconds seconds)
  (let* ((time (inexact->exact (round seconds)))
         (minutes (quotient time 60))
         (seconds (remainder time 60)))
    (format "~2,'0d:~2,'0d" minutes seconds)))

(define (format-track-progress elapsed duration)
  (and elapsed duration
       (format "~a/~a" (format-seconds elapsed) (format-seconds duration))))

;; TODO get mpd-client workaround upstream

(define mpd-connection
  (condition-case
   (mpd-connect)
   ((exn) #f)))

(define (mpd-reconnect)
  (condition-case
   (set! mpd-connection (mpd-connect))
   ((exn) #f)))

(define (mpd-available)
  (condition-case
   (alist-ref 'state (mpd-get-status mpd-connection))
   ((exn) (begin (mpd-reconnect) #f))))

(define (mpd-state)
  (if (mpd-available)
      (let* ((current-status (mpd-get-status mpd-connection))
             (state (alist-ref 'state current-status))
             (playing? (not (equal? 'stop state)))
             (elapsed (alist-ref 'elapsed current-status))
             (current-song (mpd-get-current-song mpd-connection))
             (artist (alist-ref 'Artist current-song))
             (album (alist-ref 'Album current-song))
             (track (alist-ref 'Track current-song))
             (title (alist-ref 'Title current-song))
             (duration (alist-ref 'Time current-song))
             (progress (format-track-progress elapsed duration)))
        (list playing? artist album track title progress))
      (list #f #f #f #f #f #f)))

(define (read-file path)
  (call-with-input-file path read-lines))

(define wifi-max-quality 70) ; something magic, driver-specific
(define (wifi-quality)
  (let ((lines (drop (read-file "/proc/net/wireless") 2)))
    (if (not (null? lines))
        (let* ((summary (string-split (car lines)))
               (quality (string->number (list-ref summary 2))))
          (inexact->exact (round (* (/ quality wifi-max-quality) 100))))
        0)))

(define download-column 1)
(define upload-column 9)
(define (internet-speed last-downloads last-uploads)
  (define (process-net-dev lines column)
    (let ((columns
           (map (lambda (line)
                  (string->number (list-ref (string-split line) column)))
                lines)))
      (fold + 0 columns)))
  (let* (;; drop first two header lines
         (lines (drop (read-file "/proc/net/dev") 2))
         ;; remove loopback interface
         (lines (remove (lambda (line) (equal? (car (string-split line)) "lo:"))
                        lines))
         (downloads (process-net-dev lines download-column))
         (download (if last-downloads
                       (/ (- downloads last-downloads) sleep-time)
                       0))
         (uploads (process-net-dev lines upload-column))
         (upload (if last-uploads
                     (/ (- uploads last-uploads) sleep-time)
                     0)))
    (list downloads (/ download 1024.0) uploads (/ upload 1024.0))))

(define (clamp value)
  (min (max value 0) 100))

(define cpu-count 2)
(define (cpu-usage last-cpu-usage)
  (let* ((lines (read-file "/proc/stat"))
         (summary (cdr (string-split (car lines))))
         (user (string->number (car summary)))
         (nice (string->number (cadr summary)))
         (system (string->number (list-ref summary 2)))
         (used (+ user nice system))
         (percentage (if last-cpu-usage
                         (/ (- used last-cpu-usage) cpu-count sleep-time)
                         0))) ;; hack for displaying 0% at beginning
    (list used (clamp (inexact->exact (round percentage))))))

(define thermal-path "/sys/bus/acpi/devices/LNXTHERM:00/thermal_zone/temp")
(define (cpu-temperature)
  (let ((line (car (read-file thermal-path))))
    (/ (string->number line) 1000)))

(define (used-ram-percentage)
  (let* ((lines (read-file "/proc/meminfo"))
         (available (string->number (cadr (string-split (car lines)))))
         (free (string->number (cadr (string-split (cadr lines)))))
         (buffers (string->number (cadr (string-split (list-ref lines 3)))))
         (cached (string->number (cadr (string-split (list-ref lines 4)))))
         (used (- available free buffers cached)))
    (clamp (inexact->exact (round (* (/ used available) 100))))))

(define (battery)
  (condition-case
   ;; NOTE: unlike with /proc, /sys files are not guaranteed to exist
   (let ((state (car (read-file "/sys/class/power_supply/BAT0/status")))
         (capacity
          (string->number
           (car (read-file "/sys/class/power_supply/BAT0/capacity")))))
     (list state (clamp capacity)))
   ((exn i/o file) (list "Unavailable" 0))))

(define (format-time)
  (time->string (seconds->local-time) "%H:%M"))

(define (main)
  (set-buffering-mode! (current-output-port) #:line)
  (print "{\"version\":1}")
  (print "[")
  (let loop ((battery-blinker #f)
             (last-cpu-usage #f)
             (last-downloads #f)
             (last-uploads #f))
    (match-let (((mpd-playing? mpd-artist mpd-album mpd-track mpd-title mpd-progress)
                 (mpd-state))
                (wifi (wifi-quality))
                ((last-downloads download-speed last-uploads upload-speed)
                 (internet-speed last-downloads last-uploads))
                ((last-cpu-usage cpu-percentage) (cpu-usage last-cpu-usage))
                (cpu-temp (cpu-temperature))
                (ram (used-ram-percentage))
                ((battery-state battery-percentage) (battery))
                (time (format-time))

                (foreground "#949494")
                (background "#1c1c1c")
                (highlight "#eeeeee")
                (purple "#ff0087")
                (cyan "#00d7ff")
                (green "#00d700")
                (orange "#ff5f00")
                (blue "#005fff")
                (red "#ff0000")
                (violet "#af00d7")
                (yellow "#ffd700"))
      (write-json
       (vector `((full_text . ,(if mpd-playing? "MPD: " "._."))
                 (color . ,purple)
                 ,@(if mpd-playing?
                       '((separator . #f) (separator_block_width . 1))
                       '((separator . #t))))
               `((full_text . ,(if mpd-playing? (or mpd-artist "N/A") ""))
                 (color . ,(if mpd-artist foreground cyan))
                 (separator . #f) (separator_block_width . 1))
               `((full_text . ,(if mpd-playing? " - [" ""))
                 (color . ,highlight)
                 (separator . #f) (separator_block_width . 1))
               `((full_text . ,(if mpd-playing? (or mpd-album mpd-progress) ""))
                 (color . ,foreground)
                 (separator . #f) (separator_block_width . 1))
               `((full_text . ,(if mpd-playing? (if mpd-album " #" "") ""))
                 (color . ,highlight)
                 (separator . #f) (separator_block_width . 1))
               `((full_text . ,(if mpd-playing? (if mpd-album (or mpd-track "N/A") "") ""))
                 (color . ,(if (and mpd-playing? mpd-album (not mpd-track)) cyan foreground))
                 (separator . #f) (separator_block_width . 1))
               `((full_text . ,(if mpd-playing? "] - " ""))
                 (color . ,highlight)
                 (separator . #f) (separator_block_width . 1))
               `((full_text . ,(if mpd-playing? (or mpd-title "N/A") ""))
                 (color . ,(if mpd-title foreground cyan)))
               `((full_text . "WiFi: ") (color . ,cyan)
                 (separator . #f) (separator_block_width . 1))
               `((full_text . ,(number->string wifi))
                 (color . ,(if (<= wifi 33) red foreground))
                 (separator . #f) (separator_block_width . 1))
               `((full_text . "%") (color . ,foreground))
               `((full_text . "Down: ") (color . ,green)
                 (separator . #f) (separator_block_width . 1))
               `((full_text . ,(format "~,1f" download-speed))
                 (color . ,(if (>= download-speed 500) red foreground)))
               `((full_text . "Up: ") (color . ,orange)
                 (separator . #f) (separator_block_width . 1))
               `((full_text . ,(format "~,1f" upload-speed))
                 (color . ,(if (>= upload-speed 90) red foreground)))
               `((full_text . "CPU: ") (color . ,blue)
                 (separator . #f) (separator_block_width . 1))
               `((full_text . ,(number->string cpu-percentage))
                 (color . ,(if (>= cpu-percentage 50) red foreground))
                 (separator . #f) (separator_block_width . 1))
               `((full_text . "%") (color . ,foreground)
                 (separator . #f) (separator_block_width . 1))
               `((full_text . ,(format " (~dC)" cpu-temp))
                 (color . ,(if (>= cpu-temp 80) red foreground)))
               `((full_text . "RAM: ") (color . ,red)
                 (separator . #f) (separator_block_width . 1))
               `((full_text . ,(number->string ram))
                 (color . ,(if (>= ram 75) red foreground))
                 (separator . #f) (separator_block_width . 1))
               `((full_text . "%") (color . ,foreground))
               `((full_text . "BAT: ") (color . ,violet)
                 (separator . #f) (separator_block_width . 1))
               `((full_text . ,(number->string battery-percentage))
                 (color . ,(cond
                            ((string=? battery-state "Full") green)
                            ((<= battery-percentage 20)
                             (if battery-blinker red background))
                            ((string=? battery-state "Discharging") yellow)
                            ((string=? battery-state "Charging") cyan)
                            (else foreground)))
                 (separator . #f) (separator_block_width . 1))
               `((full_text . "%") (color . ,foreground))
               `((full_text . "Time: ") (color . ,yellow)
                 (separator . #f) (separator_block_width . 1))
               `((full_text . ,(string-append time " "))
                 (color . ,foreground))))
      (print ",")
      (thread-sleep! sleep-time)
      (loop (not battery-blinker)
            last-cpu-usage
            last-downloads
            last-uploads))))

(condition-case (main)
  (condition (exn)
   (with-output-to-file "statusbar.log"
     (lambda () (pp (condition->list condition))))))