on fd62aee help sign in
stackage/Stackage/CheckPlan.hs
47 lines 1.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.InstallInfo
10import Stackage.Types
11import Stackage.Util
12import System.Exit (ExitCode (ExitFailure, ExitSuccess),
13 exitWith)
14import System.Process (readProcessWithExitCode)
16data Mismatch = OnlyDryRun String | OnlySimpleList String
17 deriving Show
19checkPlan :: InstallInfo -> IO ()
20checkPlan ii = do
21 (ec, dryRun', stderr) <- readProcessWithExitCode "cabal-dev" ("install":"--dry-run":"-fnetwork23":iiPackageList ii) ""
22 when (ec /= ExitSuccess || "Warning:" `isPrefixOf` stderr) $ do
23 putStr stderr
24 putStr dryRun'
25 putStrLn "cabal-dev returned a bad result, exiting"
26 exitWith ec
27 let dryRun = sort $ filter notOptionalCore $ map (takeWhile (/= ' ')) $ drop 2 $ lines dryRun'
28 let mismatches = getMismatches dryRun (filter notOptionalCore $ iiPackageList ii)
29 unless (null mismatches) $ do
30 putStrLn "Found the following mismtaches"
31 mapM_ print mismatches
32 exitWith $ ExitFailure 1
33 where
34 optionalCore = Set.fromList $ map packageVersionString $ Map.toList $ iiOptionalCore ii
35 notOptionalCore s = not $ s `Set.member` optionalCore
37getMismatches :: [String] -> [String] -> [Mismatch]
38getMismatches =
39 go
40 where
41 go [] y = map OnlySimpleList y
42 go x [] = map OnlyDryRun x
43 go (x:xs) (y:ys) =
44 case compare x y of
45 EQ -> go xs ys
46 LT -> OnlyDryRun x : go xs (y:ys)
47 GT -> OnlySimpleList y : go (x:xs) ys