diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,15 @@ +## Version 0.29.5 (March, 2019) + +_Bug fixes_ + + - Honour command line flags when starting xmobar without any + configuration file (issue #375). + - `Alsa` plugin: restart `alsactl` if it quits, e.g. because of a + sleep/awake cycle (issue #376). + - `Weather` using the new HTTPS URL, which requires http-conduit as + a dependency (issue #378). + - `MarqueePipeReader` exported at the API level (issue #381). + ## Version 0.29.4 (December, 2018) Upgrade to alsa-mixer 0.3.0. See issues #372 and #373. diff --git a/examples/xmobar.hs b/examples/xmobar.hs --- a/examples/xmobar.hs +++ b/examples/xmobar.hs @@ -1,6 +1,6 @@ ------------------------------------------------------------------------------ -- | --- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -30,6 +30,7 @@ -- Configuration, using predefined monitors as well as our HelloWorld -- plugin: +config :: Config config = defaultConfig { font = "xft:Sans Mono-9" , additionalFonts = [] diff --git a/readme.md b/readme.md --- a/readme.md +++ b/readme.md @@ -130,15 +130,11 @@ .xpm files in ``. Requires the [libXpm] C library. - `with_uvmeter` Enables UVMeter plugin. The plugin shows UV data for - Australia. Requires `with_conduit` to connect to HTTPS URLs. + Australia. - `with_weather` Support to display weather information. Enables Weather plugin. -- `with_conduit` Use http-conduit for getting weather data enabling - support for http proxies. Requires [http-conduit] and [http-types]. - Note that this flag has only an effect if `with_weather` is also set. - - `all_extensions` Enables all the extensions above. # Running xmobar @@ -1525,20 +1521,21 @@ with the help of the greater xmobar and Haskell communities. In particular, xmobar [incorporates patches] by Mohammed Alshiekh, -Axel Angel, Dragos Boca, Ben Boeckel, Duncan Burke, Roman Cheplyaka, -Patrick Chilton, Antoine Eiche, Nathaniel Wesley Filardo, John -Goerzen, Reto Hablützel, Juraj Hercek, Tomáš Janoušek, Ada Joule, -Spencer Janssen, Roman Joost, Jochen Keil, Lennart Kolmodin, Krzysztof -Kosciuszkiewicz, Dmitry Kurochkin, Todd Lunter, Vanessa McHale, Robert -J. Macomber, Dmitry Malikov, David McLean, Marcin Mikołajczyk, Dino -Morelli, Tony Morris, Eric Mrak, Thiago Negri, Edward O'Callaghan, -Svein Ove, Martin Perner, Jens Petersen, Alexander Polakov, Pavan -Rikhi, Petr Rockai, Andrew Sackville-West, Markus Scherer, Daniel -Schüssler, Olivier Schneider, Alexander Shabalin, Valentin Shirokov, -Peter Simons, Alexander Solovyov, Will Song, John Soros, Travis -Staton, Artem Tarasov, Samuli Thomasson, Edward Tjörnhammar, Sergei -Trofimovich, Thomas Tuegel, Jan Vornberger, Anton Vorontsov, Daniel -Wagner, Zev Weiss, Phil Xiaojun Hu, Edward Z. Yang and Norbert Zeh. +Alex Ameen, Axel Angel, Claudio Bley, Dragos Boca, Ben Boeckel, Duncan +Burke, Roman Cheplyaka, Patrick Chilton, Antoine Eiche, Nathaniel +Wesley Filardo, John Goerzen, Reto Hablützel, Juraj Hercek, Tomáš +Janoušek, Ada Joule, Spencer Janssen, Roman Joost, Jochen Keil, +Lennart Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry Kurochkin, Todd +Lunter, Vanessa McHale, Robert J. Macomber, Dmitry Malikov, David +McLean, Marcin Mikołajczyk, Dino Morelli, Tony Morris, Eric Mrak, +Thiago Negri, Edward O'Callaghan, Svein Ove, Martin Perner, Jens +Petersen, Alexander Polakov, Pavan Rikhi, Petr Rockai, Andrew +Sackville-West, Markus Scherer, Daniel Schüssler, Olivier Schneider, +Alexander Shabalin, Valentin Shirokov, Peter Simons, Alexander +Solovyov, Will Song, John Soros, Travis Staton, Artem Tarasov, Samuli +Thomasson, Edward Tjörnhammar, Sergei Trofimovich, Thomas Tuegel, Jan +Vornberger, Anton Vorontsov, Daniel Wagner, Zev Weiss, Phil Xiaojun +Hu, Edward Z. Yang and Norbert Zeh. [jao]: http://jao.io [incorporates patches]: http://www.ohloh.net/p/xmobar/contributors diff --git a/src/Xmobar.hs b/src/Xmobar.hs --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Xmobar --- Copyright : (c) 2011, 2012, 2013, 2014, 2015, 2017, 2018 Jose Antonio Ortega Ruiz +-- Copyright : (c) 2011, 2012, 2013, 2014, 2015, 2017, 2018, 2019 Jose Antonio Ortega Ruiz -- (c) 2007 Andrea Rossato -- License : BSD-style (see LICENSE) -- @@ -19,6 +19,7 @@ , xmobarMain , defaultConfig , configFromArgs + , tenthSeconds , Runnable (..) , Exec (..) , Command (..) @@ -39,6 +40,7 @@ #endif , module Xmobar.Plugins.Monitors , module Xmobar.Plugins.PipeReader + , module Xmobar.Plugins.MarqueePipeReader , module Xmobar.Plugins.StdinReader , module Xmobar.Plugins.XMonadLog ) where @@ -64,6 +66,7 @@ import Xmobar.Plugins.Monitors import Xmobar.Plugins.PipeReader import Xmobar.Plugins.StdinReader +import Xmobar.Plugins.MarqueePipeReader import Xmobar.Plugins.XMonadLog import Xmobar.App.Main(xmobar, xmobarMain, configFromArgs) diff --git a/src/Xmobar/App/Main.hs b/src/Xmobar/App/Main.hs --- a/src/Xmobar/App/Main.hs +++ b/src/Xmobar/App/Main.hs @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.Main --- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -99,7 +99,7 @@ case cf of Nothing -> case rest of (c:_) -> error $ c ++ ": file not found" - _ -> xmobar defaultConfig + _ -> doOpts defaultConfig flags >>= xmobar Just p -> do r <- readConfig defaultConfig p case r of Left e -> diff --git a/src/Xmobar/Plugins/MarqueePipeReader.hs b/src/Xmobar/Plugins/MarqueePipeReader.hs --- a/src/Xmobar/Plugins/MarqueePipeReader.hs +++ b/src/Xmobar/Plugins/MarqueePipeReader.hs @@ -12,7 +12,7 @@ -- ----------------------------------------------------------------------------- -module Xmobar.Plugins.MarqueePipeReader where +module Xmobar.Plugins.MarqueePipeReader(MarqueePipeReader(..)) where import System.IO (openFile, IOMode(ReadWriteMode), Handle) import Xmobar.System.Environment diff --git a/src/Xmobar/Plugins/Monitors/Alsa.hs b/src/Xmobar/Plugins/Monitors/Alsa.hs --- a/src/Xmobar/Plugins/Monitors/Alsa.hs +++ b/src/Xmobar/Plugins/Monitors/Alsa.hs @@ -12,6 +12,7 @@ -- ----------------------------------------------------------------------------- +{-# LANGUAGE PatternGuards #-} module Xmobar.Plugins.Monitors.Alsa ( startAlsaPlugin , withMonitorWaiter @@ -23,14 +24,20 @@ import Control.Concurrent.Async import Control.Exception import Control.Monad +import Data.IORef +import Data.Time.Clock import Xmobar.Plugins.Monitors.Common import qualified Xmobar.Plugins.Monitors.Volume as Volume; import System.Console.GetOpt import System.Directory import System.Exit import System.IO +import System.IO.Error import System.Process +alsaCtlRestartRateLimit :: NominalDiffTime +alsaCtlRestartRateLimit = 3 -- 'Num NominalDiffTime' assumes seconds + data AlsaOpts = AlsaOpts { aoVolumeOpts :: Volume.VolumeOpts , aoAlsaCtlPath :: Maybe FilePath @@ -76,16 +83,16 @@ opts2 <- io $ parseOpts args2 Volume.runVolumeWith (aoVolumeOpts opts2) mixerName controlName - withMonitorWaiter mixerName (aoAlsaCtlPath opts) $ \wait_ -> + withMonitorWaiter mixerName (aoAlsaCtlPath opts) cb $ \wait_ -> runMB args Volume.volumeConfig run wait_ cb -withMonitorWaiter :: String -> Maybe FilePath -> (IO () -> IO a) -> IO a -withMonitorWaiter mixerName alsaCtlPath cont = do +withMonitorWaiter :: String -> Maybe FilePath -> (String -> IO ()) -> (IO () -> IO a) -> IO a +withMonitorWaiter mixerName alsaCtlPathOverride outputCallback cont = do mvar <- newMVar () - path <- determineAlsaCtlPath + effectivePath <- determineAlsaCtlPath - bracket (async $ readerThread mvar path) cancel $ \a -> do + bracket (async $ alsaReaderThread mixerName effectivePath outputCallback mvar) cancel $ \a -> do -- Throw on this thread if there's an exception -- on the reader thread. @@ -94,26 +101,10 @@ cont $ takeMVar mvar where - - readerThread mvar path = - let createProc = (proc "stdbuf" ["-oL", path, "monitor", mixerName]) - {std_out = CreatePipe} - in - withCreateProcess createProc $ \_ (Just alsaOut) _ _ -> do - hSetBuffering alsaOut LineBuffering - - forever $ do - c <- hGetChar alsaOut - when (c == '\n') $ - -- This uses 'tryPutMVar' because 'putMVar' would make 'runVolume' run - -- once for each event. But we want it to run only once after a burst - -- of events. - void $ tryPutMVar mvar () - defaultPath = "/usr/sbin/alsactl" determineAlsaCtlPath = - case alsaCtlPath of + case alsaCtlPathOverride of Just path -> do found <- doesFileExist path if found @@ -137,6 +128,39 @@ alsaCtlOptionName ++ "=/path/to/alsactl" +alsaReaderThread :: String -> String -> (String -> IO a) -> MVar () -> IO b +alsaReaderThread mixerName alsaCtlPath outputCallback mvar = + let createProc = (proc "stdbuf" ["-oL", alsaCtlPath, "monitor", mixerName]) + {std_out = CreatePipe} + + runAlsaOnce = + withCreateProcess createProc $ \_ (Just alsaOut) _ _ -> do + hSetBuffering alsaOut LineBuffering + + tryPutMVar mvar () -- Refresh immediately after restarting alsactl + + forever $ do + c <- hGetChar alsaOut + when (c == '\n') $ + -- This uses 'tryPutMVar' because 'putMVar' would make 'runVolume' run + -- once for each event. But we want it to run only once after a burst + -- of events. + void $ tryPutMVar mvar () + in do + limiter <- createRateLimiter alsaCtlRestartRateLimit + + forever $ do + limiter + + catchJust + (guard . isEOFError) + runAlsaOnce + pure + + outputCallback "Restarting alsactl..." + + + -- This is necessarily very inefficient on 'String's trimTrailingNewline :: String -> String trimTrailingNewline x = @@ -144,3 +168,30 @@ '\n' : '\r' : y -> reverse y '\n' : y -> reverse y _ -> x + +-- | +-- Returns an IO action that completes at most once per @interval@. +-- The returned cation is not safe for concurrent use. +createRateLimiter :: NominalDiffTime -> IO (IO ()) +createRateLimiter interval = do + prevTimeRef <- newIORef Nothing + + let + limiter = do + prevTime0 <- readIORef prevTimeRef + curTime <- getCurrentTime + + case prevTime0 of + Just prevTime | diff <- interval - (curTime `diffUTCTime` prevTime), + diff > 0 + -> do + threadDelayNDT diff + writeIORef prevTimeRef . Just =<< getCurrentTime + + _ -> writeIORef prevTimeRef (Just curTime) + + pure limiter + +threadDelayNDT :: NominalDiffTime -> IO () +threadDelayNDT ndt = + threadDelay (round (realToFrac ndt * 1e6 :: Double)) diff --git a/src/Xmobar/Plugins/Monitors/Weather.hs b/src/Xmobar/Plugins/Monitors/Weather.hs --- a/src/Xmobar/Plugins/Monitors/Weather.hs +++ b/src/Xmobar/Plugins/Monitors/Weather.hs @@ -19,14 +19,10 @@ import qualified Control.Exception as CE -#ifdef HTTP_CONDUIT import Network.HTTP.Conduit import Network.HTTP.Types.Status import Network.HTTP.Types.Method import qualified Data.ByteString.Lazy.Char8 as B -#else -import Network.HTTP -#endif import Text.ParserCombinators.Parsec @@ -183,29 +179,20 @@ return [WI st ss y m d h w v sk tC tF dC dF rh p] defUrl :: String --- "http://weather.noaa.gov/pub/data/observations/metar/decoded/" -defUrl = "http://tgftp.nws.noaa.gov/data/observations/metar/decoded/" +defUrl = "https://tgftp.nws.noaa.gov/data/observations/metar/decoded/" stationUrl :: String -> String stationUrl station = defUrl ++ station ++ ".TXT" getData :: String -> IO String -#ifdef HTTP_CONDUIT getData station = CE.catch (do manager <- newManager tlsManagerSettings - request <- parseUrl $ stationUrl station + request <- parseUrlThrow $ stationUrl station res <- httpLbs request manager return $ B.unpack $ responseBody res ) errHandler where errHandler :: CE.SomeException -> IO String errHandler _ = return "" -#else -getData station = do - let request = getRequest (stationUrl station) - CE.catch (simpleHTTP request >>= getResponseBody) errHandler - where errHandler :: CE.IOException -> IO String - errHandler _ = return "" -#endif formatWeather :: [WeatherInfo] -> Monitor String formatWeather [WI st ss y m d h (WindInfo wc wa wm wk wkh wms) v sk tC tF dC dF r p] = @@ -221,9 +208,8 @@ formatWeather i weatherReady :: [String] -> Monitor Bool -#ifdef HTTP_CONDUIT weatherReady str = do - initRequest <- parseUrl $ stationUrl $ head str + initRequest <- parseUrlThrow $ stationUrl $ head str let request = initRequest{method = methodHead} io $ CE.catch ( do manager <- newManager tlsManagerSettings @@ -235,21 +221,3 @@ | statusIsServerError status = False | statusIsClientError status = False | otherwise = True -#else -weatherReady str = do - let station = head str - request = headRequest (stationUrl station) - io $ CE.catch (simpleHTTP request >>= checkResult) errHandler - where errHandler :: CE.IOException -> IO Bool - errHandler _ = return False - checkResult result = - case result of - Left _ -> return False - Right response -> - case rspCode response of - -- Permission or network errors are failures; anything - -- else is recoverable. - (4, _, _) -> return False - (5, _, _) -> return False - (_, _, _) -> return True -#endif diff --git a/test/Xmobar/Plugins/Monitors/AlsaSpec.hs b/test/Xmobar/Plugins/Monitors/AlsaSpec.hs --- a/test/Xmobar/Plugins/Monitors/AlsaSpec.hs +++ b/test/Xmobar/Plugins/Monitors/AlsaSpec.hs @@ -58,7 +58,9 @@ waiterTaskIsRunning <- newEmptyMVar :: IO (MVar ()) waiterTaskIsWaiting <- newEmptyMVar :: IO (MVar ()) - withMonitorWaiter fifoPath (Just fakeAlsactlPath) $ \waitFunc -> do + let outputCallback msg = fail ("Did not expect the output callback to be invoked (message: "++show msg++")") + + withMonitorWaiter fifoPath (Just fakeAlsactlPath) outputCallback $ \waitFunc -> do let addToTimeline e = modifyMVar_ timeline (pure . (e :)) diff --git a/xmobar.cabal b/xmobar.cabal --- a/xmobar.cabal +++ b/xmobar.cabal @@ -1,5 +1,5 @@ name: xmobar -version: 0.29.4 +version: 0.29.5 homepage: http://xmobar.org synopsis: A Minimalistic Text Based Status Bar description: Xmobar is a minimalistic text based status bar. @@ -87,10 +87,6 @@ description: Enable weather plugin. default: True -flag with_conduit - description: Use http-conduits for weather data, used only if with_weather. - default: False - library hs-source-dirs: src @@ -251,15 +247,11 @@ cpp-options: -DXPM if flag(with_weather) || flag(all_extensions) - build-depends: HTTP >= 4000.2.4 exposed-modules: Xmobar.Plugins.Monitors.Weather cpp-options: -DWEATHER - if flag(with_conduit) - -- use http-conduit instead of simple-http - build-depends: http-conduit, http-types - cpp-options: -DHTTP_CONDUIT + build-depends: http-conduit, http-types - if flag(with_uvmeter) && flag(with_conduit) + if flag(with_uvmeter) exposed-modules: Xmobar.Plugins.Monitors.UVMeter build-depends: http-conduit, http-types cpp-options: -DUVMETER