git.iko.soy/stackage
on b804e37 help sign in
stackage/Stackage/CheckPlan.hs
73 lines 2.9 kB history raw
1module Stackage.CheckPlan
2 ( checkPlan
3 ) where
5import Control.Monad (unless, when)
6import Data.List (isPrefixOf, sort)
7import qualified Data.Map as Map
8import qualified Data.Set as Set
9import Stackage.CheckCabalVersion (checkCabalVersion)
10import Stackage.InstallInfo
11import Stackage.Types
12import Stackage.Util
13import System.Exit (ExitCode (ExitFailure, ExitSuccess),
14 exitWith)
15import System.Process (readProcessWithExitCode)
17data Mismatch = OnlyDryRun String | OnlySimpleList String
18 deriving Show
20checkPlan :: BuildSettings -> BuildPlan -> IO ()
21checkPlan settings bp = do
22 _ <- checkCabalVersion
24 putStrLn "Checking build plan"
25 packages <- mapM (replaceTarball $ tarballDir settings) (bpPackageList bp)
26 (ec, dryRun', stderr) <- readProcessWithExitCode "cabal"
27 ( addCabalArgsOnlyGlobal settings
28 $ "install"
29 : "--dry-run"
30 : "--max-backjumps=-1"
31 : "--reorder-goals"
32 : extraArgs settings BSBuild ++ packages
33 ) ""
34 when (ec /= ExitSuccess || "Warning:" `isPrefixOf` stderr) $ do
35 putStr stderr
36 putStr dryRun'
37 putStrLn "cabal returned a bad result, exiting"
38 exitWith ec
39 let dryRun = sort $ filter notOptionalCore $ map (takeWhile (/= ' ')) $ drop 2 $ lines dryRun'
40 let mismatches = getMismatches dryRun (filter notOptionalCore $ bpPackageList bp)
41 unless (null $ filter (not . acceptableMismatch) mismatches) $ do
42 putStrLn "Found the following mismatches"
43 mapM_ print mismatches
44 exitWith $ ExitFailure 1
45 putStrLn "Build plan checked, no mismatches"
46 where
47 optionalCore = Set.fromList $ map packageVersionString $ Map.toList $ bpOptionalCore bp
48 notOptionalCore s = not $ s `Set.member` optionalCore
50getMismatches :: [String] -> [String] -> [Mismatch]
51getMismatches =
52 go
53 where
54 go [] y = map OnlySimpleList y
55 go x [] = map OnlyDryRun x
56 go (x:xs) (y:ys) =
57 case compare x y of
58 EQ -> go xs ys
59 LT -> OnlyDryRun x : go xs (y:ys)
60 GT -> OnlySimpleList y : go (x:xs) ys
62-- | Some mismatches are going to be acceptable. The reasons are described
63-- below.
64acceptableMismatch :: Mismatch -> Bool
65acceptableMismatch m =
66 case m of
67 -- GHC 7.4 included extensible-extensions as a core package, and
68 -- therefore the HP at time of writing (2012.4.0.0) includes it in that
69 -- list. However, GHC 7.6 does /not/ include that package. As a result,
70 -- we get that package included in the dry run but not our list of
71 -- packages to build. See issue #57.
72 OnlyDryRun s | "extensible-exceptions-" `isPrefixOf` s -> True
73 _ -> False