Remove warnings

This commit is contained in:
Michael Snoyman 2013-01-28 11:49:06 +02:00
parent c46a308724
commit 1bc90402b2
6 changed files with 9 additions and 90 deletions

View File

@ -4,31 +4,17 @@ module Stackage.Build
, BuildSettings (..) , BuildSettings (..)
) where ) where
import Control.Exception (assert) import Control.Monad (unless)
import Control.Monad (unless, when)
import qualified Data.Map as Map
import Data.Maybe (mapMaybe)
import Data.Set (empty)
import qualified Data.Set as Set
import Distribution.Text (simpleParse)
import Distribution.Version (withinRange)
import Prelude hiding (pi) import Prelude hiding (pi)
import Stackage.CheckPlan
import Stackage.Config import Stackage.Config
import Stackage.InstallInfo import Stackage.InstallInfo
import Stackage.Tarballs
import Stackage.Test
import Stackage.Types import Stackage.Types
import Stackage.Util import Stackage.Util
import System.Directory (canonicalizePath,
createDirectoryIfMissing,
doesDirectoryExist)
import System.Exit (ExitCode (ExitSuccess), exitWith) import System.Exit (ExitCode (ExitSuccess), exitWith)
import System.IO (IOMode (WriteMode), hPutStrLn, import System.IO (IOMode (WriteMode), hPutStrLn,
withBinaryFile) withBinaryFile)
import System.Process (rawSystem, readProcess, runProcess, import System.Process (rawSystem, runProcess,
waitForProcess) waitForProcess)
import Stackage.Select (select)
import Stackage.CheckCabalVersion (checkCabalVersion) import Stackage.CheckCabalVersion (checkCabalVersion)
defaultBuildSettings :: BuildSettings defaultBuildSettings :: BuildSettings
@ -74,10 +60,10 @@ build settings' bp = do
] ]
hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args)) hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
runCabal args handle runCabal args handle
ec1 <- waitForProcess ph1 ec2 <- waitForProcess ph1
unless (ec1 == ExitSuccess) $ do unless (ec2 == ExitSuccess) $ do
putStrLn "Building of build tools failed, please see build-tools.log" putStrLn "Building of build tools failed, please see build-tools.log"
exitWith ec1 exitWith ec2
putStrLn "Build tools built" putStrLn "Build tools built"
ph <- withBinaryFile "build.log" WriteMode $ \handle -> do ph <- withBinaryFile "build.log" WriteMode $ \handle -> do
@ -96,33 +82,3 @@ build settings' bp = do
unless (ec == ExitSuccess) $ do unless (ec == ExitSuccess) $ do
putStrLn "Build failed, please see build.log" putStrLn "Build failed, please see build.log"
exitWith ec exitWith ec
-- | Get all of the build tools required.
iiBuildTools :: InstallInfo -> [String]
iiBuildTools InstallInfo { iiPackageDB = PackageDB m, iiPackages = packages } =
-- FIXME possible improvement: track the dependencies between the build
-- tools themselves, and install them in the correct order.
map unPackageName
$ filter (flip Set.notMember coreTools)
$ mapMaybe (flip Map.lookup buildToolMap)
$ Set.toList
$ Set.unions
$ map piBuildTools
$ Map.elems
$ Map.filterWithKey isSelected m
where
unPackageName (PackageName pn) = pn
isSelected name _ = name `Set.member` selected
selected = Set.fromList $ Map.keys packages
-- Build tools shipped with GHC which we should not attempt to build
-- ourselves.
coreTools = Set.fromList $ map PackageName $ words "hsc2hs"
-- The map from build tool name to the package it comes from.
buildToolMap = Map.unions $ map toBuildToolMap $ Map.toList m
toBuildToolMap :: (PackageName, PackageInfo) -> Map Executable PackageName
toBuildToolMap (pn, pi) = Map.unions
$ map (flip Map.singleton pn)
$ Set.toList
$ piExecs pi

View File

