{-# LANGUAGE BangPatterns #-}
module Distribution.Solver.Modular.Message (
Message(..),
showMessages
) 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)
import Prelude hiding (pi)
import Distribution.Pretty (prettyShow)
import qualified Distribution.Solver.Modular.ConflictSet as CS
import Distribution.Solver.Modular.Dependency
import Distribution.Solver.Modular.Flag
import Distribution.Solver.Modular.MessageUtils
(showUnsupportedExtension, showUnsupportedLanguage)
import Distribution.Solver.Modular.Package
import Distribution.Solver.Modular.Tree
( FailReason(..), POption(..), ConflictingDep(..) )
import Distribution.Solver.Modular.Version
import Distribution.Solver.Types.ConstraintSource
import Distribution.Solver.Types.PackagePath
import Distribution.Solver.Types.Progress
import Distribution.Types.LibraryName
import Distribution.Types.UnqualComponentName
data Message =
Enter
| Leave
| TryP QPN POption
| TryF QFN Bool
| TryS QSN Bool
| Next (Goal QPN)
| Skip (Set CS.Conflict)
| Success
| Failure ConflictSet FailReason
showMessages :: Progress Message a b -> Progress String a b
showMessages :: forall a b. Progress Message a b -> Progress String a b
showMessages = Int -> Progress Message a b -> Progress String a b
forall a b. Int -> Progress Message a b -> Progress String a b
go Int
0
where
go :: Int -> Progress Message a b -> Progress String a b
go :: forall a b. Int -> Progress Message a b -> Progress String a b
go !Int
_ (Done b
x) = b -> Progress String a b
forall step fail done. done -> Progress step fail done
Done b
x
go !Int
_ (Fail a
x) = a -> Progress String a b
forall step fail done. fail -> Progress step fail done
Fail a
x
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 String a b
forall a b.
Int
-> QPN
-> [POption]
-> ConflictSet
-> FailReason
-> Progress Message a b
-> Progress String 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 String a b
forall a b.
Int
-> QPN
-> [POption]
-> Set Conflict
-> Progress Message a b
-> Progress String 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)))) =
(Int -> String -> Progress String a b -> Progress String a b
forall a b.
Int -> String -> Progress String a b -> Progress String a b
atLevel Int
l (String -> Progress String a b -> Progress String a b)
-> String -> Progress String a b -> Progress String a b
forall a b. (a -> b) -> a -> b
$ 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) (Int -> Progress Message a b -> Progress String a b
forall a b. Int -> Progress Message a b -> Progress String 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)))) =
(Int -> String -> Progress String a b -> Progress String a b
forall a b.
Int -> String -> Progress String a b -> Progress String a b
atLevel Int
l (String -> Progress String a b -> Progress String a b)
-> String -> Progress String a b -> Progress String a b
forall a b. (a -> b) -> a -> b
$ 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) (Int -> Progress Message a b -> Progress String a b
forall a b. Int -> Progress Message a b -> Progress String a b
go Int
l Progress Message a b
ms)
go !Int
l (Step (Next (Goal (P QPN
_ ) GoalReason QPN
gr)) (Step (TryP QPN
qpn' POption
i) ms :: Progress Message a b
ms@(Step Message
Enter (Step (Next Goal QPN
_) Progress Message a b
_)))) =
(Int -> String -> Progress String a b -> Progress String a b
forall a b.
Int -> String -> Progress String a b -> Progress String a b
atLevel Int
l (String -> Progress String a b -> Progress String a b)
-> String -> Progress String a b -> Progress String a b
forall a b. (a -> b) -> a -> b
$ String
"trying: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> POption -> String
showQPNPOpt QPN
qpn' POption
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ GoalReason QPN -> String
showGR GoalReason QPN
gr) (Int -> Progress Message a b -> Progress String a b
forall a b. Int -> Progress Message a b -> Progress String a b
go Int
l Progress Message a b
ms)
go !Int
l (Step (Next (Goal (P QPN
qpn) GoalReason QPN
gr)) (Step (Failure ConflictSet
_c FailReason
UnknownPackage) Progress Message a b
ms)) =
(Int -> String -> Progress String a b -> Progress String a b
forall a b.
Int -> String -> Progress String a b -> Progress String a b
atLevel Int
l (String -> Progress String a b -> Progress String a b)
-> String -> Progress String a b -> Progress String a b
forall a b. (a -> b) -> a -> b
$ String
"unknown package: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> String
showQPN QPN
qpn String -> String -> String
forall a. [a] -> [a] -> [a]
++ GoalReason QPN -> String
showGR GoalReason QPN
gr) (Progress String a b -> Progress String a b)
-> Progress String a b -> Progress String a b
forall a b. (a -> b) -> a -> b
$ Int -> Progress Message a b -> Progress String a b
forall a b. Int -> Progress Message a b -> Progress String a b
go Int
l Progress Message a b
ms
go !Int
l (Step Message
Enter Progress Message a b
ms) = Int -> Progress Message a b -> Progress String a b
forall a b. Int -> Progress Message a b -> Progress String 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 String a b
forall a b. Int -> Progress Message a b -> Progress String 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) = (Int -> String -> Progress String a b -> Progress String a b
forall a b.
Int -> String -> Progress String a b -> Progress String a b
atLevel Int
l (String -> Progress String a b -> Progress String a b)
-> String -> Progress String a b -> Progress String a b
forall a b. (a -> b) -> a -> b
$ String
"trying: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QPN -> POption -> String
showQPNPOpt QPN
qpn POption
i) (Int -> Progress Message a b -> Progress String a b
forall a b. Int -> Progress Message a b -> Progress String a b
go Int
l Progress Message a b
ms)
go !Int
l (Step (TryF QFN
qfn Bool
b) Progress Message a b
ms) = (Int -> String -> Progress String a b -> Progress String a b
forall a b.
Int -> String -> Progress String a b -> Progress String a b
atLevel Int
l (String -> Progress String a b -> Progress String a b)
-> String -> Progress String a b -> Progress String a b
forall a b. (a -> b) -> a -> b
$ String
"trying: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QFN -> Bool -> String
showQFNBool QFN
qfn Bool
b) (Int -> Progress Message a b -> Progress String a b
forall a b. Int -> Progress Message a b -> Progress String a b
go Int
l Progress Message a b
ms)
go !Int
l (Step (TryS QSN
qsn Bool
b) Progress Message a b
ms) = (Int -> String -> Progress String a b -> Progress String a b
forall a b.
Int -> String -> Progress String a b -> Progress String a b
atLevel Int
l (String -> Progress String a b -> Progress String a b)
-> String -> Progress String a b -> Progress String a b
forall a b. (a -> b) -> a -> b
$ String
"trying: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QSN -> Bool -> String
showQSNBool QSN
qsn Bool
b) (Int -> Progress Message a b -> Progress String a b
forall a b. Int -> Progress Message a b -> Progress String a b
go Int
l Progress Message a b
ms)
go !Int
l (Step (Next (Goal (P QPN
qpn) GoalReason QPN
gr)) Progress Message a b
ms) = (Int -> String -> Progress String a b -> Progress String a b
forall a b.
Int -> String -> Progress String a b -> Progress String a b
atLevel Int
l (String -> Progress String a b -> Progress String a b)
-> String -> Progress String a b -> Progress String a b
forall a b. (a -> b) -> a -> b
$ QPN -> GoalReason QPN -> String
showPackageGoal QPN
qpn GoalReason QPN
gr) (Int -> Progress Message a b -> Progress String a b
forall a b. Int -> Progress Message a b -> Progress String 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 String a b
forall a b. Int -> Progress Message a b -> Progress String a b
go Int
l Progress Message a b
ms
go !Int
l (Step (Skip Set Conflict
conflicts) Progress Message a b
ms) =
(Int -> String -> Progress String a b -> Progress String a b
forall a b.
Int -> String -> Progress String a b -> Progress String a b
atLevel Int
l (String -> Progress String a b -> Progress String a b)
-> String -> Progress String a b -> Progress String a b
forall a b. (a -> b) -> a -> b
$ String
"skipping: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Set Conflict -> String
showConflicts Set Conflict
conflicts) (Int -> Progress Message a b -> Progress String a b
forall a b. Int -> Progress Message a b -> Progress String a b
go Int
l Progress Message a b
ms)
go !Int
l (Step (Message
Success) Progress Message a b
ms) = (Int -> String -> Progress String a b -> Progress String a b
forall a b.
Int -> String -> Progress String a b -> Progress String a b
atLevel Int
l (String -> Progress String a b -> Progress String a b)
-> String -> Progress String a b -> Progress String a b
forall a b. (a -> b) -> a -> b
$ String
"done") (Int -> Progress Message a b -> Progress String a b
forall a b. Int -> Progress Message a b -> Progress String a b
go Int
l Progress Message a b
ms)
go !Int
l (Step (Failure ConflictSet
c FailReason
fr) Progress Message a b
ms) = (Int -> String -> Progress String a b -> Progress String a b
forall a b.
Int -> String -> Progress String a b -> Progress String a b
atLevel Int
l (String -> Progress String a b -> Progress String a b)
-> String -> Progress String a b -> Progress String a b
forall a b. (a -> b) -> a -> b
$ ConflictSet -> FailReason -> String
showFailure ConflictSet
c FailReason
fr) (Int -> Progress Message a b -> Progress String a b
forall a b. Int -> Progress Message a b -> Progress String a b
go Int
l Progress Message a b
ms)
showPackageGoal :: QPN -> QGoalReason -> String
showPackageGoal :: QPN -> GoalReason QPN -> String
showPackageGoal QPN
qpn GoalReason QPN
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]
++ GoalReason QPN -> String
showGR GoalReason QPN
gr
showFailure :: ConflictSet -> FailReason -> String
showFailure :: ConflictSet -> FailReason -> String
showFailure ConflictSet
c FailReason
fr = String
"fail" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConflictSet -> FailReason -> String
showFR ConflictSet
c FailReason
fr
goPReject :: Int
-> QPN
-> [POption]
-> ConflictSet
-> FailReason
-> Progress Message a b
-> Progress String a b
goPReject :: forall a b.
Int
-> QPN
-> [POption]
-> ConflictSet
-> FailReason
-> Progress Message a b
-> Progress String 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' = Int
-> QPN
-> [POption]
-> ConflictSet
-> FailReason
-> Progress Message a b
-> Progress String a b
forall a b.
Int
-> QPN
-> [POption]
-> ConflictSet
-> FailReason
-> Progress Message a b
-> Progress String 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 =
(Int -> String -> Progress String a b -> Progress String a b
forall a b.
Int -> String -> Progress String a b -> Progress String a b
atLevel Int
l (String -> Progress String a b -> Progress String a b)
-> String -> Progress String a b -> Progress String a b
forall a b. (a -> b) -> a -> b
$ String
"rejecting: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
", " ((POption -> String) -> [POption] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (QPN -> POption -> String
showQPNPOpt QPN
qpn) ([POption] -> [POption]
forall a. [a] -> [a]
reverse [POption]
is)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConflictSet -> FailReason -> String
showFR ConflictSet
c FailReason
fr) (Int -> Progress Message a b -> Progress String a b
forall a b. Int -> Progress Message a b -> Progress String a b
go Int
l Progress Message a b
ms)
goPSkip :: Int
-> QPN
-> [POption]
-> Set CS.Conflict
-> Progress Message a b
-> Progress String a b
goPSkip :: forall a b.
Int
-> QPN
-> [POption]
-> Set Conflict
-> Progress Message a b
-> Progress String 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' = Int
-> QPN
-> [POption]
-> Set Conflict
-> Progress Message a b
-> Progress String a b
forall a b.
Int
-> QPN
-> [POption]
-> Set Conflict
-> Progress Message a b
-> Progress String 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 =
let msg :: String
msg = String
"skipping: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
", " ((POption -> String) -> [POption] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (QPN -> POption -> String
showQPNPOpt QPN
qpn) ([POption] -> [POption]
forall a. [a] -> [a]
reverse [POption]
is))
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Set Conflict -> String
showConflicts Set Conflict
conflicts
in Int -> String -> Progress String a b -> Progress String a b
forall a b.
Int -> String -> Progress String a b -> Progress String a b
atLevel Int
l String
msg (Int -> Progress Message a b -> Progress String a b
forall a b. Int -> Progress Message a b -> Progress String a b
go Int
l Progress Message a b
ms)
atLevel :: Int -> String -> Progress String a b -> Progress String a b
atLevel :: forall a b.
Int -> String -> Progress String a b -> Progress String a b
atLevel Int
l String
x Progress String a b
xs =
let s :: String
s = Int -> String
forall a. Show a => a -> String
show Int
l
in String -> Progress String a b -> Progress String a b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (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]
++ String
x) Progress String a b
xs
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
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
String
"none"
else String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"; " [String]
mergedConflicts
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)
data MergedPackageConflict = MergedPackageConflict {
MergedPackageConflict -> Bool
isGoalConflict :: Bool
, MergedPackageConflict -> [Ver]
versionConstraintConflict :: [Ver]
, MergedPackageConflict -> Maybe VR
versionConflict :: Maybe VR
}
showQPNPOpt :: QPN -> POption -> String
showQPNPOpt :: QPN -> POption -> String
showQPNPOpt 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)
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)
showGR :: QGoalReason -> String
showGR :: GoalReason QPN -> String
showGR GoalReason QPN
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
_ (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
CannotInstall = String
" (only already installed instances can be used)"
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 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
_ (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
")"
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