Commit be6a94a2 authored by John Ericson's avatar John Ericson Committed by John Ericson

Use new UnqualComponentName newtype instead of String

parent 453aa45a
......@@ -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
......
......@@ -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'
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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"
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
parsec = mkUnqualComponentName <$> parsecUnqualComponentName
instance Parsec PackageName where
-- todo
parsec = mkPackageName . intercalate "-" <$> P.sepBy1 component (P.char '-')
where
component :: P.Stream s Identity Char => P.Parsec s [PWarning] String
component = do
cs <- P.munch1 isAlphaNum