Minor clean up, taking hlint suggestions
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 29 Oct 2017 21:35:57 +0000 (21:35 +0000)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 29 Oct 2017 21:35:57 +0000 (21:35 +0000)
24 files changed:
src/Hadrian/Builder.hs
src/Hadrian/Haskell/Cabal.hs
src/Hadrian/Oracles/Path.hs
src/Hadrian/Oracles/TextFile.hs
src/Oracles/ModuleFiles.hs
src/Oracles/PackageData.hs
src/Oracles/Setting.hs
src/Rules/Clean.hs
src/Rules/Compile.hs
src/Rules/Dependencies.hs
src/Rules/Install.hs
src/Rules/Libffi.hs
src/Rules/Selftest.hs
src/Settings/Builders/Cc.hs
src/Settings/Builders/Common.hs
src/Settings/Builders/Make.hs
src/Settings/Builders/Tar.hs
src/Settings/Flavours/Development.hs
src/Settings/Flavours/Performance.hs
src/Settings/Flavours/Profiled.hs
src/Settings/Flavours/Quick.hs
src/Settings/Flavours/QuickCross.hs
src/Settings/Flavours/Quickest.hs
src/Settings/Packages/Compiler.hs

index 6cc53ef..4de658e 100644 (file)
@@ -95,13 +95,12 @@ buildWith rs opts target args = do
     putInfo target
     verbose <- interpret target verboseCommand
     let quietlyUnlessVerbose = if verbose then withVerbosity Loud else quietly
-    quietlyUnlessVerbose $ do
-        runBuilderWith (builder target) $ BuildInfo
-            { buildArgs      = argList
-            , buildInputs    = inputs target
-            , buildOutputs   = outputs target
-            , buildOptions   = opts
-            , buildResources = rs }
+    quietlyUnlessVerbose $ runBuilderWith (builder target) $
+        BuildInfo { buildArgs      = argList
+                  , buildInputs    = inputs target
+                  , buildOutputs   = outputs target
+                  , buildOptions   = opts
+                  , buildResources = rs }
 
 -- | Print out information about the command being executed.
 putInfo :: Show b => Target c b -> Action ()
index bc70efb..ab5f334 100644 (file)
@@ -28,7 +28,7 @@ pkgVersion cabalFile = version <$> readCabalFile cabalFile
 pkgIdentifier :: FilePath -> Action String
 pkgIdentifier cabalFile = do
     cabal <- readCabalFile cabalFile
-    return $ if (null $ version cabal)
+    return $ if null (version cabal)
         then name cabal
         else name cabal ++ "-" ++ version cabal
 
index 4f6406c..ceccc23 100644 (file)
@@ -29,7 +29,7 @@ bashPath = lookupInPath "bash"
 -- * "/c/" => "C:/"
 -- * "/usr/bin/tar.exe" => "C:/msys/usr/bin/tar.exe"
 fixAbsolutePathOnWindows :: FilePath -> Action FilePath
-fixAbsolutePathOnWindows path = do
+fixAbsolutePathOnWindows path =
     if isWindows
     then do
         let (dir, file) = splitFileName path
@@ -57,6 +57,6 @@ pathOracle = do
 
     void $ addOracle $ \(LookupInPath name) -> do
         let unpack = fromMaybe . error $ "Cannot find executable " ++ quote name
-        path <- unifyPath <$> unpack <$> liftIO (findExecutable name)
+        path <- unifyPath . unpack <$> liftIO (findExecutable name)
         putLoud $ "| Executable found: " ++ name ++ " => " ++ path
         return path
index c2ecb4c..6d4f048 100644 (file)
@@ -58,7 +58,7 @@ lookupValueOrEmpty file key = fromMaybe "" <$> lookupValue file key
 
 -- | Like 'lookupValue' but raises an error if the key is not found.
 lookupValueOrError :: FilePath -> String -> Action String
-lookupValueOrError file key = (fromMaybe $ error msg) <$> lookupValue file key
+lookupValueOrError file key = fromMaybe (error msg) <$> lookupValue file key
   where
     msg = "Key " ++ quote key ++ " not found in file " ++ quote file
 
