Commit 50781c23 authored by Francesco Gazzetta's avatar Francesco Gazzetta
Browse files

more specific or clear functions

mainly things highlighted by hlint
parent b2d52b14
......@@ -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
......@@ -1164,8 +1164,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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
b <- readTVar t
when (not b) retry
unless b retry
wake :: QSem -> TVar Bool -> IO ()
......
......@@ -1167,7 +1167,7 @@ userConfigDiff globalFlags = do
filterShow :: SavedConfig -> [(String, String)]
filterShow cfg = map keyValueSplit
. filter (\s -> not (null s) && any (== ':') s)
. filter (\s -> not (null s) && ':' `elem` s)
. map nonComment
. lines
$ showConfig cfg
......
......@@ -671,7 +671,7 @@ writeSetupFile flags = do
]
writeChangeLog :: InitFlags -> IO ()
writeChangeLog flags = when (any (== defaultChangeLog) $ maybe [] id (extraSrc flags)) $ do
writeChangeLog flags = when ((defaultChangeLog `elem`) $ fromMaybe [] (extraSrc flags)) $ do
message flags ("Generating "++ defaultChangeLog ++"...")
writeFileSafe flags defaultChangeLog changeLog
where
......
......@@ -638,8 +638,7 @@ packageStatus installedPkgIndex cpkg =
nub
. sort
. map mungedId
. catMaybes
. map (PackageIndex.lookupUnitId installedPkgIndex)
. mapMaybe (PackageIndex.lookupUnitId installedPkgIndex)
changed (InBoth pkgid pkgid') = pkgid /= pkgid'
changed _ = True
......@@ -754,7 +753,7 @@ reportPlanningFailure verbosity
(compilerId comp) pkgids
(configConfigurationsFlags configFlags)
when (not (null buildReports)) $
unless (null buildReports) $
info verbosity $
"Solver failure will be reported for "
++ intercalate "," (map display pkgids)
......@@ -1317,7 +1316,7 @@ installLocalTarballPackage verbosity pkgid
++ " to " ++ tmpDirPath ++ "..."
extractTarGzFile tmpDirPath relUnpackedPath tarballPath
exists <- doesFileExist descFilePath
when (not exists) $
unless exists $
die' verbosity $ "Package .cabal file not found: " ++ show descFilePath
maybeRenameDistDir absUnpackedPath
installPkg (Just absUnpackedPath)
......
......@@ -97,7 +97,7 @@ import Data.List
( foldl', intercalate )
import qualified Data.Foldable as Foldable (all)
import Data.Maybe
( fromMaybe, catMaybes )
( fromMaybe, mapMaybe )
import qualified Distribution.Compat.Graph as Graph
import Distribution.Compat.Graph (Graph, IsNode(..))
import Distribution.Compat.Binary (Binary(..))
......@@ -905,10 +905,9 @@ problems :: (IsUnit ipkg, IsUnit srcpkg)
problems graph =
[ PackageMissingDeps pkg
(catMaybes
(map
(mapMaybe
(fmap nodeKey . flip Graph.lookup graph)
missingDeps))
missingDeps)
| (pkg, missingDeps) <- Graph.broken graph ]
++ [ PackageCycle cycleGroup
......
......@@ -458,10 +458,8 @@ mergePackageInfo versionPref installedPkgs sourcePkgs selectedPkg showVer =
Installed.category installed,
flags = maybe [] Source.genPackageFlags sourceGeneric,
hasLib = isJust installed
|| fromMaybe False
(fmap (isJust . Source.condLibrary) sourceGeneric),
hasExe = fromMaybe False
(fmap (not . null . Source.condExecutables) sourceGeneric),
|| maybe False (isJust . Source.condLibrary) sourceGeneric,
hasExe = maybe False (not . null . Source.condExecutables) sourceGeneric,
executables = map fst (maybe [] Source.condExecutables sourceGeneric),
modules = combine (map Installed.exposedName . Installed.exposedModules)
installed
......
......@@ -25,6 +25,7 @@ import System.FilePath
import System.IO (IOMode(..), hClose, openFile)
import System.IO.Error (isDoesNotExistError)
import System.Process (showCommandForUser)
import Data.Maybe (isJust)
import Distribution.Compat.Environment
( lookupEnv, setEnv, unsetEnv )
......@@ -179,7 +180,7 @@ gcrootPath dist = dist </> "nix" </> "gcroots"
inNixShell :: IO Bool
inNixShell = maybe False (const True) <$> lookupEnv "CABAL_IN_NIX_SHELL"
inNixShell = isJust <$> lookupEnv "CABAL_IN_NIX_SHELL"
removeGCRoots :: Verbosity -> FilePath -> IO ()
......
......@@ -824,7 +824,7 @@ unpackPackageTarball verbosity tarball parentdir pkgid pkgTextOverride =
-- Sanity check
--
exists <- doesFileExist cabalFile
when (not exists) $
unless exists $
die' verbosity $ "Package .cabal file not found in the tarball: " ++ cabalFile
-- Overwrite the .cabal with the one from the index, when appropriate
......
......@@ -282,7 +282,7 @@ instance Ord k => Monoid (MapLast k v) where
mappend = (<>)
instance Ord k => Semigroup (MapLast k v) where
MapLast a <> MapLast b = MapLast (flip Map.union a b)
MapLast a <> MapLast b = MapLast $ Map.union b a
-- rather than Map.union which is the normal Map monoid instance
......
......@@ -2662,7 +2662,7 @@ pruneInstallPlanToDependencies pkgTargets installPlan =
Left $ CannotPruneDependencies
[ (pkg, missingDeps)
| (pkg, missingDepIds) <- brokenPackages
, let missingDeps = catMaybes (map lookupDep missingDepIds)
, let missingDeps = mapMaybe lookupDep missingDepIds
]
where
-- lookup in the original unpruned graph
......
......@@ -43,7 +43,7 @@ import Control.Exception ( evaluate, throw, Exception )
import Control.Monad ( liftM, unless )
import Control.Monad.Writer.Lazy (WriterT(..), runWriterT, tell)
import Data.List ( (\\), intersect, nub, find )
import Data.Maybe ( catMaybes, fromMaybe )
import Data.Maybe ( catMaybes )
import Data.Either (partitionEithers)
import System.Directory ( createDirectoryIfMissing,
doesDirectoryExist, doesFileExist,
......@@ -224,7 +224,7 @@ removeBuildTreeRefs verbosity indexPath l = do
then tell [pth] >> return False
else return True
convertWith dict pth = fromMaybe pth $ fmap fst $ find ((==pth) . snd) dict
convertWith dict pth = maybe pth fst $ find ((==pth) . snd) dict
-- | A build tree ref can become ignored if the user later adds a build tree ref
-- with the same package ID. We display ignored build tree refs when the user
......
......@@ -60,7 +60,7 @@ import Distribution.ParseUtils ( FieldDescr(..), ParseResult(..)
, syntaxError, warning )
import Distribution.System ( Platform )
import Distribution.Verbosity ( Verbosity, normal )
import Control.Monad ( foldM, liftM2, when, unless )
import Control.Monad ( foldM, liftM2, unless )
import Data.List ( partition, sortBy )
import Data.Maybe ( isJust )
import Data.Ord ( comparing )
......@@ -297,7 +297,7 @@ userPackageEnvironment verbosity pkgEnvDir globalConfigLocation = do
return mempty
where
processConfigParse path (ParseOk warns parseResult) = do
when (not $ null warns) $ warn verbosity $
unless (null warns) $ warn verbosity $
unlines (map (showPWarning path) warns)
return parseResult
processConfigParse path (ParseFailed err) = do
......@@ -322,7 +322,7 @@ handleParseResult verbosity path minp =
Nothing -> die' verbosity $
"The package environment file '" ++ path ++ "' doesn't exist"
Just (ParseOk warns parseResult) -> do
when (not $ null warns) $ warn verbosity $
unless (null warns) $ warn verbosity $
unlines (map (showPWarning path) warns)
return parseResult
Just (ParseFailed err) -> do
......
......@@ -785,8 +785,8 @@ getExternalSetupMethod verbosity options pkg bt = do
buildTypeString = show bt
cabalVersionString = "Cabal-" ++ (display cabalLibVersion)
compilerVersionString = display $
fromMaybe buildCompilerId
(fmap compilerId . useCompiler $ options')
maybe buildCompilerId compilerId
$ useCompiler options'
platformString = display platform
-- | Look up the setup executable in the cache; update the cache if the setup
......@@ -820,8 +820,7 @@ getExternalSetupMethod verbosity options pkg bt = do
cachedSetupProgFile
return cachedSetupProgFile
where
criticalSection' = fromMaybe id
(fmap criticalSection $ setupCacheLock options')
criticalSection' = maybe id criticalSection $ setupCacheLock options'
-- | If the Setup.hs is out of date wrt the executable then recompile it.
-- Currently this is GHC/GHCJS only. It should really be generalised.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment