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?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) +# Taffybar [![Build Status](https://travis-ci.org/taffybar/taffybar.svg?branch=master)](https://travis-ci.org/taffybar/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) [![Stackage LTS](http://stackage.org/package/taffybar/badge/lts)](http://stackage.org/lts/package/taffybar) [![Stackage Nightly](http://stackage.org/package/taffybar/badge/nightly)](http://stackage.org/nightly/package/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) diff --git a/src/System/Taffybar.hs b/src/System/Taffybar.hs --- a/src/System/Taffybar.hs +++ b/src/System/Taffybar.hs @@ -25,7 +25,7 @@ -- like reserving strut space so that window managers don't put windows over -- it). -- - -- | The config file in which you specify the gtk+ widgets to render is just a + -- The config file in which you specify the gtk+ widgets to render is just a -- Haskell source file which is used to produce a custom executable with the -- desired set of widgets. This approach requires that taffybar be installed -- as a haskell library (not merely as an executable), and that the ghc @@ -35,7 +35,7 @@ -- be provided to taffybar for instantiation and execution. -- -- The following code snippet is a simple example of what a taffybar - -- configuration might look like (also see @src/System/Taffybar/Example.hs@): + -- configuration might look like (also see "System.Taffybar.Example"): -- -- > {-# LANGUAGE OverloadedStrings #-} -- > import System.Taffybar @@ -53,14 +53,14 @@ -- > let cpuCfg = defaultGraphConfig { graphDataColors = [ (0, 1, 0, 1), (1, 0, 1, 0.5)] -- > , graphLabel = Just "cpu" -- > } - -- > clock = textClockNew defaultClockConfig + -- > clock = textClockNewWith defaultClockConfig -- > cpu = pollingGraphNew cpuCfg 0.5 cpuCallback -- > workspaces = workspacesNew defaultWorkspacesConfig -- > simpleConfig = defaultSimpleTaffyConfig -- > { startWidgets = [ workspaces ] -- > , endWidgets = [ sniTrayNew, clock, cpu ] -- > } - -- > startTaffybar $ simpleTaffybar simpleConfig + -- > simpleTaffybar simpleConfig -- -- This configuration creates a bar with four widgets. On the left is a widget -- that shows information about the workspace configuration. The rightmost @@ -90,6 +90,20 @@ -- -- * If you start xmonad via @startx@ or a similar command, add the -- above command to ~\/.xinitrc + -- + -- * System tray compatability + -- + -- | "System.Taffybar.Widget.SNITray" only supports the newer + -- StatusNotifierItem (SNI) protocol; older xembed applets will not work. + -- AppIndicator is also a valid implementation of SNI. + -- + -- Additionally, this module does not handle recognising new tray applets. + -- Instead it is necessary to run status-notifier-watcher from the + -- [status-notifier-item](https://github.com/taffybar/status-notifier-item) + -- package early on system startup. + -- In case this is not possible, the alternative widget + -- sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt is available, but + -- this may not necessarily be able to pick up everything. -- * Colors -- diff --git a/src/System/Taffybar/Widget/Generic/Icon.hs b/src/System/Taffybar/Widget/Generic/Icon.hs --- a/src/System/Taffybar/Widget/Generic/Icon.hs +++ b/src/System/Taffybar/Widget/Generic/Icon.hs @@ -2,10 +2,13 @@ -- updates its contents by calling a callback at a set interval. module System.Taffybar.Widget.Generic.Icon ( iconImageWidgetNew + , iconImageWidgetNewFromName , pollingIconImageWidgetNew + , pollingIconImageWidgetNewFromName ) where import Control.Concurrent ( forkIO, threadDelay ) +import qualified Data.Text as T import Control.Exception as E import Control.Monad ( forever ) import Control.Monad.IO.Class @@ -20,6 +23,17 @@ iconImageWidgetNew :: MonadIO m => FilePath -> m Widget iconImageWidgetNew path = liftIO $ imageNewFromFile path >>= putInBox +-- | Create a new widget that displays a static image +-- +-- > iconWidgetNewFromName name +-- +-- returns a widget with the icon named @name@. Icon +-- names are sourced from the current GTK theme. +iconImageWidgetNewFromName :: MonadIO m => T.Text -> m Widget +iconImageWidgetNewFromName name = liftIO $ + imageNewFromIconName (Just name) (fromIntegral $ fromEnum IconSizeMenu) + >>= putInBox + -- | Create a new widget that updates itself at regular intervals. The -- function -- @@ -37,17 +51,53 @@ -> Double -- ^ Update interval (in seconds) -> IO FilePath -- ^ Command to run to get the input filepath -> m Widget -pollingIconImageWidgetNew path interval cmd = liftIO $ do - icon <- imageNewFromFile path - _ <- onWidgetRealize icon $ do +pollingIconImageWidgetNew path interval cmd = + pollingIcon interval cmd + (imageNewFromFile path) + (\image path' -> imageSetFromFile image (Just path')) + +-- | Create a new widget that updates itself at regular intervals. The +-- function +-- +-- > pollingIconImageWidgetNewFromName name interval cmd +-- +-- returns a widget with initial icon whose name is @name@. The widget +-- forks a thread to update its contents every @interval@ seconds. +-- The command should return the name of a valid icon. +-- +-- If the IO action throws an exception, it will be swallowed and the +-- label will not update until the update interval expires. +pollingIconImageWidgetNewFromName + :: MonadIO m + => T.Text -- ^ Icon Name + -> Double -- ^ Update interval (in seconds) + -> IO T.Text -- ^ Command to run update the icon name + -> m Widget +pollingIconImageWidgetNewFromName name interval cmd = + pollingIcon interval cmd + (imageNewFromIconName (Just name) (fromIntegral $ fromEnum IconSizeMenu)) + (\image name' -> imageSetFromIconName image (Just name') $ fromIntegral $ fromEnum IconSizeMenu) + +-- | Creates a polling icon. +pollingIcon + :: MonadIO m + => Double -- ^ Update Interval (in seconds) + -> IO name -- ^ IO action that updates image's icon-name/filepath + -> IO Image -- ^ MonadIO action that creates the initial image. + -> (Image -> name -> IO b) + -- ^ MonadIO action that updates the image. + -> m Widget -- ^ Polling Icon +pollingIcon interval doUpdateName doInitImage doSetImage = liftIO $ do + image <- doInitImage + _ <- onWidgetRealize image $ do _ <- forkIO $ forever $ do - let tryUpdate = do - str <- cmd - postGUIASync $ imageSetFromFile icon (Just str) + let tryUpdate = liftIO $ do + name' <- doUpdateName + postGUIASync $ doSetImage image name' >> return () E.catch tryUpdate ignoreIOException threadDelay $ floor (interval * 1000000) return () - putInBox icon + putInBox image putInBox :: IsWidget child => child -> IO Widget putInBox icon = do diff --git a/src/System/Taffybar/Widget/SNITray.hs b/src/System/Taffybar/Widget/SNITray.hs --- a/src/System/Taffybar/Widget/SNITray.hs +++ b/src/System/Taffybar/Widget/SNITray.hs @@ -9,6 +9,21 @@ -- Stability : unstable -- Portability : unportable ----------------------------------------------------------------------------- +-- +-- A widget to display the system tray. +-- +-- This widget only supports the newer StatusNotifierItem (SNI) protocol; +-- older xembed applets will not be visible. AppIndicator is also a valid +-- implementation of SNI. +-- +-- Additionally, it does not handle recognising new tray applets. Instead it is +-- necessary to run status-notifier-watcher from the +-- [status-notifier-item](https://github.com/taffybar/status-notifier-item) +-- package early on system startup. +-- In case this is not possiblle, +-- 'sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt is available, but +-- this may not necessarily be able to pick up everything. + module System.Taffybar.Widget.SNITray where import Control.Monad.Trans.Class @@ -55,9 +70,13 @@ GI.Gtk.widgetShowAll tray GI.Gtk.toWidget tray +-- | The simplest way to build a new StatusNotifierItem tray sniTrayNew :: TaffyIO GI.Gtk.Widget sniTrayNew = getHost False >>= sniTrayNewFromHost +-- | Build a new StatusNotifierItem tray that also starts its own watcher, +-- without depending on status-notifier-icon. This will not register applets +-- started before the watcher is started. sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt :: TaffyIO GI.Gtk.Widget sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt = getHost True >>= sniTrayNewFromHost 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 @@ -5,11 +5,12 @@ import System.Taffybar.Information.Memory import System.Taffybar.Widget.Generic.PollingLabel ( pollingLabelNew ) import qualified GI.Gtk +import Text.Printf ( printf ) -- | Creates a simple textual memory monitor. It updates once every polling -- period (in seconds). textMemoryMonitorNew :: MonadIO m - => String -- ^ Format. You can use variables: "used", "total", "free", "buffer", "cache", "rest", "used". + => String -- ^ Format. You can use variables: "used", "total", "free", "buffer", "cache", "rest", "available". -> Double -- ^ Polling period in seconds. -> m GI.Gtk.Widget textMemoryMonitorNew fmt period = do @@ -19,12 +20,23 @@ callback = do info <- parseMeminfo let template = ST.newSTMP fmt - let labels = ["used", "total", "free", "buffer", "cache", "rest", "used"] - let actions = [memoryUsed, memoryTotal, memoryFree, memoryBuffer, memoryCache, memoryRest] - actions' = map ((show . intRound).) actions + let labels = ["used", "total", "free", "buffer", "cache", "rest", "available"] + let actions = [memoryUsed, memoryTotal, memoryFree, memoryBuffer, memoryCache, memoryRest, memoryAvailable] + actions' = map ((toAuto 3).) actions let stats = [f info | f <- actions'] let template' = ST.setManyAttrib (zip labels stats) template return $ ST.render template' -intRound :: Double -> Int -intRound = round +toAuto :: Int -> Double -> String +toAuto prec value = printf "%.*f%s" p v unit + where value' = max 0 value + mag :: Int + mag = if value' == 0 then 0 else max 0 $ min 2 $ floor $ logBase 1024 value' + v = value' / 1024 ** fromIntegral mag + unit = case mag of + 0 -> "MiB" + 1 -> "GiB" + 2 -> "TiB" + _ -> "??B" -- unreachable + p :: Int + p = max 0 $ floor $ fromIntegral prec - logBase 10 v 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 @@ -66,7 +66,7 @@ where getWindow :: IO (Maybe Window) getWindow = do - windowGType <- gobjectType @Window + windowGType <- glibType @Window Just ancestor <- Gtk.widgetGetAncestor widget windowGType castTo Window ancestor diff --git a/src/System/Taffybar/Widget/Weather.hs b/src/System/Taffybar/Widget/Weather.hs --- a/src/System/Taffybar/Widget/Weather.hs +++ b/src/System/Taffybar/Widget/Weather.hs @@ -1,8 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} --- | This module defines a simple textual weather widget that polls --- NOAA for weather data. To find your weather station, you can use --- --- +-- | This module defines a simple textual weather widget that polls +-- NOAA for weather data. To find your weather station, you can use +-- either of the following: +-- +-- +-- -- -- For example, Madison, WI is KMSN. -- diff --git a/src/System/Taffybar/Widget/WttrIn.hs b/src/System/Taffybar/Widget/WttrIn.hs new file mode 100644 --- /dev/null +++ b/src/System/Taffybar/Widget/WttrIn.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | This is a simple weather widget that polls wttr.in to retrieve the weather, +-- instead of relying on noaa data. +-- +-- Useful if NOAA data doesn't cover your needs, or if you just like wttr.in +-- better. +-- +-- For more information on how to use wttr.in, use: + +module System.Taffybar.Widget.WttrIn ( textWttrNew ) where +import System.Log.Logger +import Control.Exception as E +import Control.Monad.IO.Class +import GI.Gtk +import qualified Data.Text as T +import Data.Maybe (isJust) +import Data.Text.Encoding (decodeUtf8) +import Data.ByteString.Lazy (toStrict) +import Data.ByteString (ByteString) +import Text.Regex +import Network.HTTP.Client +import Network.HTTP.Types.Status (statusIsSuccessful) +import System.Taffybar.Widget.Generic.PollingLabel + +-- | Creates a GTK Label widget that polls the requested wttr.in url for weather +-- information. +-- +-- Not compatible with image endpoints and binary data, such as the %.png% +-- endpoints. +-- +-- > -- Yields a label with the text "London: ⛅️ +72°F". Updates every 60 +-- > -- seconds. +-- > textWttrNew "http://wttr.in/London?format=3" 60 +textWttrNew + :: MonadIO m + => String -- ^ URL. All non-alphanumeric characters must be properly %-encoded. + -> Double -- ^ Update Interval (in seconds) + -> m Widget +textWttrNew url interval = pollingLabelNew interval (callWttr url) + +-- | IO Action that calls wttr.in as per the user's request. +callWttr :: String -> IO T.Text +callWttr url = do + let unknownLocation rsp = -- checks for a common wttr.in bug + case T.stripPrefix "Unknown location; please try" rsp of + Nothing -> False + Just strippedRsp -> T.length strippedRsp < T.length rsp + isImage = isJust . (matchRegex $ mkRegex ".png") + getResponseData r = ( statusIsSuccessful $ responseStatus r + , toStrict $ responseBody r) + catchAndLog = flip E.catch $ logException + manager <- newManager defaultManagerSettings + request <- parseRequest url + (isOk, response) <- catchAndLog (getResponseData <$> httpLbs request manager) + let body = decodeUtf8 response + if not isOk || isImage url || unknownLocation body + then return $ "✨" + else return $ body + +-- Logs an Http Exception and returns wttr.in's weather unknown label. +logException :: HttpException -> IO (Bool, ByteString) +logException e = do + let errmsg = show e + logM "System.Taffybar.Widget.WttrIn" ERROR $ + ("Warning: Couldn't call wttr.in. \n" ++ errmsg) + return $ (False, "✨") diff --git a/taffybar.cabal b/taffybar.cabal --- a/taffybar.cabal +++ b/taffybar.cabal @@ -1,5 +1,5 @@ name: taffybar -version: 3.2.2 +version: 3.2.3 synopsis: A desktop bar similar to xmobar, but with more GUI license: BSD3 license-file: LICENSE @@ -53,16 +53,16 @@ , gi-cairo-connector , gi-cairo-render , gi-gdk - , gi-gdkpixbuf >= 2.0.18 + , gi-gdkpixbuf , gi-gdkx11 - , gi-glib >= 2.0.17 + , gi-glib , gi-gtk , gi-gtk-hs , gi-pango , gtk-sni-tray >= 0.1.5.0 , gtk-strut >= 0.1.2.1 - , haskell-gi >= 0.22.6 - , haskell-gi-base >= 0.22.2 + , haskell-gi >= 0.24 + , haskell-gi-base >= 0.24 , hslogger , http-client >= 0.5 , http-client-tls @@ -80,7 +80,7 @@ , stm , template-haskell , text - , time >= 1.8 && < 2.0 + , time >= 1.9 && < 2.0 , time-locale-compat >= 0.1 && < 0.2 , time-units >= 1.0.0 , transformers >= 0.3.0.0 @@ -149,6 +149,7 @@ , System.Taffybar.Widget.Text.NetworkMonitor , System.Taffybar.Widget.Util , System.Taffybar.Widget.Weather + , System.Taffybar.Widget.WttrIn , System.Taffybar.Widget.Windows , System.Taffybar.Widget.Workspaces , System.Taffybar.Widget.XDGMenu.Menu