Merge pull request #4057 from Ericson2314/unqual-component-name

[WIP] Use UnqualComponentName newtype instead of String for component names

Cabal/Distribution/Backpack/ComponentsGraph.hs

@@ -51,24 +51,22 @@ toComponentsGraph enabled pkg_descr =
   where
     -- The dependencies for the given component
     componentDeps component =
-         [ CExeName toolname | Dependency pkgname _
-                               <- buildTools bi
-                             , let toolname = unPackageName pkgname
-                             , toolname `elem` map exeName
-                               (executables pkg_descr) ]
+         [ CExeName toolname
+         | Dependency pkgname _ <- buildTools bi
+         , let toolname = packageNameToUnqualComponentName pkgname
+         , toolname `elem` map exeName (executables pkg_descr) ]
 
       ++ [ if pkgname == packageName pkg_descr
-            then CLibName
-            else CSubLibName toolname
-            | Dependency pkgname _
-                               <- targetBuildDepends bi
-                             , pkgname `elem` internalPkgDeps
-            , let toolname = unPackageName pkgname ]
+           then CLibName
+           else CSubLibName toolname
+         | Dependency pkgname _ <- targetBuildDepends bi
+         , let toolname = packageNameToUnqualComponentName pkgname
+         , toolname `elem` internalPkgDeps ]
       where
         bi = componentBuildInfo component
         internalPkgDeps = map (conv . libName) (allLibraries pkg_descr)
-        conv Nothing = packageName pkg_descr
-        conv (Just s) = mkPackageName s
+        conv Nothing = packageNameToUnqualComponentName $ packageName pkg_descr
+        conv (Just s) = s
 
 -- | Error message when there is a cycle; takes the SCC of components.
 componentCycleMsg :: [ComponentName] -> Doc

Cabal/Distribution/Backpack/ConfiguredComponent.hs

@@ -104,7 +104,7 @@ mkConfiguredComponent this_pid this_cid lib_deps exe_deps component =
 
 type ConfiguredComponentMap =
         (Map PackageName (ComponentId, PackageId), -- libraries
-         Map String ComponentId)                   -- executables
+         Map UnqualComponentName ComponentId)      -- executables
 
 -- Executable map must be different because an executable can
 -- have the same name as a library. Ew.
@@ -141,7 +141,7 @@ toConfiguredComponent pkg_descr this_cid
         = Map.toList external_lib_map
     exe_deps = [ cid
                | Dependency pkgname _ <- buildTools bi
-               , let name = unPackageName pkgname
+               , let name = packageNameToUnqualComponentName pkgname
                , Just cid <- [ Map.lookup name exe_map ] ]
 
 -- | Also computes the 'ComponentId', and sets cc_public if necessary.
@@ -183,7 +183,7 @@ extendConfiguredComponentMap cc (lib_map, exe_map) =
             Map.insert (pkgName (cc_pkgid cc))
                        (cc_cid cc, cc_pkgid cc) lib_map
           CSubLibName str ->
-            Map.insert (mkPackageName str)
+            Map.insert (unqualComponentNameToPackageName str)
                        (cc_cid cc, cc_pkgid cc) lib_map
           _ -> lib_map
     exe_map'

Cabal/Distribution/Backpack/Id.hs

@@ -63,7 +63,7 @@ computeComponentId mb_ipid mb_cid pid cname mb_details =
           NoFlag -> mkComponentId $ actual_base
                         ++ (case componentNameString cname of
                                 Nothing -> ""
-                                Just s -> "-" ++ s)
+                                Just s -> "-" ++ unUnqualComponentName s)
 
 -- | Computes the package name for a library.  If this is the public
 -- library, it will just be the original package name; otherwise,
@@ -102,7 +102,8 @@ computeCompatPackageName pkg_name CLibName = pkg_name
 computeCompatPackageName pkg_name cname
     = mkPackageName $ "z-" ++ zdashcode (display pkg_name)
                  ++ (case componentNameString cname of
-                        Just cname_str -> "-z-" ++ zdashcode cname_str
+                        Just cname_u -> "-z-" ++ zdashcode cname_str
+                          where cname_str = unUnqualComponentName cname_u
                         Nothing -> "")
 
 zdashcode :: String -> String

Cabal/Distribution/Package.hs

