summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpanavtec <>2019-05-19 13:39:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-05-19 13:39:00 (GMT)
commit186ece9abb341dc6279eaeace37975bf502413f0 (patch)
treed7dba71662e0d81e5dadd8cc47fa06a457acc5e4
version 1.0.0HEAD1.0.0master
-rw-r--r--AirplaneMode/Main.hs69
-rw-r--r--Bandwidth/Main.hs234
-rw-r--r--Battery/Main.hs60
-rw-r--r--Bitcoin/Main.hs20
-rw-r--r--CHANGELOG.md2
-rw-r--r--Cpu/Main.hs26
-rw-r--r--DateTime/Main.hs18
-rw-r--r--Docker/Main.hs22
-rw-r--r--Ip/Main.hs14
-rw-r--r--LICENSE30
-rw-r--r--Memory/Main.hs37
-rw-r--r--OpenVpn/Main.hs16
-rw-r--r--Setup.hs2
-rw-r--r--Temperature/Main.hs15
-rw-r--r--Volume/Main.hs36
-rw-r--r--Wifi/Main.hs17
-rw-r--r--i3blocks-hs-contrib.cabal234
-rw-r--r--src/Common.hs51
18 files changed, 903 insertions, 0 deletions
diff --git a/AirplaneMode/Main.hs b/AirplaneMode/Main.hs
new file mode 100644
index 0000000..9ea5312
--- /dev/null
+++ b/AirplaneMode/Main.hs
@@ -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
diff --git a/Bandwidth/Main.hs b/Bandwidth/Main.hs
new file mode 100644
index 0000000..4354203
--- /dev/null
+++ b/Bandwidth/Main.hs
@@ -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
+ )
diff --git a/Battery/Main.hs b/Battery/Main.hs
new file mode 100644
index 0000000..e73b8f5
--- /dev/null
+++ b/Battery/Main.hs
@@ -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
diff --git a/Bitcoin/Main.hs b/Bitcoin/Main.hs
new file mode 100644
index 0000000..b46f37e
--- /dev/null
+++ b/Bitcoin/Main.hs
@@ -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 _ = ""
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..9080e2c
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,2 @@
+## Changes in 0.1.0
+Initial version
diff --git a/Cpu/Main.hs b/Cpu/Main.hs
new file mode 100644
index 0000000..0ffcb61
--- /dev/null
+++ b/Cpu/Main.hs
@@ -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)
diff --git a/DateTime/Main.hs b/DateTime/Main.hs
new file mode 100644
index 0000000..ae59418
--- /dev/null
+++ b/DateTime/Main.hs
@@ -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
diff --git a/Docker/Main.hs b/Docker/Main.hs
new file mode 100644
index 0000000..1d06359
--- /dev/null
+++ b/Docker/Main.hs
@@ -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
diff --git a/Ip/Main.hs b/Ip/Main.hs
new file mode 100644
index 0000000..bbf3f76
--- /dev/null
+++ b/Ip/Main.hs
@@ -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
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..d6c04a6
--- /dev/null
+++ b/LICENSE
@@ -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. \ No newline at end of file
diff --git a/Memory/Main.hs b/Memory/Main.hs
new file mode 100644
index 0000000..b0bfa7f
--- /dev/null
+++ b/Memory/Main.hs
@@ -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
diff --git a/OpenVpn/Main.hs b/OpenVpn/Main.hs
new file mode 100644
index 0000000..9d1b1e8
--- /dev/null
+++ b/OpenVpn/Main.hs
@@ -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
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Temperature/Main.hs b/Temperature/Main.hs
new file mode 100644
index 0000000..ffc0820
--- /dev/null
+++ b/Temperature/Main.hs
@@ -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)
diff --git a/Volume/Main.hs b/Volume/Main.hs
new file mode 100644
index 0000000..760bc55
--- /dev/null
+++ b/Volume/Main.hs
@@ -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
diff --git a/Wifi/Main.hs b/Wifi/Main.hs
new file mode 100644
index 0000000..7832f52
--- /dev/null
+++ b/Wifi/Main.hs
@@ -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
diff --git a/i3blocks-hs-contrib.cabal b/i3blocks-hs-contrib.cabal
new file mode 100644
index 0000000..8f09adb
--- /dev/null
+++ b/i3blocks-hs-contrib.cabal
@@ -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
diff --git a/src/Common.hs b/src/Common.hs
new file mode 100644
index 0000000..040496b
--- /dev/null
+++ b/src/Common.hs
@@ -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