Merge pull request #6910 from phadej/pretty-component

Add Pretty Component instance
haskell · Jun 16, 2020 · 6001bc9 · 6001bc9
2 parents 63d0049 + 8cbb5c3
commit 6001bc9
Show file tree

Hide file tree

Showing 3 changed files with 34 additions and 11 deletions.
diff --git a/cabal-install/Distribution/Client/ProjectPlanOutput.hs b/cabal-install/Distribution/Client/ProjectPlanOutput.hs
@@ -238,17 +238,8 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig =
                then dist_dir </> "build" </> prettyShow s </> prettyShow s
                else InstallDirs.bindir (elabInstallDirs elab) </> prettyShow s
 
-    -- TODO: maybe move this helper to "ComponentDeps" module?
-    --       Or maybe define a 'Text' instance?
     comp2str :: ComponentDeps.Component -> String
-    comp2str c = case c of
-        ComponentDeps.ComponentLib     -> "lib"
-        ComponentDeps.ComponentSubLib s -> "lib:"   <> prettyShow s
-        ComponentDeps.ComponentFLib s  -> "flib:"  <> prettyShow s
-        ComponentDeps.ComponentExe s   -> "exe:"   <> prettyShow s
-        ComponentDeps.ComponentTest s  -> "test:"  <> prettyShow s
-        ComponentDeps.ComponentBench s -> "bench:" <> prettyShow s
-        ComponentDeps.ComponentSetup   -> "setup"
+    comp2str = prettyShow
 
     style2str :: Bool -> BuildStyle -> String
     style2str True  _                = "local"

diff --git a/cabal-install/Distribution/Client/SolverInstallPlan.hs b/cabal-install/Distribution/Client/SolverInstallPlan.hs
@@ -57,6 +57,7 @@ import Prelude ()
 import Distribution.Package
          ( PackageIdentifier(..), Package(..), PackageName
          , HasUnitId(..), PackageId, packageVersion, packageName )
+import Distribution.Types.Flag (nullFlagAssignment)
 import qualified Distribution.Solver.Types.ComponentDeps as CD
 
 import Distribution.Client.Types
@@ -67,6 +68,7 @@ import Distribution.Version
 import           Distribution.Solver.Types.Settings
 import           Distribution.Solver.Types.ResolverPackage
 import           Distribution.Solver.Types.SolverId
+import           Distribution.Solver.Types.SolverPackage
 
 import Distribution.Compat.Graph (Graph, IsNode(..))
 import qualified Data.Foldable as Foldable
@@ -112,7 +114,20 @@ showPlanPackage :: SolverPlanPackage -> String
 showPlanPackage (PreExisting ipkg) = "PreExisting " ++ prettyShow (packageId ipkg)
                                             ++ " (" ++ prettyShow (installedUnitId ipkg)
                                             ++ ")"
-showPlanPackage (Configured  spkg)   = "Configured " ++ prettyShow (packageId spkg)
+showPlanPackage (Configured  spkg) =
+    "Configured " ++ prettyShow (packageId spkg) ++ flags ++ comps
+  where
+    flags
+        | nullFlagAssignment fa = ""
+        | otherwise             = " " ++ prettyShow (solverPkgFlags spkg)
+      where
+        fa = solverPkgFlags spkg
+
+    comps | null deps = ""
+          | otherwise = " " ++ unwords (map prettyShow $ Foldable.toList deps)
+      where
+        deps = CD.components (solverPkgLibDeps spkg)
+             <> CD.components (solverPkgExeDeps spkg)
 
 -- | Build an installation plan from a valid set of resolved packages.
 --

diff --git a/cabal-install/Distribution/Solver/Types/ComponentDeps.hs b/cabal-install/Distribution/Solver/Types/ComponentDeps.hs
@@ -34,6 +34,7 @@ module Distribution.Solver.Types.ComponentDeps (
   , libraryDeps
   , setupDeps
   , select
+  , components
   ) where
 
 import Prelude ()
@@ -43,8 +44,11 @@ import Distribution.Solver.Compat.Prelude hiding (empty,toList,zip)
 import qualified Data.Map as Map
 import Data.Foldable (fold)
 
+import Distribution.Pretty (Pretty (..))
 import qualified Distribution.Types.ComponentName as CN
 import qualified Distribution.Types.LibraryName as LN
+import qualified Text.PrettyPrint as PP
+
 
 {-------------------------------------------------------------------------------
   Types
@@ -64,6 +68,15 @@ data Component =
 instance Binary Component
 instance Structured Component
 
+instance Pretty Component where
+    pretty ComponentLib        = PP.text "lib"
+    pretty (ComponentSubLib n) = PP.text "lib:" <<>> pretty n
+    pretty (ComponentFLib n)   = PP.text "flib:" <<>> pretty n
+    pretty (ComponentExe n)    = PP.text "exe:" <<>> pretty n
+    pretty (ComponentTest n)   = PP.text "test:" <<>> pretty n
+    pretty (ComponentBench n)  = PP.text "bench:" <<>> pretty n
+    pretty ComponentSetup      = PP.text "setup"
+
 -- | Dependency for a single component.
 type ComponentDep a = (Component, a)
 
@@ -179,6 +192,10 @@ libraryDeps = select (\c -> case c of ComponentSubLib _ -> True
                                       ComponentLib -> True
                                       _ -> False)
 
+-- | List components
+components :: ComponentDeps a -> Set Component
+components = Map.keysSet . unComponentDeps
+
 -- | Setup dependencies.
 setupDeps :: Monoid a => ComponentDeps a -> a
 setupDeps = select (== ComponentSetup)