From f62d3d8c2bc488f26fa21a3f824879d614570aec Mon Sep 17 00:00:00 2001
From: jao <jao@gnu.org>
Date: Sat, 13 Aug 2022 17:15:15 +0100
Subject: lib: clean ups

---
 lib/Bottom.hs   |  35 +++++++++
 lib/Config.hs   | 117 ++++++++++++++++++++++++++++
 lib/Monitors.hs | 236 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 lib/Music.hs    |  53 +++++++++++++
 4 files changed, 441 insertions(+)
 create mode 100644 lib/Bottom.hs
 create mode 100644 lib/Config.hs
 create mode 100644 lib/Monitors.hs
 create mode 100644 lib/Music.hs

(limited to 'lib')

diff --git a/lib/Bottom.hs b/lib/Bottom.hs
new file mode 100644
index 0000000..5b2b6c9
--- /dev/null
+++ b/lib/Bottom.hs
@@ -0,0 +1,35 @@
+module Bottom (config) where
+
+import Xmobar
+import Config
+import Monitors
+
+-- ⏱
+config cs tpl p = (baseConfig p) {
+  position = BottomSize C 100 defaultHeight
+  , textOffset = defaultHeight - 6
+  , textOffsets = [defaultHeight - 6, defaultHeight - 6,
+                   defaultHeight - 4, defaultHeight - 8,
+                   defaultHeight - 7]
+  , border = TopB
+  , template = "|tray| \
+               \<action=`toggle-app.sh nm-applet`>|proton0||wlp1s0wi|</action> \
+               \ |dynnetwork| \
+               \ <action=`toggle-app.sh pasystray`>|default:Master|\
+               \ |default:Capture|</action>  <fn=2>🎵</fn>"
+             ++ tpl
+             ++ " {} |mail|  |EGPH| \
+                \ <fn=2>🗓  </fn>|uptime| <fn=2>🕓 </fn>|datetime| |laTime| "
+  , commands = [ Run (uptime p)
+               , Run (wireless p "wlp1s0")
+               , Run (dynNetwork p)
+               , Run proton0
+               , Run (weather "EGPH" p) -- LEGE, LEBL, KCV0
+               , Run trayPadding
+               , Run (mail p)
+               , Run (masterVol p)
+               , Run captureVol
+               , Run laTime
+               , Run localTime
+               ] ++ cs
+}
diff --git a/lib/Config.hs b/lib/Config.hs
new file mode 100644
index 0000000..7e1b2bb
--- /dev/null
+++ b/lib/Config.hs
@@ -0,0 +1,117 @@
+module Config (
+  Palette(..), baseConfig, palette, (<~>), (>~<),
+  mkArgs, defaultHeight, fc, fn, fni)
+ where
+
+import System.Environment (lookupEnv)
+
+import Xmobar
+
+defaultHeight :: Int
+defaultHeight = 24
+
+data Palette = Palette { pNormal :: String
+                       , pLow :: String
+                       , pHigh :: String
+                       , pDim :: String
+                       , pFont :: String
+                       , pBorder :: String
+                       , pForeground :: String
+                       , pBackground :: String
+                       , pAlpha :: Int
+                       , pIconRoot :: String
+                       , pIsLight :: Bool
+                       , pWm :: Maybe String
+                       }
+
+fc color thing = "<fc=" ++ color ++ ">" ++ thing ++ "</fc>"
+fn n thing = "<fn=" ++ show n ++ ">" ++ thing ++ "</fn>"
+fni = fn 6
+
+lightTheme :: IO Bool
+lightTheme = fmap (== Just "light") (lookupEnv "JAO_COLOR_SCHEME")
+
+icons k = "/home/jao/.config/xmobar/icons/" ++ k
+
+lightPalette :: Palette
+lightPalette = Palette { pNormal = "#000000"
+                       , pLow = "#4d4d4d"
+                       , pHigh = "#a0522d"
+                       , pDim = "#999999"
+                       , pFont = "xft:DejaVu Sans Mono-8"
+                       , pBorder = "#cccccc"
+                       , pForeground = "#000000"
+                       , pBackground = "#ffffff"
+                       , pAlpha = 229
+                       , pIconRoot = icons "light"
+                       , pIsLight = True
+                       , pWm = Nothing
+                       }
+
+zenburnRed = "#CC9393"
+-- zenburnBack = "#2B2B2B"
+zenburnBack = "#1f1f1f"
+zenburnBackLight = "#383838"
+zenburnFg = "#989890" -- "#DCDCCC"
+zenburnYl = "#F0DFAF"
+zenburnGreen = "#7F9F7F"
+doomBack = "#22242b"
+
+darkPalette :: Palette
+darkPalette = Palette { pNormal = zenburnFg
+                      , pLow = "darkseagreen4" -- zenburnGreen
+                      , pHigh = zenburnRed
+                      , pFont = "xft:DejaVu Sans Mono-8"
+                      , pDim = "#7f7f7f"
+                      , pBorder = "#000000" -- zenburnBackLight
+                      , pForeground = zenburnFg
+                      , pBackground = doomBack -- zenburnBack
+                      , pAlpha = 255
+                      , pIconRoot = icons "dark"
+                      , pIsLight = False
+                      , pWm = Nothing
+                      }
+
+palette :: IO Palette
+palette = do
+  light <- lightTheme
+  wm <- lookupEnv "wm"
+  let p = if light then lightPalette else darkPalette
+  return $ p {pWm = wm}
+
+baseConfig :: Palette -> Config
+baseConfig p = defaultConfig {
+  font = pFont p
+  , borderColor = pBorder p
+  , fgColor = pForeground p
+  , bgColor = pBackground p
+  , additionalFonts = [ "xft:Symbola-9"
+                      , "xft:Symbola-10"
+                      , "xft:Symbola-11"
+                      , "xft:Symbola-11"
+                      , "xft:Symbola-12"
+                      , "xft:FontAwesome-10"
+                      , "xft:FontAwesome-9"]
+
+  , border = NoBorder
+  , alpha = pAlpha p
+  , overrideRedirect = True
+  , lowerOnStart = True
+  , hideOnStart = False
+  , allDesktops = True
+  , persistent = True
+  , sepChar = "|"
+  , alignSep = "{}"
+  , iconRoot = pIconRoot p
+  }
+
+(<~>) :: Palette -> [String] -> [String]
+(<~>) p args =
+  args ++ [ "--low", pLow p , "--normal", pNormal p , "--high", pHigh p]
+
+(>~<) :: Palette -> [String] -> [String]
+(>~<) p args =
+  args ++ [ "--low", pHigh p , "--normal", pNormal p , "--high", pLow p]
+
+mkArgs :: Palette -> [String] -> [String] -> [String]
+mkArgs p args extra = concat [p <~> args, ["--"], extra]
diff --git a/lib/Monitors.hs b/lib/Monitors.hs
new file mode 100644
index 0000000..e617697
--- /dev/null
+++ b/lib/Monitors.hs
@@ -0,0 +1,236 @@
+module Monitors where
+
+import Xmobar
+import Config
+import Control.Concurrent
+import Control.Concurrent.Async (async)
+import Control.Concurrent.STM
+import qualified Data.Char as Char
+import qualified Text.Printf as Printf
+
+data CombinedMonitor a b = CombinedMonitor a b (String -> String -> String)
+
+instance (Show a, Show b) => Show (CombinedMonitor a b) where
+  show (CombinedMonitor a b _) = "Alt (" ++ show a ++ ") (" ++ show b ++ ")"
+
+instance (Read a, Read b) => Read (CombinedMonitor a b) where
+  readsPrec _ = undefined
+
+instance (Exec a, Exec b) => Exec (CombinedMonitor a b) where
+  alias (CombinedMonitor a b _) = alias a ++ "_" ++ alias b
+  rate (CombinedMonitor a b _) = min (rate a) (rate b)
+  start (CombinedMonitor a b comb) cb
+    = startMonitors a b (\s t -> cb $ comb s t)
+
+startMonitors a b cmb =  do
+    sta <- atomically $ newTVar ""
+    stb <- atomically $ newTVar ""
+    _ <- async $ start a (atomically . writeTVar sta)
+    _ <- async $ start b (atomically . writeTVar stb)
+    go sta stb
+      where go sta' stb' = do
+              s <- readTVarIO sta'
+              t <- readTVarIO stb'
+              cmb s t
+              tenthSeconds $ min (rate b) (rate a)
+              go sta' stb'
+
+guardedMonitor a p = CombinedMonitor (PipeReader p (alias a ++ "_g")) a f
+  where f s t = if null s || head s == '0' then "" else t
+
+altMonitor a b = CombinedMonitor a b (\s t -> if null s then t else s)
+concatMonitor sep a b = CombinedMonitor a b (\s t -> s ++ sep ++ t)
+toggleMonitor path a = altMonitor (guardedMonitor a path)
+
+topProc p = TopProc (p <~> ["-t" , "<mboth3>  <mboth2>  <mboth1> \
+                                   \· <both3>  <both2>  <both1>"
+                           , "-w", "10", "-L" , "10", "-H", "80"]) 15
+
+topProc' p = TopProc (p <~> ["-t" , "<mboth1>  <mboth2>  <mboth3> \
+                                   \· <both1>  <both2>  <both3>"
+                           , "-w", "10", "-L" , "10", "-H", "80"]) 15
+
+wireless p n = Wireless n (p >~< ["-t", "<essid>"
+                                 -- fc (pLow p) (fni "\xf1eb " ++ "<essid>")
+                                 -- <quality>\xf09e
+                                 , "-W", "5", "-M", "15" , "-m", "3"
+                                 , "-L", "20", "-H", "80"]) 20
+
+cpu p = MultiCpu (p <~> ["-t", "<total>"
+                        , "-S", "on", "-c", " " , "-L", "30", "-H", "70"
+                        , "-p", "3", "-a", "l"]) 10
+
+multiCPU p = MultiCpu (p <~> ["-t", "<autototal>"
+                             , "-S", "on", "-b", " ", "-f", "*"
+                             , "-c", " " , "-L", "30", "-H", "70"
+                             , "-p", "3", "-a", "l"]) 10
+
+cpuBars p = MultiCpu (mkArgs p
+                             ["--template" , "<autoipat> <total>%"
+                             , "-L", "50", "-H", "85", "-w", "3"]
+                             ["--fallback-icon-pattern", "<icon=load_%%.xpm/>"
+                             , "--contiguous-icons"])
+            10
+
+cpuFreq p = CpuFreq (p <~> ["-t" , "<avg> <max> <min> <cpu0> <cpu1> <cpu2> <cpu3>"
+                           , "-L", "1", "-H", "2", "-S", "Off" , "-d", "2"]) 50
+
+uptime p = Uptime (p <~> [ "-t" , "<days> <hours>", "-m", "3", "-c", "0", "-S"
+                         , "On" , "-L", "10", "-H", "100"]) 600
+
+weather' tmp st p =
+  WeatherX st
+           [ ("", fc (pDim p) (fn 4 "🌡"))
+           , ("clear", fn 4 "🌣")
+           , ("sunny", fc (pHigh p) $ fn 4 "🌣")
+           , ("fair", fn 4 "🌣")
+           , ("mostly clear", fn 4 "🌤")
+           , ("mostly sunny", fn 4 "🌤")
+           , ("partly sunny", fn 3 "⛅")
+           , ("obscured", fn 4 "🌁") -- 🌫
+           , ("cloudy", fn 3 "☁")
+           , ("overcast", fn 3 "☁️")
+           , ("partly cloudy", fn 3 "⛅")
+           , ("mostly cloudy", fn 3 "☁️")
+           , ("considerable cloudiness",  fn 3 "☁️")
+           , ("light rain", fn 4 "🌧")
+           , ("rain", fn 4 "⛆")
+           , ("ice crystals", snow)
+           , ("light snow", fn 3 "🌨")
+           , ("snow", snow)
+           ]
+           (mkArgs p ["-t", tmp , "-L","10", "-H", "25" , "-T", "25", "-E", ".."]
+                     ["-w", ""])
+           18000
+  where snow = fni "\xf2dc"
+
+weather = weather' "<skyConditionS> <tempC>° <rh>% <windKmh> (<hour>)"
+
+-- "https://wttr.in?format=" ++ fnn 3 "%c" ++ "+%t+%C+%w++" ++ fnn 1 "%m"
+-- , Run (ComX "curl" [wttrURL "Edinburgh"] "" "wttr" 18000)
+wttrURL l = "https://wttr.in/" ++ l ++ "?format=" ++ fmt
+  where fmt = fnn 2 "+%c+" ++ "+%t+%C+" ++ fn 5 "%w"
+        fnn n x = urlEncode ("<fn=" ++ show n ++ ">") ++ x ++ urlEncode "</fn>"
+        encode c
+          | c == ' ' = "+"
+          | Char.isAlphaNum c || c `elem` "-._~" = [c]
+          | otherwise = Printf.printf "%%%02X" c
+        urlEncode = concatMap encode
+
+batt p =
+  BatteryN ["BAT0"]
+           ["-t", "<acstatus> <left>"
+           , "-S", "Off", "-d", "0", "-m", "3"
+           , "-L", "10", "-H", "90", "-p", "3"
+           , "--low", pHigh p, "--normal", pNormal p, "--high", pLow p
+           , "--"
+           , "-P"
+           , "-a", "notify-send -u critical 'Battery running out!!!!!!'"
+           , "-A", "7"
+           , "-i", fn 2 "\9211"
+           , "-O", fn 2 " \9211" ++ " <timeleft> <watts>"
+           , "-o", fn 2 " 🔋" ++ " <timeleft> <watts>"
+           , "-H", "10", "-L", "7"
+           , "-h", pHigh p, "-l", pLow p] 50 "batt0"
+
+iconBatt p =
+  BatteryN ["BAT0"]
+           ["-t", "<acstatus>"
+           , "-S", "Off", "-d", "0", "-m", "2"
+           , "-L", "10", "-H", "90", "-p", "2"
+           , "-W", "0", "-f",
+             "\xf244\xf243\xf243\xf243\xf242\xf242\xf242\xf241\xf241\xf240"
+           , "--low", pHigh p, "--normal", pNormal p, "--high", pLow p
+           , "--"
+           , "-P"
+           , "-a", "notify-send -u critical 'Battery running out!!!!!!'"
+           , "-A", "5"
+           , "-i", fni "\xf1e6"
+           , "-O", fni "<leftbar>  \xf1e6" ++ " <left> <watts> <timeleft>"
+           , "-o", fni "<leftbar>" ++ " <left> <watts> <timeleft>"
+           , "-H", "10", "-L", "7"
+           , "-h", pHigh p, "-l", pLow p] 50 "batt0"
+
+rizenTemp p =
+  K10Temp "0000:00:18.3"
+     (mkArgs p ["-t", "<Tctl>°C", "-L", "40", "-H", "70", "-d", "0"] []) 50
+
+thinkTemp p =
+  MultiCoreTemp (mkArgs p
+                        ["-t", "<core1>°C", "-L", "40", "-H", "70", "-d", "0"]
+                        []) 50
+
+avgCoretemp p =
+  MultiCoreTemp (p <~> ["-t", "<avg>°"
+                       , "-L", "50", "-H", "75", "-d", "0"]) 50
+
+coreTemp p =
+  MultiCoreTemp (p <~> ["-t", "<avg>° <max>°"
+                       , "-L", "50", "-H", "75", "-d", "0"]) 50
+
+load p =
+  Load (p <~> ["-t" , "<load1> <load5> <load15>", "-L", "1", "-H", "3", "-d", "2"])
+       300
+
+diskU p =
+  DiskU [("/", "<used>") , ("/media/sda", " s <used>")]
+        (p <~> ["-L", "20", "-H", "70", "-m", "1", "-p", "3"])
+        20
+
+diskArgs p = mkArgs p
+                ["-f", "░", "-b", " ", "-L", "10000000", "-H" , "100000000"
+                , "-W", "5", "-w", "5", "-p", "3"]
+                ["--total-icon-pattern", "<icon=load_%%.xpm/>", "-c"]
+
+diskIO p =
+  DiskIO [("rivendell-vg/root", "<readb> <writeb> <totalbipat>")] (diskArgs p) 10
+
+mail p = MailX [ ("I", "jao/inbox", pHigh p)
+               , ("b", "bigml/bugs", pHigh p)
+               , ("B", "bigml/inbox", "")
+               , ("S", "bigml/support", "")
+               , ("H", "jao/hacking", "")
+               , ("D", "jao/drivel", "")
+               , ("D", "bigml/drivel", pDim p)
+               , ("R", "feeds/rss", pDim p)
+               , ("E", "feeds/emacs", pDim p)
+               , ("P", "feeds/prog", pDim p)
+               , ("B", "jao/bills", pDim p)
+               , ("L", "bigml/lists", pDim p)
+               ]
+               [ "-d", "~/var/mail", "-s", " "]
+               "mail"
+
+masterVol p =
+  Volume "default" "Master"
+                  ["-t", "<status> <volume>"
+                  , "--", "-C", pForeground p, "-c", "sienna4"
+                  , "-O", fni "\xf025" -- "\xf130" -- fn 2 "🎧"
+                  , "-o", fn 4 "🔇"
+                  ] 10
+
+captureVol = Volume "default" "Capture" ["-t", "<volume>"] 10
+
+kbd p = Kbd [("us", ""), ("us(intl)", kbi pHigh)] -- kbi pDim
+  where kbi a = fc (a p) (fni " \xf11c")
+
+brightness = Brightness ["--", "-D", "intel_backlight"] 10
+brightness' = Brightness ["--", "-D", "amdgpu_bl0", "-C", "brightness"] 10
+
+memory = Memory [ "-t" ,"<used>:<available>"
+                , "-p", "2", "-W", "4","-d", "1"
+                , "--", "--scale", "1024"] 20
+
+dynNetwork p = DynNetwork (p <~> ["-t", fn 1 "↑ " ++ "<tx>  " ++ fn 1 "↓" ++ " <rx>"
+                                 , "-L", "20", "-H", "1024000"
+                                 , "-m", "5", "-W", "10", "-S", "Off"]) 10
+
+netdev name icon = Network name ["-t", "<up>", "-x", "", "--", "--up", icon] 20
+vpnMark n = netdev n $ fn 2 "🔒 " -- fni "\xf0e8 "
+proton0 = vpnMark "proton0"
+tun0 = vpnMark "tun0"
+
+laTime = DateZone "%H" "en_US" "US/Pacific" "laTime" 10
+localTime = Date "%a %d %R" "datetime" 10
+
+trayPadding = Com "padding-width.sh" [] "tray" 20
diff --git a/lib/Music.hs b/lib/Music.hs
new file mode 100644
index 0000000..dc7375c
--- /dev/null
+++ b/lib/Music.hs
@@ -0,0 +1,53 @@
+module Music where
+
+import Xmobar
+import Monitors
+import qualified Bottom
+import Config (defaultHeight, pIsLight, pHigh, fc, fni)
+
+mpris p client width =
+  Mpris2 client
+         ["-t", fni "\xf1bc" ++ " <tracknumber> <title> " ++ fc (pHigh p) "<artist>"
+                ++ " <album> <length> <composer>"
+         , "-T", show width, "-E", "…", "-M", "100", "-x", ""] 40
+
+mprisConfig client p = Bottom.config [Run (mpris p client 165)] "|mpris2|" p
+
+mpd = MPD [ "-W", "12", "-b", "░", "-f", "▒", "-t"
+          , " <lapsed> <fc=honeydew3><fn=5><bar></fn></fc>"] 10 -- fn=5
+
+
+mpdt' c0 c1 c2 = "<ppos>/<plength>  "
+               ++ fc c0 "<title> " ++ fc c1 "<artist> " ++ fc c2 "<album>"
+               ++ " <composer> <date>"
+
+mpdt light =
+  if light
+  then mpdt' "darkolivegreen" "dodgerblue4" "burlywood4"
+  else mpdt' "darkseagreen4" "darkslategray4" "burlywood4"
+
+autoMPD l lgt =
+  AutoMPD [ "-T", l, "-E", "…", "-W", "10", "-t", "<length> " ++ mpdt lgt]
+
+mpdx a p i =
+  MPDX [ "-W", "12", "-b", "░", "-f", "▒", "-t", "<statei> <remaining>"
+       , "--", "-p", p, "-P", fni "\xf144", "-Z", fni i, "-S", fni i] 20 a
+
+mpdMon = mpdx "mpd" "6600" "\xf001"
+mopMon = mpdx "mopidy" "6669" "\xf1bc"
+
+mpdConfig p =
+  (Bottom.config [Run mpd, Run (autoMPD "150" (pIsLight p))] "|mpd| |autompd|" p)
+  {
+  textOffsets = [defaultHeight - 7, defaultHeight - 6]
+  }
+
+compMPD p = concatMonitor " " mpd (autoMPD "150" (pIsLight p))
+alt x p = altMonitor (mpris p x 165) (compMPD p)
+
+gpmd = Run (GMPDP "gmpdp")
+
+config cl p =
+  if cl == "mpd"
+  then mpdConfig p
+  else Bottom.config [Run (alt cl p)] "|mpris2_mpd_autompd|" p
-- 
cgit v1.2.3