taffybar 4.0.2 → 4.0.3
raw patch · 50 files changed
+1288/−437 lines, 50 filesdep +hspecdep +hspec-coredep +hspec-goldendep −gi-cairodep −haskell-gidep −old-localedep ~basedep ~gi-gdkdep ~gi-gdkpixbufsetup-changednew-uploader
Dependencies added: hspec, hspec-core, hspec-golden, temporary
Dependencies removed: gi-cairo, haskell-gi, old-locale, transformers-base
Dependency ranges changed: base, gi-gdk, gi-gdkpixbuf, gi-gtk, gi-gtk-hs, scotty
Files
- CHANGELOG.md +64/−2
- README.md +54/−141
- Setup.hs +0/−2
- app/Main.hs +1/−1
- doc/config.md +129/−0
- doc/contrib.md +10/−0
- doc/custom.md +67/−0
- doc/faq.md +6/−0
- doc/index.md +83/−0
- doc/install.md +77/−0
- doc/run.md +159/−0
- src/System/Taffybar.hs +59/−41
- src/System/Taffybar/Auth.hs +10/−11
- src/System/Taffybar/Context.hs +70/−28
- src/System/Taffybar/DBus/Client/Params.hs +1/−1
- src/System/Taffybar/DBus/Client/Util.hs +4/−15
- src/System/Taffybar/DBus/Toggle.hs +1/−4
- src/System/Taffybar/Example.hs +1/−2
- src/System/Taffybar/Hooks.hs +9/−3
- src/System/Taffybar/Information/Battery.hs +15/−5
- src/System/Taffybar/Information/Chrome.hs +1/−2
- src/System/Taffybar/Information/Crypto.hs +32/−16
- src/System/Taffybar/Information/EWMHDesktopInfo.hs +4/−6
- src/System/Taffybar/Information/Network.hs +1/−4
- src/System/Taffybar/Information/SafeX11.hs +9/−2
- src/System/Taffybar/Information/X11DesktopInfo.hs +59/−41
- src/System/Taffybar/Information/XDG/Protocol.hs +0/−1
- src/System/Taffybar/LogFormatter.hs +0/−3
- src/System/Taffybar/SimpleConfig.hs +9/−4
- src/System/Taffybar/Support/PagerHints.hs +4/−3
- src/System/Taffybar/Util.hs +87/−16
- src/System/Taffybar/Widget/Battery.hs +0/−2
- src/System/Taffybar/Widget/FreedesktopNotifications.hs +0/−3
- src/System/Taffybar/Widget/Generic/Graph.hs +5/−7
- src/System/Taffybar/Widget/Generic/Icon.hs +9/−9
- src/System/Taffybar/Widget/Layout.hs +3/−3
- src/System/Taffybar/Widget/SimpleClock.hs +1/−19
- src/System/Taffybar/Widget/SimpleCommandButton.hs +2/−3
- src/System/Taffybar/Widget/Text/CPUMonitor.hs +4/−4
- src/System/Taffybar/Widget/Util.hs +2/−2
- src/System/Taffybar/Widget/Windows.hs +1/−1
- src/System/Taffybar/Widget/Workspaces.hs +5/−8
- src/System/Taffybar/WindowIcon.hs +5/−3
- taffybar.cabal +44/−19
- test/Spec.hs +1/−0
- test/System/Taffybar/AuthSpec.hs +77/−0
- test/System/Taffybar/SpecUtil.hs +100/−0
- test/data/System.Taffybar.Auth-passGet-get-a-password-with-info.golden +1/−0
- test/data/System.Taffybar.Auth-passGet-get-a-password.golden +1/−0
- test/data/System.Taffybar.Auth-passGet-missing-entry.golden +1/−0
CHANGELOG.md view
@@ -1,9 +1,71 @@-# Unreleased+# 4.0.3 +## Breaking Changes++ * Taffybar is tested with GHC versions >= 9.2 && < 9.10.+ Other versions may or may not work.++ * The following symbols have been deprecated (not removed):+ - `System.Taffybar.SimpleConfig.toTaffyConfig` -+ Use [`toTaffybarConfig`][toTaffybarConfig] instead.+ - `System.Taffybar.Support.PagerHints` -+ Use the [`XMonad.Hooks.TaffybarPagerHints`][TaffybarPagerHints] module instead.+ - `System.Taffybar.Util`:+ * `liftReader` - Use [`Control.Monad.Trans.Reader.mapReaderT`][mapReaderT] instead.+ * `logPrintFDebug` - Use [`logPrintF`][logPrintF] instead.+ * `(??)` - Use `f <*> pure a` instead.+ * `runCommandFromPath` - Use [`runCommand`][runCommand] instead.++[toTaffybarConfig]: https://hackage.haskell.org/package/taffybar-4.0.3/docs/System-Taffybar-SimpleConfig.html#v:toTaffybarConfig+[TaffybarPagerHints]: https://hackage.haskell.org/package/xmonad-contrib-0.18.1/docs/XMonad-Hooks-TaffybarPagerHints.html+[mapReaderT]: https://hackage.haskell.org/package/transformers-0.6.1.0/docs/Control-Monad-Trans-Reader.html#v:mapReaderT+[logPrintF]: https://hackage.haskell.org/package/taffybar-4.0.3/docs/System-Taffybar-Util.html#v:logPrintF+[runCommand]: https://hackage.haskell.org/package/taffybar-4.0.3/docs/System-Taffybar-Util.html#v:runCommand++## Improvements++ * Revise and expand documentation.++ * Some code cleanups such as applying HLint suggestions, fixing+ compiler warnings, cleaning module imports.++ * The Nix code for `flake.nix` was streamlined, because upstream+ nixpkgs already contains the necessary derivation overrides.+ ## Bug Fixes - * Gtk.widgetShowAll is run on the widget created by `cryptoPriceLabelWithIcon`,+ * Fix handling of Ctrl-C.++ * Improve logging in [`System.Taffybar.Information.Battery`](https://hackage.haskell.org/package/taffybar-4.0.3/docs/System-Taffybar-Information-Battery.html)+ and [`System.Taffybar.WindowIcon`](https://hackage.haskell.org/package/taffybar-4.0.3/docs/System-Taffybar-WindowIcon.html).+++# 4.0.2++ * Taffybar can now build with GHC 9.6.++ * Allow building with Scotty 0.22.++ * Drop unused `ConfigFile` dependency.+++# 4.0.1++## Improvements++ * Taffybar can now build with GHC 9.4.++ * Adds a `flake.nix`.++## Bug Fixes++ * `Gtk.widgetShowAll` is run on the widget created by `cryptoPriceLabelWithIcon`, so that it shows up by default.++ * Fix misleading precision of rgba() parameters in `taffybar.css`.++ * Remove `cryptocurrency` Cabal flag, which is now unnecessary.+ # 4.0.0
README.md view
@@ -1,170 +1,83 @@ # Taffybar -[](https://github.com/taffybar/taffybar/actions/workflows/nix.yml) [](https://hackage.haskell.org/package/taffybar) [](https://github.com/taffybar/taffybar/compare/latest-release...master) [](http://stackage.org/lts/package/taffybar) [](http://stackage.org/nightly/package/taffybar) [](https://github.com/taffybar/taffybar/labels/help%20wanted) [](https://matrix.to/#/#taffybar:matrix.org) [](https://gitter.im/taffybar/Lobby) [](https://github.com/taffybar/taffybar/blob/master/LICENSE) +[](https://github.com/taffybar/taffybar/actions/workflows/nix.yml) [](https://hackage.haskell.org/package/taffybar) [](https://github.com/taffybar/taffybar/compare/latest-release...master) [](http://stackage.org/lts/package/taffybar) [](http://stackage.org/nightly/package/taffybar) [](https://matrix.to/#/#taffybar:matrix.org) [](https://gitter.im/taffybar/Lobby) [](https://github.com/taffybar/taffybar/blob/master/LICENSE) -Taffybar is a gtk+3 [(through-gi-gtk)](https://github.com/taffybar/taffybar/issues/256) based desktop-information bar, intended primarily for use with XMonad, though it can also+## Summary+ +Taffybar is a desktop+information bar, intended primarily for use with [XMonad][], though it can also function alongside other EWMH 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.+to [xmobar][], but it differs in that it gives up some simplicity for a reasonable+helping of [GTK 3][] eye candy. -Before Installing------------------+[](https://github.com/taffybar/taffybar/blob/master/doc/screenshot.png) -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.+[GTK 3]: https://www.gtk.org/+[XMonad]: https://xmonad.org/+[dwm]: https://dwm.suckless.org/+[xmobar]: https://codeberg.org/xmobar/xmobar+[gi-gtk]: https://hackage.haskell.org/package/gi-gtk+[Haskell]: https://www.haskell.org/+[GHC]: https://www.haskell.org/ghc/ -### Taffybar is a library+## Taffybar is a library -As with window managers like XMonad and dwm, taffybar is most appropriately+As with window managers like [XMonad][] and [dwm][], Taffybar is most appropriately described as a library that allows you to build an executable that is customized-to your tastes. This means that taffybar must be installed alongside a haskell-compiler (ghc) that can compile the user's configuration source file.--### The taffybar binary and `startTaffybar` vs `dyreTaffybar`--Taffybar can be started from your configuration file in two different ways:--#### `dyreTaffybar`--The `dyreTaffybar` entry point to taffybar uses the [dyre-library](https://github.com/willdonnelly/dyre) to automatically recompile your-taffybar configuration whenever it detects that it has changed. The binary that-is distributed with taffybar does nothing more than call this entry point. The-main downside of this approach is that it does not allow the user to use any-sort of project files for their configuration, and they must have any packages-that are necessary for compilation of their configuration available in their-global ghc environment.--#### `startTaffybar`--The `startTaffybar` entry point to taffybar simply starts taffybar with the-provided configuration. The user binary will not be automatically recompiled-when source files change. The advantage of using `startTaffybar` directly is-that you can use that in the main function of a cabal project.--Distribution Packaging------------------------Several linux distributions package taffybar-([nixos](https://github.com/NixOS/nixpkgs/blob/master/pkgs/applications/window-managers/taffybar/default.nix),-[arch/aur](https://aur.archlinux.org/packages/taffybar/),-[debian](https://aur.archlinux.org/packages/taffybar/)). Of these, only the-NixOS distribution is officially supported by the maintainers. Using any of the-others should be pretty similar to using a bare cabal installation of taffybar.--#### NixOS--If you wish to use the NixOS package for taffybar, make sure that you are using-the-[module](https://github.com/NixOS/nixpkgs/blob/master/pkgs/applications/window-managers/taffybar/default.nix),-and not simply the haskellPackage for taffybar. If you need to add additional-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-----------------------------------### Prerequisites--If you are not using distribution packaging of taffybar or the nix package-manager (it will handle getting all the necessary packages for you), you will-need to install all of taffybar's non-haskell dependencies manually.--Start by making sure you have installed everything that is needed for [haskell-gi](https://github.com/haskell-gi/haskell-gi). Taffybar also needs the-equivalent of `libdbusmenu-gtk3-dev` and `libgirepository1.0-dev` on Debian.--You can also get some idea of what the necessary dependencies are by looking at-the nix section of the stack.yaml file in the taffybar repository.--### Cabal--Cabal installation is a simple matter of installing taffybar from hackage:-```-cabal install taffybar-```--You do not need to do this if you are using the project approach with cabal.+to your tastes. Like [xmobar][] and [XMonad][], Taffybar is configured in [Haskell][]. -### The project approach-The project approach to installing/using taffybar involves maintaining a small-haskell project that produces the users taffybar binary. No matter which package-manager you choose to use you will need to make a .cabal file for this project.-It is recommended that you use [this-example](https://github.com/taffybar/taffybar/blob/master/example/my-taffybar.cabal)-as a template. In that example, the users configuration resides in the file-`taffybar.hs` in the same directory, but that can be changed as needed. As of-right now, `dyreTaffybar` is incompatible with this approach because dyre simply-calls ghc directly.+Taffybar has a reasonably useful default configuration built in. -### Cabal+To use a different configuration, however, you must install a Haskell compiler+([GHC][]) that can compile your [`taffybar.hs`](https://github.com/taffybar/taffybar/blob/master/example/taffybar.hs) source file. -Simply run `cabal new-install` to install the binary.+You then select from [the list of available widgets][widgets] for+functionality to add to your Taffybar. If the widget you need doesn't+exist, then create your own with GTK. -### Stack+[widgets]: http://hackage.haskell.org/package/taffybar/docs/System-Taffybar-Widget.html -With stack, you will also need to maintain a stack.yaml file. Run `stack-install` to install the binary. See [this-example](https://github.com/taffybar/taffybar/blob/master/example/stack.yaml)+## Documentation -### Nix+* [**Installation**][install] -You will need to add default.nix file to your package. See [this-example](https://github.com/taffybar/taffybar/blob/master/example/default.nix)+ Taffybar can be installed from Linux distribution packages,+ or compiled from source. -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.+* [**Configuration** (and compilation)][config] -#### Overlay+ Taffybar can recompile itself from `taffybar.hs`, similar to how+ [XMonad][] recompiles itself from `xmonad.hs`. -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).+ There are a number of ways to compile your configuration. +* [**Customization**][custom] -Configuration--------------+ Taffybar has a library of functions and widgets for collecting and+ displaying information. -Like xmobar and XMonad, taffybar is configured in haskell. Taffybar depends on-dyre to automatically detect changes to its configuration file-(`$XDG_CONFIG_HOME/taffybar/taffybar.hs`) and recompile when appropriate.+ Many aspects of the bar's appearance can be changed using CSS. -For more details about how to configure taffybar, see the [full-documentation](https://hackage.haskell.org/package/taffybar). You can find a-list of available widgets-[here](http://hackage.haskell.org/package/taffybar-2.0.0/docs/System-Taffybar-Widget.html).+* [**Running**][run] -FAQ----+ Taffybar is one component of a desktop environment. To work+ correctly, it requires other desktop components and system services. -For the time being, taffybar's frequently asked questions page lives in [this-github issue](https://github.com/taffybar/taffybar/issues/332).+* [**FAQ**][faq] -Contributing-------------+ Assorted information. -Taffybar desperately needs contributors. If you want to help, but don't know-where to get started you can check out our "help wanted" and "easy" labels:+* [**Contributing**][contrib] + [](https://github.com/taffybar/taffybar/labels/help%20wanted)+ [](https://github.com/taffybar/taffybar/labels/easy) -[](https://github.com/taffybar/taffybar/labels/help%20wanted)-[](https://github.com/taffybar/taffybar/labels/easy)+ Taffybar desperately needs contributors.+ There is plenty to do; enquire within.+ +[install]: https://github.com/taffybar/taffybar/blob/master/doc/install.md+[config]: https://github.com/taffybar/taffybar/blob/master/doc/config.md+[custom]: https://github.com/taffybar/taffybar/blob/master/doc/custom.md+[run]: https://github.com/taffybar/taffybar/blob/master/doc/run.md+[faq]: https://github.com/taffybar/taffybar/blob/master/doc/faq.md+[contrib]: https://github.com/taffybar/taffybar/blob/master/doc/contrib.md
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
app/Main.hs view
@@ -50,7 +50,7 @@ -- XXX: The configuration record here does not get used, this just calls in to dyre. then dyreTaffybar def else do- logM "System.Taffybar" WARNING $+ logM "System.Taffybar" WARNING ( printf "No taffybar configuration file found at %s." taffyFilepath ++ " Starting with example configuration." )
+ doc/config.md view
@@ -0,0 +1,129 @@+# Configuration (and compilation)++[dyre]: https://github.com/willdonnelly/dyre++There are broadly three ways of building your configuration:++1. [Install](./install.md) Taffybar, use the default configuration (i.e. absent+ `taffybar.hs`) and don't compile anything yourself.+2. Let [Dyre][] handle compilation of `taffybar.hs`.+3. Compile your Taffybar executable some other way. Typically this+ would be done with the "Project Approach" (see below).++## Before installing++Taffybar's [installation procedure](./install.md) varies depending+your chosen option.++For example, it's not always necessary to install the `taffybar`+executable globally using a distro package or `cabal install+taffybar`.++Read this section so you can understand what all of that means before+you decide how you want to install Taffybar.++## Comparison++| | **Dyre** | **Not Dyre** |+| ------------------------ | -------- | ------------- |+| Config file location | `$XDG_CONFIG_HOME/taffybar/taffybar.hs` | Anywhere |+| Automatic reloading | Yes | No |+| Multiple modules | No | Yes |+| Boilerplate code/config | Little | Some |+| Entry point | [`dyreTaffybar`][dyreTaffybar] | [`startTaffybar`][startTaffybar] |+| Installation environment | Global | Project-local |++[dyreTaffybar]: https://hackage.haskell.org/package/taffybar-4.0.2/docs/System-Taffybar.html#v:dyreTaffybar+[startTaffybar]: https://hackage.haskell.org/package/taffybar-4.0.2/docs/System-Taffybar.html#v:startTaffybar++## Entry point++### `dyreTaffybar` (Dyre)++Dyre simply calls `ghc` directly to compile the config file. Any+Haskell packages used by the config (e.g. `taffybar`,+`xmonad-contrib`) must be installed and available to+`ghc-pkg`. Usually this means with a global Haskell installation.++The [`dyreTaffybar`][dyreTaffybar] entry point to Taffybar uses the+[Dyre library][dyre] to automatically recompile your+configuration whenever it detects that it has changed.++The binary that is distributed with Taffybar does nothing more than+call this entry point.++The main downside of this approach is that it does not allow the user to use any+sort of project files for their configuration, and they must have any packages+that are necessary for compilation of their configuration available in their+global ghc environment.++### `startTaffybar` (not Dyre)++Not using Dyre, you can compile your Taffybar configuration the same+way you compile other Haskell projects that you work on.++The user binary will _not_ be automatically recompiled when source+files change.++The [`startTaffybar`][startTaffybar] entry point simply starts+Taffybar with the given configuration.++The advantage of using `startTaffybar` directly is+that you can use that in the `main` function of a Cabal project.++## The Project Approach++The "project approach" to configuring and installing Taffybar involves+maintaining a small Haskell project that produces the `taffybar`+binary.++With this approach, you can build your Taffybar using proper build+tools rather than just `ghc -o taffybar taffybar.hs ...`, which is+essentially what [Dyre][] uses. The "Main" disadvantage of Dyre is+that you can't easily split your configuration into multiple modules.++It is recommended that you use [this example `my-taffybar.cabal`][example-cabal]+as a template. In that example, the user's configuration resides in the file+`taffybar.hs` within the same directory, but that can be changed as needed. ++[example-cabal]: https://github.com/taffybar/taffybar/blob/master/example/my-taffybar.cabal++### Main++Example: [Main](https://github.com/taffybar/taffybar/blob/master/example/taffybar.hs)++The `Main` module and any other module(s) listed in the `.cabal` file+are therefore your configuration.++Your `main` function needs to call the `startTaffybar` entrypoint with+a `TaffybarConfig` value. See [Customization](./custom.md) for further+information.++### Build tool examples++Use your chosen build tool to compile the `taffybar` executable of+your configuration. The build tool can then install `taffybar` to a+system location such as `/usr/local/bin`.++#### Cabal++Example: [`my-taffybar.cabal`][example-cabal]++Run `cabal install` within the project to install the executable.++#### Stack++Example: [`stack.yaml`](https://github.com/taffybar/taffybar/blob/master/example/stack.yaml)++With Stack, you will also need to maintain a `stack.yaml` file in+addition to the `.cabal` file. When choosing a "resolver" for+`stack.yaml`, the latest [LTS Haskell](https://www.stackage.org/lts)+is usually a good choice.++Run `stack install` within the project to install the executable.++#### Nix++Example derivation: [`default.nix`](https://github.com/taffybar/taffybar/blob/master/example/default.nix).++This could be installed into your Nix user environment with `nix-env -i -f default.nix`.
+ doc/contrib.md view
@@ -0,0 +1,10 @@+# Contributing++<!-- NB. This file is linked to when opening pull requests. -->++If you want to help, but don't know where to get started you can check+out these issue labels:++- [Help Wanted](https://github.com/taffybar/taffybar/labels/help%20wanted)+- [Easy](https://github.com/taffybar/taffybar/labels/easy)+
+ doc/custom.md view
@@ -0,0 +1,67 @@+# Customization++For details about the library modules for configuring your Taffybar,+see the [full documentation][hackage].++[hackage]: https://hackage.haskell.org/package/taffybar+[gi-gtk]: https://hackage.haskell.org/package/gi-gtk++- [`taffybar` package documentation][hackage] - `System.Taffybar`+- [`gi-gtk` package documentation][gi-gtk] - `GI.Gtk`++## Config file location++Taffybar uses the directory `$XDG_CONFIG_HOME/taffybar/`. As per the+[XDG Base Directory Specification][basedir-spec], an unset or empty+`XDG_CONFIG_HOME` environment variable is taken to mean `~/.config`.++[basedir-spec]: https://specifications.freedesktop.org/basedir-spec/latest/#variables++## `TaffybarConfig`++Be aware that the `TaffybarConfig` value required by `dyreTaffybar`/`startTaffybar` is normally constructed via a [`SimpleConfig`](https://hackage.haskell.org/package/taffybar/docs/System-Taffybar-SimpleConfig.html#t:SimpleTaffyConfig) value and [`toTaffybarConfig`](https://hackage.haskell.org/package/taffybar/docs/System-Taffybar-SimpleConfig.html#v:toTaffybarConfig).++## CSS++[#308 Add styling tips section to README/docs](https://github.com/taffybar/taffybar/issues/308)++Appearance of Taffybar widgets can be controlled with CSS rules. These+are by default loaded from `$XDG_CONFIG_HOME/taffybar/taffybar.css`. Taffybar+must be restarted for changes in `taffybar.css` to take effect.++### GTK Documentation++CSS styling is a feature of GTK. It uses a limited version of CSS, so+the following articles from the GTK documentation are useful:+- [CSS in GTK](https://docs.gtk.org/gtk3/css-overview.html)+- [GTK CSS Properties](https://docs.gtk.org/gtk3/css-properties.html)++### GTK Inspector++Run Taffybar with the environment variable `GTK_DEBUG=interactive` to+enable the [GTK Inspector][inspector]. This will let you figure out+CSS class names of widgets. The GTK Inspector also lets you+interactively try CSS rules, which is immensely helpful.++[inspector]: https://developer.gnome.org/documentation/tools/inspector.html++### Specifying colours++Note that the first three parameters of `rgba()` are integers in the+range 0—255, but the fourth is a float in the range 0.0—1.0. For example:++```css+.taffy-box {+ background-color: rgba(255, 250, 205, 0.3);+}+```++### Adding CSS classes to Taffybar widgets++Use [`System.Taffybar.Util.widgetSetClassGI`][widgetSetClassGI] to add+a CSS class to a widget in your Taffybar config.++This can be used for example to apply different styling to widgets of+the same type.++[widgetSetClassGI]: https://hackage.haskell.org/package/taffybar/docs/System-Taffybar-Widget-Util.html#v:widgetSetClassGI
+ doc/faq.md view
@@ -0,0 +1,6 @@+# FAQ++For the time being, Taffybar's frequently asked questions page lives in+[issue #332 - Add a FAQ section to README/Docs/Wiki](https://github.com/taffybar/taffybar/issues/332).++Some of this information is collected in [Running Taffybar](./run.md).
+ doc/index.md view
@@ -0,0 +1,83 @@+# Taffybar++[](https://github.com/taffybar/taffybar/actions/workflows/nix.yml) [](https://hackage.haskell.org/package/taffybar) [](https://github.com/taffybar/taffybar/compare/latest-release...master) [](http://stackage.org/lts/package/taffybar) [](http://stackage.org/nightly/package/taffybar) [](https://matrix.to/#/#taffybar:matrix.org) [](https://gitter.im/taffybar/Lobby) [](https://github.com/taffybar/taffybar/blob/master/LICENSE)++## Summary+ +Taffybar is a desktop+information bar, intended primarily for use with [XMonad][], though it can also+function alongside other EWMH 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 [GTK 3][] eye candy.++[](https://github.com/taffybar/taffybar/blob/master/doc/screenshot.png)++[GTK 3]: https://www.gtk.org/+[XMonad]: https://xmonad.org/+[dwm]: https://dwm.suckless.org/+[xmobar]: https://codeberg.org/xmobar/xmobar+[gi-gtk]: https://hackage.haskell.org/package/gi-gtk+[Haskell]: https://www.haskell.org/+[GHC]: https://www.haskell.org/ghc/++## Taffybar is a library++As with window managers like [XMonad][] and [dwm][], Taffybar is most appropriately+described as a library that allows you to build an executable that is customized+to your tastes. Like [xmobar][] and [XMonad][], Taffybar is configured in [Haskell][].++Taffybar has a reasonably useful default configuration built in.++To use a different configuration, however, you must install a Haskell compiler+([GHC][]) that can compile your [`taffybar.hs`](https://github.com/taffybar/taffybar/blob/master/example/taffybar.hs) source file.++You then select from [the list of available widgets][widgets] for+functionality to add to your Taffybar. If the widget you need doesn't+exist, then create your own with GTK.++[widgets]: http://hackage.haskell.org/package/taffybar/docs/System-Taffybar-Widget.html++## Documentation++* [**Installation**][install]++ Taffybar can be installed from Linux distribution packages,+ or compiled from source.++* [**Configuration** (and compilation)][config]++ Taffybar can recompile itself from `taffybar.hs`, similar to how+ [XMonad][] recompiles itself from `xmonad.hs`.++ There are a number of ways to compile your configuration.++* [**Customization**][custom]++ Taffybar has a library of functions and widgets for collecting and+ displaying information.++ Many aspects of the bar's appearance can be changed using CSS.++* [**Running**][run]++ Taffybar is one component of a desktop environment. To work+ correctly, it requires other desktop components and system services.++* [**FAQ**][faq]++ Assorted information.++* [**Contributing**][contrib]++ [](https://github.com/taffybar/taffybar/labels/help%20wanted)+ [](https://github.com/taffybar/taffybar/labels/easy)++ Taffybar desperately needs contributors.+ There is plenty to do; enquire within.+ +[install]: https://github.com/taffybar/taffybar/blob/master/doc/install.md+[config]: https://github.com/taffybar/taffybar/blob/master/doc/config.md+[custom]: https://github.com/taffybar/taffybar/blob/master/doc/custom.md+[run]: https://github.com/taffybar/taffybar/blob/master/doc/run.md+[faq]: https://github.com/taffybar/taffybar/blob/master/doc/faq.md+[contrib]: https://github.com/taffybar/taffybar/blob/master/doc/contrib.md
+ doc/install.md view
@@ -0,0 +1,77 @@+# Installation++- [#535 - Fix up README](https://github.com/taffybar/taffybar/issues/535)++## Distribution Packaging++Several Linux distributions package Taffybar:++- [NixOS (nixpkgs)](https://github.com/NixOS/nixpkgs/blob/master/pkgs/applications/window-managers/taffybar/default.nix)+- [arch/aur](https://aur.archlinux.org/packages/taffybar/)+- [Debian (main)](https://packages.debian.org/unstable/taffybar)+- [Ubuntu (universe)](https://packages.ubuntu.com/taffybar)++Of these, only the NixOS distribution is officially supported by the+maintainers. Using any of the others would be pretty similar to using+a bare Cabal installation of Taffybar.++### NixOS Package++If you wish to use the NixOS package, make sure that you are using+the top-level [`pkgs.taffybar`](https://github.com/NixOS/nixpkgs/blob/master/pkgs/applications/window-managers/taffybar/default.nix)+and not simply `pkgs.haskellPackages.taffybar`.++The top-level package (`pkgs.taffybar`) provides an environment for+Dyre containing `ghc` and libraries for compiling the configuration.++If you need to add additional Haskell dependencies, then override the+`packages` parameter. For example:++```nix+pkgs.taffybar.override {+ packages = hp: [ hp.xmonad-contrib hp.dbus ];+}+```++It is also possible to use Taffybar on NixOS without using this+module, for example by using `pkgs.haskellPackages.taffybar` as a+library in another package (see [Configuration (and compilation)](./config.md)).++### Debian/Ubuntu++On Debian/Ubuntu the `taffybar` package contains the executable+only. Install the `libghc-taffybar-dev` package to get the+`System.Taffybar` Haskell library.++The development package `libghc-taffybar-dev` should also pull in the+GHC compiler and other system dependencies such as the `libgtk-3-dev`+package. Therefore it is useful to have, even if you intend to install+Taffybar from source and not use distribution binaries.++# Installation from source++## Prerequisites++If not using a distribution package of Taffybar which handles getting+all the necessary development libraries for you, then you will need to+install all of Taffybar's non-Haskell dependencies manually.++### System Dependencies++Start by making sure you have installed everything that is needed for [haskell-gi](https://github.com/haskell-gi/haskell-gi). Taffybar also needs the+equivalent of [`libdbusmenu-gtk3-dev`](https://packages.debian.org/sid/libdbusmenu-gtk3-dev) and [`libgirepository1.0-dev`](https://packages.debian.org/sid/libgirepository-1.0-dev) on Debian.++You can also get some idea of what the necessary dependencies are by looking at+the `nix` section of the [`stack.yaml`](https://github.com/taffybar/taffybar/blob/master/stack.yaml) file in the Taffybar repository.++### Haskell Compiler++For the greatest chance of success, use one of the GHC versions listed in [`taffybar.cabal` (tested-with)](https://github.com/taffybar/taffybar/blob/master/taffybar.cabal). Currently, GHC 9.6 is a good choice.++## Cabal++Once the prerequisites are in place, Cabal installation is a simple matter of installing [Taffybar from Hackage](https://hackage.haskell.org/package/taffybar):++```+cabal install taffybar+```
+ doc/run.md view
@@ -0,0 +1,159 @@+# Running Taffybar++Being a desktop component, Taffybar has various runtime dependencies,+depending on your configuration.++## X11 Compisitor++Run an X11 compositor such as [Picom][] for transparency and rounded+window corners.++This is optional and Taffybar looks fine without these features.++[Picom]: https://picom.app/++## XMonad++Example: [`xmonad.hs`](https://github.com/taffybar/taffybar/blob/master/example/xmonad.hs)++Your XMonad configuration should have:+1. [`XMonad.Hooks.ManageDocks.docks`][ManageDocks] - so that Taffybar windows are managed like docks+2. [`XMonad.Hooks.ManageDocks.avoidStruts`][ManageDocks] - so that other windows don't cover Taffybar.+1. [`XMonad.Hooks.EwmhDesktops.ewmh`][EwmhDesktops] - so that Taffybar knows about workspaces and windows managed by XMonad.+2. [`XMonad.Hooks.TaffybarPagerHints.pagerHints`][TaffybarPagerHints] - so that Taffybar knows about the current layout used by XMonad, and which workspaces are visible.++[ManageDocks]: https://hackage.haskell.org/package/xmonad-contrib/docs/XMonad-Hooks-ManageDocks.html+[EwmhDesktops]: https://hackage.haskell.org/package/xmonad-contrib/docs/XMonad-Hooks-EwmhDesktops.html+[TaffybarPagerHints]: https://hackage.haskell.org/package/xmonad-contrib/docs/XMonad-Hooks-TaffybarPagerHints.html++## D-Bus++Taffybar connects to both the system bus and session bus. These days+it would be a rare Linux system which doesn't have a working D-Bus+_system bus_.++However there can sometimes be problems configuring the per-user+_session bus_. Ensure that:++1. The D-Bus session bus (i.e. `dbus-daemon` or `dbus-broker`) is+ running for the user, or is able to be socket-activated. If you are+ using `gnome-session` then D-Bus is guaranteed to be running.++2. The `taffybar` process has the `DBUS_SESSION_BUS_ADDRESS`+ environment variable set correctly.+ + It can happen that Taffybar doesn't have `DBUS_SESSION_BUS_ADDRESS`+ if it is started from an `xsession` script before `dbus-launch`.+ + Or it can happen if Taffybar is running as a `systemd --user`+ service, and the service gets started before+ `DBUS_SESSION_BUS_ADDRESS` is imported into the systemd manager+ environment.++## Battery Status++[UPower][] is required for [`System.Taffybar.Information.Battery`][Battery].++To test that it's running and working, run:++```+$ upower -i /org/freedesktop/UPower/devices/DisplayDevice+ power supply: yes+ updated: Sun 13 Oct 2024 09:13:24 (35002 seconds ago)+ has history: no+ has statistics: no+ battery+ present: yes+ state: fully-charged+ warning-level: none+ energy: 49.9776 Wh+ energy-full: 49.9776 Wh+ energy-rate: 0.0076 W+ charge-cycles: N/A+ percentage: 100%+ icon-name: 'battery-full-charged-symbolic'+```++### Incorrect battery state?++If the battery icon is not updating or the battery state is not reported+correctly (e.g. [issue #330](https://github.com/taffybar/taffybar/issues/330),+you could try a workaround:++1. Run UPower with the `--debug` option added.+2. Apply [`System.Taffybar.Hooks.withBatteryRefresh`][withBatteryRefresh]+ to your `TaffybarConfig`.++[Battery]: https://hackage.haskell.org/package/taffybar/docs/System-Taffybar-Information-Battery.html+[withBatteryRefresh]: https://hackage.haskell.org/package/taffybar-4.0.2/docs/System-Taffybar-Hooks.html#v:withBatteryRefresh+[UPower]: https://upower.freedesktop.org/++## System Tray++Run [`status-notifier-watcher`](https://github.com/taffybar/status-notifier-item)+to track registration/deregistration of [StatusNotifierItem (SNI)][sni]+tray icons. This is an implementation of the StatusNotifierWatcher+interface which runs separately to Taffybar, so that tray icons can+survive restarts of Taffybar.++[`System.Taffybar.Widget.SNITray.sniTrayNew`][SNITray] uses D-Bus to ask+StatusNotifierWatcher for the list of tray icons. Therefore, if using+[SNITray][], ensure that `status-notifier-watcher` is started before+Taffybar.++[sni]: https://www.freedesktop.org/wiki/Specifications/StatusNotifierItem/+[SNITray]: https://hackage.haskell.org/package/taffybar/docs/System-Taffybar-Widget-SNITray.html++### Network Manager Tray Icon (`nm-applet`)++`nm-applet` needs to be started with the `--indicator` option so that+it registers with the StatusNotifierWatcher.++If using XDG autostart, then edit the `Exec=` line of+[`nm-applet.desktop`](https://gitlab.gnome.org/GNOME/network-manager-applet/-/blob/main/nm-applet.desktop.in?ref_type=heads)+in `~/.config/autostart`.++(Sometimes a `nm-applet --sm-disable` option is mentioned.+This option is not needed [1](https://askubuntu.com/a/525273), [2](https://mail.gnome.org/archives/networkmanager-list/2011-May/msg00141.html).)++## NixOS++### GDK pixbuf loaders cache++Under NixOS, it's not possible to have a global mutable file such as+`/usr/lib/gdk-pixbuf-2.0/2.10.0/loaders.cache`.++So graphical applications using `gdk-pixbuf` on NixOS need to have the+environment variable `GDK_PIXBUF_MODULE_FILE` set according to the+system configuration, _and_ available in the process execution+environment _before_ they are started.++Applications started from within `gnome-session`, being child+processes of it, will naturally have `GDK_PIXBUF_MODULE_FILE` in their+process environment.++Applications run as `systemd --user` services will not necesarily have+any environment variables at all.++So if you run Taffybar as a `systemd --user` service, then add this to+your NixOS configuration:++```nix+services.xserver.displayManager.importedVariables = [+ "GDK_PIXBUF_MODULE_FILE"+]+```++If using home-manager, and the option [`services.taffybar.enable`](https://github.com/nix-community/home-manager/blob/master/modules/services/taffybar.nix),+this is done for you.++### `XDG_DATA_DIRS`++For loading of desktop entry files and icons, Taffybar needs to be run+with a correctly configured `XDG_DATA_DIRS` environment variable.++If you run Taffybar as a `systemd --user` service, the the correct+value of `XDG_DATA_DIRS` needs to be imported into the service manager+environment, _before_ `taffybar.service` is started.++If using home-manager and the option [`xsession.enable`](https://github.com/nix-community/home-manager/blob/master/modules/xsession.nix), this is done for you.
src/System/Taffybar.hs view
@@ -12,30 +12,30 @@ module System.Taffybar ( -- | Taffybar is a system status bar meant for use with window managers like- -- XMonad and i3wm. Taffybar is somewhat similar to xmobar, but it opts to use- -- more heavy weight GUI in the form of gtk+ rather than the mostly textual+ -- "XMonad" and i3wm. Taffybar is somewhat similar to xmobar, but it opts to use+ -- more heavy weight GUI in the form of GTK rather than the mostly textual -- approach favored by the latter. This allows it to provide features like an -- SNI system tray, and a workspace widget with window icons. -- - -- * Config File+ -- * Configuration -- |- -- The interface that taffybar provides to the end user is roughly as follows:- -- you give Taffybar a list of ([Taffy]IO actions that build) gtk+ widgets and+ -- The interface that Taffybar provides to the end user is roughly as follows:+ -- you give Taffybar a list of ('TaffyIO' actions that build) GTK widgets and -- it renders them in a horizontal bar for you (taking care of ugly details -- 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+ -- desired set of widgets. This approach requires that Taffybar be installed+ -- as a Haskell library (not merely as an executable), and that the GHC -- compiler be available for recompiling the configuration. The upshot of this- -- approach is that taffybar's behavior and widget set are not limited to the+ -- approach is that Taffybar's behavior and widget set are not limited to the -- set of widgets provided by the library, because custom code and widgets can- -- be provided to taffybar for instantiation and execution.+ -- be provided to Taffybar for instantiation and execution. --- -- The following code snippet is a simple example of what a taffybar+ -- The following code snippet is a simple example of what a Taffybar -- configuration might look like (also see "System.Taffybar.Example"): -- -- > {-# LANGUAGE OverloadedStrings #-}@@ -73,30 +73,42 @@ -- and then system CPU use in a kind of semi-transparent purple on top of the -- green. --- -- It is important to note that the widget lists are *not* [Widget]. They are- -- actually [TaffyIO Widget] since the bar needs to construct them after+ -- It is important to note that the widget lists are __not__ @'GI.Gtk.Widget'@. They are+ -- actually @'TaffyIO' 'GI.Gtk.Widget'@ since the bar needs to construct them after -- performing some GTK initialization.++ getTaffyFile++ -- ** Colors --+ -- | Although Taffybar is based on GTK, it ignores your GTK theme. The default+ -- theme that it uses lives at+ -- https://github.com/taffybar/taffybar/blob/master/taffybar.css You can alter+ -- this theme by editing @~\/.config\/taffybar\/taffybar.css@ to your liking.+ -- For an idea of the customizations you can make, see+ -- <https://live.gnome.org/GnomeArt/Tutorials/GtkThemes>.++ -- * Taffybar and DBus --- -- | Taffybar has a strict dependency on dbus, so you must ensure that it is- -- started before starting taffybar.+ -- | Taffybar has a strict dependency on "DBus", so you must ensure that the DBus daemon is+ -- started before starting Taffybar. --- -- * If you start your window manager using a graphical login manager like gdm- -- or kdm, DBus should be started automatically for you.+ -- * If you start your window manager using a graphical login manager like @gdm@+ -- or @kdm@, DBus should be started automatically for you. -- -- * If you start xmonad with a different graphical login manager that does- -- not start DBus for you automatically, put the line @eval \`dbus-launch- -- --auto-syntax\`@ into your ~\/.xsession *before* xmonad and taffybar are+ -- not start DBus for you automatically, put the line+ -- @eval \`dbus-launch --auto-syntax\`@ into your @~\/.xsession@ *before* xmonad and taffybar are -- started. This command sets some environment variables that the two must -- agree on. -- -- * If you start xmonad via @startx@ or a similar command, add the- -- above command to ~\/.xinitrc+ -- above command to @~\/.xinitrc@ -- -- * System tray compatability --- -- | "System.Taffybar.Widget.SNITray" only supports the newer+ -- "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. --@@ -105,32 +117,27 @@ -- [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+ -- 'System.Taffybar.Widget.SNITray.sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt' is available, but -- this may not necessarily be able to pick up everything. - -- * Colors- --- -- | While taffybar is based on GTK+, it ignores your GTK+ theme. The default- -- theme that it uses lives at- -- https://github.com/taffybar/taffybar/blob/master/taffybar.css You can alter- -- this theme by editing @~\/.config\/taffybar\/taffybar.css@ to your liking.- -- For an idea of the customizations you can make, see- -- <https://live.gnome.org/GnomeArt/Tutorials/GtkThemes>.- dyreTaffybar+ -- * Starting+ , startTaffybar++ -- ** Using Dyre+ , dyreTaffybar , dyreTaffybarMain- , getTaffyFile- , startTaffybar , taffybarDyreParams ) where import qualified Config.Dyre as Dyre import qualified Config.Dyre.Params as Dyre+import Control.Exception ( finally ) import Control.Monad import qualified Data.GI.Gtk.Threading as GIThreading import qualified Data.Text as T import qualified GI.Gdk as Gdk import qualified GI.Gtk as Gtk-import Graphics.X11.Xlib.Misc+import Graphics.X11.Xlib.Misc ( initThreads ) import System.Directory import System.Environment.XDG.BaseDir ( getUserConfigFile ) import System.Exit ( exitFailure )@@ -139,6 +146,7 @@ import System.Log.Logger import System.Taffybar.Context import System.Taffybar.Hooks+import System.Taffybar.Util ( onSigINT ) import Paths_taffybar ( getDataDir ) @@ -150,15 +158,15 @@ , Dyre.rtsOptsHandling = Dyre.RTSAppend ["-I0", "-V0"] } --- | Use Dyre to configure and start taffybar. This will automatically recompile--- taffybar whenever there are changes to your taffybar.hs configuration file.+-- | Use Dyre to configure and start Taffybar. This will automatically recompile+-- Taffybar whenever there are changes to your @taffybar.hs@ configuration file. dyreTaffybar :: TaffybarConfig -> IO () dyreTaffybar = Dyre.wrapMain taffybarDyreParams showError :: TaffybarConfig -> String -> TaffybarConfig showError cfg msg = cfg { errorMsg = Just msg } --- | The main function that should be run by dyre given a TaffybarConfig.+-- | The main function that Dyre should run. This is used in 'taffybarDyreParams'. dyreTaffybarMain :: TaffybarConfig -> IO () dyreTaffybarMain cfg = case errorMsg cfg of@@ -190,6 +198,8 @@ Gtk.styleContextAddProviderForScreen scr taffybarProvider 800 return taffybarProvider +-- | Locates full the 'FilePath' of the given Taffybar config file.+-- The [XDG Base Directory](https://specifications.freedesktop.org/basedir-spec/latest/) convention is used, meaning that config files are usually in @~\/.config\/taffybar@. getTaffyFile :: String -> IO FilePath getTaffyFile = getUserConfigFile "taffybar" @@ -198,8 +208,8 @@ defaultUserConfig <- getTaffyFile "taffybar.css" return [defaultUserConfig] --- | Start taffybar with the provided 'TaffybarConfig'. This function will not--- handle recompiling taffybar automatically when taffybar.hs is updated. If you+-- | Start Taffybar with the provided 'TaffybarConfig'. This function will not+-- handle recompiling taffybar automatically when @taffybar.hs@ is updated. If you -- would like this feature, use 'dyreTaffybar' instead. If automatic -- recompilation is handled by another mechanism such as stack or a custom user -- script or not desired for some reason, it is perfectly fine (and probably@@ -218,7 +228,15 @@ then getDefaultCSSPaths else return $ cssPaths config _ <- startCSS $ defaultCSS:cssPathsToLoad- _ <- buildContext config+ context <- buildContext config Gtk.main- return ()+ `finally` logTaffy DEBUG "Finished main loop"+ `onSigINT` do+ logTaffy INFO "Interrupted"+ exitTaffybar context++ logTaffy DEBUG "Exited normally"++logTaffy :: Priority -> String -> IO ()+logTaffy = logM "System.Taffybar"
src/System/Taffybar/Auth.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module System.Taffybar.Auth where -import Control.Arrow import Control.Monad.IO.Class import Data.Maybe import System.Taffybar.Util@@ -11,13 +10,13 @@ fieldRegex = mkRegexWithOpts "^(.*?): *(.*?)$" True True passGet :: MonadIO m => String -> m (Either String (String, [(String, String)]))-passGet credentialName =- right (getPassComponents . lines) <$>- runCommandFromPath ["pass", "show", credentialName]- where getPassComponents passLines =- let entries =- map buildEntry $ catMaybes $- matchRegex fieldRegex <$> tail passLines- buildEntry [fieldName, fieldValue] = (fieldName, fieldValue)- buildEntry _ = ("", "")- in (head passLines, entries)+passGet credentialName = (>>= getPassComponents . lines) <$> runPassShow+ where runPassShow = runCommand "pass" ["show", credentialName]++ getPassComponents [] = Left "pass show command produced no output"+ getPassComponents (key:rest) = Right (key, buildEntries rest)++ buildEntries = mapMaybe buildEntry . mapMaybe (matchRegex fieldRegex)++ buildEntry [fieldName, fieldValue] = Just (fieldName, fieldValue)+ buildEntry _ = Nothing
src/System/Taffybar/Context.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MonoLocalBinds #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ImpredicativeTypes #-} -----------------------------------------------------------------------------@@ -23,30 +22,44 @@ ----------------------------------------------------------------------------- module System.Taffybar.Context- ( Context(..)- , TaffybarConfig(..)- , Taffy- , TaffyIO+ ( -- * Configuration+ TaffybarConfig(..)+ , defaultTaffybarConfig+ , appendHook+ -- ** Bars , BarConfig(..) , BarConfigGetter- , appendHook+ , showBarId++ -- * Taffy monad+ , Taffy+ , TaffyIO+ -- ** Context+ , Context(..) , buildContext , buildEmptyContext- , defaultTaffybarConfig+ -- ** Context State , getState , getStateDefault , putState- , forceRefreshTaffyWindows++ -- * Control , refreshTaffyWindows+ , exitTaffybar++ -- * X11 , runX11 , runX11Def+ -- ** Event subscription , subscribeToAll , subscribeToPropertyEvents- , taffyFork , unsubscribe++ -- * Threading+ , taffyFork ) where -import Control.Arrow ((&&&))+import Control.Arrow ((&&&), (***)) import Control.Concurrent (forkIO) import qualified Control.Concurrent.MVar as MV import Control.Exception.Enclosed (catchAny)@@ -72,7 +85,7 @@ import qualified GI.Gtk as Gtk import Graphics.UI.GIGtkStrut import StatusNotifier.TransparentWindow-import System.Log.Logger+import System.Log.Logger (Priority(..), logM) import System.Taffybar.Information.SafeX11 import System.Taffybar.Information.X11DesktopInfo import System.Taffybar.Util@@ -80,17 +93,17 @@ import Text.Printf import Unsafe.Coerce -logIO :: System.Log.Logger.Priority -> String -> IO ()+logIO :: Priority -> String -> IO () logIO = logM "System.Taffybar.Context" -logC :: MonadIO m => System.Log.Logger.Priority -> String -> m ()+logC :: MonadIO m => Priority -> String -> m () logC p = liftIO . logIO p --- | 'Taffy' is a monad transformer that provides 'Reader' for 'Context'.+-- | 'Taffy' is a monad transformer that provides 'ReaderT' for 'Context'. type Taffy m v = ReaderT Context m v -- | 'TaffyIO' is 'IO' wrapped with a 'ReaderT' providing 'Context'. This is the--- type of most widgets and callback in taffybar.+-- type of most widgets and callback in Taffybar. type TaffyIO v = ReaderT Context IO v type Listener = Event -> Taffy IO ()@@ -247,14 +260,26 @@ buildEmptyContext :: IO Context buildEmptyContext = buildContext def +-- | Format the 'barId' as a numeric string.+showBarId :: BarConfig -> String+showBarId = show . hashUnique . barId+ buildBarWindow :: Context -> BarConfig -> IO Gtk.Window buildBarWindow context barConfig = do let thisContext = context { contextBarConfig = Just barConfig }- logIO DEBUG $- printf "Building bar window with StrutConfig: %s" $- show $ strutConfig barConfig+ logC INFO $+ printf "Building window for Taffybar(id=%s) with %s"+ (showBarId barConfig)+ (show $ strutConfig barConfig) window <- Gtk.windowNew Gtk.WindowTypeToplevel++ void $ Gtk.onWidgetDestroy window $ do+ let bId = showBarId barConfig+ logC INFO $ printf "Window for Taffybar(id=%s) destroyed" bId+ MV.modifyMVar_ (existingWindows context) (pure . filter ((/=) window . sel2))+ logC DEBUG $ printf "Window for Taffybar(id=%s) unregistered" bId+ box <- Gtk.boxNew Gtk.OrientationHorizontal $ fromIntegral $ widgetSpacing barConfig _ <- widgetSetClassGI box "taffy-box"@@ -310,7 +335,7 @@ -- windows that should active. Will avoid recreating windows if there is already -- a window with the appropriate geometry and "BarConfig". refreshTaffyWindows :: TaffyIO ()-refreshTaffyWindows = liftReader postGUIASync $ do+refreshTaffyWindows = mapReaderT postGUIASync $ do logC DEBUG "Refreshing windows" ctx <- ask windowsVar <- asks existingWindows@@ -355,17 +380,34 @@ logC DEBUG "Finished refreshing windows" return () +-- | Unconditionally delete all existing Taffybar top-level windows.+removeTaffyWindows :: TaffyIO ()+removeTaffyWindows = asks existingWindows >>= liftIO . MV.readMVar >>= deleteWindows+ where+ deleteWindows = mapM_ (sequenceT . (msg *** del))++ msg :: BarConfig -> TaffyIO ()+ msg barConfig = logC INFO $+ printf "Destroying window for Taffybar(id=%s)" (showBarId barConfig)++ del :: Gtk.Window -> TaffyIO ()+ del = Gtk.widgetDestroy+ -- | Forcibly refresh taffybar windows, even if there are existing windows that -- correspond to the uniques in the bar configs yielded by 'barConfigGetter'. forceRefreshTaffyWindows :: TaffyIO ()-forceRefreshTaffyWindows =- asks existingWindows >>= lift . flip MV.modifyMVar_ deleteWindows >>- refreshTaffyWindows- where deleteWindows windows =- do- mapM_ (Gtk.widgetDestroy . sel2) windows- return []+forceRefreshTaffyWindows = removeTaffyWindows >> refreshTaffyWindows +-- | Destroys all top-level windows belonging to Taffybar, then+-- requests the GTK main loop to exit.+--+-- This ensures that the windows disappear promptly. For GTK windows+-- to be destroyed, the main loop still needs to be running.+exitTaffybar :: Context -> IO ()+exitTaffybar ctx = do+ postGUIASync $ runReaderT removeTaffyWindows ctx+ Gtk.mainQuit+ asksContextVar :: (r -> MV.MVar b) -> ReaderT r IO b asksContextVar getter = asks getter >>= lift . MV.readMVar @@ -414,9 +456,9 @@ (return . (contextStateMap,)) (currentValue >>= fromValue) --- | A version of "forkIO" in "TaffyIO".+-- | A version of 'forkIO' in 'TaffyIO'. taffyFork :: ReaderT r IO () -> ReaderT r IO ()-taffyFork = void . liftReader forkIO+taffyFork = void . mapReaderT forkIO startX11EventHandler :: Taffy IO () startX11EventHandler = taffyFork $ do
src/System/Taffybar/DBus/Client/Params.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE OverloadedStrings #-} module System.Taffybar.DBus.Client.Params where
src/System/Taffybar/DBus/Client/Util.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskellQuotes #-} module System.Taffybar.DBus.Client.Util where -import Control.Applicative+#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif import DBus.Generation import qualified DBus.Internal.Types as T import qualified DBus.Introspection as I@@ -13,33 +15,20 @@ import Language.Haskell.TH import StatusNotifier.Util (getIntrospectionObjectFromFile) -#if __GLASGOW_HASKELL__ >= 802 deriveShowAndEQ :: [DerivClause] deriveShowAndEQ = [DerivClause Nothing [ConT ''Eq, ConT ''Show]]-#endif buildDataFromNameTypePairs :: Name -> [(Name, Type)] -> Dec buildDataFromNameTypePairs name pairs = DataD [] name [] Nothing [RecC name (map mkVarBangType pairs)]-#if __GLASGOW_HASKELL__ >= 802 deriveShowAndEQ-#else- []-#endif where mkVarBangType (fieldName, fieldType) = (fieldName, Bang NoSourceUnpackedness NoSourceStrictness, fieldType) standaloneDeriveEqShow :: Name -> [Dec]-#if __GLASGOW_HASKELL__ < 802-standaloneDeriveEqShow name =- [ StandaloneDerivD [] (ConT ''Eq `AppT` ConT name)- , StandaloneDerivD [] (ConT ''Show `AppT` ConT name)- ]-#else standaloneDeriveEqShow _ = []-#endif type GetTypeForName = String -> T.Type -> Maybe Type
src/System/Taffybar/DBus/Toggle.hs view
@@ -15,7 +15,6 @@ module System.Taffybar.DBus.Toggle ( handleDBusToggles ) where -import Control.Applicative import qualified Control.Concurrent.MVar as MV import Control.Exception import Control.Monad@@ -29,9 +28,7 @@ import qualified Data.Map as M import Data.Maybe import qualified GI.Gdk as Gdk-import qualified GI.Gtk as Gtk import Graphics.UI.GIGtkStrut-import Prelude import System.Directory import System.FilePath.Posix import System.Log.Logger@@ -142,7 +139,7 @@ , autoMethod "showOnMonitor" $ takeInt $ toggleTaffyOnMon (const True) , autoMethod "refresh" $ runReaderT refreshTaffyWindows ctx- , autoMethod "exit" (Gtk.mainQuit :: IO ())+ , autoMethod "exit" $ exitTaffybar ctx ] } lift $ do
src/System/Taffybar/Example.hs view
@@ -104,5 +104,4 @@ , barHeight = ExactSize 50 , widgetSpacing = 0 }- in withBatteryRefresh $ withLogServer $- withToggleServer $ toTaffyConfig myConfig+ in withLogServer $ withToggleServer $ toTaffybarConfig myConfig
src/System/Taffybar/Hooks.hs view
@@ -8,7 +8,8 @@ -- Stability : unstable -- Portability : unportable ----- This module provides various startup hooks that can be added to 'TaffyConfig'.+-- This module provides various startup hooks that can be added to+-- 'TaffybarConfig'. ----------------------------------------------------------------------------- module System.Taffybar.Hooks@@ -58,8 +59,13 @@ handler <- taffyLogHandler updateGlobalLogger loggerName $ setHandlers [handler] --- | Add 'refreshrefreshBatteriesOnPropChange' to the 'startupHook' of the--- provided 'TaffybarConfig'.+-- | Add 'refreshBatteriesOnPropChange' to the 'startupHook' of the+-- provided 'TaffybarConfig'. Use this if your system has issues with+-- the battery widget not updating or reporting the incorrect state.+--+-- This function 'withBatteryRefresh' is __not normally needed__+-- because the battery widget already subscribes to updates from+-- UPower, and UPower usually works correctly. withBatteryRefresh :: TaffybarConfig -> TaffybarConfig withBatteryRefresh = appendHook refreshBatteriesOnPropChange
src/System/Taffybar/Information/Battery.hs view
@@ -59,10 +59,14 @@ => Priority -> String -> t -> m () batteryLogF = logPrintF batteryLogPath +-- | The DBus path prefix where UPower enumerates its objects.+uPowerDevicesPath :: ObjectPath+uPowerDevicesPath = objectPath_ (formatObjectPath uPowerBaseObjectPath ++ "/devices")+ -- | The prefix of name of battery devices path. UPower generates the object -- path as "battery" + "_" + basename of the sysfs object. batteryPrefix :: String-batteryPrefix = formatObjectPath uPowerBaseObjectPath ++ "/devices/battery_"+batteryPrefix = formatObjectPath uPowerDevicesPath ++ "/battery_" -- | Determine if a power source is a battery. isBattery :: ObjectPath -> Bool@@ -202,10 +206,11 @@ client <- asks systemDBusClient lift $ DBus.registerForPropertiesChanged client- matchAny { matchInterface = Just uPowerDeviceInterfaceName }+ matchAny { matchInterface = Just uPowerDeviceInterfaceName+ , matchPathNamespace = Just uPowerDevicesPath } handleIfPropertyMatches where handleIfPropertyMatches rawSignal n propertiesMap l =- let propertyPresent prop = isJust $ M.lookup prop propertiesMap+ let propertyPresent prop = M.member prop propertiesMap in when (any propertyPresent properties || null properties) $ signalHandler rawSignal n propertiesMap l @@ -232,7 +237,7 @@ runReaderT doUpdate ctx _ <- registerForUPowerPropertyChanges propertiesToMonitor signalCallback doUpdate- return ()+ return (chan, infoVar) -- | Call "refreshAllBatteries" whenever the BatteryInfo for the DisplayDevice@@ -256,7 +261,12 @@ let doRefresh path = batteryLogF DEBUG "Refreshing battery: %s" path >> refresh client path eerror <- runExceptT $ ExceptT getBatteryPaths >>= liftIO . mapM doRefresh- let logRefreshError = batteryLogF ERROR "Failed to refresh battery: %s"++ -- NB. The Refresh() method is only available if the UPower daemon+ -- was started in debug mode. So ignore any errors about the method+ -- not being implemented.+ let logRefreshError e = unless (methodErrorName e == errorUnknownMethod) $+ batteryLogF ERROR "Failed to refresh battery: %s" e logGetPathsError = batteryLogF ERROR "Failed to get battery paths %s" void $ either logGetPathsError (mapM_ $ either logRefreshError return) eerror
src/System/Taffybar/Information/Chrome.hs view
@@ -11,7 +11,6 @@ import Data.Maybe import qualified GI.GLib as Gdk import qualified GI.GdkPixbuf as Gdk-import Prelude import System.Log.Logger import System.Taffybar.Context import System.Taffybar.Information.EWMHDesktopInfo@@ -56,7 +55,7 @@ outChan <- newBChanListener inChan _ <- lift $ forkIO $ scotty port $ post "/setTabImageData/:tabID" $ do- tabID <- param "tabID"+ tabID <- queryParam "tabID" imageData <- LBS.toStrict <$> body when (BS.length imageData > 0) $ lift $ do loader <- Gdk.pixbufLoaderNew
src/System/Taffybar/Information/Crypto.hs view
@@ -30,6 +30,7 @@ import qualified Data.Map as M import Data.Maybe import Data.Proxy+import Data.Text (Text) import qualified Data.Text as T import GHC.TypeLits import Network.HTTP.Simple hiding (Proxy)@@ -38,7 +39,7 @@ import System.Taffybar.Util import Text.Printf -getSymbolToCoinGeckoId :: MonadIO m => m (M.Map T.Text T.Text)+getSymbolToCoinGeckoId :: MonadIO m => m (M.Map Text Text) getSymbolToCoinGeckoId = do let uri = "https://api.coingecko.com/api/v3/coins/list?include_platform=false" request = parseRequest_ uri@@ -52,7 +53,7 @@ return $ M.fromList $ map (\CoinGeckoInfo { identifier = theId, symbol = theSymbol } -> (theSymbol, theId)) coinInfos -newtype SymbolToCoinGeckoId = SymbolToCoinGeckoId (M.Map T.Text T.Text)+newtype SymbolToCoinGeckoId = SymbolToCoinGeckoId (M.Map Text Text) newtype CryptoPriceInfo = CryptoPriceInfo { lastPrice :: Double } @@ -66,15 +67,35 @@ getStateDefault $ buildCryptoPriceChannel (60.0 :: Double) symbolToId data CoinGeckoInfo =- CoinGeckoInfo { identifier :: T.Text, symbol :: T.Text }+ CoinGeckoInfo { identifier :: Text, symbol :: Text } deriving (Show) instance FromJSON CoinGeckoInfo where parseJSON = withObject "CoinGeckoInfo" (\v -> CoinGeckoInfo <$> v .: "id" <*> v .: "symbol") +logCrypto :: MonadIO m => Priority -> String -> m ()+logCrypto p = liftIO . logM "System.Taffybar.Information.Crypto" p++resolveSymbolPair :: KnownSymbol a => Proxy a -> SymbolToCoinGeckoId -> Either String (Text, Text)+resolveSymbolPair sym symbolToId = do+ (symbolName, inCurrency) <- parseSymbolPair (symbolVal sym)+ cgIdentifier <- lookupSymbolCoinGeckoId symbolToId symbolName+ pure (cgIdentifier, inCurrency)++ where+ parseSymbolPair :: String -> Either String (Text, Text)+ parseSymbolPair symbolPair = case T.splitOn "-" (T.toLower $ T.pack symbolPair) of+ [symbolName, inCurrency] | not (T.null inCurrency) -> Right (symbolName, inCurrency)+ _ -> Left $ printf "Type parameter \"%s\" does not match the form \"ASSET-CURRENCY\"" symbolPair++ lookupSymbolCoinGeckoId :: SymbolToCoinGeckoId -> Text -> Either String Text+ lookupSymbolCoinGeckoId (SymbolToCoinGeckoId m) symbolName = maybeToEither+ (printf "Symbol \"%s\" not found in coin gecko list" (T.unpack symbolName))+ (M.lookup symbolName m)+ buildCryptoPriceChannel ::- forall a. KnownSymbol a => Double -> SymbolToCoinGeckoId -> TaffyIO (CryptoPriceChannel a)-buildCryptoPriceChannel delay (SymbolToCoinGeckoId symbolToId) = do+ forall a. KnownSymbol a => Double -> SymbolToCoinGeckoId -> TaffyIO (CryptoPriceChannel a)+buildCryptoPriceChannel delay symbolToId = do let initialBackoff = delay chan <- newBroadcastChan var <- liftIO $ newMVar $ CryptoPriceInfo 0.0@@ -86,24 +107,19 @@ _ <- swapMVar backoffVar initialBackoff return () - let symbolPair = T.pack $ symbolVal (Proxy :: Proxy a)- (symbolName:inCurrency:_) = T.splitOn "-" symbolPair-- case M.lookup (T.toLower symbolName) symbolToId of- Nothing -> liftIO $ logM "System.Taffybar.Information.Crypto"- WARNING $ printf "Symbol %s not found in coin gecko list" symbolName- Just cgIdentifier ->+ case resolveSymbolPair (Proxy :: Proxy a) symbolToId of+ Left err -> logCrypto WARNING err+ Right (cgIdentifier, inCurrency) -> void $ foreverWithVariableDelay $- catchAny (liftIO $ getLatestPrice cgIdentifier (T.toLower inCurrency) >>=+ catchAny (liftIO $ getLatestPrice cgIdentifier inCurrency >>= maybe (return ()) (doWrites . CryptoPriceInfo) >> return delay) $ \e -> do- logPrintF "System.Taffybar.Information.Crypto"- WARNING "Error when fetching crypto price: %s" e+ logCrypto WARNING $ printf "Error when fetching crypto price: %s" (show e) modifyMVar backoffVar $ \current -> return (min (current * 2) delay, current) return $ CryptoPriceChannel (chan, var) -getLatestPrice :: MonadIO m => T.Text -> T.Text -> m (Maybe Double)+getLatestPrice :: MonadIO m => Text -> Text -> m (Maybe Double) getLatestPrice tokenId inCurrency = do let uri = printf "https://api.coingecko.com/api/v3/simple/price?ids=%s&vs_currencies=%s" tokenId inCurrency
src/System/Taffybar/Information/EWMHDesktopInfo.hs view
@@ -61,7 +61,7 @@ , withEWMHIcons ) where -import Control.Applicative+import Control.Monad ((>=>)) import Control.Monad.IO.Class import Control.Monad.Trans.Class import Data.List@@ -74,11 +74,9 @@ import Foreign.Ptr import Foreign.Storable import System.Log.Logger-import System.Taffybar.Information.SafeX11 hiding (logHere)+import System.Taffybar.Information.SafeX11 import System.Taffybar.Information.X11DesktopInfo -import Prelude- logHere :: MonadIO m => Priority -> String -> m () logHere p = liftIO . logM "System.Taffybar.Information.EWMHDesktopInfo" p @@ -232,7 +230,7 @@ -- point will not be executed, after the call to 'withEWMHIcons' completes. withEWMHIcons :: EWMHIconData -> ([EWMHIcon] -> IO a) -> IO a withEWMHIcons (fptr, size) action =- withForeignPtr fptr ((>>= action) . parseIcons size)+ withForeignPtr fptr (parseIcons size >=> action) -- | Split icon raw integer data into EWMHIcons. Each icon raw data is an -- integer for width, followed by height, followed by exactly (width*height)@@ -263,7 +261,7 @@ -- | Get the window that currently has focus if such a window exists. getActiveWindow :: X11Property (Maybe X11Window)-getActiveWindow = listToMaybe . filter (> 0) <$> readAsListOfWindow Nothing ewmhActiveWindow+getActiveWindow = find (> 0) <$> readAsListOfWindow Nothing ewmhActiveWindow -- | Return a list of all @X11Window@s, sorted by initial mapping order, oldest to newest. getWindows :: X11Property [X11Window]
src/System/Taffybar/Information/Network.hs view
@@ -16,7 +16,6 @@ module System.Taffybar.Information.Network where -import Control.Applicative import qualified Control.Concurrent.MVar as MV import Control.Exception (catch, SomeException) import Control.Monad@@ -29,8 +28,6 @@ import System.Taffybar.Information.StreamInfo ( getParsedInfo ) import System.Taffybar.Util -import Prelude- networkInfoFile :: FilePath networkInfoFile = "/proc/net/dev" @@ -103,7 +100,7 @@ let speedInfo = map sampleToSpeeds samples onUpdate speedInfo return samples- doUpdate = MV.modifyMVar_ samplesVar ((>>= doOnUpdate) . updateSamples)+ doUpdate = MV.modifyMVar_ samplesVar (updateSamples >=> doOnUpdate) foreverWithDelay interval doUpdate updateSamples ::
src/System/Taffybar/Information/SafeX11.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving, FlexibleInstances, InterruptibleFFI, ExistentialQuantification, DeriveDataTypeable #-}+{-# OPTIONS_GHC -Wno-orphans #-}+ ----------------------------------------------------------------------------- -- | -- Module : System.Taffybar.Information.SafeX11@@ -13,7 +15,13 @@ module System.Taffybar.Information.SafeX11 ( module Graphics.X11.Xlib , module Graphics.X11.Xlib.Extras- , module System.Taffybar.Information.SafeX11+ , getWMHints+ , getWindowProperty8+ , getWindowProperty16+ , getWindowProperty32+ , postX11RequestSyncDef+ , rawGetWindowPropertyBytes+ , safeGetGeometry ) where @@ -32,7 +40,6 @@ hiding (rawGetWindowProperty, getWindowProperty8, getWindowProperty16, getWindowProperty32, xGetWMHints, getWMHints, refreshKeyboardMapping)-import Prelude import System.IO.Unsafe import System.Log.Logger import System.Timeout
src/System/Taffybar/Information/X11DesktopInfo.hs view
@@ -9,42 +9,54 @@ -- Portability : unportable -- -- Low-level functions to access data provided by the X11 desktop via window--- properties. One of them ('getVisibleTags') depends on the PagerHints hook+-- properties. One of them ('getVisibleTags') depends on the+-- 'XMonad.Hooks.TaffybarPagerHints.pagerHints' hook -- being installed in your @~\/.xmonad\/xmonad.hs@ configuration: ----- > import System.Taffybar.Support.PagerHints (pagerHints)+-- > import XMonad.Hooks.TaffybarPagerHints (pagerHints) -- > -- > main = xmonad $ ewmh $ pagerHints $ ... -- ----------------------------------------------------------------------------- module System.Taffybar.Information.X11DesktopInfo- ( X11Context(..)+ ( -- * Context+ X11Context(..)+ , getDefaultCtx+ , withDefaultCtx++ -- * Properties , X11Property- , X11Window- , doLowerWindow++ -- ** Event loop , eventLoop- , fetch- , getAtom- , getDefaultCtx++ -- ** Context getters , getDisplay- , getPrimaryOutputNumber- , getVisibleTags- , isWindowUrgent- , postX11RequestSyncProp+ , getAtom++ -- ** Basic properties of windows+ , X11Window+ , PropertyFetcher+ , fetch , readAsInt , readAsListOfInt , readAsListOfString , readAsListOfWindow , readAsString++ -- ** Getters+ , isWindowUrgent+ , getPrimaryOutputNumber+ , getVisibleTags++ -- ** Operations+ , doLowerWindow+ , postX11RequestSyncProp , sendCommandEvent , sendWindowEvent- , withDefaultCtx ) where -import Data.List-import Data.Maybe- import Codec.Binary.UTF8.String as UTF8 import qualified Control.Concurrent.MVar as MV import Control.Monad@@ -52,28 +64,28 @@ import Control.Monad.Trans.Class import Control.Monad.Trans.Reader import Data.Bits (testBit, (.|.))+import Data.List (elemIndex) import Data.List.Split (endBy)-import Graphics.X11.Xlib-import Graphics.X11.Xlib.Extras- hiding (getWindowProperty8, getWindowProperty32, getWMHints)-import Graphics.X11.Xrandr-import Safe-import System.Taffybar.Information.SafeX11--import Prelude+import Data.Maybe (fromMaybe, listToMaybe)+import Graphics.X11.Xrandr (XRRScreenResources(..), XRROutputInfo(..), xrrGetOutputInfo, xrrGetScreenResources, xrrGetOutputPrimary)+import System.Taffybar.Information.SafeX11 hiding (displayName) +-- | Represents a connection to an X11 display.+-- Use 'getDefaultCtx' to construct one of these. data X11Context = X11Context { contextDisplay :: Display , _contextRoot :: Window , atomCache :: MV.MVar [(String, Atom)] } +-- | 'IO' actions with access to an 'X11Context'. type X11Property a = ReaderT X11Context IO a type X11Window = Window-type PropertyFetcher a = Display -> Atom -> Window -> IO (Maybe [a])+type PropertyFetcher a = Display -> Atom -> X11Window -> IO (Maybe [a]) --- | Put the current display and root window objects inside a Reader transformer--- for further computation.+-- | Makes a connection to the default X11 display using+-- 'getDefaultCtx' and puts the current display and root window+-- objects inside a 'ReaderT' transformer for further computation. withDefaultCtx :: X11Property a -> IO a withDefaultCtx fun = do ctx <- getDefaultCtx@@ -81,7 +93,8 @@ closeDisplay (contextDisplay ctx) return res --- | An X11Property that returns the @Display@ object stored in the X11Context.+-- | An X11Property that returns the 'Display' object stored in the+-- 'X11Context'. getDisplay :: X11Property Display getDisplay = contextDisplay <$> ask @@ -91,7 +104,7 @@ -> String -> X11Property b doRead def transform windowPropFn window name =- (fromMaybe def) . (fmap transform) <$> fetch windowPropFn window name+ maybe def 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,@@ -99,7 +112,7 @@ readAsInt :: Maybe X11Window -- ^ window to read from. Nothing means the root window. -> String -- ^ name of the property to retrieve -> X11Property Int-readAsInt = doRead (-1) (maybe (-1) fromIntegral . headMay) getWindowProperty32+readAsInt = doRead (-1) (maybe (-1) fromIntegral . listToMaybe) 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@@ -141,14 +154,15 @@ hints <- fetchWindowHints window return $ testBit (wmh_flags hints) urgencyHintBit --- | Retrieve the value of the special _XMONAD_VISIBLE_WORKSPACES hint set by--- the PagerHints hook provided by Taffybar (see module documentation for--- instructions on how to do this), or an empty list of strings if the--- PagerHints hook is not available.+-- | Retrieve the value of the special @_XMONAD_VISIBLE_WORKSPACES@+-- hint set by the 'XMonad.Hooks.TaffybarPagerHints.pagerHints' hook+-- provided by [xmonad-contrib]("XMonad.Hooks.TaffybarPagerHints")+-- (see module documentation for instructions on how to do this), or+-- an empty list of strings if the @pagerHints@ hook is not available. getVisibleTags :: X11Property [String] getVisibleTags = readAsListOfString Nothing "_XMONAD_VISIBLE_WORKSPACES" --- | Return the Atom with the given name.+-- | Return the 'Atom' with the given name. getAtom :: String -> X11Property Atom getAtom s = do (X11Context d _ cacheVar) <- ask@@ -184,14 +198,18 @@ (X11Context dpy root _) <- ask sendCustomEvent dpy cmd arg root root --- | Similar to 'sendCommandEvent', but with an argument of type Window.+-- | Similar to 'sendCommandEvent', but with an argument of type 'X11Window'. sendWindowEvent :: Atom -> X11Window -> X11Property () sendWindowEvent cmd win = do (X11Context dpy root _) <- ask sendCustomEvent dpy cmd cmd root win --- | Build a new @X11Context@ containing the current X11 display and its root--- window.+-- | Builds a new 'X11Context' containing a connection to the default+-- X11 display and its root window.+--+-- If the X11 connection could not be opened, it will throw+-- @'Control.Exception.userError' "openDisplay"@. This can occur if the+-- @X -maxclients@ limit has been exceeded. getDefaultCtx :: IO X11Context getDefaultCtx = do d <- openDisplay ""@@ -241,14 +259,14 @@ let action = runReaderT prop c lift $ postX11RequestSyncDef def action --- | X11Property which reflects whether or not the provided RROutput is active.+-- | 'X11Property' which reflects whether or not the provided 'RROutput' is active. isActiveOutput :: XRRScreenResources -> RROutput -> X11Property Bool isActiveOutput sres output = do (X11Context display _ _) <- ask maybeOutputInfo <- liftIO $ xrrGetOutputInfo display sres output return $ maybe 0 xrr_oi_crtc maybeOutputInfo /= 0 --- | Return all the active RR outputs.+-- | Return all the active RANDR outputs. getActiveOutputs :: X11Property [RROutput] getActiveOutputs = do (X11Context display rootw _) <- ask@@ -264,7 +282,7 @@ outputs <- getActiveOutputs return $ primary `elemIndex` outputs --- | Move the X11Windows to the bottom of the X11 window stack.+-- | Move the given 'X11Window' to the bottom of the X11 window stack. doLowerWindow :: X11Window -> X11Property () doLowerWindow window = asks contextDisplay >>= lift . flip lowerWindow window
src/System/Taffybar/Information/XDG/Protocol.hs view
@@ -36,7 +36,6 @@ import Data.Maybe import qualified Debug.Trace as D import GHC.IO.Encoding-import Prelude import Safe (headMay) import System.Directory import System.Environment
src/System/Taffybar/LogFormatter.hs view
@@ -16,9 +16,6 @@ import System.Log.Logger import Text.Printf import System.IO-import Data.Monoid--import Prelude setColor :: Color -> String setColor color = setSGRCode [SetColor Foreground Vivid color]
src/System/Taffybar/SimpleConfig.hs view
@@ -18,6 +18,7 @@ , simpleDyreTaffybar , simpleTaffybar , toTaffyConfig+ , toTaffybarConfig , useAllMonitors , usePrimaryMonitor , StrutSize(..)@@ -125,10 +126,14 @@ newtype SimpleBarConfigs = SimpleBarConfigs (MV.MVar [(Int, BC.BarConfig)]) +{-# DEPRECATED toTaffyConfig "Use toTaffybarConfig instead" #-}+toTaffyConfig :: SimpleTaffyConfig -> BC.TaffybarConfig+toTaffyConfig = toTaffybarConfig+ -- | Convert a 'SimpleTaffyConfig' into a 'BC.TaffybarConfig' that can be used -- with 'startTaffybar' or 'dyreTaffybar'.-toTaffyConfig :: SimpleTaffyConfig -> BC.TaffybarConfig-toTaffyConfig conf =+toTaffybarConfig :: SimpleTaffyConfig -> BC.TaffybarConfig+toTaffybarConfig conf = def { BC.getBarConfigsParam = configGetter , BC.cssPaths = cssPaths conf@@ -159,11 +164,11 @@ -- | Start taffybar using dyre with a 'SimpleTaffybarConfig'. simpleDyreTaffybar :: SimpleTaffyConfig -> IO ()-simpleDyreTaffybar conf = dyreTaffybar $ toTaffyConfig conf+simpleDyreTaffybar conf = dyreTaffybar $ toTaffybarConfig conf -- | Start taffybar with a 'SimpleTaffybarConfig'. simpleTaffybar :: SimpleTaffyConfig -> IO ()-simpleTaffybar conf = startTaffybar $ toTaffyConfig conf+simpleTaffybar conf = startTaffybar $ toTaffybarConfig conf getMonitorCount :: IO Int getMonitorCount =
src/System/Taffybar/Support/PagerHints.hs view
@@ -5,7 +5,7 @@ -- License : BSD3-style (see LICENSE) -- -- Maintainer : José A. Romero L. <escherdragon@gmail.com>--- Stability : unstable+-- Stability : deprecated -- Portability : unportable -- -- Complements the "XMonad.Hooks.EwmhDesktops" with two additional hints@@ -30,11 +30,12 @@ -- ----------------------------------------------------------------------------- -module System.Taffybar.Support.PagerHints (+module System.Taffybar.Support.PagerHints+ {-# DEPRECATED "Use XMonad.Hooks.TaffybarPagerHints instead" #-} ( -- * Usage -- $usage pagerHints-) where+ ) where import Codec.Binary.UTF8.String (encode) import Control.Monad
src/System/Taffybar/Util.hs view
@@ -11,7 +11,43 @@ -- Portability : unportable ----------------------------------------------------------------------------- -module System.Taffybar.Util where+module System.Taffybar.Util (+ -- * Configuration+ taffyStateDir+ -- * GTK concurrency+ , module Gtk+ -- * GLib+ , catchGErrorsAsLeft+ -- * Logging+ , logPrintF+ -- * Text+ , truncateString+ , truncateText+ -- * Resources+ , downloadURIToPath+ , getPixbufFromFilePath+ , safePixbufNewFromFile+ -- * Logic Combinators+ , (<||>)+ , (<|||>)+ , forkM+ , ifM+ , anyM+ , maybeTCombine+ , maybeToEither+ -- * Control+ , foreverWithVariableDelay+ , foreverWithDelay+ -- * Process control+ , runCommand+ , onSigINT+ -- * Deprecated+ , logPrintFDebug+ , liftReader+ , liftActionTaker+ , (??)+ , runCommandFromPath+ ) where import Conduit import Control.Applicative@@ -24,17 +60,19 @@ import Data.Either.Combinators import Data.GI.Base.GError import Control.Exception.Enclosed (catchAny)-import qualified Data.GI.Gtk.Threading as Gtk+import Data.GI.Gtk.Threading as Gtk (postGUIASync, postGUISync) import Data.Maybe+import Data.IORef (newIORef, readIORef, writeIORef) import qualified Data.Text as T import Data.Tuple.Sequence import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk import Network.HTTP.Simple import System.Directory import System.Environment.XDG.BaseDir-import System.Exit (ExitCode (..))+import System.Exit (ExitCode (..), exitWith) import System.FilePath.Posix import System.Log.Logger+import System.Posix.Signals (Signal, Handler(..), installHandler, sigINT) import qualified System.Process as P import Text.Printf @@ -42,10 +80,9 @@ taffyStateDir :: IO FilePath taffyStateDir = getUserDataDir "taffybar" -liftReader ::- Monad m => (m1 a -> m b) -> ReaderT r m1 a -> ReaderT r m b-liftReader modifier action =- ask >>= lift . modifier . runReaderT action+{-# DEPRECATED liftReader "Use Control.Monad.Trans.Reader.mapReaderT instead" #-}+liftReader :: Monad m => (m1 a -> m b) -> ReaderT r m1 a -> ReaderT r m b+liftReader = mapReaderT logPrintF :: (MonadIO m, Show t)@@ -53,6 +90,7 @@ logPrintF logPath priority format toPrint = liftIO $ logM logPath priority $ printf format $ show toPrint +{-# DEPRECATED logPrintFDebug "Use logPrintF instead" #-} logPrintFDebug :: (MonadIO m, Show t) => String -> String -> t -> m () logPrintFDebug path = logPrintF path DEBUG @@ -60,6 +98,7 @@ (??) :: Functor f => f (a -> b) -> a -> f b fab ?? a = fmap ($ a) fab {-# INLINE (??) #-}+{-# DEPRECATED (??) "Use @f <*> pure a@ instead" #-} ifM :: Monad m => m Bool -> m a -> m a -> m a ifM cond whenTrue whenFalse =@@ -81,10 +120,10 @@ | T.length incoming <= n = incoming | otherwise = T.append (T.take n incoming) "…" -runCommandFromPath :: MonadIO m => [String] -> m (Either String String)-runCommandFromPath = runCommand "/usr/bin/env"- -- | Run the provided command with the provided arguments.+--+-- If the command filename does not contain a slash, then the @PATH@+-- environment variable is searched for the executable. runCommand :: MonadIO m => FilePath -> [String] -> m (Either String String) runCommand cmd args = liftIO $ do (ecode, stdout, stderr) <- P.readProcessWithExitCode cmd args ""@@ -94,6 +133,10 @@ ExitSuccess -> Right stdout ExitFailure exitCode -> Left $ printf "Exit code %s: %s " (show exitCode) stderr +{-# DEPRECATED runCommandFromPath "Use runCommand instead" #-}+runCommandFromPath :: MonadIO m => FilePath -> [String] -> m (Either String String)+runCommandFromPath = runCommand+ -- | Execute the provided IO action at the provided interval. foreverWithDelay :: (MonadIO m, RealFrac d) => d -> IO () -> m ThreadId foreverWithDelay delay action =@@ -170,12 +213,6 @@ runConduitRes (httpSource uri getResponseBody .| sinkFile filepath) where (directory, _) = splitFileName filepath -postGUIASync :: IO () -> IO ()-postGUIASync = Gtk.postGUIASync--postGUISync :: IO () -> IO ()-postGUISync = Gtk.postGUISync- anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool anyM _ [] = return False anyM p (x:xs) = do@@ -183,3 +220,37 @@ if q then return True else anyM p xs++-- | Installs a useful posix signal handler for 'sigINT' (i.e. Ctrl-C)+-- for cases when the 'Control.Exception.UserInterrupt' exception gets+-- swallowed within a main loop, preventing the program from exiting.+--+-- The given callback should be a command which causes the main loop+-- action to exit. For example:+--+-- > Gtk.main `onSigINT` Gtk.mainQuit+--+-- If the signal handler was invoked, the program will exit with+-- status 130 after the main loop action returns.+onSigINT+ :: IO a -- ^ The main loop 'IO' action+ -> IO () -- ^ Callback for @SIGINT@+ -> IO a+onSigINT action callback = do+ exitStatus <- newIORef Nothing++ let intHandler = do+ writeIORef exitStatus (Just (ExitFailure 130))+ callback++ withSigHandler sigINT (CatchOnce intHandler) $ do+ res <- action+ readIORef exitStatus >>= mapM_ exitWith+ pure res++-- | Install a handler for the given signal, run an 'IO' action, then+-- restore the original handler.+withSigHandler :: Signal -> Handler -> IO a -> IO a+withSigHandler sig h = bracket (install h) install . const+ where+ install handler = installHandler sig handler Nothing
src/System/Taffybar/Widget/Battery.hs view
@@ -22,7 +22,6 @@ , textBatteryNewWithLabelAction ) where -import Control.Applicative import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Reader@@ -30,7 +29,6 @@ import Data.Int (Int64) import qualified Data.Text as T import GI.Gtk as Gtk-import Prelude import StatusNotifier.Tray (scalePixbufToSize) import System.Taffybar.Context import System.Taffybar.Information.Battery
src/System/Taffybar/Widget/FreedesktopNotifications.hs view
@@ -38,7 +38,6 @@ import Data.Foldable import Data.Int ( Int32 ) import Data.Map ( Map )-import Data.Monoid import Data.Sequence ( Seq, (|>), viewl, ViewL(..) ) import qualified Data.Sequence as S import Data.Text ( Text )@@ -48,8 +47,6 @@ import GI.Gtk import qualified GI.Pango as Pango import System.Taffybar.Util--import Prelude -- | A simple structure representing a Freedesktop notification data Notification = Notification
src/System/Taffybar/Widget/Generic/Graph.hs view
@@ -24,15 +24,13 @@ import Control.Monad ( when ) import Control.Monad.IO.Class import Data.Default ( Default(..) )-import Data.Foldable ( mapM_ )-import Data.Sequence ( Seq, (<|), viewl, ViewL(..) )+import Data.Sequence ( Seq(..), (<|), viewl, ViewL(..) ) import qualified Data.Sequence as S import qualified Data.Text as T import qualified GI.Cairo.Render as C import GI.Cairo.Render.Connector import qualified GI.Cairo.Render.Matrix as M import qualified GI.Gtk as Gtk-import Prelude hiding ( mapM_ ) import System.Taffybar.Util import System.Taffybar.Widget.Util @@ -172,13 +170,13 @@ C.transform $ M.Matrix (-1) 0 0 1 (fromIntegral w) 0 let pctToY pct = fromIntegral h * (1 - pct)- renderDataSet hist color style- | S.length hist <= 1 = return ()- | otherwise = do+ renderDataSet hist color style = case viewl hist of+ EmptyL -> return ()+ _oneSample :< Empty -> return ()+ newestSample :< hist' -> do let (r, g, b, a) = color originY = pctToY newestSample originX = 0- newestSample :< hist' = viewl hist C.setSourceRGBA r g b a C.moveTo originX originY
src/System/Taffybar/Widget/Generic/Icon.hs view
@@ -10,7 +10,7 @@ import Control.Concurrent ( forkIO, threadDelay ) import qualified Data.Text as T import Control.Exception as E-import Control.Monad ( forever )+import Control.Monad ( forever, void ) import Control.Monad.IO.Class import GI.Gtk import System.Taffybar.Util@@ -28,10 +28,10 @@ -- > iconWidgetNewFromName name -- -- returns a widget with the icon named @name@. Icon--- names are sourced from the current GTK theme. +-- names are sourced from the current GTK theme. iconImageWidgetNewFromName :: MonadIO m => T.Text -> m Widget-iconImageWidgetNewFromName name = liftIO $ - imageNewFromIconName (Just name) (fromIntegral $ fromEnum IconSizeMenu) +iconImageWidgetNewFromName name = liftIO $+ imageNewFromIconName (Just name) (fromIntegral $ fromEnum IconSizeMenu) >>= putInBox -- | Create a new widget that updates itself at regular intervals. The@@ -73,16 +73,16 @@ -> Double -- ^ Update interval (in seconds) -> IO T.Text -- ^ Command to run update the icon name -> m Widget-pollingIconImageWidgetNewFromName name interval cmd = +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 +-- | Creates a polling icon.+pollingIcon :: MonadIO m => Double -- ^ Update Interval (in seconds)- -> IO name -- ^ IO action that updates image's icon-name/filepath + -> 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.@@ -93,7 +93,7 @@ _ <- forkIO $ forever $ do let tryUpdate = liftIO $ do name' <- doUpdateName- postGUIASync $ doSetImage image name' >> return ()+ postGUIASync $ void $ doSetImage image name' E.catch tryUpdate ignoreIOException threadDelay $ floor (interval * 1000000) return ()
src/System/Taffybar/Widget/Layout.hs view
@@ -37,10 +37,10 @@ -- $usage ----- This widget requires that the "System.Taffybar.Support.PagerHints" hook be+-- This widget requires that the "XMonad.Hooks.TaffybarPagerHints" hook be -- installed in your @xmonad.hs@: ----- > import System.Taffybar.Support.PagerHints (pagerHints)+-- > import XMonad.Hooks.TaffybarPagerHints (pagerHints) -- > main = do -- > xmonad $ ewmh $ pagerHints $ defaultConfig -- > ...@@ -79,7 +79,7 @@ -- This callback is run in a separate thread and needs to use -- postGUIASync- let callback _ = liftReader postGUIASync $ do+ let callback _ = mapReaderT postGUIASync $ do layout <- runX11Def "" $ readAsString Nothing xLayoutProp markup <- formatLayout config (T.pack layout) lift $ Gtk.labelSetMarkup label markup
src/System/Taffybar/Widget/SimpleClock.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} module System.Taffybar.Widget.SimpleClock ( textClockNew@@ -92,21 +90,6 @@ instance Default ClockConfig where def = defaultClockConfig -systemGetTZ :: IO TimeZone-systemGetTZ = setTZ >> getCurrentTimeZone---- | Old versions of time do not call localtime_r properly. We set the time zone--- manually, if required.-setTZ :: IO ()-#if MIN_VERSION_time(1, 4, 2)-setTZ = return ()-#else-setTZ = c_tzsetp--foreign import ccall unsafe "time.h tzset"- c_tzset :: IO ()-#endif- -- | A configurable text-based clock widget. It currently allows for -- a configurable time zone through the 'ClockConfig'. --@@ -118,7 +101,7 @@ , clockFormatString = formatString , clockUpdateStrategy = updateStrategy } = liftIO $ do- let getTZ = maybe systemGetTZ return userZone+ let getTZ = maybe getCurrentTimeZone return userZone locale = fromMaybe L.defaultTimeLocale userLocale let getUserZonedTime =@@ -162,4 +145,3 @@ toggleCalendar label cal widgetShowAll ebox toWidget ebox-
src/System/Taffybar/Widget/SimpleCommandButton.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- -- | -- Module : System.Taffybar.Widget.SimpleCommandButton@@ -18,6 +17,7 @@ simpleCommandButtonNew) where +import Control.Monad (void) import Control.Monad.IO.Class import GI.Gtk import System.Process@@ -42,6 +42,5 @@ -> m Widget simpleCommandButtonNew txt cmd = do button <- buttonNewWithLabel txt- _ <- onButtonClicked button $ spawnCommand (T.unpack cmd) >> return ()+ void $ onButtonClicked button $ void $ spawnCommand $ T.unpack cmd toWidget button-
src/System/Taffybar/Widget/Text/CPUMonitor.hs view
@@ -19,11 +19,11 @@ where callback = do (userLoad, systemLoad, totalLoad) <- cpuLoad- let [userLoad', systemLoad', totalLoad'] = map (formatPercent.(*100)) [userLoad, systemLoad, totalLoad]+ let pct = formatPercent . (* 100) let template = ST.newSTMP fmt- let template' = ST.setManyAttrib [ ("user", userLoad'),- ("system", systemLoad'),- ("total", totalLoad') ] template+ let template' = ST.setManyAttrib [ ("user", pct userLoad),+ ("system", pct systemLoad),+ ("total", pct totalLoad) ] template return $ ST.render template' formatPercent :: Double -> String
src/System/Taffybar/Widget/Util.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module : System.Taffybar.Widget.Util@@ -132,7 +132,7 @@ getImageForMaybeIconName :: Maybe T.Text -> Int32 -> IO (Maybe GI.Pixbuf) getImageForMaybeIconName mIconName size =- join <$> sequenceA (flip getImageForIconName size <$> mIconName)+ join <$> traverse (`getImageForIconName` size) mIconName getImageForIconName :: T.Text -> Int32 -> IO (Maybe GI.Pixbuf) getImageForIconName iconName size =
src/System/Taffybar/Widget/Windows.hs view
@@ -79,7 +79,7 @@ subscription <- subscribeToPropertyEvents [ewmhActiveWindow, ewmhWMName, ewmhWMClass] activeWindowUpdatedCallback- _ <- liftReader (\x -> Gtk.onWidgetUnrealize label x) (unsubscribe subscription)+ _ <- mapReaderT (Gtk.onWidgetUnrealize label) (unsubscribe subscription) context <- ask
src/System/Taffybar/Widget/Workspaces.hs view
@@ -13,7 +13,6 @@ module System.Taffybar.Widget.Workspaces where -import Control.Applicative import Control.Arrow ((&&&)) import Control.Concurrent import qualified Control.Concurrent.MVar as MV@@ -32,7 +31,6 @@ import qualified Data.Map as M import Data.Maybe import qualified Data.MultiMap as MM-import Data.Ord import qualified Data.Set as Set import qualified Data.Text as T import Data.Time.Units@@ -42,7 +40,6 @@ import qualified GI.Gdk.Structs.EventScroll as Gdk import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk import qualified GI.Gtk as Gtk-import Prelude import StatusNotifier.Tray (scalePixbufToSize) import System.Log.Logger import System.Taffybar.Context@@ -283,7 +280,7 @@ hbox <- Gtk.boxNew Gtk.OrientationHorizontal 0 void $ Gtk.widgetGetParent workspaceWidget >>= traverse (unsafeCastTo Gtk.Box) >>=- traverse (flip Gtk.containerRemove workspaceWidget)+ traverse (`Gtk.containerRemove` workspaceWidget) Gtk.containerAdd hbox workspaceWidget Gtk.containerAdd cont hbox @@ -309,7 +306,7 @@ handleConfigureEvents _ = return () (workspaceSubscription, iconSubscription, geometrySubscription) <- flip runReaderT tContext $ sequenceT- ( subscribeToPropertyEvents (updateEvents cfg) $ doUpdate+ ( subscribeToPropertyEvents (updateEvents cfg) doUpdate , subscribeToPropertyEvents [ewmhWMIcon] (lift . onIconChanged iconHandler) , subscribeToAll handleConfigureEvents )@@ -683,8 +680,8 @@ const $ scaledWindowIconPixbufGetter getter constantSize handleIconGetterException :: WindowIconPixbufGetter -> WindowIconPixbufGetter-handleIconGetterException getter =- \size windowData -> catchAny (getter size windowData) $ \e -> do+handleIconGetterException getter size windowData =+ catchAny (getter size windowData) $ \e -> do wLog WARNING $ printf "Failed to get window icon for %s: %s" (show windowData) (show e) return Nothing @@ -744,7 +741,7 @@ let getGeometryWorkspaces w = getDisplay >>= liftIO . (`safeGetGeometry` w) getGeometries = mapM (forkM return- ((((sel2 &&& sel3) <$>) .) getGeometryWorkspaces) .+ (((sel2 &&& sel3) <$>) . getGeometryWorkspaces) . windowId) wins windowGeometries <- liftX11Def [] getGeometries
src/System/Taffybar/WindowIcon.hs view
@@ -29,6 +29,7 @@ import System.Environment.XDG.DesktopEntry import System.Taffybar.Util import System.Taffybar.Widget.Util+import Text.Printf type ColorRGBA = Word32 @@ -100,9 +101,10 @@ -> 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)+ when (length entries > 1) $ liftIO $+ logM "System.Taffybar.WindowIcon" DEBUG $ printf+ "Class \"%s\" has multiple desktop entries: %s"+ klass (intercalate ", " $ map deFilename entries) return $ listToMaybe entries getWindowIconForAllClasses
taffybar.cabal view
@@ -1,26 +1,32 @@+cabal-version: 3.4 name: taffybar-version: 4.0.2+version: 4.0.3 synopsis: A desktop bar similar to xmobar, but with more GUI-license: BSD3+license: BSD-3-Clause license-file: LICENSE author: Ivan Malison maintainer: IvanMalison@gmail.com category: System build-type: Simple-cabal-version: >=1.10-tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2+tested-with: GHC == 9.2.8, GHC == 9.4.8, GHC == 9.6.6, GHC == 9.8.2 homepage: http://github.com/taffybar/taffybar data-files: taffybar.css icons/*.svg extra-source-files:- README.md- CHANGELOG.md 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+ test/data/*.golden+extra-doc-files:+ README.md+ CHANGELOG.md+ doc/*.md +flag Deprecated-Pager-Hints+ description: Enables the deprecated System.Taffybar.Support.PagerHints module, which has been moved to xmonad-contrib.+ library default-extensions: TupleSections@@ -28,7 +34,7 @@ MonoLocalBinds default-language: Haskell2010- build-depends: base > 3 && < 5+ build-depends: base >= 4.15.0.0 && < 5 , HStringTemplate >= 0.8 && < 0.9 , X11 >= 1.5.0.1 , aeson@@ -45,19 +51,17 @@ , either >= 4.0.0.0 , enclosed-exceptions >= 1.0.0.1 , filepath- , gi-cairo , gi-cairo-connector , gi-cairo-render- , gi-gdk- , gi-gdkpixbuf+ , gi-gdk >=3.0.6 && <3.1+ , gi-gdkpixbuf >=2.0.6 && <2.1 , gi-gdkx11 , gi-glib- , gi-gtk- , gi-gtk-hs+ , gi-gtk >= 3.0.26 && < 4+ , gi-gtk-hs >= 0.3.9 && < 0.4 , gi-pango , gtk-sni-tray >= 0.1.8.0 , gtk-strut >= 0.1.2.1- , haskell-gi >= 0.24 , haskell-gi-base >= 0.24 , hslogger , http-conduit@@ -65,13 +69,12 @@ , http-client-tls , http-types , multimap >= 1.2.1- , old-locale , parsec >= 3.1 , process >= 1.0.1.1 , rate-limit >= 1.1.1 , regex-compat , safe >= 0.3 && < 1- , scotty >= 0.11 && < 0.22+ , scotty >= 0.20 && < 0.23 , split >= 0.1.4.2 , status-notifier-item >= 0.3.1.0 , stm@@ -81,7 +84,6 @@ , time-locale-compat >= 0.1 && < 0.2 , time-units >= 1.0.0 , transformers >= 0.3.0.0- , transformers-base >= 0.4 , tuple >= 0.3.0.2 , unix , utf8-string@@ -89,7 +91,6 @@ , xdg-basedir >= 0.2 && < 0.3 , xml , xml-helpers- , xmonad hs-source-dirs: src pkgconfig-depends: gtk+-3.0@@ -116,7 +117,6 @@ , System.Taffybar.Information.XDG.Protocol , System.Taffybar.LogFormatter , System.Taffybar.SimpleConfig- , System.Taffybar.Support.PagerHints , System.Taffybar.Util , System.Taffybar.Widget , System.Taffybar.Widget.Battery@@ -154,6 +154,10 @@ , System.Taffybar.Widget.XDGMenu.MenuWidget , System.Taffybar.WindowIcon + if flag(Deprecated-Pager-Hints)+ build-depends: xmonad+ exposed-modules: System.Taffybar.Support.PagerHints+ other-modules: Paths_taffybar , System.Taffybar.DBus.Client.MPRIS2 , System.Taffybar.DBus.Client.Params@@ -161,12 +165,14 @@ , System.Taffybar.DBus.Client.UPowerDevice , System.Taffybar.DBus.Client.Util + autogen-modules: Paths_taffybar+ cc-options: -fPIC ghc-options: -Wall -funbox-strict-fields -fno-warn-orphans executable taffybar default-language: Haskell2010- build-depends: base > 3 && < 5+ build-depends: base , data-default , directory , hslogger@@ -174,10 +180,29 @@ , taffybar other-modules: Paths_taffybar+ autogen-modules: Paths_taffybar hs-source-dirs: app main-is: Main.hs pkgconfig-depends: gtk+-3.0+ ghc-options: -Wall -rtsopts -threaded++test-suite unit+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: System.Taffybar.AuthSpec+ , System.Taffybar.SpecUtil+ default-language: Haskell2010+ build-depends: base+ , directory+ , filepath+ , hspec+ , hspec-core+ , hspec-golden+ , taffybar+ , temporary+ build-tool-depends: hspec-discover:hspec-discover == 2.* ghc-options: -Wall -rtsopts -threaded source-repository head
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/System/Taffybar/AuthSpec.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}++module System.Taffybar.AuthSpec (spec) where++import Data.List (intercalate)+import System.FilePath ((</>), (<.>))+import Text.Printf (printf)++import Test.Hspec+import Test.Hspec.Core.Spec (getSpecDescriptionPath)+import Test.Hspec.Golden hiding (golden)++import System.Taffybar.Auth+import System.Taffybar.SpecUtil (withMockCommand)++spec :: Spec+spec = aroundAll_ (withMockPass mockDb) $ describe "passGet" $ do+ golden "get a password" $ show <$> passGet "hello"+ golden "get a password with info" $ show <$> passGet "multiline"+ golden "missing entry" $ show <$> passGet "missing"++golden :: String -> IO String -> Spec+golden description runAction = do+ path <- (++ words description) <$> getSpecDescriptionPath+ it description $+ taffybarGolden (intercalate "-" path) <$> runAction++taffybarGolden :: String -> String -> Golden String+taffybarGolden name output = Golden+ { output+ , encodePretty = show+ , writeToFile = writeFile+ , readFromFile = readFile+ , goldenFile = "test/data/" </> name <.> "golden"+ , actualFile = Nothing+ , failFirstTime = True+ }++mockDb :: [MockEntry]+mockDb = [ mockEntry "hello" "xyzzy" []+ , mockEntry "multiline" "secret" [("Username", "fred"), ("silly", "")]+ , fallbackEntry "" "Error: is not in the password store.\n" 1+ ]++withMockPass :: [MockEntry] -> IO a -> IO a+withMockPass db = withMockCommand "pass" (mockScript db)++data MockEntry = MockEntry+ { passName :: String+ , out :: String+ , err :: String+ , status :: Int+ } deriving (Show, Read, Eq)++mockEntry :: String -> String -> [(String, String)] -> MockEntry+mockEntry passName key info =+ MockEntry { passName, out = passFile key info, err = "", status = 0 }++passFile :: String -> [(String, String)] -> String+passFile key info = unlines (key:[k ++ ": " ++ v | (k, v) <- info])++fallbackEntry :: String -> String -> Int -> MockEntry+fallbackEntry out err status = MockEntry { passName = "", .. }++mockScript :: [MockEntry] -> String+mockScript db = unlines ("#!/usr/bin/env bash":map makeEntry db)+ where+ makeEntry MockEntry{..} = printf template passName out err status+ template = unlines+ [ "pass_name='%s'"+ , "if [ -z \"$pass_name\" -o \"$2\" = \"$pass_name\" ]; then"+ , " echo -n '%s'"+ , " >&2 echo '%s'"+ , " exit %d"+ , "fi"+ ]
+ test/System/Taffybar/SpecUtil.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE ViewPatterns #-}++module System.Taffybar.SpecUtil+ ( withMockCommand+ , writeScript+ , withEnv+ , prependPath+ ) where++import Control.Arrow (second)+import Control.Exception (bracket)+import Control.Monad (guard, join)+import Data.List (uncons)+import System.Directory (Permissions (..), findExecutable, getPermissions, setPermissions)+import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.FilePath (isRelative, takeFileName, (</>))+import System.IO.Temp (withSystemTempDirectory)++-- | Run the given 'IO' action with the @PATH@ environment variable+-- set up so that executing the given command name will run a+-- script.+withMockCommand+ :: FilePath -- ^ Name of command - should not contain slashes+ -> String -- ^ Contents of script+ -> IO a -- ^ Action to run with command available in search path+ -> IO a+withMockCommand name content action =+ withSystemTempDirectory "specutil" $ \dir -> do+ writeScript (dir </> takeFileName name) content+ withEnv [("PATH", prependPath dir)] action++-- | Write a text file, make it executable.+-- It ought to have a shebang line.+writeScript :: FilePath -> String -> IO ()+writeScript scriptFile content = do+ content' <- patchShebangs content+ writeFile scriptFile content'+ p <- getPermissions scriptFile+ setPermissions scriptFile (p { executable = True })++-- | Given the text of a shell script, this replaces any relative path+-- in the shebang with an absolute path, according to the current+-- environment's @PATH@ variable.+--+-- The only reason this exists is so that we can generate shell+-- scripts containing @#!/usr/bin/env bash@ and then be able to+-- execute them within a Nix build sandbox (which does not allow+-- @/usr/bin/env@).+patchShebangs :: String -> IO String+patchShebangs = patchShebangs' findExe+ where+ findExe = fmap join . traverse findExecutable . takeRelativeFileName++ takeRelativeFileName :: FilePath -> Maybe FilePath+ takeRelativeFileName fp = guard (isRelative fp) >> pure (takeFileName fp)++patchShebangs' :: Applicative m => (FilePath -> m (Maybe FilePath)) -> String -> m String+patchShebangs' replaceExe script = case parseInterpreter script of+ Just (interpreter, rest) -> do+ let unparse exe = "#! " ++ exe ++ rest+ maybe script unparse <$> replaceExe interpreter+ Nothing -> pure script++parseInterpreter :: String -> Maybe (String, String)+parseInterpreter (lines -> content) = do+ (header, rest) <- uncons content+ (interpreter, args) <- parseShebang header+ pure (interpreter, unlines (args:rest))++ where+ parseShebang :: String -> Maybe (String, String)+ parseShebang ('#':'!':(findInterpreter -> shebang)) =+ let catArgs args = unwords ("":args)+ in second catArgs <$> shebang+ parseShebang _ = Nothing++ findInterpreter = uncons . dropWhile ((== "env") . takeFileName) . words++-- | Run an 'IO' action with the given environment variables set up+-- according to their current value. 'Nothing' denotes an unset+-- environment variable. After the 'IO' action completes, environment+-- variables are restored to their previous state.+withEnv :: [(String, Maybe String -> Maybe String)] -> IO a -> IO a+withEnv mods = bracket setup teardown . const+ where+ setup = mapM (uncurry changeEnv) mods+ teardown = mapM (uncurry putEnv) . reverse++ changeEnv name f = do+ old <- lookupEnv name+ putEnv name (f old)+ pure (name, old)++ putEnv :: String -> Maybe String -> IO ()+ putEnv name = maybe (unsetEnv name) (setEnv name)++-- | Use this as a modifier function argument of 'withEnv' to ensure+-- that the given directory is prepended to a search path variable.+prependPath :: FilePath -> Maybe String -> Maybe String+prependPath p = Just . (++ ":/usr/bin") . (p ++) . maybe "" (":" ++)
+ test/data/System.Taffybar.Auth-passGet-get-a-password-with-info.golden view
@@ -0,0 +1,1 @@+Right ("secret",[("Username","fred"),("silly","")])
+ test/data/System.Taffybar.Auth-passGet-get-a-password.golden view
@@ -0,0 +1,1 @@+Right ("xyzzy",[])
+ test/data/System.Taffybar.Auth-passGet-missing-entry.golden view
@@ -0,0 +1,1 @@+Left "Exit code 1: Error: is not in the password store.\n\n "