Commit 476376a5b31d5dbfb7cf1b56f784ac24c2861909 - xmobar

+3

-0

.gitignore less more

16	16	*.swp
17	17	tags
18	18	/cabal.project.local
	19	/.ghc.environment.*
	20	/cabal.project.local~
	21	/stack.yaml.lock

+10

-2

.travis.yml less more

0	0	language: haskell
1	1
2	2	dist: xenial
	3
	4	apt:
	5	update: true
	6	sources:
	7	- hvr-ghc
	8	packages: cabal-install-2.2
3	9
4	10	ghc:
5	11	- 8.0
6	12	- 8.2
7	13	- 8.4
8	14	- 8.6
	15	- 8.8
9	16
10	17	before_install:
11	18	- sudo apt-get -qq update
12	19	- sudo apt-get install -y libiw-dev libasound2-dev libxpm-dev libmpd-dev
13	20	- sudo apt-get install -y libxrandr-dev
14	21	- sudo apt-get install -y happy c2hs
	22	- export PATH=/opt/ghc/bin:$PATH
15	23
16	24	install:
17		- cabal install --only-dependencies --enable-tests -fall_extensions
	25	- travis_wait 30 cabal install --only-dependencies --enable-tests -fall_extensions
18	26	- wget https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh
19	27
20	28	script:
21		- sh ./travis.sh src
	29	# - sh ./travis.sh src
22	30	- cabal configure --enable-tests -fall_extensions && cabal build && cabal test

+62

-1

