taffybar 0.2.0 → 0.2.1

raw patch · 9 files changed

+168/−12 lines, 9 filesdep +process

Dependencies added: process

Files

• src/System/Information/CPU2.hs +17/−0
• src/System/Information/Network.hs +13/−0
• src/System/Information/StreamInfo.hs +52/−0
• src/System/Taffybar.hs +17/−6
• src/System/Taffybar/FSMonitor.hs +18/−0
• src/System/Taffybar/NetMonitor.hs +19/−0
• src/System/Taffybar/Widgets/PollingBar.hs +1/−0
• src/System/Taffybar/Widgets/VerticalBar.hs +15/−3
• taffybar.cabal +16/−3

@@ -0,0 +1,17 @@+module System.Information.CPU2 (getCPULoad) where++import System.Information.StreamInfo (getLoad, getParsedInfo)++getCPULoad :: String -> IO [Double]+getCPULoad cpu = do+    load <- getLoad 0.05 $ getCPUInfo cpu+    return [load!!0 + load!!1, load!!2]++getCPUInfo :: String -> IO [Integer]+getCPUInfo = getParsedInfo "/proc/stat" parse++parse :: String -> [(String, [Integer])]+parse = map (tuplize . words) . filter (\x -> take 3 x == "cpu") . lines++tuplize :: [String] -> (String, [Integer])+tuplize s = (head s, map read $ tail s)

@@ -0,0 +1,13 @@+module System.Information.Network (getNetInfo) where++import System.Information.StreamInfo (getParsedInfo)++getNetInfo :: String -> IO [Integer]+getNetInfo = getParsedInfo "/proc/net/dev" parse++parse :: String -> [(String, [Integer])]+parse = map tuplize . map words . drop 2 . lines++tuplize :: [String] -> (String, [Integer])+tuplize s = (init $ head s, map read [s!!1, s!!out])+    where out = (length s) - 7

@@ -0,0 +1,52 @@+-- | Generic code to poll any of the many data files maintained by the kernel in+-- POSIX systems. Provides methods for applying a custom parsing function to the+-- contents of the file and to calculate differentials across one or more values+-- provided via the file.+module System.Information.StreamInfo+    ( getParsedInfo+    , getLoad+    , getTransfer) where++import Control.Concurrent (threadDelay)+import Data.Maybe (fromJust)++-- | Apply the given parser function to the file under the given path to produce+-- a lookup map, then use the given selector as key to extract from it the+-- desired value.+getParsedInfo :: FilePath -> (String -> [(String, [Integer])]) -> String -> IO [Integer]+getParsedInfo path parser selector = do+    file <- readFile path+    (length file) `seq` return ()+    return (fromJust $ lookup selector $ parser file)++truncVal :: Double -> Double+truncVal v+  | isNaN v || v < 0.0 = 0.0+  | otherwise = v++-- | Execute the given action twice with the given delay in-between and return+-- the difference between the two samples.+probe :: IO [Integer] -> Double -> IO [Integer]+probe action delay = do+    a <- action+    threadDelay $ round (delay * 1e6)+    b <- action+    return $ zipWith (-) b a++-- | Probe the given action and, interpreting the result as a variation in time,+-- return the speed of change of its values.+getTransfer :: Double -> IO [Integer] -> IO [Double]+getTransfer interval action = do+    deltas <- probe action interval+    return $ map (truncVal . (/interval) . fromIntegral) deltas++-- | Probe the given action and return the relative variation of each of the+-- obtained values against the whole, where the whole is calculated as the sum+-- of all the values in the probe.+getLoad :: Double -> IO [Integer] -> IO [Double] +getLoad interval action = do+    deltas <- probe action interval+    let total  = fromIntegral $ foldr (+) 0 deltas+        ratios = map ((/total) . fromIntegral) deltas+    return $ map truncVal ratios+

