Skip to content

Commit c230d20

Browse files
committed
Fewer imports from PrettyPrint qualified as Disp
1 parent 115fcd2 commit c230d20

File tree

1 file changed

+20
-19
lines changed
  • cabal-install/src/Distribution/Client/ProjectConfig

1 file changed

+20
-19
lines changed

cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs

Lines changed: 20 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -203,13 +203,14 @@ import System.Directory (createDirectoryIfMissing, makeAbsolute)
203203
import System.FilePath (isAbsolute, isPathSeparator, makeValid, splitFileName, (</>))
204204
import Text.PrettyPrint
205205
( Doc
206+
, int
206207
, render
207208
, semi
208209
, text
209210
, vcat
210211
, ($+$)
211212
)
212-
import qualified Text.PrettyPrint as Disp (empty, int, render, text)
213+
import qualified Text.PrettyPrint as Disp (empty)
213214

214215
------------------------------------------------------------------
215216
-- Handle extended project config files with conditionals and imports.
@@ -286,7 +287,7 @@ type DupesMap = Map FilePath [Dupes]
286287
dupesMsg :: (FilePath, [Dupes]) -> Doc
287288
dupesMsg (duplicate, ds@(take 1 . sortOn dupesNormLocPath -> dupes)) =
288289
vcat $
289-
((text "Warning:" <+> Disp.int (length ds) <+> text "imports of" <+> text duplicate) <> semi)
290+
((text "Warning:" <+> int (length ds) <+> text "imports of" <+> text duplicate) <> semi)
290291
: ((\Dupes{..} -> duplicateImportMsg Disp.empty dupesUniqueImport dupesNormLocPath dupesSeenImportsBy) <$> dupes)
291292

292293
parseProjectSkeleton
@@ -326,7 +327,7 @@ parseProjectSkeleton cacheDir httpTransport verbosity importsBy dupesMap project
326327
else do
327328
when
328329
(isUntrimmedUriConfigPath importLocPath)
329-
(noticeDoc verbosity $ untrimmedUriImportMsg (Disp.text "Warning:") importLocPath)
330+
(noticeDoc verbosity $ untrimmedUriImportMsg (text "Warning:") importLocPath)
330331
let fs = (\z -> CondNode z [normLocPath] mempty) <$> fieldsToConfig normSource (reverse acc)
331332
let uniqueFields = if uniqueImport `elem` seenImports then [] else xs
332333
atomicModifyIORef' dupesMap $ \dm -> (Map.insertWith (++) uniqueImport [Dupes uniqueImport normLocPath seenImportsBy] dm, ())
@@ -1324,13 +1325,13 @@ parseLegacyProjectConfig rootConfig bs =
13241325

13251326
showLegacyProjectConfig :: LegacyProjectConfig -> String
13261327
showLegacyProjectConfig config =
1327-
Disp.render $
1328+
render $
13281329
showConfig
13291330
(legacyProjectConfigFieldDescrs constraintSrc)
13301331
legacyPackageConfigSectionDescrs
13311332
legacyPackageConfigFGSectionDescrs
13321333
config
1333-
$+$ Disp.text ""
1334+
$+$ text ""
13341335
where
13351336
-- Note: ConstraintSource is unused when pretty-printing. We fake
13361337
-- it here to avoid having to pass it on call-sites. It's not great
@@ -1341,13 +1342,13 @@ legacyProjectConfigFieldDescrs :: ConstraintSource -> [FieldDescr LegacyProjectC
13411342
legacyProjectConfigFieldDescrs constraintSrc =
13421343
[ newLineListField
13431344
"packages"
1344-
(Disp.text . renderPackageLocationToken)
1345+
(text . renderPackageLocationToken)
13451346
parsePackageLocationTokenQ
13461347
legacyPackages
13471348
(\v flags -> flags{legacyPackages = v})
13481349
, newLineListField
13491350
"optional-packages"
1350-
(Disp.text . renderPackageLocationToken)
1351+
(text . renderPackageLocationToken)
13511352
parsePackageLocationTokenQ
13521353
legacyPackagesOptional
13531354
(\v flags -> flags{legacyPackagesOptional = v})
@@ -1458,7 +1459,7 @@ legacySharedConfigFieldDescrs constraintSrc =
14581459
. addFields
14591460
[ commaNewLineListFieldParsec
14601461
"package-dbs"
1461-
(Disp.text . showPackageDb)
1462+
(text . showPackageDb)
14621463
(fmap readPackageDb parsecToken)
14631464
configPackageDBs
14641465
(\v conf -> conf{configPackageDBs = v})
@@ -1751,8 +1752,8 @@ legacyPackageConfigFieldDescrs =
17511752
in FieldDescr
17521753
name
17531754
( \f -> case f of
1754-
Flag NoDumpBuildInfo -> Disp.text "False"
1755-
Flag DumpBuildInfo -> Disp.text "True"
1755+
Flag NoDumpBuildInfo -> text "False"
1756+
Flag DumpBuildInfo -> text "True"
17561757
_ -> Disp.empty
17571758
)
17581759
( \line str _ -> case () of
@@ -1779,9 +1780,9 @@ legacyPackageConfigFieldDescrs =
17791780
in FieldDescr
17801781
name
17811782
( \f -> case f of
1782-
Flag NoOptimisation -> Disp.text "False"
1783-
Flag NormalOptimisation -> Disp.text "True"
1784-
Flag MaximumOptimisation -> Disp.text "2"
1783+
Flag NoOptimisation -> text "False"
1784+
Flag NormalOptimisation -> text "True"
1785+
Flag MaximumOptimisation -> text "2"
17851786
_ -> Disp.empty
17861787
)
17871788
( \line str _ -> case () of
@@ -1804,10 +1805,10 @@ legacyPackageConfigFieldDescrs =
18041805
in FieldDescr
18051806
name
18061807
( \f -> case f of
1807-
Flag NoDebugInfo -> Disp.text "False"
1808-
Flag MinimalDebugInfo -> Disp.text "1"
1809-
Flag NormalDebugInfo -> Disp.text "True"
1810-
Flag MaximalDebugInfo -> Disp.text "3"
1808+
Flag NoDebugInfo -> text "False"
1809+
Flag MinimalDebugInfo -> text "1"
1810+
Flag NormalDebugInfo -> text "True"
1811+
Flag MaximalDebugInfo -> text "3"
18111812
_ -> Disp.empty
18121813
)
18131814
( \line str _ -> case () of
@@ -2132,6 +2133,6 @@ monoidFieldParsec name showF readF get' set =
21322133
-- otherwise are special syntax.
21332134
showTokenQ :: String -> Doc
21342135
showTokenQ "" = Disp.empty
2135-
showTokenQ x@('-' : '-' : _) = Disp.text (show x)
2136-
showTokenQ x@('.' : []) = Disp.text (show x)
2136+
showTokenQ x@('-' : '-' : _) = text (show x)
2137+
showTokenQ x@('.' : []) = text (show x)
21372138
showTokenQ x = showToken x

0 commit comments

Comments
 (0)