@@ -18,7 +18,9 @@
 
 module Distribution.Package (
         -- * Package ids
+        UnqualComponentName, unUnqualComponentName, mkUnqualComponentName,
         PackageName, unPackageName, mkPackageName,
+        packageNameToUnqualComponentName, unqualComponentNameToPackageName,
         PackageIdentifier(..),
         PackageId,
 
@@ -69,6 +71,54 @@ import Distribution.ModuleName
 
 import Text.PrettyPrint ((<+>), text)
 
+-- | An unqualified component name, for any kind of component.
+--
+-- This is distinguished from a 'ComponentName' and 'ComponentId'. The former
+-- also states which of a library, executable, etc the name refers too. The
+-- later uniquely identifiers a component and its closure.
+--
+-- @since 2.0
+newtype UnqualComponentName = UnqualComponentName ShortText
+    deriving (Generic, Read, Show, Eq, Ord, Typeable, Data,
+              Semigroup, Monoid) -- TODO: bad enabler of bad monoids
+
+-- | Convert 'UnqualComponentName' to 'String'
+--
+-- @since 2.0
+unUnqualComponentName :: UnqualComponentName -> String
+unUnqualComponentName (UnqualComponentName s) = fromShortText s
+
+-- | Construct a 'UnqualComponentName' from a 'String'
+--
+-- 'mkUnqualComponentName' is the inverse to 'unUnqualComponentName'
+--
+-- Note: No validations are performed to ensure that the resulting
+-- 'UnqualComponentName' is valid
+--
+-- @since 2.0
+mkUnqualComponentName :: String -> UnqualComponentName
+mkUnqualComponentName = UnqualComponentName . toShortText
+
+instance Binary UnqualComponentName
+
+parsePackageName :: Parse.ReadP r String
+parsePackageName = do
+  ns <- Parse.sepBy1 component (Parse.char '-')
+  return $ intercalate "-" ns
+  where
+    component = do
+      cs <- Parse.munch1 isAlphaNum
+      if all isDigit cs then Parse.pfail else return cs
+      -- each component must contain an alphabetic character, to avoid
+      -- ambiguity in identifiers like foo-1 (the 1 is the version number).
+
+instance Text UnqualComponentName where
+  disp = Disp.text . unUnqualComponentName
+  parse = mkUnqualComponentName <$> parsePackageName
+
+instance NFData UnqualComponentName where
+    rnf (UnqualComponentName pkg) = rnf pkg
+
 -- | A package name.
 --
 -- Use 'mkPackageName' and 'unPackageName' to convert from/to a
@@ -95,19 +145,32 @@ unPackageName (PackageName s) = fromShortText s
 mkPackageName :: String -> PackageName
 mkPackageName = PackageName . toShortText
 
+-- | Converts a package name to an unqualified component name
+--
+-- Useful in legacy situations where a package name may refer to an internal
+-- component, if one is defined with that name.
+--
+-- @since 2.0
+packageNameToUnqualComponentName :: PackageName -> UnqualComponentName
+packageNameToUnqualComponentName (PackageName s) = UnqualComponentName s
+
+-- | Converts an unqualified component name to a package name
+--
+-- `packageNameToUnqualComponentName` is the inverse of
+-- `unqualComponentNameToPackageName`.
+--
+-- Useful in legacy situations where a package name may refer to an internal
+-- component, if one is defined with that name.
+--
+-- @since 2.0
+unqualComponentNameToPackageName :: UnqualComponentName -> PackageName
+unqualComponentNameToPackageName (UnqualComponentName s) = PackageName s
+
 instance Binary PackageName
 
 instance Text PackageName where
   disp = Disp.text . unPackageName
-  parse = do
-    ns <- Parse.sepBy1 component (Parse.char '-')
-    return (mkPackageName (intercalate "-" ns))
-    where
-      component = do
-        cs <- Parse.munch1 isAlphaNum
-        if all isDigit cs then Parse.pfail else return cs
-        -- each component must contain an alphabetic character, to avoid
-        -- ambiguity in identifiers like foo-1 (the 1 is the version number).
+  parse = mkPackageName <$> parsePackageName
 
 instance NFData PackageName where
     rnf (PackageName pkg) = rnf pkg

Cabal/Distribution/PackageDescription/Check.hs

@@ -185,13 +185,15 @@ checkSanity pkg =
         ++ "Only the non-internal library can have the same name as the package."
 
   , check (not (null duplicateNames)) $
-      PackageBuildImpossible $ "Duplicate sections: " ++ commaSep duplicateNames
+      PackageBuildImpossible $ "Duplicate sections: "
+        ++ commaSep (map unUnqualComponentName duplicateNames)
         ++ ". The name of every library, executable, test suite,"
         ++ " and benchmark section in"
         ++ " the package must be unique."
 
   -- NB: but it's OK for executables to have the same name!
-  , check (any (== display (packageName pkg)) subLibNames) $
+  -- TODO shouldn't need to compare on the string level
+  , check (any (== display (packageName pkg)) (display <$> subLibNames)) $
       PackageBuildImpossible $ "Illegal internal library name "
         ++ display (packageName pkg)
         ++ ". Internal libraries cannot have the same name as the package."
@@ -239,7 +241,7 @@ checkLibrary pkg lib =
       PackageDistSuspiciousWarn $
            "Library " ++ (case libName lib of
                             Nothing -> ""
-                            Just n -> n
+                            Just n -> display n
                             ) ++ "does not expose any modules"
 
     -- check use of signatures sections
@@ -273,7 +275,7 @@ checkExecutable pkg exe =
 
     check (null (modulePath exe)) $
       PackageBuildImpossible $
-        "No 'main-is' field found for executable " ++ exeName exe
+        "No 'main-is' field found for executable " ++ display (exeName exe)
 
   , check (not (null (modulePath exe))
        && (not $ fileExtensionSupportedLanguage $ modulePath exe)) $
@@ -291,14 +293,14 @@ checkExecutable pkg exe =
 
   , check (not (null moduleDuplicates)) $
        PackageBuildImpossible $
-            "Duplicate modules in executable '" ++ exeName exe ++ "': "
+            "Duplicate modules in executable '" ++ display (exeName exe) ++ "': "
          ++ commaSep (map display moduleDuplicates)
 
     -- check that all autogen-modules appear on other-modules
   , check
       (not $ and $ map (flip elem (exeModules exe)) (exeModulesAutogen exe)) $
       PackageBuildImpossible $
-           "On executable '" ++ exeName exe ++ "' an 'autogen-module' is not "
+           "On executable '" ++ display (exeName exe) ++ "' an 'autogen-module' is not "
         ++ "on 'other-modules'"
 
   ]
