From 66e903214270581174f3137cddc44e1e4745a2e2 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Mon, 17 Dec 2012 15:45:38 +0200 Subject: [PATCH] Cleaned up warnings --- Stackage/Build.hs | 2 +- Stackage/Config.hs | 2 +- Stackage/InstallInfo.hs | 1 - Stackage/LoadDatabase.hs | 12 +++++------- Stackage/Test.hs | 19 ++++++++----------- Stackage/Util.hs | 2 ++ 6 files changed, 17 insertions(+), 21 deletions(-) diff --git a/Stackage/Build.hs b/Stackage/Build.hs index d1d5f737..e25d414a 100644 --- a/Stackage/Build.hs +++ b/Stackage/Build.hs @@ -10,7 +10,7 @@ import qualified Data.Map as Map import Data.Set (empty) import qualified Data.Set as Set import Distribution.Text (simpleParse) -import Distribution.Version (thisVersion, withinRange) +import Distribution.Version (withinRange) import Stackage.CheckPlan import Stackage.Config import Stackage.InstallInfo diff --git a/Stackage/Config.hs b/Stackage/Config.hs index a20d8d7c..8f589c5f 100644 --- a/Stackage/Config.hs +++ b/Stackage/Config.hs @@ -3,7 +3,7 @@ module Stackage.Config where import Control.Monad.Trans.Writer (execWriter, tell) import qualified Data.Map as Map -import Data.Set (fromList, singleton) +import Data.Set (fromList) import Distribution.Text (simpleParse) import Stackage.Types diff --git a/Stackage/InstallInfo.hs b/Stackage/InstallInfo.hs index 8d86a223..37240db0 100644 --- a/Stackage/InstallInfo.hs +++ b/Stackage/InstallInfo.hs @@ -10,7 +10,6 @@ import qualified Data.Set as Set import Data.Version (showVersion) import qualified Distribution.Text import Distribution.Version (withinRange, simplifyVersionRange) -import Stackage.Config import Stackage.HaskellPlatform import Stackage.LoadDatabase import Stackage.NarrowDatabase diff --git a/Stackage/LoadDatabase.hs b/Stackage/LoadDatabase.hs index 7d1a3f1e..e65f56af 100644 --- a/Stackage/LoadDatabase.hs +++ b/Stackage/LoadDatabase.hs @@ -12,7 +12,6 @@ import Distribution.Compiler (CompilerFlavor (GHC)) import Distribution.Package (Dependency (Dependency)) import Distribution.PackageDescription (Condition (..), ConfVar (..), - allBuildInfo, benchmarkBuildInfo, buildInfo, buildTools, condBenchmarks, @@ -25,7 +24,6 @@ import Distribution.PackageDescription (Condition (..), flagDefault, flagName, genPackageFlags, libBuildInfo, - packageDescription, testBuildInfo, FlagName (FlagName)) import Distribution.PackageDescription.Parse (ParseResult (ParseOk), @@ -73,12 +71,12 @@ loadPackageDB settings core deps = do _ -> case Tar.entryContent e of Tar.NormalFile bs _ -> do - let (deps', hasTests, buildTools) = parseDeps bs + let (deps', hasTests, buildTools') = parseDeps bs return $ mappend pdb $ PackageDB $ Map.singleton p PackageInfo { piVersion = v , piDeps = deps' , piHasTests = hasTests - , piBuildTools = buildTools + , piBuildTools = buildTools' } _ -> return pdb @@ -113,7 +111,7 @@ loadPackageDB settings core deps = do where checkCond' (Var (OS os)) = os == buildOS checkCond' (Var (Arch arch)) = arch == buildArch - checkCond' (Var (Flag flag)) = flag `elem` flags + checkCond' (Var (Flag flag)) = flag `elem` flags' checkCond' (Var (Impl compiler range)) = compiler == GHC && withinRange targetCompilerVersion range checkCond' (Lit b) = b @@ -121,5 +119,5 @@ loadPackageDB settings core deps = do checkCond' (COr c1 c2) = checkCond' c1 || checkCond' c2 checkCond' (CAnd c1 c2) = checkCond' c1 && checkCond' c2 - flags = map flagName (filter flagDefault $ genPackageFlags gpd) ++ - (map FlagName $ Set.toList $ Stackage.Types.flags settings) + flags' = map flagName (filter flagDefault $ genPackageFlags gpd) ++ + (map FlagName $ Set.toList $ Stackage.Types.flags settings) diff --git a/Stackage/Test.hs b/Stackage/Test.hs index f665126a..dc8d9e17 100644 --- a/Stackage/Test.hs +++ b/Stackage/Test.hs @@ -4,17 +4,14 @@ module Stackage.Test ) where import qualified Control.Concurrent as C -import Control.Exception (Exception, handle, throwIO, finally, SomeException) -import Control.Monad (foldM, unless, when, replicateM) +import Control.Exception (Exception, handle, throwIO, SomeException) +import Control.Monad (unless, when, replicateM) import qualified Data.Map as Map import qualified Data.Set as Set import Data.Typeable (Typeable) -import Stackage.Config import Stackage.Types import Stackage.Util -import System.Directory (canonicalizePath, createDirectory, - removeFile) -import System.Environment (getEnvironment) +import System.Directory (createDirectory, removeFile) import System.Exit (ExitCode (ExitSuccess)) import System.FilePath ((<.>), ()) import System.IO (IOMode (WriteMode, AppendMode), @@ -39,12 +36,12 @@ parFoldM :: Int -- ^ number of threads -> a -> [b] -> IO a -parFoldM threadCount f g a0 bs0 = do +parFoldM threadCount0 f g a0 bs0 = do ma <- C.newMVar a0 mbs <- C.newMVar bs0 signal <- C.newEmptyMVar - tids <- replicateM threadCount $ C.forkIO $ worker ma mbs signal - wait threadCount signal tids + tids <- replicateM threadCount0 $ C.forkIO $ worker ma mbs signal + wait threadCount0 signal tids C.takeMVar ma where worker ma mbs signal = @@ -90,8 +87,8 @@ runTestSuite settings testdir hasTestSuites (packageName, (version, Maintainer m $ ("HASKELL_PACKAGE_SANDBOX", packageDir settings) : env' - let runGen addGPP cmd args wdir handle = do - ph <- runProcess cmd args (Just wdir) (menv addGPP) Nothing (Just handle) (Just handle) + let runGen addGPP cmd args wdir handle' = do + ph <- runProcess cmd args (Just wdir) (menv addGPP) Nothing (Just handle') (Just handle') ec <- waitForProcess ph unless (ec == ExitSuccess) $ throwIO TestException diff --git a/Stackage/Util.hs b/Stackage/Util.hs index 5b8cfa2f..5ab4148a 100644 --- a/Stackage/Util.hs +++ b/Stackage/Util.hs @@ -71,12 +71,14 @@ getPackageVersion e = do defaultHasTestSuites :: Bool defaultHasTestSuites = True +packageDir, libDir, binDir, dataDir, docDir :: BuildSettings -> FilePath packageDir = ( "package-db") . sandboxRoot libDir = ( "lib") . sandboxRoot binDir = ( "bin") . sandboxRoot dataDir = ( "share") . sandboxRoot docDir x = sandboxRoot x "share" "doc" "$pkgid" +addCabalArgs :: BuildSettings -> [String] -> [String] addCabalArgs settings rest = "--package-db=clear" : "--package-db=global"