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 :: ([String] -> [String]) -> InstallInfo -> IO ()
checkPlan extraArgs ii = do
    (ec, dryRun', stderr) <- readProcessWithExitCode "cabal" (extraArgs $ "install":"--dry-run":iiPackageList ii) ""
    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 $ iiPackageList ii)
    unless (null mismatches) $ do
        putStrLn "Found the following mismtaches"
        mapM_ print mismatches
        exitWith $ ExitFailure 1
  where
    optionalCore = Set.fromList $ map packageVersionString $ Map.toList $ iiOptionalCore ii
    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