changelog.md less more

	0	## Version 0.33 (February, 2020)
	1
	2	_New features_
	3
	4	- New template parameter `<weather>` for the `Weather` plugin, potentially
	5	displaying specific weather conditions that are occurring near the
	6	station (thanks to slotThe).
	7	- New option `--weathers`, for `Weather` to display a default string in
	8	case the `weather` field is not reported (thanks to slotThe).
	9	- New template parameter `<volumestatus>` for the `Volume` plugin, combining
	10	the effects of `<volume>` and `<status>`. This will show the volume
	11	(possibly prefixed by `onString` or a percentage-based string) if and only
	12	if the volume is not muted. Otherwise it will show the
	13	`offString` (thanks to slotThe).
	14	- `Battery` and `BatteryN` now support FreeBSD (thanks to Dhananjay
	15	Balan).
	16	- New option `--useManager` for `Weather` and `UVMeter` to decide whether to
	17	use one single manager per monitor for managing network connections or
	18	create a new one every time a connection is made.
	19	- New more efficient time coalescing strategy for monitor updates,
	20	available with the threaded runtime: use the `with_threaded` flag
	21	to enable it (see #410; thanks to Tomáš Janoušek).
	22	- `Wireless` supports current nl80211 API on Linux now, old Wext ioctls still
	23	available as compile-time option (thanks to Paul Fertser).
	24
	25	## Version 0.32 (December, 2019)
	26
	27	_New features_
	28
	29	- New options `--host` and `--port` for `MPD` monitor.
	30	- New plugin `MailX` extending `Mail` with colors and prefix/suffix.
	31	- New options `--lows`, `--mediums`, and `--highs` for `Battery`
	32	to display an additional string depending on battery level (thanks
	33	to slotThe).
	34	- New options `-L` and `-H` for `Volume` to set low and high volume
	35	levels, as well as `-l`, `-m`, and `-h` to display an additional
	36	string depending on current volume level (thanks to slotThe).
	37	- New option `-P` in `Battery` to add a `%` symbol to `<left>`.
	38	- New option `--devices` in `DynNetwork` to select what interfaces
	39	to monitor (thanks to vindex10).
	40	- DateZone plugin now also checks TZDIR (thanks to Emmanuel Rosa).
	41
	42	_Bug fixes_
	43
	44	- `Kbd` plugin: ignore "terminate" layout token (thanks to Greg
	45	Steuck).
	46	- Fixed compilation with GHC 8.8.x (thanks to Vanessa McHale).
	47	- Avoid creating `~/.xmobar` ([issue #405]).
	48
	49	[issue #405]: https://github.com/jaor/xmobar/issues/405
	50
	51	## Version 0.31 (October, 2019)
	52
	53	_New features_
	54
	55	- New option `--contiguous-icons` for `MultiCpu` to draw icons
	56	without padding (see [issue #388]).
	57	- New version of libmpd (0.9.0.10), thanks to John Tyree
	58
	59	[issue #388]: https://github.com/jaor/xmobar/issues/388
	60
0	61	## Version 0.30 (August, 2019)
1	62
2	63	_New features_
3	64
4	65	- New monitor `MultiCoreTemp`, thanks to Felix Springer.
5	66	- `DiskIO`: Additional template variables for absolute number of
6		bytes rather than speeds (see [issue #390].
	67	bytes rather than speeds (see [issue #390]).
7	68	- `WeatherX`: An extension to the `Weather` monitor allowing the
8	69	spefication of custom strings or icons for sky conditions.
9	70	- The battery monitors accept the new arguments `-a` and `-A` to

+17

-0

examples/build less more

	0	#!/usr/bin/bash
	1
	2	# An example build script that directs ghc to use a temporary directory for its
	3	# intermediate files instead of writing them into XMOBAR_CONFIG_DIR. This
	4	# allows using a read-only XMOBAR_CONFIG_DIR. To use this script, place it in
	5	# XMOBAR_CONFIG_DIR and call it "build".
	6
	7	bin=$1
	8	object_dir=$(mktemp -d)
	9
	10	default_build_args=(--make xmobar.hs -i -ilib -fforce-recomp -main-is main -v0 -o "$bin" -threaded -rtsopts -with-rtsopts -V0) # From src/Xmobar/App/Compile.hs
	11	extra_build_args=(-odir "$object_dir" -hidir "$object_dir")
	12
	13	ghc "${default_build_args[@]}" "${extra_build_args[@]}"
	14	status=$?
	15	rm -r "$object_dir"
	16	exit $status

+147

-65

readme.md less more

116	116	option is needed for the MBox and Mail plugins to work. Requires the
117	117	[hinotify] package.
118	118
119		- `with_iwlib` Support for wireless cards. Enables the Wireless
120		plugin. No Haskell library is required, but you will need the
121		[iwlib] C library and headers in your system (e.g., install
122		`libiw-dev` in Debian-based systems or `wireless_tools` on Arch
123		Linux).
	119	- `with_nl80211` Support for wireless cards on Linux via nl80211 (all
	120	upstream drivers). Enables the Wireless plugin. Requires [netlink]
	121	and [cereal] packages.
	122
	123	- `with_iwlib` Support for wireless cards via Wext ioctls
	124	(deprecated). Enables the Wireless plugin. No Haskell library is
	125	required, but you will need the [iwlib] C library and headers in your
	126	system (e.g., install `libiw-dev` in Debian-based systems or
	127	`wireless_tools` on Arch Linux). Conflicts with `with_nl80211`.
124	128
125	129	- `with_alsa` Support for ALSA sound cards. Enables the Volume
126	130	plugin. Requires the [alsa-mixer] package. To install the latter,

197	201	managers to feed xmobar strings with `<action>` tags mixed with un-trusted
198	202	content (e.g. window titles). For example, if xmobar is invoked as
199	203
200		```xmobar -c "[Run UnsafeStdinReader]" -t "%UnsafeStdinReader%"```
	204	xmobar -c "[Run UnsafeStdinReader]" -t "%UnsafeStdinReader%"
201	205
202	206	and receives on standard input the line
203	207
204		```<action=`echo test` button=1><raw=41:<action=`echo mooo` button=1>foo</action>/></action>```
	208	<action=`echo test` button=1><raw=41:<action=`echo mooo` button=1>foo</action>/></action>`
205	209
206	210	then it will display the text ```<action=`echo mooo` button=1>foo</action>```,
207	211	which, when clicked, will cause `test` to be echoed.

734	738	- Aliases to the Station ID: so `Weather "LIPB" []` can be used in
735	739	template as `%LIPB%`
736	740	- Thresholds refer to temperature in the selected units
737		- Args: default monitor arguments
	741	- Args: default monitor arguments, plus:
	742	- `--weathers` _string_ : display a default string when the `weather`
	743	variable is not reported.
	744	- short option: `-w`
	745	- Default: ""
	746	- `--useManager` _bool_ : Whether to use one single manager per monitor for
	747	managing network connections or create a new one every time a connection is
	748	made.
	749	- Short option: `-m`
	750	- Default: True
738	751	- Variables that can be used with the `-t`/`--template` argument:
739	752	`station`, `stationState`, `year`, `month`, `day`, `hour`,
740	753	`windCardinal`, `windAzimuth`, `windMph`, `windKnots`, `windMs`, `windKmh`
741		`visibility`, `skyCondition`, `tempC`, `tempF`,
	754	`visibility`, `skyCondition`, `weather`, `tempC`, `tempF`,
742	755	`dewPointC`, `dewPointF`, `rh`, `pressure`
743	756	- Default template: `<station>: <tempC>C, rh <rh>% (<hour>)`
744	757	- Retrieves weather information from http://tgftp.nws.noaa.gov.

798	811	- Thresholds are expressed in Kb/s
799	812	- Args: default monitor arguments, plus:
800	813	- `--rx-icon-pattern`: dynamic string for reception rate in `rxipat`.
801		- `--tx-icon-pattern`: dynamic string for transmission rate in `txipat`.
	814	- `--tx-icon-pattern`: dynamic string for transmission rate in `txipat`
	815	- `--devices`: comma-separated list of devices to show.
802	816	- Variables that can be used with the `-t`/`--template` argument:
803	817	`dev`, `rx`, `tx`, `rxbar`, `rxvbar`, `rxipat`, `txbar`, `txvbar`,
804	818	`txipat`. Reception and transmission rates (`rx` and `tx`) are displayed
805	819	in Kbytes per second, and you can set the `-S` to "True" to make them
806	820	displayed with units (the string "Kb/s").
807	821	- Default template: `<dev>: <rx>KB\|<tx>KB`
	822	- Example of usage of `--devices` option: `["--", "--devices", "wlp2s0,enp0s20f41"]`
808	823
809	824	### `Wireless Interface Args RefreshRate`
810	825
811		- If set to "", the interface is looked up in /proc/net/wireless.
	826	- If set to "", first suitable wireless interface is used.
812	827	- Aliases to the interface name with the suffix "wi": thus, `Wireless
813	828	"wlan0" []` can be used as `%wlan0wi%`, and `Wireless "" []` as `%wi%`.
814	829	- Args: default monitor arguments, plus:
815	830	- `--quality-icon-pattern`: dynamic string for connection quality in `qualityipat`.
816	831	- Variables that can be used with the `-t`/`--template` argument:
817		`essid`, `quality`, `qualitybar`, `qualityvbar`, `qualityipat`
818		- Thresholds refer to link quality in a `[0, 100]` scale
819		- Default template: `<essid> <quality>`
820		- Requires the C library [iwlib] (part of the wireless tools suite)
821		installed in your system. In addition, to activate this plugin you
822		must pass `--flags="with_iwlib"` during compilation
	832	`ssid`, `signal`, `quality`, `qualitybar`, `qualityvbar`, `qualityipat`
	833	- Thresholds refer to link quality on a `[0, 100]` scale. Note that
	834	`quality` is calculated from `signal` (in dBm) by a possibly lossy
	835	conversion. It is also not taking into account many factors such as
	836	noise level, air busy time, transcievers' capabilities and the
	837	others which can have drastic impact on the link performance.
	838	- Default template: `<ssid> <quality>`
	839	- To activate this plugin you must pass `--flags="with_nl80211"` or
	840	`--flags="with_iwlib"` during compilation
823	841
824	842	### `Memory Args RefreshRate`
825	843

865	883	corresponds to nth cpu.
866	884	- `--fallback-icon-pattern`: dynamic string used by `autoipat` and `ipat{i}` when no
867	885	`--load-icon-patterns` has been provided for `cpu{i}`
	886	- `--contiguous-icons`: flag (no value needs to be provided) that
	887	causes the load icons to be drawn without padding.
868	888	- Thresholds refer to percentage of CPU load
869	889	- Variables that can be used with the `-t`/`--template` argument:
870	890	`autototal`, `autobar`, `autovbar`, `autoipat`, `autouser`, `autonice`,

908	928	percentage left in the battery is less or equal than the threshold
909	929	given by the `-A` option. If not present, no action is
910	930	undertaken.
	931	- `-P`: to include a percentage symbol in `left`.
911	932	- `--on-icon-pattern`: dynamic string for current battery charge
912	933	when AC is "on" in `leftipat`.
913	934	- `--off-icon-pattern`: dynamic string for current battery charge
914	935	when AC is "off" in `leftipat`.
915	936	- `--idle-icon-pattern`: dynamic string for current battery charge
916	937	when AC is "idle" in `leftipat`.
	938	- `--lows`: string for AC "off" status and power lower than the `-L`
	939	threshold (default: "")
	940	- `--mediums`: string for AC "off" status and power lower than the `-H`
	941	threshold (default: "")
	942	- `--highs`: string for AC "off" status and power higher than the `-H`
	943	threshold (default: "")
	944
917	945
918	946	- Variables that can be used with the `-t`/`--template` argument:
919	947	`left`, `leftbar`, `leftvbar`, `leftipat`, `timeleft`, `watts`, `acstatus`

1145	1173	- `--highd` _number_ High threshold for dB. Defaults to -5.0.
1146	1174	- `--lowd` _number_ Low threshold for dB. Defaults to -30.0.
1147	1175	- `--volume-icon-pattern` _string_ dynamic string for current volume in `volumeipat`.
1148		- Variables that can be used with the `-t`/`--template` argument:
1149		`volume`, `volumebar`, `volumevbar`, `volumeipat`, `dB`, `status`
	1176	- `-H` _number_ High threshold for volume (in %). Defaults to 60.0.
	1177	- Long option: `--highv`
	1178	- `-L` _number_ Low threshold for volume (in %). Defaults to 20.0.
	1179	- Long option: `--lowv`
	1180	- `-h`: _string_ High string
	1181	- The string added in front of `<status>` when the mixer element
	1182	is on and the volume percentage is higher than the `-H` threshold.
	1183	Defaults to "".
	1184	- Long option: `--highs`
	1185	- `-m`: _string_ Medium string
	1186	- The string added in front of `<status>` when the mixer element
	1187	is on and the volume percentage is lower than the `-H` threshold.
	1188	Defaults to "".
	1189	- Long option: `--mediums`
	1190	- `-l`: _string_ Low string
	1191	- The string added in front of `<status>` when the mixer element
	1192	is on and the volume percentage is lower than the `-L` threshold.
	1193	Defaults to "".
	1194	- Long option: `--lows`
	1195	- Variables that can be used with the `-t`/`--template` argument:
	1196	`volume`, `volumebar`, `volumevbar`, `volumeipat`, `dB`, `status`,
	1197	`volumestatus`
1150	1198	- Note that `dB` might only return 0 on your system. This is known
1151	1199	to happen on systems with a pulseaudio backend.
1152	1200	- Default template: `Vol: <volume>% <status>`

1156	1204
1157	1205	### `Alsa Mixer Element Args`
1158	1206
1159		Like [Volume](#volume-mixer-element-args-refreshrate), but with the following differences:
1160		- Uses event-based refreshing via `alsactl monitor` instead of polling, so it will refresh
1161		instantly when there's a volume change, and won't use CPU until a change happens.
1162		- Aliases to `alsa:` followed by the mixer name and element name separated by a colon. Thus,
1163		`Alsa "default" "Master" []` can be used as `%alsa:default:Master%`.
	1207	Like [Volume](#volume-mixer-element-args-refreshrate), but with the
	1208	following differences:
	1209	- Uses event-based refreshing via `alsactl monitor` instead of
	1210	polling, so it will refresh instantly when there's a volume change,
	1211	and won't use CPU until a change happens.
	1212	- Aliases to `alsa:` followed by the mixer name and element name
	1213	separated by a colon. Thus, `Alsa "default" "Master" []` can be used
	1214	as `%alsa:default:Master%`.
1164	1215	- Additional options (after the `--`):
1165	1216	- `--alsactl=/path/to/alsactl`
1166		- If this option is not specified, `alsactl` will be sought in your `PATH`
1167		first, and failing that, at `/usr/sbin/alsactl` (this is its location on
1168		Debian systems. `alsactl monitor` works as a non-root user despite living
1169		in `/usr/sbin`.).
1170		- `stdbuf` (from coreutils) must be (and most probably already is) in your `PATH`.
	1217	- If this option is not specified, `alsactl` will be sought in
	1218	your `PATH` first, and failing that, at `/usr/sbin/alsactl`
	1219	(this is its location on Debian systems. `alsactl monitor`
	1220	works as a non-root user despite living in `/usr/sbin`.).
	1221	- `stdbuf` (from coreutils) must be (and most probably already is) in
	1222	your `PATH`.
1171	1223
1172	1224	### `MPD Args RefreshRate`
1173	1225
1174	1226	- This monitor will only be compiled if you ask for it using the
1175	1227	`with_mpd` flag. It needs [libmpd] 5.0 or later (available on Hackage).
1176	1228	- Aliases to `mpd`
1177		- Args: default monitor arguments. In addition you can provide
1178		`-P`, `-S` and `-Z`, with an string argument, to represent the
1179		playing, stopped and paused states in the `statei` template field.
1180		The environment variables `MPD_HOST` and `MPD_PORT` are used to configure the
1181		mpd server to communicate with. Also available:
	1229	- Args: default monitor arguments. In addition you can provide `-P`,
	1230	`-S` and `-Z`, with an string argument, to represent the playing,
	1231	stopped and paused states in the `statei` template field. The
	1232	environment variables `MPD_HOST` and `MPD_PORT` are used to
	1233	configure the mpd server to communicate with, unless given in the
	1234	additional arguments `-p` (`--port`) and `-h` (`--host`). Also
	1235	available:
1182	1236	- `lapsed-icon-pattern`: dynamic string for current track position in `ipat`.
1183	1237	- Variables that can be used with the `-t`/`--template` argument:
1184	1238	`bar`, `vbar`, `ipat`, `state`, `statei`, `volume`, `length`,

1241	1295	Run Mail [("inbox", "~/var/mail/inbox"),
1242	1296	("lists", "~/var/mail/lists")]
1243	1297	"mail"
	1298
	1299	### `MailX Args Opts Alias`
	1300
	1301	- Args: list of maildirs in form
	1302	`[("name1","path1","color1"),...]`. Paths may start with a '~'
	1303	to expand to the user's home directory. When mails are present,
	1304	counts are displayed with the given name and color.
	1305	- Opts is a possibly empty list of options, as flags. Possible values:
	1306	-d dir --dir dir a string giving the base directory where maildir files with
	1307	a relative path live.
	1308	-p prefix --prefix prefix a string giving a prefix for the list
	1309	of displayed mail counts
	1310	-s suffix --suffix suffix a string giving a suffix for the list
	1311	of displayed mail counts
	1312	- This plugin requires inotify support in your Linux kernel and the
	1313	[hinotify] package. To activate, pass `--flags="with_inotify"`
	1314	during compilation.
	1315	- Example:
	1316
	1317	Run MailX [("I", "inbox", "green"),
	1318	("L", "lists", "orange")]
	1319	["-d", "~/var/mail", "-p", " ", "-s", " "]
	1320	"mail"
	1321
1244	1322
1245	1323	### `MBox Mboxes Opts Alias`
1246	1324

1347	1425
1348	1426	### `UVMeter`
1349	1427
1350		- Aliases to "uv " + station id. For example: `%uv brisbane%` or `%uv
1351		alice springs%`
1352		- Args: default monitor arguments.
	1428	- Aliases to "uv " + station id. For example: `%uv Brisbane%` or `%uv
	1429	Alice Springs%`
	1430	- Args: default monitor arguments, plus:
	1431	- `--useManager` _bool_ : Whether to use one single manager per monitor for
	1432	managing network connections or create a new one every time a connection is
	1433	made.
	1434	- Short option: `-m`
	1435	- Default: True
1353	1436
1354	1437	- Reminder: Keep the refresh rate high, to avoid making unnecessary
1355	1438	requests every time the plug-in is run.

1357	1440	http://www.arpansa.gov.au/uvindex/realtime/xml/uvvalues.xml
1358	1441	- Example:
1359	1442
1360		Run UVMeter "brisbane" ["-H", "3", "-L", "3", "--low", "green", "--high", "red"] 900
	1443	Run UVMeter "Brisbane" ["-H", "3", "-L", "3", "--low", "green", "--high", "red"] 900
1361	1444
1362	1445	## Executing External Commands
1363	1446

1402	1485
1403	1486	## Other Plugins
1404	1487
1405		<font size="+1">`StdinReader`</font>
	1488	### `StdinReader`
1406	1489
1407	1490	- Aliases to StdinReader
1408	1491	- Displays any text received by xmobar on its standard input.

1410	1493	actions via stdin. This is safer than `UnsafeStdinReader` because there is
1411	1494	no need to escape the content before passing it to xmobar's standard input.
1412	1495
1413		<font size="+1">`UnsafeStdinReader`</font>
	1496	### `UnsafeStdinReader`
1414	1497
1415	1498	- Aliases to UnsafeStdinReader
1416	1499	- Displays any text received by xmobar on its standard input.

1424	1507	clicking on xmobar:
1425	1508	```<action=`xdotool key alt+1`>ws1</action> <action=`xdotool key alt+1`>ws2</action>```
1426	1509
1427		<font size="+1">`Date Format Alias RefreshRate`</font>
	1510	### `Date Format Alias RefreshRate`
1428	1511
1429	1512	- Format is a time format string, as accepted by the standard ISO C
1430	1513	`strftime` function (or Haskell's `formatCalendarTime`).
1431	1514	- Sample usage: `Run Date "%a %b %_d %Y <fc=#ee9a00>%H:%M:%S</fc>" "date" 10`
1432	1515
1433		<font size="+1">`DateZone Format Locale Zone Alias RefreshRate`</font>
	1516	### `DateZone Format Locale Zone Alias RefreshRate`
1434	1517
1435	1518	- Format is a time format string, as accepted by the standard ISO C
1436	1519	`strftime` function (or Haskell's `formatCalendarTime`).

1443	1526	- Sample usage:
1444	1527	`Run DateZone "%a %H:%M:%S" "de_DE.UTF-8" "Europe/Vienna" "viennaTime" 10`
1445	1528
1446		<font size="+1">`CommandReader "/path/to/program" Alias`</font>
	1529	### `CommandReader "/path/to/program" Alias`
1447	1530
1448	1531	- Runs the given program, and displays its standard output.
1449	1532
1450		<font size="+1">`PipeReader "default text:/path/to/pipe" Alias`</font>
	1533	### `PipeReader "default text:/path/to/pipe" Alias`
1451	1534
1452	1535	- Reads its displayed output from the given pipe.
1453	1536	- Prefix an optional default text separated by a colon
1454	1537	- Expands environment variables in the first argument of syntax '${VAR}' or '$VAR'
1455	1538
1456		<font size="+1">`MarqueePipeReader "default text:/path/to/pipe" (length, rate, sep) Alias`</font>
	1539	### `MarqueePipeReader "default text:/path/to/pipe" (length, rate, sep) Alias`
1457	1540
1458	1541	- Generally equivalent to PipeReader
1459	1542	- Text is displayed as marquee with the specified length, rate in 10th

1463	1546
1464	1547	- Expands environment variables in the first argument
1465	1548
1466		<font size="+1">
1467		`BufferedPipeReader Alias [(Timeout, Bool, "/path/to/pipe1"), ..]`
1468		</font>
	1549	### `BufferedPipeReader Alias [(Timeout, Bool, "/path/to/pipe1"), ..]`
1469	1550
1470	1551	- Display data from multiple pipes.
1471	1552	- Timeout (in tenth of seconds) is the value after which the previous

1497	1578	[examples/status.sh]: http://github.com/jaor/xmobar/raw/master/examples/status.sh
1498	1579
1499	1580
1500		<font size="+1">`XMonadLog`</font>
	1581	### `XMonadLog`
1501	1582
1502	1583	- Aliases to XMonadLog
1503	1584	- Displays information from xmonad's `_XMONAD_LOG`. You can set this

1515	1596
1516	1597	[here]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Hooks-DynamicLog.html
1517	1598
1518		<font size="+1">`UnsafeXMonadLog`</font>
	1599	### `UnsafeXMonadLog`
1519	1600
1520	1601	- Aliases to UnsafeXMonadLog
1521	1602	- Similar to StdinReader versus UnsafeStdinReader, this does not strip `<action

1607	1688	with the help of the greater xmobar and Haskell communities.
1608	1689
1609	1690	In particular, xmobar [incorporates patches] by Mohammed Alshiekh,
1610		Alex Ameen, Axel Angel, Claudio Bley, Dragos Boca, Ben Boeckel, Duncan
1611		Burke, Roman Cheplyaka, Patrick Chilton, Antoine Eiche, Nathaniel
1612		Wesley Filardo, John Goerzen, Reto Hablützel, Juraj Hercek, Tomáš
1613		Janoušek, Ada Joule, Spencer Janssen, Roman Joost, Jochen Keil,
1614		Lennart Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry Kurochkin, Todd
1615		Lunter, Vanessa McHale, Robert J. Macomber, Dmitry Malikov, David
1616		McLean, Marcin Mikołajczyk, Dino Morelli, Tony Morris, Eric Mrak,
1617		Thiago Negri, Edward O'Callaghan, Svein Ove, Martin Perner, Jens
1618		Petersen, Alexander Polakov, Pavan Rikhi, Petr Rockai, Andrew
1619		Sackville-West, Markus Scherer, Daniel Schüssler, Olivier Schneider,
1620		Alexander Shabalin, Valentin Shirokov, Peter Simons, Alexander
1621		Solovyov, Will Song, John Soros, Felix Springer, Travis Staton, Artem
1622		Tarasov, Samuli Thomasson, Edward Tjörnhammar, Sergei Trofimovich,
1623		Thomas Tuegel, Jan Vornberger, Anton Vorontsov, Daniel Wagner, Zev
1624		Weiss, Phil Xiaojun Hu, Edward Z. Yang and Norbert Zeh.
	1691	Alex Ameen, Axel Angel, Dhananjay Balan, Claudio Bley, Dragos Boca,
	1692	Ben Boeckel, Duncan Burke, Roman Cheplyaka, Patrick Chilton, Antoine
	1693	Eiche, Nathaniel Wesley Filardo, John Goerzen, Reto Hablützel, Juraj
	1694	Hercek, Tomáš Janoušek, Ada Joule, Spencer Janssen, Roman Joost,
	1695	Jochen Keil, Lennart Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry
	1696	Kurochkin, Todd Lunter, Vanessa McHale, Robert J. Macomber, Dmitry
	1697	Malikov, David McLean, Marcin Mikołajczyk, Dino Morelli, Tony Morris,
	1698	Eric Mrak, Thiago Negri, Edward O'Callaghan, Svein Ove, Martin Perner,
	1699	Jens Petersen, Alexander Polakov, Pavan Rikhi, Petr Rockai, Andrew
	1700	Emmanuel Rosa, Sackville-West, Markus Scherer, Daniel Schüssler,
	1701	Olivier Schneider, Alexander Shabalin, Valentin Shirokov, Peter
	1702	Simons, Alexander Solovyov, Will Song, John Soros, Felix Springer,
	1703	Travis Staton, Artem Tarasov, Samuli Thomasson, Edward Tjörnhammar,
	1704	Sergei Trofimovich, Thomas Tuegel, John Tyree, Jan Vornberger, Anton
	1705	Vorontsov, Daniel Wagner, Zev Weiss, Phil Xiaojun Hu, Edward Z. Yang
	1706	and Norbert Zeh.
1625	1707
1626	1708	[jao]: http://jao.io
1627	1709	[incorporates patches]: http://www.ohloh.net/p/xmobar/contributors

+9

-9

src/Xmobar/App/Compile.hs less more

130	130	--
131	131	-- 'False' is returned if there are compilation errors.
132	132	--
133		recompile :: MonadIO m => String -> String -> Bool -> Bool -> m Bool
134		recompile dir execName force verb = liftIO $ do
135		let bin = dir </> execName
136		err = dir </> (execName ++ ".errors")
137		src = dir </> (execName ++ ".hs")
138		lib = dir </> "lib"
139		script = dir </> "build"
	133	recompile :: MonadIO m => String -> String -> String -> Bool -> Bool -> m Bool
	134	recompile confDir dataDir execName force verb = liftIO $ do
	135	let bin = confDir </> execName
	136	err = dataDir </> (execName ++ ".errors")
	137	src = confDir </> (execName ++ ".hs")
	138	lib = confDir </> "lib"
	139	script = confDir </> "build"
140	140	useScript <- checkBuildScript verb script
141	141	sc <- if useScript \|\| force
142	142	then return True

148	148	\errHandle ->
149	149	waitForProcess =<<
150	150	if useScript
151		then runScript script bin dir errHandle
152		else runGHC bin dir errHandle
	151	then runScript script bin confDir errHandle
	152	else runGHC bin confDir errHandle
153	153	installSignalHandlers
154	154	if status == ExitSuccess
155	155	then trace verb "Xmobar recompilation process exited with success!"

+22

-19

src/Xmobar/App/Config.hs less more

0	0	------------------------------------------------------------------------------
1	1	-- \|
2	2	-- Module: Xmobar.Config.Defaults
3		-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz
	3	-- Copyright: (c) 2018, 2019 Jose Antonio Ortega Ruiz
4	4	-- License: BSD3-style (see LICENSE)
5	5	--
6	6	-- Maintainer: jao@gnu.org

19	19	xmobarConfigDir,
20	20	xmobarDataDir,
21	21	xmobarConfigFile) where
	22
	23	import Control.Monad (when)
22	24
23	25	import System.Environment
24	26	import System.Directory

78	80	--
79	81	-- The first directory that exists will be used. If none of the
80	82	-- directories exist then (1) will be used if it is set, otherwise (2)
81		-- will be used. Either way, a directory will be created if necessary.
	83	-- will be used.
82	84	xmobarConfigDir :: IO String
83	85	xmobarConfigDir =
84		findFirstDirWithEnv "XMOBAR_CONFIG_DIR"
	86	findFirstDirWithEnv False "XMOBAR_CONFIG_DIR"
85	87	[ getAppUserDataDirectory "xmobar"
86	88	, getXdgDirectory XdgConfig "xmobar"
87	89	]

93	95	-- Several directories are considered. In order of preference:
94	96	--
95	97	-- 1. The directory specified in the @XMOBAR_DATA_DIR@ environment variable.
96		-- 2. The @~\/.xmobar@ directory.
97		-- 3. The @XDG_DATA_HOME/xmobar@ directory.
	98	-- 2. The @XDG_DATA_HOME/xmobar@ directory.
	99	-- 3. The @~\/.xmobar@ directory.
98	100	--
99	101	-- The first directory that exists will be used. If none of the
100	102	-- directories exist then (1) will be used if it is set, otherwise (2)

102	104	-- necessary.
103	105	xmobarDataDir :: IO String
104	106	xmobarDataDir =
105		findFirstDirWithEnv "XMOBAR_DATA_DIR"
106		[ getAppUserDataDirectory "xmobar"
107		, getXdgDirectory XdgData "xmobar"
	107	findFirstDirWithEnv True "XMOBAR_DATA_DIR"
	108	[ getXdgDirectory XdgData "xmobar"
	109	, getAppUserDataDirectory "xmobar"
108	110	]
109	111
110	112	-- \| Helper function that will find the first existing directory and
111		-- return its path. If none of the directories can be found, create
112		-- and return the first from the list. If the list is empty this
113		-- function returns the historical @~\/.xmobar@ directory.
114		findFirstDirOf :: [IO FilePath] -> IO FilePath
115		findFirstDirOf [] = findFirstDirOf [getAppUserDataDirectory "xmobar"]
116		findFirstDirOf possibles = do
	113	-- return its path. If none of the directories can be found,
	114	-- optionally create and return the first from the list. If the list
	115	-- is empty this function returns the historical @~\/.xmobar@
	116	-- directory.
	117	findFirstDirOf :: Bool -> [IO FilePath] -> IO FilePath
	118	findFirstDirOf create [] = findFirstDirOf create [getAppUserDataDirectory "xmobar"]
	119	findFirstDirOf create possibles = do
117	120	found <- go possibles
118	121	case found of
119	122	Just path -> return path
120	123	Nothing -> do
121	124	primary <- head possibles
122		createDirectoryIfMissing True primary
	125	when create (createDirectoryIfMissing True primary)
123	126	return primary
124	127	where
125	128	go [] = return Nothing

129	132
130	133	-- \| Simple wrapper around @findFirstDirOf@ that allows the primary
131	134	-- path to be specified by an environment variable.
132		findFirstDirWithEnv :: String -> [IO FilePath] -> IO FilePath
133		findFirstDirWithEnv envName paths = do
	135	findFirstDirWithEnv :: Bool -> String -> [IO FilePath] -> IO FilePath
	136	findFirstDirWithEnv create envName paths = do
134	137	envPath' <- lookupEnv envName
135	138	case envPath' of
136		Nothing -> findFirstDirOf paths
137		Just envPath -> findFirstDirOf (return envPath:paths)
	139	Nothing -> findFirstDirOf create paths
	140	Just envPath -> findFirstDirOf create (return envPath:paths)
138	141
139	142	xmobarConfigFile :: IO (Maybe FilePath)
140	143	xmobarConfigFile =

+37

-9

src/Xmobar/App/EventLoop.hs less more

16	16	------------------------------------------------------------------------------
17	17
18	18
19		module Xmobar.App.EventLoop (startLoop, startCommand) where
	19	module Xmobar.App.EventLoop
	20	( startLoop
	21	, startCommand
	22	, newRefreshLock
	23	, refreshLock
	24	) where
20	25
21	26	import Prelude hiding (lookup)
22	27	import Graphics.X11.Xlib hiding (textExtents, textWidth)

30	35	import Control.Concurrent
31	36	import Control.Concurrent.Async (Async, async)
32	37	import Control.Concurrent.STM
33		import Control.Exception (handle, SomeException(..))
	38	import Control.Exception (bracket_, handle, SomeException(..))
34	39	import Data.Bits
35	40	import Data.Map hiding (foldr, map, filter)
36	41	import Data.Maybe (fromJust, isJust)

46	51	import Xmobar.X11.Draw
47	52	import Xmobar.X11.Bitmap as Bitmap
48	53	import Xmobar.X11.Types
	54
	55	#ifndef THREADED_RUNTIME
49	56	import Xmobar.X11.Events(nextEvent')
	57	#endif
50	58
51	59	#ifdef XFT
52	60	import Graphics.X11.Xft

59	67	runX :: XConf -> X () -> IO ()
60	68	runX xc f = runReaderT f xc
61	69
	70	newRefreshLock :: IO (TMVar ())
	71	newRefreshLock = atomically $ newTMVar ()
	72
	73	refreshLock :: TMVar () -> IO a -> IO a
	74	refreshLock var = bracket_ lock unlock
	75	where
	76	lock = atomically $ takeTMVar var
	77	unlock = atomically $ putTMVar var ()
	78
	79	refreshLockT :: TMVar () -> STM a -> STM a
	80	refreshLockT var action = do
	81	takeTMVar var
	82	r <- action
	83	putTMVar var ()
	84	return r
	85
62	86	-- \| Starts the main event loop and threads
63		startLoop :: XConf -> TMVar SignalType -> [[([Async ()], TVar String)]]
64		-> IO ()
65		startLoop xcfg@(XConf _ _ w _ _ _ _) sig vs = do
	87	startLoop :: XConf
	88	-> TMVar SignalType
	89	-> TMVar ()
	90	-> [[([Async ()], TVar String)]]
	91	-> IO ()
	92	startLoop xcfg@(XConf _ _ w _ _ _ _) sig pauser vs = do
66	93	#ifdef XFT
67	94	xftInitFtLibrary
68	95	#endif
69	96	tv <- atomically $ newTVar []
70		_ <- forkIO (handle (handler "checker") (checker tv [] vs sig))
	97	_ <- forkIO (handle (handler "checker") (checker tv [] vs sig pauser))
71	98	#ifdef THREADED_RUNTIME
72	99	_ <- forkOS (handle (handler "eventer") (eventer sig))
73	100	#else

107	134	-> [String]
108	135	-> [[([Async ()], TVar String)]]
109	136	-> TMVar SignalType
	137	-> TMVar ()
110	138	-> IO ()
111		checker tvar ov vs signal = do
112		nval <- atomically $ do
	139	checker tvar ov vs signal pauser = do
	140	nval <- atomically $ refreshLockT pauser $ do
113	141	nv <- mapM concatV vs
114	142	guard (nv /= ov)
115	143	writeTVar tvar nv
116	144	return nv
117	145	atomically $ putTMVar signal Wakeup
118		checker tvar nval vs signal
	146	checker tvar nval vs signal pauser
119	147	where
120	148	concatV = fmap concat . mapM (readTVar . snd)
121	149

+16

-13

src/Xmobar/App/Main.hs less more

39	39	import Xmobar.X11.Text
40	40	import Xmobar.X11.Window
41	41	import Xmobar.App.Opts (recompileFlag, verboseFlag, getOpts, doOpts)
42		import Xmobar.App.EventLoop (startLoop, startCommand)
	42	import Xmobar.App.EventLoop (startLoop, startCommand, newRefreshLock, refreshLock)
43	43	import Xmobar.App.Compile (recompile, trace)
44	44	import Xmobar.App.Config
	45	import Xmobar.App.Timer (withTimer)
45	46
46	47	xmobar :: Config -> IO ()
47	48	xmobar conf = withDeferSignals $ do

52	53	cls <- mapM (parseTemplate (commands conf) (sepChar conf))
53	54	(splitTemplate (alignSep conf) (template conf))
54	55	sig <- setupSignalHandler
55		bracket (mapM (mapM $ startCommand sig) cls)
56		cleanupThreads
57		$ \vars -> do
58		(r,w) <- createWin d fs conf
59		let ic = Map.empty
60		to = textOffset conf
61		ts = textOffsets conf ++ replicate (length fl) (-1)
62		startLoop (XConf d r w (fs:fl) (to:ts) ic conf) sig vars
	56	refLock <- newRefreshLock
	57	withTimer (refreshLock refLock) $
	58	bracket (mapM (mapM $ startCommand sig) cls)
	59	cleanupThreads
	60	$ \vars -> do
	61	(r,w) <- createWin d fs conf
	62	let ic = Map.empty
	63	to = textOffset conf
	64	ts = textOffsets conf ++ replicate (length fl) (-1)
	65	startLoop (XConf d r w (fs:fl) (to:ts) ic conf) sig refLock vars
63	66
64	67	configFromArgs :: Config -> IO Config
65	68	configFromArgs cfg = getArgs >>= getOpts >>= doOpts cfg . fst

69	72	for_ (concat vars) $ \(asyncs, _) ->
70	73	for_ asyncs cancel
71	74
72		buildLaunch :: Bool -> Bool -> FilePath -> ParseError -> IO ()
	75	buildLaunch :: Bool -> Bool -> String -> ParseError -> IO ()
73	76	buildLaunch verb force p e = do
74	77	let exec = takeBaseName p
75		dir = takeDirectory p
	78	confDir = takeDirectory p
76	79	ext = takeExtension p
77	80	if ext `elem` [".hs", ".hsc", ".lhs"]
78		then recompile dir exec force verb >>
79		executeFile (dir </> exec) False [] Nothing
	81	then xmobarDataDir >>= \dd -> recompile confDir dd exec force verb >>
	82	executeFile (confDir </> exec) False [] Nothing
80	83	else trace True ("Invalid configuration file: " ++ show e) >>
81	84	trace True "\n(No compilation attempted: \
82	85	\only .hs, .hsc or .lhs files are compiled)"

+221

-0

src/Xmobar/App/Timer.hs less more

	0	{-# LANGUAGE LambdaCase #-}
	1	------------------------------------------------------------------------------
	2	-- \|
	3	-- Module: Xmobar.App.Timer
	4	-- Copyright: (c) 2019 Tomáš Janoušek
	5	-- License: BSD3-style (see LICENSE)
	6	--
	7	-- Maintainer: Tomáš Janoušek <tomi@nomi.cz>
	8	-- Stability: unstable
	9	--
	10	-- Timer coalescing for recurring actions.
	11	--
	12	------------------------------------------------------------------------------
	13
	14	module Xmobar.App.Timer
	15	( doEveryTenthSeconds
	16	, tenthSeconds
	17	, withTimer
	18	) where
	19
	20	import Control.Concurrent (threadDelay)
	21	import Control.Concurrent.Async (withAsync)
	22	import Control.Concurrent.STM
	23	import Control.Exception
	24	import Control.Monad (forever, forM, guard)
	25	import Data.Foldable (foldrM, for_)
	26	import Data.Int (Int64)
	27	import Data.Map (Map)
	28	import qualified Data.Map as M
	29	import Data.Maybe (isJust, fromJust)
	30	import Data.Time.Clock.POSIX (getPOSIXTime)
	31	import Data.Unique
	32	import System.IO.Unsafe (unsafePerformIO)
	33
	34	type Periods = Map Unique Period
	35
	36	data Tick = Tick (TMVar ()) \| UnCoalesce
	37
	38	data Period = Period { rate :: Int64, next :: Int64, tick :: TMVar Tick }
	39
	40	data UnCoalesceException = UnCoalesceException deriving Show
	41	instance Exception UnCoalesceException
	42
	43	{-# NOINLINE periodsVar #-}
	44	periodsVar :: TVar (Maybe Periods)
	45	periodsVar = unsafePerformIO $ newTVarIO Nothing
	46
	47	now :: IO Int64
	48	now = do
	49	posix <- getPOSIXTime
	50	return $ floor (10 * posix)
	51
	52	newPeriod :: Int64 -> IO (Unique, Period)
	53	newPeriod r = do
	54	u <- newUnique
	55	t <- now
	56	v <- atomically newEmptyTMVar
	57	let t' = t - t `mod` r
	58	return (u, Period { rate = r, next = t', tick = v })
	59
	60	-- \| Perform a given action every N tenths of a second.
	61	--
	62	-- The timer is aligned (coalesced) with other timers to minimize the number
	63	-- of wakeups and unnecessary redraws. If the action takes too long (one
	64	-- second or when the next timer is due), coalescing is disabled for it and it
	65	-- falls back to periodic sleep.
	66	doEveryTenthSeconds :: Int -> IO () -> IO ()
	67	doEveryTenthSeconds r action =
	68	doEveryTenthSecondsCoalesced r action `catch` \UnCoalesceException ->
	69	doEveryTenthSecondsSleeping r action
	70
	71	-- \| Perform a given action every N tenths of a second,
	72	-- coalesce with other timers using a given Timer instance.
	73	doEveryTenthSecondsCoalesced :: Int -> IO () -> IO ()
	74	doEveryTenthSecondsCoalesced r action = do
	75	(u, p) <- newPeriod (fromIntegral r)
	76	bracket_ (push u p) (pop u) $ forever $ bracket (wait p) done $ const action
	77	where
	78	push u p = atomically $ modifyTVar' periodsVar $ \case
	79	Just periods -> Just $ M.insert u p periods
	80	Nothing -> throw UnCoalesceException
	81	pop u = atomically $ modifyTVar' periodsVar $ \case
	82	Just periods -> Just $ M.delete u periods
	83	Nothing -> Nothing
	84
	85	wait p = atomically (takeTMVar $ tick p) >>= \case
	86	Tick doneVar -> return doneVar
	87	UnCoalesce -> throwIO UnCoalesceException
	88	done doneVar = atomically $ putTMVar doneVar ()
	89
	90	-- \| Perform a given action every N tenths of a second,
	91	-- making no attempt to synchronize with other timers.
	92	doEveryTenthSecondsSleeping :: Int -> IO () -> IO ()
	93	doEveryTenthSecondsSleeping r action = go
	94	where go = action >> tenthSeconds r >> go
	95
	96	-- \| Sleep for a given amount of tenths of a second.
	97	--
	98	-- (Work around the Int max bound: since threadDelay takes an Int, it
	99	-- is not possible to set a thread delay grater than about 45 minutes.
	100	-- With a little recursion we solve the problem.)
	101	tenthSeconds :: Int -> IO ()
	102	tenthSeconds s \| s >= x = do threadDelay (x * 100000)
	103	tenthSeconds (s - x)
	104	\| otherwise = threadDelay (s * 100000)
	105	where x = (maxBound :: Int) `div` 100000
	106
	107	-- \| Start the timer coordination thread and perform a given IO action (this
	108	-- is meant to surround the entire xmobar execution), terminating the timer
	109	-- thread afterwards.
	110	--
	111	-- Additionally, if the timer thread fails, individual
	112	-- 'doEveryTenthSecondsCoalesced' invocations that are waiting to be
	113	-- coordinated by it are notified to fall back to periodic sleeping.
	114	--
	115	-- The timer thread _will_ fail immediately when running in a non-threaded
	116	-- RTS.
	117	withTimer :: (IO () -> IO ()) -> IO a -> IO a
	118	withTimer pauseRefresh action =
	119	withAsync (timerThread `finally` cleanup) $ const action
	120	where
	121	timerThread = do
	122	atomically $ writeTVar periodsVar $ Just M.empty
	123	timerLoop pauseRefresh
	124
	125	cleanup = atomically $ readTVar periodsVar >>= \case
	126	Just periods -> do
	127	for_ periods unCoalesceTimer'
	128	writeTVar periodsVar Nothing
	129	Nothing -> return ()
	130
	131	timerLoop :: (IO () -> IO ()) -> IO ()
	132	timerLoop pauseRefresh = forever $ do
	133	tNow <- now
	134	(toFire, tMaybeNext) <- atomically $ do
	135	periods <- fromJust <$> readTVar periodsVar
	136	let toFire = timersToFire tNow periods
	137	let periods' = advanceTimers tNow periods
	138	let tMaybeNext = nextFireTime periods'
	139	writeTVar periodsVar $ Just periods'
	140	return (toFire, tMaybeNext)
	141	pauseRefresh $ do
	142	-- To avoid multiple refreshes, pause refreshing for up to 1 second,
	143	-- fire timers and wait for them to finish (update their text).
	144	-- Those that need more time (e.g. weather monitors) will be dropped
	145	-- from timer coalescing and will fall back to periodic sleep.
	146	timeoutVar <- registerDelay $ case tMaybeNext of
	147	Just tNext -> fromIntegral ((tNext - tNow) `max` 10) * 100000
	148	Nothing -> 1000000
	149	fired <- fireTimers toFire
	150	timeouted <- waitForTimers timeoutVar fired
	151	unCoalesceTimers timeouted
	152	delayUntilNextFire
	153
	154	advanceTimers :: Int64 -> Periods -> Periods
	155	advanceTimers t = M.map advance
	156	where
	157	advance p \| next p <= t = p { next = t - t `mod` rate p + rate p }
	158	\| otherwise = p
	159
	160	timersToFire :: Int64 -> Periods -> [(Unique, Period)]
	161	timersToFire t periods = [ (u, p) \| (u, p) <- M.toList periods, next p <= t ]
	162
	163	nextFireTime :: Periods -> Maybe Int64
	164	nextFireTime periods
	165	\| M.null periods = Nothing
	166	\| otherwise = Just $ minimum [ next p \| p <- M.elems periods ]
	167
	168	fireTimers :: [(Unique, Period)] -> IO [(Unique, TMVar ())]
	169	fireTimers toFire = atomically $ forM toFire $ \(u, p) -> do
	170	doneVar <- newEmptyTMVar
	171	putTMVar (tick p) (Tick doneVar)
	172	return (u, doneVar)
	173
	174	waitForTimers :: TVar Bool -> [(Unique, TMVar ())] -> IO [Unique]
	175	waitForTimers timeoutVar fired = atomically $ do
	176	timeoutOver <- readTVar timeoutVar
	177	dones <- forM fired $ \(u, doneVar) -> do
	178	done <- isJust <$> tryReadTMVar doneVar
	179	return (u, done)
	180	guard $ timeoutOver \|\| all snd dones
	181	return [u \| (u, False) <- dones]
	182
	183	-- \| Handle slow timers (drop and signal them to stop coalescing).
	184	unCoalesceTimers :: [Unique] -> IO ()
	185	unCoalesceTimers timers = atomically $ do
	186	periods <- fromJust <$> readTVar periodsVar
	187	periods' <- foldrM unCoalesceTimer periods timers
	188	writeTVar periodsVar $ Just periods'
	189
	190	unCoalesceTimer :: Unique -> Periods -> STM Periods
	191	unCoalesceTimer u periods = do
	192	unCoalesceTimer' (periods M.! u)
	193	return $ u `M.delete` periods
	194
	195	unCoalesceTimer' :: Period -> STM ()
	196	unCoalesceTimer' p = do
	197	_ <- tryTakeTMVar (tick p)
	198	putTMVar (tick p) UnCoalesce
	199
	200	delayUntilNextFire :: IO ()
	201	delayUntilNextFire = do
	202	Just periods <- readTVarIO periodsVar
	203	let tMaybeNext = nextFireTime periods
	204	tNow <- now
	205	delayVar <- case tMaybeNext of
	206	Just tNext -> do
	207	-- Work around the Int max bound: threadDelay takes an Int, we can
	208	-- only sleep for so long, which is okay, we'll just check timers
	209	-- sooner and sleep again.
	210	let maxDelay = (maxBound :: Int) `div` 100000
	211	delay = (tNext - tNow) `min` fromIntegral maxDelay
	212	delayUsec = fromIntegral delay * 100000
	213	registerDelay delayUsec
	214	Nothing -> atomically $ newTVar False
	215	atomically $ do
	216	delayOver <- readTVar delayVar
	217	periods' <- fromJust <$> readTVar periodsVar
	218	let tMaybeNext' = nextFireTime periods'
	219	-- Return also if a new period is added (it may fire sooner).
	220	guard $ delayOver \|\| tMaybeNext /= tMaybeNext'

+6

-2

src/Xmobar/Plugins/DateZone.hs less more

27	27	import Control.Concurrent.STM
28	28
29	29	import System.IO.Unsafe
	30	import System.Environment (lookupEnv)
	31
	32	import Data.Maybe (fromMaybe)
30	33
31	34	import Data.Time.Format
32	35	import Data.Time.LocalTime

62	65	locale <- getTimeLocale
63	66	atomically $ putTMVar localeLock lock
64	67	if z /= "" then do
65		timeZone <- getTimeZoneSeriesFromOlsonFile ("/usr/share/zoneinfo/" ++ z)
	68	tzdir <- lookupEnv "TZDIR"
	69	timeZone <- getTimeZoneSeriesFromOlsonFile ((fromMaybe "/usr/share/zoneinfo" tzdir) ++ "/" ++ z)
66	70	go (dateZone f locale timeZone)
67	71	else
68	72	go (date f locale)
69	73
70		where go func = func >>= cb >> tenthSeconds r >> go func
	74	where go func = doEveryTenthSeconds r $ func >>= cb
71	75
72	76	{-# NOINLINE localeLock #-}
73	77	-- ensures that only one plugin instance sets the locale

+1

-1

src/Xmobar/Plugins/Kbd.hs less more

26	26
27	27	-- 'Bad' prefixes of layouts
28	28	noLaySymbols :: [String]
29		noLaySymbols = ["group", "inet", "ctr", "pc", "ctrl"]
	29	noLaySymbols = ["group", "inet", "ctr", "pc", "ctrl", "terminate"]
30	30
31	31
32	32	-- splits the layout string into the actual layouts

+2

-7

src/Xmobar/Plugins/MBox.hs less more

18	18	import Xmobar.Run.Exec
19	19	#ifdef INOTIFY
20	20
	21	import Xmobar.Plugins.Monitors.Common (parseOptsWith)
21	22	import Xmobar.System.Utils (changeLoop, expandHome)
22	23
23	24	import Control.Monad (when)

62	63	, Option "s" ["suffix"] (ReqArg (\x o -> o { oSuffix = x }) "") ""
63	64	]
64	65
65		parseOptions :: [String] -> IO Options
66		parseOptions args =
67		case getOpt Permute options args of
68		(o, _, []) -> return $ foldr id defaults o
69		(_, _, errs) -> ioError . userError $ concat errs
70
71	66	#else
72	67	import System.IO
73	68	#endif

85	80	" but the MBox plugin requires it"
86	81	#else
87	82	start (MBox boxes args _) cb = do
88		opts <- parseOptions args
	83	opts <- parseOptsWith options defaults args
89	84	let showAll = oAll opts
90	85	prefix = oPrefix opts
91	86	suffix = oSuffix opts

+39

-9

src/Xmobar/Plugins/Mail.hs less more

12	12	--
13	13	-----------------------------------------------------------------------------
14	14
15		module Xmobar.Plugins.Mail(Mail(..)) where
	15	module Xmobar.Plugins.Mail(Mail(..),MailX(..)) where
16	16
17	17	import Xmobar.Run.Exec
18	18	#ifdef INOTIFY
19	19
	20	import Xmobar.Plugins.Monitors.Common (parseOptsWith)
20	21	import Xmobar.System.Utils (expandHome, changeLoop)
21	22
22	23	import Control.Monad

25	26	import System.Directory
26	27	import System.FilePath
27	28	import System.INotify
	29	import System.Console.GetOpt
28	30
29	31	import Data.List (isPrefixOf)
30	32	import Data.Set (Set)

46	48	import System.IO
47	49	#endif
48	50
	51	data MOptions = MOptions
	52	{ oDir :: FilePath
	53	, oPrefix :: String
	54	, oSuffix :: String
	55	}
	56
	57	defaults :: MOptions
	58	defaults = MOptions {oDir = "", oPrefix = "", oSuffix = ""}
	59
	60	options :: [OptDescr (MOptions -> MOptions)]
	61	options =
	62	[ Option "d" ["dir"] (ReqArg (\x o -> o { oDir = x }) "") ""
	63	, Option "p" ["prefix"] (ReqArg (\x o -> o { oPrefix = x }) "") ""
	64	, Option "s" ["suffix"] (ReqArg (\x o -> o { oSuffix = x }) "") ""
	65	]
49	66
50	67	-- \| A list of mail box names and paths to maildirs.
51	68	data Mail = Mail [(String, FilePath)] String
52	69	deriving (Read, Show)
53	70
	71	-- \| A list of mail box names, paths to maildirs and display colors.
	72	data MailX = MailX [(String, FilePath, String)] [String] String
	73	deriving (Read, Show)
	74
54	75	instance Exec Mail where
55		alias (Mail _ a) = a
	76	alias (Mail _ a) = a
	77	start (Mail ms a) = start (MailX (map (\(n,p) -> (n,p,"")) ms) [] a)
	78
	79	instance Exec MailX where
	80	alias (MailX _ _ a) = a
56	81	#ifndef INOTIFY
57	82	start _ _ =
58	83	hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify,"
59	84	++ " but the Mail plugin requires it."
60	85	#else
61		start (Mail ms _) cb = do
	86	start (MailX ms args _) cb = do
62	87	vs <- mapM (const $ newTVarIO S.empty) ms
63
64		let ts = map fst ms
65		rs = map ((</> "new") . snd) ms
	88	opts <- parseOptsWith options defaults args
	89	let prefix = oPrefix opts
	90	suffix = oSuffix opts
	91	dir = oDir opts
	92	ps = map (\(_,p,_) -> if null dir then p else dir </> p) ms
	93	rs = map (</> "new") ps
66	94	ev = [Move, MoveIn, MoveOut, Create, Delete]
67	95
68	96	ds <- mapM expandHome rs

75	103	atomically $ modifyTVar v (S.union s)
76	104
77	105	changeLoop (mapM (fmap S.size . readTVar) vs) $ \ns ->
78		cb . unwords $ [m ++ show n
79		\| (m, n) <- zip ts ns
80		, n /= 0 ]
	106	let showmbx m n c = if c == ""
	107	then m ++ show n
	108	else "<fc=" ++ c ++ ">" ++ m ++ show n ++ "</fc>"
	109	cnts = [showmbx m n c \| ((m,_,c), n) <- zip ms ns , n /= 0 ]
	110	in cb $ if null cnts then "" else prefix ++ unwords cnts ++ suffix
81	111
82	112	handle :: TVar (Set String) -> Event -> IO ()
83	113	handle v e = atomically $ modifyTVar v $ case e of

+4

-9

src/Xmobar/Plugins/Monitors/Alsa.hs less more

56	56	where
57	57	modifyVolumeOpts f o = o { aoVolumeOpts = f (aoVolumeOpts o) }
58	58
59		parseOpts :: [String] -> IO AlsaOpts
60		parseOpts argv =
61		case getOpt Permute options argv of
62		(o, _, []) -> return $ foldr id defaultOpts o
63		(_, _, errs) -> ioError . userError $ concat errs
64
	59	-- \| Drop generic Monitor args first, then apply 'parseOptsWith' in order to
	60	-- parse everything.
65	61	parseOptsIncludingMonitorArgs :: [String] -> IO AlsaOpts
66	62	parseOptsIncludingMonitorArgs args =
67		-- Drop generic Monitor args first
68	63	case getOpt Permute [] args of
69		(_, args', _) -> parseOpts args'
	64	(_, args', _) -> parseOptsWith options defaultOpts args'
70	65
71	66	startAlsaPlugin :: String -> String -> [String] -> (String -> IO ()) -> IO ()
72	67	startAlsaPlugin mixerName controlName args cb = do

79	74	-- it would have to inline 'runMBD', 'doArgs' and 'parseOpts' to see
80	75	-- it, which probably isn't going to happen with the default
81	76	-- optimization settings).
82		opts2 <- io $ parseOpts args2
	77	opts2 <- io $ parseOptsWith options defaultOpts args2
83	78	Volume.runVolumeWith (aoVolumeOpts opts2) mixerName controlName
84	79
85	80	withMonitorWaiter mixerName (aoAlsaCtlPath opts) cb $ \wait_ ->

+110

-33

src/Xmobar/Plugins/Monitors/Batt.hs less more

	0	{-# LANGUAGE CPP #-}
	1
0	2	-----------------------------------------------------------------------------
1	3	-- \|
2	4	-- Module : Plugins.Monitors.Batt

16	18
17	19	import System.Process (system)
18	20	import Control.Monad (void, unless)
	21	import Xmobar.Plugins.Monitors.Common
19	22	import Control.Exception (SomeException, handle)
20		import Xmobar.Plugins.Monitors.Common
21	23	import System.FilePath ((</>))
22	24	import System.IO (IOMode(ReadMode), hGetLine, withFile)
23	25	import System.Posix.Files (fileExist)
	26	#ifdef FREEBSD
	27	import System.BSD.Sysctl (sysctlReadInt)
	28	#endif
24	29	import System.Console.GetOpt
25	30	import Data.List (sort, sortBy, group)
26	31	import Data.Maybe (fromMaybe)

44	49	, onIconPattern :: Maybe IconPattern
45	50	, offIconPattern :: Maybe IconPattern
46	51	, idleIconPattern :: Maybe IconPattern
	52	, lowString :: String
	53	, mediumString :: String
	54	, highString :: String
	55	, incPerc :: Bool
47	56	}
48	57
49	58	defaultOpts :: BattOpts

64	73	, onIconPattern = Nothing
65	74	, offIconPattern = Nothing
66	75	, idleIconPattern = Nothing
	76	, lowString = ""
	77	, mediumString = ""
	78	, highString = ""
	79	, incPerc = False
67	80	}
68	81
69	82	options :: [OptDescr (BattOpts -> BattOpts)]

80	93	, Option "f" ["online"] (ReqArg (\x o -> o { onlineFile = x }) "") ""
81	94	, Option "s" ["scale"] (ReqArg (\x o -> o {scale = read x}) "") ""
82	95	, Option "a" ["action"] (ReqArg (\x o -> o { onLowAction = Just x }) "") ""
	96	, Option "P" ["percent"] (NoArg (\o -> o {incPerc = True})) ""
83	97	, Option "A" ["action-threshold"]
84	98	(ReqArg (\x o -> o { actionThreshold = read x }) "") ""
85	99	, Option "" ["on-icon-pattern"] (ReqArg (\x o ->

88	102	o { offIconPattern = Just $ parseIconPattern x }) "") ""
89	103	, Option "" ["idle-icon-pattern"] (ReqArg (\x o ->
90	104	o { idleIconPattern = Just $ parseIconPattern x }) "") ""
	105	, Option "" ["lows"] (ReqArg (\x o -> o { lowString = x }) "") ""
	106	, Option "" ["mediums"] (ReqArg (\x o -> o { mediumString = x }) "") ""
	107	, Option "" ["highs"] (ReqArg (\x o -> o { highString = x }) "") ""
91	108	]
92	109
93		parseOpts :: [String] -> IO BattOpts
94		parseOpts argv =
95		case getOpt Permute options argv of
96		(o, _, []) -> return $ foldr id defaultOpts o
97		(_, _, errs) -> ioError . userError $ concat errs
98
99	110	data Status = Charging \| Discharging \| Full \| Idle \| Unknown deriving (Read, Eq)
100
	111	-- Result perc watts time-seconds Status
101	112	data Result = Result Float Float Float Status \| NA
102	113
103	114	sysDir :: FilePath

124	135	, status :: !String
125	136	}
126	137
	138	data BatteryStatus
	139	= BattHigh
	140	\| BattMedium
	141	\| BattLow
	142
	143	-- \| Convert the current battery charge into a 'BatteryStatus'
	144	getBattStatus
	145	:: Float -- ^ Current battery charge, assumed to be in [0,1]
	146	-> BattOpts -- ^ Battery options, including high/low thresholds
	147	-> BatteryStatus
	148	getBattStatus charge opts
	149	\| c >= highThreshold opts = BattHigh
	150	\| c >= lowThreshold opts = BattMedium
	151	\| otherwise = BattLow
	152	where
	153	c = 100 * min 1 charge
	154
	155	maybeAlert :: BattOpts -> Float -> IO ()
	156	maybeAlert opts left =
	157	case onLowAction opts of
	158	Nothing -> return ()
	159	Just x -> unless (isNaN left \|\| actionThreshold opts < 100 * left)
	160	$ void $ system x
	161
	162	-- \| FreeBSD battery query
	163	#ifdef FREEBSD
	164	battStatusFbsd :: Int -> Status
	165	battStatusFbsd x
	166	\| x == 1 = Discharging
	167	\| x == 2 = Charging
	168	\| otherwise = Unknown
	169
	170	readBatteriesFbsd :: BattOpts -> IO Result
	171	readBatteriesFbsd opts = do
	172	lf <- sysctlReadInt "hw.acpi.battery.life"
	173	rt <- sysctlReadInt "hw.acpi.battery.rate"
	174	tm <- sysctlReadInt "hw.acpi.battery.time"
	175	st <- sysctlReadInt "hw.acpi.battery.state"
	176	acline <- sysctlReadInt "hw.acpi.acline"
	177	let p = fromIntegral lf / 100
	178	w = fromIntegral rt
	179	t = fromIntegral tm * 60
	180	ac = acline == 1
	181	-- battery full when rate is 0 and on ac.
	182	sts = if (w == 0 && ac) then Full else (battStatusFbsd $ fromIntegral st)
	183	unless ac (maybeAlert opts p)
	184	return (Result p w t sts)
	185
	186	#else
	187	-- \| query linux battery
127	188	safeFileExist :: String -> String -> IO Bool
128	189	safeFileExist d f = handle noErrors $ fileExist (d </> f)
129	190	where noErrors = const (return False) :: SomeException -> IO Bool

165	226	a' = max a b -- sometimes the reported max charge is lower than
166	227	return $ Battery (3600 * a' / sc') -- wattseconds
167	228	(3600 * b / sc') -- wattseconds
168		(d / sc') -- watts
	229	(abs d / sc') -- watts
169	230	s -- string: Discharging/Charging/Full
170	231	where grab f = handle onError $ withFile f ReadMode (fmap read . hGetLine)
171	232	onError = const (return (-1)) :: SomeException -> IO Float

180	241	mostCommonDef :: Eq a => a -> [a] -> a
181	242	mostCommonDef x xs = head $ last $ [x] : sortOn length (group xs)
182	243
183		maybeAlert :: BattOpts -> Float -> IO ()
184		maybeAlert opts left =
185		case onLowAction opts of
186		Nothing -> return ()
187		Just x -> unless (isNaN left \|\| actionThreshold opts < 100 * left)
188		$ void $ system x
189
190		readBatteries :: BattOpts -> [Files] -> IO Result
191		readBatteries opts bfs =
	244	readBatteriesLinux :: BattOpts -> [Files] -> IO Result
	245	readBatteriesLinux opts bfs =
192	246	do let bfs' = filter (/= NoFiles) bfs
193	247	bats <- mapM (readBattery (scale opts)) (take 3 bfs')
194	248	ac <- haveAc (onlineFile opts)

209	263	\| otherwise = Discharging
210	264	unless ac (maybeAlert opts left)
211	265	return $ if isNaN left then NA else Result left watts time racst
	266	#endif
212	267
213	268	runBatt :: [String] -> Monitor String
214	269	runBatt = runBatt' ["BAT", "BAT0", "BAT1", "BAT2"]
215	270
216	271	runBatt' :: [String] -> [String] -> Monitor String
217	272	runBatt' bfs args = do
218		opts <- io $ parseOpts args
219		c <- io $ readBatteries opts =<< mapM batteryFiles bfs
	273	opts <- io $ parseOptsWith options defaultOpts args
	274	#ifdef FREEBSD
	275	c <- io $ readBatteriesFbsd opts
	276	#else
	277	c <- io $ readBatteriesLinux opts =<< mapM batteryFiles bfs
	278	#endif
	279	formatResult c opts
	280
	281	formatResult :: Result -> BattOpts -> Monitor String
	282	formatResult res bopt = do
	283	let sp = incPerc bopt
220	284	suffix <- getConfigValue useSuffix
221	285	d <- getConfigValue decDigits
222	286	nas <- getConfigValue naString
223		case c of
	287	case res of
224	288	Result x w t s ->
225		do l <- fmtPercent x
226		ws <- fmtWatts w opts suffix d
227		si <- getIconPattern opts s x
228		st <- showWithColors' (fmtStatus opts s nas) (100 * x)
	289	do l <- fmtPercent x sp
	290	ws <- fmtWatts w bopt suffix d
	291	si <- getIconPattern bopt s x
	292	st <- showWithColors'
	293	(fmtStatus bopt s nas (getBattStatus x bopt))
	294	(100 * x)
229	295	parseTemplate (l ++ [st, fmtTime $ floor t, ws, si])
230	296	NA -> getConfigValue naString
231		where fmtPercent :: Float -> Monitor [String]
232		fmtPercent x = do
	297	where fmtPercent :: Float -> Bool -> Monitor [String]
	298	fmtPercent x sp = do
233	299	let x' = minimum [1, x]
	300	pc <- if sp then colorizeString (100 * x') "%" else return ""
234	301	p <- showPercentWithColors x'
235	302	b <- showPercentBar (100 * x') x'
236	303	vb <- showVerticalBar (100 * x') x'
237		return [b, vb, p]
	304	return [b, vb, p ++ pc]
238	305	fmtWatts x o s d = do
239	306	ws <- showWithPadding $ showDigits d x ++ (if s then "W" else "")
240	307	return $ color x o ws

243	310	then minutes else '0' : minutes
244	311	where hours = show (x `div` 3600)
245	312	minutes = show ((x `mod` 3600) `div` 60)
246		fmtStatus opts Idle _ = idleString opts
247		fmtStatus _ Unknown na = na
248		fmtStatus opts Full _ = idleString opts
249		fmtStatus opts Charging _ = onString opts
250		fmtStatus opts Discharging _ = offString opts
	313	fmtStatus
	314	:: BattOpts
	315	-> Status
	316	-> String -- ^ What to in case battery status is unknown
	317	-> BatteryStatus
	318	-> String
	319	fmtStatus opts Idle _ _ = idleString opts
	320	fmtStatus _ Unknown na _ = na
	321	fmtStatus opts Full _ _ = idleString opts
	322	fmtStatus opts Charging _ _ = onString opts
	323	fmtStatus opts Discharging _ battStatus =
	324	(case battStatus of
	325	BattHigh -> highString
	326	BattMedium -> mediumString
	327	BattLow -> lowString) opts ++ offString opts
251	328	maybeColor Nothing str = str
252	329	maybeColor (Just c) str = "<fc=" ++ c ++ ">" ++ str ++ "</fc>"
253	330	color x o \| x >= 0 = maybeColor (posColor o)

+1

-8

src/Xmobar/Plugins/Monitors/Bright.hs less more

43	43	o { curBrightIconPattern = Just $ parseIconPattern x }) "") ""
44	44	]
45	45
46		-- from Batt.hs
47		parseOpts :: [String] -> IO BrightOpts
48		parseOpts argv =
49		case getOpt Permute options argv of
50		(o, _, []) -> return $ foldr id defaultOpts o
51		(_, _, errs) -> ioError . userError $ concat errs
52
53	46	sysDir :: FilePath
54	47	sysDir = "/sys/class/backlight/"
55	48

74	67
75	68	runBright :: [String] -> Monitor String
76	69	runBright args = do
77		opts <- io $ parseOpts args
	70	opts <- io $ parseOptsWith options defaultOpts args
78	71	f <- io $ brightFiles opts
79	72	c <- io $ readBright f
80	73	case f of

+2

-1

src/Xmobar/Plugins/Monitors/Common/Output.hs less more

0	0	------------------------------------------------------------------------------
1	1	-- \|
2	2	-- Module: Xmobar.Plugins.Monitors.Strings
3		-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz
	3	-- Copyright: (c) 2018, 2019 Jose Antonio Ortega Ruiz
4	4	-- License: BSD3-style (see LICENSE)
5	5	--
6	6	-- Maintainer: jao@gnu.org

17	17	module Xmobar.Plugins.Monitors.Common.Output ( IconPattern
18	18	, parseIconPattern
19	19	, padString
	20	, colorizeString
20	21	, showWithPadding
21	22	, showWithColors
22	23	, showWithColors'

+13

-0

src/Xmobar/Plugins/Monitors/Common/Parsers.hs less more

23	23	, skipTillString
24	24	, parseTemplate
25	25	, parseTemplate'
	26	, parseOptsWith
26	27	) where
27	28
28	29	import Xmobar.Plugins.Monitors.Common.Types
29	30
30	31	import Control.Applicative ((<$>))
31	32	import qualified Data.Map as Map
	33	import System.Console.GetOpt (ArgOrder(Permute), OptDescr, getOpt)
32	34	import Text.ParserCombinators.Parsec
33	35
34	36	runP :: Parser [a] -> String -> IO [a]

149	151	Nothing -> return $ "<" ++ ts ++ ">"
150	152	Just r -> let f "" = r; f n = n; in f <$> parseTemplate' r m
151	153	return $ s ++ str ++ ss ++ next
	154
	155	-- \| Try to parse arguments from the config file and apply them to Options.
	156	parseOptsWith
	157	:: [OptDescr (opts -> opts)] -- ^ Options that are specifiable
	158	-> opts -- ^ Default options to use as a fallback
	159	-> [String] -- ^ Actual arguments given
	160	-> IO opts
	161	parseOptsWith options defaultOpts argv =
	162	case getOpt Permute options argv of
	163	(o, _, [] ) -> pure $ foldr id defaultOpts o
	164	(_, _, errs) -> ioError . userError $ concat errs

+24

-3

src/Xmobar/Plugins/Monitors/Common/Run.hs less more

18	18	, runMD
19	19	, runMB
20	20	, runMBD
	21	, runML
	22	, runMLD
	23	, getArgvs
21	24	) where
22	25
23	26	import Control.Exception (SomeException,handle)

26	29	import System.Console.GetOpt
27	30
28	31	import Xmobar.Plugins.Monitors.Common.Types
29		import Xmobar.Run.Exec (tenthSeconds)
	32	import Xmobar.Run.Exec (doEveryTenthSeconds)
30	33
31	34	options :: [OptDescr Opts]
32	35	options =

53	56	, Option "T" ["maxtwidth"] (ReqArg MaxTotalWidth "Maximum total width") "Maximum total width"
54	57	, Option "E" ["maxtwidthellipsis"] (ReqArg MaxTotalWidthEllipsis "Maximum total width ellipsis") "Ellipsis to be added to the total text when it has reached its max width."
55	58	]
	59
	60	-- \| Get all argument values out of a list of arguments.
	61	getArgvs :: [String] -> [String]
	62	getArgvs args =
	63	case getOpt Permute options args of
	64	(_, n, [] ) -> n
	65	(_, _, errs) -> errs
56	66
57	67	doArgs :: [String]
58	68	-> ([String] -> Monitor String)

99	109
100	110	runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int
101	111	-> (String -> IO ()) -> IO ()
102		runM args conf action r = runMB args conf action (tenthSeconds r)
	112	runM args conf action r = runML args conf action (doEveryTenthSeconds r)
103	113
104	114	runMD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int
105	115	-> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO ()
106		runMD args conf action r = runMBD args conf action (tenthSeconds r)
	116	runMD args conf action r = runMLD args conf action (doEveryTenthSeconds r)
107	117
108	118	runMB :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO ()
109	119	-> (String -> IO ()) -> IO ()

115	125	where ac = doArgs args action detect
116	126	loop = conf >>= runReaderT ac >>= cb >> wait >> loop
117	127
	128	runML :: [String] -> IO MConfig -> ([String] -> Monitor String)
	129	-> (IO () -> IO ()) -> (String -> IO ()) -> IO ()
	130	runML args conf action looper = runMLD args conf action looper (\_ -> return True)
	131
	132	runMLD :: [String] -> IO MConfig -> ([String] -> Monitor String)
	133	-> (IO () -> IO ()) -> ([String] -> Monitor Bool) -> (String -> IO ())
	134	-> IO ()
	135	runMLD args conf action looper detect cb = handle (cb . showException) loop
	136	where ac = doArgs args action detect
	137	loop = looper $ conf >>= runReaderT ac >>= cb
	138
118	139	showException :: SomeException -> String
119	140	showException = ("error: "++) . show . flip asTypeOf undefined

+3

-2

src/Xmobar/Plugins/Monitors/Common/Types.hs less more

24	24	, io
25	25	) where
26	26
27		import Data.IORef
28		import Control.Monad.Reader
	27	import Control.Monad.Reader (ReaderT, ask, liftIO)
	28	import Data.IORef (IORef, modifyIORef, newIORef, readIORef)
	29
29	30
30	31	type Monitor a = ReaderT MConfig IO a
31	32

+1

-2

src/Xmobar/Plugins/Monitors/CoreTemp.hs less more

24	24	coreTempConfig :: IO MConfig
25	25	coreTempConfig = mkMConfig
26	26	"Temp: <core0>C" -- template
27		(map ((++) "core" . show) [0 :: Int ..]) -- available
28		-- replacements
	27	(map ((++) "core" . show) [0 :: Int ..]) -- available replacements
29	28
30	29	-- \|
31	30	-- Function retrieves monitor string holding the core temperature

+1

-7

src/Xmobar/Plugins/Monitors/Cpu.hs less more

34	34	o { loadIconPattern = Just $ parseIconPattern x }) "") ""
35	35	]
36	36
37		parseOpts :: [String] -> IO CpuOpts
38		parseOpts argv =
39		case getOpt Permute options argv of
40		(o, _, []) -> return $ foldr id defaultOpts o
41		(_, _, errs) -> ioError . userError $ concat errs
42
43	37	cpuConfig :: IO MConfig
44	38	cpuConfig = mkMConfig
45	39	"Cpu: <total>%"

76	70	runCpu :: CpuDataRef -> [String] -> Monitor String
77	71	runCpu cref argv =
78	72	do c <- io (parseCpu cref)
79		opts <- io $ parseOpts argv
	73	opts <- io $ parseOptsWith options defaultOpts argv
80	74	l <- formatCpu opts c
81	75	parseTemplate l
82	76

+44

-41

src/Xmobar/Plugins/Monitors/Disk.hs less more

30	30	{ totalIconPattern :: Maybe IconPattern
31	31	, writeIconPattern :: Maybe IconPattern
32	32	, readIconPattern :: Maybe IconPattern
	33	, contiguous :: Bool
33	34	}
34	35
35		parseDiskIOOpts :: [String] -> IO DiskIOOpts
36		parseDiskIOOpts argv =
37		case getOpt Permute options argv of
38		(o, _, []) -> return $ foldr id defaultOpts o
39		(_, _, errs) -> ioError . userError $ concat errs
40		where defaultOpts = DiskIOOpts
41		{ totalIconPattern = Nothing
42		, writeIconPattern = Nothing
43		, readIconPattern = Nothing
44		}
45		options =
46		[ Option "" ["total-icon-pattern"] (ReqArg (\x o ->
47		o { totalIconPattern = Just $ parseIconPattern x}) "") ""
48		, Option "" ["write-icon-pattern"] (ReqArg (\x o ->
49		o { writeIconPattern = Just $ parseIconPattern x}) "") ""
50		, Option "" ["read-icon-pattern"] (ReqArg (\x o ->
51		o { readIconPattern = Just $ parseIconPattern x}) "") ""
52		]
	36	dioDefaultOpts :: DiskIOOpts
	37	dioDefaultOpts = DiskIOOpts
	38	{ totalIconPattern = Nothing
	39	, writeIconPattern = Nothing
	40	, readIconPattern = Nothing
	41	, contiguous = False
	42	}
	43
	44	dioOptions :: [OptDescr (DiskIOOpts -> DiskIOOpts)]
	45	dioOptions =
	46	[ Option "" ["total-icon-pattern"] (ReqArg (\x o ->
	47	o { totalIconPattern = Just $ parseIconPattern x}) "") ""
	48	, Option "" ["write-icon-pattern"] (ReqArg (\x o ->
	49	o { writeIconPattern = Just $ parseIconPattern x}) "") ""
	50	, Option "" ["read-icon-pattern"] (ReqArg (\x o ->
	51	o { readIconPattern = Just $ parseIconPattern x}) "") ""
	52	, Option "c" ["contiguous"] (NoArg (\o -> o {contiguous = True})) ""
	53	]
53	54
54	55	diskIOConfig :: IO MConfig
55	56	diskIOConfig = mkMConfig "" ["total", "read", "write"

65	66	data DiskUOpts = DiskUOpts
66	67	{ freeIconPattern :: Maybe IconPattern
67	68	, usedIconPattern :: Maybe IconPattern
	69	, contiguousU :: Bool
68	70	}
69	71
70		parseDiskUOpts :: [String] -> IO DiskUOpts
71		parseDiskUOpts argv =
72		case getOpt Permute options argv of
73		(o, _, []) -> return $ foldr id defaultOpts o
74		(_, _, errs) -> ioError . userError $ concat errs
75		where defaultOpts = DiskUOpts
76		{ freeIconPattern = Nothing
77		, usedIconPattern = Nothing
78		}
79		options =
80		[ Option "" ["free-icon-pattern"] (ReqArg (\x o ->
81		o { freeIconPattern = Just $ parseIconPattern x}) "") ""
82		, Option "" ["used-icon-pattern"] (ReqArg (\x o ->
83		o { usedIconPattern = Just $ parseIconPattern x}) "") ""
84		]
	72	duDefaultOpts :: DiskUOpts
	73	duDefaultOpts = DiskUOpts
	74	{ freeIconPattern = Nothing
	75	, usedIconPattern = Nothing
	76	, contiguousU = False
	77	}
	78
	79	duOptions :: [OptDescr (DiskUOpts -> DiskUOpts)]
	80	duOptions =
	81	[ Option "" ["free-icon-pattern"] (ReqArg (\x o ->
	82	o { freeIconPattern = Just $ parseIconPattern x}) "") ""
	83	, Option "" ["used-icon-pattern"] (ReqArg (\x o ->
	84	o { usedIconPattern = Just $ parseIconPattern x}) "") ""
	85	, Option "c" ["contiguous"] (NoArg (\o -> o {contiguousU = True})) ""
	86	]
85	87
86	88	diskUConfig :: IO MConfig
87	89	diskUConfig = mkMConfig ""

146	148	return $ map (parseDev (zipWith diff dt' dt)) devs
147	149	where diff (dev, xs) (_, ys) = (dev, zipWith (-) xs ys)
148	150
	151
149	152	parseDev :: [(DevName, [Float])] -> DevName -> (DevName, [Float])
150	153	parseDev dat dev =
151	154	case find ((==dev) . fst) dat of
152	155	Nothing -> (dev, [0, 0, 0])
153	156	Just (_, xs) ->
154		let r = xs !! 2
155		w = xs !! 6
	157	let r = 4096 * xs !! 2
	158	w = 4096 * xs !! 6
156	159	t = r + w
157	160	rSp = speed r (xs !! 3)
158	161	wSp = speed w (xs !! 7)
159	162	sp = speed t (xs !! 3 + xs !! 7)
160		speed x d = if d == 0 then 0 else 500 * x / d
	163	speed x d = if d == 0 then 0 else x / d
161	164	dat' = if length xs > 6
162	165	then [sp, rSp, wSp, t, r, w]
163	166	else [0, 0, 0, 0, 0, 0]
164	167	in (dev, dat')
165	168
166	169	speedToStr :: Float -> String
167		speedToStr = showWithUnits 2 1
	170	speedToStr = showWithUnits 2 1 . (/ 1024)
168	171
169	172	sizeToStr :: Integer -> String
170	173	sizeToStr = showWithUnits 3 0 . fromIntegral

200	203
201	204	runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String
202	205	runDiskIO dref disks argv = do
203		opts <- io $ parseDiskIOOpts argv
	206	opts <- io $ parseOptsWith dioOptions dioDefaultOpts argv
204	207	dev <- io $ mountedOrDiskDevices (map fst disks)
205	208	dat <- io $ mountedData dref (map fst dev)
206	209	strs <- mapM (runDiskIO' opts) $ devTemplates disks dev dat
207		return $ unwords strs
	210	return $ (if contiguous opts then concat else unwords) strs
208	211
209	212	startDiskIO :: [(String, String)] ->
210	213	[String] -> Int -> (String -> IO ()) -> IO ()

246	249	runDiskU :: [(String, String)] -> [String] -> Monitor String
247	250	runDiskU disks argv = do
248	251	devs <- io $ mountedDevices (map fst disks)
249		opts <- io $ parseDiskUOpts argv
	252	opts <- io $ parseOptsWith duOptions duDefaultOpts argv
250	253	strs <- mapM (\(d, p) -> runDiskU' opts (findTempl d p disks) p) devs
251		return $ unwords strs
	254	return $ (if contiguousU opts then concat else unwords) strs

+18

-14

src/Xmobar/Plugins/Monitors/MPD.hs less more

33	33	, mStopped :: String
34	34	, mPaused :: String
35	35	, mLapsedIconPattern :: Maybe IconPattern
	36	, mPort :: Maybe String
	37	, mHost :: Maybe String
36	38	}
37	39
38	40	defaultOpts :: MOpts

41	43	, mStopped = "><"
42	44	, mPaused = "\|\|"
43	45	, mLapsedIconPattern = Nothing
	46	, mPort = Nothing
	47	, mHost = Nothing
44	48	}
45	49
46	50	options :: [OptDescr (MOpts -> MOpts)]

48	52	[ Option "P" ["playing"] (ReqArg (\x o -> o { mPlaying = x }) "") ""
49	53	, Option "S" ["stopped"] (ReqArg (\x o -> o { mStopped = x }) "") ""
50	54	, Option "Z" ["paused"] (ReqArg (\x o -> o { mPaused = x }) "") ""
	55	, Option "p" ["port"] (ReqArg (\x o -> o { mPort = Just x }) "") ""
	56	, Option "h" ["host"] (ReqArg (\x o -> o { mHost = Just x }) "") ""
51	57	, Option "" ["lapsed-icon-pattern"] (ReqArg (\x o ->
52	58	o { mLapsedIconPattern = Just $ parseIconPattern x }) "") ""
53	59	]
54	60
	61	withMPD :: MOpts -> M.MPD a -> IO (M.Response a)
	62	withMPD opts = M.withMPD_ (mHost opts) (mPort opts)
	63
55	64	runMPD :: [String] -> Monitor String
56	65	runMPD args = do
57		opts <- io $ mopts args
58		status <- io $ M.withMPD M.status
59		song <- io $ M.withMPD M.currentSong
	66	opts <- io $ parseOptsWith options defaultOpts args
	67	status <- io $ withMPD opts M.status
	68	song <- io $ withMPD opts M.currentSong
60	69	s <- parseMPD status song opts
61	70	parseTemplate s
62	71

68	77	_ -> return ()
69	78
70	79	mpdReady :: [String] -> Monitor Bool
71		mpdReady _ = do
72		response <- io $ M.withMPD M.ping
	80	mpdReady args = do
	81	opts <- io $ parseOptsWith options defaultOpts args
	82	response <- io $ withMPD opts M.ping
73	83	case response of
74	84	Right _ -> return True
75	85	-- Only cases where MPD isn't responding is an issue; bogus information at

77	87	Left M.NoMPD -> return False
78	88	Left (M.ConnectionError _) -> return False
79	89	Left _ -> return True
80
81		mopts :: [String] -> IO MOpts
82		mopts argv =
83		case getOpt Permute options argv of
84		(o, _, []) -> return $ foldr id defaultOpts o
85		(_, _, errs) -> ioError . userError $ concat errs
86	90
87	91	parseMPD :: M.Response M.Status -> M.Response (Maybe M.Song) -> MOpts
88	92	-> Monitor [String]

98	102	si = stateGlyph s opts
99	103	vol = int2str $ fromMaybe 0 (M.stVolume st)
100	104	(p, t) = fromMaybe (0, 0) (M.stTime st)
101		[lap, len, remain] = map showTime [floor p, t, max 0 (t - floor p)]
102		b = if t > 0 then realToFrac $ p / fromIntegral t else 0
	105	[lap, len, remain] = map showTime [floor p, floor t, max 0 (floor t - floor p)]
	106	b = if t > 0 then realToFrac $ p / t else 0
103	107	plen = int2str $ M.stPlaylistLength st
104	108	ppos = maybe "" (int2str . (+1)) $ M.stSongPos st
105	109	flags = playbackMode st
106	110
107		stateGlyph :: M.State -> MOpts -> String
	111	stateGlyph :: M.PlaybackState -> MOpts -> String
108	112	stateGlyph s o =
109	113	case s of
110	114	M.Playing -> mPlaying o

+1

-7

src/Xmobar/Plugins/Monitors/Mem.hs less more

39	39	, Option "" ["available-icon-pattern"] (ReqArg (\x o ->
40	40	o { availableIconPattern = Just $ parseIconPattern x }) "") ""
41	41	]
42
43		parseOpts :: [String] -> IO MemOpts
44		parseOpts argv =
45		case getOpt Permute options argv of
46		(o, _, []) -> return $ foldr id defaultOpts o
47		(_, _, errs) -> ioError . userError $ concat errs
48	42
49	43	memConfig :: IO MConfig
50	44	memConfig = mkMConfig

90	84	runMem :: [String] -> Monitor String
91	85	runMem argv =
92	86	do m <- io parseMEM
93		opts <- io $ parseOpts argv
	87	opts <- io $ parseOptsWith options defaultOpts argv
94	88	l <- formatMem opts m
95	89	parseTemplate l

+1

-7

src/Xmobar/Plugins/Monitors/MultiCoreTemp.hs less more

58	58	"")
59	59	""
60	60	]
61
62		-- \| Parse Arguments and apply them to Options.
63		parseOpts :: [String] -> IO CTOpts
64		parseOpts argv = case getOpt Permute options argv of
65		(opts , _ , [] ) -> return $ foldr id defaultOpts opts
66		(_ , _ , errs) -> ioError . userError $ concat errs
67	61
68	62	-- \| Generate Config with a default template and options.
69	63	cTConfig :: IO MConfig

156	150
157	151	runCT :: [String] -> Monitor String
158	152	runCT argv = do cTs <- io parseCT
159		opts <- io $ parseOpts argv
	153	opts <- io $ parseOptsWith options defaultOpts argv
160	154	l <- formatCT opts cTs
161	155	parseTemplate l
162	156

+13

-13

src/Xmobar/Plugins/Monitors/MultiCpu.hs less more

24	24	{ loadIconPatterns :: [IconPattern]
25	25	, loadIconPattern :: Maybe IconPattern
26	26	, fallbackIconPattern :: Maybe IconPattern
	27	, contiguous :: Bool
27	28	}
28	29
29	30	defaultOpts :: MultiCpuOpts

31	32	{ loadIconPatterns = []
32	33	, loadIconPattern = Nothing
33	34	, fallbackIconPattern = Nothing
	35	, contiguous = False
34	36	}
35	37
36	38	options :: [OptDescr (MultiCpuOpts -> MultiCpuOpts)]

41	43	o { loadIconPatterns = parseIconPattern x : loadIconPatterns o }) "") ""
42	44	, Option "" ["fallback-icon-pattern"] (ReqArg (\x o ->
43	45	o { fallbackIconPattern = Just $ parseIconPattern x }) "") ""
	46	, Option "" ["contiguous-icons"] (NoArg (\o -> o {contiguous = True})) ""
44	47	]
45
46		parseOpts :: [String] -> IO MultiCpuOpts
47		parseOpts argv =
48		case getOpt Permute options argv of
49		(o, _, []) -> return $ foldr id defaultOpts o
50		(_, _, errs) -> ioError . userError $ concat errs
51	48
52	49	variables :: [String]
53	50	variables = ["bar", "vbar","ipat","total","user","nice","system","idle"]

86	83
87	84	formatMultiCpus :: MultiCpuOpts -> [[Float]] -> Monitor [String]
88	85	formatMultiCpus _ [] = return []
89		formatMultiCpus opts xs = concat <$> mapM (\(i, x) -> formatCpu opts i x) (zip [0..] xs)
	86	formatMultiCpus opts xs =
	87	concat <$> mapM (\(i, x) -> formatCpu opts i x) (zip [0..] xs)
90	88
91	89	formatCpu :: MultiCpuOpts -> Int -> [Float] -> Monitor [String]
92	90	formatCpu opts i xs

99	97	return (b:h:d:ps)
100	98	where tryString
101	99	\| i == 0 = loadIconPattern opts
102		\| i <= length (loadIconPatterns opts) = Just $ loadIconPatterns opts !! (i - 1)
	100	\| i <= length (loadIconPatterns opts) =
	101	Just $ loadIconPatterns opts !! (i - 1)
103	102	\| otherwise = fallbackIconPattern opts
104	103
105	104	splitEvery :: Int -> [a] -> [[a]]

108	107	groupData :: [String] -> [[String]]
109	108	groupData = transpose . tail . splitEvery vNum
110	109
111		formatAutoCpus :: [String] -> Monitor [String]
112		formatAutoCpus [] = return $ replicate vNum ""
113		formatAutoCpus xs = return $ map unwords (groupData xs)
	110	formatAutoCpus :: MultiCpuOpts -> [String] -> Monitor [String]
	111	formatAutoCpus _ [] = return $ replicate vNum ""
	112	formatAutoCpus opts xs =
	113	return $ map (if contiguous opts then concat else unwords) (groupData xs)
114	114
115	115	runMultiCpu :: CpuDataRef -> [String] -> Monitor String
116	116	runMultiCpu cref argv =
117	117	do c <- io $ parseCpuData cref
118		opts <- io $ parseOpts argv
	118	opts <- io $ parseOptsWith options defaultOpts argv
119	119	l <- formatMultiCpus opts c
120		a <- formatAutoCpus l
	120	a <- formatAutoCpus opts l
121	121	parseTemplate $ a ++ l
122	122
123	123	startMultiCpu :: [String] -> Int -> (String -> IO ()) -> IO ()

+54

-45

src/Xmobar/Plugins/Monitors/Net.hs less more

12	12	--
13	13	-----------------------------------------------------------------------------
14	14
	15	{-# LANGUAGE OverloadedStrings #-}
	16
15	17	module Xmobar.Plugins.Monitors.Net (
16	18	startNet
17	19	, startDynNet

19	21
20	22	import Xmobar.Plugins.Monitors.Common
21	23
	24	import Data.IORef (IORef, newIORef, readIORef, writeIORef)
	25	import Data.Monoid ((<>))
	26	import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime)
22	27	import Data.Word (Word64)
23		import Data.IORef (IORef, newIORef, readIORef, writeIORef)
24		import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime)
25	28	import Control.Monad (forM, filterM)
26	29	import System.Directory (getDirectoryContents, doesFileExist)
27	30	import System.FilePath ((</>))
28	31	import System.Console.GetOpt
29	32	import System.IO.Error (catchIOError)
30
31		import qualified Data.ByteString.Lazy.Char8 as B
	33	import System.IO.Unsafe (unsafeInterleaveIO)
	34
	35	import qualified Data.ByteString.Char8 as B
	36
	37	type DevList = [String]
	38
	39	parseDevList :: String -> DevList
	40	parseDevList = splitOnComma
	41	where splitOnComma [] = [[]]
	42	splitOnComma (',':xs) = [] : splitOnComma xs
	43	splitOnComma (x:xs) =
	44	let rest = splitOnComma xs
	45	in (x : head rest) : tail rest
32	46
33	47	data NetOpts = NetOpts
34	48	{ rxIconPattern :: Maybe IconPattern
35	49	, txIconPattern :: Maybe IconPattern
	50	, onlyDevList :: Maybe DevList
36	51	}
37	52
38	53	defaultOpts :: NetOpts
39	54	defaultOpts = NetOpts
40	55	{ rxIconPattern = Nothing
41	56	, txIconPattern = Nothing
	57	, onlyDevList = Nothing
42	58	}
43	59
44	60	options :: [OptDescr (NetOpts -> NetOpts)]

47	63	o { rxIconPattern = Just $ parseIconPattern x }) "") ""
48	64	, Option "" ["tx-icon-pattern"] (ReqArg (\x o ->
49	65	o { txIconPattern = Just $ parseIconPattern x }) "") ""
	66	, Option "" ["devices"] (ReqArg (\x o ->
	67	o { onlyDevList = Just $ parseDevList x }) "") ""
50	68	]
51
52		parseOpts :: [String] -> IO NetOpts
53		parseOpts argv =
54		case getOpt Permute options argv of
55		(o, _, []) -> return $ foldr id defaultOpts o
56		(_, _, errs) -> ioError . userError $ concat errs
57	69
58	70	data UnitPerSec = Bs \| KBs \| MBs \| GBs deriving (Eq,Enum,Ord)
59	71	data NetValue = NetValue Float UnitPerSec deriving (Eq,Show)

64	76	show MBs = "MB/s"
65	77	show GBs = "GB/s"
66	78
67		data NetDev num
68		= NA
69		\| NI String
70		\| ND String num num deriving (Eq,Show,Read)
	79	data NetDev num = N String (NetDevInfo num) \| NA deriving (Eq,Show,Read)
	80	data NetDevInfo num = NI \| ND num num deriving (Eq,Show,Read)
71	81
72	82	type NetDevRawTotal = NetDev Word64
73	83	type NetDevRate = NetDev Float

78	88	-- Note that names don't matter. Therefore, if only the names differ,
79	89	-- a compare evaluates to EQ while (==) evaluates to False.
80	90	instance Ord num => Ord (NetDev num) where
81		compare NA NA = EQ
82		compare NA _ = LT
83		compare _ NA = GT
84		compare (NI _) (NI _) = EQ
85		compare (NI _) ND {} = LT
86		compare ND {} (NI _) = GT
87		compare (ND _ x1 y1) (ND _ x2 y2) =
88		if downcmp /= EQ
89		then downcmp
90		else y1 `compare` y2
91		where downcmp = x1 `compare` x2
	91	compare NA NA = EQ
	92	compare NA _ = LT
	93	compare _ NA = GT
	94	compare (N _ i1) (N _ i2) = i1 `compare` i2
	95
	96	instance Ord num => Ord (NetDevInfo num) where
	97	compare NI NI = EQ
	98	compare NI ND {} = LT
	99	compare ND {} NI = GT
	100	compare (ND x1 y1) (ND x2 y2) = x1 `compare` x2 <> y1 `compare` y2
92	101
93	102	netConfig :: IO MConfig
94	103	netConfig = mkMConfig

107	116	isUp :: String -> IO Bool
108	117	isUp d = flip catchIOError (const $ return False) $ do
109	118	operstate <- B.readFile (operstateDir d)
110		return $! (B.unpack . head . B.lines) operstate `elem` ["up", "unknown"]
	119	return $! (head . B.lines) operstate `elem` ["up", "unknown"]
111	120
112	121	readNetDev :: [String] -> IO NetDevRawTotal
113		readNetDev (d:x:y:_) = do
114		up <- isUp d
115		return (if up then ND d (r x) (r y) else NI d)
	122	readNetDev ~[d, x, y] = do
	123	up <- unsafeInterleaveIO $ isUp d
	124	return $ N d (if up then ND (r x) (r y) else NI)
116	125	where r s \| s == "" = 0
117	126	\| otherwise = read s
118
119		readNetDev _ = return NA
120	127
121	128	netParser :: B.ByteString -> IO [NetDevRawTotal]
122	129	netParser = mapM (readNetDev . splitDevLine) . readDevLines
123	130	where readDevLines = drop 2 . B.lines
124		splitDevLine = selectCols . wordsBy (`elem` " :") . B.unpack
	131	splitDevLine = map B.unpack . selectCols . filter (not . B.null) . B.splitWith (`elem` [' ',':'])
125	132	selectCols cols = map (cols!!) [0,1,9]
126		wordsBy f s = case dropWhile f s of
127		[] -> []
128		s' -> w : wordsBy f s'' where (w, s'') = break f s'
129	133
130	134	findNetDev :: String -> IO NetDevRawTotal
131	135	findNetDev dev = do

133	137	case filter isDev nds of
134	138	x:_ -> return x
135	139	_ -> return NA
136		where isDev (ND d _ _) = d == dev
137		isDev (NI d) = d == dev
	140	where isDev (N d _) = d == dev
138	141	isDev NA = False
139	142
140	143	formatNet :: Maybe IconPattern -> Float -> Monitor (String, String, String, String)

153	156	printNet :: NetOpts -> NetDevRate -> Monitor String
154	157	printNet opts nd =
155	158	case nd of
156		ND d r t -> do
	159	N d (ND r t) -> do
157	160	(rx, rb, rvb, ripat) <- formatNet (rxIconPattern opts) r
158	161	(tx, tb, tvb, tipat) <- formatNet (txIconPattern opts) t
159	162	parseTemplate [d,rx,tx,rb,rvb,ripat,tb,tvb,tipat]
160		NI _ -> return ""
	163	N _ NI -> return ""
161	164	NA -> getConfigValue naString
162	165
163	166	parseNet :: NetDevRef -> String -> IO NetDevRate

169	172	let scx = realToFrac (diffUTCTime t1 t0)
170	173	scx' = if scx > 0 then scx else 1
171	174	rate da db = takeDigits 2 $ fromIntegral (db - da) / scx'
172		diffRate (ND d ra ta) (ND _ rb tb) = ND d (rate ra rb) (rate ta tb)
173		diffRate (NI d) _ = NI d
174		diffRate _ (NI d) = NI d
	175	diffRate (N d (ND ra ta)) (N _ (ND rb tb)) = N d (ND (rate ra rb) (rate ta tb))
	176	diffRate (N d NI) _ = N d NI
	177	diffRate _ (N d NI) = N d NI
175	178	diffRate _ _ = NA
176	179	return $ diffRate n0 n1
177	180
178	181	runNet :: NetDevRef -> String -> [String] -> Monitor String
179	182	runNet nref i argv = do
180	183	dev <- io $ parseNet nref i
181		opts <- io $ parseOpts argv
	184	opts <- io $ parseOptsWith options defaultOpts argv
182	185	printNet opts dev
183	186
184	187	parseNets :: [(NetDevRef, String)] -> IO [NetDevRate]

186	189
187	190	runNets :: [(NetDevRef, String)] -> [String] -> Monitor String
188	191	runNets refs argv = do
189		dev <- io $ parseActive refs
190		opts <- io $ parseOpts argv
	192	opts <- io $ parseOptsWith options defaultOpts argv
	193	dev <- io $ parseActive $ filterRefs opts refs
191	194	printNet opts dev
192	195	where parseActive refs' = fmap selectActive (parseNets refs')
	196	refInDevList opts' (_, refname') = case onlyDevList opts' of
	197	Just theList -> refname' `elem` theList
	198	Nothing -> True
	199	filterRefs opts' refs' = case filter (refInDevList opts') refs' of
	200	[] -> refs'
	201	xs -> xs
193	202	selectActive = maximum
194	203
195	204	startNet :: String -> [String] -> Int -> (String -> IO ()) -> IO ()

+69

-17

src/Xmobar/Plugins/Monitors/UVMeter.hs less more

18	18
19	19	import qualified Control.Exception as CE
20	20	import Network.HTTP.Conduit
21		(parseRequest, newManager, tlsManagerSettings, httpLbs,
22		responseBody)
	21	( Manager
	22	, httpLbs
	23	, managerConnCount
	24	, newManager
	25	, parseRequest
	26	, responseBody
	27	, tlsManagerSettings
	28	)
23	29	import Data.ByteString.Lazy.Char8 as B
	30	import Data.Maybe (fromMaybe)
	31	import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(Option))
24	32	import Text.Read (readMaybe)
25	33	import Text.Parsec
26	34	import Text.Parsec.String
27	35	import Control.Monad (void)
28	36
	37
	38	-- \| Options the user may specify.
	39	newtype UVMeterOpts = UVMeterOpts
	40	{ useManager :: Bool
	41	}
	42
	43	-- \| Default values for options.
	44	defaultOpts :: UVMeterOpts
	45	defaultOpts = UVMeterOpts
	46	{ useManager = True
	47	}
	48
	49	-- \| Apply options.
	50	options :: [OptDescr (UVMeterOpts -> UVMeterOpts)]
	51	options =
	52	[ Option "m" ["useManager"] (ReqArg (\m o -> o { useManager = read m }) "") ""
	53	]
29	54
30	55	uvConfig :: IO MConfig
31	56	uvConfig = mkMConfig

39	64	uvURL :: String
40	65	uvURL = "https://uvdata.arpansa.gov.au/xml/uvvalues.xml"
41	66
42		getData :: IO String
43		getData =
44		CE.catch (do request <- parseRequest uvURL
45		manager <- newManager tlsManagerSettings
46		res <- httpLbs request manager
47		return $ B.unpack $ responseBody res)
48		errHandler
49		where errHandler
50		:: CE.SomeException -> IO String
51		errHandler _ = return "<Could not retrieve data>"
	67	-- \| Get the UV data from the given url.
	68	getData :: Maybe Manager -> IO String
	69	getData uvMan = CE.catch
	70	(do man <- flip fromMaybe uvMan <$> mkManager
	71	-- Create a new manager if none was present or the user does not want to
	72	-- use one, otherwise use the provided manager.
	73	request <- parseRequest uvURL
	74	res <- httpLbs request man
	75	return $ B.unpack $ responseBody res)
	76	errHandler
	77	where
	78	errHandler :: CE.SomeException -> IO String
	79	errHandler _ = return "<Could not retrieve data>"
52	80
53	81	textToXMLDocument :: String -> Either ParseError [XML]
54	82	textToXMLDocument = parse document ""

68	96	getUVRating locID (_:xs) = getUVRating locID xs
69	97	getUVRating _ [] = Nothing
70	98
71
72		runUVMeter :: [String] -> Monitor String
73		runUVMeter [] = return "N.A."
74		runUVMeter (s:_) = do
75		resp <- io getData
	99	-- \| Start the uvmeter monitor, create a new 'Maybe Manager', should the user have
	100	-- chosen to use one.
	101	startUVMeter
	102	:: String -- ^ Station
	103	-> [String] -- ^ User supplied arguments
	104	-> Int -- ^ Update rate
	105	-> (String -> IO ())
	106	-> IO ()
	107	startUVMeter station args rate cb = do
	108	opts <- parseOptsWith options defaultOpts (getArgvs args)
	109	uvMan <- tryMakeManager opts
	110	runM (station : args) uvConfig (runUVMeter uvMan) rate cb
	111
	112	runUVMeter :: Maybe Manager -> [String] -> Monitor String
	113	runUVMeter _ [] = return "N.A."
	114	runUVMeter uvMan (s:_) = do
	115	resp <- io $ getData uvMan
76	116	case textToXMLDocument resp of
77	117	Right doc -> formatUVRating (getUVRating s doc)
78	118	Left _ -> getConfigValue naString

154	194	char '"'
155	195	spaces
156	196	return (Attribute (name, value))
	197
	198	-- \| Possibly create a new 'Manager', based upon the users preference. If one
	199	-- is created, this 'Manager' will be used throughout the monitor.
	200	tryMakeManager :: UVMeterOpts -> IO (Maybe Manager)
	201	tryMakeManager opts =
	202	if useManager opts
	203	then Just <$> mkManager
	204	else pure Nothing
	205
	206	-- \| Create a new 'Manager' for managing network connections.
	207	mkManager :: IO Manager
	208	mkManager = newManager $ tlsManagerSettings {managerConnCount = 1}

+84

-20

src/Xmobar/Plugins/Monitors/Volume.hs less more

20	20	, VolumeOpts
21	21	) where
22	22
23		import Control.Applicative ((<$>))
	23	import Control.Applicative ( (<$>), liftA3 )
24	24	import Control.Monad ( liftM2, liftM3, mplus )
	25	import Data.Maybe (fromMaybe)
25	26	import Data.Traversable (sequenceA)
26	27	import Xmobar.Plugins.Monitors.Common
27	28	import Sound.ALSA.Mixer
28	29	import qualified Sound.ALSA.Exception as AE
29	30	import System.Console.GetOpt
30	31
	32
31	33	volumeConfig :: IO MConfig
32		volumeConfig = mkMConfig "Vol: <volume>% <status>"
33		["volume", "volumebar", "volumevbar", "dB","status", "volumeipat"]
34
	34	volumeConfig =
	35	mkMConfig
	36	"Vol: <volume>% <status>"
	37	[ "volume"
	38	, "volumebar"
	39	, "volumevbar"
	40	, "dB"
	41	, "status"
	42	, "volumeipat"
	43	, "volumestatus"
	44	]
35	45
36	46	data VolumeOpts = VolumeOpts
37	47	{ onString :: String

41	51	, highDbThresh :: Float
42	52	, lowDbThresh :: Float
43	53	, volumeIconPattern :: Maybe IconPattern
	54	, lowVolThresh :: Maybe Float
	55	, highVolThresh :: Maybe Float
	56	, lowString :: String
	57	, mediumString :: String
	58	, highString :: String
44	59	}
45	60
46	61	defaultOpts :: VolumeOpts

52	67	, highDbThresh = -5.0
53	68	, lowDbThresh = -30.0
54	69	, volumeIconPattern = Nothing
	70	, lowVolThresh = Just 20.0
	71	, highVolThresh = Just 60.0
	72	, lowString = ""
	73	, mediumString = ""
	74	, highString = ""
55	75	}
	76
	77	data VolumeStatus
	78	= VolLow
	79	\| VolMedium
	80	\| VolHigh
	81	\| VolOff
	82
	83	-- \| Set the volume status according to user set thresholds and the current
	84	-- volume
	85	getVolStatus :: Float -- ^ Low volume threshold, in [0,100]
	86	-> Float -- ^ High volume threshold, in [0,100]
	87	-> Float -- ^ Current volume, in [0,1]
	88	-> VolumeStatus
	89	getVolStatus lo hi val'
	90	\| val >= hi = VolHigh
	91	\| val >= lo = VolMedium
	92	\| otherwise = VolLow
	93	where
	94	val = val' * 100
56	95
57	96	options :: [OptDescr (VolumeOpts -> VolumeOpts)]
58	97	options =

64	103	, Option "c" ["offc"] (ReqArg (\x o -> o { offColor = Just x }) "") ""
65	104	, Option "" ["volume-icon-pattern"] (ReqArg (\x o ->
66	105	o { volumeIconPattern = Just $ parseIconPattern x }) "") ""
	106	, Option "L" ["lowv"] (ReqArg (\x o -> o { lowVolThresh = Just $ read x }) "") ""
	107	, Option "H" ["highv"] (ReqArg (\x o -> o { highVolThresh = Just $ read x }) "") ""
	108	, Option "l" ["lows"] (ReqArg (\x o -> o { lowString = x }) "") ""
	109	, Option "m" ["mediums"] (ReqArg (\x o -> o { mediumString = x }) "") ""
	110	, Option "h" ["highs"] (ReqArg (\x o -> o { highString = x }) "") ""
67	111	]
68
69		parseOpts :: [String] -> IO VolumeOpts
70		parseOpts argv =
71		case getOpt Permute options argv of
72		(o, _, []) -> return $ foldr id defaultOpts o
73		(_, _, errs) -> ioError . userError $ concat errs
74	112
75	113	percent :: Integer -> Integer -> Integer -> Float
76	114	percent v' lo' hi' = (v - lo) / (hi - lo)

97	135	switchHelper :: VolumeOpts
98	136	-> (VolumeOpts -> Maybe String)
99	137	-> (VolumeOpts -> String)
	138	-> VolumeStatus
100	139	-> Monitor String
101		switchHelper opts cHelp strHelp = return $
	140	switchHelper opts cHelp strHelp vs = return $
102	141	colorHelper (cHelp opts)
	142	++ volHelper vs opts
103	143	++ strHelp opts
104	144	++ maybe "" (const "</fc>") (cHelp opts)
105	145
106		formatSwitch :: VolumeOpts -> Bool -> Monitor String
107		formatSwitch opts True = switchHelper opts onColor onString
108		formatSwitch opts False = switchHelper opts offColor offString
	146	formatSwitch :: VolumeOpts -> Bool -> VolumeStatus -> Monitor String
	147	formatSwitch opts True vs = switchHelper opts onColor onString vs
	148	formatSwitch opts False _ = switchHelper opts offColor offString VolOff
	149
	150	-- \| Convert the current volume status into user defined strings
	151	volHelper :: VolumeStatus -> VolumeOpts -> String
	152	volHelper volStatus opts =
	153	case volStatus of
	154	VolHigh -> highString opts
	155	VolMedium -> mediumString opts
	156	VolLow -> lowString opts
	157	VolOff -> ""
109	158
110	159	colorHelper :: Maybe String -> String
111	160	colorHelper = maybe "" (\c -> "<fc=" ++ c ++ ">")

127	176
128	177	runVolume :: String -> String -> [String] -> Monitor String
129	178	runVolume mixerName controlName argv = do
130		opts <- io $ parseOpts argv
	179	opts <- io $ parseOptsWith options defaultOpts argv
131	180	runVolumeWith opts mixerName controlName
132	181
133	182	runVolumeWith :: VolumeOpts -> String -> String -> Monitor String

137	186	b <- liftMonitor $ liftM3 formatVolBar lo hi val
138	187	v <- liftMonitor $ liftM3 formatVolVBar lo hi val
139	188	d <- getFormatDB opts db
140		s <- getFormatSwitch opts sw
	189	let volStat = liftA3 getVolStatus
	190	(lowVolThresh opts)
	191	(highVolThresh opts)
	192	(liftA3 percent val lo hi) -- current volume in %
	193	s <- getFormatSwitch opts sw volStat
141	194	ipat <- liftMonitor $ liftM3 (formatVolDStr $ volumeIconPattern opts) lo hi val
142		parseTemplate [p, b, v, d, s, ipat]
	195
	196	-- Volume and status in one.
	197	let vs = if isVolOff sw
	198	then offString opts -- User defined off string
	199	else s ++ p -- Status string, current volume in %
	200
	201	parseTemplate [p, b, v, d, s, ipat, vs]
143	202
144	203	where
145	204

190	249	getFormatDB _ Nothing = unavailable
191	250	getFormatDB opts' (Just d) = formatDb opts' d
192	251
193		getFormatSwitch :: VolumeOpts -> Maybe Bool -> Monitor String
194		getFormatSwitch _ Nothing = unavailable
195		getFormatSwitch opts' (Just sw) = formatSwitch opts' sw
	252	getFormatSwitch :: VolumeOpts -> Maybe Bool -> Maybe VolumeStatus -> Monitor String
	253	getFormatSwitch _ Nothing _ = unavailable
	254	getFormatSwitch _ _ Nothing = unavailable
	255	getFormatSwitch opts' (Just sw) (Just vs) = formatSwitch opts' sw vs
	256
	257	-- \| Determine whether the volume is off based on the value of 'sw' from
	258	-- 'runVolumeWith'.
	259	isVolOff = not . fromMaybe False
196	260
197	261	unavailable = getConfigValue naString

+124

-37

src/Xmobar/Plugins/Monitors/Weather.hs less more

18	18
19	19	import qualified Control.Exception as CE
20	20
	21	import qualified Data.ByteString.Lazy.Char8 as B
	22	import Data.Char (toLower)
	23	import Data.Maybe (fromMaybe)
21	24	import Network.HTTP.Conduit
22	25	import Network.HTTP.Types.Status
23	26	import Network.HTTP.Types.Method
24		import qualified Data.ByteString.Lazy.Char8 as B
25		import Data.Char (toLower)
26	27
27	28	import Text.ParserCombinators.Parsec
	29	import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(Option))
	30
	31
	32	-- \| Options the user may specify.
	33	data WeatherOpts = WeatherOpts
	34	{ weatherString :: String
	35	, useManager :: Bool
	36	}
	37
	38	-- \| Default values for options.
	39	defaultOpts :: WeatherOpts
	40	defaultOpts = WeatherOpts
	41	{ weatherString = ""
	42	, useManager = True
	43	}
	44
	45	-- \| Apply options.
	46	options :: [OptDescr (WeatherOpts -> WeatherOpts)]
	47	options =
	48	[ Option "w" ["weathers" ] (ReqArg (\s o -> o { weatherString = s }) "") ""
	49	, Option "m" ["useManager"] (ReqArg (\b o -> o { useManager = read b }) "") ""
	50	]
28	51
29	52	weatherConfig :: IO MConfig
30	53	weatherConfig = mkMConfig

44	67	, "visibility"
45	68	, "skyCondition"
46	69	, "skyConditionS"
	70	, "weather"
47	71	, "tempC"
48	72	, "tempF"
49	73	, "dewPointC"

72	96	, windInfo :: WindInfo
73	97	, visibility :: String
74	98	, skyCondition :: String
	99	, weather :: String
75	100	, tempC :: Int
76	101	, tempF :: Int
77	102	, dewPointC :: Int

168	193	w <- pWind
169	194	v <- getAfterString "Visibility: "
170	195	sk <- getAfterString "Sky conditions: "
	196	we <- getAfterString "Weather: "
171	197	skipTillString "Temperature: "
172	198	(tC,tF) <- pTemp
173	199	skipTillString "Dew Point: "

177	203	skipTillString "Pressure (altimeter): "
178	204	p <- pPressure
179	205	manyTill skipRestOfLine eof
180		return [WI st ss y m d h w v sk tC tF dC dF rh p]
	206	return [WI st ss y m d h w v sk we tC tF dC dF rh p]
181	207
182	208	defUrl :: String
183	209	defUrl = "https://tgftp.nws.noaa.gov/data/observations/metar/decoded/"

185	211	stationUrl :: String -> String
186	212	stationUrl station = defUrl ++ station ++ ".TXT"
187	213
188		getData :: String -> IO String
189		getData station = CE.catch (do
190		manager <- newManager tlsManagerSettings
191		request <- parseUrlThrow $ stationUrl station
192		res <- httpLbs request manager
193		return $ B.unpack $ responseBody res
194		) errHandler
195		where errHandler :: CE.SomeException -> IO String
196		errHandler _ = return "<Could not retrieve data>"
	214	-- \| Get the decoded weather data from the given station.
	215	getData :: Maybe Manager -> String -> IO String
	216	getData weMan station = CE.catch
	217	(do man <- flip fromMaybe weMan <$> mkManager
	218	-- Create a new manager if none was present or the user does not want to
	219	-- use one.
	220	request <- parseUrlThrow $ stationUrl station
	221	res <- httpLbs request man
	222	return $ B.unpack $ responseBody res)
	223	errHandler
	224	where
	225	errHandler :: CE.SomeException -> IO String
	226	errHandler _ = return "<Could not retrieve data>"
197	227
198	228	formatSk :: Eq p => [(p, p)] -> p -> p
199	229	formatSk ((a,b):sks) sk = if a == sk then b else formatSk sks sk
200	230	formatSk [] sk = sk
201	231
202		formatWeather :: [(String,String)] -> [WeatherInfo] -> Monitor String
203		formatWeather sks [WI st ss y m d h (WindInfo wc wa wm wk wkh wms) v sk tC tF dC dF r p] =
	232	formatWeather
	233	:: WeatherOpts -- ^ Formatting options from the cfg file
	234	-> [(String,String)] -- ^ 'SkyConditionS' for 'WeatherX'
	235	-> [WeatherInfo] -- ^ The actual weather info
	236	-> Monitor String
	237	formatWeather opts sks [WI st ss y m d h (WindInfo wc wa wm wk wkh wms) v sk we tC tF dC dF r p] =
204	238	do cel <- showWithColors show tC
205	239	far <- showWithColors show tF
206	240	let sk' = formatSk sks (map toLower sk)
	241	we' = showWeather (weatherString opts) we
207	242	parseTemplate [st, ss, y, m, d, h, wc, wa, wm, wk, wkh
208		, wms, v, sk, sk', cel, far
	243	, wms, v, sk, sk', we', cel, far
209	244	, show dC, show dF, show r , show p ]
210		formatWeather _ _ = getConfigValue naString
211
212		runWeather :: [String] -> Monitor String
213		runWeather = runWeather' []
214
215		runWeather' :: [(String, String)] -> [String] -> Monitor String
216		runWeather' sks args =
217		do d <- io $ getData $ head args
218		i <- io $ runP parseData d
219		formatWeather sks i
	245	formatWeather _ _ _ = getConfigValue naString
	246
	247	-- \| Show the 'weather' field with a default string in case it was empty.
	248	showWeather :: String -> String -> String
	249	showWeather "" d = d
	250	showWeather s _ = s
	251
	252	-- \| Start a weather monitor, create a new 'Maybe Manager', should the user have
	253	-- chosen to use one.
	254	startWeather'
	255	:: [(String, String)] -- ^ 'SkyConditionS' replacement strings
	256	-> String -- ^ Weather station
	257	-> [String] -- ^ User supplied arguments
	258	-> Int -- ^ Update rate
	259	-> (String -> IO ())
	260	-> IO ()
	261	startWeather' sks station args rate cb = do
	262	opts <- parseOptsWith options defaultOpts (getArgvs args)
	263	weRef <- tryMakeManager opts
	264	runMD
	265	(station : args)
	266	weatherConfig
	267	(runWeather sks weRef opts)
	268	rate
	269	weatherReady
	270	cb
	271
	272	-- \| Same as 'startWeather'', only for 'Weather' instead of 'WeatherX', meaning
	273	-- no 'SkyConditionS'.
	274	startWeather :: String -> [String] -> Int -> (String -> IO ()) -> IO ()
	275	startWeather = startWeather' []
	276
	277	-- \| Run a weather monitor.
	278	runWeather
	279	:: [(String, String)] -- ^ 'SkyConditionS' replacement strings
	280	-> Maybe Manager -- ^ Whether to use a 'Manager'
	281	-> WeatherOpts -- ^ Weather specific options
	282	-> [String] -- ^ User supplied arguments
	283	-> Monitor String
	284	runWeather sks weMan opts args = do
	285	d <- io $ getData weMan (head args)
	286	i <- io $ runP parseData d
	287	formatWeather opts sks i
220	288
221	289	weatherReady :: [String] -> Monitor Bool
222		weatherReady str = do
	290	weatherReady str = io $ do
223	291	initRequest <- parseUrlThrow $ stationUrl $ head str
224		let request = initRequest{method = methodHead}
225		io $ CE.catch ( do
226		manager <- newManager tlsManagerSettings
227		res <- httpLbs request manager
228		return $ checkResult $responseStatus res ) errHandler
229		where errHandler :: CE.SomeException -> IO Bool
230		errHandler _ = return False
231		checkResult status
232		\| statusIsServerError status = False
233		\| statusIsClientError status = False
234		\| otherwise = True
	292	let request = initRequest { method = methodHead }
	293
	294	CE.catch
	295	(do man <- mkManager
	296	res <- httpLbs request man
	297	return $ checkResult $ responseStatus res)
	298	errHandler
	299	where
	300	-- \| If any exception occurs, indicate that the monitor is not ready.
	301	errHandler :: CE.SomeException -> IO Bool
	302	errHandler _ = return False
	303
	304	-- \| Check for and indicate any errors in the http response.
	305	checkResult :: Status -> Bool
	306	checkResult status
	307	\| statusIsServerError status = False
	308	\| statusIsClientError status = False
	309	\| otherwise = True
	310
	311	-- \| Possibly create a new 'Manager', based upon the users preference. If one
	312	-- is created, this 'Manager' will be used throughout the monitor.
	313	tryMakeManager :: WeatherOpts -> IO (Maybe Manager)
	314	tryMakeManager opts =
	315	if useManager opts
	316	then Just <$> mkManager
	317	else pure Nothing
	318
	319	-- \| Create a new 'Manager' for managing network connections.
	320	mkManager :: IO Manager
	321	mkManager = newManager $ tlsManagerSettings { managerConnCount = 1 }

+70

-11

src/Xmobar/Plugins/Monitors/Wireless.hs less more

	0	{-# LANGUAGE TypeApplications, CPP #-}
0	1	-----------------------------------------------------------------------------
1	2	-- \|
2	3	-- Module : Plugins.Monitors.Wireless

7	8	-- Stability : unstable
8	9	-- Portability : unportable
9	10	--
10		-- A monitor reporting ESSID and link quality for wireless interfaces
	11	-- A monitor reporting SSID and signal level for wireless interfaces
11	12	--
12	13	-----------------------------------------------------------------------------
13	14
14	15	module Xmobar.Plugins.Monitors.Wireless (wirelessConfig, runWireless) where
15	16
16	17	import System.Console.GetOpt
	18	import Data.Maybe (fromMaybe)
17	19
18	20	import Xmobar.Plugins.Monitors.Common
	21
	22	#ifdef IWLIB
19	23	import Network.IWlib
	24	#elif defined USE_NL80211
	25	import Control.Exception (bracket)
	26	import qualified Data.Map as M
	27	import GHC.Int (Int8)
	28	import Data.Maybe (listToMaybe)
	29	import Control.Monad.IO.Class (liftIO)
	30	import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
	31	import Data.ByteString.Char8 (unpack)
	32	import Data.Serialize.Put (runPut, putWord32host, putByteString)
	33	import Data.Serialize.Get (runGet)
	34
	35	import System.Linux.Netlink hiding (query)
	36	import System.Linux.Netlink.GeNetlink.NL80211
	37	import System.Linux.Netlink.GeNetlink.NL80211.StaInfo
	38	import System.Linux.Netlink.GeNetlink.NL80211.Constants
	39	import System.Posix.IO (closeFd)
	40
	41	data IwData = IwData { wiEssid :: String, wiSignal :: Maybe Int, wiQuality :: Int }
	42
	43	getWirelessInfo :: String -> IO IwData
	44	getWirelessInfo ifname = do
	45	bracket makeNL80211Socket (closeFd . getFd) (\s -> do
	46	iflist <- getInterfaceList s
	47	iwdata <- runMaybeT $ do
	48	ifidx <- MaybeT . return $ foldr (\(n, i) z ->
	49	if (ifname == "" \|\| ifname == n) then Just i else z)
	50	Nothing
	51	iflist
	52	scanp <- liftIO (getConnectedWifi s ifidx) >>=
	53	MaybeT . return . listToMaybe
	54	bssid <- MaybeT . return $ M.lookup eNL80211_ATTR_BSS (packetAttributes scanp) >>=
	55	rightToMaybe . runGet getAttributes >>=
	56	M.lookup eNL80211_BSS_BSSID
	57	stap <- liftIO (query s eNL80211_CMD_GET_STATION True $ M.fromList
	58	[(eNL80211_ATTR_IFINDEX, runPut $ putWord32host ifidx),
	59	(eNL80211_ATTR_MAC, runPut $ putByteString bssid)]) >>=
	60	MaybeT . return . listToMaybe
	61	let ssid = fromMaybe "" $ getWifiAttributes scanp >>= M.lookup eWLAN_EID_SSID >>=
	62	return . unpack
	63	signal = staInfoFromPacket stap >>= staSignalMBM >>=
	64	return . fromIntegral @Int8 . fromIntegral
	65	qlty = fromMaybe (-1) (round @Float . (/ 0.7) . (+ 110) .
	66	clamp (-110) (-40) . fromIntegral <$> signal)
	67	MaybeT . return $ Just $ IwData ssid signal qlty
	68	return $ fromMaybe (IwData "" Nothing (-1)) iwdata)
	69	where
	70	rightToMaybe = either (const Nothing) Just
	71	clamp lb up v = if v < lb then lb else if v > up then up else v
	72	#endif
20	73
21	74	newtype WirelessOpts = WirelessOpts
22	75	{ qualityIconPattern :: Maybe IconPattern

33	86	opts { qualityIconPattern = Just $ parseIconPattern d }) "") ""
34	87	]
35	88
36		parseOpts :: [String] -> IO WirelessOpts
37		parseOpts argv =
38		case getOpt Permute options argv of
39		(o, _, []) -> return $ foldr id defaultOpts o
40		(_, _, errs) -> ioError . userError $ concat errs
41
42	89	wirelessConfig :: IO MConfig
43	90	wirelessConfig =
44		mkMConfig "<essid> <quality>"
45		["essid", "quality", "qualitybar", "qualityvbar", "qualityipat"]
	91	mkMConfig "<ssid> <quality>"
	92	["ssid", "essid", "signal", "quality", "qualitybar", "qualityvbar", "qualityipat"]