@@ -73,7 +73,7 @@ lookupValuesOrEmpty file key = fromMaybe [] <$> lookupValues file key
 
 -- | Like 'lookupValues' but raises an error if the key is not found.
 lookupValuesOrError :: FilePath -> String -> Action [String]
-lookupValuesOrError file key = (fromMaybe $ error msg) <$> lookupValues file key
+lookupValuesOrError file key = fromMaybe (error msg) <$> lookupValues file key
   where
     msg = "Key " ++ quote key ++ " not found in file " ++ quote file
 
index 9a54a2a..c7175db 100644 (file)
@@ -135,8 +135,8 @@ moduleFilesOracle = void $ do
             forM todo $ \(mDir, mFiles) -> do
                 let fullDir = unifyPath $ dir -/- mDir
                 files <- getDirectoryFiles fullDir moduleFilePatterns
-                let cmp fe f = compare (dropExtension fe) f
-                    found    = intersectOrd cmp files mFiles
+                let cmp f = compare (dropExtension f)
+                    found = intersectOrd cmp files mFiles
                 return (map (fullDir -/-) found, mDir)
         let pairs = sort [ (encodeModule d f, f) | (fs, d) <- result, f <- fs ]
             multi = [ (m, f1, f2) | (m, f1):(n, f2):_ <- tails pairs, m == n ]
@@ -151,7 +151,7 @@ moduleFilesOracle = void $ do
     generators <- newCache $ \(stage, package) -> do
         let context = vanillaContext stage package
         files <- contextFiles context
-        list  <- sequence [ (,src) <$> (generatedFile context modName)
+        list  <- sequence [ (,src) <$> generatedFile context modName
                           | (modName, Just src) <- files
                           , takeExtension src `notElem` haskellExtensions ]
         return $ Map.fromList list
index 1fecb8c..cdfe9bf 100644 (file)
@@ -6,7 +6,7 @@ import Hadrian.Oracles.TextFile
 
 import Base
 
-data PackageData = BuildGhciLib FilePath
+newtype PackageData = BuildGhciLib FilePath
 
 data PackageDataList = AsmSrcs        FilePath
                      | CcArgs         FilePath
index 5f148d4..aa49011 100644 (file)
@@ -141,7 +141,7 @@ getSettingList :: SettingList -> Args c b
 getSettingList = expr . settingList
 
 matchSetting :: Setting -> [String] -> Action Bool
-matchSetting key values = fmap (`elem` values) $ setting key
+matchSetting key values = (`elem` values) <$> setting key
 
 anyTargetPlatform :: [String] -> Action Bool
 anyTargetPlatform = matchSetting TargetPlatformFull
@@ -226,7 +226,7 @@ installGhcLibDir = do
 -- We also need to respect the system's dynamic extension, e.g. .dll or .so.
 libsuf :: Way -> Action String
 libsuf way =
-    if (not . wayUnit Dynamic $ way)
+    if not (wayUnit Dynamic way)
     then return $ waySuffix way ++ ".a" -- e.g., _p.a
     else do
         extension <- setting DynamicExtension  -- e.g., .dll or .so
index 03d2d73..d11cbf5 100644 (file)
@@ -5,11 +5,11 @@ import Base
 clean :: Action ()
 clean = do
     cleanSourceTree
-    putBuild "| Remove Hadrian files..."
+    putBuild "| Remove Hadrian files..."
     path <- buildRoot
     removeDirectory $ path -/- generatedDir
     removeFilesAfter path ["//*"]
-    putSuccess "| Done. "
+    putSuccess "| Done. "
 
 cleanSourceTree :: Action ()
 cleanSourceTree = do
index a4b1278..8534f1a 100644 (file)
@@ -18,7 +18,7 @@ compilePackage rs context@Context {..} = do
             need [src]
             needDependencies context src $ obj <.> "d"
             buildWithResources rs $ target context (compiler stage) [src] [obj]
-        compileHs = \[obj, _hi] -> do
+        compileHs [obj, _hi] = do
             path <- buildPath context
             (src, deps) <- lookupDependencies (path -/- ".dependencies") obj
             need $ src : deps
index 4ac21a6..f27ef0d 100644 (file)
@@ -18,7 +18,7 @@ buildPackageDependencies rs context@Context {..} =
         need srcs
         orderOnly =<< interpretInContext context generatedDependencies
         let mk = deps <.> "mk"
-        if srcs == []
+        if null srcs
         then writeFileChanged mk ""
         else buildWithResources rs $
             target context (Ghc FindHsDependencies stage) srcs [mk]
index a34536a..bcdbf33 100644 (file)
@@ -36,7 +36,7 @@ The resulting tree structure is organized under @destDir ++ prefix@ as follows:
 XXX (izgzhen): Do we need @INSTALL_OPTS@ in the make scripts?
 -}
 installRules :: Rules ()
