Commit b24c8461 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov Committed by GitHub
Browse files

Merge pull request #4495 from fgaz/lint

Partially linted
parents 512d74ad 50781c23
......@@ -30,7 +30,7 @@ import Data.Word
import Data.Binary.Put
import Data.Binary.Get
import Control.Monad
import Control.Applicative ((<$>), (<*>), (*>))
import Foreign
import Data.ByteString.Lazy (ByteString)
......@@ -104,12 +104,12 @@ instance Binary () where
-- Bools are encoded as a byte in the range 0 .. 1
instance Binary Bool where
put = putWord8 . fromIntegral . fromEnum
get = liftM (toEnum . fromIntegral) getWord8
get = fmap (toEnum . fromIntegral) getWord8
-- Values of type 'Ordering' are encoded as a byte in the range 0 .. 2
instance Binary Ordering where
put = putWord8 . fromIntegral . fromEnum
get = liftM (toEnum . fromIntegral) getWord8
get = fmap (toEnum . fromIntegral) getWord8
------------------------------------------------------------------------
-- Words and Ints
......@@ -137,34 +137,34 @@ instance Binary Word64 where
-- Int8s are written as a single byte.
instance Binary Int8 where
put i = put (fromIntegral i :: Word8)
get = liftM fromIntegral (get :: Get Word8)
get = fmap fromIntegral (get :: Get Word8)
-- Int16s are written as a 2 bytes in big endian format
instance Binary Int16 where
put i = put (fromIntegral i :: Word16)
get = liftM fromIntegral (get :: Get Word16)
get = fmap fromIntegral (get :: Get Word16)
-- Int32s are written as a 4 bytes in big endian format
instance Binary Int32 where
put i = put (fromIntegral i :: Word32)
get = liftM fromIntegral (get :: Get Word32)
get = fmap fromIntegral (get :: Get Word32)
-- Int64s are written as a 4 bytes in big endian format
instance Binary Int64 where
put i = put (fromIntegral i :: Word64)
get = liftM fromIntegral (get :: Get Word64)
get = fmap fromIntegral (get :: Get Word64)
------------------------------------------------------------------------
-- Words are are written as Word64s, that is, 8 bytes in big endian format
instance Binary Word where
put i = put (fromIntegral i :: Word64)
get = liftM fromIntegral (get :: Get Word64)
get = fmap fromIntegral (get :: Get Word64)
-- Ints are are written as Int64s, that is, 8 bytes in big endian format
instance Binary Int where
put i = put (fromIntegral i :: Int64)
get = liftM fromIntegral (get :: Get Int64)
get = fmap fromIntegral (get :: Get Int64)
------------------------------------------------------------------------
--
......@@ -200,7 +200,7 @@ instance Binary Integer where
get = do
tag <- get :: Get Word8
case tag of
0 -> liftM fromIntegral (get :: Get SmallInt)
0 -> fmap fromIntegral (get :: Get SmallInt)
_ -> do sign <- get
bytes <- get
let v = roll bytes
......@@ -237,7 +237,7 @@ import GHC.Ptr (Ptr(..))
import GHC.IOBase (IO(..))
instance Binary Integer where
put (S# i) = putWord8 0 >> put (I# i)
put (S# i) = putWord8 0 *> put (I# i)
put (J# s ba) = do
putWord8 1
put (I# s)
......@@ -263,7 +263,7 @@ instance Binary ByteArray where
-- Pretty scary. Should be quick though
get = do
(fp, off, n@(I# sz)) <- liftM toForeignPtr get -- so decode a ByteString
(fp, off, n@(I# sz)) <- fmap toForeignPtr get -- so decode a ByteString
assert (off == 0) $ return $ unsafePerformIO $ do
(MBA arr) <- newByteArray sz -- and copy it into a ByteArray#
let to = byteArrayContents# (unsafeCoerce# arr) -- urk, is this safe?
......@@ -287,8 +287,8 @@ freezeByteArray arr = IO $ \s ->
-}
instance (Binary a,Integral a) => Binary (R.Ratio a) where
put r = put (R.numerator r) >> put (R.denominator r)
get = liftM2 (R.%) get get
put r = put (R.numerator r) *> put (R.denominator r)
get = (R.%) <$> get <*> get
------------------------------------------------------------------------
......@@ -314,23 +314,23 @@ instance Binary Char where
w = fromIntegral (shiftR c 18 .&. 0x7)
get = do
let getByte = liftM (fromIntegral :: Word8 -> Int) get
let getByte = fmap (fromIntegral :: Word8 -> Int) get
shiftL6 = flip shiftL 6 :: Int -> Int
w <- getByte
r <- case () of
_ | w < 0x80 -> return w
| w < 0xe0 -> do
x <- liftM (xor 0x80) getByte
x <- fmap (xor 0x80) getByte
return (x .|. shiftL6 (xor 0xc0 w))
| w < 0xf0 -> do
x <- liftM (xor 0x80) getByte
y <- liftM (xor 0x80) getByte
x <- fmap (xor 0x80) getByte
y <- fmap (xor 0x80) getByte
return (y .|. shiftL6 (x .|. shiftL6
(xor 0xe0 w)))
| otherwise -> do
x <- liftM (xor 0x80) getByte
y <- liftM (xor 0x80) getByte
z <- liftM (xor 0x80) getByte
x <- fmap (xor 0x80) getByte
y <- fmap (xor 0x80) getByte
z <- fmap (xor 0x80) getByte
return (z .|. shiftL6 (y .|. shiftL6
(x .|. shiftL6 (xor 0xf0 w))))
return $! chr r
......@@ -339,20 +339,20 @@ instance Binary Char where
-- Instances for the first few tuples
instance (Binary a, Binary b) => Binary (a,b) where
put (a,b) = put a >> put b
get = liftM2 (,) get get
put (a,b) = put a *> put b
get = (,) <$> get <*> get
instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where
put (a,b,c) = put a >> put b >> put c
get = liftM3 (,,) get get get
put (a,b,c) = put a *> put b *> put c
get = (,,) <$> get <*> get <*> get
instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where
put (a,b,c,d) = put a >> put b >> put c >> put d
get = liftM4 (,,,) get get get get
put (a,b,c,d) = put a *> put b *> put c *> put d
get = (,,,) <$> get <*> get <*> get <*> get
instance (Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a,b,c,d,e) where
put (a,b,c,d,e) = put a >> put b >> put c >> put d >> put e
get = liftM5 (,,,,) get get get get get
put (a,b,c,d,e) = put a *> put b *> put c *> put d *> put e
get = (,,,,) <$> get <*> get <*> get <*> get <*> get
--
-- and now just recurse:
......@@ -390,7 +390,7 @@ instance (Binary a, Binary b, Binary c, Binary d, Binary e,
-- Container types
instance Binary a => Binary [a] where
put l = put (length l) >> traverse_ put l
put l = put (length l) *> traverse_ put l
get = do n <- get :: Get Int
getMany n
......@@ -407,21 +407,21 @@ getMany n = go [] n
instance (Binary a) => Binary (Maybe a) where
put Nothing = putWord8 0
put (Just x) = putWord8 1 >> put x
put (Just x) = putWord8 1 *> put x
get = do
w <- getWord8
case w of
0 -> return Nothing
_ -> liftM Just get
_ -> fmap Just get
instance (Binary a, Binary b) => Binary (Either a b) where
put (Left a) = putWord8 0 >> put a
put (Right b) = putWord8 1 >> put b
put (Left a) = putWord8 0 *> put a
put (Right b) = putWord8 1 *> put b
get = do
w <- getWord8
case w of
0 -> liftM Left get
_ -> liftM Right get
0 -> fmap Left get
_ -> fmap Right get
------------------------------------------------------------------------
-- ByteStrings (have specially efficient instances)
......@@ -445,26 +445,26 @@ instance Binary ByteString where
-- Maps and Sets
instance (Binary a) => Binary (Set.Set a) where
put s = put (Set.size s) >> traverse_ put (Set.toAscList s)
get = liftM Set.fromDistinctAscList get
put s = put (Set.size s) *> traverse_ put (Set.toAscList s)
get = fmap Set.fromDistinctAscList get
instance (Binary k, Binary e) => Binary (Map.Map k e) where
put m = put (Map.size m) >> traverse_ put (Map.toAscList m)
get = liftM Map.fromDistinctAscList get
put m = put (Map.size m) *> traverse_ put (Map.toAscList m)
get = fmap Map.fromDistinctAscList get
instance Binary IntSet.IntSet where
put s = put (IntSet.size s) >> traverse_ put (IntSet.toAscList s)
get = liftM IntSet.fromDistinctAscList get
put s = put (IntSet.size s) *> traverse_ put (IntSet.toAscList s)
get = fmap IntSet.fromDistinctAscList get
instance (Binary e) => Binary (IntMap.IntMap e) where
put m = put (IntMap.size m) >> traverse_ put (IntMap.toAscList m)
get = liftM IntMap.fromDistinctAscList get
put m = put (IntMap.size m) *> traverse_ put (IntMap.toAscList m)
get = fmap IntMap.fromDistinctAscList get
------------------------------------------------------------------------
-- Queues and Sequences
instance (Binary e) => Binary (Seq.Seq e) where
put s = put (Seq.length s) >> Fold.traverse_ put s
put s = put (Seq.length s) *> Fold.traverse_ put s
get = do n <- get :: Get Int
rep Seq.empty n get
where rep xs 0 _ = return $! xs
......@@ -477,18 +477,18 @@ instance (Binary e) => Binary (Seq.Seq e) where
instance Binary Double where
put d = put (decodeFloat d)
get = liftM2 encodeFloat get get
get = encodeFloat <$> get <*> get
instance Binary Float where
put f = put (decodeFloat f)
get = liftM2 encodeFloat get get
get = encodeFloat <$> get <*> get
------------------------------------------------------------------------
-- Trees
instance (Binary e) => Binary (T.Tree e) where
put (T.Node r s) = put r >> put s
get = liftM2 T.Node get get
put (T.Node r s) = put r *> put s
get = T.Node <$> get <*> get
------------------------------------------------------------------------
-- Arrays
......
......@@ -33,11 +33,10 @@ import Foreign
( allocaBytes )
#ifndef mingw32_HOST_OS
import System.Posix.Internals (withFilePath)
import System.Posix.Types
( FileMode )
import System.Posix.Internals
( c_chmod )
( c_chmod, withFilePath )
import Foreign.C
( throwErrnoPathIfMinus1_ )
#endif /* mingw32_HOST_OS */
......
......@@ -788,9 +788,9 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
ghcOptProfilingMode = toFlag True,
ghcOptExtra = toNubListR (ghcjsProfOptions libBi)
}
ghcArgs = if withVanillaLib lbi then vanillaArgs
else if withProfLib lbi then profArgs
else error "libAbiHash: Can't find an enabled library way"
ghcArgs | withVanillaLib lbi = vanillaArgs
| withProfLib lbi = profArgs
| otherwise = error "libAbiHash: Can't find an enabled library way"
--
(ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi)
hash <- getProgramInvocationOutput verbosity
......
......@@ -56,8 +56,9 @@ import Distribution.Compiler
import Distribution.Text
import System.Directory (getAppUserDataDirectory)
import System.FilePath ((</>), isPathSeparator, pathSeparator)
import System.FilePath (dropDrive)
import System.FilePath
( (</>), isPathSeparator
, pathSeparator, dropDrive )
#ifdef mingw32_HOST_OS
import qualified Prelude
......
......@@ -790,7 +790,7 @@ configureOptions showOrParseArgs =
configConstraints (\v flags -> flags { configConstraints = v})
(reqArg "DEPENDENCY"
(readP_to_E (const "dependency expected") ((\x -> [x]) `fmap` parse))
(map (\x -> display x)))
(map display))
,option "" ["dependency"]
"A list of exact dependencies. E.g., --dependency=\"void=void-0.5.8-177d5cdf20962d0581fe2e4932a6c309\""
......
......@@ -335,7 +335,7 @@ filterAutogenModules pkg_descr0 = mapLib filterAutogenModuleLib $
pathsModule = autogenPathsModuleName pkg_descr0
filterFunction bi = \mn ->
mn /= pathsModule
&& not (elem mn (autogenModules bi))
&& not (mn `elem` autogenModules bi)
-- | Prepare a directory tree of source files for a snapshot version.
-- It is expected that the appropriate snapshot version has already been set
......
......@@ -40,7 +40,7 @@ import Distribution.Text
import System.Directory
( createDirectoryIfMissing, doesFileExist, getDirectoryContents
, removeFile )
import System.Exit ( ExitCode(..), exitFailure, exitWith )
import System.Exit ( exitFailure, exitSuccess )
import System.FilePath ( (</>) )
-- |Perform the \"@.\/setup test@\" action.
......@@ -80,9 +80,9 @@ test args pkg_descr lbi flags = do
, logFile = ""
}
when (not $ PD.hasTests pkg_descr) $ do
unless (PD.hasTests pkg_descr) $ do
notice verbosity "Package has no test suites."
exitWith ExitSuccess
exitSuccess
when (PD.hasTests pkg_descr && null enabledTests) $
die' verbosity $
......@@ -91,7 +91,7 @@ test args pkg_descr lbi flags = do
testsToRun <- case testNames of
[] -> return $ zip enabledTests $ repeat Nothing
names -> flip traverse names $ \tName ->
names -> for names $ \tName ->
let testMap = zip enabledNames enabledTests
enabledNames = map (PD.testName . fst) enabledTests
allNames = map PD.testName pkgTests
......
......@@ -33,7 +33,7 @@ import System.Directory
, getCurrentDirectory, removeDirectoryRecursive )
import System.Exit ( ExitCode(..) )
import System.FilePath ( (</>), (<.>) )
import System.IO ( hGetContents, hPutStr, stdout, stderr )
import System.IO ( hGetContents, stdout, stderr )
runTest :: PD.PackageDescription
-> LBI.LocalBuildInfo
......@@ -78,7 +78,7 @@ runTest pkg_descr lbi clbi flags suite = do
void $ forkIO $ length logText `seq` return ()
-- '--show-details=streaming': print the log output in another thread
when (details == Streaming) $ void $ forkIO $ hPutStr stdout logText
when (details == Streaming) $ void $ forkIO $ putStr logText
return (wOut, wOut, logText)
......
......@@ -38,7 +38,7 @@ import System.Directory
( createDirectoryIfMissing, doesDirectoryExist, doesFileExist
, getCurrentDirectory, removeDirectoryRecursive, removeFile
, setCurrentDirectory, makeAbsolute )
import System.Exit ( ExitCode(..), exitWith )
import System.Exit ( exitSuccess, exitWith, ExitCode(..) )
import System.FilePath ( (</>), (<.>) )
import System.IO ( hClose, hGetContents, hPutStr )
import System.Process (StdStream(..), waitForProcess)
......@@ -271,4 +271,4 @@ stubWriteLog f n logs = do
writeFile (logFile testLog) $ show testLog
when (suiteError logs) $ exitWith $ ExitFailure 2
when (suiteFailed logs) $ exitWith $ ExitFailure 1
exitWith ExitSuccess
exitSuccess
......@@ -203,7 +203,7 @@ import qualified Data.ByteString.Lazy.Char8 as BS.Char8
import System.Directory
( Permissions(executable), getDirectoryContents, getPermissions
, doesDirectoryExist, doesFileExist, removeFile, findExecutable
, getModificationTime )
, getModificationTime, createDirectory, removeDirectoryRecursive )
import System.Environment
( getProgName )
import System.Exit
......@@ -213,8 +213,6 @@ import System.FilePath
, getSearchPath, joinPath, takeDirectory, splitFileName
, splitExtension, splitExtensions, splitDirectories
, searchPathSeparator )
import System.Directory
( createDirectory, removeDirectoryRecursive )
import System.IO
( Handle, hSetBinaryMode, hGetContents, stderr, stdout, hPutStr, hFlush
, hClose, hSetBuffering, BufferMode(..) )
......@@ -1168,8 +1166,7 @@ createDirectoryIfMissingVerbose verbosity create_parents path0
-- that the directory did indeed exist.
| isAlreadyExistsError e -> (do
isDir <- doesDirectoryExist dir
if isDir then return ()
else throwIO e
unless isDir $ throwIO e
) `catchIO` ((\_ -> return ()) :: IOException -> IO ())
| otherwise -> throwIO e
......
......@@ -46,7 +46,7 @@ data ModuleRenaming
-- to 'ModuleName'. For efficiency, you should partially apply it
-- with 'ModuleRenaming' and then reuse it.
interpModuleRenaming :: ModuleRenaming -> ModuleName -> Maybe ModuleName
interpModuleRenaming DefaultRenaming = \m -> Just m
interpModuleRenaming DefaultRenaming = Just
interpModuleRenaming (ModuleRenaming rns) =
let m = Map.fromList rns
in \k -> Map.lookup k m
......
......@@ -81,13 +81,12 @@ import qualified Data.Set as Set
import qualified Data.ByteString as SBS
import System.Directory
( removeFile )
( removeFile, renameFile )
import System.FilePath
( (<.>), splitFileName )
import System.Directory
( renameFile )
import System.IO
( openFile, openBinaryFile, openBinaryTempFileWithDefaultPermissions
( openBinaryFile, withFile, withBinaryFile
, openBinaryTempFileWithDefaultPermissions
, IOMode(ReadMode), hGetContents, hClose )
import qualified Control.Exception as Exception
......@@ -129,8 +128,8 @@ wrapLine width = wrap 0 []
--
withFileContents :: FilePath -> (String -> NoCallStackIO a) -> NoCallStackIO a
withFileContents name action =
Exception.bracket (openFile name ReadMode) hClose
(\hnd -> hGetContents hnd >>= action)
withFile name ReadMode
(\hnd -> hGetContents hnd >>= action)
-- | Writes a file atomically.
--
......@@ -254,9 +253,7 @@ readUTF8File f = fmap (ignoreBOM . fromUTF8)
--
withUTF8FileContents :: FilePath -> (String -> IO a) -> IO a
withUTF8FileContents name action =
Exception.bracket
(openBinaryFile name ReadMode)
hClose
withBinaryFile name ReadMode
(\hnd -> hGetContents hnd >>= action . ignoreBOM . fromUTF8)
-- | Writes a Unicode String as a UTF8 encoded text file.
......
......@@ -86,8 +86,6 @@ skipPredicates :: [FilePath -> Bool]
skipPredicates =
[ isSuffixOf "register.sh"
]
where
-- eq = (==)
main :: IO ()
main = do
......
......@@ -3,7 +3,7 @@ module Main where
import Control.Applicative
(Applicative (..), (<$>), Const (..))
import Control.Monad (when)
import Control.Monad (when, unless)
import Data.Foldable
(foldMap, for_, traverse_)
import Data.List (isPrefixOf, isSuffixOf)
......@@ -127,9 +127,7 @@ compareTest pfx fpath bsl
else parsec0
-- Compare two parse results
if readp0 == parsec1
then return ()
else do
unless (readp0 == parsec1) $ do
#if HAS_STRUCT_DIFF
prettyResultIO $ diff readp parsec
#else
......@@ -152,14 +150,14 @@ compareTest pfx fpath bsl
return (readpWarnCount, parsecWarnCount, parsecWarnMap)
parseReadpTest :: FilePath -> BSL.ByteString -> IO ()
parseReadpTest fpath bsl = when (not $ any ($ fpath) problematicFiles) $ do
parseReadpTest fpath bsl = unless (any ($ fpath) problematicFiles) $ do
let str = fromUTF8LBS bsl
case ReadP.parseGenericPackageDescription str of
ReadP.ParseOk _ _ -> return ()
ReadP.ParseFailed err -> print err >> exitFailure
parseParsecTest :: FilePath -> BSL.ByteString -> IO ()
parseParsecTest fpath bsl = when (not $ any ($ fpath) problematicFiles) $ do
parseParsecTest fpath bsl = unless (any ($ fpath) problematicFiles) $ do
let bs = BSL.toStrict bsl
let (_warnings, errors, parsec) = Parsec.runParseResult $ Parsec.parseGenericPackageDescription bs
case parsec of
......
......@@ -235,7 +235,7 @@ prop_nonNull = (/= nullVersion)
prop_anyVersion :: Version -> Bool
prop_anyVersion v' =
withinRange v' anyVersion == True
withinRange v' anyVersion
prop_noVersion :: Version -> Bool
prop_noVersion v' =
......
......@@ -51,7 +51,7 @@ import Distribution.Simple.Utils
import Data.List
( groupBy, sortBy )
import Data.Maybe
( catMaybes )
( mapMaybe )
import System.FilePath
( (</>), takeDirectory )
import System.Directory
......@@ -126,10 +126,9 @@ fromInstallPlan :: Platform -> CompilerId
-> BuildOutcomes
-> [(BuildReport, Maybe Repo)]
fromInstallPlan platform comp plan buildOutcomes =
catMaybes
. map (\pkg -> fromPlanPackage
platform comp pkg
(InstallPlan.lookupBuildOutcome pkg buildOutcomes))
mapMaybe (\pkg -> fromPlanPackage
platform comp pkg
(InstallPlan.lookupBuildOutcome pkg buildOutcomes))
. InstallPlan.toList
$ plan
......
......@@ -87,7 +87,7 @@ check verbosity = do
when (null packageChecks) $
putStrLn "No errors or warnings could be found in the package."
return (null . filter isCheckError $ packageChecks)
return (not . any isCheckError $ packageChecks)
where
printCheckMessages = mapM_ (putStrLn . format . explanation)
......
......@@ -35,7 +35,7 @@ import Distribution.Client.Setup
import Distribution.Simple.Setup
( HaddockFlags, fromFlagOrDefault )
import Distribution.Simple.Utils
( die', notice )
( die', notice, wrapText )
import Distribution.Verbosity
( normal )
......@@ -46,8 +46,6 @@ import Control.Monad (unless)
import Distribution.Simple.Command
( CommandUI(..), usageAlternatives )
import Distribution.Simple.Utils
( wrapText )
import qualified Distribution.Client.Setup as Client
......
......@@ -12,9 +12,8 @@ import System.Posix.Types
import System.Posix.Internals
( c_chmod )
import Foreign.C
( withCString )
import Foreign.C
( throwErrnoPathIfMinus1_ )
( withCString
, throwErrnoPathIfMinus1_ )
#else
import System.Win32.File (setFileAttributes, fILE_ATTRIBUTE_HIDDEN)
#endif /* mingw32_HOST_OS */
......
......@@ -10,7 +10,7 @@ module Distribution.Client.Compat.Semaphore
import Control.Concurrent.STM (TVar, atomically, newTVar, readTVar, retry,
writeTVar)
import Control.Exception (mask_, onException)
import Control.Monad (join, when)
import Control.Monad (join, unless)
import Data.Typeable (Typeable)
-- | 'QSem' is a quantity semaphore in which the resource is aqcuired
......@@ -57,7 +57,7 @@ waitQSem s@(QSem q _b1 b2) =
flip onException (wake s t) $
atomically $ do