Convert display functions into Pretty instances

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"

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,37 +93,35 @@ 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
 -- produced by 'dispPackageConstraint').
 --
 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 ->

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