From d9b24473ce65c6ce7f5bdea8c7d6eee07a62461e Mon Sep 17 00:00:00 2001 From: Reto Hablützel Date: Sat, 9 Aug 2014 21:33:10 +0200 Subject: hlint refactorings --- src/Actions.hs | 2 +- src/ColorCache.hs | 4 ++-- src/IPC/DBus.hs | 2 +- src/Main.hs | 8 ++++---- src/Parsers.hs | 6 +++--- src/Plugins/BufferedPipeReader.hs | 4 ++-- src/Plugins/Date.hs | 3 ++- src/Plugins/EWMH.hs | 12 ++++++------ src/Plugins/MBox.hs | 2 +- src/Plugins/Mail.hs | 2 +- src/Plugins/Monitors.hs | 2 +- src/Plugins/Monitors/Batt.hs | 7 ++++--- src/Plugins/Monitors/Bright.hs | 21 +++++++++++---------- src/Plugins/Monitors/CatInt.hs | 2 +- src/Plugins/Monitors/Common.hs | 7 ++++--- src/Plugins/Monitors/CoreTemp.hs | 6 +++--- src/Plugins/Monitors/Cpu.hs | 4 ++-- src/Plugins/Monitors/CpuFreq.hs | 8 ++++---- src/Plugins/Monitors/Disk.hs | 4 ++-- src/Plugins/Monitors/Mem.hs | 4 ++-- src/Plugins/Monitors/Mpris.hs | 19 ++++++++++--------- src/Plugins/Monitors/MultiCpu.hs | 7 ++++--- src/Plugins/Monitors/Net.hs | 6 +++--- src/Plugins/Monitors/Swap.hs | 4 ++-- src/Plugins/Monitors/Thermal.hs | 13 ++++++------- src/Plugins/Monitors/Weather.hs | 14 +++++++------- src/Plugins/PipeReader.hs | 17 +++++++---------- src/Plugins/StdinReader.hs | 2 +- src/Window.hs | 3 ++- src/Xmobar.hs | 18 ++++++++++-------- 30 files changed, 109 insertions(+), 104 deletions(-) diff --git a/src/Actions.hs b/src/Actions.hs index 5bcfea7..a739828 100644 --- a/src/Actions.hs +++ b/src/Actions.hs @@ -28,7 +28,7 @@ stripActions s = case matchRegex actionRegex s of Nothing -> s Just _ -> stripActions strippedOneLevel where - strippedOneLevel = subRegex actionRegex s $ "[action=\\1\\2]\\3[/action]" + strippedOneLevel = subRegex actionRegex s "[action=\\1\\2]\\3[/action]" actionRegex :: Regex actionRegex = mkRegex "`]*)`?( +button=[12345]+)?>(.+)" diff --git a/src/ColorCache.hs b/src/ColorCache.hs index e9c5810..3f8d7b4 100644 --- a/src/ColorCache.hs +++ b/src/ColorCache.hs @@ -35,10 +35,10 @@ import Graphics.X11.Xlib data DynPixel = DynPixel Bool Pixel initColor :: Display -> String -> IO DynPixel -initColor dpy c = handle black $ (initColor' dpy c) +initColor dpy c = handle black $ initColor' dpy c where black :: SomeException -> IO DynPixel - black = (const . return $ DynPixel False (blackPixel dpy $ defaultScreen dpy)) + black = const . return $ DynPixel False (blackPixel dpy $ defaultScreen dpy) type ColorCache = [(String, Color)] {-# NOINLINE colorCache #-} diff --git a/src/IPC/DBus.hs b/src/IPC/DBus.hs index b95e59f..3f2d6f2 100644 --- a/src/IPC/DBus.hs +++ b/src/IPC/DBus.hs @@ -44,7 +44,7 @@ runIPC mvst = handle printException exportConnection sendSignalMethod :: TMVar SignalType -> Method sendSignalMethod mvst = method interfaceName sendSignalName - (signature_ [variantType $ toVariant $ (undefined :: SignalType)]) + (signature_ [variantType $ toVariant (undefined :: SignalType)]) (signature_ []) sendSignalMethodCall where diff --git a/src/Main.hs b/src/Main.hs index 92573b9..f3885ff 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -37,7 +37,7 @@ import System.Exit import System.Environment import System.FilePath (()) import System.Posix.Files -import Control.Monad (unless) +import Control.Monad (unless, liftM) import Signal (setupSignalHandler) @@ -94,13 +94,13 @@ xdgConfigDir :: IO String xdgConfigDir = do env <- getEnvironment case lookup "XDG_CONFIG_HOME" env of Just val -> return val - Nothing -> getHomeDirectory >>= return . ( ".config") + Nothing -> liftM ( ".config") getHomeDirectory xmobarConfigDir :: IO FilePath -xmobarConfigDir = xdgConfigDir >>= return . ( "xmobar") +xmobarConfigDir = liftM ( "xmobar") xdgConfigDir getXdgConfigFile :: IO FilePath -getXdgConfigFile = xmobarConfigDir >>= return . ( "xmobarrc") +getXdgConfigFile = liftM ( "xmobarrc") xmobarConfigDir -- | Read default configuration file or load the default config readDefaultConfig :: IO (Config,[String]) diff --git a/src/Parsers.hs b/src/Parsers.hs index cda7004..69c5f21 100644 --- a/src/Parsers.hs +++ b/src/Parsers.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : Xmobar.Parsers @@ -87,7 +87,7 @@ rawParser c a = do char ':' case reads lenstr of [(len,[])] -> do - guard ((len :: Integer) <= (fromIntegral (maxBound :: Int))) + guard ((len :: Integer) <= fromIntegral (maxBound :: Int)) s <- count (fromIntegral len) anyChar string "/>" return [(Text s, c, a)] @@ -123,7 +123,7 @@ actionParser c act = do return (concat s) toButtons :: String -> [Button] -toButtons s = map (\x -> read [x]) s +toButtons = map (\x -> read [x]) -- | Parsers a string wrapped in a color specification. colorParser :: Maybe [Action] -> Parser [(Widget, ColorString, Maybe [Action])] diff --git a/src/Plugins/BufferedPipeReader.hs b/src/Plugins/BufferedPipeReader.hs index a2ea2a3..9a7266e 100644 --- a/src/Plugins/BufferedPipeReader.hs +++ b/src/Plugins/BufferedPipeReader.hs @@ -14,7 +14,7 @@ module Plugins.BufferedPipeReader where -import Control.Monad(forM_, when) +import Control.Monad(forM_, when, void) import Control.Concurrent import Control.Concurrent.STM import System.IO @@ -66,7 +66,7 @@ instance Exec BufferedPipeReader where where sfork :: IO () -> IO () - sfork f = forkIO f >> return () + sfork f = void (forkIO f) update :: IO (Int, Bool, String, TVar Bool) update = atomically $ do diff --git a/src/Plugins/Date.hs b/src/Plugins/Date.hs index 3caad30..a263536 100644 --- a/src/Plugins/Date.hs +++ b/src/Plugins/Date.hs @@ -21,6 +21,7 @@ module Plugins.Date (Date(..)) where import Plugins import System.Locale +import Control.Monad (liftM) import Data.Time data Date = Date String String Int @@ -32,4 +33,4 @@ instance Exec Date where rate (Date _ _ r) = r date :: String -> IO String -date format = getZonedTime >>= return . formatTime defaultTimeLocale format +date format = liftM (formatTime defaultTimeLocale format) getZonedTime diff --git a/src/Plugins/EWMH.hs b/src/Plugins/EWMH.hs index d5b70cb..5f1c0c4 100644 --- a/src/Plugins/EWMH.hs +++ b/src/Plugins/EWMH.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -w #-} -{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP, NamedFieldPuns, GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | @@ -58,7 +58,7 @@ instance Exec EWMH where liftIO $ nextEvent' d ep e <- liftIO $ getEvent ep case e of - PropertyEvent { ev_atom = a, ev_window = w } -> do + PropertyEvent { ev_atom = a, ev_window = w } -> case lookup a handlers' of Just f -> f w _ -> return () @@ -95,7 +95,7 @@ fmt e (Workspaces opts) = sep " " attrs = [(n, [s | (s, b) <- stats i, b]) | (i, n) <- zip [0 ..] (desktopNames e)] nonEmptys = Set.unions . map desktops . Map.elems $ clients e -modifier :: Modifier -> (String -> String) +modifier :: Modifier -> String -> String modifier Hide = const "" modifier (Color fg bg) = \x -> concat ["", x, ""] @@ -227,9 +227,9 @@ updateClientList _ = do dels = Map.difference cl cl' new = Map.difference cl' cl modify (\s -> s { clients = Map.union (Map.intersection cl cl') cl'}) - mapM_ unmanage (map fst $ Map.toList dels) - mapM_ listen (map fst $ Map.toList cl') - mapM_ update (map fst $ Map.toList new) + mapM_ (unmanage . fst) (Map.toList dels) + mapM_ (listen . fst) (Map.toList cl') + mapM_ (update . fst) (Map.toList new) _ -> return () where unmanage w = asks display >>= \d -> liftIO $ selectInput d w 0 diff --git a/src/Plugins/MBox.hs b/src/Plugins/MBox.hs index d9a9765..62f9d78 100644 --- a/src/Plugins/MBox.hs +++ b/src/Plugins/MBox.hs @@ -71,7 +71,7 @@ data MBox = MBox [(String, FilePath, String)] [String] String instance Exec MBox where alias (MBox _ _ a) = a #ifndef INOTIFY - start _ _ = do + start _ _ = hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify" ++ " but the MBox plugin requires it" #else diff --git a/src/Plugins/Mail.hs b/src/Plugins/Mail.hs index 23a5654..772d1d7 100644 --- a/src/Plugins/Mail.hs +++ b/src/Plugins/Mail.hs @@ -41,7 +41,7 @@ data Mail = Mail [(String, FilePath)] String instance Exec Mail where alias (Mail _ a) = a #ifndef INOTIFY - start _ _ = do + start _ _ = hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify," ++ " but the Mail plugin requires it." #else diff --git a/src/Plugins/Monitors.hs b/src/Plugins/Monitors.hs index 860da71..9aef386 100644 --- a/src/Plugins/Monitors.hs +++ b/src/Plugins/Monitors.hs @@ -118,7 +118,7 @@ instance Exec Monitors where alias (DiskU _ _ _) = "disku" alias (DiskIO _ _ _) = "diskio" alias (Uptime _ _) = "uptime" - alias (CatInt n _ _ _) = "cat" ++ (show n) + alias (CatInt n _ _ _) = "cat" ++ show n #ifdef IWLIB alias (Wireless i _ _) = i ++ "wi" #endif diff --git a/src/Plugins/Monitors/Batt.hs b/src/Plugins/Monitors/Batt.hs index 3eb2051..ac8cb24 100644 --- a/src/Plugins/Monitors/Batt.hs +++ b/src/Plugins/Monitors/Batt.hs @@ -105,7 +105,7 @@ batteryFiles bat = do is_charge <- exists "charge_now" is_energy <- if is_charge then return False else exists "energy_now" is_power <- exists "power_now" - plain <- if is_charge then exists "charge_full" else exists "energy_full" + plain <- exists (if is_charge then "charge_full" else "energy_full") let cf = if is_power then "power_now" else "current_now" sf = if plain then "" else "_design" return $ case (is_charge, is_energy) of @@ -150,8 +150,9 @@ readBatteries opts bfs = time = if idle then 0 else sum $ map time' bats mwatts = if idle then 1 else sign * watts time' b = (if ac then full b - now b else now b) / mwatts - acstr = if idle then idleString opts else - if ac then onString opts else offString opts + acstr | idle = idleString opts + | ac = onString opts + | otherwise = offString opts return $ if isNaN left then NA else Result left watts time acstr runBatt :: [String] -> Monitor String diff --git a/src/Plugins/Monitors/Bright.hs b/src/Plugins/Monitors/Bright.hs index 1c4cc01..d29c5a4 100644 --- a/src/Plugins/Monitors/Bright.hs +++ b/src/Plugins/Monitors/Bright.hs @@ -14,6 +14,7 @@ module Plugins.Monitors.Bright (brightConfig, runBright) where +import Control.Applicative ((<$>)) import Control.Exception (SomeException, handle) import qualified Data.ByteString.Lazy.Char8 as B import System.FilePath (()) @@ -60,12 +61,12 @@ data Files = Files { fCurr :: String brightFiles :: BrightOpts -> IO Files brightFiles opts = do - is_curr <- fileExist $ (fCurr files) - is_max <- fileExist $ (fCurr files) - if is_curr && is_max then return files else return NoFiles - where prefix = sysDir (subDir opts) - files = Files { fCurr = prefix (currBright opts) - , fMax = prefix (maxBright opts) + is_curr <- fileExist $ fCurr files + is_max <- fileExist $ fCurr files + return (if is_curr && is_max then files else NoFiles) + where prefix = sysDir subDir opts + files = Files { fCurr = prefix currBright opts + , fMax = prefix maxBright opts } runBright :: [String] -> Monitor String @@ -85,9 +86,9 @@ runBright args = do readBright :: Files -> IO Float readBright NoFiles = return 0 readBright files = do - currVal<- grab $ (fCurr files) - maxVal <- grab $ (fMax files) - return $ (currVal / maxVal) - where grab f = handle handler (fmap (read . B.unpack) $ B.readFile f) + currVal<- grab $ fCurr files + maxVal <- grab $ fMax files + return (currVal / maxVal) + where grab f = handle handler (read . B.unpack <$> B.readFile f) handler = const (return 0) :: SomeException -> IO Float diff --git a/src/Plugins/Monitors/CatInt.hs b/src/Plugins/Monitors/CatInt.hs index 3d19270..aacbd71 100644 --- a/src/Plugins/Monitors/CatInt.hs +++ b/src/Plugins/Monitors/CatInt.hs @@ -20,6 +20,6 @@ catIntConfig = mkMConfig "" ["v"] runCatInt :: FilePath -> [String] -> Monitor String runCatInt p _ = - let failureMessage = "Cannot read: " ++ (show p) + let failureMessage = "Cannot read: " ++ show p fmt x = show (truncate x :: Int) in checkedDataRetrieval failureMessage [[p]] Nothing id fmt diff --git a/src/Plugins/Monitors/Common.hs b/src/Plugins/Monitors/Common.hs index 70f1b5f..1fd09a6 100644 --- a/src/Plugins/Monitors/Common.hs +++ b/src/Plugins/Monitors/Common.hs @@ -60,6 +60,7 @@ module Plugins.Monitors.Common ( ) where +import Control.Applicative ((<$>)) import Control.Monad.Reader import qualified Data.ByteString.Lazy.Char8 as B import Data.IORef @@ -112,7 +113,7 @@ mods s m = setConfigValue :: a -> Selector a -> Monitor () setConfigValue v s = - mods s (\_ -> v) + mods s (const v) getConfigValue :: Selector a -> Monitor a getConfigValue = sel @@ -342,7 +343,7 @@ combine m ((s,ts,ss):xs) = do next <- combine m xs str <- case Map.lookup ts m of Nothing -> return $ "<" ++ ts ++ ">" - Just r -> let f "" = r; f n = n; in fmap f $ parseTemplate' r m + Just r -> let f "" = r; f n = n; in f <$> parseTemplate' r m return $ s ++ str ++ ss ++ next -- $strings @@ -459,7 +460,7 @@ showVerticalBar v x = colorizeString v [convert $ 100 * x] | t <= 9600 = ' ' | t > 9608 = chr 9608 | otherwise = chr t - where t = 9600 + ((round val) `div` 12) + where t = 9600 + (round val `div` 12) showLogBar :: Float -> Float -> Monitor String showLogBar f v = do diff --git a/src/Plugins/Monitors/CoreTemp.hs b/src/Plugins/Monitors/CoreTemp.hs index bfe9aca..e19baf0 100644 --- a/src/Plugins/Monitors/CoreTemp.hs +++ b/src/Plugins/Monitors/CoreTemp.hs @@ -27,8 +27,8 @@ import Data.Char (isDigit) coreTempConfig :: IO MConfig coreTempConfig = mkMConfig "Temp: C" -- template - (zipWith (++) (repeat "core") (map show [0 :: Int ..])) -- available - -- replacements + (map ((++) "core" . show) [0 :: Int ..]) -- available + -- replacements -- | -- Function retrieves monitor string holding the core temperature @@ -39,7 +39,7 @@ runCoreTemp _ = do failureMessage <- getConfigValue naString let path = ["/sys/bus/platform/devices/coretemp.", "/temp", "_input"] path' = ["/sys/bus/platform/devices/coretemp.", "/hwmon/hwmon", "/temp", "_input"] - lbl = Just ("_label", read . (dropWhile (not . isDigit))) + lbl = Just ("_label", read . dropWhile (not . isDigit)) divisor = 1e3 :: Double show' = showDigits (max 0 dn) checkedDataRetrieval failureMessage [path, path'] lbl (/divisor) show' diff --git a/src/Plugins/Monitors/Cpu.hs b/src/Plugins/Monitors/Cpu.hs index df2dc4e..10d945f 100644 --- a/src/Plugins/Monitors/Cpu.hs +++ b/src/Plugins/Monitors/Cpu.hs @@ -38,8 +38,8 @@ parseCpu cref = b <- cpuData writeIORef cref b let dif = zipWith (-) b a - tot = fromIntegral $ foldr (+) 0 dif - percent = map (/ tot) (map fromIntegral dif) + tot = fromIntegral $ sum dif + percent = map ((/ tot) . fromIntegral) dif return percent formatCpu :: [Float] -> Monitor [String] diff --git a/src/Plugins/Monitors/CpuFreq.hs b/src/Plugins/Monitors/CpuFreq.hs index 3fe2577..d3ecf89 100644 --- a/src/Plugins/Monitors/CpuFreq.hs +++ b/src/Plugins/Monitors/CpuFreq.hs @@ -24,8 +24,8 @@ import Plugins.Monitors.CoreCommon cpuFreqConfig :: IO MConfig cpuFreqConfig = mkMConfig "Freq: " -- template - (zipWith (++) (repeat "cpu") (map show [0 :: Int ..])) -- available - -- replacements + (map ((++) "cpu" . show) [0 :: Int ..]) -- available + -- replacements -- | -- Function retrieves monitor string holding the cpu frequency (or frequencies) @@ -33,7 +33,7 @@ runCpuFreq :: [String] -> Monitor String runCpuFreq _ = do let path = ["/sys/devices/system/cpu/cpu", "/cpufreq/scaling_cur_freq"] divisor = 1e6 :: Double - fmt x | x < 1 = (show (round (x * 1000) :: Integer)) ++ "MHz" - | otherwise = (show x) ++ "GHz" + fmt x | x < 1 = show (round (x * 1000) :: Integer) ++ "MHz" + | otherwise = show x ++ "GHz" failureMessage <- getConfigValue naString checkedDataRetrieval failureMessage [path] Nothing (/divisor) fmt diff --git a/src/Plugins/Monitors/Disk.hs b/src/Plugins/Monitors/Disk.hs index e0a7886..4cc2865 100644 --- a/src/Plugins/Monitors/Disk.hs +++ b/src/Plugins/Monitors/Disk.hs @@ -63,10 +63,10 @@ diskDevices req = do s <- B.readFile "/proc/diskstats" parse `fmap` mapM canon (devs s) where - canon (d, p) = do {d' <- canonicalizePath (d); return (d', p)} + canon (d, p) = do {d' <- canonicalizePath d; return (d', p)} devs = map (third . B.words) . B.lines parse = map undev . filter isReq - third (_:_:c:_) = ("/dev/" ++ (B.unpack c), B.unpack c) + third (_:_:c:_) = ("/dev/" ++ B.unpack c, B.unpack c) third _ = ("", "") isReq (d, p) = p `elem` req || drop 5 d `elem` req undev (d, f) = (drop 5 d, f) diff --git a/src/Plugins/Monitors/Mem.hs b/src/Plugins/Monitors/Mem.hs index e409095..db2e5de 100644 --- a/src/Plugins/Monitors/Mem.hs +++ b/src/Plugins/Monitors/Mem.hs @@ -30,10 +30,10 @@ parseMEM :: IO [Float] parseMEM = do file <- fileMEM let content = map words $ take 8 $ lines file - info = M.fromList $ map (\line -> (line !! 0, (read $ line !! 1 :: Float) / 1024)) content + info = M.fromList $ map (\line -> (head line, (read $ line !! 1 :: Float) / 1024)) content [total, free, buffer, cache] = map (info M.!) ["MemTotal:", "MemFree:", "Buffers:", "Cached:"] rest = free + buffer + cache - used = total - (M.findWithDefault rest "MemAvailable:" info) + used = total - M.findWithDefault rest "MemAvailable:" info usedratio = used / total freeratio = free / total return [usedratio, freeratio, total, free, buffer, cache, rest, used, freeratio] diff --git a/src/Plugins/Monitors/Mpris.hs b/src/Plugins/Monitors/Mpris.hs index 98b4c0f..245c0df 100644 --- a/src/Plugins/Monitors/Mpris.hs +++ b/src/Plugins/Monitors/Mpris.hs @@ -25,6 +25,7 @@ import Text.Printf (printf) import DBus import qualified DBus.Client as DC +import Control.Arrow ((***)) import Data.Maybe ( fromJust ) import Data.Int ( Int32, Int64 ) import System.IO.Unsafe (unsafePerformIO) @@ -43,10 +44,10 @@ instance MprisVersion MprisVersion1 where { methodCallDestination = Just busName } where - busName = busName_ $ "org.mpris." ++ p - objectPath = objectPath_ $ "/Player" - interfaceName = interfaceName_ $ "org.freedesktop.MediaPlayer" - memberName = memberName_ $ "GetMetadata" + busName = busName_ $ "org.mpris." ++ p + objectPath = objectPath_ "/Player" + interfaceName = interfaceName_ "org.freedesktop.MediaPlayer" + memberName = memberName_ "GetMetadata" fieldsList MprisVersion1 = [ "album", "artist", "arturl", "mtime", "title" , "tracknumber" ] @@ -58,10 +59,10 @@ instance MprisVersion MprisVersion2 where , methodCallBody = arguments } where - busName = busName_ $ "org.mpris.MediaPlayer2." ++ p - objectPath = objectPath_ $ "/org/mpris/MediaPlayer2" - interfaceName = interfaceName_ $ "org.freedesktop.DBus.Properties" - memberName = memberName_ $ "Get" + busName = busName_ $ "org.mpris.MediaPlayer2." ++ p + objectPath = objectPath_ "/org/mpris/MediaPlayer2" + interfaceName = interfaceName_ "org.freedesktop.DBus.Properties" + memberName = memberName_ "Get" arguments = map (toVariant::String -> Variant) ["org.mpris.MediaPlayer2.Player", "Metadata"] @@ -98,7 +99,7 @@ fromVar = fromJust . fromVariant unpackMetadata :: [Variant] -> [(String, Variant)] unpackMetadata [] = [] -unpackMetadata xs = ((map (\(k, v) -> (fromVar k, fromVar v))) . unpack . head) xs where +unpackMetadata xs = (map (fromVar *** fromVar) . unpack . head) xs where unpack v = case variantType v of TypeDictionary _ _ -> dictionaryItems $ fromVar v TypeVariant -> unpack $ fromVar v diff --git a/src/Plugins/Monitors/MultiCpu.hs b/src/Plugins/Monitors/MultiCpu.hs index 429c38a..150fb7e 100644 --- a/src/Plugins/Monitors/MultiCpu.hs +++ b/src/Plugins/Monitors/MultiCpu.hs @@ -15,6 +15,7 @@ module Plugins.Monitors.MultiCpu (startMultiCpu) where import Plugins.Monitors.Common +import Control.Applicative ((<$>)) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (isPrefixOf, transpose, unfoldr) import Data.IORef (IORef, newIORef, readIORef, writeIORef) @@ -52,16 +53,16 @@ parseCpuData cref = percent :: [Float] -> [Float] -> [Float] percent b a = if tot > 0 then map (/ tot) $ take 4 dif else [0, 0, 0, 0] where dif = zipWith (-) b a - tot = foldr (+) 0 dif + tot = sum dif formatMultiCpus :: [[Float]] -> Monitor [String] formatMultiCpus [] = return [] -formatMultiCpus xs = fmap concat $ mapM formatCpu xs +formatMultiCpus xs = concat <$> mapM formatCpu xs formatCpu :: [Float] -> Monitor [String] formatCpu xs | length xs < 4 = showPercentsWithColors $ replicate vNum 0.0 - | otherwise = let t = foldr (+) 0 $ take 3 xs + | otherwise = let t = sum $ take 3 xs in do b <- showPercentBar (100 * t) t h <- showVerticalBar (100 * t) t ps <- showPercentsWithColors (t:xs) diff --git a/src/Plugins/Monitors/Net.hs b/src/Plugins/Monitors/Net.hs index 31dc411..39bdd61 100644 --- a/src/Plugins/Monitors/Net.hs +++ b/src/Plugins/Monitors/Net.hs @@ -22,7 +22,7 @@ import Plugins.Monitors.Common import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime) -import Control.Monad (forM, filterM) +import Control.Monad (forM, filterM, liftM) import System.Directory (getDirectoryContents, doesFileExist) import System.FilePath (()) @@ -147,11 +147,11 @@ runNet :: NetDevRef -> String -> [String] -> Monitor String runNet nref i _ = io (parseNet nref i) >>= printNet parseNets :: [(NetDevRef, String)] -> IO [NetDev] -parseNets = mapM $ \(ref, i) -> parseNet ref i +parseNets = mapM $ uncurry parseNet runNets :: [(NetDevRef, String)] -> [String] -> Monitor String runNets refs _ = io (parseActive refs) >>= printNet - where parseActive refs' = parseNets refs' >>= return . selectActive + where parseActive refs' = liftM selectActive (parseNets refs') selectActive = maximum startNet :: String -> [String] -> Int -> (String -> IO ()) -> IO () diff --git a/src/Plugins/Monitors/Swap.hs b/src/Plugins/Monitors/Swap.hs index 107eb1e..b6c5019 100644 --- a/src/Plugins/Monitors/Swap.hs +++ b/src/Plugins/Monitors/Swap.hs @@ -33,8 +33,8 @@ parseMEM = | l /= [] = head l !! i | otherwise = B.empty fs s l - | l == [] = False - | otherwise = head l == B.pack s + | null l = False + | otherwise = head l == B.pack s get_data s = flip (/) 1024 . read . B.unpack . li 1 . filter (fs s) st = map B.words . B.lines $ file tot = get_data "SwapTotal:" st diff --git a/src/Plugins/Monitors/Thermal.hs b/src/Plugins/Monitors/Thermal.hs index a3ffe6d..6013511 100644 --- a/src/Plugins/Monitors/Thermal.hs +++ b/src/Plugins/Monitors/Thermal.hs @@ -14,6 +14,7 @@ module Plugins.Monitors.Thermal where +import Control.Monad (liftM) import qualified Data.ByteString.Lazy.Char8 as B import Plugins.Monitors.Common import System.Posix.Files (fileExist) @@ -32,11 +33,9 @@ runThermal args = do let zone = head args file = "/proc/acpi/thermal_zone/" ++ zone ++ "/temperature" exists <- io $ fileExist file - case exists of - False -> return $ "Thermal (" ++ zone ++ "): N/A" - True -> do number <- io $ B.readFile file - >>= return . (read :: String -> Int) - . stringParser (1, 0) - thermal <- showWithColors show number - parseTemplate [ thermal ] + if exists + then do number <- io $ liftM ((read :: String -> Int) . stringParser (1, 0)) (B.readFile file) + thermal <- showWithColors show number + parseTemplate [ thermal ] + else return $ "Thermal (" ++ zone ++ "): N/A" diff --git a/src/Plugins/Monitors/Weather.hs b/src/Plugins/Monitors/Weather.hs index dfc421e..ba4d911 100644 --- a/src/Plugins/Monitors/Weather.hs +++ b/src/Plugins/Monitors/Weather.hs @@ -68,7 +68,7 @@ pTime = do y <- getNumbersAsString char ' ' (h:hh:mi:mimi) <- getNumbersAsString char ' ' - return (y, m, d ,([h]++[hh]++":"++[mi]++mimi)) + return (y, m, d ,[h]++[hh]++":"++[mi]++mimi) pTemp :: Parser (Int, Int) pTemp = do let num = digit <|> char '-' <|> char '.' @@ -76,10 +76,10 @@ pTemp = do let num = digit <|> char '-' <|> char '.' manyTill anyChar $ char '(' c <- manyTill num $ char ' ' skipRestOfLine - return $ (floor (read c :: Double), floor (read f :: Double)) + return (floor (read c :: Double), floor (read f :: Double)) pRh :: Parser Int -pRh = do s <- manyTill digit $ (char '%' <|> char '.') +pRh = do s <- manyTill digit (char '%' <|> char '.') return $ read s pPressure :: Parser Int @@ -123,7 +123,7 @@ parseData = skipTillString "Pressure (altimeter): " p <- pPressure manyTill skipRestOfLine eof - return $ [WI st ss y m d h w v sk tC tF dp rh p] + return [WI st ss y m d h w v sk tC tF dp rh p] defUrl :: String defUrl = "http://weather.noaa.gov/pub/data/observations/metar/decoded/" @@ -139,7 +139,7 @@ getData station = do errHandler _ = return "" formatWeather :: [WeatherInfo] -> Monitor String -formatWeather [(WI st ss y m d h w v sk tC tF dp r p)] = +formatWeather [WI st ss y m d h w v sk tC tF dp r p] = do cel <- showWithColors show tC far <- showWithColors show tF parseTemplate [st, ss, y, m, d, h, w, v, sk, cel, far, dp, show r , show p ] @@ -158,10 +158,10 @@ weatherReady str = do io $ CE.catch (simpleHTTP request >>= checkResult) errHandler where errHandler :: CE.IOException -> IO Bool errHandler _ = return False - checkResult result = do + checkResult result = case result of Left _ -> return False - Right response -> do + Right response -> case rspCode response of -- Permission or network errors are failures; anything -- else is recoverable. diff --git a/src/Plugins/PipeReader.hs b/src/Plugins/PipeReader.hs index 7efea60..058ed46 100644 --- a/src/Plugins/PipeReader.hs +++ b/src/Plugins/PipeReader.hs @@ -19,7 +19,7 @@ import Plugins import System.Posix.Files import Control.Concurrent(threadDelay) import Control.Exception -import Control.Monad(when) +import Control.Monad(forever, unless) data PipeReader = PipeReader String String deriving (Read, Show) @@ -28,21 +28,18 @@ instance Exec PipeReader where alias (PipeReader _ a) = a start (PipeReader p _) cb = do let (def, pipe) = split ':' p - when (not $ null def) (cb def) + unless (null def) (cb def) checkPipe pipe h <- openFile pipe ReadWriteMode forever (hGetLineSafe h >>= cb) where - forever a = a >> forever a - split c xs | c `elem` xs = let (pre, post) = span ((/=) c) xs - in (pre, dropWhile ((==) c) post) + split c xs | c `elem` xs = let (pre, post) = span (c /=) xs + in (pre, dropWhile (c ==) post) | otherwise = ([], xs) checkPipe :: FilePath -> IO () -checkPipe file = do +checkPipe file = handle (\(SomeException _) -> waitForPipe) $ do - status <- getFileStatus file - if isNamedPipe status - then return () - else waitForPipe + status <- getFileStatus file + unless (isNamedPipe status) waitForPipe where waitForPipe = threadDelay 1000 >> checkPipe file diff --git a/src/Plugins/StdinReader.hs b/src/Plugins/StdinReader.hs index 35f0375..31d041e 100644 --- a/src/Plugins/StdinReader.hs +++ b/src/Plugins/StdinReader.hs @@ -34,7 +34,7 @@ instance Exec StdinReader where s <- handle (\(SomeException e) -> do hPrint stderr e; return "") (hGetLineSafe stdin) cb $ escape stdinReader s - eof <- hIsEOF stdin + eof <- isEOF if eof then exitImmediately ExitSuccess else start stdinReader cb diff --git a/src/Window.hs b/src/Window.hs index 876b7a2..f7e1801 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -16,6 +16,7 @@ module Window where import Prelude +import Control.Applicative ((<$>)) import Control.Monad (when, unless) import Graphics.X11.Xlib hiding (textExtents, textWidth) import Graphics.X11.Xlib.Extras @@ -190,5 +191,5 @@ showWindow r c d w = do sync d False isMapped :: Display -> Window -> IO Bool -isMapped d w = fmap ism $ getWindowAttributes d w +isMapped d w = ism <$> getWindowAttributes d w where ism (WindowAttributes { wa_map_state = wms }) = wms /= waIsUnmapped diff --git a/src/Xmobar.hs b/src/Xmobar.hs index c126b7c..6ea8fab 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, CPP #-} +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Xmobar @@ -36,13 +36,14 @@ import Graphics.X11.Xinerama import Graphics.X11.Xrandr import Control.Arrow ((&&&)) +import Control.Applicative ((<$>)) import Control.Monad.Reader import Control.Concurrent import Control.Concurrent.STM import Control.Exception (handle, SomeException(..)) import Data.Bits import Data.Map hiding (foldr, map, filter) -import Data.Maybe (fromJust) +import Data.Maybe (fromJust, isJust) import Bitmap import Config @@ -204,10 +205,11 @@ eventLoop tv xc@(XConf d r w fs is cfg) as signal = do case position ocfg of OnScreen n o -> do srs <- getScreenInfo d - if n == length srs then - return (ocfg {position = OnScreen 1 o}) - else - return (ocfg {position = OnScreen (n+1) o}) + return (if n == length srs + then + (ocfg {position = OnScreen 1 o}) + else + (ocfg {position = OnScreen (n+1) o})) o -> return (ocfg {position = OnScreen 1 o}) @@ -254,7 +256,7 @@ updateActions conf (Rectangle _ _ wid _) ~[left,center,right] = do getCoords (Text s,_,a) = textWidth d fs 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, _,_) -> a /= Nothing) $ + filter (\(a, _,_) -> isJust a) $ scanl (\(_,_,x') (a,_,w') -> (a, x', x' + w')) (Nothing, 0, off) xs totSLen = foldr (\(_,_,len) -> (+) len) 0 @@ -265,7 +267,7 @@ updateActions conf (Rectangle _ _ wid _) ~[left,center,right] = do R -> remWidth xs L -> offs - fmap concat $ mapM (\(a,xs) -> fmap (\xs' -> partCoord (offset a xs') xs') $ strLn xs) $ + fmap concat $ mapM (\(a,xs) -> (\xs' -> partCoord (offset a xs') xs') <$> strLn xs) $ zip [L,C,R] [left,center,right] -- $print -- cgit v1.2.3