46	93
47	94	runWireless :: String -> [String] -> Monitor String
48	95	runWireless iface args = do
49		opts <- io $ parseOpts args
	96	opts <- io $ parseOptsWith options defaultOpts args
	97	#ifdef IWLIB
50	98	iface' <- if "" == iface then io findInterface else return iface
	99	#else
	100	let iface' = iface
	101	#endif
51	102	wi <- io $ getWirelessInfo iface'
52	103	na <- getConfigValue naString
53	104	let essid = wiEssid wi
54	105	qlty = fromIntegral $ wiQuality wi
55	106	e = if essid == "" then na else essid
56	107	ep <- showWithPadding e
	108	#ifdef USE_NL80211
	109	let s = wiSignal wi
	110	#else
	111	let s = if qlty >= 0 then Just (qlty * 0.7 - 110) else Nothing
	112	#endif
	113	sp <- showWithPadding $ maybe "" show s
57	114	q <- if qlty >= 0
58	115	then showPercentWithColors (qlty / 100)
59	116	else showWithPadding ""
60	117	qb <- showPercentBar qlty (qlty / 100)
61	118	qvb <- showVerticalBar qlty (qlty / 100)
62	119	qipat <- showIconPattern (qualityIconPattern opts) (qlty / 100)
63		parseTemplate [ep, q, qb, qvb, qipat]
	120	parseTemplate [ep, ep, sp, q, qb, qvb, qipat]
