Skip to content

Commit 761abbf

Browse files
Ericson2314Ericson2314
committed
WIP yak introducing UnqualComponentName
1 parent c837c05 commit 761abbf

30 files changed

+271
-211
lines changed

‎Cabal/Distribution/Backpack/ComponentsGraph.hs‎

Lines changed: 11 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -51,24 +51,22 @@ toComponentsGraph enabled pkg_descr =
5151
where
5252
-- The dependencies for the given component
5353
componentDeps component =
54-
[ CExeName toolname | Dependency pkgname _
55-
<- buildTools bi
56-
, let toolname = unPackageName pkgname
57-
, toolname `elem` map exeName
58-
(executables pkg_descr) ]
54+
[ CExeName toolname
55+
| Dependency pkgname _ <- buildTools bi
56+
, let toolname = packageNameToUnqualComponentName pkgname
57+
, toolname `elem` map exeName (executables pkg_descr) ]
5958

6059
++ [ if pkgname == packageName pkg_descr
61-
then CLibName
62-
else CSubLibName toolname
63-
| Dependency pkgname _
64-
<- targetBuildDepends bi
65-
, pkgname `elem` internalPkgDeps
66-
, let toolname = unPackageName pkgname ]
60+
then CLibName
61+
else CSubLibName toolname
62+
| Dependency pkgname _ <- targetBuildDepends bi
63+
, let toolname = packageNameToUnqualComponentName pkgname
64+
, toolname `elem` internalPkgDeps ]
6765
where
6866
bi = componentBuildInfo component
6967
internalPkgDeps = map (conv . libName) (allLibraries pkg_descr)
70-
conv Nothing = packageName pkg_descr
71-
conv (Just s) = mkPackageName s
68+
conv Nothing = packageNameToUnqualComponentName $ packageName pkg_descr
69+
conv (Just s) = s
7270

7371
-- | Error message when there is a cycle; takes the SCC of components.
7472
componentCycleMsg :: [ComponentName] -> Doc

‎Cabal/Distribution/Backpack/ConfiguredComponent.hs‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -103,7 +103,7 @@ mkConfiguredComponent this_pid this_cid lib_deps exe_deps component =
103103

104104
type ConfiguredComponentMap =
105105
(Map PackageName (ComponentId, PackageId), -- libraries
106-
Map String ComponentId) -- executables
106+
Map UnqualComponentName ComponentId) -- executables
107107

108108
-- Executable map must be different because an executable can
109109
-- have the same name as a library. Ew.
@@ -140,7 +140,7 @@ toConfiguredComponent pkg_descr this_cid
140140
= Map.toList external_lib_map
141141
exe_deps = [ cid
142142
| Dependency pkgname _ <- buildTools bi
143-
, let name = unPackageName pkgname
143+
, let name = packageNameToUnqualComponentName pkgname
144144
, Just cid <- [ Map.lookup name exe_map ] ]
145145

146146
-- | Also computes the 'ComponentId', and sets cc_public if necessary.
@@ -182,7 +182,8 @@ extendConfiguredComponentMap cc (lib_map, exe_map) =
182182
Map.insert (pkgName (cc_pkgid cc))
183183
(cc_cid cc, cc_pkgid cc) lib_map
184184
CSubLibName str ->
185-
Map.insert (mkPackageName str)
185+
-- TODO roundtrip
186+
Map.insert (mkPackageName $ unUnqualComponentName str)
186187
(cc_cid cc, cc_pkgid cc) lib_map
187188
_ -> lib_map
188189
exe_map'

‎Cabal/Distribution/Backpack/Id.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -63,7 +63,7 @@ computeComponentId mb_ipid mb_cid pid cname mb_details =
6363
NoFlag -> mkComponentId $ actual_base
6464
++ (case componentNameString cname of
6565
Nothing -> ""
66-
Just s -> "-" ++ s)
66+
Just s -> "-" ++ unUnqualComponentName s)
6767

6868
-- | Computes the package name for a library. If this is the public
6969
-- library, it will just be the original package name; otherwise,
@@ -102,7 +102,8 @@ computeCompatPackageName pkg_name CLibName = pkg_name
102102
computeCompatPackageName pkg_name cname
103103
= mkPackageName $ "z-" ++ zdashcode (display pkg_name)
104104
++ (case componentNameString cname of
105-
Just cname_str -> "-z-" ++ zdashcode cname_str
105+
Just cname_u -> "-z-" ++ zdashcode cname_str
106+
where cname_str = unUnqualComponentName cname_u
106107
Nothing -> "")
107108

108109
zdashcode :: String -> String

‎Cabal/Distribution/Package.hs‎

Lines changed: 47 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,8 @@
1818

