Initial import

.gitignore

@@ -0,0 +1 @@
+/dist/

LICENSE

@@ -0,0 +1,30 @@
+Copyright (c)2011, Tristan Ravitch
+
+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 Tristan Ravitch 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.

README.md

@@ -0,0 +1,38 @@
+This is a desktop information bar intended for use with XMonad and
+similar window managers.  It is similar in spirit to xmobar; it is
+different in that it gives up some simplicity for a reasonable helping
+of eye candy.  This bar is based on GTK+ (via gtk2hs) and uses fancy
+graphics where doing so is reasonable and useful.
+
+The bar is configured much like XMonad.  It uses
+~/.config/taffybar/taffybar.hs as its configuration file.  This file
+is just a Haskell program that invokes the real _main_ function with a
+configuration object.  The configuration file basically just specifies
+which widgets to use, though any arbitrary Haskell code can be
+executed before the bar is created.
+
+There are some generic pre-defined widgets available:
+
+ * Graph (modeled after the graph widget in Awesome)
+ * Vertical bar (also similar to a widget in Awesome)
+ * Periodically-updating labels, graphs, and vertical bars
+
+There are also several more specialized widgets:
+
+ * Battery widget
+ * Textual clock
+ * Freedesktop.org notifications (via dbus)
+ * MPRIS widget (currently only supports MPRIS1)
+ * Weather widget
+ * XMonad log widget (listens on dbus instead of stdin)
+ * System tray
+
+TODO
+====
+
+An incomplete list of things that would be cool to have:
+
+ * xrandr widget (for dealing changing clone/extend mode and orientation)
+ * MPRIS2 widget
+ * Better behavior when adding/removing monitors (never tried it)
+ * Make MPRIS more configurable

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

src/Main.hs

@@ -0,0 +1,9 @@
+-- | This is just a stub executable that uses dyre to read the config
+-- file and recompile itself.
+module Main ( main ) where
+
+import System.Taffybar
+
+main :: IO ()
+main = do
+  defaultTaffybar defaultTaffybarConfig

src/System/Information/Battery.hs

