From f62d3d8c2bc488f26fa21a3f824879d614570aec Mon Sep 17 00:00:00 2001 From: jao Date: Sat, 13 Aug 2022 17:15:15 +0100 Subject: lib: clean ups --- lib/Monitors.hs | 236 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 236 insertions(+) create mode 100644 lib/Monitors.hs (limited to 'lib/Monitors.hs') 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" , " \ + \ยท " + , "-w", "10", "-L" , "10", "-H", "80"]) 15 + +topProc' p = TopProc (p <~> ["-t" , " \ + \ยท " + , "-w", "10", "-L" , "10", "-H", "80"]) 15 + +wireless p n = Wireless n (p >~< ["-t", "" + -- fc (pLow p) (fni "\xf1eb " ++ "") + -- \xf09e + , "-W", "5", "-M", "15" , "-m", "3" + , "-L", "20", "-H", "80"]) 20 + +cpu p = MultiCpu (p <~> ["-t", "" + , "-S", "on", "-c", " " , "-L", "30", "-H", "70" + , "-p", "3", "-a", "l"]) 10 + +multiCPU p = MultiCpu (p <~> ["-t", "" + , "-S", "on", "-b", " ", "-f", "*" + , "-c", " " , "-L", "30", "-H", "70" + , "-p", "3", "-a", "l"]) 10 + +cpuBars p = MultiCpu (mkArgs p + ["--template" , " %" + , "-L", "50", "-H", "85", "-w", "3"] + ["--fallback-icon-pattern", "" + , "--contiguous-icons"]) + 10 + +cpuFreq p = CpuFreq (p <~> ["-t" , " " + , "-L", "1", "-H", "2", "-S", "Off" , "-d", "2"]) 50 + +uptime p = Uptime (p <~> [ "-t" , " ", "-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' " ยฐ % ()" + +-- "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 ("") ++ x ++ urlEncode "" + encode c + | c == ' ' = "+" + | Char.isAlphaNum c || c `elem` "-._~" = [c] + | otherwise = Printf.printf "%%%02X" c + urlEncode = concatMap encode + +batt p = + BatteryN ["BAT0"] + ["-t", " " + , "-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" ++ " " + , "-o", fn 2 " ๐Ÿ”‹" ++ " " + , "-H", "10", "-L", "7" + , "-h", pHigh p, "-l", pLow p] 50 "batt0" + +iconBatt p = + BatteryN ["BAT0"] + ["-t", "" + , "-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 " \xf1e6" ++ " " + , "-o", fni "" ++ " " + , "-H", "10", "-L", "7" + , "-h", pHigh p, "-l", pLow p] 50 "batt0" + +rizenTemp p = + K10Temp "0000:00:18.3" + (mkArgs p ["-t", "ยฐC", "-L", "40", "-H", "70", "-d", "0"] []) 50 + +thinkTemp p = + MultiCoreTemp (mkArgs p + ["-t", "ยฐC", "-L", "40", "-H", "70", "-d", "0"] + []) 50 + +avgCoretemp p = + MultiCoreTemp (p <~> ["-t", "ยฐ" + , "-L", "50", "-H", "75", "-d", "0"]) 50 + +coreTemp p = + MultiCoreTemp (p <~> ["-t", "ยฐ ยฐ" + , "-L", "50", "-H", "75", "-d", "0"]) 50 + +load p = + Load (p <~> ["-t" , " ", "-L", "1", "-H", "3", "-d", "2"]) + 300 + +diskU p = + DiskU [("/", "") , ("/media/sda", " s ")] + (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", "", "-c"] + +diskIO p = + DiskIO [("rivendell-vg/root", " ")] (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", " " + , "--", "-C", pForeground p, "-c", "sienna4" + , "-O", fni "\xf025" -- "\xf130" -- fn 2 "๐ŸŽง" + , "-o", fn 4 "๐Ÿ”‡" + ] 10 + +captureVol = Volume "default" "Capture" ["-t", ""] 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" ,":" + , "-p", "2", "-W", "4","-d", "1" + , "--", "--scale", "1024"] 20 + +dynNetwork p = DynNetwork (p <~> ["-t", fn 1 "โ†‘ " ++ " " ++ fn 1 "โ†“" ++ " " + , "-L", "20", "-H", "1024000" + , "-m", "5", "-W", "10", "-S", "Off"]) 10 + +netdev name icon = Network name ["-t", "", "-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 -- cgit v1.2.3