git.iko.soy/stackage
on 9599cf4 help sign in
stackage/Stackage/CheckPlan.hs
72 lines 2.8 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 :: BuildPlan -> IO ()
21checkPlan bp = do
22 _ <- checkCabalVersion
24 putStrLn "Checking build plan"
25 (ec, dryRun', stderr) <- readProcessWithExitCode "cabal"
26 ( addCabalArgsOnlyGlobal
27 $ "install"
28 : "--dry-run"
29 : "--max-backjumps=-1"
30 : "--reorder-goals"
31 : bpPackageList bp
32 ) ""
33 when (ec /= ExitSuccess || "Warning:" `isPrefixOf` stderr) $ do
34 putStr stderr
35 putStr dryRun'
36 putStrLn "cabal returned a bad result, exiting"
37 exitWith ec
38 let dryRun = sort $ filter notOptionalCore $ map (takeWhile (/= ' ')) $ drop 2 $ lines dryRun'
39 let mismatches = getMismatches dryRun (filter notOptionalCore $ bpPackageList bp)
40 unless (null $ filter (not . acceptableMismatch) mismatches) $ do
41 putStrLn "Found the following mismatches"
42 mapM_ print mismatches
43 exitWith $ ExitFailure 1
44 putStrLn "Build plan checked, no mismatches"
45 where
46 optionalCore = Set.fromList $ map packageVersionString $ Map.toList $ bpOptionalCore bp
47 notOptionalCore s = not $ s `Set.member` optionalCore
49getMismatches :: [String] -> [String] -> [Mismatch]
50getMismatches =
51 go
52 where
53 go [] y = map OnlySimpleList y
54 go x [] = map OnlyDryRun x
55 go (x:xs) (y:ys) =
56 case compare x y of
57 EQ -> go xs ys
58 LT -> OnlyDryRun x : go xs (y:ys)
59 GT -> OnlySimpleList y : go (x:xs) ys
61-- | Some mismatches are going to be acceptable. The reasons are described
62-- below.
63acceptableMismatch :: Mismatch -> Bool
64acceptableMismatch m =
65 case m of
66 -- GHC 7.4 included extensible-extensions as a core package, and
67 -- therefore the HP at time of writing (2012.4.0.0) includes it in that
68 -- list. However, GHC 7.6 does /not/ include that package. As a result,
69 -- we get that package included in the dry run but not our list of
70 -- packages to build. See issue #57.
71 OnlyDryRun s | "extensible-exceptions-" `isPrefixOf` s -> True
72 _ -> False