-installRules = do
+installRules =
     "install" ~> do
         installIncludes
         installPackageConf
@@ -74,12 +74,12 @@ installLibExecs = do
     libExecDir <- getLibExecDir
     destDir <- getDestDir
     installDirectory (destDir ++ libExecDir)
-    forM_ installBinPkgs $ \pkg -> do
+    forM_ installBinPkgs $ \pkg ->
         withInstallStage pkg $ \stage -> do
             context <- programContext stage pkg
             let bin = inplaceLibBinPath -/- programName context <.> exe
             installProgram bin (destDir ++ libExecDir)
-            when (pkg == ghc) $ do
+            when (pkg == ghc) $
                 moveFile (destDir ++ libExecDir -/- programName context <.> exe)
                          (destDir ++ libExecDir -/- "ghc" <.> exe)
 
@@ -165,8 +165,8 @@ installPackages = do
     let rtsDir = destDir ++ ghcLibDir -/- "rts"
     installDirectory rtsDir
     ways    <- interpretInContext (vanillaContext Stage1 rts) getRtsWays
-    rtsLibs <- mapM pkgLibraryFile $ map (Context Stage1 rts) ways
-    ffiLibs <- sequence $ map rtsLibffiLibrary ways
+    rtsLibs <- mapM (pkgLibraryFile . Context Stage1 rts) ways
+    ffiLibs <- mapM rtsLibffiLibrary ways
 
     -- TODO: Add dynamic libraries.
     forM_ (rtsLibs ++ ffiLibs) $ \lib -> installData [lib] rtsDir
@@ -185,7 +185,7 @@ installPackages = do
     -- TODO: Figure out what is the root cause of the missing ghc-gmp.h error.
     copyFile (pkgPath integerGmp -/- "gmp/ghc-gmp.h") (pkgPath integerGmp -/- "ghc-gmp.h")
 
-    forM_ installLibPkgs $ \pkg -> do
+    forM_ installLibPkgs $ \pkg ->
         case pkgCabalFile pkg of
             Nothing -> error $ "Non-Haskell project in installLibPkgs" ++ show pkg
             Just cabalFile -> withInstallStage pkg $ \stage -> do
@@ -222,7 +222,7 @@ installPackages = do
                                            , pref
                                            , ghclibDir
                                            , docDir -/- "html/libraries"
-                                           , intercalate " " (map show ways) ]
+                                           , unwords (map show ways) ]
 
     -- Register packages
     let installedGhcPkgReal = destDir ++ binDir -/- "ghc-pkg" <.> exe
@@ -232,7 +232,7 @@ installPackages = do
                                    , installedPackageConf, "update"
                                    , confPath ]
 
-    forM_ installLibPkgs $ \pkg -> do
+    forM_ installLibPkgs $ \pkg ->
         withInstallStage pkg $ \stage -> do
             let context = vanillaContext stage pkg
             top <- topDirectory
@@ -280,13 +280,12 @@ installCommonLibs = do
 installLibsTo :: [FilePath] -> FilePath -> Action ()
 installLibsTo libs dir = do
     installDirectory dir
