diff --git a/cabal-install-solver/src/Distribution/Solver/Types/ConstraintSource.hs b/cabal-install-solver/src/Distribution/Solver/Types/ConstraintSource.hs index cb91bc742b4..01082be62cd 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/ConstraintSource.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/ConstraintSource.hs @@ -6,7 +6,8 @@ module Distribution.Solver.Types.ConstraintSource import Distribution.Solver.Compat.Prelude import Distribution.Solver.Types.ProjectConfigPath (ProjectConfigPath, docProjectConfigPath) -import Text.PrettyPrint (render) +import Distribution.Pretty (Pretty(pretty), prettyShow) +import Text.PrettyPrint (text) -- | Source of a 'PackageConstraint'. data ConstraintSource = @@ -55,31 +56,40 @@ data ConstraintSource = -- | An internal constraint due to compatibility issues with the Setup.hs -- command line interface requires a maximum upper bound on Cabal | ConstraintSetupCabalMaxVersion - deriving (Eq, Show, Generic) + + -- | An implicit constraint added by Cabal. + | ConstraintSourceImplicit + deriving (Show, Eq, Ord, Generic, Typeable) instance Binary ConstraintSource instance Structured ConstraintSource -- | Description of a 'ConstraintSource'. showConstraintSource :: ConstraintSource -> String -showConstraintSource (ConstraintSourceMainConfig path) = - "main config " ++ path -showConstraintSource (ConstraintSourceProjectConfig path) = - "project config " ++ render (docProjectConfigPath path) -showConstraintSource (ConstraintSourceUserConfig path)= "user config " ++ path -showConstraintSource ConstraintSourceCommandlineFlag = "command line flag" -showConstraintSource ConstraintSourceUserTarget = "user target" -showConstraintSource ConstraintSourceNonReinstallablePackage = - "non-reinstallable package" -showConstraintSource ConstraintSourceFreeze = "cabal freeze" -showConstraintSource ConstraintSourceConfigFlagOrTarget = - "config file, command line flag, or user target" -showConstraintSource ConstraintSourceMultiRepl = - "--enable-multi-repl" -showConstraintSource ConstraintSourceProfiledDynamic = - "--enable-profiling-shared" -showConstraintSource ConstraintSourceUnknown = "unknown source" -showConstraintSource ConstraintSetupCabalMinVersion = - "minimum version of Cabal used by Setup.hs" -showConstraintSource ConstraintSetupCabalMaxVersion = - "maximum version of Cabal used by Setup.hs" +showConstraintSource = prettyShow + +instance Pretty ConstraintSource where + pretty constraintSource = case constraintSource of + (ConstraintSourceMainConfig path) -> + text "main config" <+> text path + (ConstraintSourceProjectConfig path) -> + text "project config" <+> docProjectConfigPath path + (ConstraintSourceUserConfig path)-> text "user config " <+> text path + ConstraintSourceCommandlineFlag -> text "command line flag" + ConstraintSourceUserTarget -> text "user target" + ConstraintSourceNonReinstallablePackage -> + text "non-reinstallable package" + ConstraintSourceFreeze -> text "cabal freeze" + ConstraintSourceConfigFlagOrTarget -> + text "config file, command line flag, or user target" + ConstraintSourceMultiRepl -> + text "--enable-multi-repl" + ConstraintSourceProfiledDynamic -> + text "--enable-profiling-shared" + ConstraintSourceUnknown -> text "unknown source" + ConstraintSetupCabalMinVersion -> + text "minimum version of Cabal used by Setup.hs" + ConstraintSetupCabalMaxVersion -> + text "maximum version of Cabal used by Setup.hs" + ConstraintSourceImplicit -> + text "implicit target" diff --git a/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs b/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs index fbe56380e81..2c00d9592fa 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs @@ -11,9 +11,7 @@ module Distribution.Solver.Types.PackageConstraint ( scopeToPackageName, constraintScopeMatches, PackageProperty(..), - dispPackageProperty, PackageConstraint(..), - dispPackageConstraint, showPackageConstraint, packageConstraintToDependency ) where @@ -23,7 +21,7 @@ import Prelude () import Distribution.Package (PackageName) import Distribution.PackageDescription (FlagAssignment, dispFlagAssignment) -import Distribution.Pretty (flatStyle, pretty) +import Distribution.Pretty (flatStyle, Pretty(pretty)) import Distribution.Types.PackageVersionConstraint (PackageVersionConstraint (..)) import Distribution.Version (VersionRange, simplifyVersionRange) @@ -82,12 +80,11 @@ constraintScopeMatches (ScopeAnySetupQualifier pn) (Q pp pn') = in setup pp && pn == pn' constraintScopeMatches (ScopeAnyQualifier pn) (Q _ pn') = pn == pn' --- | Pretty-prints a constraint scope. -dispConstraintScope :: ConstraintScope -> Disp.Doc -dispConstraintScope (ScopeTarget pn) = pretty pn <<>> Disp.text "." <<>> pretty pn -dispConstraintScope (ScopeQualified q pn) = dispQualifier q <<>> pretty pn -dispConstraintScope (ScopeAnySetupQualifier pn) = Disp.text "setup." <<>> pretty pn -dispConstraintScope (ScopeAnyQualifier pn) = Disp.text "any." <<>> pretty pn +instance Pretty ConstraintScope where + pretty (ScopeTarget pn) = pretty pn <<>> Disp.text "." <<>> pretty pn + pretty (ScopeQualified q pn) = dispQualifier q <<>> pretty pn + pretty (ScopeAnySetupQualifier pn) = Disp.text "setup." <<>> pretty pn + pretty (ScopeAnyQualifier pn) = Disp.text "any." <<>> pretty pn -- | A package property is a logical predicate on packages. data PackageProperty @@ -96,29 +93,27 @@ data PackageProperty | PackagePropertySource | PackagePropertyFlags FlagAssignment | PackagePropertyStanzas [OptionalStanza] - deriving (Eq, Show, Generic) + deriving (Eq, Ord, Show, Generic) instance Binary PackageProperty instance Structured PackageProperty --- | Pretty-prints a package property. -dispPackageProperty :: PackageProperty -> Disp.Doc -dispPackageProperty (PackagePropertyVersion verrange) = pretty verrange -dispPackageProperty PackagePropertyInstalled = Disp.text "installed" -dispPackageProperty PackagePropertySource = Disp.text "source" -dispPackageProperty (PackagePropertyFlags flags) = dispFlagAssignment flags -dispPackageProperty (PackagePropertyStanzas stanzas) = - Disp.hsep $ map (Disp.text . showStanza) stanzas +instance Pretty PackageProperty where + pretty (PackagePropertyVersion verrange) = pretty verrange + pretty PackagePropertyInstalled = Disp.text "installed" + pretty PackagePropertySource = Disp.text "source" + pretty (PackagePropertyFlags flags) = dispFlagAssignment flags + pretty (PackagePropertyStanzas stanzas) = + Disp.hsep $ map (Disp.text . showStanza) stanzas -- | A package constraint consists of a scope plus a property -- that must hold for all packages within that scope. data PackageConstraint = PackageConstraint ConstraintScope PackageProperty deriving (Eq, Show) --- | Pretty-prints a package constraint. -dispPackageConstraint :: PackageConstraint -> Disp.Doc -dispPackageConstraint (PackageConstraint scope prop) = - dispConstraintScope scope <+> dispPackageProperty prop +instance Pretty PackageConstraint where + pretty (PackageConstraint scope prop) = + pretty scope <+> pretty prop -- | Alternative textual representation of a package constraint -- for debugging purposes (slightly more verbose than that @@ -126,7 +121,7 @@ dispPackageConstraint (PackageConstraint scope prop) = -- showPackageConstraint :: PackageConstraint -> String showPackageConstraint pc@(PackageConstraint scope prop) = - Disp.renderStyle flatStyle . postprocess $ dispPackageConstraint pc2 + Disp.renderStyle flatStyle . postprocess $ pretty pc2 where pc2 = case prop of PackagePropertyVersion vr -> diff --git a/cabal-install/src/Distribution/Client/Targets.hs b/cabal-install/src/Distribution/Client/Targets.hs index 1a37c9c73b9..5a7d62593d8 100644 --- a/cabal-install/src/Distribution/Client/Targets.hs +++ b/cabal-install/src/Distribution/Client/Targets.hs @@ -676,7 +676,7 @@ readUserConstraint str = instance Pretty UserConstraint where pretty (UserConstraint scope prop) = - dispPackageConstraint $ PackageConstraint (fromUserConstraintScope scope) prop + pretty $ PackageConstraint (fromUserConstraintScope scope) prop instance Parsec UserConstraint where parsec = do