@@ -325,7 +327,7 @@ checkTestSuite pkg test =
 
   , check (not $ null moduleDuplicates) $
       PackageBuildImpossible $
-           "Duplicate modules in test suite '" ++ testName test ++ "': "
+           "Duplicate modules in test suite '" ++ display (testName test) ++ "': "
         ++ commaSep (map display moduleDuplicates)
 
   , check mainIsWrongExt $
@@ -346,7 +348,7 @@ checkTestSuite pkg test =
         (testModulesAutogen test)
       ) $
       PackageBuildImpossible $
-           "On test suite '" ++ testName test ++ "' an 'autogen-module' is not "
+           "On test suite '" ++ display (testName test) ++ "' an 'autogen-module' is not "
         ++ "on 'other-modules'"
   ]
   where
@@ -380,7 +382,7 @@ checkBenchmark _pkg bm =
 
   , check (not $ null moduleDuplicates) $
       PackageBuildImpossible $
-           "Duplicate modules in benchmark '" ++ benchmarkName bm ++ "': "
+           "Duplicate modules in benchmark '" ++ display (benchmarkName bm) ++ "': "
         ++ commaSep (map display moduleDuplicates)
 
   , check mainIsWrongExt $
@@ -395,7 +397,7 @@ checkBenchmark _pkg bm =
         (benchmarkModulesAutogen bm)
       ) $
       PackageBuildImpossible $
-             "On benchmark '" ++ benchmarkName bm ++ "' an 'autogen-module' is "
+             "On benchmark '" ++ display (benchmarkName bm) ++ "' an 'autogen-module' is "
           ++ "not on 'other-modules'"
   ]
   where
@@ -552,7 +554,7 @@ checkFields pkg =
       , isNoVersion vr ]
 
     internalLibraries =
