rktbar.rkt

#!/usr/bin/env racket
#lang racket
(require (for-syntax racket/format))
(require racket/date)


(define-syntax (bar-definitions bar)
  (syntax-case bar ()
    [(_ forms ...)
     #`(begin
         #,@(for/list ([form (map syntax-e (syntax->list #'(forms ...)))])
              (with-syntax
                ([id (datum->syntax bar (car form))]
                 [compiled-format (format "%{~a}~~a~a"
                                          (syntax->datum (cadr form))
                                          (if (= (length form) 3)
                                              (~a "%{" (syntax->datum (caddr form)) "}")
                                              ""))])

                #'(define (id text . args)
                    (apply format compiled-format (append args (list text)))))))]))
(define-syntax (define-module defmodule)
  (syntax-case defmodule ()
    [(_ (id) forms ...)
     #'(define (id) (thread
                     (lambda ()
                       (letrec ([body (lambda ()
                                      (let ([value (cons id (begin
                                                              forms ...))])
                                        (channel-put bar-channel value))
                                      (body))])
                       (body)))))]))

(bar-definitions
 (fg->bg "R" "R")
 (left "l")
 (middle "m")
 (right "r")
 (foreground "F~a" "F-")
 (background "B~a" "B-")
 (offset "O~a")
 (font "T~a" "T-")
 (underline "U~a" "U-")
 (button "A~a:~a" "A")
 (monitor "S~a"))


(define bar-channel (make-channel))

(define (capture cmd)
  (string-trim
   (with-output-to-string
     (lambda () (system cmd)))))

(define (get-volume)

  (string->number
   (cadr
    (regexp-match #px"\\[([0-9]{2})%\\]" (capture "amixer sget Master")))))

(define (get-wifi)
  (string-trim (capture "iwgetid -r")))

(define (get-wifi-strength)
  (string->number (cadr (regexp-match #px"\\d{4}\\s+(\\d{2})" (file->string "/proc/net/wireless")))))

(define-module (wifi-module)
  (sleep 5)
  (let [(wifi-ssid (get-wifi))
        (wifi-strength (get-wifi-strength))]
    (~a (foreground (cond
                      ((or (<= wifi-strength 0) (equal? wifi-ssid "")) " ")
                      ((<= wifi-strength 34) " ")
                      ((<= wifi-strength 67) " ")
                      ((<= wifi-strength 100) " "))
                    "#bf616a")
        (~a wifi-ssid #:max-width 20
            #:limit-marker "..."))))

(define-module (volume-module)
  (let ([input (open-input-file "bar.events" #:mode 'text)])
    (let ([line (read-line input)])
      (close-input-port input)
      (when (and (not (eof-object? line)) (string-prefix? line "volume:"))
        (left (~a (foreground " " "#d08770") (substring line 7) "%"))))))

(define-module (kernel-module)
  (sleep 5)
  (capture "uname -a"))

(define-module (battery-module)
  (let [(output (capture "acpi -b"))]
    (if (equal? output "")
        (thread-suspend (current-thread))
        (let [(status (battery-status output))]
          (left (~a (match
                        ['charging ""]
                      ['charged ""]
                      [(? (curry >= 10) n) ""]
                      [(? (curry >= 66) n) ""]
                      [(? (curry >= 100) n) ""]) ()))) )))

(define-module (mpd-module)
  (sleep 1)
  (middle
   (capture "mpc current")))

(define-module (time-module)
  (sleep 1)
  (let [(cur-date (current-date))]
    (~a
     (date-hour cur-date) ":" (~a (date-minute cur-date)
                                  #:min-width 2
                                  #:align 'right
                                  #:left-pad-string "0"))))

(define (workspace-from bspc-status)
  (let ([monitor-segments (string-split (cadr (string-split bspc-status "M")) ":")])
    (substring (car (filter (lambda (segment)
                              (member (substring segment 0 1) '("O" "F")))
                            monitor-segments)) 1)))


(define (workspace-module)
  (match-let ([(list pin _ _ perr status)
               (process "bspc subscribe report")])
    (thread
     (lambda ()
       (letrec ([body (lambda ()
                        (let ([line (workspace-from (read-line pin))])
                          (when (not (eof-object? line))
                            (channel-put bar-channel (cons workspace-module line))
                            (body))))])
         (body))))))

(define ordering (list
                  (list kernel-module volume-module)
                  workspace-module
                  mpd-module
                  wifi-module
                  time-module))

(define (build-bar bar-status)
  (apply string-append (map
                        (lambda (m)
                          (if (hash-has-key? bar-status m)
                                        (hash-ref bar-status m)
                                        "")) ordering)))

(define (resolve-key bar-segment)
  (for/first ([item ordering]
              #:when (if (list? item)
                         (member bar-segment item)
                         (equal? item bar-segment)))
    item))

(define (bar-loop bar-status)
  (match-let ([(cons module-name module-value)
               (channel-get bar-channel)])
    (let ([key (resolve-key module-name)])
      (if (and
           (hash-has-key? bar-status key)
           (equal? (hash-ref bar-status key)
                   module-value))
          (bar-loop bar-status)
          (let ([bar-status (hash-set bar-status key module-value)])
            (displayln bar-status)
            (displayln (build-bar bar-status))
            (bar-loop bar-status))))))

(define (start-threads threads)
  (for ([worker threads])
    (if (list? worker)
        (start-threads worker)
        (worker))))

(define (main)
  (start-threads ordering)
  (bar-loop (hash)))

(main)