64	121
	122	#ifdef IWLIB
65	123	findInterface :: IO String
66	124	findInterface = do
67	125	c <- readFile "/proc/net/wireless"
68	126	let nds = lines c
69	127	return $ if length nds > 2 then takeWhile (/= 'c') (nds!!2) else []
	128	#endif

+10

-10

src/Xmobar/Plugins/Monitors.hs less more

18	18
19	19	import Xmobar.Run.Exec
20	20
21		import Xmobar.Plugins.Monitors.Common (runM, runMD)
	21	import Xmobar.Plugins.Monitors.Common (runM)
22	22	#ifdef WEATHER
23	23	import Xmobar.Plugins.Monitors.Weather
24	24	#endif

41	41	#ifdef UVMETER
42	42	import Xmobar.Plugins.Monitors.UVMeter
43	43	#endif
44		#ifdef IWLIB
	44	#if defined IWLIB \|\| defined USE_NL80211
45	45	import Xmobar.Plugins.Monitors.Wireless
46	46	#endif
47	47	#ifdef LIBMPD
48	48	import Xmobar.Plugins.Monitors.MPD
49		import Xmobar.Plugins.Monitors.Common (runMBD)
	49	import Xmobar.Plugins.Monitors.Common (runMBD, runMD)
50	50	#endif
51	51	#ifdef ALSA
52	52	import Xmobar.Plugins.Monitors.Volume

