{-# LANGUAGE BangPatterns #-}

module Distribution.Solver.Modular.Message (
    Message(..),
    summarizeMessages,
    renderSummarizedMessage,
  ) where

import qualified Data.List as L
import Data.Map (Map)
import qualified Data.Map as M
import Data.Set (Set)
import qualified Data.Set as S
import Data.Maybe (catMaybes, mapMaybe, isJust)
import Prelude hiding (pi)

import Distribution.Pretty ( prettyShow ) -- from Cabal

import qualified Distribution.Solver.Modular.ConflictSet as CS
import Distribution.Solver.Modular.Dependency
    ( Var(P),
      ConflictSet,
      showConflictSet,
      QGoalReason,
      GoalReason(DependencyGoal, UserGoal),
      Goal(Goal),
      DependencyReason(DependencyReason),
      ExposedComponent(..),
      PkgComponent(PkgComponent),
      CI(Constrained, Fixed),
      showDependencyReason )
import Distribution.Solver.Modular.Flag
    ( QSN, QFN, showQFNBool, showQSNBool, showQFN, showQSN )
import Distribution.Solver.Modular.MessageUtils
    ( showUnsupportedExtension, showUnsupportedLanguage )
import Distribution.Solver.Modular.Package
    ( PI(PI), showI, showPI )
import Distribution.Solver.Modular.Tree
    ( FailReason(..), POption(..), ConflictingDep(..) )
import Distribution.Solver.Modular.Version
    ( VR, Ver, showVer, showVR, (.||.) )

import Distribution.Solver.Types.ConstraintSource
    ( ConstraintSource (..), showConstraintSource )
import Distribution.Solver.Types.PackagePath
    ( QPN, Qualified(Q), showQPN )
import Distribution.Solver.Types.Progress
    ( Progress(..) )
import Distribution.Solver.Types.ProjectConfigPath
    ( docProjectConfigPathFailReason)
import Distribution.Solver.Types.SummarizedMessage
    ( Entry(..), EntryAtLevel(..), SummarizedMessage(..) )
import Distribution.Types.LibraryName
    ( LibraryName(LSubLibName, LMainLibName) )
import Distribution.Types.UnqualComponentName
    ( unUnqualComponentName )

import Text.PrettyPrint ( nest, render )

-- A data type to hold log information from the modular solver.
data Message =
    Enter           -- ^ increase indentation level
  | Leave           -- ^ decrease indentation level
  | TryP QPN POption
  | TryF QFN Bool
  | TryS QSN Bool
  | Next (Goal QPN)
  | Skip (Set CS.Conflict)
  | Success
  | Failure ConflictSet FailReason

renderSummarizedMessage :: SummarizedMessage -> String
renderSummarizedMessage :: SummarizedMessage -> String
renderSummarizedMessage (SummarizedMsg EntryAtLevel
i) = EntryAtLevel -> String
displayMessageAtLevel EntryAtLevel
i
renderSummarizedMessage (StringMsg String
s) = String
s

displayMessageAtLevel :: EntryAtLevel -> String
displayMessageAtLevel :: EntryAtLevel -> String
displayMessageAtLevel (AtLevel Int
l Entry
msg) =
  let s :: String
s = Int -> String
forall a. Show a => a -> String
show Int
l
  in  String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
'_' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Entry -> String
displayMessage Entry
msg

displayMessage :: Entry -> String
displayMessage :: Entry -> String
displayMessage (EntryPackageGoal QPN
qpn QGoalReason
gr) = String
"next goal: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> String
showQPN QPN
qpn String -> String -> String
forall a. [a] -> [a] -> [a]
++ QGoalReason -> String
showGR QGoalReason
gr
displayMessage (EntryRejectF QFN
qfn Bool
b ConflictSet
c FailReason
fr) = String
"rejecting: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QFN -> Bool -> String
showQFNBool QFN
qfn Bool
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConflictSet -> FailReason -> String
showFR ConflictSet
c FailReason
fr
displayMessage (EntryRejectS QSN
qsn Bool
b ConflictSet
c FailReason
fr) = String
"rejecting: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QSN -> Bool -> String
showQSNBool QSN
qsn Bool
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConflictSet -> FailReason -> String
showFR ConflictSet
c FailReason
fr
displayMessage (EntrySkipping Set Conflict
cs) = String
"skipping: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Set Conflict -> String
showConflicts Set Conflict
cs
displayMessage (EntryTryingF QFN
qfn Bool
b) = String
"trying: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QFN -> Bool -> String
showQFNBool QFN
qfn Bool
b
displayMessage (EntryTryingP QPN
qpn POption
i) = String
"trying: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> POption -> String
showOption QPN
qpn POption
i
displayMessage (EntryTryingNewP QPN
qpn POption
i QGoalReason
gr) = String
"trying: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> POption -> String
showOption QPN
qpn POption
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ QGoalReason -> String
showGR QGoalReason
gr
displayMessage (EntryTryingS QSN
qsn Bool
b) = String
"trying: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QSN -> Bool -> String
showQSNBool QSN
qsn Bool
b
displayMessage (EntryUnknownPackage QPN
qpn QGoalReason
gr) = String
"unknown package: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> String
showQPN QPN
qpn String -> String -> String
forall a. [a] -> [a] -> [a]
++ QGoalReason -> String
showGR QGoalReason
gr
displayMessage Entry
EntrySuccess = String
"done"
displayMessage (EntryFailure ConflictSet
c FailReason
fr) = String
"fail" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConflictSet -> FailReason -> String
showFR ConflictSet
c FailReason
fr
displayMessage (EntrySkipMany QPN
qsn [POption]
b Set Conflict
cs) = String
"skipping: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> [POption] -> String
showOptions QPN
qsn [POption]
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Set Conflict -> String
showConflicts Set Conflict
cs
-- Instead of displaying `aeson-1.0.2.1, aeson-1.0.2.0, aeson-1.0.1.0, ...`,
-- the following line aims to display `aeson: 1.0.2.1, 1.0.2.0, 1.0.1.0, ...`.
--
displayMessage (EntryRejectMany QPN
qpn [POption]
is ConflictSet
c FailReason
fr) = String
"rejecting: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> [POption] -> String
showOptions QPN
qpn [POption]
is String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConflictSet -> FailReason -> String
showFR ConflictSet
c FailReason
fr

-- | Transforms the structured message type to actual messages (SummarizedMessage s).
--
-- The log contains level numbers, which are useful for any trace that involves
-- backtracking, because only the level numbers will allow to keep track of
-- backjumps.
summarizeMessages :: Progress Message a b -> Progress SummarizedMessage a b
summarizeMessages :: forall a b. Progress Message a b -> Progress SummarizedMessage a b
summarizeMessages = Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go Int
0
  where
    -- 'go' increments the level for a recursive call when it encounters
    -- 'TryP', 'TryF', or 'TryS' and decrements the level when it encounters 'Leave'.
    go :: Int -> Progress Message a b -> Progress SummarizedMessage a b
    go :: forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go !Int
_ (Done b
x)                           = b -> Progress SummarizedMessage a b
forall step fail done. done -> Progress step fail done
Done b
x
    go !Int
_ (Fail a
x)                           = a -> Progress SummarizedMessage a b
forall step fail done. fail -> Progress step fail done
Fail a
x

    -- complex patterns
    go !Int
l (Step (TryP QPN
qpn POption
i) (Step Message
Enter (Step (Failure ConflictSet
c FailReason
fr) (Step Message
Leave Progress Message a b
ms)))) =
        Int
-> QPN
-> [POption]
-> ConflictSet
-> FailReason
-> Progress Message a b
-> Progress SummarizedMessage a b
forall a b.
Int
-> QPN
-> [POption]
-> ConflictSet
-> FailReason
-> Progress Message a b
-> Progress SummarizedMessage a b
goPReject Int
l QPN
qpn [POption
i] ConflictSet
c FailReason
fr Progress Message a b
ms

    go !Int
l (Step (TryP QPN
qpn POption
i) (Step Message
Enter (Step (Skip Set Conflict
conflicts) (Step Message
Leave Progress Message a b
ms)))) =
        Int
-> QPN
-> [POption]
-> Set Conflict
-> Progress Message a b
-> Progress SummarizedMessage a b
forall a b.
Int
-> QPN
-> [POption]
-> Set Conflict
-> Progress Message a b
-> Progress SummarizedMessage a b
goPSkip Int
l QPN
qpn [POption
i] Set Conflict
conflicts Progress Message a b
ms

    go !Int
l (Step (TryF QFN
qfn Bool
b) (Step Message
Enter (Step (Failure ConflictSet
c FailReason
fr) (Step Message
Leave Progress Message a b
ms)))) =
        SummarizedMessage
-> Progress SummarizedMessage a b -> Progress SummarizedMessage a b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (EntryAtLevel -> SummarizedMessage
SummarizedMsg (EntryAtLevel -> SummarizedMessage)
-> EntryAtLevel -> SummarizedMessage
forall a b. (a -> b) -> a -> b
$ Int -> Entry -> EntryAtLevel
AtLevel Int
l (QFN -> Bool -> ConflictSet -> FailReason -> Entry
EntryRejectF QFN
qfn Bool
b ConflictSet
c FailReason
fr)) (Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go Int
l Progress Message a b
ms)

    go !Int
l (Step (TryS QSN
qsn Bool
b) (Step Message
Enter (Step (Failure ConflictSet
c FailReason
fr) (Step Message
Leave Progress Message a b
ms)))) =
        SummarizedMessage
-> Progress SummarizedMessage a b -> Progress SummarizedMessage a b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (EntryAtLevel -> SummarizedMessage
SummarizedMsg (EntryAtLevel -> SummarizedMessage)
-> EntryAtLevel -> SummarizedMessage
forall a b. (a -> b) -> a -> b
$ Int -> Entry -> EntryAtLevel
AtLevel Int
l (QSN -> Bool -> ConflictSet -> FailReason -> Entry
EntryRejectS QSN
qsn Bool
b ConflictSet
c FailReason
fr)) (Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go Int
l Progress Message a b
ms)

    -- "Trying ..." message when a new goal is started
    go !Int
l (Step (Next (Goal (P QPN
_  ) QGoalReason
gr)) (Step (TryP QPN
qpn' POption
i) ms :: Progress Message a b
ms@(Step Message
Enter (Step (Next Goal QPN
_) Progress Message a b
_)))) =
        SummarizedMessage
-> Progress SummarizedMessage a b -> Progress SummarizedMessage a b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (EntryAtLevel -> SummarizedMessage
SummarizedMsg (EntryAtLevel -> SummarizedMessage)
-> EntryAtLevel -> SummarizedMessage
forall a b. (a -> b) -> a -> b
$ Int -> Entry -> EntryAtLevel
AtLevel Int
l (QPN -> POption -> QGoalReason -> Entry
EntryTryingNewP QPN
qpn' POption
i QGoalReason
gr)) (Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go Int
l Progress Message a b
ms)

    go !Int
l (Step (Next (Goal (P QPN
qpn) QGoalReason
gr)) (Step (Failure ConflictSet
_c FailReason
UnknownPackage) Progress Message a b
ms)) =
        SummarizedMessage
-> Progress SummarizedMessage a b -> Progress SummarizedMessage a b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (EntryAtLevel -> SummarizedMessage
SummarizedMsg (EntryAtLevel -> SummarizedMessage)
-> EntryAtLevel -> SummarizedMessage
forall a b. (a -> b) -> a -> b
$ Int -> Entry -> EntryAtLevel
AtLevel Int
l (QPN -> QGoalReason -> Entry
EntryUnknownPackage QPN
qpn QGoalReason
gr)) (Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go Int
l Progress Message a b
ms)

    -- standard display
    go !Int
l (Step Message
Enter                    Progress Message a b
ms) = Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Progress Message a b
ms
    go !Int
l (Step Message
Leave                    Progress Message a b
ms) = Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Progress Message a b
ms

    go !Int
l (Step (TryP QPN
qpn POption
i)             Progress Message a b
ms) = SummarizedMessage
-> Progress SummarizedMessage a b -> Progress SummarizedMessage a b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (EntryAtLevel -> SummarizedMessage
SummarizedMsg (EntryAtLevel -> SummarizedMessage)
-> EntryAtLevel -> SummarizedMessage
forall a b. (a -> b) -> a -> b
$ Int -> Entry -> EntryAtLevel
AtLevel Int
l (QPN -> POption -> Entry
EntryTryingP QPN
qpn POption
i)) (Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go Int
l Progress Message a b
ms)
    go !Int
l (Step (TryF QFN
qfn Bool
b)             Progress Message a b
ms) = SummarizedMessage
-> Progress SummarizedMessage a b -> Progress SummarizedMessage a b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (EntryAtLevel -> SummarizedMessage
SummarizedMsg (EntryAtLevel -> SummarizedMessage)
-> EntryAtLevel -> SummarizedMessage
forall a b. (a -> b) -> a -> b
$ Int -> Entry -> EntryAtLevel
AtLevel Int
l (QFN -> Bool -> Entry
EntryTryingF QFN
qfn Bool
b)) (Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go Int
l Progress Message a b
ms)
    go !Int
l (Step (TryS QSN
qsn Bool
b)             Progress Message a b
ms) = SummarizedMessage
-> Progress SummarizedMessage a b -> Progress SummarizedMessage a b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (EntryAtLevel -> SummarizedMessage
SummarizedMsg (EntryAtLevel -> SummarizedMessage)
-> EntryAtLevel -> SummarizedMessage
forall a b. (a -> b) -> a -> b
$ Int -> Entry -> EntryAtLevel
AtLevel Int
l (QSN -> Bool -> Entry
EntryTryingS QSN
qsn Bool
b)) (Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go Int
l Progress Message a b
ms)
    go !Int
l (Step (Next (Goal (P QPN
qpn) QGoalReason
gr)) Progress Message a b
ms) = SummarizedMessage
-> Progress SummarizedMessage a b -> Progress SummarizedMessage a b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (EntryAtLevel -> SummarizedMessage
SummarizedMsg (EntryAtLevel -> SummarizedMessage)
-> EntryAtLevel -> SummarizedMessage
forall a b. (a -> b) -> a -> b
$ Int -> Entry -> EntryAtLevel
AtLevel Int
l (QPN -> QGoalReason -> Entry
EntryPackageGoal QPN
qpn QGoalReason
gr)) (Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go Int
l Progress Message a b
ms)
    go !Int
l (Step (Next Goal QPN
_)                 Progress Message a b
ms) = Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go Int
l Progress Message a b
ms -- ignore flag goals in the log

    -- 'Skip' should always be handled by 'goPSkip' in the case above.
    go !Int
l (Step (Skip Set Conflict
conflicts)         Progress Message a b
ms) = SummarizedMessage
-> Progress SummarizedMessage a b -> Progress SummarizedMessage a b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (EntryAtLevel -> SummarizedMessage
SummarizedMsg (EntryAtLevel -> SummarizedMessage)
-> EntryAtLevel -> SummarizedMessage
forall a b. (a -> b) -> a -> b
$ Int -> Entry -> EntryAtLevel
AtLevel Int
l (Set Conflict -> Entry
EntrySkipping Set Conflict
conflicts)) (Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go Int
l Progress Message a b
ms)
    go !Int
l (Step Message
Success                  Progress Message a b
ms) = SummarizedMessage
-> Progress SummarizedMessage a b -> Progress SummarizedMessage a b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (EntryAtLevel -> SummarizedMessage
SummarizedMsg (EntryAtLevel -> SummarizedMessage)
-> EntryAtLevel -> SummarizedMessage
forall a b. (a -> b) -> a -> b
$ Int -> Entry -> EntryAtLevel
AtLevel Int
l Entry
EntrySuccess) (Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go Int
l Progress Message a b
ms)
    go !Int
l (Step (Failure ConflictSet
c FailReason
fr)           Progress Message a b
ms) = SummarizedMessage
-> Progress SummarizedMessage a b -> Progress SummarizedMessage a b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (EntryAtLevel -> SummarizedMessage
SummarizedMsg (EntryAtLevel -> SummarizedMessage)
-> EntryAtLevel -> SummarizedMessage
forall a b. (a -> b) -> a -> b
$ Int -> Entry -> EntryAtLevel
AtLevel Int
l (ConflictSet -> FailReason -> Entry
EntryFailure ConflictSet
c FailReason
fr)) (Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go Int
l Progress Message a b
ms)

    -- special handler for many subsequent package rejections
    goPReject :: Int
              -> QPN
              -> [POption]
              -> ConflictSet
              -> FailReason
              -> Progress Message a b
              -> Progress SummarizedMessage a b
    goPReject :: forall a b.
Int
-> QPN
-> [POption]
-> ConflictSet
-> FailReason
-> Progress Message a b
-> Progress SummarizedMessage a b
goPReject Int
l QPN
qpn [POption]
is ConflictSet
c FailReason
fr (Step (TryP QPN
qpn' POption
i) (Step Message
Enter (Step (Failure ConflictSet
_ FailReason
fr') (Step Message
Leave Progress Message a b
ms))))
      | QPN
qpn QPN -> QPN -> Bool
forall a. Eq a => a -> a -> Bool
== QPN
qpn' Bool -> Bool -> Bool
&& FailReason
fr FailReason -> FailReason -> Bool
forall a. Eq a => a -> a -> Bool
== FailReason
fr' =
        -- By prepending (i : is) we reverse the order of the instances.
        Int
-> QPN
-> [POption]
-> ConflictSet
-> FailReason
-> Progress Message a b
-> Progress SummarizedMessage a b
forall a b.
Int
-> QPN
-> [POption]
-> ConflictSet
-> FailReason
-> Progress Message a b
-> Progress SummarizedMessage a b
goPReject Int
l QPN
qpn (POption
i POption -> [POption] -> [POption]
forall a. a -> [a] -> [a]
: [POption]
is) ConflictSet
c FailReason
fr Progress Message a b
ms
    goPReject Int
l QPN
qpn [POption]
is ConflictSet
c FailReason
fr Progress Message a b
ms =
        SummarizedMessage
-> Progress SummarizedMessage a b -> Progress SummarizedMessage a b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (EntryAtLevel -> SummarizedMessage
SummarizedMsg (EntryAtLevel -> SummarizedMessage)
-> EntryAtLevel -> SummarizedMessage
forall a b. (a -> b) -> a -> b
$ Int -> Entry -> EntryAtLevel
AtLevel Int
l (QPN -> [POption] -> ConflictSet -> FailReason -> Entry
EntryRejectMany QPN
qpn ([POption] -> [POption]
forall a. [a] -> [a]
reverse [POption]
is) ConflictSet
c FailReason
fr)) (Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go Int
l Progress Message a b
ms)

    -- Handle many subsequent skipped package instances.
    goPSkip :: Int
            -> QPN
            -> [POption]
            -> Set CS.Conflict
            -> Progress Message a b
            -> Progress SummarizedMessage a b
    goPSkip :: forall a b.
Int
-> QPN
-> [POption]
-> Set Conflict
-> Progress Message a b
-> Progress SummarizedMessage a b
goPSkip Int
l QPN
qpn [POption]
is Set Conflict
conflicts (Step (TryP QPN
qpn' POption
i) (Step Message
Enter (Step (Skip Set Conflict
conflicts') (Step Message
Leave Progress Message a b
ms))))
      | QPN
qpn QPN -> QPN -> Bool
forall a. Eq a => a -> a -> Bool
== QPN
qpn' Bool -> Bool -> Bool
&& Set Conflict
conflicts Set Conflict -> Set Conflict -> Bool
forall a. Eq a => a -> a -> Bool
== Set Conflict
conflicts' =
        -- By prepending (i : is) we reverse the order of the instances.
        Int
-> QPN
-> [POption]
-> Set Conflict
-> Progress Message a b
-> Progress SummarizedMessage a b
forall a b.
Int
-> QPN
-> [POption]
-> Set Conflict
-> Progress Message a b
-> Progress SummarizedMessage a b
goPSkip Int
l QPN
qpn (POption
i POption -> [POption] -> [POption]
forall a. a -> [a] -> [a]
: [POption]
is) Set Conflict
conflicts Progress Message a b
ms
    goPSkip Int
l QPN
qpn [POption]
is Set Conflict
conflicts Progress Message a b
ms =
       SummarizedMessage
-> Progress SummarizedMessage a b -> Progress SummarizedMessage a b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (EntryAtLevel -> SummarizedMessage
SummarizedMsg (EntryAtLevel -> SummarizedMessage)
-> EntryAtLevel -> SummarizedMessage
forall a b. (a -> b) -> a -> b
$ Int -> Entry -> EntryAtLevel
AtLevel Int
l (QPN -> [POption] -> Set Conflict -> Entry
EntrySkipMany QPN
qpn ([POption] -> [POption]
forall a. [a] -> [a]
reverse [POption]
is) Set Conflict
conflicts)) (Int -> Progress Message a b -> Progress SummarizedMessage a b
forall a b.
Int -> Progress Message a b -> Progress SummarizedMessage a b
go Int
l Progress Message a b
ms)

-- | Display the set of 'Conflicts' for a skipped package version.
showConflicts :: Set CS.Conflict -> String
showConflicts :: Set Conflict -> String
showConflicts Set Conflict
conflicts =
    String
"(has the same characteristics that caused the previous version to fail: "
     String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
conflictMsg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  where
    conflictMsg :: String
    conflictMsg :: String
conflictMsg =
      if Conflict -> Set Conflict -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Conflict
CS.OtherConflict Set Conflict
conflicts
      then
        -- This case shouldn't happen, because an unknown conflict should not
        -- cause a version to be skipped.
        String
"unknown conflict"
      else let mergedConflicts :: [String]
mergedConflicts =
                   [ QPN -> MergedPackageConflict -> String
showConflict QPN
qpn MergedPackageConflict
conflict
                   | (QPN
qpn, MergedPackageConflict
conflict) <- Map QPN MergedPackageConflict -> [(QPN, MergedPackageConflict)]
forall k a. Map k a -> [(k, a)]
M.toList (Set Conflict -> Map QPN MergedPackageConflict
mergeConflicts Set Conflict
conflicts) ]
           in if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [String]
mergedConflicts
              then
                  -- This case shouldn't happen unless backjumping is turned off.
                  String
"none"
              else String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"; " [String]
mergedConflicts

    -- Merge conflicts to simplify the log message.
    mergeConflicts :: Set CS.Conflict -> Map QPN MergedPackageConflict
    mergeConflicts :: Set Conflict -> Map QPN MergedPackageConflict
mergeConflicts = (MergedPackageConflict
 -> MergedPackageConflict -> MergedPackageConflict)
-> [(QPN, MergedPackageConflict)] -> Map QPN MergedPackageConflict
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith MergedPackageConflict
-> MergedPackageConflict -> MergedPackageConflict
mergeConflict ([(QPN, MergedPackageConflict)] -> Map QPN MergedPackageConflict)
-> (Set Conflict -> [(QPN, MergedPackageConflict)])
-> Set Conflict
-> Map QPN MergedPackageConflict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Conflict -> Maybe (QPN, MergedPackageConflict))
-> [Conflict] -> [(QPN, MergedPackageConflict)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Conflict -> Maybe (QPN, MergedPackageConflict)
toMergedConflict ([Conflict] -> [(QPN, MergedPackageConflict)])
-> (Set Conflict -> [Conflict])
-> Set Conflict
-> [(QPN, MergedPackageConflict)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Conflict -> [Conflict]
forall a. Set a -> [a]
S.toList
      where
        mergeConflict :: MergedPackageConflict
                      -> MergedPackageConflict
                      -> MergedPackageConflict
        mergeConflict :: MergedPackageConflict
-> MergedPackageConflict -> MergedPackageConflict
mergeConflict MergedPackageConflict
mergedConflict1 MergedPackageConflict
mergedConflict2 = MergedPackageConflict {
              isGoalConflict :: Bool
isGoalConflict =
                  MergedPackageConflict -> Bool
isGoalConflict MergedPackageConflict
mergedConflict1 Bool -> Bool -> Bool
|| MergedPackageConflict -> Bool
isGoalConflict MergedPackageConflict
mergedConflict2
            , versionConstraintConflict :: [Ver]
versionConstraintConflict =
                  [Ver] -> [Ver]
forall a. Eq a => [a] -> [a]
L.nub ([Ver] -> [Ver]) -> [Ver] -> [Ver]
forall a b. (a -> b) -> a -> b
$ MergedPackageConflict -> [Ver]
versionConstraintConflict MergedPackageConflict
mergedConflict1
                       [Ver] -> [Ver] -> [Ver]
forall a. [a] -> [a] -> [a]
++ MergedPackageConflict -> [Ver]
versionConstraintConflict MergedPackageConflict
mergedConflict2
            , versionConflict :: Maybe VR
versionConflict =
                  Maybe VR -> Maybe VR -> Maybe VR
mergeVersionConflicts (MergedPackageConflict -> Maybe VR
versionConflict MergedPackageConflict
mergedConflict1)
                                        (MergedPackageConflict -> Maybe VR
versionConflict MergedPackageConflict
mergedConflict2)
            }
          where
            mergeVersionConflicts :: Maybe VR -> Maybe VR -> Maybe VR
mergeVersionConflicts (Just VR
vr1) (Just VR
vr2) = VR -> Maybe VR
forall a. a -> Maybe a
Just (VR
vr1 VR -> VR -> VR
.||. VR
vr2)
            mergeVersionConflicts (Just VR
vr1) Maybe VR
Nothing    = VR -> Maybe VR
forall a. a -> Maybe a
Just VR
vr1
            mergeVersionConflicts Maybe VR
Nothing    (Just VR
vr2) = VR -> Maybe VR
forall a. a -> Maybe a
Just VR
vr2
            mergeVersionConflicts Maybe VR
Nothing    Maybe VR
Nothing    = Maybe VR
forall a. Maybe a
Nothing

        toMergedConflict :: CS.Conflict -> Maybe (QPN, MergedPackageConflict)
        toMergedConflict :: Conflict -> Maybe (QPN, MergedPackageConflict)
toMergedConflict (CS.GoalConflict QPN
qpn) =
            (QPN, MergedPackageConflict) -> Maybe (QPN, MergedPackageConflict)
forall a. a -> Maybe a
Just (QPN
qpn, Bool -> [Ver] -> Maybe VR -> MergedPackageConflict
MergedPackageConflict Bool
True [] Maybe VR
forall a. Maybe a
Nothing)
        toMergedConflict (CS.VersionConstraintConflict QPN
qpn Ver
v) =
            (QPN, MergedPackageConflict) -> Maybe (QPN, MergedPackageConflict)
forall a. a -> Maybe a
Just (QPN
qpn, Bool -> [Ver] -> Maybe VR -> MergedPackageConflict
MergedPackageConflict Bool
False [Ver
v] Maybe VR
forall a. Maybe a
Nothing)
        toMergedConflict (CS.VersionConflict QPN
qpn (CS.OrderedVersionRange VR
vr)) =
            (QPN, MergedPackageConflict) -> Maybe (QPN, MergedPackageConflict)
forall a. a -> Maybe a
Just (QPN
qpn, Bool -> [Ver] -> Maybe VR -> MergedPackageConflict
MergedPackageConflict Bool
False [] (VR -> Maybe VR
forall a. a -> Maybe a
Just VR
vr))
        toMergedConflict Conflict
CS.OtherConflict = Maybe (QPN, MergedPackageConflict)
forall a. Maybe a
Nothing

    showConflict :: QPN -> MergedPackageConflict -> String
    showConflict :: QPN -> MergedPackageConflict -> String
showConflict QPN
qpn MergedPackageConflict
mergedConflict = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"; " [String]
conflictStrings
      where
        conflictStrings :: [String]
conflictStrings = [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes [
            case () of
              () | MergedPackageConflict -> Bool
isGoalConflict MergedPackageConflict
mergedConflict -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$
                     String
"depends on '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> String
showQPN QPN
qpn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         (if [Ver] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (MergedPackageConflict -> [Ver]
versionConstraintConflict MergedPackageConflict
mergedConflict)
                          then String
""
                          else String
" but excludes "
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Ver] -> String
showVersions (MergedPackageConflict -> [Ver]
versionConstraintConflict MergedPackageConflict
mergedConflict))
                 | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Ver] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null (MergedPackageConflict -> [Ver]
versionConstraintConflict MergedPackageConflict
mergedConflict) -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$
                     String
"excludes '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> String
showQPN QPN
qpn
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Ver] -> String
showVersions (MergedPackageConflict -> [Ver]
versionConstraintConflict MergedPackageConflict
mergedConflict)
                 | Bool
otherwise -> Maybe String
forall a. Maybe a
Nothing
          , (\VR
vr -> String
"excluded by constraint '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ VR -> String
showVR VR
vr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' from '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> String
showQPN QPN
qpn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'")
             (VR -> String) -> Maybe VR -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MergedPackageConflict -> Maybe VR
versionConflict MergedPackageConflict
mergedConflict
          ]

        showVersions :: [Ver] -> String
showVersions []  = String
"no versions"
        showVersions [Ver
v] = String
"version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ver -> String
showVer Ver
v
        showVersions [Ver]
vs  = String
"versions " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
", " ((Ver -> String) -> [Ver] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Ver -> String
showVer [Ver]
vs)

-- | All conflicts related to one package, used for simplifying the display of
-- a 'Set CS.Conflict'.
data MergedPackageConflict = MergedPackageConflict {
    MergedPackageConflict -> Bool
isGoalConflict :: Bool
  , MergedPackageConflict -> [Ver]
versionConstraintConflict :: [Ver]
  , MergedPackageConflict -> Maybe VR
versionConflict :: Maybe VR
  }

showOption :: QPN -> POption -> String
showOption :: QPN -> POption -> String
showOption qpn :: QPN
qpn@(Q PackagePath
_pp PackageName
pn) (POption I
i Maybe PackagePath
linkedTo) =
  case Maybe PackagePath
linkedTo of
    Maybe PackagePath
Nothing  -> PI QPN -> String
showPI (QPN -> I -> PI QPN
forall qpn. qpn -> I -> PI qpn
PI QPN
qpn I
i) -- Consistent with prior to POption
    Just PackagePath
pp' -> QPN -> String
showQPN QPN
qpn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"~>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PI QPN -> String
showPI (QPN -> I -> PI QPN
forall qpn. qpn -> I -> PI qpn
PI (PackagePath -> PackageName -> QPN
forall a. PackagePath -> a -> Qualified a
Q PackagePath
pp' PackageName
pn) I
i)

-- | Shows a mixed list of instances and versions in a human-friendly way,
-- abbreviated.
-- >>> showOptions foobarQPN [v0, v1]
-- "foo-bar; 0, 1"
-- >>> showOptions foobarQPN [v0]
-- "foo-bar-0"
-- >>> showOptions foobarQPN [i0, i1]
-- "foo-bar; 0/installed-inplace, 1/installed-inplace"
-- >>> showOptions foobarQPN [i0, v1]
-- "foo-bar; 0/installed-inplace, 1"
-- >>> showOptions foobarQPN [v0, i1]
-- "foo-bar; 0, 1/installed-inplace"
-- >>> showOptions foobarQPN []
-- "unexpected empty list of versions"
-- >>> showOptions foobarQPN [k1, k2]
-- "foo-bar; foo-bar~>bazqux.foo-bar-1, foo-bar~>bazqux.foo-bar-2"
-- >>> showOptions foobarQPN [v0, i1, k2]
-- "foo-bar; 0, 1/installed-inplace, foo-bar~>bazqux.foo-bar-2"
showOptions :: QPN -> [POption] -> String
showOptions :: QPN -> [POption] -> String
showOptions QPN
_ [] = String
"unexpected empty list of versions"
showOptions QPN
q [POption
x] = QPN -> POption -> String
showOption QPN
q POption
x
showOptions QPN
q [POption]
xs = QPN -> String
showQPN QPN
q String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
", "
  [if Maybe PackagePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe PackagePath
linkedTo
    then QPN -> POption -> String
showOption QPN
q POption
x
    else I -> String
showI I
i -- Don't show the package, just the version
  | x :: POption
x@(POption I
i Maybe PackagePath
linkedTo) <- [POption]
xs
  ]

showGR :: QGoalReason -> String
showGR :: QGoalReason -> String
showGR QGoalReason
UserGoal            = String
" (user goal)"
showGR (DependencyGoal DependencyReason QPN
dr) = String
" (dependency of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DependencyReason QPN -> String
showDependencyReason DependencyReason QPN
dr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

showFR :: ConflictSet -> FailReason -> String
showFR :: ConflictSet -> FailReason -> String
showFR ConflictSet
_ (UnsupportedExtension Extension
ext)       = String
" (conflict: requires " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Extension -> String
showUnsupportedExtension Extension
ext String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
showFR ConflictSet
_ (UnsupportedLanguage Language
lang)       = String
" (conflict: requires " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Language -> String
showUnsupportedLanguage Language
lang String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
showFR ConflictSet
_ (MissingPkgconfigPackage PkgconfigName
pn PkgconfigVersionRange
vr)  = String
" (conflict: pkg-config package " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PkgconfigName -> String
forall a. Pretty a => a -> String
prettyShow PkgconfigName
pn String -> String -> String
forall a. [a] -> [a] -> [a]
++ PkgconfigVersionRange -> String
forall a. Pretty a => a -> String
prettyShow PkgconfigVersionRange
vr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", not found in the pkg-config database)"
showFR ConflictSet
_ (MissingPkgconfigProgram PkgconfigName
pn PkgconfigVersionRange
vr)  = String
" (pkg-config package " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PkgconfigName -> String
forall a. Pretty a => a -> String
prettyShow PkgconfigName
pn String -> String -> String
forall a. [a] -> [a] -> [a]
++ PkgconfigVersionRange -> String
forall a. Pretty a => a -> String
prettyShow PkgconfigVersionRange
vr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is needed but no pkg-config executable was found or querying it failed)"
showFR ConflictSet
_ (NewPackageDoesNotMatchExistingConstraint ConflictingDep
d) = String
" (conflict: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConflictingDep -> String
showConflictingDep ConflictingDep
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
showFR ConflictSet
_ (ConflictingConstraints ConflictingDep
d1 ConflictingDep
d2)   = String
" (conflict: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
", " ((ConflictingDep -> String) -> [ConflictingDep] -> [String]
forall a b. (a -> b) -> [a] -> [b]
L.map ConflictingDep -> String
showConflictingDep [ConflictingDep
d1, ConflictingDep
d2]) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
showFR ConflictSet
_ (NewPackageIsMissingRequiredComponent ExposedComponent
comp DependencyReason QPN
dr) = String
" (does not contain " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExposedComponent -> String
showExposedComponent ExposedComponent
comp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", which is required by " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DependencyReason QPN -> String
showDependencyReason DependencyReason QPN
dr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
showFR ConflictSet
_ (NewPackageHasPrivateRequiredComponent ExposedComponent
comp DependencyReason QPN
dr) = String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExposedComponent -> String
showExposedComponent ExposedComponent
comp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is private, but it is required by " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DependencyReason QPN -> String
showDependencyReason DependencyReason QPN
dr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
showFR ConflictSet
_ (NewPackageHasUnbuildableRequiredComponent ExposedComponent
comp DependencyReason QPN
dr) = String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExposedComponent -> String
showExposedComponent ExposedComponent
comp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not buildable in the current environment, but it is required by " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DependencyReason QPN -> String
showDependencyReason DependencyReason QPN
dr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
showFR ConflictSet
_ (PackageRequiresMissingComponent QPN
qpn ExposedComponent
comp) = String
" (requires " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExposedComponent -> String
showExposedComponent ExposedComponent
comp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> String
showQPN QPN
qpn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but the component does not exist)"
showFR ConflictSet
_ (PackageRequiresPrivateComponent QPN
qpn ExposedComponent
comp) = String
" (requires " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExposedComponent -> String
showExposedComponent ExposedComponent
comp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> String
showQPN QPN
qpn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but the component is private)"
showFR ConflictSet
_ (PackageRequiresUnbuildableComponent QPN
qpn ExposedComponent
comp) = String
" (requires " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExposedComponent -> String
showExposedComponent ExposedComponent
comp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> String
showQPN QPN
qpn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but the component is not buildable in the current environment)"
showFR ConflictSet
_ FailReason
CannotReinstall                  = String
" (avoiding to reinstall a package with same version but new dependencies)"
showFR ConflictSet
_ FailReason
NotExplicit                      = String
" (not a user-provided goal nor mentioned as a constraint, but reject-unconstrained-dependencies was set)"
showFR ConflictSet
_ FailReason
Shadowed                         = String
" (shadowed by another installed package with same version)"
showFR ConflictSet
_ (Broken UnitId
u)                       = String
" (package is broken, missing dependency " String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnitId -> String
forall a. Pretty a => a -> String
prettyShow UnitId
u String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
showFR ConflictSet
_ FailReason
UnknownPackage                   = String
" (unknown package)"
showFR ConflictSet
_ (GlobalConstraintVersion VR
vr (ConstraintSourceProjectConfig ProjectConfigPath
pc)) = Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: (Doc -> String
render (Doc -> String) -> (Doc -> Doc) -> Doc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Doc
nest Int
6 (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ VR -> ProjectConfigPath -> Doc
docProjectConfigPathFailReason VR
vr ProjectConfigPath
pc)
showFR ConflictSet
_ (GlobalConstraintVersion VR
vr ConstraintSource
src) = String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConstraintSource -> String
constraintSource ConstraintSource
src String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" requires " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VR -> String
forall a. Pretty a => a -> String
prettyShow VR
vr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
showFR ConflictSet
_ (GlobalConstraintInstalled ConstraintSource
src)  = String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConstraintSource -> String
constraintSource ConstraintSource
src String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" requires installed instance)"
showFR ConflictSet
_ (GlobalConstraintInstalledSpecificUnitId UnitId
unitId ConstraintSource
src)  = String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConstraintSource -> String
constraintSource ConstraintSource
src String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" requires installed instance with unit id " String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnitId -> String
forall a. Pretty a => a -> String
prettyShow UnitId
unitId String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
showFR ConflictSet
_ (GlobalConstraintSource ConstraintSource
src)     = String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConstraintSource -> String
constraintSource ConstraintSource
src String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" requires source instance)"
showFR ConflictSet
_ (GlobalConstraintFlag ConstraintSource
src)       = String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConstraintSource -> String
constraintSource ConstraintSource
src String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" requires opposite flag selection)"
showFR ConflictSet
_ FailReason
ManualFlag                       = String
" (manual flag can only be changed explicitly)"
showFR ConflictSet
c FailReason
Backjump                         = String
" (backjumping, conflict set: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConflictSet -> String
showConflictSet ConflictSet
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
showFR ConflictSet
_ FailReason
MultipleInstances                = String
" (multiple instances)"
showFR ConflictSet
c (DependenciesNotLinked String
msg)      = String
" (dependencies not linked: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"; conflict set: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConflictSet -> String
showConflictSet ConflictSet
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
showFR ConflictSet
c FailReason
CyclicDependencies               = String
" (cyclic dependencies; conflict set: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConflictSet -> String
showConflictSet ConflictSet
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
showFR ConflictSet
_ (UnsupportedSpecVer Ver
ver)         = String
" (unsupported spec-version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ver -> String
forall a. Pretty a => a -> String
prettyShow Ver
ver String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
-- The following are internal failures. They should not occur. In the
-- interest of not crashing unnecessarily, we still just print an error
-- message though.
showFR ConflictSet
_ (MalformedFlagChoice QFN
qfn)        = String
" (INTERNAL ERROR: MALFORMED FLAG CHOICE: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QFN -> String
showQFN QFN
qfn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
showFR ConflictSet
_ (MalformedStanzaChoice QSN
qsn)      = String
" (INTERNAL ERROR: MALFORMED STANZA CHOICE: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QSN -> String
showQSN QSN
qsn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
showFR ConflictSet
_ FailReason
EmptyGoalChoice                  = String
" (INTERNAL ERROR: EMPTY GOAL CHOICE)"

showExposedComponent :: ExposedComponent -> String
showExposedComponent :: ExposedComponent -> String
showExposedComponent (ExposedLib LibraryName
LMainLibName)       = String
"library"
showExposedComponent (ExposedLib (LSubLibName UnqualComponentName
name)) = String
"library '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
showExposedComponent (ExposedExe UnqualComponentName
name)               = String
"executable '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"

constraintSource :: ConstraintSource -> String
constraintSource :: ConstraintSource -> String
constraintSource ConstraintSource
src = String
"constraint from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConstraintSource -> String
showConstraintSource ConstraintSource
src

showConflictingDep :: ConflictingDep -> String
showConflictingDep :: ConflictingDep -> String
showConflictingDep (ConflictingDep DependencyReason QPN
dr (PkgComponent QPN
qpn ExposedComponent
comp) CI
ci) =
  let DependencyReason QPN
qpn' Map Flag FlagValue
_ Set Stanza
_ = DependencyReason QPN
dr
      componentStr :: String
componentStr = case ExposedComponent
comp of
                       ExposedExe UnqualComponentName
exe               -> String
" (exe " String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
exe String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                       ExposedLib LibraryName
LMainLibName      -> String
""
                       ExposedLib (LSubLibName UnqualComponentName
lib) -> String
" (lib " String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
lib String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  in case CI
ci of
       Fixed I
i        -> (if QPN
qpn QPN -> QPN -> Bool
forall a. Eq a => a -> a -> Bool
/= QPN
qpn' then DependencyReason QPN -> String
showDependencyReason DependencyReason QPN
dr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" => " else String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         QPN -> String
showQPN QPN
qpn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
componentStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"==" String -> String -> String
forall a. [a] -> [a] -> [a]
++ I -> String
showI I
i
       Constrained VR
vr -> DependencyReason QPN -> String
showDependencyReason DependencyReason QPN
dr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" => " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> String
showQPN QPN
qpn String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         String
componentStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ VR -> String
showVR VR
vr

-- $setup
-- >>> import Distribution.Solver.Modular.Package
-- >>> import Distribution.Solver.Types.PackagePath
-- >>> import Distribution.Types.PackageName
-- >>> import Distribution.Types.Version
-- >>> import Distribution.Types.UnitId
-- >>> let foobarPN = PackagePath DefaultNamespace QualToplevel
-- >>> let bazquxPN = PackagePath (Independent $ mkPackageName "bazqux") QualToplevel
-- >>> let foobarQPN = Q foobarPN (mkPackageName "foo-bar")
-- >>> let v0 = POption (I (mkVersion [0]) InRepo) Nothing
-- >>> let v1 = POption (I (mkVersion [1]) InRepo) Nothing
-- >>> let i0 = POption (I (mkVersion [0]) (Inst $ mkUnitId "foo-bar-0-inplace")) Nothing
-- >>> let i1 = POption (I (mkVersion [1]) (Inst $ mkUnitId "foo-bar-1-inplace")) Nothing
-- >>> let k1 = POption (I (mkVersion [1]) InRepo) (Just bazquxPN)
-- >>> let k2 = POption (I (mkVersion [2]) InRepo) (Just bazquxPN)