taffybar 2.1.0 → 2.1.1

raw patch · 22 files changed

+443/−323 lines, 22 filesdep −alsa-mixerPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: alsa-mixer

API changes (from Hackage documentation)

Files

• README.md +1/−8
• dbus-xml/org.freedesktop.UPower.Device.xml +48/−0
• dbus-xml/org.freedesktop.UPower.xml +26/−0
• dbus-xml/org.mpris.MediaPlayer2.xml +10/−0
• src/System/Taffybar/Compat/GtkLibs.hs +0/−13
• src/System/Taffybar/Context.hs +1/−10
• src/System/Taffybar/EWMHPixbuf.hs +0/−78
• src/System/Taffybar/Hooks.hs +43/−6
• src/System/Taffybar/Information/EWMHDesktopInfo.hs +25/−20
• src/System/Taffybar/Information/Volume.hs +0/−40
• src/System/Taffybar/Information/XDG/DesktopEntry.hs +8/−1
• src/System/Taffybar/Information/XDG/Protocol.hs +0/−1
• src/System/Taffybar/Util.hs +44/−0
• src/System/Taffybar/Widget.hs +1/−11
• src/System/Taffybar/Widget/Generic/DynamicMenu.hs +0/−1
• src/System/Taffybar/Widget/SNITray.hs +12/−5
• src/System/Taffybar/Widget/Util.hs +8/−0
• src/System/Taffybar/Widget/Volume.hs +0/−26
• src/System/Taffybar/Widget/Workspaces.hs +84/−95
• src/System/Taffybar/WindowIcon.hs +122/−0
• taffybar.cabal +6/−7
• taffybar.hs.example +4/−1