-        map (maybe (packageName pkg) mkPackageName . libName)
+        map (maybe (packageName pkg) (unqualComponentNameToPackageName) . libName)
             (allLibraries pkg)
     buildDependsRangeOnInternalLibrary =
       [ dep

Cabal/Distribution/PackageDescription/Configuration.hs

@@ -452,7 +452,7 @@ constrainBy left extra =
 
 -- | Collect up the targets in a TargetSet of tagged targets, storing the
 -- dependencies as we go.
-flattenTaggedTargets :: TargetSet PDTagged -> (Maybe Library, [(String, Component)])
+flattenTaggedTargets :: TargetSet PDTagged -> (Maybe Library, [(UnqualComponentName, Component)])
 flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, []) targets
   where
     untag (_, Lib _) (Just _, _) = userBug "Only one library expected"
@@ -464,7 +464,7 @@ flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, []) targets
             }
     untag (deps, SubComp n c) (mb_lib, comps)
         | any ((== n) . fst) comps =
-          userBug $ "There exist several components with the same name: '" ++ n ++ "'"
+          userBug $ "There exist several components with the same name: '" ++ unUnqualComponentName n ++ "'"
 
         | otherwise = (mb_lib, (n, c') : comps)
       where
@@ -484,7 +484,7 @@ flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, []) targets
 --
 
 data PDTagged = Lib Library
-              | SubComp String Component
+              | SubComp UnqualComponentName Component
               | PDNull
               deriving Show
 

Cabal/Distribution/PackageDescription/Parse.hs

@@ -889,11 +889,11 @@ parsePackageDescription file = do
             -> PM ([SourceRepo], [Flag]
                   ,Maybe SetupBuildInfo
                   ,(Maybe (CondTree ConfVar [Dependency] Library))
-                  ,[(String, CondTree ConfVar [Dependency] Library)]
-                  ,[(String, CondTree ConfVar [Dependency] ForeignLib)]
-                  ,[(String, CondTree ConfVar [Dependency] Executable)]
-                  ,[(String, CondTree ConfVar [Dependency] TestSuite)]
-                  ,[(String, CondTree ConfVar [Dependency] Benchmark)])
+                  ,[(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
+                  ,[(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
+                  ,[(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
+                  ,[(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
+                  ,[(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)])
     getBody pkg = peekField >>= \mf -> case mf of
       Just (Section line_no sec_type sec_label sec_fields)
         | sec_type == "executable" -> do
@@ -903,7 +903,7 @@ parsePackageDescription file = do
             flds <- collectFields parseExeFields sec_fields
             skipField
             (repos, flags, csetup, mlib, sub_libs, flibs, exes, tests, bms) <- getBody pkg
-            return (repos, flags, csetup, mlib, sub_libs, flibs, (exename, flds): exes, tests, bms)
+            return (repos, flags, csetup, mlib, sub_libs, flibs, (mkUnqualComponentName exename, flds): exes, tests, bms)
 
         | sec_type == "foreign-library" -> do
             when (null sec_label) $ lift $ syntaxError line_no
@@ -922,7 +922,7 @@ parsePackageDescription file = do
                 then do
                     skipField
                     (repos, flags, csetup, mlib, sub_libs, flibs, exes, tests, bms) <- getBody pkg
-                    return (repos, flags, csetup, mlib, sub_libs, (libname, flds):flibs, exes, tests, bms)
+                    return (repos, flags, csetup, mlib, sub_libs, (mkUnqualComponentName libname, flds):flibs, exes, tests, bms)
                 else lift $ syntaxError line_no $
                          "Foreign library \"" ++ libname
                       ++ "\" is missing required field \"type\" or the field "
@@ -948,7 +948,7 @@ parsePackageDescription file = do
                     skipField
                     (repos, flags, csetup, mlib, sub_libs, flibs, exes, tests, bms) <- getBody pkg
                     return (repos, flags, csetup, mlib, sub_libs, flibs, exes,
-                            (testname, flds) : tests, bms)
+                            (mkUnqualComponentName testname, flds) : tests, bms)
                 else lift $ syntaxError line_no $
                          "Test suite \"" ++ testname
                       ++ "\" is missing required field \"type\" or the field "
@@ -974,7 +974,7 @@ parsePackageDescription file = do
                     skipField
                     (repos, flags, csetup, mlib, sub_libs, flibs, exes, tests, bms) <- getBody pkg
                     return (repos, flags, csetup, mlib, sub_libs, flibs, exes,
-                            tests, (benchname, flds) : bms)
+                            tests, (mkUnqualComponentName benchname, flds) : bms)
                 else lift $ syntaxError line_no $
                          "Benchmark \"" ++ benchname
                       ++ "\" is missing required field \"type\" or the field "
@@ -994,7 +994,7 @@ parsePackageDescription file = do
             (repos, flags, csetup, mlib, sub_libs, flibs, exes, tests, bms) <- getBody pkg
             case mb_libname of
                 Just libname ->
-                    return (repos, flags, csetup, mlib, (libname, flds) : sub_libs, flibs, exes, tests, bms)
+                    return (repos, flags, csetup, mlib, (mkUnqualComponentName libname, flds) : sub_libs, flibs, exes, tests, bms)
                 Nothing -> do
                     when (isJust mlib) $ lift $ syntaxError line_no
                       "There can only be one (public) library section in a package description."
@@ -1141,9 +1141,9 @@ parsePackageDescription file = do
     checkForUndefinedFlags ::
         [Flag] ->
         Maybe (CondTree ConfVar [Dependency] Library) ->
-        [(String, CondTree ConfVar [Dependency] Library)] ->
-        [(String, CondTree ConfVar [Dependency] Executable)] ->
-        [(String, CondTree ConfVar [Dependency] TestSuite)] ->
+        [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] ->
+        [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] ->
+        [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] ->
         PM ()
     checkForUndefinedFlags flags mlib sub_libs exes tests = do
         let definedFlags = map flagName flags
@@ -1252,11 +1252,11 @@ parseHookedBuildInfo inp = do
         | lowercase inFieldName /= "executable" = liftM Just (parseBI bi)
     parseLib _ = return Nothing
 
-    parseExe :: [Field] -> ParseResult (String, BuildInfo)
+    parseExe :: [Field] -> ParseResult (UnqualComponentName, BuildInfo)
     parseExe (F line inFieldName mName:bi)
         | lowercase inFieldName == "executable"
             = do bis <- parseBI bi
-                 return (mName, bis)
+                 return (mkUnqualComponentName mName, bis)
         | otherwise = syntaxError line "expecting 'executable' at top of stanza"
     parseExe (_:_) = cabalBug "`parseExe' called on a non-field"
     parseExe [] = syntaxError 0 "error in parsing buildinfo file. Expected executable stanza"

Cabal/Distribution/PackageDescription/Parsec.hs

@@ -34,6 +34,7 @@ import qualified Data.ByteString                                   as BS
 import           Data.List                                         (partition)
 import qualified Data.Map                                          as Map
 import qualified Distribution.Compat.SnocList                      as SnocList
+import           Distribution.Package
 import           Distribution.PackageDescription
 import           Distribution.PackageDescription.Parsec.FieldDescr
 import           Distribution.Parsec.Class                         (parsec)
@@ -215,21 +216,21 @@ parseGenericPackageDescription' lexWarnings fs = do
 
         -- Sublibraries
         | name == "library" = do
-            name' <- parseName pos args
+            name' <- parseUnqualComponentName pos args
             lib <- parseCondTree libFieldDescrs storeXFieldsLib (targetBuildDepends . libBuildInfo) emptyLibrary fields
             -- TODO check duplicate name here?
             let gpd' = gpd { condSubLibraries = condSubLibraries gpd ++ [(name', lib)] }
             pure gpd'
 
         | name == "foreign-library" = do
-            name' <- parseName pos args
+            name' <- parseUnqualComponentName pos args
             flib <- parseCondTree foreignLibFieldDescrs storeXFieldsForeignLib (targetBuildDepends . foreignLibBuildInfo) emptyForeignLib fields
             -- TODO check duplicate name here?
             let gpd' = gpd { condForeignLibs = condForeignLibs gpd ++ [(name', flib)] }
             pure gpd'
 
         | name == "executable" = do
