diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +# 3.2.2 + +## Bug Fixes + + * Solve space leaks on `updateSamples` and `getDeviceUpDown` (#472). + * Prevent crash when using mpris2New and librsvg is not available (#478). + * Fixed compilation issues that appear when using ghc 8.8. + # 3.2.1 ## Bug Fixes diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +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?logo=haskell&label=taffybar)](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) @@ -12,11 +12,11 @@ Before Installing ----------------- -The installation method, and procedure that must be followed depends on whether -or not you intend to setup a new haskell project and use `startTaffybar`, or if -you want to use the `dyreTaffybar` approach. It is important for you to read -this section so you can understand what all of that means before you decide how -you want to install taffybar. +Taffybar's installation procedure varies depending on whether or not you intend +to setup a new haskell project and use `startTaffybar` or use the `dyreTaffybar` +with a global haskell installation . It is important for you to read this +section so you can understand what all of that means before you decide how you +want to install taffybar. ### Taffybar is a library @@ -65,6 +65,16 @@ haskell packages to the environment that compiles your taffybar.hs you will need to invoke that module and use the packages parameter to allow this. +It is also possible to run/use taffybar on NixOS without using this module by +using a standalone haskell project for the taffybar configuration. + +##### Using the overlay.nix when taffybar is broken in nixpkgs +The taffybar haskell package in nixpkgs has been broken in the unstable channel +from time to time. This repository provides a nix overlay file which can be used +to build taffybar with current versions of nixpkgs. See [this +comment](https://github.com/taffybar/taffybar/issues/464#issuecomment-503258726) +for details on how to use the overlay. + Installation From Hackage/Source -------------------------------- @@ -114,6 +124,21 @@ You will need to add default.nix file to your package. See [this example](https://github.com/taffybar/taffybar/blob/master/example/default.nix) + +You may also need to use the overlay provided by this repository. See [this +comment](https://github.com/taffybar/taffybar/issues/464#issuecomment-503258726) +for details. + +#### Overlay + +The taffybar haskell package is currently broken in nixpkgs, because some of its +dependencies are not compiling correctly/are not sufficiently new. The +environment.nix file in this repository fixes these build issues with an +overlay. The overlay.nix file extends the environment overlay so that it +overrides the taffybar package's build description to build the nix taffybar +package from the repository source directory. An example of how to set up +nixpkgs to use the taffybar overlay can be found +[here](https://github.com/ivanmalison/dotfiles/blob/a20b11a070472d182e09cf39f2b0149f39eac9ac/dotfiles/config/taffybar/base.nix#L1). Configuration diff --git a/src/System/Taffybar/Context.hs b/src/System/Taffybar/Context.hs --- a/src/System/Taffybar/Context.hs +++ b/src/System/Taffybar/Context.hs @@ -4,6 +4,7 @@ {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ImpredicativeTypes #-} ----------------------------------------------------------------------------- -- | -- Module : System.Taffybar.Context diff --git a/src/System/Taffybar/Hooks.hs b/src/System/Taffybar/Hooks.hs --- a/src/System/Taffybar/Hooks.hs +++ b/src/System/Taffybar/Hooks.hs @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- | +-- Module : System.Taffybar.Hooks +-- Copyright : (c) Ivan A. Malison +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Ivan A. Malison +-- Stability : unstable +-- Portability : unportable +----------------------------------------------------------------------------- + module System.Taffybar.Hooks ( module System.Taffybar.DBus , module System.Taffybar.Hooks @@ -9,21 +20,18 @@ ) where import BroadcastChan -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.Log.Logger import System.Taffybar.Context import System.Taffybar.DBus import System.Taffybar.Information.Battery import System.Taffybar.Information.Chrome import System.Taffybar.Information.Network -import System.Taffybar.Information.XDG.DesktopEntry +import System.Environment.XDG.DesktopEntry import System.Taffybar.LogFormatter import System.Taffybar.Util @@ -57,20 +65,4 @@ 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 + indexDesktopEntriesByClassName <$> getDirectoryEntriesDefault diff --git a/src/System/Taffybar/Information/MPRIS2.hs b/src/System/Taffybar/Information/MPRIS2.hs --- a/src/System/Taffybar/Information/MPRIS2.hs +++ b/src/System/Taffybar/Information/MPRIS2.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NoMonoLocalBinds #-} +{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : System.Taffybar.Information.MPRIS2 diff --git a/src/System/Taffybar/Information/Network.hs b/src/System/Taffybar/Information/Network.hs --- a/src/System/Taffybar/Information/Network.hs +++ b/src/System/Taffybar/Information/Network.hs @@ -55,7 +55,7 @@ dev <- initSafe <$> s `atMay` 0 down <- readDef (-1) <$> s `atMay` 1 up <- readDef (-1) <$> s `atMay` out - return (dev, (down, up)) + dev `seq` down `seq` up `seq` return (dev, (down, up)) where out = length s - 8 @@ -113,7 +113,8 @@ let getLast sample@TxSample { sampleDevice = device } = maybe sample fst $ lookup device currentSamples getSamplePair sample@TxSample { sampleDevice = device } = - (device, (sample, getLast sample)) + let lastSample = getLast sample + in lastSample `seq` (device, (sample, lastSample)) maybe currentSamples (map getSamplePair) <$> getDeviceSamples getSpeed :: TxSample -> TxSample -> (Rational, Rational) diff --git a/src/System/Taffybar/Information/X11DesktopInfo.hs b/src/System/Taffybar/Information/X11DesktopInfo.hs --- a/src/System/Taffybar/Information/X11DesktopInfo.hs +++ b/src/System/Taffybar/Information/X11DesktopInfo.hs @@ -4,7 +4,7 @@ -- Copyright : (c) José A. Romero L. -- License : BSD3-style (see LICENSE) -- --- Maintainer : José A. Romero L. +-- Maintainer : Ivan Malison -- Stability : unstable -- Portability : unportable -- @@ -57,6 +57,7 @@ import Graphics.X11.Xlib.Extras hiding (getWindowProperty8, getWindowProperty32, getWMHints) import Graphics.X11.Xrandr +import Safe import System.Taffybar.Information.SafeX11 import Prelude @@ -84,17 +85,21 @@ getDisplay :: X11Property Display getDisplay = contextDisplay <$> ask +doRead :: Integral a => b -> ([a] -> b) + -> PropertyFetcher a + -> Maybe X11Window + -> String + -> X11Property b +doRead def transform windowPropFn window name = + (fromMaybe def) . (fmap transform) <$> fetch windowPropFn window name + -- | Retrieve the property of the given window (or the root window, if Nothing) -- with the given name as a value of type Int. If that property hasn't been set, -- then return -1. readAsInt :: Maybe X11Window -- ^ window to read from. Nothing means the root window. -> String -- ^ name of the property to retrieve -> X11Property Int -readAsInt window name = do - prop <- fetch getWindowProperty32 window name - case prop of - Just (x:_) -> return (fromIntegral x) - _ -> return (-1) +readAsInt = doRead (-1) (maybe (-1) fromIntegral . headMay) getWindowProperty32 -- | Retrieve the property of the given window (or the root window, if Nothing) -- with the given name as a list of Ints. If that property hasn't been set, then @@ -102,11 +107,7 @@ readAsListOfInt :: Maybe X11Window -- ^ window to read from. Nothing means the root window. -> String -- ^ name of the property to retrieve -> X11Property [Int] -readAsListOfInt window name = do - prop <- fetch getWindowProperty32 window name - case prop of - Just xs -> return (map fromIntegral xs) - _ -> return [] +readAsListOfInt = doRead [] (map fromIntegral) getWindowProperty32 -- | Retrieve the property of the given window (or the root window, if Nothing) -- with the given name as a String. If the property hasn't been set, then return @@ -114,11 +115,7 @@ readAsString :: Maybe X11Window -- ^ window to read from. Nothing means the root window. -> String -- ^ name of the property to retrieve -> X11Property String -readAsString window name = do - prop <- fetch getWindowProperty8 window name - case prop of - Just xs -> return . UTF8.decode . map fromIntegral $ xs - _ -> return [] +readAsString = doRead "" (UTF8.decode . map fromIntegral) getWindowProperty8 -- | Retrieve the property of the given window (or the root window, if Nothing) -- with the given name as a list of Strings. If the property hasn't been set, @@ -126,13 +123,8 @@ readAsListOfString :: Maybe X11Window -- ^ window to read from. Nothing means the root window. -> String -- ^ name of the property to retrieve -> X11Property [String] -readAsListOfString window name = do - prop <- fetch getWindowProperty8 window name - case prop of - Just xs -> return (parse xs) - _ -> return [] - where - parse = endBy "\0" . UTF8.decode . map fromIntegral +readAsListOfString = doRead [] parse getWindowProperty8 + where parse = endBy "\0" . UTF8.decode . map fromIntegral -- | Retrieve the property of the given window (or the root window, if Nothing) -- with the given name as a list of X11 Window IDs. If the property hasn't been @@ -140,11 +132,7 @@ readAsListOfWindow :: Maybe X11Window -- ^ window to read from. Nothing means the root window. -> String -- ^ name of the property to retrieve -> X11Property [X11Window] -readAsListOfWindow window name = do - prop <- fetch getWindowProperty32 window name - case prop of - Just xs -> return $ map fromIntegral xs - _ -> return [] +readAsListOfWindow = doRead [] (map fromIntegral) getWindowProperty32 -- | Determine whether the \"urgent\" flag is set in the WM_HINTS of the given -- window. diff --git a/src/System/Taffybar/Information/XDG/DesktopEntry.hs b/src/System/Taffybar/Information/XDG/DesktopEntry.hs deleted file mode 100644 --- a/src/System/Taffybar/Information/XDG/DesktopEntry.hs +++ /dev/null @@ -1,203 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : System.Taffybar.Information.XDG.DesktopEntry --- Copyright : 2017 Ulf Jasper --- License : BSD3-style (see LICENSE) --- --- Maintainer : Ulf Jasper --- Stability : unstable --- Portability : unportable --- --- Implementation of version 1.1 of the freedesktop "Desktop Entry --- specification", see --- https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-1.2.html. ------------------------------------------------------------------------------ - -module System.Taffybar.Information.XDG.DesktopEntry - ( DesktopEntry(..) - , deCommand - , deComment - , deHasCategory - , deIcon - , deName - , deNoDisplay - , deNotShowIn - , deOnlyShowIn - , existingDirs - , getDefaultConfigHome - , getDirectoryEntriesDefault - , getDirectoryEntry - , getDirectoryEntryDefault - , getXDGDataDirs - , listDesktopEntries - ) where - -import Control.Monad -import Control.Monad.IO.Class -import Control.Monad.Trans.Except -import Data.Char -import qualified Data.ConfigFile as CF -import Data.List -import Data.Maybe -import System.Directory -import System.FilePath.Posix -import System.Log.Logger -import System.Posix.Files -import Text.Printf -import Text.Read (readMaybe) - -logHere :: Priority -> String -> IO () -logHere = logM "System.Taffybar.Information.XDG.DesktopEntry" - -data DesktopEntryType = Application | Link | Directory - deriving (Read, Show, Eq) - -existingDirs :: [FilePath] -> IO [FilePath] -existingDirs dirs = filterM fileExist dirs - -getDefaultConfigHome :: IO FilePath -getDefaultConfigHome = do - h <- getHomeDirectory - return $ h ".config" - -getXDGDataDirs :: IO [FilePath] -getXDGDataDirs = getXdgDirectoryList XdgDataDirs - --- | Desktop Entry. All attributes (key-value-pairs) are stored in an --- association list. -data DesktopEntry = DesktopEntry - { deType :: DesktopEntryType - , deFilename :: FilePath -- ^ unqualified filename, e.g. "taffybar.desktop" - , deAttributes :: [(String, String)] -- ^ Key-value pairs - } deriving (Read, Show, Eq) - --- | Determine whether the Category attribute of a desktop entry contains a --- given value. -deHasCategory - :: DesktopEntry -- ^ desktop entry - -> String -- ^ category to be checked - -> Bool -deHasCategory de cat = - maybe False ((cat `elem`) . splitAtSemicolon) $ - lookup "Categories" (deAttributes de) - -splitAtSemicolon :: String -> [String] -splitAtSemicolon = lines . map (\c -> if c == ';' then '\n' else c) - --- | Return the proper name of the desktop entry, depending on the list of --- preferred languages. -deName - :: [String] -- ^ Preferred languages - -> DesktopEntry - -> String -deName langs de = fromMaybe (deFilename de) $ deLocalisedAtt langs de "Name" - --- | Return the categories in which the entry shall be shown -deOnlyShowIn :: DesktopEntry -> [String] -deOnlyShowIn = maybe [] splitAtSemicolon . deAtt "OnlyShowIn" - --- | Return the categories in which the entry shall not be shown -deNotShowIn :: DesktopEntry -> [String] -deNotShowIn = maybe [] splitAtSemicolon . deAtt "NotShowIn" - --- | Return the value of the given attribute key -deAtt :: String -> DesktopEntry -> Maybe String -deAtt att = lookup att . deAttributes - --- | Return the Icon attribute -deIcon :: DesktopEntry -> Maybe String -deIcon = deAtt "Icon" - --- | Return True if the entry must not be displayed -deNoDisplay :: DesktopEntry -> Bool -deNoDisplay de = maybe False (("true" ==) . map toLower) $ deAtt "NoDisplay" de - -deLocalisedAtt - :: [String] -- ^ Preferred languages - -> DesktopEntry - -> String - -> Maybe String -deLocalisedAtt langs de att = - let localeMatches = - mapMaybe (\l -> lookup (att ++ "[" ++ l ++ "]") (deAttributes de)) langs - in if null localeMatches - then lookup att $ deAttributes de - else Just $ head localeMatches - --- | Return the proper comment of the desktop entry, depending on the list of --- preferred languages. -deComment :: [String] -- ^ Preferred languages - -> DesktopEntry - -> Maybe String -deComment langs de = deLocalisedAtt langs de "Comment" - --- | Return the command defined by the given desktop entry. --- TODO: should check the dbus thing. --- TODO: are there "field codes", i.e. % things, that -deCommand :: DesktopEntry -> Maybe String -deCommand de = - reverse . dropWhile (== ' ') . reverse . takeWhile (/= '%') <$> - lookup "Exec" (deAttributes de) - --- | Return a list of all desktop entries in the given directory. -listDesktopEntries - :: String -- ^ The extension to use in the search - -> FilePath -- ^ The filepath at which to search - -> IO [DesktopEntry] -listDesktopEntries extension dir = do - let normalizedDir = normalise dir - ex <- doesDirectoryExist normalizedDir - if ex - then do - files <- - map (normalizedDir ) . filter (\v -> v /= "." && v /= "..") <$> - getDirectoryContents dir - entries <- - (nub . catMaybes) <$> - mapM readDesktopEntry (filter (extension `isSuffixOf`) files) - subDirs <- filterM doesDirectoryExist files - subEntries <- concat <$> mapM (listDesktopEntries extension) subDirs - return $ entries ++ subEntries - else return [] - --- XXX: This function doesn't recurse, but `listDesktopEntries` does. Why? --- Shouldn't they really share logic... --- | Retrieve a desktop entry with a specific name. -getDirectoryEntry :: [FilePath] -> String -> IO (Maybe DesktopEntry) -getDirectoryEntry dirs name = do - liftIO $ logHere DEBUG $ printf "Searching %s for %s" (show dirs) name - exFiles <- filterM doesFileExist $ map (( name) . normalise) dirs - if null exFiles - then return Nothing - else readDesktopEntry $ head exFiles - -getDirectoryEntryDefault :: String -> IO (Maybe DesktopEntry) -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 -sectionMain = "Desktop Entry" - --- | Read a desktop entry from a file. -readDesktopEntry :: FilePath -> IO (Maybe DesktopEntry) -readDesktopEntry filePath = doReadDesktopEntry >>= either logWarning (return . Just) - where - logWarning err = - logHere WARNING (printf "Failed to parse desktop entry at %s: error: %s" filePath (show err)) >> - return Nothing - doReadDesktopEntry = runExceptT $ do - result <- (join $ liftIO $ CF.readfile CF.emptyCP filePath) >>= - flip CF.items sectionMain - return DesktopEntry - { deType = fromMaybe Application $ lookup "Type" result >>= readMaybe - , deFilename = filePath - , deAttributes = result - } diff --git a/src/System/Taffybar/Information/XDG/Protocol.hs b/src/System/Taffybar/Information/XDG/Protocol.hs --- a/src/System/Taffybar/Information/XDG/Protocol.hs +++ b/src/System/Taffybar/Information/XDG/Protocol.hs @@ -28,6 +28,7 @@ ) where import Control.Applicative +import Control.Monad import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import Data.Char (toLower) @@ -39,9 +40,10 @@ import Safe (headMay) import System.Directory import System.Environment +import System.Environment.XDG.DesktopEntry import System.FilePath.Posix import System.Log.Logger -import System.Taffybar.Information.XDG.DesktopEntry +import System.Posix.Files import System.Taffybar.Util import Text.XML.Light import Text.XML.Light.Helpers @@ -56,7 +58,9 @@ -- 'Just "mate-"'). -> IO [FilePath] getXDGMenuFilenames mMenuPrefix = do - configDirs <- getXdgDirectoryList XdgConfigDirs + configDirs <- + liftA2 (:) (getXdgDirectory XdgConfig "") + (getXdgDirectoryList XdgConfigDirs) maybePrefix <- (mMenuPrefix <|>) <$> getXDGMenuPrefix let maybeAddDash t = if last t == '-' then t else t ++ "-" dashedPrefix = maybe "" maybeAddDash maybePrefix @@ -219,7 +223,7 @@ getDirectoryDirs :: IO [FilePath] getDirectoryDirs = do dataDirs <- getXDGDataDirs - existingDirs $ map ( "desktop-directories") dataDirs + filterM (fileExist . ( "desktop-directories")) dataDirs -- | Fetch menus and desktop entries and assemble the XDG menu. readXDGMenu :: Maybe String -> IO (Maybe (XDGMenu, [DesktopEntry])) diff --git a/src/System/Taffybar/Support/PagerHints.hs b/src/System/Taffybar/Support/PagerHints.hs --- a/src/System/Taffybar/Support/PagerHints.hs +++ b/src/System/Taffybar/Support/PagerHints.hs @@ -1,6 +1,6 @@ ----------------------------------------------------------------------------- -- | --- Module : System.Taffybar.Hooks.PagerHints +-- Module : System.Taffybar.Support.PagerHints -- Copyright : (c) José A. Romero L. -- License : BSD3-style (see LICENSE) -- @@ -47,7 +47,7 @@ -- -- You can use this module with the following in your @xmonad.hs@ file: -- --- > import System.Taffybar.Hooks.PagerHints (pagerHints) +-- > import System.Taffybar.Support.PagerHints (pagerHints) -- > -- > main = xmonad $ ewmh $ pagerHints $ defaultConfig -- > ... diff --git a/src/System/Taffybar/Widget/MPRIS2.hs b/src/System/Taffybar/Widget/MPRIS2.hs --- a/src/System/Taffybar/Widget/MPRIS2.hs +++ b/src/System/Taffybar/Widget/MPRIS2.hs @@ -35,10 +35,11 @@ import System.Taffybar.Context import System.Taffybar.DBus.Client.MPRIS2 import System.Taffybar.Information.MPRIS2 -import System.Taffybar.Information.XDG.DesktopEntry +import System.Environment.XDG.DesktopEntry import System.Taffybar.Util import System.Taffybar.Widget.Generic.AutoSizeImage import System.Taffybar.Widget.Util +import System.Taffybar.WindowIcon import Text.Printf mprisLog :: (MonadIO m, Show t) => Priority -> String -> t -> m () @@ -58,10 +59,15 @@ newPlayerWidget :: BusName -> IO MPRIS2PlayerWidget newPlayerWidget busName = do - let logErrorAndLoadDefault size err = + let loadDefault size = catchGErrorsAsLeft (loadIcon size "play.svg") + >>= either failure return + where failure err = + mprisLog WARNING "Failed to load default image: %s" err >> + pixBufFromColor size 0 + logErrorAndLoadDefault size err = mprisLog WARNING "Failed to get MPRIS icon: %s" err >> mprisLog WARNING "MPRIS failure for: %s" busName >> - loadIcon size "play.svg" + loadDefault size makeExcept :: String -> (a -> IO (Maybe b)) -> a -> ExceptT String IO b makeExcept errorString actionBuilder = diff --git a/src/System/Taffybar/Widget/SimpleClock.hs b/src/System/Taffybar/Widget/SimpleClock.hs --- a/src/System/Taffybar/Widget/SimpleClock.hs +++ b/src/System/Taffybar/Widget/SimpleClock.hs @@ -22,13 +22,6 @@ import System.Taffybar.Widget.Generic.PollingLabel import System.Taffybar.Widget.Util -diffLocalTime :: LocalTime -> LocalTime -> Clock.NominalDiffTime -diffLocalTime a b = Clock.diffUTCTime (localTimeToUTC utc a) (localTimeToUTC utc b) - --- | addLocalTime a b = a + b -addLocalTime :: Clock.NominalDiffTime -> LocalTime -> LocalTime -addLocalTime x = utcToLocalTime utc . Clock.addUTCTime x . localTimeToUTC utc - -- | This module implements a very simple text-based clock widget. The widget -- also toggles a calendar widget when clicked. This calendar is not fancy at -- all and has no data backend. diff --git a/src/System/Taffybar/Widget/Text/CPUMonitor.hs b/src/System/Taffybar/Widget/Text/CPUMonitor.hs --- a/src/System/Taffybar/Widget/Text/CPUMonitor.hs +++ b/src/System/Taffybar/Widget/Text/CPUMonitor.hs @@ -1,5 +1,6 @@ module System.Taffybar.Widget.Text.CPUMonitor (textCpuMonitorNew) where +import Control.Monad.IO.Class ( MonadIO ) import Text.Printf ( printf ) import qualified Text.StringTemplate as ST import System.Taffybar.Information.CPU @@ -8,13 +9,13 @@ -- | Creates a simple textual CPU monitor. It updates once every polling -- period (in seconds). -textCpuMonitorNew :: String -- ^ Format. You can use variables: $total$, $user$, $system$ +textCpuMonitorNew :: MonadIO m + => String -- ^ Format. You can use variables: $total$, $user$, $system$ -> Double -- ^ Polling period (in seconds) - -> IO GI.Gtk.Widget + -> m GI.Gtk.Widget textCpuMonitorNew fmt period = do label <- pollingLabelNew period callback - GI.Gtk.widgetShowAll label - return label + GI.Gtk.toWidget label where callback = do (userLoad, systemLoad, totalLoad) <- cpuLoad diff --git a/src/System/Taffybar/Widget/Text/MemoryMonitor.hs b/src/System/Taffybar/Widget/Text/MemoryMonitor.hs --- a/src/System/Taffybar/Widget/Text/MemoryMonitor.hs +++ b/src/System/Taffybar/Widget/Text/MemoryMonitor.hs @@ -1,5 +1,6 @@ module System.Taffybar.Widget.Text.MemoryMonitor (textMemoryMonitorNew) where +import Control.Monad.IO.Class ( MonadIO ) import qualified Text.StringTemplate as ST import System.Taffybar.Information.Memory import System.Taffybar.Widget.Generic.PollingLabel ( pollingLabelNew ) @@ -7,13 +8,13 @@ -- | Creates a simple textual memory monitor. It updates once every polling -- period (in seconds). -textMemoryMonitorNew :: String -- ^ Format. You can use variables: "used", "total", "free", "buffer", "cache", "rest", "used". +textMemoryMonitorNew :: MonadIO m + => String -- ^ Format. You can use variables: "used", "total", "free", "buffer", "cache", "rest", "used". -> Double -- ^ Polling period in seconds. - -> IO GI.Gtk.Widget + -> m GI.Gtk.Widget textMemoryMonitorNew fmt period = do label <- pollingLabelNew period callback - GI.Gtk.widgetShowAll label - return label + GI.Gtk.toWidget label where callback = do info <- parseMeminfo diff --git a/src/System/Taffybar/Widget/Util.hs b/src/System/Taffybar/Widget/Util.hs --- a/src/System/Taffybar/Widget/Util.hs +++ b/src/System/Taffybar/Widget/Util.hs @@ -27,7 +27,7 @@ import GI.Gtk as Gtk import StatusNotifier.Tray (scalePixbufToSize) import System.FilePath.Posix -import System.Taffybar.Information.XDG.DesktopEntry +import System.Environment.XDG.DesktopEntry import System.Taffybar.Util import Text.Printf diff --git a/src/System/Taffybar/Widget/XDGMenu/Menu.hs b/src/System/Taffybar/Widget/XDGMenu/Menu.hs --- a/src/System/Taffybar/Widget/XDGMenu/Menu.hs +++ b/src/System/Taffybar/Widget/XDGMenu/Menu.hs @@ -26,7 +26,7 @@ import Data.List import Data.Maybe import qualified Data.Text as T -import System.Taffybar.Information.XDG.DesktopEntry +import System.Environment.XDG.DesktopEntry import System.Taffybar.Information.XDG.Protocol -- | Displayable menu diff --git a/src/System/Taffybar/WindowIcon.hs b/src/System/Taffybar/WindowIcon.hs --- a/src/System/Taffybar/WindowIcon.hs +++ b/src/System/Taffybar/WindowIcon.hs @@ -26,7 +26,7 @@ import System.Taffybar.Information.Chrome import System.Taffybar.Information.EWMHDesktopInfo import System.Taffybar.Information.X11DesktopInfo -import System.Taffybar.Information.XDG.DesktopEntry +import System.Environment.XDG.DesktopEntry import System.Taffybar.Util import System.Taffybar.Widget.Util @@ -121,6 +121,9 @@ where getWindowIconFromDesktopEntryByClass size klass = runMaybeT $ do entry <- MaybeT $ getDirectoryEntryByClass klass + lift $ logPrintF "System.Taffybar.WindowIcon" DEBUG + "Using desktop entry for icon %s" + (deFilename entry, klass) MaybeT $ lift $ getImageForDesktopEntry size entry getWindowIconFromClasses :: Int32 -> String -> IO (Maybe Gdk.Pixbuf) diff --git a/taffybar.cabal b/taffybar.cabal --- a/taffybar.cabal +++ b/taffybar.cabal @@ -1,5 +1,5 @@ name: taffybar -version: 3.2.1 +version: 3.2.2 synopsis: A desktop bar similar to xmobar, but with more GUI license: BSD3 license-file: LICENSE @@ -27,10 +27,6 @@ compliant window managers. It is similar in spirit to xmobar, but it differs in that it gives up some simplicity for a reasonable helping of eye candy. -flag network-uri - description: network hack - default: True - library default-extensions: TupleSections @@ -46,7 +42,7 @@ , broadcast-chan >= 0.2.0.2 , bytestring , containers - , dbus >= 1.2.1 && < 2.0.0 + , dbus >= 1.2.11 && < 2.0.0 , dbus-hslogger >= 0.1.0.1 && < 0.2.0.0 , directory , dyre >= 0.8.6 && < 0.9 @@ -80,7 +76,7 @@ , safe >= 0.3 && < 1 , scotty >= 0.11.0 && < 0.12.0 , split >= 0.1.4.2 - , status-notifier-item >= 0.3.0.1 + , status-notifier-item >= 0.3.0.5 , stm , template-haskell , text @@ -92,15 +88,12 @@ , tuple >= 0.3.0.2 , unix , utf8-string + , xdg-desktop-entry , xdg-basedir >= 0.2 && < 0.3 , xml , xml-helpers , xmonad - if flag(network-uri) - build-depends: network-uri >= 2.6 && < 3, network >= 2.6 && < 3 - else - build-depends: network-uri < 2.6, network < 2.6 hs-source-dirs: src pkgconfig-depends: gtk+-3.0 exposed-modules: System.Taffybar @@ -122,7 +115,6 @@ , System.Taffybar.Information.SafeX11 , System.Taffybar.Information.StreamInfo , System.Taffybar.Information.X11DesktopInfo - , System.Taffybar.Information.XDG.DesktopEntry , System.Taffybar.Information.XDG.Protocol , System.Taffybar.LogFormatter , System.Taffybar.SimpleConfig