1919
module Distribution.Package (
2020
-- * Package ids
21-
PackageName, unPackageName, mkPackageName,
21+
UnqualComponentName, unUnqualComponentName, mkUnqualComponentName,
22+
PackageName, unPackageName, mkPackageName, packageNameToUnqualComponentName,
2223
PackageIdentifier(..),
2324
PackageId,
2425

@@ -69,6 +70,44 @@ import Distribution.ModuleName
6970

7071
import Text.PrettyPrint ((<+>), text)
7172

73+
-- | A Component name, or other similarly-parsed identifier.
74+
--
75+
newtype UnqualComponentName = UnqualComponentName ShortText
76+
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data,
77+
Semigroup, Monoid) -- TODO: bad enabler of bad monoids
78+
79+
-- | Convert 'UnqualComponentName' to 'String'
80+
unUnqualComponentName :: UnqualComponentName -> String
81+
unUnqualComponentName (UnqualComponentName s) = fromShortText s
82+
83+
-- | Construct a 'UnqualComponentName' from a 'String'
84+
--
85+
-- 'mkUnqualComponentName' is the inverse to 'unUnqualComponentName'
86+
--
87+
-- Note: No validations are performed to ensure that the resulting
88+
-- 'UnqualComponentName' is valid
89+
--
90+
-- @since 2.0
91+
mkUnqualComponentName :: String -> UnqualComponentName
92+
mkUnqualComponentName = UnqualComponentName . toShortText
93+
94+
instance Binary UnqualComponentName
95+
96+
instance Text UnqualComponentName where
97+
disp = Disp.text . unUnqualComponentName
98+
parse = do
99+
ns <- Parse.sepBy1 component (Parse.char '-')
100+
return (mkUnqualComponentName (intercalate "-" ns))
101+
where
102+
component = do
103+
cs <- Parse.munch1 isAlphaNum
104+
if all isDigit cs then Parse.pfail else return cs
105+
-- each component must contain an alphabetic character, to avoid
106+
-- ambiguity in identifiers like foo-1 (the 1 is the version number).
107+
108+
instance NFData UnqualComponentName where
109+
rnf (UnqualComponentName pkg) = rnf pkg
110+
72111
-- | A package name.
73112
--
74113
-- Use 'mkPackageName' and 'unPackageName' to convert from/to a
@@ -77,12 +116,15 @@ import Text.PrettyPrint ((<+>), text)
77116
-- This type is opaque since @Cabal-2.0@
78117
--
79118
-- @since 2.0
80-
newtype PackageName = PackageName ShortText
81-
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
119+
newtype PackageName = PackageName UnqualComponentName
120+
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data,
121+
Binary, Text, NFData)
122+
123+
packageNameToUnqualComponentName (PackageName n) = n
82124

83125
-- | Convert 'PackageName' to 'String'
84126
unPackageName :: PackageName -> String
85-
unPackageName (PackageName s) = fromShortText s
127+
unPackageName = unUnqualComponentName . packageNameToUnqualComponentName
86128

87129
-- | Construct a 'PackageName' from a 'String'
88130
--
@@ -93,24 +135,7 @@ unPackageName (PackageName s) = fromShortText s
93135
--
94136
-- @since 2.0
95137
mkPackageName :: String -> PackageName
96-
mkPackageName = PackageName . toShortText
97-
98-
instance Binary PackageName
99-
100-
instance Text PackageName where
101-
disp = Disp.text . unPackageName
102-
parse = do
103-
ns <- Parse.sepBy1 component (Parse.char '-')
104-
return (mkPackageName (intercalate "-" ns))
105-
where
106-
component = do
107-
cs <- Parse.munch1 isAlphaNum
108-
if all isDigit cs then Parse.pfail else return cs
109-
-- each component must contain an alphabetic character, to avoid
110-
-- ambiguity in identifiers like foo-1 (the 1 is the version number).
111-
112-
instance NFData PackageName where
113-
rnf (PackageName pkg) = rnf pkg
138+
mkPackageName = PackageName . mkUnqualComponentName
114139

115140
-- | Type alias so we can use the shorter name PackageId.
116141
type PackageId = PackageIdentifier

‎Cabal/Distribution/PackageDescription/Check.hs‎

Lines changed: 14 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -184,13 +184,15 @@ checkSanity pkg =
184184
++ "Only the non-internal library can have the same name as the package."
185185

186186
, check (not (null duplicateNames)) $
187-
PackageBuildImpossible $ "Duplicate sections: " ++ commaSep duplicateNames
187+
PackageBuildImpossible $ "Duplicate sections: "
188+
++ commaSep (unUnqualComponentName <$> duplicateNames)
188189
++ ". The name of every library, executable, test suite,"
189190
++ " and benchmark section in"
190191
++ " the package must be unique."
191192