-            name' <- parseName pos args
+            name' <- parseUnqualComponentName pos args
             -- Note: we don't parse the "executable" field here, hence the tail hack. Duncan 2010
             exe <- parseCondTree (tail executableFieldDescrs) storeXFieldsExe (targetBuildDepends . buildInfo) emptyExecutable fields
             -- TODO check duplicate name here?
@@ -237,7 +238,7 @@ parseGenericPackageDescription' lexWarnings fs = do
             pure gpd'
 
         | name == "test-suite" = do
-            name' <- parseName pos args
+            name' <- parseUnqualComponentName pos args
             testStanza <- parseCondTree testSuiteFieldDescrs storeXFieldsTest (targetBuildDepends . testStanzaBuildInfo) emptyTestStanza fields
             testSuite <- traverse (validateTestSuite pos) testStanza
             -- TODO check duplicate name here?
@@ -245,7 +246,7 @@ parseGenericPackageDescription' lexWarnings fs = do
             pure gpd'
 
         | name == "benchmark" = do
-            name' <- parseName pos args
+            name' <- parseUnqualComponentName pos args
             benchStanza <- parseCondTree benchmarkFieldDescrs storeXFieldsBenchmark (targetBuildDepends . benchmarkStanzaBuildInfo) emptyBenchmarkStanza fields
             bench <- traverse (validateBenchmark pos) benchStanza
             -- TODO check duplicate name here?