84	84	#ifdef UVMETER
85	85	\| UVMeter Station Args Rate
86	86	#endif
87		#ifdef IWLIB
	87	#if defined IWLIB \|\| defined USE_NL80211
88	88	\| Wireless Interface Args Rate
89	89	#endif
90	90	#ifdef LIBMPD

141	141	#ifdef UVMETER
142	142	alias (UVMeter s _ _) = "uv " ++ s
143	143	#endif
144		#ifdef IWLIB
	144	#if defined IWLIB \|\| defined USE_NL80211
145	145	alias (Wireless i _ _) = i ++ "wi"
146	146	#endif
147	147	#ifdef LIBMPD

163	163	start (TopProc a r) = startTop a r
164	164	start (TopMem a r) = runM a topMemConfig runTopMem r
165	165	#ifdef WEATHER
166		start (Weather s a r) = runMD (a ++ [s]) weatherConfig runWeather r weatherReady
167		start (WeatherX s c a r) = runMD (a ++ [s]) weatherConfig (runWeather' c) r weatherReady
	166	start (Weather s a r) = startWeather s a r
	167	start (WeatherX s c a r) = startWeather' c s a r
168	168	#endif
169	169	start (Thermal z a r) = runM (a ++ [z]) thermalConfig runThermal r
170	170	start (ThermalZone z a r) =

183	183	start (Uptime a r) = runM a uptimeConfig runUptime r
184	184	start (CatInt _ s a r) = runM a catIntConfig (runCatInt s) r
185	185	#ifdef UVMETER
186		start (UVMeter s a r) = runM (a ++ [s]) uvConfig runUVMeter r
187		#endif
188		#ifdef IWLIB
	186	start (UVMeter s a r) = startUVMeter s a r
	187	#endif
	188	#if defined IWLIB \|\| defined USE_NL80211
189	189	start (Wireless i a r) = runM a wirelessConfig (runWireless i) r
190	190	#endif
191	191	#ifdef LIBMPD

+1

-1

src/Xmobar/Run/Command.hs less more

40	40	start (Com p as al r) cb =
41	41	start (ComX p as ("Could not execute command " ++ p) al r) cb
42	42	start (ComX prog args msg _ r) cb = if r > 0 then go else exec
43		where go = exec >> tenthSeconds r >> go
	43	where go = doEveryTenthSeconds r exec
44	44	exec = do
45	45	(i,o,e,p) <- runInteractiveProcess prog args Nothing Nothing
46	46	exit <- waitForProcess p

+3

-12

src/Xmobar/Run/Exec.hs less more

16	16	--
17	17	-----------------------------------------------------------------------------
18	18
19		module Xmobar.Run.Exec (Exec (..), tenthSeconds) where
	19	module Xmobar.Run.Exec (Exec (..), tenthSeconds, doEveryTenthSeconds) where
20	20
21	21	import Prelude
22	22	import Data.Char
23		import Control.Concurrent
24	23
	24	import Xmobar.App.Timer (doEveryTenthSeconds, tenthSeconds)
25	25	import Xmobar.System.Signal
26
27		-- \| Work around to the Int max bound: since threadDelay takes an Int, it
28		-- is not possible to set a thread delay grater than about 45 minutes.
29		-- With a little recursion we solve the problem.
30		tenthSeconds :: Int -> IO ()
31		tenthSeconds s \| s >= x = do threadDelay (x * 100000)
32		tenthSeconds (s - x)
33		\| otherwise = threadDelay (s * 100000)
34		where x = (maxBound :: Int) `div` 100000
35	26
36	27	class Show e => Exec e where
37	28	alias :: e -> String

42	33	run _ = return ""
43	34	start :: e -> (String -> IO ()) -> IO ()
44	35	start e cb = go
45		where go = run e >>= cb >> tenthSeconds (rate e) >> go
	36	where go = doEveryTenthSeconds (rate e) $ run e >>= cb
46	37	trigger :: e -> (Maybe SignalType -> IO ()) -> IO ()
47	38	trigger _ sh = sh Nothing

+2

-0

src/Xmobar/X11/Draw.hs less more

61	61	(defaultDepthOfScreen (defaultScreenOfDisplay d))
62	62	#if XFT
63	63	when (alpha c /= 255) (liftIO $ drawBackground d p (bgColor c) (alpha c) wr)
	64	#else
	65	_ <- return wr
64	66	#endif
65	67	withColors d [bgColor c, borderColor c] $ \[bgcolor, bdcolor] -> do
66	68	gc <- liftIO $ createGC d w

+4

-11

stack.yaml less more

0		# Compiling with ghc 8.6.4
1		resolver: lts-13.17
2
3		# To use ghc 4.4 try:
4		# resolver: lts-12.24
	0	# ghc 8.6.5
	1	resolver: lts-14.20
5	2
6	3	packages:
7	4	- .

9	6	flags:
10	7	xmobar:
11	8	all_extensions: true
	9	with_threaded: true
12	10
13	11	extra-deps:
14		- iwlib-0.1.0
15
16		# Add to extra-deps for lts-12.24:
17		# - parsec-numbers-0.1.0
18		# - libmpd-0.9.0.9
19		# - alsa-mixer-0.3.0
	12	- netlink-1.1.1.0
20	13
21	14	nix:
22	15	packages:

+25

-7

xmobar.cabal less more

0	0	name: xmobar
1		version: 0.30
	1	version: 0.33
2	2	homepage: http://xmobar.org
3	3	synopsis: A Minimalistic Text Based Status Bar
4	4	description: Xmobar is a minimalistic text based status bar.

39	39	default: False
40	40
41	41	flag with_iwlib
42		description: Wireless info support. Required for the Wireless plugin, needs iwlib installed.
	42	description: Wireless info support via Wext ioctls (deprecated). Required for the Wireless plugin, needs iwlib installed.
	43	default: False
	44
	45	flag with_nl80211
	46	description: Wireless info support via nl80211. Required for the Wireless plugin on systems running Linux, the kernel.
43	47	default: False
44	48
45	49	flag with_mpd

71	75	default: False
72	76
73	77	flag with_threaded
74		description: Use threaded runtime.
	78	description: Use threaded runtime. Required for timer coalescing (less power usage).
75	79	default: False
76	80
77	81	flag with_rtsopts

104	108	Xmobar.App.Main,
105	109	Xmobar.App.Opts,
106	110	Xmobar.App.Compile,
	111	Xmobar.App.Timer,
107	112	Xmobar.System.Utils,
108	113	Xmobar.System.StatFS,
109	114	Xmobar.System.Environment,

158	163	ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-do-bind
159	164
160	165	build-depends:
161		base >= 4.9.1.0 && < 4.13,
	166	base >= 4.9.1.0 && < 4.14,
162	167	containers,
163	168	regex-compat,
164	169	process,

207	212	exposed-modules: Xmobar.Plugins.Mail, Xmobar.Plugins.MBox
208	213	cpp-options: -DINOTIFY
209	214
210		if flag(with_iwlib) \|\| flag(all_extensions)
	215	if flag(with_iwlib) \|\| flag(with_nl80211) \|\| flag(all_extensions)
	216	exposed-modules: Xmobar.Plugins.Monitors.Wireless
	217
	218	if flag(with_iwlib)
211	219	extra-libraries: iw
212	220	build-depends: iwlib >= 0.1.0 && < 0.2
213		exposed-modules: Xmobar.Plugins.Monitors.Wireless
214	221	cpp-options: -DIWLIB
215	222
	223	if !flag(with_iwlib) && (flag(with_nl80211) \|\| flag(all_extensions))
	224	build-depends: netlink >= 1.1.1.0,
	225	cereal >= 0.5.8.1
	226	cpp-options: -DUSE_NL80211
	227
216	228	if flag(with_mpd) \|\| flag(all_extensions)
217		build-depends: libmpd >= 0.9.0.6
	229	build-depends: libmpd >= 0.9.0.10
218	230	exposed-modules: Xmobar.Plugins.Monitors.MPD
219	231	cpp-options: -DLIBMPD
220	232

255	267	exposed-modules: Xmobar.Plugins.Monitors.UVMeter
256	268	build-depends: http-conduit, http-types
257	269	cpp-options: -DUVMETER
	270
	271	if os(freebsd)
	272	-- enables freebsd specific code
	273	build-depends: bsd-sysctl
	274	cpp-options: -DFREEBSD
258	275
259	276	executable xmobar
260	277	hs-source-dirs: app

314	331	Xmobar.Plugins.Monitors.Common.Output
315	332	Xmobar.Plugins.Monitors.Common.Files
316	333	Xmobar.Run.Exec
	334	Xmobar.App.Timer
317	335	Xmobar.System.Signal
318	336
319	337	if flag(with_alsa) \|\| flag(all_extensions)