commit f26f36281b1fa38f795730f78448b5c45fca3885 Author: Ricard Illa Date: Wed Nov 4 17:12:03 2020 +0100 initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..f693319 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +.stack-work/ +*~ +hmonitors.cabal +stack.yaml.lock diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..e637cde --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2020 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..157c052 --- /dev/null +++ b/README.md @@ -0,0 +1,11 @@ +# hmonitors + +This is a collection of monitors the I use as widgets in xmobar. +Currently implemented: + * battery (throug acpi) + * volume (throuugh alsa) + * network (through network-manager) + +They are all one-shot scripts, intended for xmobar to run periodically. +They are very ad-hoc to my use case. Even the icons (using NerdFonts) and +colors (I use the gruvbox color scheme) are hard-coded. diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..55ac3c3 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,24 @@ +module Main where + +import Text.Printf +import System.Environment + +import Monitors.Battery (queryBattery) +import Monitors.Date (queryDate) +import Monitors.Net (queryNet) +import Monitors.Volume (queryVolume) + +usage :: IO String +usage = printf "%s battery | volume | net" <$> getProgName + +main :: IO () +main = do + args <- getArgs + output <- case args of + [ "bat" ] -> queryBattery + [ "vol" ] -> queryVolume + [ "net" ] -> queryNet + [ "date" ] -> queryDate True + [ "date-min" ] -> queryDate False + _ -> usage + putStrLn output diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..950b12e --- /dev/null +++ b/package.yaml @@ -0,0 +1,36 @@ +name: hmonitors +version: 0.1.0.0 +license: BSD3 +author: "Ricard Illa" +maintainer: "r.illa.pujagut@gmail.com" +copyright: "2020 Ricard Illa Pujagut" + +extra-source-files: +- README.md + +description: Please see README.md + +dependencies: +- base +- containers +- process +- regex-compat +- split +- time + +library: + source-dirs: src + +executables: + hmonitors-query: + main: Main.hs + source-dirs: app + ghc-options: + - -Wall + - -Werror + - -O2 + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - hmonitors diff --git a/src/Monitors/Battery.hs b/src/Monitors/Battery.hs new file mode 100644 index 0000000..d6c57f9 --- /dev/null +++ b/src/Monitors/Battery.hs @@ -0,0 +1,134 @@ +module Monitors.Battery (queryBattery) where + +import Data.List +import Data.Maybe +import System.Process +import Text.Printf +import Text.Regex +import qualified Data.Map as M + +import Monitors.Common + +data BatteryData = BatteryData + { battery :: String + , state :: String + , percent :: Int + , time :: Maybe (Int,Int) + } + +dischargingIcons :: M.Map Int String +dischargingIcons = M.map buildIcon $ M.fromList + [ ( 0 , 62861 ) + , ( 10 , 62841 ) + , ( 20 , 62842 ) + , ( 30 , 62843 ) + , ( 40 , 62844 ) + , ( 50 , 62845 ) + , ( 60 , 62846 ) + , ( 70 , 62847 ) + , ( 80 , 62848 ) + , ( 90 , 62849 ) + , ( 100 , 62840 ) + ] + +chargingIcons :: M.Map Int String +chargingIcons = M.map buildIcon $ M.fromList + [ ( 20 , 62853 ) + , ( 30 , 62854 ) + , ( 40 , 62855 ) + , ( 60 , 62856 ) + , ( 80 , 62857 ) + , ( 90 , 62858 ) + , ( 100 , 62852 ) + ] + +alertIcon :: String +alertIcon = buildIcon 62850 + +unknownIcon :: String +unknownIcon = buildIcon 62864 + +fullIcon :: String +fullIcon = buildIcon 62851 + +getColor :: Int -> String +getColor charge = fromMaybe def (M.lookup getKey colors) + where + getKey + | charge < 20 = "red" + | charge >= 20 && charge < 80 = "yellow" + | charge >= 80 && charge <= 100 = "green" + | otherwise = "active" + def = "#ffffff" + +iconSel :: Ord a => a -> M.Map a String -> String +iconSel a xs = fromMaybe def $ findKey a xs >>= lookupKey xs + where + findKey b ys = getNextAbove b (M.keys ys) + lookupKey = flip M.lookup + getNextAbove a = listToMaybe . dropWhile (< a) . sort + def = unknownIcon + +getIcon :: BatteryData -> String +getIcon BatteryData { state = "Charging", percent = charge } = iconSel charge chargingIcons +getIcon BatteryData { state = "Discharging", percent = charge } = iconSel charge dischargingIcons +getIcon BatteryData { state = "Full" } = fullIcon +getIcon BatteryData { state = "Unknown" } = unknownIcon +getIcon _ = unknownIcon + +parseBatteryInfo :: String -> Maybe BatteryData +parseBatteryInfo = fmap fmtBattery . matchRegex regex + where + regex = mkRegex "^(.+): (.+), ([0-9]+)%(, ([0-9]+):([0-9]+):[0-9]+ .+)?" + fmtBattery [b,s,p,_,h,m] = + let + t = if h /= "" && m /= "" + then Just (read h,read m) + else Nothing + in BatteryData + { battery = b + , state = s + , percent = read p + , time = t + } + +getColorIcon :: BatteryData -> String +getColorIcon BatteryData { state = "Full" } = colorize (colors M.! "active") fullIcon +getColorIcon x@BatteryData { percent = charge } = colorize (getColor charge) (getIcon x) + +getStatus :: BatteryData -> String +getStatus x@BatteryData { state = "Full" } = getColorIcon x + +getStatus x@BatteryData { state = "Unknown", percent = charge } + | charge >= 95 = getStatus x{ state="Full" } + | otherwise = + let + fmt = "%s %d" + colorIcon = getColorIcon x + in printf fmt colorIcon charge + +getStatus x@BatteryData { state = "Charging", percent = charge } = + let + fmt = "%s %d" + colorIcon = getColorIcon x + in printf fmt colorIcon charge + +getStatus x@BatteryData { state = "Discharging", percent = charge, time = (Just (h,m)) } = + let + fmt = "%s %d (%d:%02d)" + colorIcon = getColorIcon x + in printf fmt colorIcon charge h m + +getStatus _ = colorize (colors M.! "active") unknownIcon + +parseAcpiStdout :: String -> [BatteryData] +parseAcpiStdout = mapMaybe parseBatteryInfo . lines + +fmtData :: [BatteryData] -> String +fmtData = (separator ++ ) . intercalate separator . map getStatus + +runAcpi :: IO String +runAcpi = readProcess "acpi" ["-b"] "" + +queryBattery :: IO String +queryBattery = fmtData . parseAcpiStdout <$> runAcpi diff --git a/src/Monitors/Common.hs b/src/Monitors/Common.hs new file mode 100644 index 0000000..c7cb913 --- /dev/null +++ b/src/Monitors/Common.hs @@ -0,0 +1,29 @@ +module Monitors.Common + ( colors + , colorize + , separator + , buildIcon + ) where + +import qualified Data.Map as M +import Text.Printf +import Data.Char + +colors :: M.Map String String +colors = M.fromList + [ ( "active" , "#ebdbb2" ) + , ( "inactive" , "#a89974" ) + , ( "red" , "#fb4944" ) + , ( "yellow" , "#fabd2f" ) + , ( "green" , "#b8bb26" ) + , ( "blue" , "#83a587" ) + ] + +colorize :: String -> String -> String +colorize = printf "%s" + +separator :: String +separator = printf " %s " . colorize (colors M.! "inactive") $ "|" + +buildIcon :: Int -> String +buildIcon = printf "%c" . chr diff --git a/src/Monitors/Date.hs b/src/Monitors/Date.hs new file mode 100644 index 0000000..a1e5e4a --- /dev/null +++ b/src/Monitors/Date.hs @@ -0,0 +1,31 @@ +module Monitors.Date (queryDate) where + +import Data.Time +import Text.Printf +import qualified Data.Map as M + +import Monitors.Common + + +icons :: M.Map String String +icons = M.map buildIcon $ M.fromList + [ ( "clock" , 63055 ) + , ( "calendar" , 62957 ) + ] + +fullFmtter :: Bool -> String -> String -> String +fullFmtter True icon x = printf "%s %s" (icons M.! icon) x +fullFmtter _ _ x = x + +fmtter :: FormatTime t => Bool -> String -> String -> t -> String +fmtter full icon fmt = (fullFmtter full icon) . (formatTime defaultTimeLocale fmt) + +fmtTime :: FormatTime t => Bool -> t -> String +fmtTime full time = + let + date = fmtter full "calendar" "%m/%d" time + hour = fmtter full "clock" "%H:%M" time + in printf "%s%s%s%s " separator date separator hour + +queryDate :: Bool -> IO String +queryDate full = fmtTime full <$> getZonedTime diff --git a/src/Monitors/Net.hs b/src/Monitors/Net.hs new file mode 100644 index 0000000..8932f9a --- /dev/null +++ b/src/Monitors/Net.hs @@ -0,0 +1,124 @@ +module Monitors.Net (queryNet) where + +import Data.List.Split +import Data.List +import Data.Maybe +import System.Process +import Text.Printf +import Text.Regex +import qualified Data.Map as M + +import Monitors.Common + +data DeviceType = Wifi | Ethernet | OtherDevice + +data DeviceData = DeviceData + { deviceName :: String + , deviceType :: DeviceType + , connected :: Bool + , signal :: Maybe Int + } + +icons :: M.Map String String +icons = M.map buildIcon $ M.fromList + [ ( "wifi" , 64168 ) + , ( "wifi-off" , 64169 ) + , ( "ethernet" , 63231 ) + ] + +offline :: String +offline = colorize (colors M.! "inactive") (icons M.! "wifi-off") + +getConnectivity :: IO String +getConnectivity = head . lines <$> readProcess "nmcli" args "" + where args = ["networking", "connectivity", "check"] + +getDevStatus :: IO [DeviceData] +getDevStatus = readProcess "nmcli" args "" >>= mapM buildDeviceData . lines + where + args = ["--terse", "--fields", "device,type,state", "device", "status"] + +buildDeviceData :: String -> IO DeviceData +buildDeviceData x = + let + [d,t,state] = splitOn ":" x + deviceType = readDeviceType t + connected = state == "connected" + in do + signal <- getWifiSignal deviceType d + return DeviceData + { deviceName = d + , deviceType = deviceType + , connected = connected + , signal = signal + } + +readDeviceType :: String -> DeviceType +readDeviceType "wifi" = Wifi +readDeviceType "ethernet" = Ethernet +readDeviceType _ = OtherDevice + +getWifiSignal :: DeviceType -> String -> IO (Maybe Int) +getWifiSignal Wifi dev = parseStdout <$> readProcess "nmcli" args "" + where + args = + [ "--terse" + , "--fields", "in-use,signal" + , "device", "wifi", "list" + , "ifname", dev + ] + splt = splitOn ":" + isActive = (=="*") . head . splt + readVal = read . (!! 1) . splt + parseStdout = fmap readVal . find isActive . lines +getWifiSignal _ _ = return Nothing + +getActiveDevs :: IO [DeviceData] +getActiveDevs = filter activeDev <$> getDevStatus + where + activeDev :: DeviceData -> Bool + activeDev DeviceData { deviceType = Wifi, connected = True } = True + activeDev DeviceData { deviceType = Ethernet, connected = True } = True + activeDev _ = False + +getSignalColor :: Maybe Int -> String +getSignalColor x = fromMaybe (colors M.! def) (M.lookup (getKey x) colors) + where + def = "active" + getKey Nothing = def + getKey (Just x) + | x < 30 = "red" + | x >= 30 && x < 60 = "yellow" + | x >= 60 && x <= 100 = "green" + | otherwise = def + + +makeDevIcon :: DeviceData -> String + +makeDevIcon DeviceData { deviceType = Ethernet } = + colorize (colors M.! "active") (icons M.! "ethernet") + +makeDevIcon DeviceData { deviceType = Wifi, signal = signal@(Just s) } = + let + colorIcon = colorize (getSignalColor signal) (icons M.! "wifi") + txt = colorize (colors M.! "active") (show s) + in printf "%s %s" colorIcon txt + +makeDevIcon DeviceData { deviceType = Wifi, signal = Nothing } = + colorize (getSignalColor Nothing) (icons M.! "wifi") + +makeDevIcon _ = offline + + +getStatus :: [DeviceData] -> String +getStatus = intercalate separator . map makeDevIcon + + +queryNet :: IO String +queryNet = do + connectivity <- getConnectivity + --icon <- if connectivity `elem` ["none", "limited"] + icon <- if connectivity == "none" + then return offline + else getStatus <$> getActiveDevs + return $ separator ++ icon diff --git a/src/Monitors/Volume.hs b/src/Monitors/Volume.hs new file mode 100644 index 0000000..5bfb891 --- /dev/null +++ b/src/Monitors/Volume.hs @@ -0,0 +1,86 @@ +module Monitors.Volume (queryVolume) where + +import Data.List +import Data.Maybe +import System.Process +import Text.Printf +import Text.Regex +import qualified Data.Map as M + +import Monitors.Common + +mixer :: String +mixer = "Master" + +icons :: M.Map String String +icons = M.map buildIcon $ M.fromList + [ ( "high" , 64125 ) + , ( "low" , 64126 ) + , ( "mid" , 64127 ) + , ( "off" , 64128 ) + , ( "mute" , 64605 ) + ] + +data MixerData = MixerData + { mute :: Bool + , vol :: Int + } + deriving Eq + +getIcon :: MixerData -> String +getIcon x = fromMaybe (icons M.! def) $ M.lookup (iconKey x) icons + where + iconKey MixerData { mute = True } = "mute" + iconKey MixerData { vol = vol } + | vol >= 80 = "high" + | vol >= 10 && vol < 80 = "mid" + | vol < 10 = "low" + | otherwise = def + def = "high" + +getColor :: MixerData -> String +getColor x = fromMaybe (colors M.! def) $ M.lookup (colorKey x) colors + where + colorKey MixerData { mute = True } = "inactive" + colorKey MixerData { vol = vol } + | vol > 110 = "red" + | vol > 100 && vol <= 110 = "yellow" + | vol > 70 && vol <= 100 = "green" + | vol > 0 && vol <= 70 = "blue" + | vol == 0 = "inactive" + | otherwise = def + def = "active" + +getStatus :: MixerData -> String +getStatus x@MixerData { mute = mute, vol = vol } = + let + txtColor = if mute then colors M.! "inactive" else colors M.! "active" + icon = colorize (getColor x) (getIcon x) + txt = colorize txtColor $ show vol + in printf "%s %s" icon txt + +parseMixerInfo :: String -> Maybe MixerData +parseMixerInfo = fmap fmtMixer . matchRegex regex + where + regex = mkRegex ".+: Playback [0-9]+ \\[([0-9]+)%\\] (\\[.+dB\\] )?\\[(on|off)\\]" + fmtMixer [volume,_,state] = + let + mute = case state of + "on" -> False + "off" -> True + _ -> False + vol = read volume + in MixerData { mute = mute, vol = vol } + +parseAmixerStdout :: String -> [MixerData] +parseAmixerStdout = nub . mapMaybe parseMixerInfo . lines + +fmtData :: [MixerData] -> String +fmtData = (separator ++ ) . intercalate separator . map getStatus + +runAmixer :: String -> IO String +runAmixer mixer = readProcess "amixer" ["get", mixer] "" + + +queryVolume :: IO String +queryVolume = fmtData . parseAmixerStdout <$> runAmixer mixer diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..3b4d68f --- /dev/null +++ b/stack.yaml @@ -0,0 +1,67 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/20.yaml + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: +# +# extra-deps: +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.5" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor