amadaluzia/hetch
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

feat(display): add separator

Browse source
This commit is contained in:
Artur Manuel 2025-02-24 07:32:35 +00:00
commit 54654d56b1
Signed by: amadaluzia
SSH key fingerprint: SHA256:Zwg7gBuZyaG48ucAZneJwltiXu0+tJb7c3lYt9AYlLg
1 changed files with 38 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

67
app/Main.hs
View file

@ -4,11 +4,19 @@ import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import System.Environment (lookupEnv) import System.Environment (lookupEnv)
import System.IO (readFile') import System.IO (readFile')
import Control.Monad.IO.Class (MonadIO)
fromIOMaybe :: (MonadIO m) => a -> m (Maybe a) -> m a
fromIOMaybe failsafe maybeVal = do
res <- maybeVal
case res of
Nothing -> return failsafe
(Just val) -> return val
readUptime :: String -> Int readUptime :: String -> Int
readUptime "" = 0 readUptime "" = 0
readUptime uptime readUptime uptime
| length (words uptime) > 1 = floor (read . head . words $ uptime :: Float) | length (words uptime) > 1 = floor (read . head $ words uptime :: Float)
| otherwise = floor (read uptime :: Float) | otherwise = floor (read uptime :: Float)
getUptime :: Int -> String getUptime :: Int -> String
@ -18,36 +26,36 @@ getUptime uptime
| otherwise = unwords [remH, remM, remS] | otherwise = unwords [remH, remM, remS]
where where
totalM = uptime `div` 60 totalM = uptime `div` 60
remS = show (uptime `mod` 60) ++ "s" remS = show (uptime `mod` 60) <> "s"
remM = show (totalM `mod` 60) ++ "m" remM = show (totalM `mod` 60) <> "m"
remH = show (totalM `div` 60) ++ "h" remH = show (totalM `div` 60) <> "h"
getKVer :: String -> String getKVer :: String -> String
getKVer "" = "" getKVer "" = ""
getKVer info getKVer info
| length (words info) < 3 = head (words info) | length (words info) < 3 = head (words info)
| otherwise = (\(k : ks) -> k ++ " " ++ (head . tail) ks) . words $ info | otherwise = (\(k : ks) -> unwords [k, (!! 1) ks]) (words info)
findPrettyName :: [String] -> String findPrettyName :: [String] -> String
findPrettyName [] = "Unknown"
findPrettyName (o : os) findPrettyName (o : os)
| "PRETTY_NAME" `isPrefixOf` o = (reverse . tail . init . takeWhile (/= '=') . reverse) o | "PRETTY_NAME" `isPrefixOf` o = tail . init $ dropWhile (/='"') o
| otherwise = findPrettyName os | otherwise = findPrettyName os
parseKBFromMeminfo :: String -> Int parseKB :: String -> Int
parseKBFromMeminfo "" = 0 parseKB "" = 0
parseKBFromMeminfo line = read (head . tail . words $ line) :: Int parseKB line = read (head . tail $ words line) :: Int
getMemory :: String -> String getMemory :: String -> String
getMemory meminfo getMemory memInfo
| length (lines meminfo) < 2 = "N/A" | length (lines memInfo) < 2 = "N/A"
| otherwise = memAvail ++ "/" ++ memTotal | otherwise = memAvail <> "/" <> memTotal
where where
memTotal = show (parseKBFromMeminfo (head $ lines meminfo) `div` 1000) ++ "MB" memAvail = show ((parseKB . (!! 2) $ lines memInfo) `div` 1000) <> "MB"
memAvail = show (parseKBFromMeminfo (head . tail . tail $ lines meminfo) `div` 1000) ++ "MB" memTotal = show ((parseKB . head $ lines memInfo) `div` 1000) <> "MB"
getWM :: Maybe String -> Maybe String -> String getWM :: String -> String -> String
getWM (Just desktop) (Just session) = desktop ++ " (" ++ session ++ ")" getWM desktop session = unwords [desktop, "(" <> session <> ")"]
getWM _ _ = "Unknown"
main :: IO () main :: IO ()
main = do main = do
@ -56,19 +64,20 @@ main = do
osRelease <- readFile' "/etc/os-release" osRelease <- readFile' "/etc/os-release"
hostname <- readFile' "/proc/sys/kernel/hostname" hostname <- readFile' "/proc/sys/kernel/hostname"
meminfo <- readFile' "/proc/meminfo" meminfo <- readFile' "/proc/meminfo"
username <- lookupEnv "USER" username <- fromIOMaybe "username" (lookupEnv "USER")
currentDesktop <- lookupEnv "XDG_CURRENT_DESKTOP" currentDesktop <- fromIOMaybe "Unknown" (lookupEnv "XDG_CURRENT_DESKTOP")
sessionType <- lookupEnv "XDG_SESSION_TYPE" sessionType <- fromIOMaybe "Unkown" (lookupEnv "XDG_SESSION_TYPE")
locale <- lookupEnv "LANG" locale <- fromIOMaybe "un_KN.own" (lookupEnv "LANG")
let userandhost = username <> "@" <> init hostname
putStr putStr
( unlines ( unlines
[ "\x1b[1;35m █ \x1b[1;34m" ++ fromMaybe "username" username ++ "@" ++ init hostname [ "\x1b[1;35m █ \x1b[1;34m" <> userandhost
, "\x1b[1;35m █ \x1b[1;34m" , "\x1b[1;35m █ \x1b[1;34m" <> take (length userandhost) (repeat '-')
, "\x1b[1;35m █ \x1b[1;34m" ++ "up\t" ++ (getUptime . readUptime) uptime , "\x1b[1;35m █ \x1b[1;34m" <> "up\t" <> getUptime (readUptime uptime)
, "\x1b[1;35m █ \x1b[1;34m" ++ "wm\t" ++ getWM currentDesktop sessionType , "\x1b[1;35m █ \x1b[1;34m" <> "wm\t" <> getWM currentDesktop sessionType
, "\x1b[1;35m ███ \x1b[1;34m" ++ "krl\t" ++ getKVer version , "\x1b[1;35m ███ \x1b[1;34m" <> "krl\t" <> getKVer version
, "\x1b[1;35m █ ██ \x1b[1;34m" ++ "os\t" ++ (findPrettyName . lines) osRelease , "\x1b[1;35m █ ██ \x1b[1;34m" <> "os\t" <> findPrettyName (lines osRelease)
, "\x1b[1;35m █ ██ \x1b[1;34m" ++ "lcl\t" ++ fromMaybe "??_??" locale , "\x1b[1;35m █ ██ \x1b[1;34m" <> "lcl\t" <> locale
, "\x1b[1;35m █ ██ \x1b[1;34m" ++ "mem\t" ++ getMemory meminfo , "\x1b[1;35m █ ██ \x1b[1;34m" <> "mem\t" <> getMemory meminfo
] ]
) )