@@ -203,13 +203,14 @@ import System.Directory (createDirectoryIfMissing, makeAbsolute)
203
203
import System.FilePath (isAbsolute , isPathSeparator , makeValid , splitFileName , (</>) )
204
204
import Text.PrettyPrint
205
205
( Doc
206
+ , int
206
207
, render
207
208
, semi
208
209
, text
209
210
, vcat
210
211
, ($+$)
211
212
)
212
- import qualified Text.PrettyPrint as Disp (empty , int , render , text )
213
+ import qualified Text.PrettyPrint as Disp (empty )
213
214
214
215
------------------------------------------------------------------
215
216
-- Handle extended project config files with conditionals and imports.
@@ -286,7 +287,7 @@ type DupesMap = Map FilePath [Dupes]
286
287
dupesMsg :: (FilePath , [Dupes ]) -> Doc
287
288
dupesMsg (duplicate, ds@ (take 1 . sortOn dupesNormLocPath -> dupes)) =
288
289
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)
290
291
: ((\ Dupes {.. } -> duplicateImportMsg Disp. empty dupesUniqueImport dupesNormLocPath dupesSeenImportsBy) <$> dupes)
291
292
292
293
parseProjectSkeleton
@@ -326,7 +327,7 @@ parseProjectSkeleton cacheDir httpTransport verbosity importsBy dupesMap project
326
327
else do
327
328
when
328
329
(isUntrimmedUriConfigPath importLocPath)
329
- (noticeDoc verbosity $ untrimmedUriImportMsg (Disp. text " Warning:" ) importLocPath)
330
+ (noticeDoc verbosity $ untrimmedUriImportMsg (text " Warning:" ) importLocPath)
330
331
let fs = (\ z -> CondNode z [normLocPath] mempty ) <$> fieldsToConfig normSource (reverse acc)
331
332
let uniqueFields = if uniqueImport `elem` seenImports then [] else xs
332
333
atomicModifyIORef' dupesMap $ \ dm -> (Map. insertWith (++) uniqueImport [Dupes uniqueImport normLocPath seenImportsBy] dm, () )
@@ -1324,13 +1325,13 @@ parseLegacyProjectConfig rootConfig bs =
1324
1325
1325
1326
showLegacyProjectConfig :: LegacyProjectConfig -> String
1326
1327
showLegacyProjectConfig config =
1327
- Disp. render $
1328
+ render $
1328
1329
showConfig
1329
1330
(legacyProjectConfigFieldDescrs constraintSrc)
1330
1331
legacyPackageConfigSectionDescrs
1331
1332
legacyPackageConfigFGSectionDescrs
1332
1333
config
1333
- $+$ Disp. text " "
1334
+ $+$ text " "
1334
1335
where
1335
1336
-- Note: ConstraintSource is unused when pretty-printing. We fake
1336
1337
-- it here to avoid having to pass it on call-sites. It's not great
@@ -1341,13 +1342,13 @@ legacyProjectConfigFieldDescrs :: ConstraintSource -> [FieldDescr LegacyProjectC
1341
1342
legacyProjectConfigFieldDescrs constraintSrc =
1342
1343
[ newLineListField
1343
1344
" packages"
1344
- (Disp. text . renderPackageLocationToken)
1345
+ (text . renderPackageLocationToken)
1345
1346
parsePackageLocationTokenQ
1346
1347
legacyPackages
1347
1348
(\ v flags -> flags{legacyPackages = v})
1348
1349
, newLineListField
1349
1350
" optional-packages"
1350
- (Disp. text . renderPackageLocationToken)
1351
+ (text . renderPackageLocationToken)
1351
1352
parsePackageLocationTokenQ
1352
1353
legacyPackagesOptional
1353
1354
(\ v flags -> flags{legacyPackagesOptional = v})
@@ -1458,7 +1459,7 @@ legacySharedConfigFieldDescrs constraintSrc =
1458
1459
. addFields
1459
1460
[ commaNewLineListFieldParsec
1460
1461
" package-dbs"
1461
- (Disp. text . showPackageDb)
1462
+ (text . showPackageDb)
1462
1463
(fmap readPackageDb parsecToken)
1463
1464
configPackageDBs
1464
1465
(\ v conf -> conf{configPackageDBs = v})
@@ -1751,8 +1752,8 @@ legacyPackageConfigFieldDescrs =
1751
1752
in FieldDescr
1752
1753
name
1753
1754
( \ 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"
1756
1757
_ -> Disp. empty
1757
1758
)
1758
1759
( \ line str _ -> case () of
@@ -1779,9 +1780,9 @@ legacyPackageConfigFieldDescrs =
1779
1780
in FieldDescr
1780
1781
name
1781
1782
( \ 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"
1785
1786
_ -> Disp. empty
1786
1787
)
1787
1788
( \ line str _ -> case () of
@@ -1804,10 +1805,10 @@ legacyPackageConfigFieldDescrs =
1804
1805
in FieldDescr
1805
1806
name
1806
1807
( \ 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"
1811
1812
_ -> Disp. empty
1812
1813
)
1813
1814
( \ line str _ -> case () of
@@ -2132,6 +2133,6 @@ monoidFieldParsec name showF readF get' set =
2132
2133
-- otherwise are special syntax.
2133
2134
showTokenQ :: String -> Doc
2134
2135
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)
2137
2138
showTokenQ x = showToken x
0 commit comments