Commit 9a00d302 authored by Oleg Grenrus's avatar Oleg Grenrus

Remove Text type-class

parent 70041401
......@@ -23,7 +23,7 @@ import System.FilePath.Posix
( (</>) )
import qualified Distribution.Client.BuildReports.Anonymous as BuildReport
import Distribution.Client.BuildReports.Anonymous (BuildReport, showBuildReport)
import Distribution.Deprecated.Text (display)
import Distribution.Pretty (prettyShow)
import Distribution.Verbosity (Verbosity)
import Distribution.Simple.Utils (die')
import Distribution.Client.HttpUtils
......@@ -43,7 +43,7 @@ uploadReports verbosity repoCtxt auth uri reports = do
postBuildReport :: Verbosity -> RepoContext -> (String, String) -> URI -> BuildReport -> IO BuildReportId
postBuildReport verbosity repoCtxt auth uri buildReport = do
let fullURI = uri { uriPath = "/package" </> display (BuildReport.package buildReport) </> "reports" }
let fullURI = uri { uriPath = "/package" </> prettyShow (BuildReport.package buildReport) </> "reports" }
transport <- repoContextGetTransport repoCtxt
res <- postHttp transport verbosity fullURI (showBuildReport buildReport) (Just auth)
case res of
......@@ -53,7 +53,7 @@ postBuildReport verbosity repoCtxt auth uri buildReport = do
{-
setAllowRedirects False
(_, response) <- request Request {
rqURI = uri { uriPath = "/package" </> display (BuildReport.package buildReport) </> "reports" },
rqURI = uri { uriPath = "/package" </> prettyShow (BuildReport.package buildReport) </> "reports" },
rqMethod = POST,
rqHeaders = [Header HdrContentType ("text/plain"),
Header HdrContentLength (show (length body)),
......
......@@ -23,8 +23,8 @@ import Distribution.Simple.Setup
( HaddockFlags, TestFlags, BenchmarkFlags, fromFlagOrDefault )
import Distribution.Simple.Command
( CommandUI(..), usageAlternatives )
import Distribution.Deprecated.Text
( display )
import Distribution.Pretty
( prettyShow )
import Distribution.Verbosity
( Verbosity, normal )
import Distribution.Simple.Utils
......@@ -235,7 +235,7 @@ renderTargetProblem (TargetProblemComponentNotBenchmark pkgid cname) =
"The bench command is for running benchmarks, but the target '"
++ showTargetSelector targetSelector ++ "' refers to "
++ renderTargetSelector targetSelector ++ " from the package "
++ display pkgid ++ "."
++ prettyShow pkgid ++ "."
where
targetSelector = TargetComponent pkgid cname WholeComponent
......
......@@ -22,8 +22,8 @@ import Distribution.Types.LibraryName
( LibraryName(..) )
import Distribution.Solver.Types.OptionalStanza
( OptionalStanza(..) )
import Distribution.Deprecated.Text
( display )
import Distribution.Pretty
( prettyShow )
import qualified Data.List.NonEmpty as NE
import Data.Function (on)
......@@ -74,7 +74,7 @@ renderListSemiAnd (x:xs) = x ++ "; " ++ renderListSemiAnd xs
-- things, e.g. grouping components by package name
--
-- > renderListSemiAnd
-- > [ "the package " ++ display pkgname ++ " components "
-- > [ "the package " ++ prettyShow pkgname ++ " components "
-- > ++ renderListCommaAnd showComponentName components
-- > | (pkgname, components) <- sortGroupOn packageName allcomponents ]
--
......@@ -91,19 +91,19 @@ sortGroupOn key = map (\(x:|xs) -> (key x, x:xs))
renderTargetSelector :: TargetSelector -> String
renderTargetSelector (TargetPackage _ pkgids Nothing) =
"the " ++ plural (listPlural pkgids) "package" "packages" ++ " "
++ renderListCommaAnd (map display pkgids)
++ renderListCommaAnd (map prettyShow pkgids)
renderTargetSelector (TargetPackage _ pkgids (Just kfilter)) =
"the " ++ renderComponentKind Plural kfilter
++ " in the " ++ plural (listPlural pkgids) "package" "packages" ++ " "
++ renderListCommaAnd (map display pkgids)
++ renderListCommaAnd (map prettyShow pkgids)
renderTargetSelector (TargetPackageNamed pkgname Nothing) =
"the package " ++ display pkgname
"the package " ++ prettyShow pkgname
renderTargetSelector (TargetPackageNamed pkgname (Just kfilter)) =
"the " ++ renderComponentKind Plural kfilter
++ " in the package " ++ display pkgname
++ " in the package " ++ prettyShow pkgname
renderTargetSelector (TargetAllPackages Nothing) =
"all the packages in the project"
......@@ -117,8 +117,8 @@ renderTargetSelector (TargetComponent pkgid cname subtarget) =
++ renderComponentName (packageName pkgid) cname
renderTargetSelector (TargetComponentUnknown pkgname (Left ucname) subtarget) =
renderSubComponentTarget subtarget ++ "the component " ++ display ucname
++ " in the package " ++ display pkgname
renderSubComponentTarget subtarget ++ "the component " ++ prettyShow ucname
++ " in the package " ++ prettyShow pkgname
renderTargetSelector (TargetComponentUnknown pkgname (Right cname) subtarget) =
renderSubComponentTarget subtarget ++ "the "
......@@ -129,7 +129,7 @@ renderSubComponentTarget WholeComponent = ""
renderSubComponentTarget (FileTarget filename) =
"the file " ++ filename ++ "in "
renderSubComponentTarget (ModuleTarget modname) =
"the module" ++ display modname ++ "in "
"the module" ++ prettyShow modname ++ "in "
renderOptionalStanza :: Plural -> OptionalStanza -> String
......@@ -169,12 +169,12 @@ targetSelectorFilter TargetComponent{} = Nothing
targetSelectorFilter TargetComponentUnknown{} = Nothing
renderComponentName :: PackageName -> ComponentName -> String
renderComponentName pkgname (CLibName LMainLibName) = "library " ++ display pkgname
renderComponentName _ (CLibName (LSubLibName name)) = "library " ++ display name
renderComponentName _ (CFLibName name) = "foreign library " ++ display name
renderComponentName _ (CExeName name) = "executable " ++ display name
renderComponentName _ (CTestName name) = "test suite " ++ display name
renderComponentName _ (CBenchName name) = "benchmark " ++ display name
renderComponentName pkgname (CLibName LMainLibName) = "library " ++ prettyShow pkgname
renderComponentName _ (CLibName (LSubLibName name)) = "library " ++ prettyShow name
renderComponentName _ (CFLibName name) = "foreign library " ++ prettyShow name
renderComponentName _ (CExeName name) = "executable " ++ prettyShow name
renderComponentName _ (CTestName name) = "test suite " ++ prettyShow name
renderComponentName _ (CBenchName name) = "benchmark " ++ prettyShow name
renderComponentKind :: Plural -> ComponentKind -> String
renderComponentKind Singular ckind = case ckind of
......@@ -197,19 +197,19 @@ renderComponentKind Plural ckind = case ckind of
renderTargetProblemCommon :: String -> TargetProblemCommon -> String
renderTargetProblemCommon verb (TargetNotInProject pkgname) =
"Cannot " ++ verb ++ " the package " ++ display pkgname ++ ", it is not "
"Cannot " ++ verb ++ " the package " ++ prettyShow pkgname ++ ", it is not "
++ "in this project (either directly or indirectly). If you want to add it "
++ "to the project then edit the cabal.project file."
renderTargetProblemCommon verb (TargetAvailableInIndex pkgname) =
"Cannot " ++ verb ++ " the package " ++ display pkgname ++ ", it is not "
"Cannot " ++ verb ++ " the package " ++ prettyShow pkgname ++ ", it is not "
++ "in this project (either directly or indirectly), but it is in the current "
++ "package index. If you want to add it to the project then edit the "
++ "cabal.project file."
renderTargetProblemCommon verb (TargetComponentNotProjectLocal pkgid cname _) =
"Cannot " ++ verb ++ " the " ++ showComponentName cname ++ " because the "
++ "package " ++ display pkgid ++ " is not local to the project, and cabal "
++ "package " ++ prettyShow pkgid ++ " is not local to the project, and cabal "
++ "does not currently support building test suites or benchmarks of "
++ "non-local dependencies. To run test suites or benchmarks from "
++ "dependencies you can unpack the package locally and adjust the "
......@@ -217,7 +217,7 @@ renderTargetProblemCommon verb (TargetComponentNotProjectLocal pkgid cname _) =
renderTargetProblemCommon verb (TargetComponentNotBuildable pkgid cname _) =
"Cannot " ++ verb ++ " the " ++ showComponentName cname ++ " because it is "
++ "marked as 'buildable: False' within the '" ++ display (packageName pkgid)
++ "marked as 'buildable: False' within the '" ++ prettyShow (packageName pkgid)
++ ".cabal' file (at least for the current configuration). If you believe it "
++ "should be buildable then check the .cabal file to see if the buildable "
++ "property is conditional on flags. Alternatively you may simply have to "
......@@ -240,7 +240,7 @@ renderTargetProblemCommon verb (TargetOptionalStanzaDisabledByUser _ cname _) =
renderTargetProblemCommon verb (TargetOptionalStanzaDisabledBySolver pkgid cname _) =
"Cannot " ++ verb ++ " the " ++ showComponentName cname ++ " because the "
++ "solver did not find a plan that included the " ++ compkinds
++ " for " ++ display pkgid ++ ". It is probably worth trying again with "
++ " for " ++ prettyShow pkgid ++ ". It is probably worth trying again with "
++ compkinds ++ " explicitly enabled in the configuration in the "
++ "cabal.project{.local} file. This will ask the solver to find a plan with "
++ "the " ++ compkinds ++ " available. It will either fail with an "
......@@ -253,9 +253,9 @@ renderTargetProblemCommon verb (TargetOptionalStanzaDisabledBySolver pkgid cname
renderTargetProblemCommon verb (TargetProblemUnknownComponent pkgname ecname) =
"Cannot " ++ verb ++ " the "
++ (case ecname of
Left ucname -> "component " ++ display ucname
Left ucname -> "component " ++ prettyShow ucname
Right cname -> renderComponentName pkgname cname)
++ " from the package " ++ display pkgname
++ " from the package " ++ prettyShow pkgname
++ ", because the package does not contain a "
++ (case ecname of
Left _ -> "component"
......@@ -264,13 +264,13 @@ renderTargetProblemCommon verb (TargetProblemUnknownComponent pkgname ecname) =
renderTargetProblemCommon verb (TargetProblemNoSuchPackage pkgid) =
"Internal error when trying to " ++ verb ++ " the package "
++ display pkgid ++ ". The package is not in the set of available targets "
++ prettyShow pkgid ++ ". The package is not in the set of available targets "
++ "for the project plan, which would suggest an inconsistency "
++ "between readTargetSelectors and resolveTargets."
renderTargetProblemCommon verb (TargetProblemNoSuchComponent pkgid cname) =
"Internal error when trying to " ++ verb ++ " the "
++ showComponentName cname ++ " from the package " ++ display pkgid
++ showComponentName cname ++ " from the package " ++ prettyShow pkgid
++ ". The package,component pair is not in the set of available targets "
++ "for the project plan, which would suggest an inconsistency "
++ "between readTargetSelectors and resolveTargets."
......@@ -385,9 +385,9 @@ renderCannotPruneDependencies (CannotPruneDependencies brokenPackages) =
"Cannot select only the dependencies (as requested by the "
++ "'--only-dependencies' flag), "
++ (case pkgids of
[pkgid] -> "the package " ++ display pkgid ++ " is "
[pkgid] -> "the package " ++ prettyShow pkgid ++ " is "
_ -> "the packages "
++ renderListCommaAnd (map display pkgids) ++ " are ")
++ renderListCommaAnd (map prettyShow pkgids) ++ " are ")
++ "required by a dependency of one of the other targets."
where
-- throw away the details and just list the deps that are needed
......
......@@ -124,8 +124,8 @@ import Distribution.Simple.Utils
, ordNub )
import Distribution.Utils.Generic
( safeHead, writeFileAtomic )
import Distribution.Deprecated.Text
( simpleParse )
import Distribution.Parsec
( simpleParsec )
import Distribution.Pretty
( prettyShow )
......@@ -235,7 +235,7 @@ installAction ( configFlags, configExFlags, installFlags
(targetStrings'', packageIds) =
partitionEithers .
flip fmap targetStrings' $
\str -> case simpleParse str of
\str -> case simpleParsec str of
Just (pkgId :: PackageId)
| pkgVersion pkgId /= nullVersion -> Right pkgId
_ -> Left str
......
......@@ -87,8 +87,6 @@ import Distribution.Types.Version
( mkVersion )
import Distribution.Types.VersionRange
( anyVersion )
import Distribution.Deprecated.Text
( display )
import Distribution.Utils.Generic
( safeHead )
import Distribution.Verbosity
......@@ -568,7 +566,7 @@ renderTargetProblem (TargetProblemMatchesMultiple targetSelector targets) =
++ renderListSemiAnd
[ "the " ++ renderComponentKind Plural ckind ++ " " ++
renderListCommaAnd
[ maybe (display pkgname) display (componentNameString cname)
[ maybe (prettyShow pkgname) prettyShow (componentNameString cname)
| t <- ts
, let cname = availableTargetComponentName t
pkgname = packageName (availableTargetPackageId t)
......
......@@ -37,9 +37,9 @@ import Distribution.Simple.Command
( CommandUI(..), usageAlternatives )
import Distribution.Types.ComponentName
( showComponentName )
import Distribution.Deprecated.Text
( display )
import Distribution.CabalSpecVersion (CabalSpecVersion (..))
import Distribution.Pretty
( prettyShow )
import Distribution.CabalSpecVersion (CabalSpecVersion (..), cabalSpecLatest)
import Distribution.Verbosity
( Verbosity, normal )
import Distribution.Simple.Utils
......@@ -65,8 +65,6 @@ import Distribution.Simple.Program.Run
import Distribution.Types.UnitId
( UnitId )
import Distribution.CabalSpecVersion
( cabalSpecLatest )
import Distribution.Client.Types
( PackageLocation(..), PackageSpecifier(..) )
import Distribution.FieldGrammar
......@@ -275,17 +273,17 @@ runAction ( configFlags, configExFlags, installFlags
[] -> die' verbosity $ "Unknown executable "
++ exeName
++ " in package "
++ display selectedUnitId
++ prettyShow selectedUnitId
[elabPkg] -> do
info verbosity $ "Selecting "
++ display selectedUnitId
++ prettyShow selectedUnitId
++ " to supply " ++ exeName
return elabPkg
elabPkgs -> die' verbosity
$ "Multiple matching executables found matching "
++ exeName
++ ":\n"
++ unlines (fmap (\p -> " - in package " ++ display (elabUnitId p)) elabPkgs)
++ unlines (fmap (\p -> " - in package " ++ prettyShow (elabUnitId p)) elabPkgs)
let exePath = binDirectoryFor (distDirLayout baseCtx)
(elaboratedShared buildCtx)
pkg
......@@ -617,7 +615,7 @@ renderTargetProblem (TargetProblemComponentNotExe pkgid cname) =
"The run command is for running executables, but the target '"
++ showTargetSelector targetSelector ++ "' refers to "
++ renderTargetSelector targetSelector ++ " from the package "
++ display pkgid ++ "."
++ prettyShow pkgid ++ "."
where
targetSelector = TargetComponent pkgid cname WholeComponent
......
......@@ -25,8 +25,8 @@ import Distribution.Simple.Command
( CommandUI(..), usageAlternatives )
import Distribution.Simple.Flag
( Flag(..) )
import Distribution.Deprecated.Text
( display )
import Distribution.Pretty
( prettyShow )
import Distribution.Verbosity
( Verbosity, normal )
import Distribution.Simple.Utils
......@@ -264,7 +264,7 @@ renderTargetProblem (TargetProblemComponentNotTest pkgid cname) =
"The test command is for running test suites, but the target '"
++ showTargetSelector targetSelector ++ "' refers to "
++ renderTargetSelector targetSelector ++ " from the package "
++ display pkgid ++ "."
++ prettyShow pkgid ++ "."
where
targetSelector = TargetComponent pkgid cname WholeComponent
......
......@@ -46,6 +46,9 @@ module Distribution.Client.Config (
postProcessRepo,
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Language.Haskell.Extension ( Language(Haskell2010) )
import Distribution.Deprecated.ViewAsFieldDescr
......@@ -95,7 +98,7 @@ import Distribution.Deprecated.ParseUtils
, readFields, warning, lineNo
, simpleField, listField, spaceListField
, parseFilePathQ, parseOptCommaList, parseTokenQ, syntaxError
, simpleFieldParsec
, simpleFieldParsec, listFieldParsec
)
import Distribution.Client.ParseUtils
( parseFields, ppFields, ppSection )
......@@ -103,8 +106,6 @@ import Distribution.Client.HttpUtils
( isOldHackageURI )
import qualified Distribution.Deprecated.ParseUtils as ParseUtils
( Field(..) )
import qualified Distribution.Deprecated.Text as Text
( Text(..), display )
import Distribution.Simple.Command
( CommandUI(commandOptions), commandDefaultFlags, ShowOrParseArgs(..) )
import Distribution.Simple.Program
......@@ -122,18 +123,13 @@ import qualified Distribution.Compat.CharParsing as P
import Distribution.Solver.Types.ConstraintSource
import Data.List
( partition, find, foldl', nubBy )
import Data.Maybe
( fromMaybe )
import Control.Monad
( when, unless, foldM, liftM )
( partition )
import qualified Distribution.Deprecated.ReadP as Parse
( (<++), option )
import Distribution.Compat.Semigroup
import qualified Text.PrettyPrint as Disp
( render, text, empty )
import Distribution.Parsec (parsec, simpleParsec, parsecOptCommaList)
import Distribution.Pretty (pretty)
import Distribution.Pretty (pretty, prettyShow)
import Text.PrettyPrint
( ($+$) )
import Text.PrettyPrint.HughesPJ
......@@ -150,12 +146,9 @@ import Distribution.Compat.Environment
( getEnvironment, lookupEnv )
import Distribution.Compat.Exception
( catchIO )
import Data.Char
( isSpace )
import qualified Data.Map as M
import Data.Function
( on )
import GHC.Generics ( Generic )
--
-- * Configuration saved in the config file
......@@ -826,8 +819,8 @@ writeConfigFile file comments vals = do
,"--"
,"-- This config file was generated using the following versions"
,"-- of Cabal and cabal-install:"
,"-- Cabal library version: " ++ Text.display cabalVersion
,"-- cabal-install version: " ++ Text.display cabalInstallVersion
,"-- Cabal library version: " ++ prettyShow cabalVersion
,"-- cabal-install version: " ++ prettyShow cabalInstallVersion
,"",""
]
......@@ -900,8 +893,8 @@ configFieldDescriptions src =
-- This is only here because viewAsFieldDescr gives us a parser
-- that only recognises 'ghc' etc, the case-sensitive flag names, not
-- what the normal case-insensitive parser gives us.
[simpleField "compiler"
(fromFlagOrDefault Disp.empty . fmap Text.disp) (optional Text.parse)
[simpleFieldParsec "compiler"
(fromFlagOrDefault Disp.empty . fmap pretty) (Flag <$> parsec <|> pure NoFlag)
configHcFlavor (\v flags -> flags { configHcFlavor = v })
-- TODO: The following is a temporary fix. The "optimization"
......@@ -965,14 +958,14 @@ configFieldDescriptions src =
[let pkgs = (Just . AllowOlder . RelaxDepsSome)
`fmap` parsecOptCommaList parsec
parseAllowOlder = ((Just . AllowOlder . toRelaxDeps)
`fmap` Text.parse) Parse.<++ pkgs
`fmap` parsec) Parse.<++ pkgs
in simpleField "allow-older"
(showRelaxDeps . fmap unAllowOlder) parseAllowOlder
configAllowOlder (\v flags -> flags { configAllowOlder = v })
,let pkgs = (Just . AllowNewer . RelaxDepsSome)
`fmap` parsecOptCommaList parsec
parseAllowNewer = ((Just . AllowNewer . toRelaxDeps)
`fmap` Text.parse) Parse.<++ pkgs
`fmap` parsec) Parse.<++ pkgs
in simpleField "allow-newer"
(showRelaxDeps . fmap unAllowNewer) parseAllowNewer
configAllowNewer (\v flags -> flags { configAllowNewer = v })
......@@ -1020,8 +1013,6 @@ configFieldDescriptions src =
name = fieldName field
replacement = find ((== name) . fieldName) replacements
, name `notElem` exclusions ]
optional = Parse.option mempty . fmap toFlag
showRelaxDeps Nothing = mempty
showRelaxDeps (Just rd) | isRelaxDeps rd = Disp.text "True"
......@@ -1036,7 +1027,7 @@ configFieldDescriptions src =
deprecatedFieldDescriptions :: [FieldDescr SavedConfig]
deprecatedFieldDescriptions =
[ liftGlobalFlag $
listField "repos"
listFieldParsec "repos"
pretty parsec
(fromNubList . globalRemoteRepos)
(\rs cfg -> cfg { globalRemoteRepos = toNubList rs })
......@@ -1342,8 +1333,8 @@ remoteRepoFields =
[ simpleField "url"
(text . show) (parseTokenQ >>= parseURI')
remoteRepoURI (\x repo -> repo { remoteRepoURI = x })
, simpleField "secure"
showSecure (Just `fmap` Text.parse)
, simpleFieldParsec "secure"
showSecure (Just `fmap` parsec)
remoteRepoSecure (\x repo -> repo { remoteRepoSecure = x })
, listField "root-keys"
text parseTokenQ
......
......@@ -81,7 +81,6 @@ import Distribution.Simple.Utils as Utils
, defaultPackageDesc )
import Distribution.System
( Platform )
import Distribution.Deprecated.Text ( display )
import Distribution.Verbosity as Verbosity
( Verbosity )
......@@ -279,7 +278,7 @@ checkConfigExFlags verbosity installedPkgIndex sourcePkgIndex flags = do
++ showConstraint h
forM_ (safeHead unknownPreferences) $ \h ->
warn verbosity $ "Preference refers to an unknown package: "
++ display h
++ prettyShow h
where
unknownConstraints = filter (unknown . userConstraintPackageName . fst) $
configExConstraints flags
......@@ -403,7 +402,7 @@ configurePackage verbosity platform comp scriptOptions configFlags
configIPID = if isJust (flagToMaybe (configIPID configFlags))
-- Make sure cabal configure --ipid works.
then configIPID configFlags
else toFlag (display ipid),
else toFlag (prettyShow ipid),
configConfigurationsFlags = flags,
-- We generate the legacy constraints as well as the new style precise
-- deps. In the end only one set gets passed to Setup.hs configure,
......
......@@ -100,8 +100,7 @@ import Distribution.Simple.Utils
( comparing )
import Distribution.Simple.Setup
( asBool )
import Distribution.Deprecated.Text
( display )
import Distribution.Pretty (prettyShow)
import Distribution.Verbosity
( normal, Verbosity )
import Distribution.Version
......@@ -184,7 +183,7 @@ data DepResolverParams = DepResolverParams {
showDepResolverParams :: DepResolverParams -> String
showDepResolverParams p =
"targets: " ++ intercalate ", " (map display $ Set.toList (depResolverTargets p))
"targets: " ++ intercalate ", " (map prettyShow $ Set.toList (depResolverTargets p))
++ "\nconstraints: "
++ concatMap (("\n " ++) . showLabeledConstraint)
(depResolverConstraints p)
......@@ -233,11 +232,11 @@ data PackagePreference =
--
showPackagePreference :: PackagePreference -> String
showPackagePreference (PackageVersionPreference pn vr) =
display pn ++ " " ++ display (simplifyVersionRange vr)
prettyShow pn ++ " " ++ prettyShow (simplifyVersionRange vr)
showPackagePreference (PackageInstalledPreference pn ip) =
display pn ++ " " ++ show ip
prettyShow pn ++ " " ++ show ip
showPackagePreference (PackageStanzasPreference pn st) =
display pn ++ " " ++ show st
prettyShow pn ++ " " ++ show st
basicDepResolverParams :: InstalledPackageIndex
-> PackageIndex.PackageIndex UnresolvedSourcePackage
......@@ -833,12 +832,12 @@ data PlanPackageProblem =
showPlanPackageProblem :: PlanPackageProblem -> String
showPlanPackageProblem (InvalidConfiguredPackage pkg packageProblems) =
"Package " ++ display (packageId pkg)
"Package " ++ prettyShow (packageId pkg)
++ " has an invalid configuration, in particular:\n"
++ unlines [ " " ++ showPackageProblem problem
| problem <- packageProblems ]
showPlanPackageProblem (DuplicatePackageSolverId pid dups) =
"Package " ++ display (packageId pid) ++ " has "
"Package " ++ prettyShow (packageId pid) ++ " has "
++ show (length dups) ++ " duplicate instances."
planPackagesProblems :: Platform -> CompilerInfo
......@@ -872,20 +871,20 @@ showPackageProblem (ExtraFlag flag) =
showPackageProblem (DuplicateDeps pkgids) =
"duplicate packages specified as selected dependencies: "
++ intercalate ", " (map display pkgids)
++ intercalate ", " (map prettyShow pkgids)
showPackageProblem (MissingDep dep) =
"the package has a dependency " ++ display dep
"the package has a dependency " ++ prettyShow dep
++ " but no package has been selected to satisfy it."
showPackageProblem (ExtraDep pkgid) =
"the package configuration specifies " ++ display pkgid
"the package configuration specifies " ++ prettyShow pkgid
++ " but (with the given flag assignment) the package does not actually"
++ " depend on any version of that package."
showPackageProblem (InvalidDep dep pkgid) =
"the package depends on " ++ display dep
++ " but the configuration specifies " ++ display pkgid
"the package depends on " ++ prettyShow dep
++ " but the configuration specifies " ++ prettyShow pkgid
++ " which does not satisfy the dependency."
-- | A 'ConfiguredPackage' is valid if the flag assignment is total and if
......@@ -1048,5 +1047,5 @@ data ResolveNoDepsError =
instance Show ResolveNoDepsError where
show (ResolveUnsatisfiable name ver) =
"There is no available version of " ++ display name
++ " that satisfies " ++ display (simplifyVersionRange ver)
"There is no available version of " ++ prettyShow name
++ " that satisfies " ++ prettyShow (simplifyVersionRange ver)
......@@ -30,7 +30,6 @@ import Distribution.Package
import Distribution.Compiler
import Distribution.Simple.Compiler
( PackageDB(..), PackageDBStack, OptimisationLevel(..) )
import Distribution.Deprecated.Text
import Distribution.Pretty
( prettyShow )
import Distribution.Types.ComponentName
......@@ -193,29 +192,29 @@ defaultDistDirLayout projectRoot mdistDirectory =
distBuildRootDirectory = distDirectory </> "build"
distBuildDirectory params =
distBuildRootDirectory </>
display (distParamPlatform params) </>
display (distParamCompilerId params) </>
display (distParamPackageId params) </>
prettyShow (distParamPlatform params) </>
prettyShow (distParamCompilerId params) </>
prettyShow (distParamPackageId params) </>
(case distParamComponentName params of
Nothing -> ""
Just (CLibName LMainLibName) -> ""
Just (CLibName (LSubLibName name)) -> "l" </> display name
Just (CFLibName name) -> "f" </> display name
Just (CExeName name) -> "x" </> display name
Just (CTestName name) -> "t" </> display name
Just (CBenchName name) -> "b" </> display name) </>
Just (CLibName (LSubLibName name)) -> "l" </> prettyShow name
Just (CFLibName name) -> "f" </> prettyShow name
Just (CExeName name) -> "x" </> prettyShow name
Just (CTestName name) -> "t" </> prettyShow name
Just (CBenchName name) -> "b" </> prettyShow name) </>
(case distParamOptimization params of
NoOptimisation -> "noopt"
NormalOptimisation -> ""
MaximumOptimisation -> "opt") </>
(let uid_str = display (distParamUnitId params)
in if uid_str == display (distParamComponentId params)
(let uid_str = prettyShow (distParamUnitId params)
in if uid_str == prettyShow (distParamComponentId params)
then ""
else uid_str)
distUnpackedSrcRootDirectory = distDirectory </> "src"
distUnpackedSrcDirectory pkgid = distUnpackedSrcRootDirectory
</> display pkgid
</> prettyShow pkgid
-- we shouldn't get name clashes so this should be fine:
distDownloadSrcDirectory = distUnpackedSrcRootDirectory
......@@ -233,7 +232,7 @@ defaultDistDirLayout projectRoot mdistDirectory =
distBinDirectory = distDirectory </> "bin"
distPackageDBPath compid = distDirectory </> "packagedb" </> display compid
distPackageDBPath compid = distDirectory </> "packagedb" </> prettyShow compid
distPackageDB = SpecificPackageDB . distPackageDBPath
......@@ -242,10 +241,10 @@ defaultStoreDirLayout storeRoot =
StoreDirLayout {..}
where
storeDirectory compid =
storeRoot </> display compid
storeRoot </> prettyShow compid