stackage/Stackage/CheckPlan.hs

module Stackage.CheckPlan
    ( checkPlan
    ) where

import           Control.Monad        (unless, when)
import           Data.List            (isPrefixOf, sort)
import qualified Data.Map             as Map
import qualified Data.Set             as Set
import           Stackage.InstallInfo
import           Stackage.Types
import           Stackage.Util
import           System.Exit          (ExitCode (ExitFailure, ExitSuccess),
                                       exitWith)
import           System.Process       (readProcessWithExitCode)

data Mismatch = OnlyDryRun String | OnlySimpleList String
    deriving Show

checkPlan :: BuildPlan -> IO ()
checkPlan bp = do
    putStrLn "Checking build plan"
    (ec, dryRun', stderr) <- readProcessWithExitCode "cabal" (addCabalArgsOnlyGlobal $ "install":"--dry-run":bpPackageList bp) ""
    when (ec /= ExitSuccess || "Warning:" `isPrefixOf` stderr) $ do
        putStr stderr
        putStr dryRun'
        putStrLn "cabal returned a bad result, exiting"
        exitWith ec
    let dryRun = sort $ filter notOptionalCore $ map (takeWhile (/= ' ')) $ drop 2 $ lines dryRun'
    let mismatches = getMismatches dryRun (filter notOptionalCore $ bpPackageList bp)
    unless (null mismatches) $ do
        putStrLn "Found the following mismatches"
        mapM_ print mismatches
        exitWith $ ExitFailure 1
    putStrLn "Build plan checked, no mismatches"
  where
    optionalCore = Set.fromList $ map packageVersionString $ Map.toList $ bpOptionalCore bp
    notOptionalCore s = not $ s `Set.member` optionalCore

getMismatches :: [String] -> [String] -> [Mismatch]
getMismatches =
    go
  where
    go [] y = map OnlySimpleList y
    go x [] = map OnlyDryRun x
    go (x:xs) (y:ys) =
        case compare x y of
            EQ -> go xs ys
            LT -> OnlyDryRun x     : go xs (y:ys)
            GT -> OnlySimpleList y : go (x:xs) ys