@@ -136,14 +136,23 @@ data Position = Top | Bottom   deriving (Show, Eq) + strutProperties :: Position  -- ^ Bar position                 -> Int       -- ^ Bar height-                -> Rectangle -- ^ Monitor rectangle+                -> Rectangle -- ^ Current monitor rectangle+                -> [Rectangle] -- ^ All monitors                 -> StrutProperties-strutProperties pos bh (Rectangle x _ w _) = case pos of-    Top    -> (0, 0, bh, 0, 0, 0, 0, 0, x, x2, 0, 0)-    Bottom -> (0, 0, 0, bh, 0, 0, 0, 0, 0, 0, x, x2)-  where x2 = x + w - 10+strutProperties pos bh (Rectangle mX mY mW mH) monitors =+    propertize pos sX sW sH+    where sX = mX+          sW = mW - 1+          sH = case pos of Top    -> bh + mY+                           Bottom -> bh + totalH - mY - mH+          totalH = maximum $ map bottomY monitors+          bottomY (Rectangle _ y _ h) = y + h+          propertize p x w h = case p of+              Top    -> (0, 0, h, 0, 0, 0, 0, 0, x, x+w, 0,   0)+              Bottom -> (0, 0, 0, h, 0, 0, 0, 0, 0,   0, x, x+w)  data TaffybarConfig =   TaffybarConfig { screenNumber :: Int -- ^ The screen number to run the bar on (default is almost always fine)@@ -213,9 +222,10 @@     False -> error $ printf "Screen %d is not available in the default display" (screenNumber cfg)     True -> displayGetScreen disp (screenNumber cfg)   nmonitors <- screenGetNMonitors screen+  allMonitorSizes <- mapM (screenGetMonitorGeometry screen) [0 .. (nmonitors - 1)]   monitorSize <- case monitorNumber cfg < nmonitors of     False -> error $ printf "Monitor %d is not available in the selected screen" (monitorNumber cfg)-    True -> screenGetMonitorGeometry screen (monitorNumber cfg)+    True -> return $ allMonitorSizes !! monitorNumber cfg    window <- windowNew   widgetSetName window "Taffybar"@@ -230,6 +240,7 @@                             $ strutProperties (barPosition cfg)                                               (barHeight cfg)                                               monitorSize+                                              allMonitorSizes   box <- hBoxNew False 10   containerAdd window box 

@@ -0,0 +1,18 @@+module System.Taffybar.FSMonitor where++import Graphics.UI.Gtk+import System.Process (readProcess)+import System.Taffybar.Widgets.PollingLabel+import Text.Printf (printf)++fsMonitorNew :: Double -> [String] -> IO Widget+fsMonitorNew interval fsList = do+    label <- pollingLabelNew "" interval $ showFSInfo fsList+    widgetShowAll label+    return $ toWidget label+    where+        showFSInfo :: [String] -> IO String+        showFSInfo fsDict = do+            fsOut <- readProcess "df" (["-kP"] ++ fsList) ""+            let fss = map ((take 2) . reverse . words) $ drop 1 $ lines fsOut+            return $ unwords $ map ((\s -> "[" ++ s ++ "]") . unwords) fss

@@ -0,0 +1,19 @@+module System.Taffybar.NetMonitor where++import Graphics.UI.Gtk+import System.Information.Network (getNetInfo)+import System.Information.StreamInfo (getTransfer)+import System.Taffybar.Widgets.PollingLabel+import Text.Printf (printf)++netMonitorNew :: Double -> String -> IO Widget+netMonitorNew interval interface = do+    label <- pollingLabelNew "" interval $ showNetInfo interface+    widgetShowAll label+    return $ toWidget label+    where+        showNetInfo :: String -> IO String+        showNetInfo interface = do+            trans <- getTransfer 0.3 $ getNetInfo interface+            let [incoming, outgoing] = map (/1e3) trans+            return $ printf "▼ %.2fkb/s ▲ %.2fkb/s" incoming outgoing

@@ -4,6 +4,7 @@   -- * Types   VerticalBarHandle,   BarConfig(..),+  BarDirection(..),   -- * Constructors and accessors   pollingBarNew,   defaultBarConfig

@@ -4,6 +4,7 @@   -- * Types   VerticalBarHandle,   BarConfig(..),+  BarDirection(..),   -- * Accessors/Constructors   verticalBarNew,   verticalBarSetPercent,@@ -22,12 +23,15 @@                    , barConfig :: BarConfig                    } +data BarDirection = HORIZONTAL | VERTICAL+ data BarConfig =   BarConfig { barBorderColor :: (Double, Double, Double) -- ^ Color of the border drawn around the widget             , barBackgroundColor :: (Double, Double, Double) -- ^ The background color of the widget             , barColor :: Double -> (Double, Double, Double) -- ^ A function to determine the color of the widget for the current data point             , barPadding :: Int -- ^ Number of pixels of padding around the widget             , barWidth :: Int+            , barDirection :: BarDirection             }  -- | A default bar configuration.  The color of the active portion of@@ -38,6 +42,7 @@                                , barColor = c                                , barPadding = 2                                , barWidth = 15+                               , barDirection = VERTICAL                                }  verticalBarSetPercent :: VerticalBarHandle -> Double -> IO ()@@ -77,9 +82,16 @@ renderBar :: Double -> BarConfig -> Int -> Int -> Render () renderBar pct cfg width height = do -- renderBar pct (r, g, b) width height = do-  let activeHeight = pct * (fromIntegral height)-      activeWidth = fromIntegral width-      newOrigin = fromIntegral height - activeHeight+  let direction = barDirection cfg+      activeHeight = case direction of+                       VERTICAL   -> pct * (fromIntegral height)+                       HORIZONTAL -> fromIntegral height+      activeWidth  = case direction of+                       VERTICAL   -> fromIntegral width+                       HORIZONTAL -> pct * (fromIntegral width)+      newOrigin    = case direction of+                       VERTICAL -> fromIntegral height - activeHeight+                       HORIZONTAL -> 0       pad = barPadding cfg    renderFrame cfg width height