-    forM_ libs $ \lib -> do
-       case takeExtension lib of
-           ".a" -> do
-               let out = dir -/- takeFileName lib
-               installData [out] dir
-               runBuilder Ranlib [out] [out] [out]
-           _ -> installData [lib] dir
+    forM_ libs $ \lib -> case takeExtension lib of
+        ".a" -> do
+            let out = dir -/- takeFileName lib
+            installData [out] dir
+            runBuilder Ranlib [out] [out] [out]
+        _ -> installData [lib] dir
 
 -- ref: includes/ghc.mk
 -- | All header files are in includes/{one of these subdirectories}.
@@ -333,5 +332,5 @@ installDocs = do
     installData ["docs/index.html"] htmlDocDir
 
     forM_ ["Haddock", "libraries", "users_guide"] $ \dirname -> do
-        let dir = (root -/- "docs/html" -/- dirname)
+        let dir = root -/- "docs/html" -/- dirname
         whenM (doesDirectoryExist dir) $ copyDirectory dir htmlDocDir
index 9641b66..73f481d 100644 (file)
@@ -59,7 +59,7 @@ libffiRules = do
             putBuild "| System supplied FFI library will be used"
             forM_ ["ffi.h", "ffitarget.h"] $ \file ->
                 copyFile (ffiIncludeDir -/- file) (rtsPath -/- file)
-            putSuccess "| Successfully copied system FFI library header files"
+            putSuccess "| Successfully copied system FFI library header files"
         else do
             libffiPath <- libffiBuildPath
             build $ target libffiContext (Make libffiPath) [] []
@@ -73,7 +73,7 @@ libffiRules = do
                 rtsLib <- rtsLibffiLibrary way
                 copyFileUntracked (libffiPath -/- libffiLibrary) rtsLib
 
-            putSuccess "| Successfully built custom library 'libffi'"
+            putSuccess "| Successfully built custom library 'libffi'"
 
     "//libffi/Makefile.in" %> \mkIn -> do
         libffiPath <- libffiBuildPath
index 94c1ecc..d1ffaac 100644 (file)
@@ -31,16 +31,16 @@ selftestRules =
 
 testBuilder :: Action ()
 testBuilder = do
-    putBuild "==== trackArgument"
+    putBuild "==== trackArgument"
     let make = target undefined (Make undefined) undefined undefined
     test $ forAll (elements ["-j", "MAKEFLAGS=-j", "THREADS="])
          $ \prefix (NonNegative n) ->
-            trackArgument make prefix == False &&
-            trackArgument make ("-j" ++ show (n :: Int)) == False
+            not (trackArgument make prefix) &&
+            not (trackArgument make ("-j" ++ show (n :: Int)))
 
 testChunksOfSize :: Action ()
 testChunksOfSize = do
-    putBuild "==== chunksOfSize"
+    putBuild "==== chunksOfSize"
     test $ chunksOfSize 3 [  "a", "b", "c" ,  "defg" ,  "hi" ,  "jk"  ]
                        == [ ["a", "b", "c"], ["defg"], ["hi"], ["jk"] ]
     test $ \n xs ->
@@ -49,12 +49,12 @@ testChunksOfSize = do
 
 testLookupAll :: Action ()
 testLookupAll = do
-    putBuild "==== lookupAll"
+    putBuild "==== lookupAll"
     test $ lookupAll ["b"    , "c"            ] [("a", 1), ("c", 3), ("d", 4)]
                   == [Nothing, Just (3 :: Int)]
     test $ forAll dicts $ \dict -> forAll extras $ \extra ->
         let items = sort $ map fst dict ++ extra
-        in lookupAll items (sort dict) == map (flip lookup dict) items
+        in lookupAll items (sort dict) == map (`lookup` dict) items
   where
     dicts :: Gen [(Int, Int)]
     dicts = nubBy (\x y -> fst x == fst y) <$> vector 20
