Skip to content

Add Pretty Component instance #6910

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Jun 16, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 1 addition & 10 deletions cabal-install/Distribution/Client/ProjectPlanOutput.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
17 changes: 16 additions & 1 deletion cabal-install/Distribution/Client/SolverInstallPlan.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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.
--
Expand Down
17 changes: 17 additions & 0 deletions cabal-install/Distribution/Solver/Types/ComponentDeps.hs
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,7 @@ module Distribution.Solver.Types.ComponentDeps (
, libraryDeps
, setupDeps
, select
, components
) where

import Prelude ()
Expand All @@ -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
Expand All @@ -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)

Expand Down Expand Up @@ -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)
Expand Down