packages feed

taffybar 3.2.2 → 3.2.3

raw patch · 9 files changed

+193/−29 lines, 9 filesdep ~gi-gdkpixbufdep ~gi-glibdep ~haskell-gi

Dependency ranges changed: gi-gdkpixbuf, gi-glib, haskell-gi, haskell-gi-base

Files

README.md view
@@ -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) 
src/System/Taffybar.hs view
@@ -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   --
src/System/Taffybar/Widget/Generic/Icon.hs view
@@ -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
src/System/Taffybar/Widget/SNITray.hs view
@@ -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
src/System/Taffybar/Widget/Text/MemoryMonitor.hs view
@@ -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
src/System/Taffybar/Widget/Util.hs view
@@ -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 
src/System/Taffybar/Widget/Weather.hs view
@@ -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------ <https://www.weather.gov/tg/siteloc>+-- | 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:+-- +-- <https://www.weather.gov/tg/siteloc> +-- <https://cnrfc.noaa.gov/metar.php> -- -- For example, Madison, WI is KMSN. --
+ src/System/Taffybar/Widget/WttrIn.hs view
@@ -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, "✨")
taffybar.cabal view
@@ -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