on f8fcc41 help sign in
stackage/Stackage/CheckPlan.hs
52 lines 2.0 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" (addCabalArgsOnlyGlobal $ "install":"--dry-run":bpPackageList bp) ""
26 when (ec /= ExitSuccess || "Warning:" `isPrefixOf` stderr) $ do
27 putStr stderr
28 putStr dryRun'
29 putStrLn "cabal returned a bad result, exiting"
30 exitWith ec
31 let dryRun = sort $ filter notOptionalCore $ map (takeWhile (/= ' ')) $ drop 2 $ lines dryRun'
32 let mismatches = getMismatches dryRun (filter notOptionalCore $ bpPackageList bp)
33 unless (null mismatches) $ do
34 putStrLn "Found the following mismatches"
35 mapM_ print mismatches
36 exitWith $ ExitFailure 1
37 putStrLn "Build plan checked, no mismatches"
38 where
39 optionalCore = Set.fromList $ map packageVersionString $ Map.toList $ bpOptionalCore bp
40 notOptionalCore s = not $ s `Set.member` optionalCore
42getMismatches :: [String] -> [String] -> [Mismatch]
43getMismatches =
44 go
45 where
46 go [] y = map OnlySimpleList y
47 go x [] = map OnlyDryRun x
48 go (x:xs) (y:ys) =
49 case compare x y of
50 EQ -> go xs ys
51 LT -> OnlyDryRun x : go xs (y:ys)
52 GT -> OnlySimpleList y : go (x:xs) ys