packages feed

xmobar 0.33 → 0.34

raw patch · 27 files changed

+293/−165 lines, 27 filesdep +http-client-tlsdep ~basedep ~bytestring

Dependencies added: http-client-tls

Dependency ranges changed: base, bytestring

Files

changelog.md view
@@ -1,3 +1,16 @@+## Version 0.34 (June, 2020)++_New features_++  - New plugin `HandleReader` for reading data from a Haskell `Handle`. This is+    useful if you are running xmobar from within a Haskell program.+  - Build with ghc 8.10 allowed.+  - Optimize date plugin by avoiding calling getTimeZone for each of+    the time the date has to be updated. Instead, it's computed once+    at the start and re-used for each invocation.+  - Optimize Weather and UVMeter plugin by using global Manager instead of+    creating for each http request when useManager is explicitly configured as False.+ ## Version 0.33 (February, 2020)  _New features_
readme.md view
@@ -798,11 +798,14 @@ - Args: default monitor arguments, plus:   - `--rx-icon-pattern`: dynamic string for reception rate in `rxipat`.   - `--tx-icon-pattern`: dynamic string for transmission rate in `txipat`.+  - `--up`: string used for the `up` variable value when the+    interface is up. - Variables that can be used with the `-t`/`--template` argument:   `dev`, `rx`, `tx`, `rxbar`, `rxvbar`, `rxipat`, `txbar`, `txvbar`,-  `txipat`. Reception and transmission rates (`rx` and `tx`) are displayed-  by default as Kb/s, without any suffixes, but you can set the `-S` to-  "True" to make them displayed with adaptive units (Kb/s, Mb/s, etc.).+  `txipat`, `up`. Reception and transmission rates (`rx` and `tx`) are+  displayed by default as Kb/s, without any suffixes, but you can set+  the `-S` to "True" to make them displayed with adaptive units (Kb/s,+  Mb/s, etc.). - Default template: `<dev>: <rx>KB|<tx>KB`  ### `DynNetwork Args RefreshRate`@@ -1147,7 +1150,7 @@           Run MultiCoreTemp ["-t", "Temp: <avg>°C | <avgpc>%",                             "-L", "60", "-H", "80",-                            "-l", "green", "-n", "yellow", "-h", "red"+                            "-l", "green", "-n", "yellow", "-h", "red",                             "--", "--mintemp", "20", "--maxtemp", "100"] 50  ### `Volume Mixer Element Args RefreshRate`@@ -1610,6 +1613,23 @@           logHook = dynamicLogString myPP >>= xmonadPropLog         } +### `HandleReader Handle Alias`++- Display data from a Haskell `Handle`+- This plugin is only useful if you are running xmobar from another Haskell+  program like XMonad.+- You can use `System.Process.createPipe` to create a pair of `read` & `write`+  Handles. Pass the `read` Handle to HandleReader and write your output to the+  `write` Handle:++        (readHandle, writeHandle) <- createPipe+        xmobarProcess <- forkProcess $ xmobar myConfig+                { commands =+                    Run (HandleReader readHandle "handle") : commands myConfig+                }+        hPutStr writeHandle "Hello World"++ # Plugins  ## Writing a Plugin@@ -1697,14 +1717,14 @@ 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-Emmanuel Rosa, Sackville-West, Markus Scherer, Daniel Schüssler,-Olivier Schneider, Alexander Shabalin, Valentin Shirokov, Peter-Simons, Alexander Solovyov, Will Song, John Soros, Felix Springer,-Travis Staton, Artem Tarasov, Samuli Thomasson, Edward Tjörnhammar,-Sergei Trofimovich, Thomas Tuegel, John Tyree, Jan Vornberger, Anton-Vorontsov, Daniel Wagner, Zev Weiss, Phil Xiaojun Hu, Edward Z. Yang-and Norbert Zeh.+Jens Petersen, Alexander Polakov, Sibi Prabakaran, Pavan Rikhi, Petr+Rockai, Andrew Emmanuel Rosa, Sackville-West, Markus Scherer, Daniel+Schüssler, Olivier Schneider, Alexander Shabalin, Valentin Shirokov,+Peter Simons, Alexander Solovyov, Will Song, John Soros, Felix+Springer, Travis Staton, Artem Tarasov, Samuli Thomasson, Edward+Tjörnhammar, Sergei Trofimovich, Thomas Tuegel, John Tyree, 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@@ -1741,7 +1761,7 @@ This software is released under a BSD-style license. See [LICENSE] for more details. -Copyright &copy; 2010-2019 Jose Antonio Ortega Ruiz+Copyright &copy; 2010-2020 Jose Antonio Ortega Ruiz  Copyright &copy; 2007-2010 Andrea Rossato
src/Xmobar.hs view
@@ -32,6 +32,7 @@               , module Xmobar.Plugins.DateZone #endif               , module Xmobar.Plugins.EWMH+              , module Xmobar.Plugins.HandleReader               , module Xmobar.Plugins.Kbd               , module Xmobar.Plugins.Locks #ifdef INOTIFY@@ -57,6 +58,7 @@ import Xmobar.Plugins.DateZone #endif import Xmobar.Plugins.EWMH+import Xmobar.Plugins.HandleReader import Xmobar.Plugins.Kbd import Xmobar.Plugins.Locks #ifdef INOTIFY
src/Xmobar/App/EventLoop.hs view
@@ -40,6 +40,7 @@ import Data.Bits import Data.Map hiding (foldr, map, filter) import Data.Maybe (fromJust, isJust)+import qualified Data.List.NonEmpty as NE  import Xmobar.System.Signal import Xmobar.Config.Types@@ -52,6 +53,7 @@ import Xmobar.X11.Draw import Xmobar.X11.Bitmap as Bitmap import Xmobar.X11.Types+import Xmobar.System.Utils (safeIndex)  #ifndef THREADED_RUNTIME import Xmobar.X11.Events(nextEvent')@@ -208,7 +210,7 @@             eventLoop tv xc as signal          reposWindow rcfg = do-          r' <- repositionWin d w (head fs) rcfg+          r' <- repositionWin d w (NE.head fs) rcfg           eventLoop tv (XConf d r' w fs vos is rcfg) as signal          updateConfigPosition ocfg =@@ -262,7 +264,7 @@       strLn :: [(Widget, String, Int, Maybe [Action])] -> IO [(Maybe [Action], Position, Position)]       strLn  = liftIO . mapM getCoords       iconW i = maybe 0 Bitmap.width (lookup i $ iconS conf)-      getCoords (Text s,_,i,a) = textWidth d (fs!!i) s >>= \tw -> return (a, 0, fi tw)+      getCoords (Text s,_,i,a) = textWidth d (safeIndex fs i) s >>= \tw -> return (a, 0, fi tw)       getCoords (Icon s,_,_,a) = return (a, 0, fi $ iconW s)       partCoord off xs = map (\(a, x, x') -> (fromJust a, x, x')) $                          filter (\(a, _,_) -> isJust a) $
src/Xmobar/App/Main.hs view
@@ -29,6 +29,7 @@ import System.FilePath import System.FilePath.Posix (takeBaseName, takeDirectory) import Text.Parsec.Error (ParseError)+import Data.List.NonEmpty (NonEmpty(..))  import Graphics.X11.Xlib @@ -63,7 +64,7 @@       let ic = Map.empty           to = textOffset conf           ts = textOffsets conf ++ replicate (length fl) (-1)-      startLoop (XConf d r w (fs:fl) (to:ts) ic conf) sig refLock vars+      startLoop (XConf d r w (fs :| fl) (to:ts) ic conf) sig refLock vars  configFromArgs :: Config -> IO Config configFromArgs cfg = getArgs >>= getOpts >>= doOpts cfg . fst
src/Xmobar/App/Opts.hs view
@@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.Opts--- Copyright: (c) 2018, 2019 Jose Antonio Ortega Ruiz+-- Copyright: (c) 2018, 2019, 2020 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org@@ -104,9 +104,9 @@  info :: String info = "xmobar " ++ showVersion version-        ++ "\n (C) 2007 - 2010 Andrea Rossato "-        ++ "\n (C) 2010 - 2019 Jose A Ortega Ruiz\n "-        ++ mail ++ "\n" ++ license+        ++ "\n (C) 2010 - 2020 Jose A Ortega Ruiz"+        ++ "\n (C) 2007 - 2010 Andrea Rossato\n "+        ++ mail ++ "\n" ++ license ++ "\n"  mail :: String mail = "<mail@jao.io>"
src/Xmobar/Plugins/BufferedPipeReader.hs view
@@ -23,7 +23,6 @@ import Xmobar.Run.Exec import Xmobar.System.Signal import Xmobar.System.Environment-import Xmobar.System.Utils(hGetLineSafe)  data BufferedPipeReader = BufferedPipeReader String [(Int, Bool, String)]     deriving (Read, Show)@@ -55,7 +54,7 @@         reader :: (Int, Bool, FilePath) -> TChan (Int, Bool, String) -> IO ()         reader p@(to, tg, fp) tc = do             fp' <- expandEnv fp-            openFile fp' ReadWriteMode >>= hGetLineSafe >>= \dt ->+            openFile fp' ReadWriteMode >>= hGetLine >>= \dt ->                 atomically $ writeTChan tc (to, tg, dt)             reader p tc
src/Xmobar/Plugins/CommandReader.hs view
@@ -17,7 +17,6 @@  import System.IO import Xmobar.Run.Exec-import Xmobar.System.Utils (hGetLineSafe) import System.Process(runInteractiveCommand, getProcessExitCode)  data CommandReader = CommandReader String String@@ -31,7 +30,7 @@         hClose hstderr         hSetBinaryMode hstdout False         hSetBuffering hstdout LineBuffering-        forever ph (hGetLineSafe hstdout >>= cb)+        forever ph (hGetLine hstdout >>= cb)         where forever ph a =                   do a                      ec <- getProcessExitCode ph
src/Xmobar/Plugins/Date.hs view
@@ -31,8 +31,16 @@  instance Exec Date where     alias (Date _ a _) = a-    run   (Date f _ _) = date f     rate  (Date _ _ r) = r+    start (Date f _ r) cb = do+      t <- getCurrentTime+      zone <- getTimeZone t+      go zone+     where+      go zone = doEveryTenthSeconds r $ date zone f >>= cb -date :: String -> IO String-date format = fmap (formatTime defaultTimeLocale format) getZonedTime+date :: TimeZone -> String -> IO String+date timezone format = do+  time <- getCurrentTime+  let zonedTime = utcToZonedTime timezone time+  pure $ formatTime defaultTimeLocale format zonedTime
+ src/Xmobar/Plugins/HandleReader.hs view
@@ -0,0 +1,70 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Plugins.HandleReader+-- Copyright   :  (c) Pavan Rikhi+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Pavan Rikhi <pavan.rikhi@gmail.com>+-- Stability   :  unstable+-- Portability :  portable+--+-- A plugin for reading from 'Handle's+--+-----------------------------------------------------------------------------++module Xmobar.Plugins.HandleReader+    ( HandleReader(..)+    )+where++import           System.IO                      ( Handle+                                                , hIsEOF+                                                , hGetLine+                                                )++import           Xmobar.Run.Exec                ( Exec(..) )+++-- | A HandleReader displays any text received from a Handle.+--+-- This is only useful if you are running @xmobar@ from other Haskell code.+-- You can create a pair of @(read, write)@ 'Handle's using+-- 'System.Process.createPipe'. Pass the @read@ 'Handle' to HandleReader+-- and write your desired output to the @write@ 'Handle'.+--+-- @+--  (readHandle, writeHandle) <- 'System.Process.createPipe'+--  xmobarProcess <- 'System.Posix.Process.forkProcess' $ 'Xmobar.xmobar' myConfig+--          { commands =+--              'Xmobar.Run' ('HandleReader' readHandle "handle") : 'Xmobar.commands' myConfig+--          }+--  'System.IO.hPutStr' writeHandle "Hello World"+-- @+data HandleReader+    = HandleReader+        Handle+        -- ^ The Handle to read from.+        String+        -- ^ Alias for the HandleReader+    deriving (Show)++-- | WARNING: This Read instance will throw an exception if used! It is+-- only implemented because it is required to use HandleReader with+-- 'Xmobar.Run' in 'Xmobar.commands'.+instance Read HandleReader where+    -- | Throws an 'error'!+    readsPrec = error "HandleReader: Read instance is stub"++-- | Asynchronously read from the 'Handle'.+instance Exec HandleReader where+    -- | Read from the 'Handle' until it is closed.+    start (HandleReader handle _) cb =+        untilM (hIsEOF handle) $ hGetLine handle >>= cb+    -- | Use the 2nd argument to HandleReader as its alias.+    alias (HandleReader _ a) = a++-- Loop the action until predicateM returns True.+untilM :: Monad m => m Bool -> m () -> m ()+untilM predicateM action = do+    predicate <- predicateM+    if predicate then return () else action >> untilM predicateM action
src/Xmobar/Plugins/MarqueePipeReader.hs view
@@ -14,10 +14,9 @@  module Xmobar.Plugins.MarqueePipeReader(MarqueePipeReader(..)) where -import System.IO (openFile, IOMode(ReadWriteMode), Handle)+import System.IO (openFile, IOMode(ReadWriteMode), Handle, hGetLine) import Xmobar.System.Environment import Xmobar.Run.Exec(Exec(alias, start), tenthSeconds)-import Xmobar.System.Utils(hGetLineSafe) import System.Posix.Files (getFileStatus, isNamedPipe) import Control.Concurrent(forkIO, threadDelay) import Control.Concurrent.STM (TChan, atomically, writeTChan, tryReadTChan, newTChan)@@ -39,7 +38,7 @@         unless (null def) (cb def)         checkPipe pipe         h <- openFile pipe ReadWriteMode-        line <- hGetLineSafe h+        line <- hGetLine h         chan <- atomically newTChan         forkIO $ writer (toInfTxt line sep) sep len rate chan cb         forever $ pipeToChan h chan@@ -50,7 +49,7 @@  pipeToChan :: Handle -> TChan String -> IO () pipeToChan h chan = do-    line <- hGetLineSafe h+    line <- hGetLine h     atomically $ writeTChan chan line  writer :: String -> Separator -> Length -> Rate -> TChan String -> (String -> IO ()) -> IO ()
src/Xmobar/Plugins/Monitors/MPD.hs view
@@ -20,14 +20,17 @@ import System.Console.GetOpt import qualified Network.MPD as M import Control.Concurrent (threadDelay)+import Control.Monad.Except (catchError) +templateVars :: [String]+templateVars = [ "bar", "vbar", "ipat", "state", "statei", "volume", "length"+               , "lapsed", "remaining", "plength", "ppos", "flags", "file"+               , "name", "artist", "composer", "performer"+               , "album", "title", "track", "genre", "date"+               ]+ mpdConfig :: IO MConfig-mpdConfig = mkMConfig "MPD: <state>"-              [ "bar", "vbar", "ipat", "state", "statei", "volume", "length"-              , "lapsed", "remaining", "plength", "ppos", "flags", "file"-              , "name", "artist", "composer", "performer"-              , "album", "title", "track", "genre", "date"-              ]+mpdConfig = mkMConfig "MPD: <state>" templateVars  data MOpts = MOpts   { mPlaying :: String@@ -60,7 +63,8 @@   ]  withMPD :: MOpts -> M.MPD a -> IO (M.Response a)-withMPD opts = M.withMPD_ (mHost opts) (mPort opts)+withMPD opts a =+  M.withMPD_ (mHost opts) (mPort opts) a `catchError` (\_ -> return (Left M.NoMPD))  runMPD :: [String] -> Monitor String runMPD args = do@@ -74,7 +78,7 @@ mpdWait = do   status <- M.withMPD $ M.idle [M.PlayerS, M.MixerS, M.OptionsS]   case status of-    Left _ -> threadDelay 10000000+    Left _ -> threadDelay 5000     _ -> return ()  mpdReady :: [String] -> Monitor Bool@@ -91,19 +95,21 @@  parseMPD :: M.Response M.Status -> M.Response (Maybe M.Song) -> MOpts             -> Monitor [String]-parseMPD (Left e) _ _ = return $ show e:replicate 19 ""+parseMPD (Left _) _ _ = return $ "N/A": repeat "" parseMPD (Right st) song opts = do   songData <- parseSong song   bar <- showPercentBar (100 * b) b   vbar <- showVerticalBar (100 * b) b   ipat <- showIconPattern (mLapsedIconPattern opts) b-  return $ [bar, vbar, ipat, ss, si, vol, len, lap, remain, plen, ppos, flags] ++ songData+  return $ [bar, vbar, ipat, ss, si, vol, len, lap, remain, plen, ppos, flags]+           ++ songData   where s = M.stState st         ss = show s         si = stateGlyph s opts         vol = int2str $ fromMaybe 0 (M.stVolume st)         (p, t) = fromMaybe (0, 0) (M.stTime st)-        [lap, len, remain] = map showTime [floor p, floor t, max 0 (floor t - floor p)]+        [lap, len, remain] = map showTime+                                 [floor p, floor t, max 0 (floor t - floor p)]         b = if t > 0 then realToFrac $ p / t else 0         plen = int2str $ M.stPlaylistLength st         ppos = maybe "" (int2str . (+1)) $ M.stSongPos st
src/Xmobar/Plugins/Monitors/Net.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Plugins.Monitors.Net--- Copyright   :  (c) 2011, 2012, 2013, 2014, 2017 Jose Antonio Ortega Ruiz+-- Copyright   :  (c) 2011, 2012, 2013, 2014, 2017, 2020 Jose Antonio Ortega Ruiz --                (c) 2007-2010 Andrea Rossato -- License     :  BSD-style (see LICENSE) --@@ -49,6 +49,7 @@   { rxIconPattern :: Maybe IconPattern   , txIconPattern :: Maybe IconPattern   , onlyDevList :: Maybe DevList+  , upIndicator :: String   }  defaultOpts :: NetOpts@@ -56,6 +57,7 @@   { rxIconPattern = Nothing   , txIconPattern = Nothing   , onlyDevList = Nothing+  , upIndicator = "+"   }  options :: [OptDescr (NetOpts -> NetOpts)]@@ -64,6 +66,7 @@      o { rxIconPattern = Just $ parseIconPattern x }) "") ""   , Option "" ["tx-icon-pattern"] (ReqArg (\x o ->      o { txIconPattern = Just $ parseIconPattern x }) "") ""+  , Option "" ["up"] (ReqArg (\x o -> o { upIndicator = x }) "") ""   , Option "" ["devices"] (ReqArg (\x o ->      o { onlyDevList = Just $ parseDevList x }) "") ""   ]@@ -103,7 +106,7 @@ netConfig :: IO MConfig netConfig = mkMConfig     "<dev>: <rx>KB|<tx>KB"      -- template-    ["dev", "rx", "tx", "rxbar", "rxvbar", "rxipat", "txbar", "txvbar", "txipat"]     -- available replacements+    ["dev", "rx", "tx", "rxbar", "rxvbar", "rxipat", "txbar", "txvbar", "txipat", "up"]     -- available replacements  operstateDir :: String -> FilePath operstateDir d = "/sys/class/net" </> d </> "operstate"@@ -160,7 +163,7 @@     N d (ND r t) -> do         (rx, rb, rvb, ripat) <- formatNet (rxIconPattern opts) r         (tx, tb, tvb, tipat) <- formatNet (txIconPattern opts) t-        parseTemplate [d,rx,tx,rb,rvb,ripat,tb,tvb,tipat]+        parseTemplate [d,rx,tx,rb,rvb,ripat,tb,tvb,tipat, upIndicator opts]     N _ NI -> return ""     NA -> getConfigValue naString
src/Xmobar/Plugins/Monitors/UVMeter.hs view
@@ -21,14 +21,11 @@ import Network.HTTP.Conduit     ( Manager     , httpLbs-    , managerConnCount-    , newManager     , parseRequest     , responseBody-    , tlsManagerSettings     )+import Network.HTTP.Client.TLS (getGlobalManager) import Data.ByteString.Lazy.Char8 as B-import Data.Maybe (fromMaybe) import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(Option)) import Text.Read (readMaybe) import Text.Parsec@@ -66,12 +63,9 @@ uvURL = "https://uvdata.arpansa.gov.au/xml/uvvalues.xml"  -- | Get the UV data from the given url.-getData :: Maybe Manager -> IO String-getData uvMan = CE.catch-    (do man <- flip fromMaybe uvMan <$> mkManager-        -- Create a new manager if none was present or the user does not want to-        -- use one, otherwise use the provided manager.-        request <- parseRequest uvURL+getData ::Manager -> IO String+getData man = CE.catch+    (do request <- parseRequest uvURL         res <- httpLbs request man         return $ B.unpack $ responseBody res)     errHandler@@ -105,15 +99,13 @@     -> Int       -- ^ Update rate     -> (String -> IO ())     -> IO ()-startUVMeter station args rate cb = do-    opts  <- parseOptsWith options defaultOpts (getArgvs args)-    uvMan <- tryMakeManager opts-    runM (station : args) uvConfig (runUVMeter uvMan) rate cb+startUVMeter station args = runM (station : args) uvConfig runUVMeter -runUVMeter :: Maybe Manager -> [String] -> Monitor String-runUVMeter _ [] = return "N.A."-runUVMeter uvMan (s:_) = do-    resp <- io $ getData uvMan+runUVMeter :: [String] -> Monitor String+runUVMeter [] = return "N.A."+runUVMeter (s:_) = do+    man <- io getGlobalManager+    resp <- io $ getData man     case textToXMLDocument resp of         Right doc -> formatUVRating (getUVRating s doc)         Left _ -> getConfigValue naString@@ -195,15 +187,3 @@     char '"'     spaces     return (Attribute (name, value))---- | Possibly create a new 'Manager', based upon the users preference.  If one--- is created, this 'Manager' will be used throughout the monitor.-tryMakeManager :: UVMeterOpts -> IO (Maybe Manager)-tryMakeManager opts =-    if useManager opts-        then Just <$> mkManager-        else pure Nothing---- | Create a new 'Manager' for managing network connections.-mkManager :: IO Manager-mkManager = newManager $ tlsManagerSettings {managerConnCount = 1}
src/Xmobar/Plugins/Monitors/Volume.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Plugins.Monitors.Volume--- Copyright   :  (c) 2011, 2013, 2015, 2018 Thomas Tuegel+-- Copyright   :  (c) 2011, 2013, 2015, 2018, 2020 Thomas Tuegel -- License     :  BSD-style (see LICENSE) -- -- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>@@ -23,7 +23,6 @@  import Control.Applicative ( (<$>), liftA3 ) import Control.Monad ( liftM2, liftM3, mplus )-import Data.Maybe (fromMaybe) import Data.Traversable (sequenceA) import Xmobar.Plugins.Monitors.Common import Sound.ALSA.Mixer@@ -257,6 +256,5 @@      -- | Determine whether the volume is off based on the value of 'sw' from     -- 'runVolumeWith'.-    isVolOff = not . fromMaybe False-+    isVolOff = (Just True /=)     unavailable = getConfigValue naString
src/Xmobar/Plugins/Monitors/Weather.hs view
@@ -21,33 +21,30 @@  import qualified Data.ByteString.Lazy.Char8 as B import Data.Char (toLower)-import Data.Maybe (fromMaybe) import Network.HTTP.Conduit import Network.HTTP.Types.Status import Network.HTTP.Types.Method+import Network.HTTP.Client.TLS (getGlobalManager)  import Text.ParserCombinators.Parsec import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(Option))   -- | Options the user may specify.-data WeatherOpts = WeatherOpts+newtype WeatherOpts = WeatherOpts   { weatherString :: String-  , useManager    :: Bool   }  -- | Default values for options. defaultOpts :: WeatherOpts defaultOpts = WeatherOpts   { weatherString = ""-  , useManager    = True   }  -- | Apply options. options :: [OptDescr (WeatherOpts -> WeatherOpts)] options =   [ Option "w" ["weathers"  ] (ReqArg (\s o -> o { weatherString = s   }) "") ""-  , Option "m" ["useManager"] (ReqArg (\b o -> o { useManager = read b }) "") ""   ]  weatherConfig :: IO MConfig@@ -213,12 +210,10 @@ stationUrl station = defUrl ++ station ++ ".TXT"  -- | Get the decoded weather data from the given station.-getData :: Maybe Manager -> String -> IO String-getData weMan station = CE.catch-    (do man <- flip fromMaybe weMan <$> mkManager-        -- Create a new manager if none was present or the user does not want to-        -- use one.-        request <- parseUrlThrow $ stationUrl station+getData :: String -> IO String+getData station = CE.catch+    (do request <- parseUrlThrow $ stationUrl station+        man <- getGlobalManager         res <- httpLbs request man         return $ B.unpack $ responseBody res)     errHandler@@ -261,11 +256,10 @@     -> IO () startWeather' sks station args rate cb = do     opts  <- parseOptsWith options defaultOpts (getArgvs args)-    weRef <- tryMakeManager opts     runMD         (station : args)         weatherConfig-        (runWeather sks weRef opts)+        (runWeather sks opts)         rate         weatherReady         cb@@ -278,12 +272,11 @@ -- | Run a weather monitor. runWeather     :: [(String, String)]  -- ^ 'SkyConditionS' replacement strings-    -> Maybe Manager       -- ^ Whether to use a 'Manager'     -> WeatherOpts         -- ^ Weather specific options     -> [String]            -- ^ User supplied arguments     -> Monitor String-runWeather sks weMan opts args = do-    d <- io $ getData weMan (head args)+runWeather sks opts args = do+    d <- io $ getData (head args)     i <- io $ runP parseData d     formatWeather opts sks i @@ -293,7 +286,7 @@     let request = initRequest { method = methodHead }      CE.catch-        (do man <- mkManager+        (do man <- getGlobalManager             res  <- httpLbs request man             return $ checkResult $ responseStatus res)         errHandler@@ -308,15 +301,3 @@         | statusIsServerError status = False         | statusIsClientError status = False         | otherwise = True---- | Possibly create a new 'Manager', based upon the users preference.  If one--- is created, this 'Manager' will be used throughout the monitor.-tryMakeManager :: WeatherOpts -> IO (Maybe Manager)-tryMakeManager opts =-    if useManager opts-        then Just <$> mkManager-        else pure Nothing---- | Create a new 'Manager' for managing network connections.-mkManager :: IO Manager-mkManager = newManager $ tlsManagerSettings { managerConnCount = 1 }
src/Xmobar/Plugins/Monitors/Wireless.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE TypeApplications, CPP #-}+{-# LANGUAGE CPP #-}+#ifdef USE_NL80211+{-# LANGUAGE TypeApplications #-}+#endif ----------------------------------------------------------------------------- -- | -- Module      :  Plugins.Monitors.Wireless@@ -16,7 +19,6 @@ module Xmobar.Plugins.Monitors.Wireless (wirelessConfig, runWireless)  where  import System.Console.GetOpt-import Data.Maybe (fromMaybe)  import Xmobar.Plugins.Monitors.Common @@ -26,7 +28,7 @@ import Control.Exception (bracket) import qualified Data.Map as M import GHC.Int (Int8)-import Data.Maybe (listToMaybe)+import Data.Maybe (listToMaybe, fromMaybe) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) import Data.ByteString.Char8 (unpack)@@ -42,12 +44,12 @@ data IwData = IwData { wiEssid :: String, wiSignal :: Maybe Int, wiQuality :: Int }  getWirelessInfo :: String -> IO IwData-getWirelessInfo ifname = do+getWirelessInfo ifname =   bracket makeNL80211Socket (closeFd . getFd) (\s -> do   iflist <- getInterfaceList s   iwdata <- runMaybeT $ do     ifidx <- MaybeT . return $ foldr (\(n, i) z ->-                                       if (ifname == "" || ifname == n) then Just i else z)+                                       if ifname == "" || ifname == n then Just i else z)                                      Nothing                                      iflist     scanp <- liftIO (getConnectedWifi s ifidx) >>=@@ -63,13 +65,16 @@                                 return . unpack         signal = staInfoFromPacket stap >>= staSignalMBM >>=                  return . fromIntegral @Int8 . fromIntegral-        qlty   = fromMaybe (-1) (round @Float . (/ 0.7) . (+ 110) .-                                                clamp (-110) (-40) . fromIntegral <$> signal)+        qlty   = maybe (-1) (round @Float . (/ 0.7) . (+ 110) .+                                            clamp (-110) (-40) . fromIntegral) signal     MaybeT . return $ Just $ IwData ssid signal qlty   return $ fromMaybe (IwData "" Nothing (-1)) iwdata)   where     rightToMaybe = either (const Nothing) Just-    clamp lb up v = if v < lb then lb else if v > up then up else v+    clamp lb up v+      | v < lb = lb+      | v > up = up+      | otherwise = v #endif  newtype WirelessOpts = WirelessOpts
src/Xmobar/Plugins/PipeReader.hs view
@@ -16,7 +16,6 @@  import System.IO import Xmobar.Run.Exec(Exec(..))-import Xmobar.System.Utils(hGetLineSafe) import Xmobar.System.Environment(expandEnv) import System.Posix.Files import Control.Concurrent(threadDelay)@@ -34,7 +33,7 @@         unless (null def) (cb def)         checkPipe pipe         h <- openFile pipe ReadWriteMode-        forever (hGetLineSafe h >>= cb)+        forever (hGetLine h >>= cb)       where         split c xs | c `elem` xs = let (pre, post) = span (c /=) xs                                    in (pre, dropWhile (c ==) post)
src/Xmobar/Plugins/StdinReader.hs view
@@ -22,23 +22,30 @@ import System.Posix.Process import System.Exit import System.IO-import Control.Exception (SomeException(..), handle) import Xmobar.Run.Exec import Xmobar.X11.Actions (stripActions)-import Xmobar.System.Utils (hGetLineSafe)+import Xmobar.System.Utils (onSomeException)+import Control.Monad (when)  data StdinReader = StdinReader | UnsafeStdinReader   deriving (Read, Show)  instance Exec StdinReader where   start stdinReader cb = do-    s <- handle (\(SomeException e) -> do hPrint stderr e; return "")-                (hGetLineSafe stdin)-    cb $ escape stdinReader s+    -- The EOF check is necessary for certain systems+    -- More details here https://github.com/jaor/xmobar/issues/442     eof <- isEOF-    if eof-      then exitImmediately ExitSuccess-      else start stdinReader cb+    when eof $+      do hPrint stderr "xmobar: eof at an early stage"+         exitImmediately ExitSuccess+    s <-+      getLine `onSomeException`+      (\e -> do+         let errorMessage = "xmobar: Received exception " <> show e+         hPrint stderr errorMessage+         cb errorMessage)+    cb $ escape stdinReader s+    start stdinReader cb  escape :: StdinReader -> String -> String escape StdinReader = stripActions
src/Xmobar/Run/Command.hs view
@@ -20,8 +20,7 @@ import Control.Exception (handle, SomeException(..)) import System.Process import System.Exit-import System.IO (hClose)-import Xmobar.System.Utils (hGetLineSafe)+import System.IO (hClose, hGetLine)  import Xmobar.Run.Exec @@ -47,7 +46,7 @@                 exit <- waitForProcess p                 let closeHandles = hClose o >> hClose i >> hClose e                     getL = handle (\(SomeException _) -> return "")-                                  (hGetLineSafe o)+                                  (hGetLine o)                 case exit of                   ExitSuccess -> do str <- getL                                     closeHandles
src/Xmobar/Run/Exec.hs view
@@ -10,7 +10,7 @@ -- -- The 'Exec' class and the 'Command' data type. ----- The 'Exec' class rappresents the executable types, whose constructors may+-- The 'Exec' class represents the executable types, whose constructors may -- appear in the 'Config.commands' field of the 'Config.Config' data type. -- -- The 'Command' data type is for OS commands to be run by xmobar
src/Xmobar/System/Utils.hs view
@@ -3,7 +3,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Utils--- Copyright: (c) 2010, 2018 Jose Antonio Ortega Ruiz+-- Copyright: (c) 2010, 2018, 2020 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: Jose A Ortega Ruiz <jao@gnu.org>@@ -17,27 +17,21 @@ ------------------------------------------------------------------------------  -module Xmobar.System.Utils (expandHome, changeLoop, hGetLineSafe)-where+module Xmobar.System.Utils+  ( expandHome+  , changeLoop+  , onSomeException+  , safeIndex+  ) where  import Control.Monad import Control.Concurrent.STM+import qualified Data.List.NonEmpty as NE+import Data.Maybe (fromMaybe)  import System.Environment import System.FilePath-import System.IO--#if defined XFT || defined UTF8-import qualified System.IO as S (hGetLine)-#endif--hGetLineSafe :: Handle -> IO String-#if defined XFT || defined UTF8-hGetLineSafe = S.hGetLine-#else-hGetLineSafe = hGetLine-#endif-+import Control.Exception  expandHome :: FilePath -> IO FilePath expandHome ('~':'/':path) = fmap (</> path) (getEnv "HOME")@@ -52,3 +46,26 @@             new <- s             guard (new /= old)             return new)++-- | Like 'finally', but only performs the final action if there was an+-- exception raised by the computation.+--+-- Note that this implementation is a slight modification of+-- onException function.+onSomeException :: IO a -> (SomeException -> IO b) -> IO a+onSomeException io what = io `catch` \e -> do _ <- what e+                                              throwIO (e :: SomeException)++(!!?) :: [a] -> Int -> Maybe a+(!!?) xs i+    | i < 0     = Nothing+    | otherwise = go i xs+  where+    go :: Int -> [a] -> Maybe a+    go 0 (x:_)  = Just x+    go j (_:ys) = go (j - 1) ys+    go _ []     = Nothing+{-# INLINE (!!?) #-}++safeIndex :: NE.NonEmpty a -> Int -> a+safeIndex xs index = fromMaybe (NE.head xs) (NE.toList xs !!? index)
src/Xmobar/X11/Draw.hs view
@@ -25,6 +25,7 @@ import Control.Monad (when) import Control.Arrow ((&&&)) import Data.Map hiding (foldr, map, filter)+import qualified Data.List.NonEmpty as NE  import Graphics.X11.Xlib hiding (textExtents, textWidth) import Graphics.X11.Xlib.Extras@@ -37,6 +38,7 @@ import Xmobar.X11.ColorCache import Xmobar.X11.Window (drawBorder) import Xmobar.X11.Parsers (Widget(..))+import Xmobar.System.Utils (safeIndex)  #ifdef XFT import Xmobar.X11.MinXft@@ -55,7 +57,7 @@       strLn = liftIO . mapM getWidth       iconW i = maybe 0 B.width (lookup i $ iconS r)       getWidth (Text s,cl,i,_) =-        textWidth d (fs!!i) s >>= \tw -> return (Text s,cl,i,fi tw)+        textWidth d (safeIndex fs i) s >>= \tw -> return (Text s,cl,i,fi tw)       getWidth (Icon s,cl,i,_) = return (Icon s,cl,i,fi $ iconW s)    p <- liftIO $ createPixmap d w wid ht@@ -126,7 +128,7 @@ #endif  -- | An easy way to print the stuff we need to print-printStrings :: Drawable -> GC -> [XFont] -> [Int] -> Position+printStrings :: Drawable -> GC -> NE.NonEmpty XFont -> [Int] -> Position              -> Align -> [(Widget, String, Int, Position)] -> X () printStrings _ _ _ _ _ _ [] = return () printStrings dr gc fontlist voffs offs a sl@((s,c,i,l):xs) = do@@ -136,7 +138,7 @@       Rectangle _ _ wid ht = rect r       totSLen = foldr (\(_,_,_,len) -> (+) len) 0 sl       remWidth = fi wid - fi totSLen-      fontst = fontlist !! i+      fontst = safeIndex fontlist i       offset = case a of                  C -> (remWidth + offs) `div` 2                  R -> remWidth@@ -144,7 +146,7 @@       (fc,bc) = case break (==',') c of                  (f,',':b) -> (f, b           )                  (f,    _) -> (f, bgColor conf)-  valign <- verticalOffset ht s (head fontlist) (voffs !! i) conf+  valign <- verticalOffset ht s (NE.head fontlist) (voffs !! i) conf   case s of     (Text t) -> liftIO $ printString d dr fontst gc fc bc offset valign t alph     (Icon p) -> liftIO $ maybe (return ())
src/Xmobar/X11/Parsers.hs view
@@ -20,7 +20,9 @@ import Xmobar.X11.Actions  import Control.Monad (guard, mzero)+import Data.Maybe (fromMaybe) import Text.ParserCombinators.Parsec+import Text.Read (readMaybe) import Graphics.X11.Types (Button)  data Widget = Icon String | Text String@@ -138,7 +140,7 @@               -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] fontParser c a = do   f <- between (string "<fn=") (string ">") colors-  s <- manyTill (allParsers c (read f) a) (try $ string "</fn>")+  s <- manyTill (allParsers c (fromMaybe 0 $ readMaybe f) a) (try $ string "</fn>")   return (concat s)  -- | Parses a color specification (hex or named)
src/Xmobar/X11/Types.hs view
@@ -20,6 +20,7 @@ import Graphics.X11.Xlib import Control.Monad.Reader import Data.Map+import qualified Data.List.NonEmpty as NE  import Xmobar.X11.Bitmap import Xmobar.X11.Text@@ -33,7 +34,7 @@     XConf { display   :: Display           , rect      :: Rectangle           , window    :: Window-          , fontListS :: [XFont]+          , fontListS :: NE.NonEmpty XFont           , verticalOffsets :: [Int]           , iconS     :: Map FilePath Bitmap           , config    :: Config
test/Xmobar/Plugins/Monitors/AlsaSpec.hs view
@@ -1,9 +1,12 @@ {-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE CPP #-}+ module Xmobar.Plugins.Monitors.AlsaSpec   ( main   , spec   ) where +#ifdef ALSA import Control.Concurrent import Control.Concurrent.Async import Control.Monad@@ -158,3 +161,11 @@       $ \(Just h) _ _ _ -> do         hSetBuffering h LineBuffering         body h+#else+-- These No-Op values are required for HSpec's test discovery.+main :: IO ()+main = return ()++spec :: Monad m => m ()+spec = return ()+#endif
xmobar.cabal view
@@ -1,5 +1,5 @@ name:               xmobar-version:            0.33+version:            0.34 homepage:           http://xmobar.org synopsis:           A Minimalistic Text Based Status Bar description: 	    Xmobar is a minimalistic text based status bar.@@ -13,7 +13,7 @@ author:             Andrea Rossato and Jose A. Ortega Ruiz maintainer:         Jose A. Ortega Ruiz <jao@gnu.org> bug-reports:        https://github.com/jaor/xmobar/issues-cabal-version:      >= 1.8+cabal-version:      >= 1.10 build-type:         Simple  extra-source-files: readme.md, changelog.md,@@ -92,6 +92,7 @@   default: True  library+    default-language: Haskell2010     hs-source-dirs:  src      exposed-modules: Xmobar@@ -129,6 +130,7 @@                    Xmobar.Plugins.CommandReader,                    Xmobar.Plugins.Date,                    Xmobar.Plugins.EWMH,+                   Xmobar.Plugins.HandleReader,                    Xmobar.Plugins.PipeReader,                    Xmobar.Plugins.MarqueePipeReader,                    Xmobar.Plugins.StdinReader,@@ -164,12 +166,12 @@     ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-do-bind      build-depends:-      base >= 4.9.1.0 && < 4.14,+      base >= 4.9.1.0 && < 4.15,       containers,       regex-compat,       process,       old-locale,-      bytestring,+      bytestring >= 0.10.8.2,       directory,       unix,       time,@@ -210,11 +212,11 @@      if flag(with_inotify) || flag(all_extensions)        build-depends: hinotify >= 0.3 && < 0.5-       exposed-modules: Xmobar.Plugins.Mail, Xmobar.Plugins.MBox+       other-modules: Xmobar.Plugins.Mail, Xmobar.Plugins.MBox        cpp-options: -DINOTIFY      if flag(with_iwlib) || flag(with_nl80211) || flag(all_extensions)-       exposed-modules: Xmobar.Plugins.Monitors.Wireless+       other-modules: Xmobar.Plugins.Monitors.Wireless      if flag(with_iwlib)        extra-libraries: iw@@ -228,25 +230,25 @@      if flag(with_mpd) || flag(all_extensions)        build-depends: libmpd >= 0.9.0.10-       exposed-modules: Xmobar.Plugins.Monitors.MPD+       other-modules: Xmobar.Plugins.Monitors.MPD        cpp-options: -DLIBMPD      if flag(with_alsa) || flag(all_extensions)        build-depends: alsa-mixer >= 0.3 && < 0.4        build-depends: alsa-core == 0.5.*,                       process >= 1.4.3.0-       exposed-modules: Xmobar.Plugins.Monitors.Volume+       other-modules: Xmobar.Plugins.Monitors.Volume                         Xmobar.Plugins.Monitors.Alsa        cpp-options: -DALSA      if flag(with_datezone) || flag(all_extensions)        build-depends: timezone-olson == 0.1.*, timezone-series == 0.1.*-       exposed-modules: Xmobar.Plugins.DateZone+       other-modules: Xmobar.Plugins.DateZone        cpp-options: -DDATEZONE      if flag(with_mpris) || flag(all_extensions)        build-depends: dbus >= 1-       exposed-modules: Xmobar.Plugins.Monitors.Mpris+       other-modules: Xmobar.Plugins.Monitors.Mpris        cpp-options: -DMPRIS      if flag(with_dbus) || flag(all_extensions)@@ -260,12 +262,12 @@        cpp-options: -DXPM      if flag(with_weather) || flag(all_extensions)-       exposed-modules: Xmobar.Plugins.Monitors.Weather+       other-modules: Xmobar.Plugins.Monitors.Weather        cpp-options: -DWEATHER-       build-depends: http-conduit, http-types+       build-depends: http-conduit, http-types, http-client-tls      if flag(with_uvmeter)-       exposed-modules: Xmobar.Plugins.Monitors.UVMeter+       other-modules: Xmobar.Plugins.Monitors.UVMeter        build-depends: http-conduit, http-types        cpp-options: -DUVMETER @@ -275,6 +277,7 @@        cpp-options: -DFREEBSD  executable xmobar+    default-language:   Haskell2010     hs-source-dirs:     app     main-is:            Main.hs     build-depends:      base,@@ -300,6 +303,7 @@        cpp-options: -DTHREADED_RUNTIME  test-suite XmobarTest+  default-language:   Haskell2010   type:           exitcode-stdio-1.0   hs-source-dirs: src, test   main-is:        Spec.hs