@@ -63,7 +63,7 @@ testLookupAll = do
 
 testModuleName :: Action ()
 testModuleName = do
-    putBuild "==== Encode/decode module name"
+    putBuild "==== Encode/decode module name"
     test $ encodeModule "Data/Functor" "Identity.hs" == "Data.Functor.Identity"
     test $ encodeModule "" "Prelude"                 == "Prelude"
 
@@ -76,9 +76,9 @@ testModuleName = do
 
 testPackages :: Action ()
 testPackages = do
-    putBuild "==== Check system configuration"
+    putBuild "==== Check system configuration"
     win <- windowsHost -- This depends on the @boot@ and @configure@ scripts.
-    putBuild "==== Packages, interpretInContext, configuration flags"
+    putBuild "==== Packages, interpretInContext, configuration flags"
     forM_ [Stage0 ..] $ \stage -> do
         pkgs <- stagePackages stage
         when (win32 `elem` pkgs) . test $ win
@@ -87,6 +87,6 @@ testPackages = do
 
 testWay :: Action ()
 testWay = do
-    putBuild "==== Read Way, Show Way"
+    putBuild "==== Read Way, Show Way"
     test $ \(x :: Way) -> read (show x) == x
 
index 7dc4423..4dcb191 100644 (file)
@@ -4,25 +4,25 @@ import Settings.Builders.Common
 
 ccBuilderArgs :: Args
 ccBuilderArgs = do
-  way <- getWay
-  builder Cc ? mconcat
-    [ getPkgDataList CcArgs
-    , getStagedSettingList ConfCcArgs
-    , cIncludeArgs
+    way <- getWay
+    builder Cc ? mconcat
+        [ getPkgDataList CcArgs
+        , getStagedSettingList ConfCcArgs
+        , cIncludeArgs
 
-    , builder (Cc CompileC) ? mconcat
-        [ arg "-Werror"
-        , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ]
-        -- ref: mk/warning.mk:
-        --  SRC_CC_OPTS     += -Wall $(WERROR)
-        , arg "-c", arg =<< getInput
-        , arg "-o", arg =<< getOutput ]
+        , builder (Cc CompileC) ? mconcat
+            [ arg "-Werror"
+            , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ]
+            -- ref: mk/warning.mk:
+            --  SRC_CC_OPTS     += -Wall $(WERROR)
+            , arg "-c", arg =<< getInput
+            , arg "-o", arg =<< getOutput ]
 
-    , builder (Cc FindCDependencies) ? do
-        output <- getOutput
-        mconcat [ arg "-E"
-                , arg "-MM", arg "-MG"
-                , arg "-MF", arg output
-                , arg "-MT", arg $ dropExtension output -<.> "o"
-                , arg "-x", arg "c"
-                , arg =<< getInput ] ]
+        , builder (Cc FindCDependencies) ? do
+            output <- getOutput
+            mconcat [ arg "-E"
+                    , arg "-MM", arg "-MG"
+                    , arg "-MF", arg output
+                    , arg "-MT", arg $ dropExtension output -<.> "o"
+                    , arg "-x", arg "c"
+                    , arg =<< getInput ] ]
index e7af38b..5ca594e 100644 (file)
@@ -41,7 +41,7 @@ cArgs = mempty
 -- TODO: should be in a different file
 cWarnings :: Args
 cWarnings = do