@@ -0,0 +1,166 @@
+{-# LANGUAGE OverloadedStrings #-}
+-- | This is a simple library to query the Linux UPower daemon (via
+-- DBus) for battery information.  Currently, it only retrieves
+-- information for the first battery it finds.
+module System.Information.Battery (
+  -- * Types
+  BatteryContext,
+  BatteryInfo(..),
+  BatteryState(..),
+  BatteryTechnology(..),
+  BatteryType(..),
+  -- * Accessors
+  batteryContextNew,
+  getBatteryInfo
+  ) where
+
+import Data.Map ( Map )
+import qualified Data.Map as M
+import Data.Word
+import Data.Int
+import DBus.Client.Simple
+import Data.List ( find )
+import Data.Text ( isInfixOf, Text )
+
+-- | An opaque wrapper around some internal library state
+newtype BatteryContext = BC Proxy
+
+data BatteryType = BatteryTypeUnknown
+                 | BatteryTypeLinePower
+                 | BatteryTypeBatteryType
+                 | BatteryTypeUps
+                 | BatteryTypeMonitor
+                 | BatteryTypeMouse
+                 | BatteryTypeKeyboard
+                 | BatteryTypePda
+                 | BatteryTypePhone
+                 deriving (Show, Ord, Eq, Enum)
+
+data BatteryState = BatteryStateUnknown
+                  | BatteryStateCharging
+                  | BatteryStateDischarging
+                  | BatteryStateEmpty
+                  | BatteryStateFullyCharged
+                  | BatteryStatePendingCharge
+                  | BatteryStatePendingDischarge
+                  deriving (Show, Ord, Eq, Enum)
+
+data BatteryTechnology = BatteryTechnologyUnknown
+                       | BatteryTechnologyLithiumIon
+                       | BatteryTechnologyLithiumPolymer
+                       | BatteryTechnologyLithiumIronPhosphate
+                       | BatteryTechnologyLeadAcid
+                       | BatteryTechnologyNickelCadmium
+                       | BatteryTechnologyNickelMetalHydride
+                       deriving (Show, Ord, Eq, Enum)
+
+-- | There are a few fields supported by UPower that aren't exposed
+-- here.. could be easily.
+data BatteryInfo = BatteryInfo { batteryNativePath :: Text
+                               , batteryVendor :: Text
+                               , batteryModel :: Text
+                               , batterySerial :: Text
+                               -- , batteryUpdateTime :: Time
+                               , batteryType :: BatteryType
+                               , batteryPowerSupply :: Bool
+                               , batteryHasHistory :: Bool
+                               , batteryHasStatistics :: Bool
+                               , batteryOnline :: Bool
+                               , batteryEnergy :: Double
+                               , batteryEnergyEmpty :: Double
+                               , batteryEnergyFull :: Double
+                               , batteryEnergyFullDesign :: Double
+                               , batteryEnergyRate :: Double
+                               , batteryVoltage :: Double
+                               , batteryTimeToEmpty :: Int64
+                               , batteryTimeToFull :: Int64
+                               , batteryPercentage :: Double
+                               , batteryIsPresent :: Bool
+                               , batteryState :: BatteryState
+                               , batteryIsRechargable :: Bool
+                               , batteryCapacity :: Double
+                               , batteryTechnology :: BatteryTechnology
+{-                               , batteryRecallNotice :: Bool
+                               , batteryRecallVendor :: Text
+                               , batteryRecallUr :: Text
+-}
+                               }
+
+-- | Find the first power source that is a battery in the list.  The
+-- simple heuristic is a substring search on 'BAT'
+firstBattery :: [ObjectPath] -> Maybe ObjectPath
+firstBattery = find (isInfixOf "BAT" . objectPathText)
+
+-- | The name of the power daemon bus
+powerBusName :: BusName
+powerBusName = "org.freedesktop.UPower"
+
+-- | The base object path
+powerBaseObjectPath :: ObjectPath
+powerBaseObjectPath = "/org/freedesktop/UPower"
+
+-- | A helper to read the variant contents of a dict with a default
+-- value.
+readDict :: (IsVariant a) => Map Text Variant -> Text -> a -> a
+readDict dict key dflt = val
+  where
+    Just val = fromVariant variant
+    variant = M.findWithDefault (toVariant dflt) key dict
+
+-- | Query the UPower daemon about information on a specific battery.
+-- If some fields are not actually present, they may have bogus values
+-- here.  Don't bet anything critical on it.
+getBatteryInfo :: BatteryContext -> IO BatteryInfo
+getBatteryInfo (BC batteryProxy) = do
+  -- Grab all of the properties of the battery each call with one
+  -- message.
+  let iface :: Variant
+      iface = toVariant ("org.freedesktop.UPower.Device" :: Text)
+
+  [val] <- call batteryProxy "org.freedesktop.DBus.Properties" "GetAll" [iface]
+
+  let dict :: Map Text Variant
+      Just dict = fromVariant val
+  return BatteryInfo { batteryNativePath = readDict dict "NativePath" ""
+                     , batteryVendor = readDict dict "Vendor" ""
+                     , batteryModel = readDict dict "Model" ""
+                     , batterySerial = readDict dict "Serial" ""
+                     , batteryType = toEnum $ fromIntegral $ readDict dict "Type" (0 :: Word64)
+                     , batteryPowerSupply = readDict dict "PowerSupply" False
+                     , batteryHasHistory = readDict dict "HasHistory" False
+                     , batteryHasStatistics = readDict dict "HasStatistics" False
+                     , batteryOnline = readDict dict "Online" False
+                     , batteryEnergy = readDict dict "Energy" 0.0
+                     , batteryEnergyEmpty = readDict dict "EnergyEmpty" 0.0
+                     , batteryEnergyFull = readDict dict "EnergyFull" 0.0
+                     , batteryEnergyFullDesign = readDict dict "EnergyFullDesign" 0.0
+                     , batteryEnergyRate = readDict dict "EnergyRate" 0.0
+                     , batteryVoltage = readDict dict "Voltage" 0.0
+                     , batteryTimeToEmpty = readDict dict "TimeToEmpty" 0
+                     , batteryTimeToFull = readDict dict "TimeToFull" 0
+                     , batteryPercentage = readDict dict "Percentage" 0.0
+                     , batteryIsPresent = readDict dict "IsPresent" False
+                     , batteryState = toEnum $ fromIntegral $ readDict dict "State" (0 :: Word64)
+                     , batteryIsRechargable = readDict dict "IsRechargable" True
+                     , batteryCapacity = readDict dict "Capacity" 0.0
+                     , batteryTechnology =
+                       toEnum $ fromIntegral $ readDict dict "Technology" (0 :: Word64)
+                     }
+
+-- | Construct a battery context if possible.  This could fail if the
+-- UPower daemon is not running.  The context can be used to get
+-- actual battery state with 'getBatteryInfo'.
+batteryContextNew :: IO (Maybe BatteryContext)
+batteryContextNew = do
+  systemConn <- connectSystem
+
+  -- First, get the list of devices.  For now, we just get the stats
+  -- for the first battery
+  powerProxy <- proxy systemConn powerBusName powerBaseObjectPath
+  [ powerDevicesV ] <- call powerProxy "org.freedesktop.UPower" "EnumerateDevices" []
+  let Just powerDevices = fromVariant powerDevicesV
+  case firstBattery powerDevices of
+    Nothing -> return Nothing
+    Just battPath ->
+      proxy systemConn powerBusName battPath >>= (return . Just . BC)
+

src/System/Information/CPU.hs

@@ -0,0 +1,35 @@
+module System.Information.CPU ( cpuLoad ) where
+
+import Control.Concurrent ( threadDelay )
+import System.IO ( IOMode(ReadMode), openFile, hGetLine, hClose )
+
+procData :: IO [Double]
+procData = do
+  h <- openFile "/proc/stat" ReadMode
+  firstLine <- hGetLine h
+  (length firstLine) `seq` return ()
+  hClose h
+  return (procParser firstLine)
+
+procParser :: String -> [Double]
+procParser = map read . tail . words
+
+truncVal :: Double -> Double
+truncVal v
+  | isNaN v || v < 0.0 = 0.0
+  | otherwise = v
+
+-- | Return a pair with (user time, system time, total time) (read
+-- from /proc/stat).  The function waits for 50 ms between samples.
+cpuLoad :: IO (Double, Double, Double)
+cpuLoad = do
+  a <- procData
+  threadDelay 50000
+  b <- procData
+  let dif = zipWith (-) b a
+      tot = foldr (+) 0 dif
+      pct = map (/ tot) dif
+      user = foldr (+) 0 $ take 2 pct
+      system = pct !! 2
+      t = user + system
+  return (truncVal user, truncVal system, truncVal t)

src/System/Information/Memory.hs

@@ -0,0 +1,34 @@
+module System.Information.Memory (
+  MemoryInfo(..),
+  parseMeminfo
+  ) where
+
+toMB :: [String] -> Double
+toMB line = (read $ line !! 1 :: Double) / 1024
+
+data MemoryInfo = MemoryInfo { memoryUsedRatio :: Double
+                             , memoryTotal :: Double
+                             , memoryFree :: Double
+                             , memoryBuffer :: Double
+                             , memoryCache :: Double
+                             , memoryRest :: Double
+                             , memoryUsed :: Double
+                             }
+
+parseMeminfo :: IO MemoryInfo
+parseMeminfo = do
+  s <- readFile "/proc/meminfo"
+  let content = map words $ take 4 $ lines s
+      [total, free, buffer, cache ] = map toMB content
+      rest = free + buffer + cache
+      used = total - rest
+      usedRatio = used / total
+  return MemoryInfo { memoryUsedRatio = usedRatio
+                    , memoryTotal = total
+                    , memoryFree = free
+                    , memoryBuffer = buffer
+                    , memoryCache = cache
+                    , memoryRest = rest
+                    , memoryUsed = used
+                    }
+