From 72ec0ab7366970105a670cd213e82a30c97a5226 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 26 Apr 2014 19:25:05 -0400 Subject: [PATCH] hlint --- Utility/CoProcess.hs | 2 +- Utility/DBus.hs | 3 ++- Utility/Daemon.hs | 2 +- Utility/DataUnits.hs | 2 +- Utility/Directory.hs | 2 +- Utility/Exception.hs | 2 +- Utility/Gpg.hs | 4 ++-- Utility/HumanNumber.hs | 2 +- Utility/HumanTime.hs | 2 +- Utility/LinuxMkLibs.hs | 2 +- Utility/Lsof.hs | 4 ++-- Utility/Matcher.hs | 8 ++++---- 12 files changed, 18 insertions(+), 17 deletions(-) diff --git a/Utility/CoProcess.hs b/Utility/CoProcess.hs index c1134011bf..0c8e95e175 100644 --- a/Utility/CoProcess.hs +++ b/Utility/CoProcess.hs @@ -62,7 +62,7 @@ query ch send receive = do s <- readMVar ch restartable s (send $ coProcessTo s) $ const $ restartable s (hFlush $ coProcessTo s) $ const $ - restartable s (receive $ coProcessFrom s) $ + restartable s (receive $ coProcessFrom s) return where restartable s a cont diff --git a/Utility/DBus.hs b/Utility/DBus.hs index 3523a3aa35..bfcaa44716 100644 --- a/Utility/DBus.hs +++ b/Utility/DBus.hs @@ -9,6 +9,7 @@ module Utility.DBus where +import Utility.PartialPrelude import Utility.Exception import DBus.Client @@ -22,7 +23,7 @@ type ServiceName = String listServiceNames :: Client -> IO [ServiceName] listServiceNames client = do reply <- callDBus client "ListNames" [] - return $ fromMaybe [] $ fromVariant (methodReturnBody reply !! 0) + return $ fromMaybe [] $ fromVariant =<< headMaybe (methodReturnBody reply) callDBus :: Client -> MemberName -> [Variant] -> IO MethodReturn callDBus client name params = call_ client $ diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs index 11aa576868..5d47be035f 100644 --- a/Utility/Daemon.hs +++ b/Utility/Daemon.hs @@ -36,7 +36,7 @@ daemonize logfd pidfile changedirectory a = do _ <- forkProcess child1 out where - checkalreadyrunning f = maybe noop (const $ alreadyRunning) + checkalreadyrunning f = maybe noop (const alreadyRunning) =<< checkDaemon f child1 = do _ <- createSession diff --git a/Utility/DataUnits.hs b/Utility/DataUnits.hs index 2a936f1fda..7399809eb1 100644 --- a/Utility/DataUnits.hs +++ b/Utility/DataUnits.hs @@ -111,7 +111,7 @@ roughSize units short i | i < 0 = '-' : findUnit units' (negate i) | otherwise = findUnit units' i where - units' = reverse $ sort units -- largest first + units' = sortBy (flip compare) units -- largest first findUnit (u@(Unit s _ _):us) i' | i' >= s = showUnit i' u diff --git a/Utility/Directory.hs b/Utility/Directory.hs index f1bcfada37..c2a50714c7 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -43,7 +43,7 @@ dirContents d = map (d ) . filter (not . dirCruft) <$> getDirectoryContents d - When the directory does not exist, no exception is thrown, - instead, [] is returned. -} dirContentsRecursive :: FilePath -> IO [FilePath] -dirContentsRecursive topdir = dirContentsRecursiveSkipping (const False) True topdir +dirContentsRecursive = dirContentsRecursiveSkipping (const False) True {- Skips directories whose basenames match the skipdir. -} dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath] diff --git a/Utility/Exception.hs b/Utility/Exception.hs index cf2c615c7e..6f3c059f6e 100644 --- a/Utility/Exception.hs +++ b/Utility/Exception.hs @@ -18,7 +18,7 @@ import Utility.Data {- Catches IO errors and returns a Bool -} catchBoolIO :: IO Bool -> IO Bool -catchBoolIO a = catchDefaultIO False a +catchBoolIO = catchDefaultIO False {- Catches IO errors and returns a Maybe -} catchMaybeIO :: IO a -> IO (Maybe a) diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index 05c03d6efb..a00bf99da5 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -145,7 +145,7 @@ findPubKeys :: String -> IO KeyIds findPubKeys for = KeyIds . parse . lines <$> readStrict params where params = [Params "--with-colons --list-public-keys", Param for] - parse = catMaybes . map (keyIdField . split ":") + parse = mapMaybe (keyIdField . split ":") keyIdField ("pub":_:_:_:f:_) = Just f keyIdField _ = Nothing @@ -195,7 +195,7 @@ genSecretKey keytype passphrase userid keysize = Algo n -> show n , Just $ "Key-Length: " ++ show keysize , Just $ "Name-Real: " ++ userid - , Just $ "Expire-Date: 0" + , Just "Expire-Date: 0" , if null passphrase then Nothing else Just $ "Passphrase: " ++ passphrase diff --git a/Utility/HumanNumber.hs b/Utility/HumanNumber.hs index 904135987e..d5f647cd66 100644 --- a/Utility/HumanNumber.hs +++ b/Utility/HumanNumber.hs @@ -17,5 +17,5 @@ showImprecise precision n int :: Integer (int, frac) = properFraction n remainder = round (frac * 10 ^ precision) :: Integer - pad0s s = (take (precision - length s) (repeat '0')) ++ s + pad0s s = replicate (precision - length s) '0' ++ s striptrailing0s = reverse . dropWhile (== '0') . reverse diff --git a/Utility/HumanTime.hs b/Utility/HumanTime.hs index 297b2bd973..f52fd5b1b6 100644 --- a/Utility/HumanTime.hs +++ b/Utility/HumanTime.hs @@ -59,7 +59,7 @@ parseDuration = Duration <$$> go 0 fromDuration :: Duration -> String fromDuration Duration { durationSeconds = d } | d == 0 = "0s" - | otherwise = concat $ map showunit $ go [] units d + | otherwise = concatMap showunit $ go [] units d where showunit (u, n) | n > 0 = show n ++ [u] diff --git a/Utility/LinuxMkLibs.hs b/Utility/LinuxMkLibs.hs index 76e6266dda..f4744fcb24 100644 --- a/Utility/LinuxMkLibs.hs +++ b/Utility/LinuxMkLibs.hs @@ -49,7 +49,7 @@ inTop top f = top ++ f - link to. Note that some of the libraries may not exist - (eg, linux-vdso.so) -} parseLdd :: String -> [FilePath] -parseLdd = catMaybes . map (getlib . dropWhile isSpace) . lines +parseLdd = mapMaybe (getlib . dropWhile isSpace) . lines where getlib l = headMaybe . words =<< lastMaybe (split " => " l) diff --git a/Utility/Lsof.hs b/Utility/Lsof.hs index 63009f7232..b0d2bc53cf 100644 --- a/Utility/Lsof.hs +++ b/Utility/Lsof.hs @@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE BangPatterns, CPP #-} +{-# LANGUAGE CPP #-} module Utility.Lsof where @@ -110,7 +110,7 @@ parseFormatted s = bundle $ go [] $ lines s {- Parses lsof's default output format. -} parseDefault :: LsofParser -parseDefault = catMaybes . map parseline . drop 1 . lines +parseDefault = mapMaybe parseline . drop 1 . lines where parseline l = case words l of (command : spid : _user : _fd : _type : _device : _size : _node : rest) -> diff --git a/Utility/Matcher.hs b/Utility/Matcher.hs index eabc585f4c..5647c3e30c 100644 --- a/Utility/Matcher.hs +++ b/Utility/Matcher.hs @@ -64,10 +64,10 @@ generate = simplify . process MAny . tokenGroups process m [] = m process m ts = uncurry process $ consume m ts - consume m ((One And):rest) = term (m `MAnd`) rest - consume m ((One Or):rest) = term (m `MOr`) rest - consume m ((One Not):rest) = term (\p -> m `MAnd` (MNot p)) rest - consume m ((One (Operation o)):rest) = (m `MAnd` MOp o, rest) + consume m (One And:rest) = term (m `MAnd`) rest + consume m (One Or:rest) = term (m `MOr`) rest + consume m (One Not:rest) = term (\p -> m `MAnd` (MNot p)) rest + consume m (One (Operation o):rest) = (m `MAnd` MOp o, rest) consume m (Group g:rest) = (process m g, rest) consume m (_:rest) = consume m rest consume m [] = (m, [])