Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Improve few internalErrors in InstallPlan #6439

Merged
merged 1 commit into from
Dec 16, 2019
Merged

Improve few internalErrors in InstallPlan #6439

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 13 additions & 5 deletions cabal-install/Distribution/Client/InstallPlan.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -69,6 +69,7 @@ module Distribution.Client.InstallPlan (

import Distribution.Client.Compat.Prelude hiding (toList, lookup, tail)
import Prelude (tail)
import Distribution.Compat.Stack (WithCallStack)

import Distribution.Client.Types hiding (BuildOutcomes)
import qualified Distribution.PackageDescription as PD
Expand All @@ -83,6 +84,7 @@ import Distribution.Package
import Distribution.Solver.Types.SolverPackage
import Distribution.Client.JobControl
import Distribution.Deprecated.Text
import Distribution.Pretty (prettyShow)
import Text.PrettyPrint
import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
import Distribution.Client.SolverInstallPlan (SolverInstallPlan)
Expand Down Expand Up @@ -165,6 +167,11 @@ data GenericPlanPackage ipkg srcpkg
| Installed srcpkg
deriving (Eq, Show, Generic)

displayGenericPlanPackage :: (IsUnit ipkg, IsUnit srcpkg) => GenericPlanPackage ipkg srcpkg -> String
displayGenericPlanPackage (PreExisting pkg) = "PreExisting " ++ prettyShow (nodeKey pkg)
displayGenericPlanPackage (Configured pkg) = "Configured " ++ prettyShow (nodeKey pkg)
displayGenericPlanPackage (Installed pkg) = "Installed " ++ prettyShow (nodeKey pkg)

-- | Convenience combinator for destructing 'GenericPlanPackage'.
-- This is handy because if you case manually, you have to handle
-- 'Configured' and 'Installed' separately (where often you want
Expand Down Expand Up @@ -249,7 +256,7 @@ mkInstallPlan loc graph indepGoals =
planIndepGoals = indepGoals
}

internalError :: String -> String -> a
internalError :: WithCallStack (String -> String -> a)
internalError loc msg = error $ "internal error in InstallPlan." ++ loc
++ if null msg then "" else ": " ++ msg

Expand Down Expand Up @@ -619,7 +626,7 @@ isInstalled _ = False
-- and return any packages that are newly in the processing state (ie ready to
-- process), along with the updated 'Processing' state.
--
completed :: (IsUnit ipkg, IsUnit srcpkg)
completed :: forall ipkg srcpkg. (IsUnit ipkg, IsUnit srcpkg)
=> GenericInstallPlan ipkg srcpkg
-> Processing -> UnitId
-> ([GenericReadyPackage srcpkg], Processing)
Expand All @@ -644,8 +651,9 @@ completed plan (Processing processingSet completedSet failedSet) pkgid =
(map nodeKey newlyReady)
processing' = Processing processingSet' completedSet' failedSet

asReadyPackage (Configured pkg) = ReadyPackage pkg
asReadyPackage _ = internalError "completed" ""
asReadyPackage :: GenericPlanPackage ipkg srcpkg -> GenericReadyPackage srcpkg
asReadyPackage (Configured pkg) = ReadyPackage pkg
asReadyPackage pkg = internalError "completed" $ "not in configured state: " ++ displayGenericPlanPackage pkg

failed :: (IsUnit ipkg, IsUnit srcpkg)
=> GenericInstallPlan ipkg srcpkg
Expand All @@ -671,7 +679,7 @@ failed plan (Processing processingSet completedSet failedSet) pkgid =
processing' = Processing processingSet' completedSet failedSet'

asConfiguredPackage (Configured pkg) = pkg
asConfiguredPackage _ = internalError "failed" "not in configured state"
asConfiguredPackage pkg = internalError "failed" $ "not in configured state: " ++ displayGenericPlanPackage pkg

processingInvariant :: (IsUnit ipkg, IsUnit srcpkg)
=> GenericInstallPlan ipkg srcpkg
Expand Down