i3blocks-hs-contrib 1.0.0 → 2.0.0
raw patch · 15 files changed
+370/−142 lines, 15 filesdep +http-clientdep +http-client-tlsdep −lensdep −lens-aesondep −wreq
Dependencies added: http-client, http-client-tls
Dependencies removed: lens, lens-aeson, wreq
Files
- AirplaneMode/Main.hs +23/−3
- Bandwidth/Main.hs +46/−42
- Battery/Main.hs +58/−17
- Bitcoin/Main.hs +45/−11
- Cpu/Main.hs +15/−5
- DateTime/Main.hs +16/−9
- Docker/Main.hs +16/−5
- Ip/Main.hs +18/−3
- Memory/Main.hs +16/−2
- OpenVpn/Main.hs +30/−9
- Temperature/Main.hs +19/−4
- Volume/Main.hs +27/−8
- Wifi/Main.hs +25/−5
- i3blocks-hs-contrib.cabal +11/−12
- src/Common.hs +5/−7
AirplaneMode/Main.hs view
@@ -5,7 +5,12 @@ import Common import Data.Bool import Data.Text (lines, pack)+import Data.Text.IO (putStrLn)+import Prelude hiding (putStrLn) import Turtle+import System.Environment (getArgs)+import qualified Data.Text as Text+import Data.Maybe type CardName = Text type CardDev = Text@@ -22,10 +27,25 @@ rfkill <- rfkill' let cards = head $ match (parseCards rfkill) rfkill let isAirplaneOn = isAirplaneMode cards- bool (airplaneModeOff cards) (airplaneModeOn cards) isAirplaneOn+ icons <- liftIO getArgs+ bool (airplaneModeOff icons cards) (airplaneModeOn icons cards) isAirplaneOn where- airplaneModeOn cards = do liftIO $ putStrLn "\61554"; handleClick Deactivate cards- airplaneModeOff cards = do liftIO $ putStrLn "\61554 x"; handleClick Activate cards+ airplaneModeOn icons cards = do+ liftIO $ putStrLn $ fromMaybe "Airplane On" $ getAirplaneOnIcon icons+ handleClick Deactivate cards+ airplaneModeOff icons cards = do+ liftIO $ putStrLn $ fromMaybe "Airplane Off" $ getAirplaneOffIcon icons+ handleClick Activate cards++getAirplaneOffIcon :: [String] -> Maybe Text+getAirplaneOffIcon icons = case icons of+ airplaneOffIcon : _ -> Just $ Text.pack airplaneOffIcon+ _ -> Nothing++getAirplaneOnIcon :: [String] -> Maybe Text+getAirplaneOnIcon icons = case icons of+ _ : airplaneOnIcon : _ -> Just $ Text.pack airplaneOnIcon+ _ -> Nothing handleClick :: AirplaneAction -> [Card] -> Shell [ExitCode] handleClick action cards = do
Bandwidth/Main.hs view
@@ -14,9 +14,12 @@ import Data.Monoid ((<>)) import Data.Text (null, pack, strip, unpack) import Data.Time.Clock.POSIX (getPOSIXTime)-import Prelude hiding (FilePath)+import Prelude hiding (FilePath, putStrLn) import Text.Printf (printf)+import Data.Text.IO (putStrLn) import Turtle hiding (empty, fold, printf)+import Data.Maybe+import System.Environment (getArgs) data Report = Report { uploadRate :: UploadRate,@@ -51,13 +54,15 @@ dataPath = "/dev/shm/i3blocks-bandwidth-module" main :: IO ()-main =- sh- $ defaultInterface- >>= maybe handleNoInterface runScript- >>= liftIO- . putStrLn- where handleNoInterface = return "No interface"+main = do+ icons <- getArgs+ sh+ $ defaultInterface+ >>= maybe handleNoInterface (runScript icons)+ >>= liftIO+ . putStrLn+ where+ handleNoInterface = return "No UP interface" initPath :: NetworkInterface -> Shell FilePath initPath interface = do@@ -65,27 +70,20 @@ touch $ dataPathForInterface interface return $ dataPathForInterface interface -runScript :: NetworkInterface -> Shell String-runScript interface = do- _ <- initPath interface- liftA3 bool- (handleInterfaceDown interface)- (handleInterfaceUp interface)- (isUp interface)--handleInterfaceDown :: NetworkInterface -> Shell String-handleInterfaceDown interface = return . unpack $ interface <> " is down"--handleInterfaceUp :: NetworkInterface -> Shell String-handleInterfaceUp interface =- maybe handleNoRecordAvailable handleRecord =<< readRecord interface+runScript :: [String] -> NetworkInterface -> Shell Text+runScript icons interface = do+ _ <- initPath interface+ record <- readRecord interface+ maybe handleNoRecordAvailable handleRecord record where handleRecord oldRecord =- formatReport+ formatReport icons . applyBestUnit . speedReport oldRecord <$> writeRecord interface- handleNoRecordAvailable = writeRecord interface >>= return "No data"+ handleNoRecordAvailable = do+ _ <- writeRecord interface+ return $ "No data for " <> (pack $ show interface) writeRecord :: NetworkInterface -> Shell Record writeRecord interface =@@ -153,25 +151,39 @@ (fromIntegral bytesSentDiff / fromIntegral timediff) Bs -formatReport :: Report -> String-formatReport report =- "\61677 "- ++ ( printf "%.1f"+getUploadIcon :: [String] -> Maybe Text+getUploadIcon icons = case icons of+ uploadIcon : _ -> Just $ pack uploadIcon+ _ -> Nothing++getDownloadIcon :: [String] -> Maybe Text+getDownloadIcon icons = case icons of+ _ : downloadIcon : _ -> Just $ pack downloadIcon+ _ -> Nothing++formatReport :: [String] -> Report -> Text+formatReport icons report =+ let downloadIcon = fromMaybe "Rx " $ getDownloadIcon icons+ uploadIcon = fromMaybe "Tx " $ getUploadIcon icons+ in downloadIcon+ <> ( pack+ . printf "%.1f" . value . runDownloadRate . downloadRate $ report )- ++ (show . unit . runDownloadRate . downloadRate $ report)- ++ " "- ++ "\61678 "- ++ ( printf "%.1f"+ <> (pack . show . unit . runDownloadRate . downloadRate $ report)+ <> " "+ <> uploadIcon+ <> ( pack+ . printf "%.1f" . value . runUploadRate . uploadRate $ report )- ++ (show . unit . runUploadRate . uploadRate $ report)+ <> (pack . show . unit . runUploadRate . uploadRate $ report) applyBestUnit :: Report -> Report applyBestUnit = liftA2@@ -194,19 +206,11 @@ = TransferRate (rate * 1024) (pred from) convertRate rate _ = rate -isUp :: Text -> Shell Bool-isUp interface- = let- state = inshell- ("cat /sys/class/net/" <> interface <> "/operstate")- mempty- in ("up" ==) . lineToText <$> state- defaultInterface :: Shell (Maybe NetworkInterface) defaultInterface = textToMaybe . strip <$> strict (inshell- "ip route | awk '/^default/ { print $5 ; exit }'"+ "ip addr | awk '/state UP/ {print $2}' | sed 's/.$//'" mempty ) where textToMaybe text' = bool (Just text') Nothing (Data.Text.null text')
Battery/Main.hs view
@@ -6,6 +6,8 @@ import Common import Data.Text (pack) import Turtle+import Data.Maybe (fromMaybe)+import System.Environment (getArgs) newtype BatteryPercentage = BatteryPercentage Integer data BatteryStatus = Discharging | Charging | Full | Plugged | Unknown@@ -14,33 +16,72 @@ main :: IO () main = sh $ do acpi <- acpi'+ icons <- liftIO getArgs let info = parse acpi- blockOutput $ OutputReport (makeLongDesc info) Nothing (makeColor $ fst info)+ maybe (renderNoBattery icons) (renderOutput icons) info where- makeLongDesc = LongDesc . pack . formatBattery- makeColor (BatteryPercentage per) = Color <$> batteryColor per+ renderNoBattery icons =+ let desc = fromMaybe "No Battery" $ getNoBatteryIcon icons+ in blockOutput $ OutputReport (LongDesc desc) Nothing Nothing+ renderOutput icons info+ = blockOutput $ OutputReport (makeLongDesc info) Nothing (makeColor $ fst info)+ where+ makeLongDesc = LongDesc . formatBattery icons+ makeColor (BatteryPercentage per) = Color <$> batteryColor per -formatBattery :: (BatteryPercentage, BatteryStatus) -> String-formatBattery (BatteryPercentage per, Discharging) = format' (icon per) per-formatBattery (BatteryPercentage per, Unknown) = format' (icon per) per-formatBattery (BatteryPercentage per, _) = format' "\61926 " per+formatBattery :: [String] -> (BatteryPercentage, BatteryStatus) -> Text+formatBattery icons info = case info of+ (BatteryPercentage per, Discharging) -> format' (getIcon icons per) per+ (BatteryPercentage per, Unknown) -> format' (getIcon icons per) per+ (BatteryPercentage per, _) -> format' (fromMaybe "" $ getFullBatteryIcon icons) per -format' :: Show a => String -> a -> String-format' i per = i ++ " " ++ show per ++ "%"+format' :: Show a => Text -> a -> Text+format' icon per = icon <> (pack $ show per) <> "%" -icon :: Integer -> String-icon p | p >= 90 = "\62016"-icon p | p >= 75 = "\62017"-icon p | p >= 50 = "\62018"-icon p | p >= 25 = "\62019"-icon _ = "\62020"+getIcon :: [String] -> Integer -> Text+getIcon icons p | p >= 90 = fromMaybe "" $ getHighBatteryIcon icons+getIcon icons p | p >= 75 = fromMaybe "" $ getMediumBatteryIcon icons+getIcon icons p | p >= 25 = fromMaybe "" $ getLowBatteryIcon icons+getIcon icons _ = fromMaybe "" $ getEmptyBatteryIcon icons +getNoBatteryIcon :: [String] -> Maybe Text+getNoBatteryIcon icons = case icons of+ icon : _ -> Just $ pack icon+ _ -> Nothing++getEmptyBatteryIcon :: [String] -> Maybe Text+getEmptyBatteryIcon icons = case icons of+ _ : icon : _ -> Just $ pack icon+ _ -> Nothing++getLowBatteryIcon :: [String] -> Maybe Text+getLowBatteryIcon icons = case icons of+ _ : _ : icon : _ -> Just $ pack icon+ _ -> Nothing++getMediumBatteryIcon :: [String] -> Maybe Text+getMediumBatteryIcon icons = case icons of+ _ : _ : _ : icon : _ -> Just $ pack icon+ _ -> Nothing++getHighBatteryIcon :: [String] -> Maybe Text+getHighBatteryIcon icons = case icons of+ _ : _ : _ : _ : icon : _ -> Just $ pack icon+ _ -> Nothing++getFullBatteryIcon :: [String] -> Maybe Text+getFullBatteryIcon icons = case icons of+ _ : _ : _ : _ : _ : icon : _ -> Just $ pack icon+ _ -> Nothing+ batteryColor :: Integer -> Maybe Text batteryColor p | p <= 25 = Just "#ff0000" batteryColor _ = Nothing -parse :: Text -> (BatteryPercentage, BatteryStatus)-parse acpi = head $ match batteryLeft acpi+parse :: Text -> Maybe (BatteryPercentage, BatteryStatus)+parse acpi = case match batteryLeft acpi of+ [] -> Nothing+ info:_ -> Just info batteryLeft :: Pattern (BatteryPercentage, BatteryStatus) batteryLeft = do
Bitcoin/Main.hs view
@@ -1,20 +1,54 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} module Main where -import Control.Lens-import Data.Aeson-import Data.Aeson.Lens-import Data.Text (unpack)-import Network.Wreq+import Network.HTTP.Client+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Data.Aeson (FromJSON(..), decode)+import GHC.Generics (Generic(..))+import System.Environment (getArgs) main :: IO () main = do- response <- get "https://api.gdax.com/products/BTC-EUR/ticker"- let ask' = response ^? responseBody . key "ask"+ args <- getArgs+ let (icon, mode) = (getIcon args, getMode args)+ mResponse <- makeBtcReq mode+ putStrLn $ maybe "" (formatValue icon mode) mResponse - putStrLn $ formatValue ask'+getIcon :: [String] -> String+getIcon = \case+ _ : icon : _ -> icon+ _ -> "" -formatValue :: Maybe Value -> String-formatValue (Just (String s)) = "\61786 " ++ unpack s ++ " €"-formatValue _ = ""+getMode :: [String] -> Mode+getMode = read . head++makeBtcReq :: Mode -> IO (Maybe GdaxResponse)+makeBtcReq mode = do+ manager <- newManager tlsManagerSettings+ request <- createRequest+ response <- httpLbs request manager+ pure . decode $ responseBody response+ where+ urlForMode+ = "https://api.gdax.com/products/BTC-"<> show mode <>"/ticker"+ createRequest+ = addUserAgent <$> parseRequest urlForMode+ addUserAgent req'+ = req' { requestHeaders = ("User-Agent", "Ticker") : requestHeaders req' }++formatValue :: String -> Mode -> GdaxResponse -> String+formatValue icon mode (GdaxResponse amount)+ = icon <> formatWithCurrency amount mode++formatWithCurrency :: String -> Mode -> String+formatWithCurrency amount = \case+ EUR -> amount <> " €"+ USD -> "$ " <> amount+ GBP -> "£ " <> amount++data GdaxResponse = GdaxResponse { ask :: String } deriving (Generic, FromJSON)+data Mode = EUR | GBP | USD deriving (Eq, Show, Read)
Cpu/Main.hs view
@@ -4,18 +4,28 @@ import Common import Data.Text (pack, strip, unpack)+import qualified Data.Text.IO as Text import Turtle+import System.Environment (getArgs)+import Data.Maybe main :: IO () main = sh $ do- liftIO . putStrLn =<< cpuUsage+ icons <- liftIO getArgs+ liftIO . Text.putStrLn =<< cpuUsage icons maybe (return ExitSuccess) handleButton =<< currentButton -cpuUsage :: Shell String-cpuUsage = format' <$> idleCpu+cpuUsage :: [String] -> Shell Text+cpuUsage icons = format' <$> idleCpu where format' idle =- let usage = formatFloatN (100 - idle) 0- in "\61668 " ++ usage ++ "%"+ let usage = pack $ formatFloatN (100 - idle) 0+ icon = fromMaybe "" $ getIcon icons+ in icon <> usage <> "%"++getIcon :: [String] -> Maybe Text+getIcon icons = case icons of+ icon : _ -> Just $ pack icon+ _ -> Nothing handleButton :: MonadIO io => Button -> io ExitCode handleButton LeftClick = shell "urxvt -title pop-up -e htop" empty
DateTime/Main.hs view
@@ -1,18 +1,25 @@+{-# LANGUAGE LambdaCase #-} module Main where -import Data.Maybe (fromMaybe) import Data.Time.Format import Data.Time.LocalTime-import System.Environment+import System.Environment (getArgs) main :: IO () main = do args <- getArgs- getZonedTime >>= printDateTime . formatTime defaultTimeLocale (format $ safeHead args)- where- format = fromMaybe "%d-%m-%y %H:%M"- printDateTime datetime = putStrLn $ "\61747 " ++ datetime+ let (format, icon) = (getFormat args, getIcon args)+ zonedTime <- getZonedTime+ putStrLn $ icon <> (formatTime defaultTimeLocale format zonedTime) -safeHead :: [a] -> Maybe a-safeHead l | not (null l) = Just $ head l-safeHead _ = Nothing+getIcon :: [String] -> String+getIcon = \case+ _ : icon : _ -> icon+ _ -> ""++getFormat :: [String] -> String+getFormat = \case+ format : _ -> format+ _ -> defaultFormat+ where+ defaultFormat = "%d-%m-%y %H:%M"
Docker/Main.hs view
@@ -5,18 +5,29 @@ import Common import Data.Text (pack) import Turtle+import System.Environment (getArgs)+import Data.Maybe+import Data.Text.IO (putStrLn)+import Prelude hiding (putStrLn) main :: IO () main = sh $ do+ icons <- liftIO getArgs isRunning <- processIsRunning "dockerd" if isRunning- then formatCommand (show <$> nImages)- else formatCommand (return "x")+ then formatCommand icons (pack . show <$> nImages)+ else formatCommand icons (return "x") -formatCommand :: Shell String -> Shell ()-formatCommand out = do+getIcon :: [String] -> Maybe Text+getIcon icons = case icons of+ icon : _ -> Just $ pack icon+ _ -> Nothing++formatCommand :: [String] -> Shell Text -> Shell ()+formatCommand icons out = do out' <- out- liftIO $ putStrLn $ "\61875" ++ " " ++ out'+ let icon = fromMaybe "Docker " $ getIcon icons+ liftIO $ putStrLn $ icon <> out' nImages :: Shell Integer nImages = fold (inshell (pack "docker ps -q") empty) countLines
Ip/Main.hs view
@@ -3,12 +3,27 @@ module Main where import Data.Text.IO (putStrLn)+import Data.Text ( pack) import Prelude hiding (putStrLn) import Turtle+import System.Environment (getArgs)+import Data.Maybe main :: IO ()-main = sh $ liftIO . putStrLn =<< ip+main = do+ icons <- getArgs+ sh $ liftIO . putStrLn . formatBlock icons =<< getIp -ip :: Shell Text-ip = strict $+formatBlock :: [String] -> Text -> Text+formatBlock icons ip =+ let icon = fromMaybe "" $ getIcon icons+ in icon <> ip++getIp :: Shell Text+getIp = strict $ inshell "dig +short myip.opendns.com @resolver1.opendns.com" empty++getIcon :: [String] -> Maybe Text+getIcon icons = case icons of+ icon : _ -> Just $ pack icon+ _ -> Nothing
Memory/Main.hs view
@@ -5,13 +5,27 @@ import Common import Data.Text (pack) import Turtle+import Data.Maybe+import System.Environment (getArgs)+import Data.Text.IO (putStrLn)+import Prelude hiding (putStrLn) data MemType = MemTotal | MemFree main :: IO ()-main = sh $ (liftIO . putStrLn . format') =<< (memory :: Shell Float)+main = sh $ do+ icons <- liftIO getArgs+ (liftIO . putStrLn . format' icons) =<< (memory :: Shell Float) where- format' mem = "\62171 " ++ formatFloatN mem 2 ++ "G"+ format' icons mem =+ let icon = fromMaybe "" $ getIcon icons+ usedMem = pack $ formatFloatN mem 2+ in icon <> usedMem <> "G"++getIcon :: [String] -> Maybe Text+getIcon icons = case icons of+ icon : _ -> Just $ pack icon+ _ -> Nothing memory :: RealFloat a => Shell a memory = do
OpenVpn/Main.hs view
@@ -1,16 +1,37 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-} module Main where -import Common-import Control.Applicative (liftA3)-import Data.Bool (bool)-import Data.Text (pack)-import Turtle+import Common+import Data.Bool (bool)+import System.Environment (getArgs)+import Data.Text (pack)+import Turtle main :: IO ()-main = sh $ processIsRunning "openvpn" >>=- bool (printCommand "x") (printCommand "✓")+main = do+ args <- getArgs+ let (onClickHandler, icon) = (getOnClickHandler args, getIcon args)+ sh $ do+ processIsRunning "openvpn" >>= bool (printCommand icon "x") (printCommand icon "✓")+ maybe (return ExitSuccess) (handleButton onClickHandler) =<< currentButton -printCommand :: String -> Shell ()-printCommand out = liftIO $ putStrLn $ "\61676" ++ " " ++ out+getIcon :: [String] -> String+getIcon = \case+ _ : icon : _ -> icon+ _ -> ""++getOnClickHandler :: [String] -> Maybe OnClickHandlerPath+getOnClickHandler = \case+ clickHandler : _ -> Just $ pack clickHandler+ _ -> Nothing++printCommand :: String -> String -> Shell ()+printCommand icon out = liftIO . putStrLn $ icon <> out++handleButton :: MonadIO io => Maybe OnClickHandlerPath -> Button -> io ExitCode+handleButton handler LeftClick = maybe (pure ExitSuccess) (`shell` empty) handler+handleButton _ _ = pure ExitSuccess++type OnClickHandlerPath = Text
Temperature/Main.hs view
@@ -2,14 +2,29 @@ module Main where -import Data.Text (strip)+import Data.Text (strip, pack) import Data.Text.IO (putStrLn) import Prelude hiding (putStrLn) import Turtle+import System.Environment (getArgs)+import Data.Maybe main :: IO ()-main = sh $ liftIO . putStrLn =<< cpuTemperature+main = do+ icons <- getArgs+ sh $ liftIO . putStrLn . formatBlock icons =<< cpuTemperature +formatBlock :: [String] -> Text -> Text+formatBlock icons temp =+ let icon = fromMaybe "" $ getIcon icons+ in icon <> temp <> "°C"++getIcon :: [String] -> Maybe Text+getIcon icons = case icons of+ icon : _ -> Just $ pack icon+ _ -> Nothing+ cpuTemperature :: Shell Text-cpuTemperature = (<> "°C") . strip <$>- strict (inshell "sensors | grep -oP 'Package[^\\+]*\\+\\K[0-9]+'" mempty)+cpuTemperature+ = strip+ <$> strict (inshell "sensors | grep -oP 'Package[^\\+]*\\+\\K[0-9]+'" mempty)
Volume/Main.hs view
@@ -4,15 +4,34 @@ import Common import Control.Applicative (liftA2)-import Data.Maybe (maybe)+import Data.Maybe (maybe, fromMaybe)+import System.Environment (getArgs) import Data.Text (pack, strip, unpack) import Turtle+import Data.Text.IO (putStrLn)+import Prelude hiding (putStrLn) main :: IO () main = sh $ do- liftIO . putStrLn =<< liftA2 formatVol isMuted getVolume+ icons <- liftIO getArgs+ liftIO . putStrLn =<< liftA2 (formatVol icons) isMuted getVolume maybe (return ExitSuccess) handleButton =<< currentButton +getMutedIcon :: [String] -> Maybe Text+getMutedIcon icons = case icons of+ mutedIcon : _ -> Just $ pack mutedIcon+ _ -> Nothing++getLowVolIcon :: [String] -> Maybe Text+getLowVolIcon icons = case icons of+ _ : lowVolIcon : _ -> Just $ pack lowVolIcon+ _ -> Nothing++getHighVolIcon :: [String] -> Maybe Text+getHighVolIcon icons = case icons of+ _ : _ : highVolIcon : _ -> Just $ pack highVolIcon+ _ -> Nothing+ handleButton :: MonadIO io => Button -> io ExitCode handleButton LeftClick = shell "pavucontrol" empty handleButton RightClick = shell "ponymix toggle >/dev/null" empty@@ -20,13 +39,13 @@ handleButton WheelDown = shell "ponymix decrease 5 >/dev/null" empty handleButton _ = pure . ExitFailure $ 1 -formatVol :: Bool -> Integer -> String-formatVol True _ = "\61478 x"-formatVol False vol = icon vol ++ " " ++ show vol ++ "%"+formatVol :: [String] -> Bool -> Integer -> Text+formatVol icons True _ = fromMaybe "Muted" $ getMutedIcon icons+formatVol icons False vol = icon icons vol <> (pack $ show vol) <> "%" -icon :: Integer -> String-icon v | v < 33 = "\61479"-icon _ = "\61480"+icon :: [String] -> Integer -> Text+icon icons v | v < 33 = fromMaybe "Volume " $ getLowVolIcon icons+icon icons _ = fromMaybe "Volume " $ getHighVolIcon icons isMuted :: Shell Bool isMuted = (== ExitSuccess) <$> shell (pack "ponymix is-muted") empty
Wifi/Main.hs view
@@ -6,12 +6,32 @@ import Data.Text.IO (putStrLn) import Prelude hiding (putStrLn) import Turtle+import qualified Data.Text as Text+import Data.Maybe+import System.Environment (getArgs) main :: IO ()-main = sh $ liftIO . putStrLn . format' =<< ssid+main = do+ args <- getArgs+ sh $ liftIO . putStrLn . formatBlock args =<< getSSID -format' :: Text -> Text-format' ssid' = "\61931" <> " " <> ssid'+formatBlock :: [String] -> Text -> Text+formatBlock args ssid+ = if Text.null ssid+ then fromMaybe "No WiFi" $ getNoWifiIcon args+ else fromMaybe "" (getWifiIcon args) <> ssid -ssid :: Shell Text-ssid = strict $ inshell "iwgetid -r" empty+getNoWifiIcon :: [String] -> Maybe Text+getNoWifiIcon icons = case icons of+ noWifiIcon : _ -> Just $ Text.pack noWifiIcon+ _ -> Nothing++getWifiIcon :: [String] -> Maybe Text+getWifiIcon icons = case icons of+ _ : wifiIcon : _ -> Just $ Text.pack wifiIcon+ _ -> Nothing++getSSID :: Shell Text+getSSID = do+ (exitCode, out) <- shellStrict "iwgetid -r" empty+ if exitCode == ExitFailure 255 then pure mempty else pure out
i3blocks-hs-contrib.cabal view
@@ -1,25 +1,25 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 2848a3939923d85f2e41f6999eefbcfd33f0081ad14ce24fa91f6afb64f8e34d+-- hash: a5188ee4b0a0288a70e0db0e517aeb7ed3c85a162ccd39d65a2103c874a190d1 name: i3blocks-hs-contrib-version: 1.0.0+version: 2.0.0 synopsis: Base i3blocks written in haskell description: @i3blocks-hs-contrib@ defines a set of blocks for your i3 bar+category: Distribution homepage: https://github.com/panavtec/i3blocks-hs-contrib#readme bug-reports: https://github.com/panavtec/i3blocks-hs-contrib/issues-license: MIT-license-file: LICENSE-tested-with: GHC == 8.4.* , GHC == 8.6.* author: Christian Panadero <panavtec@gmail.com>, Carlos Morera <carlosdelachica@gmail.com> maintainer: Christian Panadero <panavtec@gmail.com>, Carlos Morera <carlosdelachica@gmail.com>-category: Distribution+license: MIT+license-file: LICENSE+tested-with: GHC == 8.4.* , GHC == 8.6.* build-type: Simple extra-source-files: CHANGELOG.md@@ -88,21 +88,20 @@ default-language: Haskell2010 executable Bitcoin- hs-source-dirs:- Bitcoin main-is: Main.hs other-modules: Paths_i3blocks_hs_contrib+ hs-source-dirs:+ Bitcoin ghc-options: -Wall build-depends: aeson <1.5 , attoparsec <0.14 , base >=4.3 && <5- , lens <4.2- , lens-aeson <1.1+ , http-client <0.7+ , http-client-tls <0.4 , text <1.3 , turtle <1.6- , wreq <0.5 default-language: Haskell2010 executable Cpu
src/Common.hs view
@@ -6,6 +6,8 @@ import Data.Text.IO (putStrLn) import Numeric import Turtle+import Data.Coerce (coerce)+import Data.Foldable (traverse_) processIsRunning :: String -> Shell Bool processIsRunning process = (== ExitSuccess) . fst <$> shellStrict (pack $ "pidof " ++ process) empty@@ -41,11 +43,7 @@ blockOutput :: MonadIO io => OutputReport -> io () blockOutput report = do- let longDesc' = toText' . longDesc $ report+ let longDesc' = coerce . longDesc $ report liftIO $ Data.Text.IO.putStrLn longDesc'- liftIO $ Data.Text.IO.putStrLn $ maybe longDesc' toText'' (shortDesc report)- liftIO $ Data.Text.IO.putStrLn $ maybe "" toText''' (color report)- where- toText' (LongDesc t) = t- toText'' (ShortDesc t) = t- toText''' (Color t) = t+ liftIO $ Data.Text.IO.putStrLn $ maybe longDesc' coerce (shortDesc report)+ traverse_ (liftIO . Data.Text.IO.putStrLn . coerce) $ color report