From b7177f8b7f972258eb4fa72217d2896d8a45849a Mon Sep 17 00:00:00 2001
From: Daniel Gröber <dxld@darkboxed.org>
Date: Sun, 2 Dec 2018 18:26:39 +0100
Subject: Add cabal target-selector compatible pretty printer for CompName

Currently `dispCompName CompNameLib` would just print `"lib"` however this
syntax is neither accepted by `cabal v1-build` nor `v2-build` as a valid target
selector making it somewhat useless for that use-case.

To specify a main library as a target selector one has to use the
`<namespace>:<component name>` syntax where `<component name>` is the name of
the respective package for unqualified libraries.

Hence this commit adds new function `dispCompName` with an additional `PkgName`
argument.
---
 cabal-plan/src-exe/LicenseReport.hs |  2 +-
 cabal-plan/src-exe/cabal-plan.hs    | 21 +++++++++++----------
 2 files changed, 12 insertions(+), 11 deletions(-)

(limited to 'cabal-plan/src-exe')

diff --git a/cabal-plan/src-exe/LicenseReport.hs b/cabal-plan/src-exe/LicenseReport.hs
index 9427d7a..7afe4e7 100644
--- a/cabal-plan/src-exe/LicenseReport.hs
+++ b/cabal-plan/src-exe/LicenseReport.hs
@@ -206,7 +206,7 @@ generateLicenseReport mlicdir plan uid0 cn0 = do
     T.putStrLn ("Bold-faced **`package-name`**s denote standard libraries bundled with `" <> dispPkgId (pjCompilerId plan) <> "`.")
     T.putStrLn ""
 
-    T.putStrLn ("## Direct dependencies of `" <> unPkgN pn0 <> ":" <> dispCompName cn0 <> "`")
+    T.putStrLn ("## Direct dependencies of `" <> unPkgN pn0 <> ":" <> dispCompNameTarget pn0 cn0 <> "`")
     T.putStrLn ""
     T.putStrLn "| Name | Version | [SPDX](https://spdx.org/licenses/) License Id | Description | Also depended upon by |"
     T.putStrLn "| --- | --- | --- | --- | --- |"
diff --git a/cabal-plan/src-exe/cabal-plan.hs b/cabal-plan/src-exe/cabal-plan.hs
index 2da2519..fd1cc72 100644
--- a/cabal-plan/src-exe/cabal-plan.hs
+++ b/cabal-plan/src-exe/cabal-plan.hs
@@ -168,9 +168,7 @@ patternCompleter onlyWithExes = mkCompleter $ \pfx -> do
         guard (onlyWithExes `impl` isJust (ciBinFile ci))
 
         let PkgId pn@(PkgName pnT) _ = uPId
-            g = case cn of
-                CompNameLib -> pnT <> T.pack":lib:" <> pnT
-                _           -> pnT <> T.pack":" <> dispCompName cn
+            g = pnT <> T.pack":" <> dispCompNameTarget pn cn
 
         let cnT = extractCompName pn cn
         [ (g, cnT) ]
@@ -343,7 +341,7 @@ doListBin plan patterns = do
             let PkgId pn@(PkgName pnT) _ = uPId
                 g = case cn of
                     CompNameLib -> T.unpack (pnT <> T.pack":lib:" <> pnT)
-                    _           -> T.unpack (pnT <> T.pack":" <> dispCompName cn)
+                    _           -> T.unpack (pnT <> T.pack":" <> dispCompNameTarget pn cn)
             guard . getAny $ patternChecker pn cn
             [(g, fn)]
   where
@@ -671,11 +669,13 @@ doDot showBuiltin showGlobal plan tred tredWeights highlights = either loopGraph
     dispDotUnit :: DotUnitId -> T.Text
     dispDotUnit (DU unitId mcname) = case M.lookup unitId units of
         Nothing   -> "?"
-        Just unit -> dispPkgId (uPId unit) <> maybe ":*" dispCompName' mcname
+        Just unit ->
+            let PkgId pn _ = uPId unit in
+            dispPkgId (uPId unit) <> maybe ":*" (dispCompName' pn) mcname
 
-    dispCompName' :: CompName -> T.Text
-    dispCompName' CompNameLib = ""
-    dispCompName' cname       = ":" <> dispCompName cname
+    dispCompName' :: PkgName -> CompName -> T.Text
+    dispCompName' _ CompNameLib = ""
+    dispCompName' pn cname       = ":" <> dispCompNameTarget pn cname
 
 -------------------------------------------------------------------------------
 -- license-report
@@ -706,7 +706,7 @@ doLicenseReport mlicdir pat = do
         let PkgId pn@(PkgName pnT) _ = uPId
             g = case cn of
                 CompNameLib -> pnT <> T.pack":lib:" <> pnT
-                _           -> pnT <> T.pack":" <> dispCompName cn
+                _           -> pnT <> T.pack":" <> dispCompNameTarget pn cn
 
         guard (getAny $ checkPattern pat pn cn)
 
@@ -740,10 +740,11 @@ doTopo showBuiltin showGlobal plan rev = do
                         UnitTypeGlobal  -> White
                         UnitTypeLocal   -> Green
                         UnitTypeInplace -> Red
+                let PkgId pn _ = uPId unit
                 let components = case M.keys (uComps unit) of
                         [] -> ""
                         [CompNameLib] -> ""
-                        names -> " " <> T.intercalate " " (map dispCompName names)
+                        names -> " " <> T.intercalate " " (map (dispCompNameTarget pn) names)
                 putStrLn $
                     colorify colour (T.unpack $ dispPkgId $ uPId unit)
                     ++ T.unpack components
-- 
cgit v1.2.3