@@ -363,6 +364,10 @@ parseName pos args = case args of
          parseFailure pos $ "Invalid name " ++ show args
          pure ""
 
+parseUnqualComponentName :: Position -> [SectionArg Position] -> ParseResult UnqualComponentName
+parseUnqualComponentName pos args = mkUnqualComponentName <$> parseName pos args
+
+
 -- | Parse a non-recursive list of fields, given a list of field descriptions,
 --   a structure to accumulate the parsed fields, and a function
 --   that can decide what to do with fields which don't match any

Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs

@@ -231,7 +231,7 @@ executableFieldDescrs =
     [ -- note ordering: configuration must come first, for
       -- showPackageDescription.
       simpleField "executable"
-        showToken          parsecToken
+        disp               parsec
         exeName            (\xs    exe -> exe{exeName=xs})
     , simpleField "main-is"
         showFilePath       parsecFilePath

Cabal/Distribution/PackageDescription/PrettyPrint.hs

@@ -126,11 +126,10 @@ ppCondLibrary :: Maybe (CondTree ConfVar [Dependency] Library) -> Doc
 ppCondLibrary Nothing = mempty
 ppCondLibrary (Just condTree) =
     emptyLine $ text "library"
-        $+$ nest indentWith (ppCondTree condTree Nothing ppLib)
-
-ppCondSubLibraries :: [(String, CondTree ConfVar [Dependency] Library)] -> Doc
+        $+$ nest indentWith (ppCondTree condTree Nothing ppLib) 
+ppCondSubLibraries :: [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] -> Doc
 ppCondSubLibraries libs                           =
-    vcat [emptyLine $ text ("library " ++ n)
+    vcat [emptyLine $ (text "library " <+> disp n)
               $+$ nest indentWith (ppCondTree condTree Nothing ppLib)| (n,condTree) <- libs]
 
 ppLib :: Library -> Maybe Library -> Doc
@@ -139,9 +138,9 @@ ppLib lib Nothing     = ppFieldsFiltered libDefaults libFieldDescrs lib
 ppLib lib (Just plib) = ppDiffFields libFieldDescrs lib plib
                         $$  ppCustomFields (customFieldsBI (libBuildInfo lib))
 
-ppCondExecutables :: [(String, CondTree ConfVar [Dependency] Executable)] -> Doc
+ppCondExecutables :: [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] -> Doc
 ppCondExecutables exes                       =
-    vcat [emptyLine $ text ("executable " ++ n)
+    vcat [emptyLine $ (text "executable " <+> disp n)
               $+$ nest indentWith (ppCondTree condTree Nothing ppExe)| (n,condTree) <- exes]
   where
     ppExe (Executable _ modulePath' buildInfo') Nothing =
@@ -155,9 +154,9 @@ ppCondExecutables exes                       =
             $+$ ppDiffFields binfoFieldDescrs buildInfo' buildInfo2
             $+$ ppCustomFields (customFieldsBI buildInfo')
 
-ppCondTestSuites :: [(String, CondTree ConfVar [Dependency] TestSuite)] -> Doc
+ppCondTestSuites :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] -> Doc
 ppCondTestSuites suites =
-    emptyLine $ vcat [     text ("test-suite " ++ n)
+    emptyLine $ vcat [     (text "test-suite " <+> disp n)
                        $+$ nest indentWith (ppCondTree condTree Nothing ppTestSuite)
                      | (n,condTree) <- suites]
   where
@@ -187,9 +186,9 @@ ppCondTestSuites suites =
       TestSuiteLibV09 _ m -> Just m
       _                   -> Nothing
 
-ppCondBenchmarks :: [(String, CondTree ConfVar [Dependency] Benchmark)] -> Doc
+ppCondBenchmarks :: [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -> Doc
 ppCondBenchmarks suites =
-    emptyLine $ vcat [     text ("benchmark " ++ n)
+    emptyLine $ vcat [     (text "benchmark " <+> disp n)
                        $+$ nest indentWith (ppCondTree condTree Nothing ppBenchmark)
                      | (n,condTree) <- suites]
   where
@@ -299,25 +298,25 @@ ppMaybeLibrary (Just lib) =
 
 ppSubLibraries :: [Library] -> Doc
 ppSubLibraries libs = vcat [
-    emptyLine $ text "library" <+> text libname
+    emptyLine $ text "library" <+> disp libname
         $+$ nest indentWith (ppFields libFieldDescrs lib)
     | lib@Library{ libName = Just libname } <- libs ]
 
 ppForeignLibs :: [ForeignLib] -> Doc
 ppForeignLibs flibs = vcat [
-    emptyLine $ text "foreign library" <+> text flibname
+    emptyLine $ text "foreign library" <+> disp flibname
         $+$ nest indentWith (ppFields foreignLibFieldDescrs flib)
     | flib@ForeignLib{ foreignLibName = flibname } <- flibs ]
 
 ppExecutables :: [Executable] -> Doc
 ppExecutables exes = vcat [
-    emptyLine $ text "executable" <+> text (exeName exe)
+    emptyLine $ text "executable" <+> disp (exeName exe)
         $+$ nest indentWith (ppFields executableFieldDescrs exe)
     | exe <- exes ]
 
 ppTestSuites :: [TestSuite] -> Doc
 ppTestSuites tests = vcat [
-    emptyLine $ text "test-suite" <+> text (testName test)
+    emptyLine $ text "test-suite" <+> disp (testName test)
         $+$ nest indentWith (ppFields testSuiteFieldDescrs test_stanza)
     | test <- tests
     , let test_stanza
@@ -346,7 +345,7 @@ testSuiteInterfaceToMaybeModule TestSuiteUnsupported{} = Nothing
 
 ppBenchmarks :: [Benchmark] -> Doc
 ppBenchmarks benchs = vcat [
-    emptyLine $ text "benchmark" <+> text (benchmarkName bench)
+    emptyLine $ text "benchmark" <+> disp (benchmarkName bench)
         $+$ nest indentWith (ppFields benchmarkFieldDescrs bench_stanza)
     | bench <- benchs
     , let bench_stanza = BenchmarkStanza {
@@ -377,7 +376,7 @@ showHookedBuildInfo (mb_lib_bi, ex_bis) = render $
         Nothing -> mempty
         Just bi -> ppBuildInfo bi)
    $$ vcat [    space
-             $$ text "executable:" <+> text name
+             $$ (text "executable:" <+> disp name)
              $$ ppBuildInfo bi
            | (name, bi) <- ex_bis ]
   where

Cabal/Distribution/Parsec/Class.hs

@@ -34,7 +34,9 @@ import           Distribution.License                         (License (..))
 import           Distribution.ModuleName                      (ModuleName)
 import qualified Distribution.ModuleName                      as ModuleName
 import           Distribution.Package
-                 (Dependency (..), PackageName, mkPackageName)
+                 (Dependency (..),
+                 UnqualComponentName, mkUnqualComponentName,
+                 PackageName, mkPackageName)
 import           Distribution.System
                  (Arch (..), ClassificationStrictness (..), OS (..),
                  classifyArch, classifyOS)
@@ -86,14 +88,22 @@ parsecWarning t w =
 
 -- TODO: use lexemeParsec
 
+-- TODO avoid String
+parsecUnqualComponentName :: P.Stream s Identity Char => P.Parsec s [PWarning] String
+parsecUnqualComponentName = intercalate "-" <$> P.sepBy1 component (P.char '-')
+  where
+    component :: P.Stream s Identity Char => P.Parsec s [PWarning] String
+    component = do
+      cs <- P.munch1 isAlphaNum
+      if all isDigit cs
+        then fail "all digits in portion of unqualified component name"
+        else return cs
+
+instance Parsec UnqualComponentName where