Permalink
Browse files

Initial import

  • Loading branch information...
0 parents commit 190f14fb3626da2415062e64e9c8f4473a6111ad @travitch committed Aug 12, 2011
@@ -0,0 +1 @@
+/dist/
@@ -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.
@@ -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
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
@@ -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
@@ -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)
+
@@ -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)
@@ -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
+ }
+
Oops, something went wrong.

0 comments on commit 190f14f

Please sign in to comment.