Ignore pre-installed HP packages

This commit is contained in:
Michael Snoyman 2012-11-26 10:08:11 +02:00
parent 3336356fd0
commit 48c9d56a73
6 changed files with 24 additions and 11 deletions

View File

@ -2,25 +2,37 @@ module Stackage.CheckPlan
( checkPlan
) where
import Control.Monad (unless)
import Data.List (sort)
import Control.Monad (unless, when)
import Data.List (isPrefixOf, sort)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Stackage.InstallInfo
import Stackage.Types
import System.Exit (ExitCode (ExitFailure), exitWith)
import System.Process (readProcess)
import Stackage.Util
import System.Exit (ExitCode (ExitFailure, ExitSuccess),
exitWith)
import System.Process (readProcessWithExitCode)
data Mismatch = OnlyDryRun String | OnlySimpleList String
deriving Show
checkPlan :: InstallInfo -> IO ()
checkPlan ii = do
dryRun' <- readProcess "cabal-dev" ("install":"--dry-run":"-fnetwork23":iiPackageList ii) ""
let dryRun = sort $ drop 2 $ lines dryRun'
let mismatches = getMismatches dryRun (iiPackageList ii)
(ec, dryRun', stderr) <- readProcessWithExitCode "cabal-dev" ("install":"--dry-run":"-fnetwork23":iiPackageList ii) ""
when (ec /= ExitSuccess || "Warning:" `isPrefixOf` stderr) $ do
putStr stderr
putStr dryRun'
putStrLn "cabal-dev returned a bad result, exiting"
exitWith ec
let dryRun = sort $ filter notOptionalCore $ map (takeWhile (/= ' ')) $ drop 2 $ lines dryRun'
let mismatches = getMismatches dryRun (filter notOptionalCore $ iiPackageList ii)
unless (null mismatches) $ do
putStrLn "Found the following mismtaches"
mapM_ print mismatches
exitWith $ ExitFailure 1
where
optionalCore = Set.fromList $ map packageVersionString $ Map.toList $ iiOptionalCore ii
notOptionalCore s = not $ s `Set.member` optionalCore
getMismatches :: [String] -> [String] -> [Mismatch]
getMismatches =

View File

@ -1,11 +1,9 @@
{-# LANGUAGE CPP #-}
module Stackage.Config where
import Control.Monad (unless, when)
import Control.Monad.Trans.Writer (execWriter, tell)
import qualified Data.Map as Map
import Data.Set (fromList, singleton)
import Distribution.System (OS (..), buildOS)
import Distribution.Text (simpleParse)
import Stackage.Types

View File

@ -28,6 +28,7 @@ getInstallInfo = do
return InstallInfo
{ iiCore = totalCore
, iiPackages = Map.map fst final
, iiOptionalCore = Map.fromList $ map (\(PackageIdentifier p v) -> (p, v)) $ Set.toList $ hplibs hp
}
showDep :: (PackageName, (Version, [PackageName])) -> String

View File

@ -1,7 +1,6 @@
module Stackage.LoadDatabase where
import qualified Codec.Archive.Tar as Tar
import Control.Exception (throwIO)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.Map as Map

View File

@ -3,7 +3,6 @@ module Stackage.Tarballs
) where
import qualified Codec.Archive.Tar as Tar
import Control.Exception (throwIO)
import qualified Data.ByteString.Lazy as L
import qualified Data.Map as Map
import qualified Data.Set as Set

View File

@ -42,4 +42,8 @@ instance Monoid HaskellPlatform where
data InstallInfo = InstallInfo
{ iiCore :: Set PackageName
, iiPackages :: Map PackageName Version
, iiOptionalCore :: Map PackageName Version
-- ^ This is intended to hold onto packages which might be automatically
-- provided in the global package database. In practice, this would be
-- Haskell Platform packages provided by distributions.
}