@@ -1,11 +1,4 @@-Taffybar-========-[![Hackage](https://img.shields.io/hackage/v/taffybar.svg)](https://hackage.haskell.org/package/taffybar)-[![Commits](https://img.shields.io/github/commits-since/taffybar/taffybar/latest-release.svg?label=unreleased%20commits)](https://github.com/taffybar/taffybar/compare/latest-release...master)-[![Build Status](https://travis-ci.org/taffybar/taffybar.svg?branch=master)](https://travis-ci.org/taffybar/taffybar)-[![Help Wanted](https://img.shields.io/github/issues/taffybar/taffybar/help%20wanted.svg)](https://github.com/taffybar/taffybar/labels/help%20wanted)-[![Gitter chat](https://badges.gitter.im/gitterHQ/gitter.png)](https://gitter.im/taffybar/Lobby)-[![License BSD3](https://img.shields.io/badge/license-BSD3-green.svg?dummy)](https://github.com/taffybar/taffybar/blob/master/LICENSE)+# Taffybar [![Hackage](https://img.shields.io/hackage/v/taffybar.svg)](https://hackage.haskell.org/package/taffybar) [![Commits](https://img.shields.io/github/commits-since/taffybar/taffybar/latest-release.svg?label=unreleased%20commits)](https://github.com/taffybar/taffybar/compare/latest-release...master) [![Build Status](https://travis-ci.org/taffybar/taffybar.svg?branch=master)](https://travis-ci.org/taffybar/taffybar) [![Help Wanted](https://img.shields.io/github/issues/taffybar/taffybar/help%20wanted.svg)](https://github.com/taffybar/taffybar/labels/help%20wanted) [![Gitter chat](https://badges.gitter.im/gitterHQ/gitter.png)](https://gitter.im/taffybar/Lobby) [![License BSD3](https://img.shields.io/badge/license-BSD3-green.svg?dummy)](https://github.com/taffybar/taffybar/blob/master/LICENSE)  ![https://github.com/taffybar/taffybar/blob/master/doc/screenshot.png](https://raw.githubusercontent.com/taffybar/taffybar/master/doc/screenshot.png) 

@@ -0,0 +1,48 @@+<node>+  <interface name="org.freedesktop.UPower.Device">+    <method name="Refresh">+      <annotation name="org.freedesktop.DBus.GLib.Async" value=""/>+    </method>+    <method name="GetHistory">+      <annotation name="org.freedesktop.DBus.GLib.Async" value=""/>+      <arg type="s" name="typev" direction="in"/>+      <arg type="u" name="timespan" direction="in"/>+      <arg type="u" name="resolution" direction="in"/>+      <arg type="a(udu)" name="data" direction="out"/>+    </method>+    <method name="GetStatistics">+      <annotation name="org.freedesktop.DBus.GLib.Async" value=""/>+      <arg type="s" name="typev" direction="in"/>+      <arg type="a(dd)" name="data" direction="out"/>+    </method>+    <property type="s" name="NativePath" access="read"/>+    <property type="s" name="Vendor" access="read"/>+    <property type="s" name="Model" access="read"/>+    <property type="s" name="Serial" access="read"/>+    <property type="t" name="UpdateTime" access="read"/>+    <property type="u" name="Type" access="read"/>+    <property type="b" name="PowerSupply" access="read"/>+    <property type="b" name="HasHistory" access="read"/>+    <property type="b" name="HasStatistics" access="read"/>+    <property type="b" name="Online" access="read"/>+    <property type="d" name="Energy" access="read"/>+    <property type="d" name="EnergyEmpty" access="read"/>+    <property type="d" name="EnergyFull" access="read"/>+    <property type="d" name="EnergyFullDesign" access="read"/>+    <property type="d" name="EnergyRate" access="read"/>+    <property type="d" name="Voltage" access="read"/>+    <property type="d" name="Luminosity" access="read"/>+    <property type="x" name="TimeToEmpty" access="read"/>+    <property type="x" name="TimeToFull" access="read"/>+    <property type="d" name="Percentage" access="read"/>+    <property type="d" name="Temperature" access="read"/>+    <property type="b" name="IsPresent" access="read"/>+    <property type="u" name="State" access="read"/>+    <property type="b" name="IsRechargeable" access="read"/>+    <property type="d" name="Capacity" access="read"/>+    <property type="u" name="Technology" access="read"/>+    <property type="u" name="WarningLevel" access="read"/>+    <property type="u" name="BatteryLevel" access="read"/>+    <property type="s" name="IconName" access="read"/>+  </interface>+</node>

@@ -0,0 +1,26 @@+<node>+  <interface name="org.freedesktop.UPower">+    <method name="EnumerateDevices">+      <annotation name="org.freedesktop.DBus.GLib.Async" value=""/>+      <arg type="ao" name="devices" direction="out"/>+    </method>+    <method name="GetDisplayDevice">+      <annotation name="org.freedesktop.DBus.GLib.Async" value=""/>+      <arg type="o" name="device" direction="out"/>+    </method>+    <method name="GetCriticalAction">+      <annotation name="org.freedesktop.DBus.GLib.Async" value=""/>+      <arg type="s" name="action" direction="out"/>+    </method>+    <signal name="DeviceAdded">+      <arg type="o" name="device"/>+    </signal>+    <signal name="DeviceRemoved">+      <arg type="o" name="device"/>+    </signal>+    <property type="s" name="DaemonVersion" access="read"/>+    <property type="b" name="OnBattery" access="read"/>+    <property type="b" name="LidIsClosed" access="read"/>+    <property type="b" name="LidIsPresent" access="read"/>+  </interface>+</node>

@@ -0,0 +1,10 @@+<node>+  <interface name="org.mpris.MediaPlayer2">+    <property name="CanQuit" type="b" access="read"/>+    <property name="CanRaise" type="b" access="read"/>+    <property name="DesktopEntry" type="s" access="read"/>+    <property name="Identity" type="s" access="read"/>+    <method name="Quit"/>+    <method name="Raise"/>+  </interface>+</node>

@@ -12,11 +12,8 @@  import           Control.Monad.IO.Class import           Data.GI.Base.ManagedPtr-import           Data.Word import           Foreign.ForeignPtr-import           Foreign.Marshal.Alloc import           Foreign.Ptr-import           GI.GdkPixbuf.Enums import qualified GI.GdkPixbuf.Objects.Pixbuf as PB import qualified GI.Gtk import qualified Graphics.UI.Gtk as Gtk@@ -57,13 +54,3 @@  toGIImage :: MonadIO m => Gtk.Image -> m GI.Gtk.Image toGIImage = toGIWidget' GI.Gtk.Image Gtk.unImage---- | Call the GI version of 'pixbufNewFromData' with sensible parameters. The--- provided ptr will be freed when the pixbuf is destroyed.-pixbufNewFromData :: (Integral p2, Integral p1) => Ptr Word8 -> p2 -> p1 -> IO PB.Pixbuf-pixbufNewFromData ptr w h = do-  let width = fromIntegral w-      height = fromIntegral h-      rowStride = width * 4-  PB.pixbufNewFromData ptr ColorspaceRgb True 8-    width height rowStride (Just free)

@@ -45,7 +45,6 @@ import           System.Taffybar.Information.SafeX11 import           System.Taffybar.Information.X11DesktopInfo import           System.Taffybar.Util-import           System.Taffybar.Widget.Generic.AutoSizeImage import           System.Taffybar.Widget.Util import           Text.Printf import           Unsafe.Coerce@@ -181,15 +180,7 @@   _ <- widgetSetClass window "taffy-window"    let addWidgetWith widgetAdd buildWidget =-        do-          widget <- runReaderT buildWidget context-          -- XXX: This is a pretty bad way to do this-          let height =-                case strutHeight $ strutConfig barConfig of-                  ExactSize size -> fromIntegral size-                  _ -> 40-          Gtk.widgetSetSizeRequest widget (-1) height-          widgetAdd widget+        runReaderT buildWidget thisContext >>= widgetAdd       addToStart widget = Gtk.boxPackStart box widget Gtk.PackNatural 0       addToEnd widget = Gtk.boxPackEnd box widget Gtk.PackNatural 0       addToCenter widget = Gtk.boxPackStart centerBox widget Gtk.PackNatural 0

@@ -1,78 +0,0 @@--------------------------------------------------------------------------------- |--- Module      : System.Taffybar.EWMHPixbuf--- Copyright   : (c) Ivan A. Malison--- License     : BSD3-style (see LICENSE)------ Maintainer  : Ivan A. Malison--- Stability   : unstable--- Portability : unportable--------------------------------------------------------------------------------module System.Taffybar.EWMHPixbuf-  ( ColorRGBA-  , pixBufFromEWMHIcon-  , pixelsARGBToBytesABGR-  , pixBufFromColor-  , pixBufFromFile-  ) where--import           Data.Bits-import           Data.Int-import           Data.Word-import           Foreign.Marshal.Array-import           Foreign.Ptr-import           Foreign.Storable-import qualified GI.GdkPixbuf.Enums as Gdk-import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk-import           System.Taffybar.Compat.GtkLibs-import           System.Taffybar.Information.EWMHDesktopInfo--type ColorRGBA = Word32--colorspace :: Gdk.Colorspace-colorspace = Gdk.ColorspaceRgb---- | Create a pixbuf from the pixel data in an EWMHIcon.-pixBufFromEWMHIcon :: EWMHIcon -> IO Gdk.Pixbuf-pixBufFromEWMHIcon EWMHIcon {width = w, height = h, pixelsARGB = px} = do-  wPtr <- pixelsARGBToBytesABGR px (w * h)-  pixbufNewFromData wPtr w h---- | Create a pixbuf with the indicated RGBA color.-pixBufFromColor :: Int32 -> ColorRGBA -> IO Gdk.Pixbuf-pixBufFromColor imgSize c = do-  Just pixbuf <- Gdk.pixbufNew colorspace True 8 imgSize imgSize-  Gdk.pixbufFill pixbuf c-  return pixbuf---- | Convert a C array of integer pixels in the ARGB format to the ABGR format.--- Returns an unmanged Ptr that points to a block of memory that must be freed--- manually.-pixelsARGBToBytesABGR-  :: (Storable a, Bits a, Num a, Integral a)-  => Ptr a -> Int -> IO (Ptr Word8)-pixelsARGBToBytesABGR ptr size = do-  target <- mallocArray (size * 4)-  let writeIndex i = do-        bits <- peekElemOff ptr i-        let b = toByte bits-            g = toByte $ bits `shift` (-8)-            r = toByte $ bits `shift` (-16)-            a = toByte $ bits `shift` (-24)-            baseTarget = 4 * i-            doPoke offset = pokeElemOff target (baseTarget + offset)-            toByte = fromIntegral . (.&. 0xFF)-        doPoke 0 r-        doPoke 1 g-        doPoke 2 b-        doPoke 3 a-      writeIndexAndNext i-        | i >= size = return ()-        | otherwise = writeIndex i >> writeIndexAndNext (i + 1)-  writeIndexAndNext 0-  return target---- | Create a pixbuf from a file and scale it to be square.-pixBufFromFile :: FilePath -> IO Gdk.Pixbuf-pixBufFromFile = Gdk.pixbufNewFromFile

@@ -4,12 +4,20 @@   , refreshBatteriesOnPropChange   ) where -import Control.Concurrent-import Control.Monad.Trans.Class-import System.Taffybar.Context-import System.Taffybar.DBus-import System.Taffybar.Information.Battery-import System.Taffybar.Information.Network+import           Control.Applicative+import           Control.Concurrent+import           Control.Monad+import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Reader+import           Data.Maybe+import qualified Data.MultiMap as MM+import           System.FilePath+import           System.Taffybar.Context+import           System.Taffybar.DBus+import           System.Taffybar.Information.Battery+import           System.Taffybar.Information.Network+import           System.Taffybar.Information.XDG.DesktopEntry+import           System.Taffybar.Util  newtype NetworkInfoChan = NetworkInfoChan (Chan [(String, (Rational, Rational))]) @@ -24,3 +32,32 @@  withBatteryRefresh :: TaffybarConfig -> TaffybarConfig withBatteryRefresh = appendHook refreshBatteriesOnPropChange++getDirectoryEntriesByClassName :: TaffyIO (MM.MultiMap String DesktopEntry)+getDirectoryEntriesByClassName =+  getStateDefault readDirectoryEntriesDefault++updateDirectoryEntriesCache :: TaffyIO ()+updateDirectoryEntriesCache = ask >>= \ctx ->+  void $ lift $ foreverWithDelay (60 :: Double) $ flip runReaderT ctx $+       putState readDirectoryEntriesDefault++readDirectoryEntriesDefault :: TaffyIO (MM.MultiMap String DesktopEntry)+readDirectoryEntriesDefault = lift $+  directoryEntriesByClassName <$> getDirectoryEntriesDefault++directoryEntriesByClassName+  :: Foldable t+  => t DesktopEntry -> MM.MultiMap String DesktopEntry+directoryEntriesByClassName = foldl insertByClassName MM.empty+  where+    insertByClassName entriesMap entry =+      MM.insert (getClassName entry) entry entriesMap+    getFromFilename filepath =+      let (_, filename) = splitFileName filepath+          (_, noExtensions) = splitExtensions filename+      in noExtensions+    getClassName DesktopEntry {deAttributes = attributes, deFilename = filename} =+      fromMaybe (getFromFilename filename) $+                lookup "StartupWMClass" attributes <|>+                lookup "Name" attributes

@@ -20,31 +20,33 @@ -----------------------------------------------------------------------------  module System.Taffybar.Information.EWMHDesktopInfo-  ( X11Window      -- re-exported from X11DesktopInfo-  , X11WindowHandle-  , WorkspaceIdx(..)-  , EWMHIcon(..)+  ( EWMHIcon(..)   , EWMHIconData-  , withDefaultCtx -- re-exported from X11DesktopInfo-  , isWindowUrgent -- re-exported from X11DesktopInfo+  , WorkspaceIdx(..)+  , X11Window      -- re-exported from X11DesktopInfo+  , X11WindowHandle+  , focusWindow+  , getActiveWindowTitle   , getCurrentWorkspace   , getVisibleWorkspaces-  , getWorkspaceNames-  , switchToWorkspace-  , switchOneWorkspace-  , withEWMHIcons-  , getWindowTitle   , getWindowClass+  , getWindowHandles   , getWindowIconsData-  , getActiveWindowTitle+  , getWindowTitle   , getWindows-  , getWindowHandles   , getWorkspace-  , focusWindow+  , getWorkspaceNames+  , isWindowUrgent -- re-exported from X11DesktopInfo+  , parseWindowClasses+  , switchOneWorkspace+  , switchToWorkspace+  , withDefaultCtx -- re-exported from X11DesktopInfo+  , withEWMHIcons   ) where  import Control.Applicative import Control.Monad.Trans.Class+import Data.List.Split import Data.Maybe import Data.Tuple import Data.Word@@ -79,9 +81,9 @@ type EWMHIconData = (ForeignPtr PixelsWordType, Int)  data EWMHIcon = EWMHIcon-  { width :: Int-  , height :: Int-  , pixelsARGB :: Ptr PixelsWordType+  { ewmhWidth :: Int+  , ewmhHeight :: Int+  , ewmhPixelsARGB :: Ptr PixelsWordType   } deriving (Show, Eq)  noFocus :: String@@ -145,6 +147,9 @@ getWindowClass :: X11Window -> X11Property String getWindowClass window = readAsString (Just window) "WM_CLASS" +parseWindowClasses :: String -> [String]+parseWindowClasses = filter (not . null) . splitOn "\NUL"+ -- | Get EWMHIconData for the given X11Window getWindowIconsData :: X11Window -> X11Property (Maybe EWMHIconData) getWindowIconsData window = do@@ -179,9 +184,9 @@       newArr = advancePtr pixelsPtr thisSize       thisIcon =         EWMHIcon-        { width = iwidth-        , height = iheight-        , pixelsARGB = pixelsPtr+        { ewmhWidth = iwidth+        , ewmhHeight = iheight+        , ewmhPixelsARGB = pixelsPtr         }       getRes newSize         | newSize < 0 = trace "This should not happen parseIcons" return []

@@ -1,40 +0,0 @@-module System.Taffybar.Information.Volume-  ( getVolume-  , setVolume-  ) where--import Sound.ALSA.Mixer--volumeAct :: String -> String -> (Volume -> Integer -> Integer -> IO a) -> IO a-volumeAct mix channel action = withMixer mix $ \mixer -> do-  Just control <- getControlByName mixer channel-  let Just playbackVolume = playback $ volume control-  (lo, hi) <- getRange playbackVolume-  action playbackVolume lo hi---- | Gets volume of a channel of a mixer-getVolume :: String -> String -> IO Integer-getVolume mix channel = volumeAct mix channel $ \playbackVolume lo hi -> do-  Just vol <- getChannel FrontLeft $ value playbackVolume-  return $ toPercent vol lo hi---- | Sets volume of a channel of a mixer-setVolume :: String -> String -> Double -> IO ()-setVolume mix channel vol = volumeAct mix channel $ \playbackVolume lo hi -> do-  let volumeValue = value playbackVolume-      percentage = fromPercent vol lo hi-      setForChannel c = setChannel c volumeValue percentage-  mapM_ setForChannel allChannels--toPercent :: Integer -> Integer -> Integer -> Integer-toPercent v lo hi = ceiling $ (v' - lo') / (hi' - lo') * 100-  where-    v' :: Double-    v' = fromIntegral v-    lo' = fromIntegral lo-    hi' = fromIntegral hi--fromPercent :: Double -> Integer -> Integer -> Integer-fromPercent v lo hi = ceiling $ lo' + (hi' - lo') * v / 100-  where lo' = fromIntegral lo-        hi' = fromIntegral hi

@@ -10,7 +10,7 @@ -- -- Implementation of version 1.1 of the freedesktop "Desktop Entry -- specification", see--- https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-1.1.html.+-- https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-1.2.html. -----------------------------------------------------------------------------  module System.Taffybar.Information.XDG.DesktopEntry@@ -25,6 +25,7 @@   , deOnlyShowIn   , existingDirs   , getDefaultDataHome+  , getDirectoryEntriesDefault   , getDirectoryEntry   , getDirectoryEntryDefault   , getXDGDataDirs@@ -184,6 +185,12 @@ getDirectoryEntryDefault entry =   fmap (</> "applications") <$> getXDGDataDirs >>=   flip getDirectoryEntry (printf "%s.desktop" entry)++getDirectoryEntriesDefault :: IO [DesktopEntry]+getDirectoryEntriesDefault =+  fmap (</> "applications") <$> getXDGDataDirs >>= foldM addDirectories []+  where addDirectories soFar directory =+          (soFar ++) <$> listDesktopEntries "desktop" directory  -- | Main section of a desktop entry file. sectionMain :: String

@@ -104,7 +104,6 @@ getApplicationEntries langs xm = do   defEntries <- if xmDefaultAppDirs xm     then do dataDirs <- getXDGDataDirs-            putStrLn $ "DataDirs=" ++ show dataDirs             concat <$> mapM (listDesktopEntries ".desktop" .                                                   (</> "applications")) dataDirs     else return []

@@ -11,13 +11,19 @@  module System.Taffybar.Util where +import           Control.Applicative import           Control.Arrow ((&&&)) import           Control.Concurrent+import           Control.Exception.Base import           Control.Monad import           Control.Monad.IO.Class import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Maybe import           Control.Monad.Trans.Reader+import           Data.Either.Combinators+import           Data.GI.Base.GError import           Data.Tuple.Sequence+import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk import           System.Exit (ExitCode (..)) import           System.Log.Logger import qualified System.Process as P@@ -81,3 +87,41 @@ liftActionTaker actionTaker action = do   ctx <- ask   lift $ actionTaker $ flip runReaderT ctx . action++maybeTCombine+  :: Monad m+  => m (Maybe a) -> m (Maybe a) -> m (Maybe a)+maybeTCombine a b = runMaybeT $ MaybeT a <|> MaybeT b++infixl 3 <||>+(<||>) :: Monad m =>+             (t -> m (Maybe a)) -> (t -> m (Maybe a)) -> t -> m (Maybe a)+a <||> b = combineOptions+  where combineOptions v = maybeTCombine (a v) (b v)++infixl 3 <|||>+(<|||>)+  :: Monad m+  => (t -> t1 -> m (Maybe a))+  -> (t -> t1 -> m (Maybe a))+  -> t+  -> t1+  -> m (Maybe a)+a <|||> b = combineOptions+  where combineOptions v v1 = maybeTCombine (a v v1) (b v v1)++catchGErrorsAsLeft :: IO a -> IO (Either GError a)+catchGErrorsAsLeft action = catch (Right <$> action) mkLeft+  where mkLeft err = return $ Left err++safePixbufNewFromFile :: FilePath -> IO (Either GError Gdk.Pixbuf)+safePixbufNewFromFile filepath =+  catchGErrorsAsLeft (Gdk.pixbufNewFromFile filepath)++getPixbufFromFilePath :: FilePath -> IO (Maybe Gdk.Pixbuf)+getPixbufFromFilePath filepath = do+  result <- safePixbufNewFromFile filepath+  when (isLeft result) $+       logM "System.Taffybar.WindowIcon" WARNING $+            printf "Failed to load icon from filepath %s" filepath+  return $ rightToMaybe result

@@ -53,10 +53,6 @@   -- * "System.Taffybar.Widget.Text.NetworkMonitor"   , module System.Taffybar.Widget.Text.NetworkMonitor -  -- * "System.Taffybar.Widget.Volume"-  , volumeTextNew-  , volumeControlNew-   -- * "System.Taffybar.Widget.Weather"   , WeatherConfig(..)   , WeatherInfo(..)@@ -73,12 +69,7 @@   , truncatedGetMenuLabel    -- * "System.Taffybar.Widget.Workspaces"-  , IconInfo(..)-  , Workspace(..)-  , WorkspacesConfig(..)-  , WorkspacesIO-  , hideEmpty-  , workspacesNew+  , module System.Taffybar.Widget.Workspaces    -- * "System.Taffybar.Widget.XDGMenu.MenuWidget"   , module System.Taffybar.Widget.XDGMenu.MenuWidget@@ -100,7 +91,6 @@ import System.Taffybar.Widget.Text.MemoryMonitor import System.Taffybar.Widget.Text.NetworkMonitor import System.Taffybar.Widget.Util-import System.Taffybar.Widget.Volume import System.Taffybar.Widget.Weather import System.Taffybar.Widget.Windows import System.Taffybar.Widget.Workspaces

@@ -2,7 +2,6 @@  import           Control.Monad.IO.Class import qualified GI.Gtk as Gtk-import           System.Log.Logger  data DynamicMenuConfig = DynamicMenuConfig   { dmClickWidget :: Gtk.Widget

@@ -24,21 +24,21 @@ import           System.Taffybar.Widget.Util import           Text.Printf -getHost :: TaffyIO H.Host-getHost = getStateDefault $ do+getHost :: Bool -> TaffyIO H.Host+getHost startWatcher = getStateDefault $ do   pid <- lift getProcessID   client <- asks sessionDBusClient   Just host <- lift $ H.build H.defaultParams      { H.dbusClient = Just client      , H.uniqueIdentifier = printf "taffybar-%s" $ show pid+     , H.startWatcher = startWatcher      }   return host  -- | Build a new StatusNotifierItem tray that will share a host with any other -- trays that are constructed automatically-sniTrayNew :: TaffyIO Gtk.Widget-sniTrayNew = do-  host <- getHost+sniTrayNewFromHost :: H.Host -> TaffyIO Gtk.Widget+sniTrayNewFromHost host = do   client <- asks sessionDBusClient   lift $ do     tray <-@@ -54,3 +54,10 @@     _ <- widgetSetClassGI tray "sni-tray"     GI.Gtk.widgetShowAll tray     GI.Gtk.toWidget tray >>= fromGIWidget++sniTrayNew :: TaffyIO Gtk.Widget+sniTrayNew = getHost False >>= sniTrayNewFromHost++sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt :: TaffyIO Gtk.Widget+sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt = getHost True >>= sniTrayNewFromHost+

@@ -142,6 +142,14 @@       then Just <$> GI.pixbufNewFromFile iconName       else return Nothing +loadPixbufByName :: Int32 -> T.Text -> IO (Maybe GI.Pixbuf)+loadPixbufByName size name = do+  iconTheme <- GI.Gtk.iconThemeGetDefault+  hasIcon <- GI.Gtk.iconThemeHasIcon iconTheme name+  if hasIcon+  then GI.Gtk.iconThemeLoadIcon iconTheme name size themeLoadFlags+  else return Nothing+ alignCenter :: (GI.Gtk.IsWidget o, MonadIO m) => o -> m () alignCenter widget =   GI.Gtk.setWidgetValign widget GI.Gtk.AlignCenter >>

@@ -1,26 +0,0 @@-module System.Taffybar.Widget.Volume-  ( volumeTextNew-  , volumeControlNew-  ) where--import Control.Monad.IO.Class-import Graphics.UI.Gtk-import System.Taffybar.Information.Volume-import System.Taffybar.Widget.Generic.PollingLabel---- | Creates a new text volume meter-volumeTextNew :: MonadIO m => String -> String -> Double -> m Widget-volumeTextNew mixer control pollSeconds = liftIO $ do-  l <- pollingLabelNew "" pollSeconds . fmap show $ getVolume mixer control-  widgetShowAll l-  return l---- | Creates a new volume meter widget-volumeControlNew :: String -> String -> IO Widget-volumeControlNew mixer control = do-  b <- volumeButtonNew-  _ <- on b scaleButtonValueChanged $ \v ->-    setVolume mixer control (v * 100)-  let w = toWidget b-  widgetShowAll w-  return w

@@ -11,38 +11,7 @@ -- Portability : unportable ----------------------------------------------------------------------------- -module System.Taffybar.Widget.Workspaces-  ( ControllerConstructor-  , IconController(..)-  , IconInfo(..)-  , WWC(..)-  , WindowData(..)-  , Workspace(..)-  , WorkspaceButtonController(..)-  , WorkspaceContentsController(..)-  , WorkspaceState(..)-  , WorkspaceUnderlineController(..)-  , WorkspaceWidgetController(..)-  , WorkspacesConfig(..)-  , WorkspacesContext(..)-  , WorkspacesIO-  , buildBorderButtonController-  , buildButtonController-  , buildContentsController-  , buildIconController-  , buildLabelController-  , buildUnderlineButtonController-  , buildUnderlineController-  , buildWorkspaceData-  , defaultBuildContentsController-  , defaultGetIconInfo-  , defaultWorkspacesConfig-  , getWorkspaceToWindows-  , hideEmpty-  , liftX11Def-  , workspacesNew-  , windowTitleClassIconGetter-) where+module System.Taffybar.Widget.Workspaces where  import           Control.Applicative import           Control.Arrow ((&&&))@@ -51,6 +20,7 @@ import           Control.Monad import           Control.Monad.IO.Class import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Maybe import           Control.Monad.Trans.Reader import           Control.RateLimit import qualified Data.Char as Char@@ -76,7 +46,6 @@ import           System.Log.Logger import           System.Taffybar.Compat.GtkLibs import           System.Taffybar.Context-import           System.Taffybar.EWMHPixbuf import           System.Taffybar.Information.EWMHDesktopInfo import           System.Taffybar.Information.SafeX11 import           System.Taffybar.Information.X11DesktopInfo@@ -84,6 +53,7 @@ import           System.Taffybar.Widget.Decorators import           System.Taffybar.Widget.Generic.AutoSizeImage (autoSizeImage) import           System.Taffybar.Widget.Util+import           System.Taffybar.WindowIcon import           Text.Printf  data WorkspaceState@@ -100,16 +70,6 @@ cssWorkspaceStates :: [String] cssWorkspaceStates = map getCSSClass [Active, Visible, Hidden, Empty, Urgent] -data IconInfo-  = IIEWMH EWMHIconData-  | IIFilePath FilePath-  | IIColor ColorRGBA-  | IINone-  deriving (Eq, Show)--transparentInfo :: IconInfo-transparentInfo = IIColor 0- data WindowData = WindowData   { windowId :: X11Window   , windowTitle :: String@@ -131,7 +91,7 @@ data WorkspacesContext = WorkspacesContext   { controllersVar :: MV.MVar (M.Map WorkspaceIdx WWC)   , workspacesVar :: MV.MVar (M.Map WorkspaceIdx Workspace)-  , hudWidget :: Gtk.HBox+  , workspacesWidget :: Gtk.HBox   , workspacesConfig :: WorkspacesConfig   , taffyContext :: Context   }@@ -183,6 +143,9 @@ type ParentControllerConstructor =   ControllerConstructor -> ControllerConstructor +type WindowIconPixbufGetter =+  Int32 -> WindowData -> TaffyIO (Maybe Gdk.Pixbuf)+ data WorkspacesConfig =   WorkspacesConfig   { widgetBuilder :: ControllerConstructor@@ -192,7 +155,7 @@   , underlinePadding :: Int   , maxIcons :: Maybe Int   , minIcons :: Int-  , getIconInfo :: WindowData -> WorkspacesIO IconInfo+  , getWindowIconPixbuf :: WindowIconPixbufGetter   , labelSetter :: Workspace -> WorkspacesIO String   , showWorkspaceFn :: Workspace -> Bool   , borderWidth :: Int@@ -202,18 +165,6 @@   , urgentWorkspaceState :: Bool   } -windowTitleClassIconGetter-  :: (Bool -> String -> String -> IconInfo)-  -> (WindowData -> WorkspacesIO IconInfo)-windowTitleClassIconGetter customIconF = fn-  where-    fn w@WindowData {windowTitle = wTitle, windowClass = wClass} = do-      ewmhIcon <- defaultGetIconInfo w-      let hasEwmhIcon = ewmhIcon /= IINone-          custIcon = customIconF hasEwmhIcon wTitle wClass-          hasCustomIcon = custIcon /= IINone-      return $ if hasCustomIcon then custIcon else ewmhIcon- defaultWorkspacesConfig :: WorkspacesConfig defaultWorkspacesConfig =   WorkspacesConfig@@ -224,7 +175,7 @@   , underlinePadding = 1   , maxIcons = Nothing   , minIcons = 0-  , getIconInfo = defaultGetIconInfo+  , getWindowIconPixbuf = defaultGetWindowIconPixbuf   , labelSetter = return . workspaceName   , showWorkspaceFn = const True   , borderWidth = 2@@ -321,7 +272,7 @@ addWidgetsToTopLevel = do   WorkspacesContext     { controllersVar = controllersRef-    , hudWidget = cont+    , workspacesWidget = cont     } <- ask   controllersMap <- lift $ MV.readMVar controllersRef   -- Elems returns elements in ascending order of their keys so this will always@@ -331,7 +282,7 @@  addWidget :: WWC -> WorkspacesIO () addWidget controller = do-  cont <- asks hudWidget+  cont <- asks workspacesWidget   let workspaceWidget = getWidget controller   lift $ do      -- XXX: This hbox exists to (hopefully) prevent the issue where workspace@@ -353,7 +304,7 @@         WorkspacesContext         { controllersVar = controllersRef         , workspacesVar = workspacesRef-        , hudWidget = cont+        , workspacesWidget = cont         , workspacesConfig = cfg         , taffyContext = tContext         }@@ -431,11 +382,12 @@  updateWorkspaceControllers :: WorkspacesIO () updateWorkspaceControllers = do-  WorkspacesContext { controllersVar = controllersRef-          , workspacesVar = workspacesRef-          , hudWidget = cont-          , workspacesConfig = cfg-          } <- ask+  WorkspacesContext+    { controllersVar = controllersRef+    , workspacesVar = workspacesRef+    , workspacesWidget = cont+    , workspacesConfig = cfg+    } <- ask   workspacesMap <- lift $ MV.readMVar workspacesRef   controllersMap <- lift $ MV.readMVar controllersRef @@ -574,29 +526,20 @@   , iconForceUpdate :: IO ()   } -getPixbufFromInfo :: Bool -> Int32 -> IconInfo -> IO (Maybe Gdk.Pixbuf)-getPixbufFromInfo transparentOnNone imgSize = gpb-  where-    gpb (IIEWMH iconData) =-      withEWMHIcons iconData (traverse pixBufFromEWMHIcon . selectEWMHIcon imgSize)-    gpb (IIFilePath file) = Just <$> pixBufFromFile file-    gpb (IIColor color) = Just <$> pixBufFromColor imgSize color-    gpb IINone =-      if transparentOnNone-      then getPixbufFromInfo transparentOnNone imgSize transparentInfo-      else return Nothing- getPixbufForIconWidget :: Bool                        -> MV.MVar (Maybe WindowData)                        -> Int32                        -> WorkspacesIO (Maybe Gdk.Pixbuf)-getPixbufForIconWidget transparentOnNone dataVar size =-  ask >>= \ctx ->-    let getII = getIconInfo $ workspacesConfig ctx-    in lift $ MV.readMVar dataVar >>=-       flip runReaderT ctx . maybe (return IINone) getII >>=-       getPixbufFromInfo transparentOnNone size >>=-       traverse (scalePixbufToSize size GI.Gtk.OrientationHorizontal)+getPixbufForIconWidget transparentOnNone dataVar size = do+  ctx <- ask+  let tContext = taffyContext ctx+      getPBFromData = getWindowIconPixbuf $ workspacesConfig ctx+      getPB' = runMaybeT $+               MaybeT (lift $ MV.readMVar dataVar) >>= MaybeT . getPBFromData size+      getPB = if transparentOnNone+              then maybeTCombine getPB' (Just <$> pixBufFromColor size 0)+              else getPB'+  lift $ runReaderT getPB tContext  buildIconWidget :: Bool -> Workspace -> WorkspacesIO IconWidget buildIconWidget transparentOnNone ws = do@@ -673,10 +616,63 @@   W.Requisition w _ <- W.widgetSizeRequest widget   when (w < minWidth) $ W.widgetSetSizeRequest widget minWidth  $ -1 -defaultGetIconInfo :: WindowData -> WorkspacesIO IconInfo-defaultGetIconInfo w =-  maybe IINone IIEWMH <$> liftX11Def Nothing (getWindowIconsData $ windowId w)+scaledWindowIconPixbufGetter :: WindowIconPixbufGetter -> WindowIconPixbufGetter+scaledWindowIconPixbufGetter getter size =+  getter size >=>+  lift . traverse (scalePixbufToSize size GI.Gtk.OrientationHorizontal) +constantScaleWindowIconPixbufGetter :: Int32+                                    -> WindowIconPixbufGetter+                                    -> WindowIconPixbufGetter+constantScaleWindowIconPixbufGetter constantSize getter =+  const $ scaledWindowIconPixbufGetter getter constantSize++getWindowIconPixbufFromEWMH :: WindowIconPixbufGetter+getWindowIconPixbufFromEWMH size windowData =+  runX11Def Nothing (getIconPixBufFromEWMH size $ windowId windowData)++getWindowIconPixbufFromClass :: WindowIconPixbufGetter+getWindowIconPixbufFromClass size windowData =+  lift $ getWindowIconFromClasses size (windowClass windowData)++getWindowIconPixbufFromDesktopEntry :: WindowIconPixbufGetter+getWindowIconPixbufFromDesktopEntry size windowData =+  getWindowIconFromDesktopEntryByClasses size (windowClass windowData)++defaultGetWindowIconPixbuf :: WindowIconPixbufGetter+defaultGetWindowIconPixbuf =+  scaledWindowIconPixbufGetter unscaledDefaultGetWindowIconPixbuf++unscaledDefaultGetWindowIconPixbuf :: WindowIconPixbufGetter+unscaledDefaultGetWindowIconPixbuf =+  getWindowIconPixbufFromDesktopEntry <|||>+  getWindowIconPixbufFromClass <|||>+  getWindowIconPixbufFromEWMH++addCustomIconsToDefaultWithFallbackByPath+  :: (WindowData -> Maybe FilePath)+  -> FilePath+  -> WindowIconPixbufGetter+addCustomIconsToDefaultWithFallbackByPath getCustomIconPath fallbackPath =+  addCustomIconsAndFallback+    getCustomIconPath+    (const $ lift $ getPixbufFromFilePath fallbackPath)+    unscaledDefaultGetWindowIconPixbuf++addCustomIconsAndFallback+  :: (WindowData -> Maybe FilePath)+  -> (Int32 -> TaffyIO (Maybe Gdk.Pixbuf))+  -> WindowIconPixbufGetter+  -> WindowIconPixbufGetter+addCustomIconsAndFallback getCustomIconPath fallback defaultGetter =+  scaledWindowIconPixbufGetter $+  getCustomIcon <|||> defaultGetter <|||> (\s _ -> fallback s)+  where+    getCustomIcon :: Int32 -> WindowData -> TaffyIO (Maybe Gdk.Pixbuf)+    getCustomIcon _ wdata =+      lift $+      maybe (return Nothing) getPixbufFromFilePath $ getCustomIconPath wdata+ sortWindowsByPosition :: [WindowData] -> WorkspacesIO [WindowData] sortWindowsByPosition wins = do   let getGeometryWorkspaces w = getDisplay >>= liftIO . (`safeGetGeometry` w)@@ -761,13 +757,6 @@         updateWidgetClasses iconButton [statusString] possibleStatusStrings   void $ updateVar windowRef $ const $ return windowData   lift $ updateIcon >> setIconWidgetProperties--selectEWMHIcon :: Int32 -> [EWMHIcon] -> Maybe EWMHIcon-selectEWMHIcon imgSize icons = listToMaybe prefIcon-  where sortedIcons = sortBy (comparing height) icons-        smallestLargerIcon = take 1 $ dropWhile ((<= fromIntegral imgSize) . height) sortedIcons-        largestIcon = take 1 $ reverse sortedIcons-        prefIcon = smallestLargerIcon ++ largestIcon  data WorkspaceButtonController = WorkspaceButtonController   { button :: Gtk.EventBox

@@ -0,0 +1,122 @@+module System.Taffybar.WindowIcon where++import           Control.Monad+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Maybe+import           Data.Bits+import           Data.Int+import           Data.List+import           Data.Maybe+import qualified Data.MultiMap as MM+import           Data.Ord+import qualified Data.Text as T+import           Data.Word+import           Foreign.Marshal.Alloc+import           Foreign.Marshal.Array+import           Foreign.Ptr+import           Foreign.Storable+import qualified GI.GdkPixbuf.Enums as Gdk+import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk+import           System.Log.Logger+import           System.Taffybar.Context+import           System.Taffybar.Hooks+import           System.Taffybar.Information.EWMHDesktopInfo+import           System.Taffybar.Information.X11DesktopInfo+import           System.Taffybar.Information.XDG.DesktopEntry+import           System.Taffybar.Util+import           System.Taffybar.Widget.Util++type ColorRGBA = Word32++-- | Convert a C array of integer pixels in the ARGB format to the ABGR format.+-- Returns an unmanged Ptr that points to a block of memory that must be freed+-- manually.+pixelsARGBToBytesABGR+  :: (Storable a, Bits a, Num a, Integral a)+  => Ptr a -> Int -> IO (Ptr Word8)+pixelsARGBToBytesABGR ptr size = do+  target <- mallocArray (size * 4)+  let writeIndex i = do+        bits <- peekElemOff ptr i+        let b = toByte bits+            g = toByte $ bits `shift` (-8)+            r = toByte $ bits `shift` (-16)+            a = toByte $ bits `shift` (-24)+            baseTarget = 4 * i+            doPoke offset = pokeElemOff target (baseTarget + offset)+            toByte = fromIntegral . (.&. 0xFF)+        doPoke 0 r+        doPoke 1 g+        doPoke 2 b+        doPoke 3 a+      writeIndexAndNext i+        | i >= size = return ()+        | otherwise = writeIndex i >> writeIndexAndNext (i + 1)+  writeIndexAndNext 0+  return target++selectEWMHIcon :: Int32 -> [EWMHIcon] -> Maybe EWMHIcon+selectEWMHIcon imgSize icons = listToMaybe prefIcon+  where sortedIcons = sortBy (comparing ewmhHeight) icons+        smallestLargerIcon = take 1 $ dropWhile ((<= fromIntegral imgSize) . ewmhHeight) sortedIcons+        largestIcon = take 1 $ reverse sortedIcons+        prefIcon = smallestLargerIcon ++ largestIcon++getPixbufFromEWMHIcons :: Int32 -> [EWMHIcon] -> IO (Maybe Gdk.Pixbuf)+getPixbufFromEWMHIcons size = traverse pixBufFromEWMHIcon . selectEWMHIcon size++-- | Create a pixbuf from the pixel data in an EWMHIcon.+pixBufFromEWMHIcon :: EWMHIcon -> IO Gdk.Pixbuf+pixBufFromEWMHIcon EWMHIcon {ewmhWidth = w, ewmhHeight = h, ewmhPixelsARGB = px} = do+  let width = fromIntegral w+      height = fromIntegral h+      rowStride = width * 4+  wPtr <- pixelsARGBToBytesABGR px (w * h)+  Gdk.pixbufNewFromData wPtr Gdk.ColorspaceRgb True 8+     width height rowStride (Just free)++getIconPixBufFromEWMH :: Int32 -> X11Window -> X11Property (Maybe Gdk.Pixbuf)+getIconPixBufFromEWMH size x11WindowId = runMaybeT $ do+  ewmhData <- MaybeT $ getWindowIconsData x11WindowId+  MaybeT $ lift $ withEWMHIcons ewmhData (getPixbufFromEWMHIcons size)++-- | Create a pixbuf with the indicated RGBA color.+pixBufFromColor+  :: MonadIO m+  => Int32 -> Word32 -> m Gdk.Pixbuf+pixBufFromColor imgSize c = do+  Just pixbuf <- Gdk.pixbufNew Gdk.ColorspaceRgb True 8 imgSize imgSize+  Gdk.pixbufFill pixbuf c+  return pixbuf++getDirectoryEntryByClass+  :: String+  -> TaffyIO (Maybe DesktopEntry)+getDirectoryEntryByClass klass = do+  entries <- MM.lookup klass <$> getDirectoryEntriesByClassName+  when (length entries > 1) $+       logPrintF "System.Taffybar.WindowIcon" INFO "Multiple entries for: %s" (klass, entries)+  return $ listToMaybe entries++getWindowIconForAllClasses+  :: Monad m+  => (p -> String -> m (Maybe a)) -> p -> String -> m (Maybe a)+getWindowIconForAllClasses doOnClass size klass =+  foldl combine (return Nothing) $ parseWindowClasses klass+  where+    combine soFar theClass =+      maybeTCombine soFar (doOnClass size theClass)++getWindowIconFromDesktopEntryByClasses :: Int32 -> String -> TaffyIO (Maybe Gdk.Pixbuf)+getWindowIconFromDesktopEntryByClasses =+  getWindowIconForAllClasses getWindowIconFromDesktopEntryByClass+  where getWindowIconFromDesktopEntryByClass size klass =+          runMaybeT $ do+            entry <- MaybeT $ getDirectoryEntryByClass klass+            MaybeT $ lift $ getImageForDesktopEntry size entry++getWindowIconFromClasses :: Int32 -> String -> IO (Maybe Gdk.Pixbuf)+getWindowIconFromClasses =+  getWindowIconForAllClasses getWindowIconFromClass+  where getWindowIconFromClass size klass = loadPixbufByName size (T.pack klass)

@@ -1,5 +1,5 @@ name: taffybar-version: 2.1.0+version: 2.1.1 synopsis: A desktop bar similar to xmobar, but with more GUI license: BSD3 license-file: LICENSE@@ -17,8 +17,10 @@   README.md   CHANGELOG.md   taffybar.hs.example+  dbus-xml/org.freedesktop.UPower.Device.xml+  dbus-xml/org.freedesktop.UPower.xml   dbus-xml/org.mpris.MediaPlayer2.Player.xml-+  dbus-xml/org.mpris.MediaPlayer2.xml  description:   Taffybar is a gtk+3 (through gtk2hs) based desktop information bar, intended@@ -37,7 +39,6 @@    default-language: Haskell2010   build-depends: base > 3 && < 5-               , alsa-mixer >= 0.2.0                , ConfigFile                , HStringTemplate >= 0.8 && < 0.9                , HTTP@@ -104,7 +105,6 @@                  , System.Taffybar.Context                  , System.Taffybar.DBus                  , System.Taffybar.DBus.Toggle-                 , System.Taffybar.EWMHPixbuf                  , System.Taffybar.Hooks                  , System.Taffybar.Information.Battery                  , System.Taffybar.Information.CPU@@ -116,12 +116,12 @@                  , System.Taffybar.Information.Network                  , System.Taffybar.Information.SafeX11                  , System.Taffybar.Information.StreamInfo-                 , System.Taffybar.Information.Volume                  , System.Taffybar.Information.X11DesktopInfo                  , System.Taffybar.Information.XDG.DesktopEntry                  , System.Taffybar.Information.XDG.Protocol                  , System.Taffybar.SimpleConfig                  , System.Taffybar.Support.PagerHints+                 , System.Taffybar.Util                  , System.Taffybar.Widget                  , System.Taffybar.Widget.Battery                  , System.Taffybar.Widget.CPUMonitor@@ -150,12 +150,12 @@                  , System.Taffybar.Widget.Text.MemoryMonitor                  , System.Taffybar.Widget.Text.NetworkMonitor                  , System.Taffybar.Widget.Util-                 , System.Taffybar.Widget.Volume                  , System.Taffybar.Widget.Weather                  , System.Taffybar.Widget.Windows                  , System.Taffybar.Widget.Workspaces                  , System.Taffybar.Widget.XDGMenu.Menu                  , System.Taffybar.Widget.XDGMenu.MenuWidget+                 , System.Taffybar.WindowIcon                       other-modules: Paths_taffybar                , System.Taffybar.DBus.Client.MPRIS2@@ -163,7 +163,6 @@                , System.Taffybar.DBus.Client.UPower                , System.Taffybar.DBus.Client.UPowerDevice                , System.Taffybar.DBus.Client.Util-               , System.Taffybar.Util    cc-options: -fPIC   ghc-options: -Wall -funbox-strict-fields -fno-warn-orphans

@@ -64,13 +64,16 @@       clock = textClockNew Nothing "%a %b %_d %r" 1       layout = layoutNew defaultLayoutConfig       windows = windowsNew defaultWindowsConfig+	  -- See https://github.com/taffybar/gtk-sni-tray#statusnotifierwatcher+	  -- for a better way to set up the sni tray+	  tray = sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt       myConfig = defaultSimpleTaffyConfig         { startWidgets =             workspaces : map (>>= buildContentsBox) [ layout, windows ]         , endWidgets = map (>>= buildContentsBox)           [ batteryIconNew           , clock-          , sniTrayNew+          , tray           , cpu           , mem           , net