@@ -1,5 +1,5 @@ name: taffybar-version: 0.2.0+version: 0.2.1 synopsis: A desktop bar similar to xmobar, but with more GUI license: BSD3 license-file: LICENSE@@ -18,6 +18,14 @@   gtk2hs and provides several widgets (including a few graphical ones).   It also sports an optional snazzy system tray.   .+  Changes in v0.2.1:+  .+    * More robust strut handling for multiple monitors of different sizes (contributed by Morgan Gibson)+  .+    * New widgets from José A. Romero (network monitor, fs monitor, another CPU monitor)+  .+    * Allow the bar widget to grow vertically (also contributed by José A. Romero)+  .   Changes in v0.2.0:   .     * Add some more flexible formatting options for the XMonadLog widget (contributed by@@ -53,7 +61,7 @@                  parsec >= 3.1, mtl >= 2, network, web-encodings, cairo,                  dbus-core >= 0.9.1 && < 1.0, gtk >= 0.12.1, dyre >= 0.8.6,                  HStringTemplate, gtk-traymanager >= 0.1.2 && < 0.2, xmonad-contrib, xmonad,-                 xdg-basedir, filepath, utf8-string+                 xdg-basedir, filepath, utf8-string, process   hs-source-dirs: src   pkgconfig-depends: gtk+-2.0   exposed-modules: System.Taffybar,@@ -64,14 +72,19 @@                    System.Taffybar.Weather,                    System.Taffybar.MPRIS,                    System.Taffybar.Battery,+                   System.Taffybar.FSMonitor+                   System.Taffybar.NetMonitor                    System.Taffybar.Widgets.Graph,                    System.Taffybar.Widgets.PollingBar,                    System.Taffybar.Widgets.PollingGraph,                    System.Taffybar.Widgets.PollingLabel,                    System.Taffybar.Widgets.VerticalBar,+                   System.Information.StreamInfo,                    System.Information.Battery,                    System.Information.Memory,-                   System.Information.CPU+                   System.Information.Network,+                   System.Information.CPU,+                   System.Information.CPU2   other-modules: System.Taffybar.StrutProperties,                  Paths_taffybar