i3blocks-hs-contrib (empty) → 1.0.0
raw patch · 18 files changed
+903/−0 lines, 18 filesdep +aesondep +attoparsecdep +basesetup-changed
Dependencies added: aeson, attoparsec, base, lens, lens-aeson, text, time, transformers, turtle, wreq
Files
- AirplaneMode/Main.hs +69/−0
- Bandwidth/Main.hs +234/−0
- Battery/Main.hs +60/−0
- Bitcoin/Main.hs +20/−0
- CHANGELOG.md +2/−0
- Cpu/Main.hs +26/−0
- DateTime/Main.hs +18/−0
- Docker/Main.hs +22/−0
- Ip/Main.hs +14/−0
- LICENSE +30/−0
- Memory/Main.hs +37/−0
- OpenVpn/Main.hs +16/−0
- Setup.hs +2/−0
- Temperature/Main.hs +15/−0
- Volume/Main.hs +36/−0
- Wifi/Main.hs +17/−0
- i3blocks-hs-contrib.cabal +234/−0
- src/Common.hs +51/−0
+ AirplaneMode/Main.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Common+import Data.Bool+import Data.Text (lines, pack)+import Turtle++type CardName = Text+type CardDev = Text+data BlockType = Soft | Hard | SoftAndHard | NotBlocked deriving (Eq, Show)+type Index = Int+data Card = Card { index :: Index,+ cardName :: CardName,+ cardDev :: CardDev,+ blockType :: BlockType } deriving Show+data AirplaneAction = Activate | Deactivate deriving (Eq, Show)++main :: IO ()+main = sh $ do+ rfkill <- rfkill'+ let cards = head $ match (parseCards rfkill) rfkill+ let isAirplaneOn = isAirplaneMode cards+ bool (airplaneModeOff cards) (airplaneModeOn cards) isAirplaneOn+ where+ airplaneModeOn cards = do liftIO $ putStrLn "\61554"; handleClick Deactivate cards+ airplaneModeOff cards = do liftIO $ putStrLn "\61554 x"; handleClick Activate cards++handleClick :: AirplaneAction -> [Card] -> Shell [ExitCode]+handleClick action cards = do+ leftClicked <- buttonClicked LeftClick+ bool (return []) (sequence $ blockCards action cards) leftClicked++blockCards :: AirplaneAction -> [Card] -> [Shell ExitCode]+blockCards act cards = actionCard act . index <$> cards++actionCard :: (MonadIO io, Show a) => AirplaneAction -> a -> io ExitCode+actionCard Deactivate i = shell (pack $ "rfkill unblock " ++ show i) empty+actionCard Activate i = shell (pack $ "rfkill block " ++ show i) empty++isAirplaneMode :: [Card] -> Bool+isAirplaneMode = all ((/= NotBlocked) . blockType)++parseCards :: Text -> Pattern [Card]+parseCards rfkill =+ let cardCount = countCards rfkill+ in bounded cardCount cardCount parseCard+ where+ countCards = (`div` linesPerCard) . length . Data.Text.lines+ linesPerCard = 3++parseCard :: Pattern Card+parseCard = do+ index' <- decimal <* separator+ cardDev' <- star alphaNum <* separator+ cardName' <- chars1 <* newline+ soft <- tab *> "Soft blocked" *> separator *> ("yes" <|> "no") <* newline+ hard <- tab *> "Hard blocked" *> separator *> ("yes" <|> "no") <* newline+ return $ Card index' cardName' cardDev' (toBlockType soft hard)+ where+ separator = skip (":" *> spaces1)+ toBlockType "yes" "yes" = SoftAndHard+ toBlockType "yes" _ = Soft+ toBlockType _ "yes" = Hard+ toBlockType _ _ = NotBlocked++rfkill' :: Shell Text+rfkill' = strict $ inshell (pack "rfkill list") empty
+ Bandwidth/Main.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Applicative (liftA3)+import Control.Exception (try)+import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)+import Data.Bool (bool)+import Data.Foldable (fold)+import Data.Functor (($>))+import Data.List (intersperse)+import Data.Maybe (maybe)+import Data.Monoid ((<>))+import Data.Text (null, pack, strip, unpack)+import Data.Time.Clock.POSIX (getPOSIXTime)+import Prelude hiding (FilePath)+import Text.Printf (printf)+import Turtle hiding (empty, fold, printf)++data Report = Report {+ uploadRate :: UploadRate,+ downloadRate :: DownloadRate+ } deriving Show++newtype DownloadRate = DownloadRate { runDownloadRate :: TransferRate } deriving Show+newtype UploadRate = UploadRate { runUploadRate :: TransferRate } deriving Show++data TransferRate = TransferRate {+ value :: Double,+ unit :: TransferUnit+ } deriving (Show, Eq)++data TransferUnit = Bs | KBs | MBs deriving (Show, Eq, Enum, Ord)++data Record = Record {+ timestamp :: Timestamp,+ bytesReceived :: TotalBytesIn,+ bytesSent :: TotalBytesOut+ } deriving Show++newtype TotalBytesIn = TotalBytesIn { runTotalBytesIn :: Integer } deriving (Show, Read)+newtype TotalBytesOut = TotalBytesOut { runTotalBytesOut :: Integer } deriving (Show, Read)+type Timestamp = Integer+type NetworkInterface = Text++dataPathForInterface :: NetworkInterface -> FilePath+dataPathForInterface interface = dataPath </> fromText interface++dataPath :: FilePath+dataPath = "/dev/shm/i3blocks-bandwidth-module"++main :: IO ()+main =+ sh+ $ defaultInterface+ >>= maybe handleNoInterface runScript+ >>= liftIO+ . putStrLn+ where handleNoInterface = return "No interface"++initPath :: NetworkInterface -> Shell FilePath+initPath interface = do+ mktree dataPath+ 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+ where+ handleRecord oldRecord =+ formatReport+ . applyBestUnit+ . speedReport oldRecord+ <$> writeRecord interface+ handleNoRecordAvailable = writeRecord interface >>= return "No data"++writeRecord :: NetworkInterface -> Shell Record+writeRecord interface =+ liftA3 Record+ (liftIO poxisTimeAsInteger)+ (readBytesReceived interface)+ (readBytesTransfered interface)+ >>= liftIO+ . writeRecordToFile+ where+ recordToText record =+ pack+ . fold+ . intersperse " "+ $ [ show . timestamp $ record+ , show . runTotalBytesIn . bytesReceived $ record+ , show . runTotalBytesOut . bytesSent $ record+ , "\n"+ ]+ poxisTimeAsInteger = round <$> getPOSIXTime+ writeRecordToFile record =+ ( writeTextFile (dataPathForInterface interface)+ . recordToText+ $ record+ )+ $> record++readRecord :: NetworkInterface -> Shell (Maybe Record)+readRecord interface = liftIO . runMaybeT $ extractRecord =<< safeReadTextFile+ where+ safeReadTextFile =+ MaybeT+ $ tryToMaybe+ <$> try+ (strip <$> readTextFile+ (dataPathForInterface interface)+ )+ extractRecord =+ MaybeT . return . matchToMaybe . match (decimal `sepBy` " ")+ matchToMaybe = \case+ [[time', received, sent]] -> Just $ Record+ time'+ (TotalBytesIn received)+ (TotalBytesOut sent)+ _ -> Nothing+ tryToMaybe :: Either IOError b -> Maybe b+ tryToMaybe (Left _) = Nothing+ tryToMaybe (Right x') = Just x'++speedReport :: Record -> Record -> Report+speedReport oldRecord newRecord = Report (UploadRate uploadRate')+ (DownloadRate downloadRate')+ where+ timediff = max (timestamp newRecord - timestamp oldRecord) 1+ bytesReceivedDiff =+ runTotalBytesIn (bytesReceived newRecord)+ - runTotalBytesIn (bytesReceived oldRecord)+ bytesSentDiff =+ runTotalBytesOut (bytesSent newRecord)+ - runTotalBytesOut (bytesSent oldRecord)+ downloadRate' = TransferRate+ (fromIntegral bytesReceivedDiff / fromIntegral timediff)+ Bs+ uploadRate' = TransferRate+ (fromIntegral bytesSentDiff / fromIntegral timediff)+ Bs++formatReport :: Report -> String+formatReport report =+ "\61677 "+ ++ ( printf "%.1f"+ . value+ . runDownloadRate+ . downloadRate+ $ report+ )+ ++ (show . unit . runDownloadRate . downloadRate $ report)+ ++ " "+ ++ "\61678 "+ ++ ( printf "%.1f"+ . value+ . runUploadRate+ . uploadRate+ $ report+ )+ ++ (show . unit . runUploadRate . uploadRate $ report)++applyBestUnit :: Report -> Report+applyBestUnit = liftA2+ Report+ (UploadRate . applyBestUnit' . runUploadRate . uploadRate)+ (DownloadRate . applyBestUnit' . runDownloadRate . downloadRate)+ where+ applyBestUnit' transferRate | value transferRate < 1024 = transferRate+ applyBestUnit' transferRate = applyBestUnit'+ $ convertRate transferRate (succ . unit $ transferRate)++convertRate :: TransferRate -> TransferUnit -> TransferRate+convertRate rate to | unit rate < to = convertRate (convertRateUp rate) to+ where+ convertRateUp (TransferRate rate' from)+ = TransferRate (rate' / 1024) (succ from)+convertRate rate' to | unit rate' > to = convertRate (convertRateDown rate') to+ where+ convertRateDown (TransferRate rate from)+ = 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 }'"+ mempty+ )+ where textToMaybe text' = bool (Just text') Nothing (Data.Text.null text')++readBytesTransfered :: Text -> Shell TotalBytesOut+readBytesTransfered interface =+ TotalBytesOut . read . unpack . strip+ <$> strict (inshell+ ( "cat /sys/class/net/"+ <> interface+ <> "/statistics/tx_bytes"+ )+ mempty+ )++readBytesReceived :: Text -> Shell TotalBytesIn+readBytesReceived interface =+ TotalBytesIn . read . unpack . strip+ <$> strict (inshell+ ( "cat /sys/class/net/"+ <> interface+ <> "/statistics/rx_bytes"+ )+ mempty+ )
+ Battery/Main.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Main where++import Common+import Data.Text (pack)+import Turtle++newtype BatteryPercentage = BatteryPercentage Integer+data BatteryStatus = Discharging | Charging | Full | Plugged | Unknown+data MemType = MemTotal | MemFree++main :: IO ()+main = sh $ do+ acpi <- acpi'+ let info = parse acpi+ blockOutput $ OutputReport (makeLongDesc info) Nothing (makeColor $ fst info)+ where+ makeLongDesc = LongDesc . pack . formatBattery+ 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++format' :: Show a => String -> a -> String+format' i per = i ++ " " ++ 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"++batteryColor :: Integer -> Maybe Text+batteryColor p | p <= 25 = Just "#ff0000"+batteryColor _ = Nothing++parse :: Text -> (BatteryPercentage, BatteryStatus)+parse acpi = head $ match batteryLeft acpi++batteryLeft :: Pattern (BatteryPercentage, BatteryStatus)+batteryLeft = do+ _ <- batteryNumber+ state <- spaces1 *> chars1 <* ","+ per <- spaces1 *> decimal <* "%" <* ("," <|> "") <* spaces1 <* star anyChar+ return (BatteryPercentage per, toBatteryStatus state)+ where+ batteryNumber = "Battery" *> spaces1 *> decimal @Integer *> ":"+ toBatteryStatus "Discharging" = Discharging+ toBatteryStatus "Charging" = Charging+ toBatteryStatus "Plugged" = Plugged+ toBatteryStatus "Full" = Full+ toBatteryStatus _ = Unknown++acpi' :: Shell Text+acpi' = strict $ inshell (pack "acpi") empty
+ Bitcoin/Main.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Lens+import Data.Aeson+import Data.Aeson.Lens+import Data.Text (unpack)+import Network.Wreq++main :: IO ()+main = do+ response <- get "https://api.gdax.com/products/BTC-EUR/ticker"+ let ask' = response ^? responseBody . key "ask"++ putStrLn $ formatValue ask'++formatValue :: Maybe Value -> String+formatValue (Just (String s)) = "\61786 " ++ unpack s ++ " €"+formatValue _ = ""
+ CHANGELOG.md view
@@ -0,0 +1,2 @@+## Changes in 0.1.0+Initial version
+ Cpu/Main.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Common+import Data.Text (pack, strip, unpack)+import Turtle++main :: IO ()+main = sh $ do+ liftIO . putStrLn =<< cpuUsage+ maybe (return ExitSuccess) handleButton =<< currentButton++cpuUsage :: Shell String+cpuUsage = format' <$> idleCpu+ where format' idle =+ let usage = formatFloatN (100 - idle) 0+ in "\61668 " ++ usage ++ "%"++handleButton :: MonadIO io => Button -> io ExitCode+handleButton LeftClick = shell "urxvt -title pop-up -e htop" empty+handleButton _ = return ExitSuccess++idleCpu :: Shell Double+idleCpu = read . unpack . strip <$>+ strict (inshell (pack "mpstat 1 1 -o JSON | jq -r '.sysstat.hosts[0].statistics[0].\"cpu-load\"[0].idle'") empty)
+ DateTime/Main.hs view
@@ -0,0 +1,18 @@+module Main where++import Data.Maybe (fromMaybe)+import Data.Time.Format+import Data.Time.LocalTime+import System.Environment++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++safeHead :: [a] -> Maybe a+safeHead l | not (null l) = Just $ head l+safeHead _ = Nothing
+ Docker/Main.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Common+import Data.Text (pack)+import Turtle++main :: IO ()+main = sh $ do+ isRunning <- processIsRunning "dockerd"+ if isRunning+ then formatCommand (show <$> nImages)+ else formatCommand (return "x")++formatCommand :: Shell String -> Shell ()+formatCommand out = do+ out' <- out+ liftIO $ putStrLn $ "\61875" ++ " " ++ out'++nImages :: Shell Integer+nImages = fold (inshell (pack "docker ps -q") empty) countLines
+ Ip/Main.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.Text.IO (putStrLn)+import Prelude hiding (putStrLn)+import Turtle++main :: IO ()+main = sh $ liftIO . putStrLn =<< ip++ip :: Shell Text+ip = strict $+ inshell "dig +short myip.opendns.com @resolver1.opendns.com" empty
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Christian Panadero (c) 2018++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 Christian Panadero 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.
+ Memory/Main.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Common+import Data.Text (pack)+import Turtle++data MemType = MemTotal | MemFree++main :: IO ()+main = sh $ (liftIO . putStrLn . format') =<< (memory :: Shell Float)+ where+ format' mem = "\62171 " ++ formatFloatN mem 2 ++ "G"++memory :: RealFloat a => Shell a+memory = do+ let memoryReport = input (filePath "/proc/meminfo")+ memFree <- parseMemory memoryReport MemFree+ memTotal <- parseMemory memoryReport MemTotal+ return $ kbsToGb (fromIntegral $ memTotal - memFree)+ where+ kbsToGb kbs = kbs / 1024 / 1024+ parseMemory memoryReport k =+ head . match (parseMem k) <$> strict (grep (parseMem k) memoryReport)++parseMem :: MemType -> Pattern Integer+parseMem memType = parseMemType memType *> spaces1 *> decimal <* star anyChar++parseMemType :: MemType -> Pattern Text+parseMemType t = toMem t <> ":"+ where+ toMem MemTotal = "MemTotal"+ toMem MemFree = "MemFree"++filePath :: String -> Turtle.FilePath+filePath p = fromText $ pack p
+ OpenVpn/Main.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Common+import Control.Applicative (liftA3)+import Data.Bool (bool)+import Data.Text (pack)+import Turtle++main :: IO ()+main = sh $ processIsRunning "openvpn" >>=+ bool (printCommand "x") (printCommand "✓")++printCommand :: String -> Shell ()+printCommand out = liftIO $ putStrLn $ "\61676" ++ " " ++ out
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Temperature/Main.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.Text (strip)+import Data.Text.IO (putStrLn)+import Prelude hiding (putStrLn)+import Turtle++main :: IO ()+main = sh $ liftIO . putStrLn =<< cpuTemperature++cpuTemperature :: Shell Text+cpuTemperature = (<> "°C") . strip <$>+ strict (inshell "sensors | grep -oP 'Package[^\\+]*\\+\\K[0-9]+'" mempty)
+ Volume/Main.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Common+import Control.Applicative (liftA2)+import Data.Maybe (maybe)+import Data.Text (pack, strip, unpack)+import Turtle++main :: IO ()+main = sh $ do+ liftIO . putStrLn =<< liftA2 formatVol isMuted getVolume+ maybe (return ExitSuccess) handleButton =<< currentButton++handleButton :: MonadIO io => Button -> io ExitCode+handleButton LeftClick = shell "pavucontrol" empty+handleButton RightClick = shell "ponymix toggle >/dev/null" empty+handleButton WheelUp = shell "ponymix increase 5 >/dev/null" empty+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 ++ "%"++icon :: Integer -> String+icon v | v < 33 = "\61479"+icon _ = "\61480"++isMuted :: Shell Bool+isMuted = (== ExitSuccess) <$> shell (pack "ponymix is-muted") empty++getVolume :: Shell Integer+getVolume = toVolumeInt <$> strict (inshell (pack "ponymix get-volume") empty)+ where toVolumeInt = read . unpack . strip
+ Wifi/Main.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.Monoid+import Data.Text.IO (putStrLn)+import Prelude hiding (putStrLn)+import Turtle++main :: IO ()+main = sh $ liftIO . putStrLn . format' =<< ssid++format' :: Text -> Text+format' ssid' = "\61931" <> " " <> ssid'++ssid :: Shell Text+ssid = strict $ inshell "iwgetid -r" empty
+ i3blocks-hs-contrib.cabal view
@@ -0,0 +1,234 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: 2848a3939923d85f2e41f6999eefbcfd33f0081ad14ce24fa91f6afb64f8e34d++name: i3blocks-hs-contrib+version: 1.0.0+synopsis: Base i3blocks written in haskell+description: @i3blocks-hs-contrib@ defines a set of blocks for your i3 bar+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+build-type: Simple+extra-source-files:+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/panavtec/i3blocks-hs-contrib++library+ exposed-modules:+ Common+ other-modules:+ Paths_i3blocks_hs_contrib+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base >=4.3 && <5+ , text <1.3+ , turtle <1.6+ default-language: Haskell2010++executable AirplaneMode+ main-is: Main.hs+ other-modules:+ Common+ Paths_i3blocks_hs_contrib+ hs-source-dirs:+ AirplaneMode+ src+ ghc-options: -Wall+ build-depends:+ base >=4.3 && <5+ , text <1.3+ , turtle <1.6+ default-language: Haskell2010++executable Bandwidth+ main-is: Main.hs+ other-modules:+ Paths_i3blocks_hs_contrib+ hs-source-dirs:+ Bandwidth+ ghc-options: -Wall+ build-depends:+ base >=4.3 && <5+ , text <1.3+ , time <1.9+ , transformers <0.6+ , turtle <1.6+ default-language: Haskell2010++executable Battery+ main-is: Main.hs+ other-modules:+ Common+ Paths_i3blocks_hs_contrib+ hs-source-dirs:+ Battery+ src+ ghc-options: -Wall+ build-depends:+ base >=4.3 && <5+ , text <1.3+ , turtle <1.6+ default-language: Haskell2010++executable Bitcoin+ hs-source-dirs:+ Bitcoin+ main-is: Main.hs+ other-modules:+ Paths_i3blocks_hs_contrib+ ghc-options: -Wall+ build-depends:+ aeson <1.5+ , attoparsec <0.14+ , base >=4.3 && <5+ , lens <4.2+ , lens-aeson <1.1+ , text <1.3+ , turtle <1.6+ , wreq <0.5+ default-language: Haskell2010++executable Cpu+ main-is: Main.hs+ other-modules:+ Common+ Paths_i3blocks_hs_contrib+ hs-source-dirs:+ Cpu+ src+ ghc-options: -Wall+ build-depends:+ base >=4.3 && <5+ , text <1.3+ , turtle <1.6+ default-language: Haskell2010++executable DateTime+ main-is: Main.hs+ other-modules:+ Paths_i3blocks_hs_contrib+ hs-source-dirs:+ DateTime+ ghc-options: -Wall+ build-depends:+ base >=4.3 && <5+ , text <1.3+ , time <1.9+ , turtle <1.6+ default-language: Haskell2010++executable Docker+ main-is: Main.hs+ other-modules:+ Common+ Paths_i3blocks_hs_contrib+ hs-source-dirs:+ Docker+ src+ ghc-options: -Wall+ build-depends:+ base >=4.3 && <5+ , text <1.3+ , turtle <1.6+ default-language: Haskell2010++executable Ip+ main-is: Main.hs+ other-modules:+ Paths_i3blocks_hs_contrib+ hs-source-dirs:+ Ip+ ghc-options: -Wall+ build-depends:+ base >=4.3 && <5+ , text <1.3+ , turtle <1.6+ default-language: Haskell2010++executable Memory+ main-is: Main.hs+ other-modules:+ Common+ Paths_i3blocks_hs_contrib+ hs-source-dirs:+ Memory+ src+ ghc-options: -Wall+ build-depends:+ base >=4.3 && <5+ , text <1.3+ , turtle <1.6+ default-language: Haskell2010++executable OpenVpn+ main-is: Main.hs+ other-modules:+ Common+ Paths_i3blocks_hs_contrib+ hs-source-dirs:+ OpenVpn+ src+ ghc-options: -Wall+ build-depends:+ base >=4.3 && <5+ , text <1.3+ , turtle <1.6+ default-language: Haskell2010++executable Temperature+ main-is: Main.hs+ other-modules:+ Paths_i3blocks_hs_contrib+ hs-source-dirs:+ Temperature+ ghc-options: -Wall+ build-depends:+ base >=4.3 && <5+ , text <1.3+ , turtle <1.6+ default-language: Haskell2010++executable Volume+ main-is: Main.hs+ other-modules:+ Common+ Paths_i3blocks_hs_contrib+ hs-source-dirs:+ Volume+ src+ ghc-options: -Wall+ build-depends:+ base >=4.3 && <5+ , text <1.3+ , turtle <1.6+ default-language: Haskell2010++executable Wifi+ main-is: Main.hs+ other-modules:+ Paths_i3blocks_hs_contrib+ hs-source-dirs:+ Wifi+ ghc-options: -Wall+ build-depends:+ base >=4.3 && <5+ , text <1.3+ , turtle <1.6+ default-language: Haskell2010
+ src/Common.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}++module Common where++import Data.Text (pack)+import Data.Text.IO (putStrLn)+import Numeric+import Turtle++processIsRunning :: String -> Shell Bool+processIsRunning process = (== ExitSuccess) . fst <$> shellStrict (pack $ "pidof " ++ process) empty++formatFloatN :: RealFloat a => a -> Int -> String+formatFloatN floatNum numOfDecimals = showFFloat (Just numOfDecimals) floatNum ""++data Button = LeftClick | RightClick | WheelUp | WheelDown | WheelLeft | WheelRight deriving (Eq, Show)++currentButton :: MonadIO io => io (Maybe Button)+currentButton = maybe Nothing toButton <$> (lookup "BLOCK_BUTTON" <$> env)++toButton :: Text -> Maybe Button+toButton "1" = Just LeftClick+toButton "3" = Just RightClick+toButton "4" = Just WheelUp+toButton "5" = Just WheelDown+toButton "6" = Just WheelLeft+toButton "7" = Just WheelRight+toButton _ = Nothing++buttonClicked :: MonadIO io => Button -> io Bool+buttonClicked but = (== Just but) <$> currentButton++newtype LongDesc = LongDesc Text deriving (Eq, Show)+newtype ShortDesc = ShortDesc Text deriving (Eq, Show)+newtype Color = Color Text deriving (Eq, Show)+data OutputReport = OutputReport {+ longDesc :: LongDesc,+ shortDesc :: Maybe ShortDesc,+ color :: Maybe Color+}++blockOutput :: MonadIO io => OutputReport -> io ()+blockOutput report = do+ let longDesc' = toText' . 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