From 30d226ba5eca8847775d03403367dee1f1e3dcfc Mon Sep 17 00:00:00 2001 From: jao Date: Sat, 30 Mar 2024 18:26:01 +0000 Subject: fix for unmet pattern matches warnings (clean build) --- src/Xmobar/Draw/Boxes.hs | 11 +++++------ src/Xmobar/Draw/Cairo.hs | 13 +++++++------ src/Xmobar/Plugins/Monitors/Alsa.hs | 6 ++++-- src/Xmobar/Plugins/Monitors/Common/Output.hs | 20 ++++++++++---------- src/Xmobar/Plugins/Monitors/Disk.hs | 8 ++++---- src/Xmobar/Plugins/Monitors/Mem/Linux.hs | 10 +++++++--- src/Xmobar/Plugins/Monitors/Net/Linux.hs | 5 ++++- src/Xmobar/Run/Template.hs | 3 ++- src/Xmobar/System/Environment.hs | 3 ++- src/Xmobar/X11/Bitmap.hs | 7 ++++--- src/Xmobar/X11/Loop.hs | 5 ++--- 11 files changed, 51 insertions(+), 40 deletions(-) (limited to 'src/Xmobar') diff --git a/src/Xmobar/Draw/Boxes.hs b/src/Xmobar/Draw/Boxes.hs index 692e232..ff55ab3 100644 --- a/src/Xmobar/Draw/Boxes.hs +++ b/src/Xmobar/Draw/Boxes.hs @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.Boxes --- Copyright: (c) 2022 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2022, 2024 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -43,11 +43,10 @@ boxLines (T.Box bd offset lw _ margins) ht x0 x1 = T.C -> (ma, -ma) T.R -> (ma, 0) lc = fromIntegral lw / 2 - [mt, mr, mb, ml] = map fromIntegral [top, right, bot, left] - xmin = x0 - ml - lc - xmax = x1 + mr + lc - ymin = mt + lc - ymax = ht - mb - lc + xmin = x0 - fromIntegral left - lc + xmax = x1 + fromIntegral right + lc + ymin = fromIntegral top + lc + ymax = ht - fromIntegral bot - lc rtop = (xmin + p0, ymin, xmax + p1, ymin) rbot = (xmin + p0, ymax, xmax + p1, ymax) rleft = (xmin, ymin + p0, xmin, ymax + p1) diff --git a/src/Xmobar/Draw/Cairo.hs b/src/Xmobar/Draw/Cairo.hs index 8dcda5d..2338b10 100644 --- a/src/Xmobar/Draw/Cairo.hs +++ b/src/Xmobar/Draw/Cairo.hs @@ -2,7 +2,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.Cairo --- Copyright: (c) 2022, 2023 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2022, 2023, 2024 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -169,21 +169,22 @@ drawCairoBackground dctx surf = do drawSegments :: T.DrawContext -> Surface -> IO T.Actions drawSegments dctx surf = do - let [left, center, right] = take 3 $ T.dcSegments dctx ++ repeat [] + let segs = take 3 $ T.dcSegments dctx ++ repeat [] dh = T.dcHeight dctx dw = T.dcWidth dctx conf = T.dcConfig dctx sWidth = foldl (\a (_,_,w) -> a + w) 0 ctx <- Pango.cairoCreateContext Nothing Pango.cairoContextSetResolution ctx $ C.dpi conf - llyts <- mapM (withRenderinfo ctx dctx) left - rlyts <- mapM (withRenderinfo ctx dctx) right - clyts <- mapM (withRenderinfo ctx dctx) center + llyts <- mapM (withRenderinfo ctx dctx) (head segs) + rlyts <- mapM (withRenderinfo ctx dctx) (segs !! 2) + clyts <- mapM (withRenderinfo ctx dctx) (segs !! 1) #ifndef XRENDER drawCairoBackground dctx surf #endif (lend, as, bx) <- foldM (drawSegment dctx surf dw) (0, [], []) llyts - let [rw, cw] = map sWidth [rlyts, clyts] + let rw = sWidth rlyts + cw = sWidth clyts rstart = max lend (dw - rw) cstart = if lend > 1 || rw == 0 then max lend ((dw - cw) / 2.0) else lend (_, as', bx') <- if cw > 0 diff --git a/src/Xmobar/Plugins/Monitors/Alsa.hs b/src/Xmobar/Plugins/Monitors/Alsa.hs index dfc7329..8d02931 100644 --- a/src/Xmobar/Plugins/Monitors/Alsa.hs +++ b/src/Xmobar/Plugins/Monitors/Alsa.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Alsa --- Copyright : (c) 2018 Daniel Schüssler +-- Copyright : (c) 2018, 2024 Daniel Schüssler -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz @@ -25,6 +25,7 @@ import Control.Concurrent.Async import Control.Exception import Control.Monad import Data.IORef +import Data.Maybe (fromJust) import Data.Time.Clock import Xmobar.Plugins.Monitors.Common import qualified Xmobar.Plugins.Monitors.Volume as Volume; @@ -129,7 +130,8 @@ alsaReaderThread mixerName alsaCtlPath outputCallback mvar = {std_out = CreatePipe} runAlsaOnce = - withCreateProcess createProc $ \_ (Just alsaOut) _ _ -> do + withCreateProcess createProc $ \_ out _ _ -> do + let alsaOut = fromJust out hSetBuffering alsaOut LineBuffering tryPutMVar mvar () -- Refresh immediately after restarting alsactl diff --git a/src/Xmobar/Plugins/Monitors/Common/Output.hs b/src/Xmobar/Plugins/Monitors/Common/Output.hs index 2d0e194..c0a00ab 100644 --- a/src/Xmobar/Plugins/Monitors/Common/Output.hs +++ b/src/Xmobar/Plugins/Monitors/Common/Output.hs @@ -3,7 +3,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Plugins.Monitors.Strings --- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019, 2020, 2022, 2024 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -88,9 +88,9 @@ pShowWithColors p f x = do pColorizeString :: (Num a, Ord a, MonadIO m) => MonitorConfig -> a -> String -> m String pColorizeString p x s = do let col = pSetColor p s - [ll,hh] = map fromIntegral $ sort [pLow p, pHigh p] -- consider high < low - pure $ head $ [col pHighColor | x > hh ] ++ - [col pNormalColor | x > ll ] ++ + cols = map fromIntegral $ sort [pLow p, pHigh p] -- consider high < low + pure $ head $ [col pHighColor | x > (cols !! 1) ] ++ + [col pNormalColor | x > head cols ] ++ [col pLowColor | True] pSetColor :: MonitorConfig -> String -> PSelector (Maybe String) -> String @@ -197,9 +197,9 @@ colorizeString x s = do h <- getConfigValue high l <- getConfigValue low let col = setColor s - [ll,hh] = map fromIntegral $ sort [l, h] -- consider high < low - head $ [col highColor | x > hh ] ++ - [col normalColor | x > ll ] ++ + cols = map fromIntegral $ sort [l, h] -- consider high < low + head $ [col highColor | x > cols !! 1 ] ++ + [col normalColor | x > head cols ] ++ [col lowColor | True] showWithColors :: (Num a, Ord a) => (a -> String) -> a -> Monitor String @@ -260,11 +260,11 @@ logScaling f v = do h <- fromIntegral `fmap` getConfigValue high l <- fromIntegral `fmap` getConfigValue low bw <- fromIntegral `fmap` getConfigValue barWidth - let [ll, hh] = sort [l, h] + let ws = sort [l, h] bw' = if bw > 0 then bw else 10 scaled x | x == 0.0 = 0 - | x <= ll = 1 / bw' - | otherwise = f + logBase 2 (x / hh) / bw' + | x <= head ws = 1 / bw' + | otherwise = f + logBase 2 (x / ws !! 1) / bw' return $ scaled v showLogBar :: Float -> Float -> Monitor String diff --git a/src/Xmobar/Plugins/Monitors/Disk.hs b/src/Xmobar/Plugins/Monitors/Disk.hs index 47d1eac..95bcff6 100644 --- a/src/Xmobar/Plugins/Monitors/Disk.hs +++ b/src/Xmobar/Plugins/Monitors/Disk.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Disk --- Copyright : (c) 2010, 2011, 2012, 2014, 2018, 2019 Jose A Ortega Ruiz +-- Copyright : (c) 2010-2012, 2014, 2018, 2019, 2024 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz @@ -131,10 +131,9 @@ startDiskIO disks args rate cb = do runM args diskIOConfig (runDiskIO dref disks) rate cb runDiskU' :: DiskUOpts -> String -> [Integer] -> Monitor String -runDiskU' opts tmp stat = do +runDiskU' opts tmp (total:free:diff:_) = do setConfigValue tmp template - let [total, free, diff] = stat - strs = map sizeToStr [free, diff] + let strs = map sizeToStr [free, diff] freep = if total > 0 then free * 100 `div` total else 0 fr = fromIntegral freep / 100 s <- zipWithM showWithColors' strs [freep, 100 - freep] @@ -146,6 +145,7 @@ runDiskU' opts tmp stat = do uvb <- showVerticalBar (fromIntegral $ 100 - freep) (1 - fr) uipat <- showIconPattern (usedIconPattern opts) (1 - fr) parseTemplate $ [sizeToStr total] ++ s ++ sp ++ [fb,fvb,fipat,ub,uvb,uipat] +runDiskU' _ _ _ = return "" runDiskU :: [(String, String)] -> [String] -> Monitor String runDiskU disks argv = do diff --git a/src/Xmobar/Plugins/Monitors/Mem/Linux.hs b/src/Xmobar/Plugins/Monitors/Mem/Linux.hs index 79dcc9d..7a81c6d 100644 --- a/src/Xmobar/Plugins/Monitors/Mem/Linux.hs +++ b/src/Xmobar/Plugins/Monitors/Mem/Linux.hs @@ -25,9 +25,13 @@ parseMEM = let content = map words $ take 8 $ lines file info = M.fromList $ map ( \line -> (head line, (read $ line !! 1 :: Float) / 1024)) content - [total, free, buffer, cache] = - map (info M.!) ["MemTotal:", "MemFree:", "Buffers:", "Cached:"] - available = M.findWithDefault (free + buffer + cache) "MemAvailable:" info + info' x = info M.! (x ++ ":") + total = info' "MemTotal" + free = info' "MemFree" + buffer = info' "Buffers" + cache = info' "Cached" + available = + M.findWithDefault (free + buffer + cache) "MemAvailable:" info used = total - available usedratio = used / total freeratio = free / total diff --git a/src/Xmobar/Plugins/Monitors/Net/Linux.hs b/src/Xmobar/Plugins/Monitors/Net/Linux.hs index 9306497..f9cbc28 100644 --- a/src/Xmobar/Plugins/Monitors/Net/Linux.hs +++ b/src/Xmobar/Plugins/Monitors/Net/Linux.hs @@ -47,7 +47,10 @@ isUp d = flip catchIOError (const $ return False) $ do return $! (head . B.lines) operstate `elem` ["up", "unknown"] readNetDev :: [String] -> IO NetDevRawTotal -readNetDev ~[d, x, y] = do +readNetDev ds = do + let (d, x, y) = case ds of + d':x':y':_ -> (d', x', y') + _ -> ("", "", "") up <- unsafeInterleaveIO $ isUp d return $ N d (if up then ND (r x) (r y) else NI) where r s | s == "" = 0 diff --git a/src/Xmobar/Run/Template.hs b/src/Xmobar/Run/Template.hs index 87c84d3..68feacb 100644 --- a/src/Xmobar/Run/Template.hs +++ b/src/Xmobar/Run/Template.hs @@ -77,5 +77,6 @@ splitTemplate alignSep template = (ce,_:ri) -> [le, ce, ri] _ -> def _ -> def - where [l, r] = if length alignSep == 2 then alignSep else defaultAlign + where sep = if length alignSep == 2 then alignSep else defaultAlign + (l, r) = (head sep, sep !! 1) def = [template, "", ""] diff --git a/src/Xmobar/System/Environment.hs b/src/Xmobar/System/Environment.hs index 42483ca..0491bcc 100644 --- a/src/Xmobar/System/Environment.hs +++ b/src/Xmobar/System/Environment.hs @@ -36,12 +36,13 @@ expandEnv (c:s) = case c of False -> do remainder <- expandEnv $ drop 1 s return $ escString s ++ remainder - where escString s' = let (cc:_) = s' in + where escString (cc:_) = case cc of 't' -> "\t" 'n' -> "\n" '$' -> "$" _ -> [cc] + escString [] = "" _ -> do remainder <- expandEnv s diff --git a/src/Xmobar/X11/Bitmap.hs b/src/Xmobar/X11/Bitmap.hs index b14356f..c5304d9 100644 --- a/src/Xmobar/X11/Bitmap.hs +++ b/src/Xmobar/X11/Bitmap.hs @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : X11.Bitmap --- Copyright : (C) 2013, 2015, 2017, 2018, 2022 Alexander Polakov +-- Copyright : (C) 2013, 2015, 2017, 2018, 2022, 2024 Alexander Polakov -- License : BSD3 -- -- Maintainer : jao@gnu.org @@ -116,8 +116,9 @@ loadBitmap d w p = do drawBitmap :: Display -> Drawable -> GC -> String -> String -> Position -> Position -> Bitmap -> IO () drawBitmap d p gc fc bc x y i = - withColors d [fc, bc] $ \[fc', bc'] -> do - let w = width i + withColors d [fc, bc] $ \cs -> do + let (fc', bc') = (head cs, cs !! 1) + w = width i h = height i y' = 1 + y - fromIntegral h `div` 2 setForeground d gc fc' diff --git a/src/Xmobar/X11/Loop.hs b/src/Xmobar/X11/Loop.hs index 6ddb693..2dfb34d 100644 --- a/src/Xmobar/X11/Loop.hs +++ b/src/Xmobar/X11/Loop.hs @@ -3,7 +3,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.X11EventLoop --- Copyright: (c) 2018, 2020, 2022, 2023 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2020, 2022, 2023, 2024 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -149,8 +149,7 @@ signalLoop xc@(T.XConf d r w fs is cfg) actions signalv strs = do parseSegments :: C.Config -> STM.TVar [String] -> IO [[C.Segment]] parseSegments conf v = do s <- STM.readTVarIO v - let l:c:r:_ = s ++ repeat "" - return $ map (CT.parseString conf) [l, c, r] + return $ map (CT.parseString conf) (take 3 $ s ++ repeat "") updateIconCache :: T.XConf -> [[C.Segment]] -> IO T.XConf updateIconCache xc@(T.XConf d _ w _ c cfg) segs = do -- cgit v1.2.3