-    let gccGe46 = notM (flag GccIsClang ||^ flag GccLt46)
+    let gccGe46 = notM (flag GccIsClang ||^ flag GccLt46)
     mconcat [ arg "-Wall"
             , flag GccIsClang ? arg "-Wno-unknown-pragmas"
             , gccGe46 ? notM windowsHost ? arg "-Werror=unused-but-set-variable"
index 5a89921..cc350df 100644 (file)
@@ -6,7 +6,7 @@ import Settings.Builders.Common
 
 makeBuilderArgs :: Args
 makeBuilderArgs = do
-    threads    <- shakeThreads <$> (expr getShakeOptions)
+    threads    <- shakeThreads <$> expr getShakeOptions
     gmpPath    <- expr gmpBuildPath
     libffiPath <- expr libffiBuildPath
     let t = show $ max 4 (threads - 2) -- Don't use all Shake's threads
index e1688eb..4fb7d97 100644 (file)
@@ -3,7 +3,7 @@ module Settings.Builders.Tar (tarBuilderArgs) where
 import Settings.Builders.Common
 
 tarBuilderArgs :: Args
-tarBuilderArgs = do
+tarBuilderArgs =
     mconcat [ builder (Tar Create) ? mconcat
                 [ arg "-c"
                 , output "//*.gz" ? arg "--gzip"
index 713e409..cab1a2c 100644 (file)
@@ -12,7 +12,7 @@ developmentFlavour ghcStage = defaultFlavour
 developmentArgs :: Stage -> Args
 developmentArgs ghcStage = do
     stage <- getStage
-    sourceArgs SourceArgs
+    sourceArgs SourceArgs
         { hsDefault  = pure ["-O", "-H64m"]
         , hsLibrary  = notStage0 ? arg "-dcore-lint"
         , hsCompiler = succ stage == ghcStage ? pure ["-O0", "-DDEBUG"]
index b04cabe..abf544d 100644 (file)
@@ -10,7 +10,7 @@ performanceFlavour = defaultFlavour
     , args = defaultBuilderArgs <> performanceArgs <> defaultPackageArgs }
 
 performanceArgs :: Args
-performanceArgs = sourceArgs SourceArgs
+performanceArgs = sourceArgs SourceArgs
     { hsDefault  = pure ["-O", "-H64m"]
     , hsLibrary  = notStage0 ? arg "-O2"
     , hsCompiler = mconcat [stage0 ? arg "-O", notStage0 ? arg "-O2"]
index a1b3d98..1b47544 100644 (file)
@@ -11,7 +11,7 @@ profiledFlavour = defaultFlavour
     , ghcProfiled = True }
 
 profiledArgs :: Args
-profiledArgs = sourceArgs SourceArgs
+profiledArgs = sourceArgs SourceArgs
     { hsDefault  = pure ["-O0", "-H64m"]
     , hsLibrary  = notStage0 ? arg "-O"
     , hsCompiler = arg "-O"
index 410d0c5..266d3e3 100644 (file)
@@ -14,7 +14,7 @@ quickFlavour = defaultFlavour
                     , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] }
 
 quickArgs :: Args
-quickArgs = sourceArgs SourceArgs
+quickArgs = sourceArgs SourceArgs
     { hsDefault  = pure ["-O0", "-H64m"]
     , hsLibrary  = notStage0 ? arg "-O"
     , hsCompiler =    stage0 ? arg "-O"
index 458d6ef..9debdbb 100644 (file)
@@ -14,7 +14,7 @@ quickCrossFlavour = defaultFlavour
                     , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] }
 
 quickCrossArgs :: Args
-quickCrossArgs = sourceArgs SourceArgs
+quickCrossArgs = sourceArgs SourceArgs
     { hsDefault  = pure ["-O0", "-H64m"]
     , hsLibrary  = notStage0 ? mconcat [ arg "-O", arg "-fllvm" ]
     , hsCompiler = stage0 ? arg "-O"
index 88922ec..6134df6 100644 (file)
@@ -12,7 +12,7 @@ quickestFlavour = defaultFlavour
     , rtsWays     = quickestRtsWays }
 
 quickestArgs :: Args
-quickestArgs = sourceArgs SourceArgs
+quickestArgs = sourceArgs SourceArgs
     { hsDefault  = pure ["-O0", "-H64m"]
     , hsLibrary  = mempty
     , hsCompiler = stage0 ? arg "-O"
index 1e12dbe..6b329d7 100644 (file)
@@ -6,7 +6,6 @@ import Flavour
 import Oracles.Flag
 import Oracles.Setting
 import Settings
-import Oracles.Flag (crossCompiling)
 
 compilerPackageArgs :: Args
 compilerPackageArgs = package compiler ? do