192193
-- NB: but it's OK for executables to have the same name!
193-
, check (any (== display (packageName pkg)) subLibNames) $
194+
-- TODO shouldn't need to compare on the string level
195+
, check (any (== display (packageName pkg)) (display <$> subLibNames)) $
194196
PackageBuildImpossible $ "Illegal internal library name "
195197
++ display (packageName pkg)
196198
++ ". Internal libraries cannot have the same name as the package."
@@ -238,7 +240,7 @@ checkLibrary pkg lib =
238240
PackageDistSuspiciousWarn $
239241
"Library " ++ (case libName lib of
240242
Nothing -> ""
241-
Just n -> n
243+
Just n -> display n
242244
) ++ "does not expose any modules"
243245

244246
-- check use of signatures sections
@@ -272,7 +274,7 @@ checkExecutable pkg exe =
272274

273275
check (null (modulePath exe)) $
274276
PackageBuildImpossible $
275-
"No 'main-is' field found for executable " ++ exeName exe
277+
"No 'main-is' field found for executable " ++ display (exeName exe)
276278

277279
, check (not (null (modulePath exe))
278280
&& (not $ fileExtensionSupportedLanguage $ modulePath exe)) $
@@ -290,14 +292,14 @@ checkExecutable pkg exe =
290292

291293
, check (not (null moduleDuplicates)) $
292294
PackageBuildImpossible $
293-
"Duplicate modules in executable '" ++ exeName exe ++ "': "
295+
"Duplicate modules in executable '" ++ display (exeName exe) ++ "': "
294296
++ commaSep (map display moduleDuplicates)
295297

296298
-- check that all autogen-modules appear on other-modules
297299
, check
298300
(not $ and $ map (flip elem (exeModules exe)) (exeModulesAutogen exe)) $
299301
PackageBuildImpossible $
300-
"On executable '" ++ exeName exe ++ "' an 'autogen-module' is not "
302+
"On executable '" ++ display (exeName exe) ++ "' an 'autogen-module' is not "
301303
++ "on 'other-modules'"
302304

303305
]
@@ -324,7 +326,7 @@ checkTestSuite pkg test =
324326

325327
, check (not $ null moduleDuplicates) $
326328
PackageBuildImpossible $
327-
"Duplicate modules in test suite '" ++ testName test ++ "': "
329+
"Duplicate modules in test suite '" ++ display (testName test) ++ "': "
328330
++ commaSep (map display moduleDuplicates)
329331

330332
, check mainIsWrongExt $
@@ -345,7 +347,7 @@ checkTestSuite pkg test =
345347
(testModulesAutogen test)
346348
) $
347349
PackageBuildImpossible $
348-
"On test suite '" ++ testName test ++ "' an 'autogen-module' is not "
350+
"On test suite '" ++ display (testName test) ++ "' an 'autogen-module' is not "
349351
++ "on 'other-modules'"
350352
]
351353
where
@@ -379,7 +381,7 @@ checkBenchmark _pkg bm =
379381

380382
, check (not $ null moduleDuplicates) $
381383
PackageBuildImpossible $
382-
"Duplicate modules in benchmark '" ++ benchmarkName bm ++ "': "
384+
"Duplicate modules in benchmark '" ++ display (benchmarkName bm) ++ "': "
383385
++ commaSep (map display moduleDuplicates)
384386

385387
, check mainIsWrongExt $
@@ -394,7 +396,7 @@ checkBenchmark _pkg bm =
394396
(benchmarkModulesAutogen bm)
395397
) $
396398
PackageBuildImpossible $
397-
"On benchmark '" ++ benchmarkName bm ++ "' an 'autogen-module' is "
399+
"On benchmark '" ++ display (benchmarkName bm) ++ "' an 'autogen-module' is "
398400
++ "not on 'other-modules'"
399401
]
400402
where
@@ -551,7 +553,8 @@ checkFields pkg =
551553
, isNoVersion vr ]
552554

