git.iko.soy/stackage
on fb2385d 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 :: BuildPlan -> IO ()
20checkPlan bp = do
21 (ec, dryRun', stderr) <- readProcessWithExitCode "cabal" (addCabalArgsOnlyGlobal $ "install":"--dry-run":bpPackageList bp) ""
22 when (ec /= ExitSuccess || "Warning:" `isPrefixOf` stderr) $ do
23 putStr stderr
24 putStr dryRun'
25 putStrLn "cabal 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 $ bpPackageList bp)
29 unless (null mismatches) $ do
30 putStrLn "Found the following mismatches"
31 mapM_ print mismatches
32 exitWith $ ExitFailure 1
33 where
34 optionalCore = Set.fromList $ map packageVersionString $ Map.toList $ bpOptionalCore bp
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