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