553555
internalLibraries =
554-
map (maybe (packageName pkg) mkPackageName . libName)
556+
-- TODO, avoid around trip
557+
map (maybe (packageName pkg) (mkPackageName . unUnqualComponentName) . libName)
555558
(allLibraries pkg)
556559
buildDependsRangeOnInternalLibrary =
557560
[ dep

‎Cabal/Distribution/PackageDescription/Configuration.hs‎

Lines changed: 16 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -450,8 +450,8 @@ constrainBy left extra =
450450
-- dependencies as we go.
451451
flattenTaggedTargets :: TargetSet PDTagged ->
452452
(Maybe Library
453-
, [(String, Library)], [(String, Executable)], [(String, TestSuite)]
454-
, [(String, Benchmark)])
453+
, [(UnqualComponentName, Library)], [(UnqualComponentName, Executable)]
454+
, [(UnqualComponentName, TestSuite)], [(UnqualComponentName, Benchmark)])
455455
flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, [], [], [], []) targets
456456
where
457457
untag (_, Lib _) (Just _, _, _, _, _) = userBug "Only one library expected"
@@ -463,7 +463,7 @@ flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, [], [], [], [])
463463
}
464464
untag (deps, SubLib n l) (mb_lib, libs, exes, tests, bms)
465465
| any ((== n) . fst) libs =
466-
userBug $ "There exist several libs with the same name: '" ++ n ++ "'"
466+
userBug $ "There exist several libs with the same name: '" ++ unUnqualComponentName n ++ "'"
467467
-- NB: libraries live in a different namespace than everything else
468468
-- TODO: no, (new-style) TESTS live in same namespace!!
469469
| otherwise = (mb_lib, (n, l'):libs, exes, tests, bms)
@@ -473,23 +473,23 @@ flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, [], [], [], [])
473473
}
474474
untag (deps, Exe n e) (mb_lib, libs, exes, tests, bms)
475475
| any ((== n) . fst) exes =
476-
userBug $ "There exist several exes with the same name: '" ++ n ++ "'"
476+
userBug $ "There exist several exes with the same name: '" ++ unUnqualComponentName n ++ "'"
477477
| any ((== n) . fst) tests =
478-
userBug $ "There exists a test with the same name as an exe: '" ++ n ++ "'"
478+
userBug $ "There exists a test with the same name as an exe: '" ++ unUnqualComponentName n ++ "'"
479479
| any ((== n) . fst) bms =
480-
userBug $ "There exists a benchmark with the same name as an exe: '" ++ n ++ "'"
480+
userBug $ "There exists a benchmark with the same name as an exe: '" ++ unUnqualComponentName n ++ "'"
481481
| otherwise = (mb_lib, libs, (n, e'):exes, tests, bms)
482482
where
483483
e' = e {
484484
buildInfo = (buildInfo e) { targetBuildDepends = fromDepMap deps }
485485
}
486486
untag (deps, Test n t) (mb_lib, libs, exes, tests, bms)
487487
| any ((== n) . fst) tests =
488-
userBug $ "There exist several tests with the same name: '" ++ n ++ "'"
488+
userBug $ "There exist several tests with the same name: '" ++ unUnqualComponentName n ++ "'"
489489
| any ((== n) . fst) exes =
490-
userBug $ "There exists an exe with the same name as the test: '" ++ n ++ "'"
490+
userBug $ "There exists an exe with the same name as the test: '" ++ unUnqualComponentName n ++ "'"
491491
| any ((== n) . fst) bms =
492-
userBug $ "There exists a benchmark with the same name as the test: '" ++ n ++ "'"
492+
userBug $ "There exists a benchmark with the same name as the test: '" ++ unUnqualComponentName n ++ "'"
493493
| otherwise = (mb_lib, libs, exes, (n, t'):tests, bms)
494494
where
495495
t' = t {
@@ -498,11 +498,11 @@ flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, [], [], [], [])
498498
}
499499
untag (deps, Bench n b) (mb_lib, libs, exes, tests, bms)
500500
| any ((== n) . fst) bms =
501-
userBug $ "There exist several benchmarks with the same name: '" ++ n ++ "'"
501+
userBug $ "There exist several benchmarks with the same name: '" ++ unUnqualComponentName n ++ "'"
502502
| any ((== n) . fst) exes =
503-
userBug $ "There exists an exe with the same name as the benchmark: '" ++ n ++ "'"
503+
userBug $ "There exists an exe with the same name as the benchmark: '" ++ unUnqualComponentName n ++ "'"
504504
| any ((== n) . fst) tests =
505-
userBug $ "There exists a test with the same name as the benchmark: '" ++ n ++ "'"
505+
userBug $ "There exists a test with the same name as the benchmark: '" ++ unUnqualComponentName n ++ "'"
506506
| otherwise = (mb_lib, libs, exes, tests, (n, b'):bms)
507507
where
508508
b' = b {
@@ -520,10 +520,10 @@ flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, [], [], [], [])
520520
-- data PDTagged = PDComp Component
521521
-- | PDNull
522522
data PDTagged = Lib Library
523-
| SubLib String Library
524-
| Exe String Executable
525-
| Test String TestSuite
526-
| Bench String Benchmark
523+
| SubLib UnqualComponentName Library
524+
| Exe UnqualComponentName Executable
525+
| Test UnqualComponentName TestSuite
526+
| Bench UnqualComponentName Benchmark
527527
| PDNull
528528
deriving Show
529529

0 commit comments

Comments
 (0)