@ -9,8 +9,6 @@ import Stackage.Types
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import Distribution.Text (simpleParse, display) import Distribution.Text (simpleParse, display)
import Distribution.Package (PackageName (..))
import Control.Applicative ((<$>), (<*>))
readBuildPlan :: FilePath -> IO BuildPlan readBuildPlan :: FilePath -> IO BuildPlan
readBuildPlan fp = do readBuildPlan fp = do
@ -76,6 +74,7 @@ takeWord s =
if null s' if null s'
then Right (x', y) then Right (x', y)
else Left $ "Unconsumed input in takeWord call" else Left $ "Unconsumed input in takeWord call"
(_, []) -> Left "takeWord failed"
instance AsString SelectedPackageInfo where instance AsString SelectedPackageInfo where
toString SelectedPackageInfo {..} = unwords toString SelectedPackageInfo {..} = unwords

View File

@ -3,28 +3,10 @@ module Stackage.CheckCabalVersion
) where ) where
import Control.Exception (assert) import Control.Exception (assert)
import Control.Monad (unless, when)
import qualified Data.Map as Map
import Data.Maybe (mapMaybe)
import Data.Set (empty)
import qualified Data.Set as Set
import Distribution.Text (simpleParse) import Distribution.Text (simpleParse)
import Distribution.Version (withinRange) import Distribution.Version (withinRange)
import Prelude hiding (pi) import Prelude hiding (pi)
import Stackage.Config import System.Process (readProcess)
import Stackage.InstallInfo
import Stackage.Tarballs
import Stackage.Test
import Stackage.Types
import Stackage.Util
import System.Directory (canonicalizePath,
createDirectoryIfMissing,
doesDirectoryExist)
import System.Exit (ExitCode (ExitSuccess), exitWith)
import System.IO (IOMode (WriteMode), hPutStrLn,
withBinaryFile)
import System.Process (rawSystem, readProcess, runProcess,
waitForProcess)
checkCabalVersion :: IO String checkCabalVersion :: IO String
checkCabalVersion = do checkCabalVersion = do

View File

@ -4,7 +4,6 @@ module Stackage.InstallInfo
, bpPackageList , bpPackageList
) where ) where
import Control.Arrow ((&&&))
import Control.Monad (forM_) import Control.Monad (forM_)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set

View File

@ -3,31 +3,15 @@ module Stackage.Select
, defaultSelectSettings , defaultSelectSettings
) where ) where
import Control.Exception (assert)
import Control.Monad (unless, when)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe (mapMaybe) import Data.Maybe (mapMaybe)
import Data.Set (empty) import Data.Set (empty)
import qualified Data.Set as Set import qualified Data.Set as Set
import Distribution.Text (simpleParse)
import Distribution.Version (withinRange)
import Prelude hiding (pi) import Prelude hiding (pi)
import Stackage.CheckPlan
import Stackage.Config import Stackage.Config
import Stackage.InstallInfo import Stackage.InstallInfo
import Stackage.Tarballs
import Stackage.Test
import Stackage.Types import Stackage.Types
import Stackage.Util import Stackage.Util
import System.Directory (canonicalizePath,
createDirectoryIfMissing,
doesDirectoryExist)
import System.Exit (ExitCode (ExitSuccess), exitWith)
import System.IO (IOMode (WriteMode), hPutStrLn,
withBinaryFile)
import System.Process (rawSystem, readProcess, runProcess,
waitForProcess)
import Stackage.BuildPlan
defaultSelectSettings :: SelectSettings defaultSelectSettings :: SelectSettings
defaultSelectSettings = SelectSettings defaultSelectSettings = SelectSettings
@ -66,7 +50,6 @@ iiBuildTools InstallInfo { iiPackageDB = PackageDB m, iiPackages = packages } =
$ Map.elems $ Map.elems
$ Map.filterWithKey isSelected m $ Map.filterWithKey isSelected m
where where
unPackageName (PackageName pn) = pn
isSelected name _ = name `Set.member` selected isSelected name _ = name `Set.member` selected
selected = Set.fromList $ Map.keys packages selected = Set.fromList $ Map.keys packages

View File

@ -20,8 +20,8 @@ import qualified Distribution.Package as P
import qualified Distribution.PackageDescription as PD import qualified Distribution.PackageDescription as PD
import Distribution.License (License (..)) import Distribution.License (License (..))
import System.Directory (canonicalizePath, import System.Directory (canonicalizePath,
createDirectoryIfMissing, createDirectoryIfMissing
doesDirectoryExist) )
-- | Allow only packages with permissive licenses. -- | Allow only packages with permissive licenses.
allowPermissive :: [String] -- ^ list of explicitly allowed packages allowPermissive :: [String] -- ^ list of explicitly allowed packages