Skip to content

Commit dfab51e

Browse files
qrilkaqrilka
committed
Incorporate haddock building flag into source map and use it for hash
1 parent 6d57ab5 commit dfab51e

14 files changed

Lines changed: 86 additions & 53 deletions

File tree

‎src/Stack/Build/ConstructPlan.hs‎

Lines changed: 19 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -235,6 +235,7 @@ constructPlan baseConfigOpts0 localDumpPkgs loadPackage0 sourceMap installedMap
235235
pPackages <- for (smProject sourceMap) $ \pp -> do
236236
lp <- loadLocalPackage sourceMap pp
237237
return $ SourceLocal lp Local
238+
bopts <- view $ configL.to configBuild
238239
deps <- for (smDeps sourceMap) $ \dp ->
239240
case dpLocation dp of
240241
PLImmutable loc -> do
@@ -244,7 +245,7 @@ constructPlan baseConfigOpts0 localDumpPkgs loadPackage0 sourceMap installedMap
244245
PLMutable dir -> do
245246
-- FIXME this is not correct, we don't want to treat all Mutable as local
246247
-- FIXME ^ is from Stack.Build.Source
247-
pp <- mkProjectPackage YesPrintWarnings dir
248+
pp <- mkProjectPackage YesPrintWarnings dir (shouldHaddockDeps bopts)
248249
lp <- loadLocalPackage sourceMap pp
249250
return $ SourceLocal lp Snap
250251
return $ pPackages <> deps
@@ -343,8 +344,8 @@ mkUnregisterLocal tasks dirtyReason localDumpPkgs sourceMap initialBuildSteps =
343344
-- benchmarks. If @isAllInOne@ is 'True' (the common case), then all of
344345
-- these should have already been taken care of as part of the build
345346
-- step.
346-
addFinal :: LocalPackage -> Package -> Bool -> M ()
347-
addFinal lp package isAllInOne = do
347+
addFinal :: LocalPackage -> Package -> Bool -> Bool -> M ()
348+
addFinal lp package isAllInOne buildHaddocks = do
348349
depsRes <- addPackageDeps False package
349350
res <- case depsRes of
350351
Left e -> return $ Left e
@@ -363,6 +364,7 @@ addFinal lp package isAllInOne = do
363364
True -- local
364365
Local
365366
package
367+
, taskBuildHaddock = buildHaddocks
366368
, taskPresent = present
367369
, taskType = TTFilePath lp Local -- FIXME we can rely on this being Local, right?
368370
, taskAllInOne = isAllInOne
@@ -474,12 +476,12 @@ installPackage treatAsDep name ps minstalled = do
474476
SourceRemote pkgLoc _version cp -> do
475477
planDebug $ "installPackage: Doing all-in-one build for upstream package " ++ show name
476478
package <- loadPackage ctx pkgLoc (cpFlags cp) (cpGhcOptions cp)
477-
resolveDepsAndInstall True treatAsDep ps package minstalled
479+
resolveDepsAndInstall True treatAsDep (cpHaddocks cp) ps package minstalled
478480
SourceLocal lp _ ->
479481
case lpTestBench lp of
480482
Nothing -> do
481483
planDebug $ "installPackage: No test / bench component for " ++ show name ++ " so doing an all-in-one build."
482-
resolveDepsAndInstall True treatAsDep ps (lpPackage lp) minstalled
484+
resolveDepsAndInstall True treatAsDep (lpBuildHaddocks lp) ps (lpPackage lp) minstalled
483485
Just tb -> do
484486
-- Attempt to find a plan which performs an all-in-one
485487
-- build. Ignore the writer action + reset the state if
@@ -494,10 +496,10 @@ installPackage treatAsDep name ps minstalled = do
494496
case res of
495497
Right deps -> do
496498
planDebug $ "installPackage: For " ++ show name ++ ", successfully added package deps"
497-
adr <- installPackageGivenDeps True ps tb minstalled deps
499+
adr <- installPackageGivenDeps True False ps tb minstalled deps
498500
-- FIXME: this redundantly adds the deps (but
499501
-- they'll all just get looked up in the map)
500-
addFinal lp tb True
502+
addFinal lp tb True False
501503
return $ Right adr
502504
Left _ -> do
503505
-- Reset the state to how it was before
@@ -507,43 +509,45 @@ installPackage treatAsDep name ps minstalled = do
507509
put s
508510
-- Otherwise, fall back on building the
509511
-- tests / benchmarks in a separate step.
510-
res' <- resolveDepsAndInstall False treatAsDep ps (lpPackage lp) minstalled
512+
res' <- resolveDepsAndInstall False treatAsDep (lpBuildHaddocks lp) ps (lpPackage lp) minstalled
511513
when (isRight res') $ do
512514
-- Insert it into the map so that it's
513515
-- available for addFinal.
514516
updateLibMap name res'
515-
addFinal lp tb False
517+
addFinal lp tb False False
516518
return res'
517519

518520
resolveDepsAndInstall :: Bool
521+
-> Bool
519522
-> Bool
520523
-> Source
521524
-> Package
522525
-> Maybe Installed
523526
-> M (Either ConstructPlanException AddDepRes)
524-
resolveDepsAndInstall isAllInOne treatAsDep ps package minstalled = do
527+
resolveDepsAndInstall isAllInOne treatAsDep buildHaddocks ps package minstalled = do
525528
res <- addPackageDeps treatAsDep package
526529
case res of
527530
Left err -> return $ Left err
528-
Right deps -> liftM Right $ installPackageGivenDeps isAllInOne ps package minstalled deps
531+
Right deps -> liftM Right $ installPackageGivenDeps isAllInOne buildHaddocks ps package minstalled deps
529532

530533
-- | Checks if we need to install the given 'Package', given the results
531534
-- of 'addPackageDeps'. If dependencies are missing, the package is
532535
-- dirty, or it's not installed, then it needs to be installed.
533536
installPackageGivenDeps :: Bool
537+
-> Bool
534538
-> Source
535539
-> Package
536540
-> Maybe Installed
537541
-> ( Set PackageIdentifier
538542
, Map PackageIdentifier GhcPkgId
539543
, InstallLocation )
540544
-> M AddDepRes
541-
installPackageGivenDeps isAllInOne ps package minstalled (missing, present, minLoc) = do
545+
installPackageGivenDeps isAllInOne buildHaddocks ps package minstalled (missing, present, minLoc) = do
542546
let name = packageName package
543547
ctx <- ask
544548
mRightVersionInstalled <- case (minstalled, Set.null missing) of
545549
(Just installed, True) -> do
546-
shouldInstall <- checkDirtiness ps installed package present (wanted ctx)
550+
shouldInstall <- checkDirtiness ps installed package present
547551
return $ if shouldInstall then Nothing else Just installed
548552
(Just _, False) -> do
549553
let t = T.intercalate ", " $ map (T.pack . packageNameString . pkgName) (Set.toList missing)
@@ -569,6 +573,7 @@ installPackageGivenDeps isAllInOne ps package minstalled (missing, present, minL
569573
-- https://github.com/commercialhaskell/stack/issues/345
570574
(assert (destLoc == loc) destLoc)
571575
package
576+
, taskBuildHaddock = buildHaddocks
572577
, taskPresent = present
573578
, taskType =
574579
case ps of
@@ -721,9 +726,8 @@ checkDirtiness :: Source
721726
-> Installed
722727
-> Package
723728
-> Map PackageIdentifier GhcPkgId
724-
-> Set PackageName
725729
-> M Bool
726-
checkDirtiness ps installed package present wanted' = do
730+
checkDirtiness ps installed package present = do
727731
ctx <- ask
728732
moldOpts <- runRIO ctx $ tryGetFlagCache installed
729733
let configOpts = configureOpts
@@ -733,18 +737,13 @@ checkDirtiness ps installed package present wanted' = do
733737
(psLocal ps)
734738
(sourceLocation ps) -- should be Local always
735739
package
736-
buildOpts = bcoBuildOpts (baseConfigOpts ctx)
737740
wantConfigCache = ConfigCache
738741
{ configCacheOpts = configOpts
739742
, configCacheDeps = Set.fromList $ Map.elems present
740743
, configCacheComponents =
741744
case ps of
742745
SourceLocal lp _ -> Set.map (encodeUtf8 . renderComponent) $ lpComponents lp
743746
SourceRemote{} -> Set.empty
744-
, configCacheHaddock =
745-
shouldHaddockPackage buildOpts wanted' (packageName package) ||
746-
-- Disabling haddocks when old config had haddocks doesn't make dirty.
747-
maybe False configCacheHaddock moldOpts
748747
, configCachePkgSrc = toCachePkgSrc ps
749748
}
750749
config = view configL ctx
@@ -776,7 +775,6 @@ describeConfigDiff config old new
776775
| not $ Set.null newComponents =
777776
Just $ "components added: " `T.append` T.intercalate ", "
778777
(map (decodeUtf8With lenientDecode) (Set.toList newComponents))
779-
| not (configCacheHaddock old) && configCacheHaddock new = Just "rebuilding with haddocks"
780778
| oldOpts /= newOpts = Just $ T.pack $ concat
781779
[ "flags changed from "
782780
, show oldOpts

‎src/Stack/Build/Execute.hs‎

Lines changed: 2 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -197,7 +197,6 @@ data ExecuteEnv = ExecuteEnv
197197
-- ^ Compiled version of eeSetupHs
198198
, eeCabalPkgVer :: !Version
199199
, eeTotalWanted :: !Int
200-
, eeWanted :: !(Set PackageName)
201200
, eeLocals :: ![LocalPackage]
202201
, eeGlobalDB :: !(Path Abs Dir)
203202
, eeGlobalDumpPkgs :: !(Map GhcPkgId (DumpPackage () () ()))
@@ -359,7 +358,6 @@ withExecuteEnv bopts boptsCli baseConfigOpts locals globalPackages snapshotPacka
359358
, eeSetupExe = setupExe
360359
, eeCabalPkgVer = cabalPkgVer
361360
, eeTotalWanted = totalWanted
362-
, eeWanted = wantedLocalPackages locals
363361
, eeLocals = locals
364362
, eeGlobalDB = globalDB
365363
, eeGlobalDumpPkgs = toDumpPackagesByGhcPkgId globalPackages
@@ -784,8 +782,6 @@ getConfigCache ExecuteEnv {..} task@Task {..} installedMap enableTest enableBenc
784782
case taskType of
785783
TTFilePath lp _ -> Set.map (encodeUtf8 . renderComponent) $ lpComponents lp
786784
TTRemote{} -> Set.empty
787-
, configCacheHaddock =
788-
shouldHaddockPackage eeBuildOpts eeWanted (pkgName taskProvides)
789785
, configCachePkgSrc = taskCachePkgSrc
790786
}
791787
allDepsMap = Map.union missing' taskPresent
@@ -1254,9 +1250,8 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap
12541250
liftIO $ atomically $ modifyTVar eeGhcPkgIds $ Map.insert taskProvides installed
12551251
where
12561252
pname = pkgName taskProvides
1257-
shouldHaddockPackage' = shouldHaddockPackage eeBuildOpts eeWanted pname
12581253
doHaddock mcurator package
1259-
= shouldHaddockPackage' &&
1254+
= taskBuildHaddock &&
12601255
not isFinalBuild &&
12611256
-- Works around haddock failing on bytestring-builder since it has no modules
12621257
-- when bytestring is new enough.
@@ -1293,7 +1288,7 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap
12931288

12941289
getPrecompiled cache =
12951290
case taskLocation task of
1296-
Snap | not shouldHaddockPackage' -> do
1291+
Snap -> do
12971292
mpc <-
12981293
case taskLocation task of
12991294
Snap -> fmap join $ for (ttPackageLocation taskType) $ \loc -> readPrecompiledCache

‎src/Stack/Build/Source.hs‎

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ import qualified Data.Map.Strict as M
2727
import qualified Data.Set as Set
2828
import Foreign.C.Types (CTime)
2929
import Stack.Build.Cache
30+
import Stack.Build.Haddock (shouldHaddockDeps)
3031
import Stack.Build.Target
3132
import Stack.Package
3233
import Stack.SourceMap
@@ -48,11 +49,12 @@ projectLocalPackages = do
4849

4950
localDependencies :: HasEnvConfig env => RIO env [LocalPackage]
5051
localDependencies = do
52+
bopts <- view $ configL.to configBuild
5153
sourceMap <- view $ envConfigL . to envConfigSourceMap
5254
forMaybeM (Map.elems $ smDeps sourceMap) $ \dp ->
5355
case dpLocation dp of
5456
PLMutable dir -> do
55-
pp <- mkProjectPackage YesPrintWarnings dir
57+
pp <- mkProjectPackage YesPrintWarnings dir (shouldHaddockDeps bopts)
5658
Just <$> loadLocalPackage sourceMap pp
5759
_ -> return Nothing
5860

@@ -66,6 +68,7 @@ loadSourceMap :: HasBuildConfig env
6668
loadSourceMap smt boptsCli sma = do
6769
bconfig <- view buildConfigL
6870
let project = M.map applyOptsFlagsPP $ smaProject sma
71+
bopts = configBuild (bcConfig bconfig)
6972
applyOptsFlagsPP p@ProjectPackage{ppCommon = c} =
7073
p{ppCommon = applyOptsFlags (M.member (cpName c) (smtTargets smt)) True c}
7174
deps0 = smtDeps smt <> smaDeps sma
@@ -86,6 +89,10 @@ loadSourceMap smt boptsCli sma = do
8689
if null ghcOptions
8790
then cpGhcOptions common
8891
else ghcOptions
92+
, cpHaddocks =
93+
if isTarget
94+
then boptsHaddock bopts
95+
else shouldHaddockDeps bopts
8996
}
9097
globals = smaGlobal sma `M.difference` smtDeps smt
9198
return
@@ -285,6 +292,7 @@ loadLocalPackage sm pp = do
285292
, lpBenchDeps = dvVersionRange <$> packageDeps benchpkg
286293
, lpTestBench = btpkg
287294
, lpComponentFiles = componentFiles
295+
, lpBuildHaddocks = cpHaddocks (ppCommon pp)
288296
, lpForceDirty = boptsForceDirty bopts
289297
, lpDirtyFiles = dirtyFiles
290298
, lpNewBuildCaches = newBuildCaches

‎src/Stack/Build/Target.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -432,10 +432,11 @@ combineResolveResults results = do
432432

433433
parseTargets :: HasBuildConfig env
434434
=> NeedTargets
435+
-> Bool
435436
-> BuildOptsCLI
436437
-> SMActual
437438
-> RIO env SMTargets
438-
parseTargets needTargets boptscli smActual = do
439+
parseTargets needTargets haddockDeps boptscli smActual = do
439440
logDebug "Parsing the targets"
440441
bconfig <- view buildConfigL
441442
workingDir <- getCurrentDir
@@ -465,7 +466,7 @@ parseTargets needTargets boptscli smActual = do
465466
| otherwise -> throwIO $ TargetParseException
466467
["The specified targets matched no packages"]
467468

468-
addedDeps' <- mapM (mkDepPackage . PLImmutable) addedDeps
469+
addedDeps' <- mapM (mkDepPackage haddockDeps . PLImmutable) addedDeps
469470

470471
return SMTargets
471472
{ smtTargets = targets

‎src/Stack/Config.hs‎

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -72,6 +72,7 @@ import Stack.Config.Docker
7272
import Stack.Config.Nix
7373
import Stack.Config.Urls
7474
import Stack.Constants
75+
import Stack.Build.Haddock (shouldHaddockDeps)
7576
import qualified Stack.Image as Image
7677
import Stack.SourceMap
7778
import Stack.Types.Config
@@ -589,14 +590,16 @@ loadBuildConfig mproject maresolver mcompiler = do
589590

590591
extraPackageDBs <- mapM resolveDir' (projectExtraPackageDBs project)
591592

593+
let bopts = configBuild config
594+
592595
packages0 <- for (projectPackages project) $ \fp@(RelFilePath t) -> do
593596
abs' <- resolveDir (parent stackYamlFP) (T.unpack t)
594597
let resolved = ResolvedPath fp abs'
595-
pp <- mkProjectPackage YesPrintWarnings resolved
598+
pp <- mkProjectPackage YesPrintWarnings resolved (boptsHaddock bopts)
596599
pure (cpName $ ppCommon pp, pp)
597600

598601
deps0 <- forM (projectDependencies project) $ \plp -> do
599-
dp <- mkDepPackage plp
602+
dp <- mkDepPackage (shouldHaddockDeps bopts) plp
600603
pure (cpName $ dpCommon dp, dp)
601604

602605
checkDuplicateNames $
@@ -607,7 +610,7 @@ loadBuildConfig mproject maresolver mcompiler = do
607610
snPackages = snapshotPackages snapshot `Map.difference` packages1
608611
`Map.difference` Map.fromList deps0
609612

610-
snDeps <- Map.traverseWithKey snapToDepPackage snPackages
613+
snDeps <- Map.traverseWithKey (snapToDepPackage (shouldHaddockDeps bopts)) snPackages
611614

612615
let deps1 = Map.fromList deps0 `Map.union` snDeps
613616

‎src/Stack/Dot.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -212,7 +212,7 @@ createDepLoader sourceMap installed globalDumpMap globalIdMap loadPackageDeps pk
212212
Nothing ->
213213
case Map.lookup pkgName (smDeps sourceMap) of
214214
Just DepPackage{dpLocation=PLMutable dir} -> do
215-
pp <- mkProjectPackage YesPrintWarnings dir
215+
pp <- mkProjectPackage YesPrintWarnings dir False
216216
pkg <- loadCommonPackage (ppCommon pp)
217217
pure (packageAllDeps pkg, payloadFromLocal pkg)
218218
Just dp@DepPackage{dpLocation=PLImmutable loc} -> do

‎src/Stack/Ghci.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -219,7 +219,7 @@ preprocessTargets buildOptsCLI sma rawTargets = do
219219
-- Try parsing targets before checking if both file and
220220
-- module targets are specified (see issue#3342).
221221
let boptsCLI = buildOptsCLI { boptsCLITargets = normalTargetsRaw }
222-
normalTargets <- parseTargets AllowNoTargets boptsCLI sma
222+
normalTargets <- parseTargets AllowNoTargets False boptsCLI sma
223223
`catch` \ex -> case ex of
224224
TargetParseException xs -> throwM (GhciTargetParseException xs)
225225
_ -> throwM ex
@@ -234,7 +234,7 @@ parseMainIsTargets
234234
-> RIO env (Maybe (Map PackageName Target))
235235
parseMainIsTargets buildOptsCLI sma mtarget = forM mtarget $ \target -> do
236236
let boptsCLI = buildOptsCLI { boptsCLITargets = [target] }
237-
targets <- parseTargets AllowNoTargets boptsCLI sma
237+
targets <- parseTargets AllowNoTargets False boptsCLI sma
238238
return $ smtTargets targets
239239

240240
-- | Display PackageName + NamedComponent

‎src/Stack/SDist.hs‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -308,6 +308,7 @@ readLocalPackage pkgDir = do
308308
, lpTestDeps = Map.empty
309309
, lpBenchDeps = Map.empty
310310
, lpTestBench = Nothing
311+
, lpBuildHaddocks = False
311312
, lpForceDirty = False
312313
, lpDirtyFiles = pure Nothing
313314
, lpNewBuildCaches = pure Map.empty
@@ -345,6 +346,7 @@ getSDistFileList lp =
345346
{ tcoMissing = Set.empty
346347
, tcoOpts = \_ -> ConfigureOpts [] []
347348
}
349+
, taskBuildHaddock = False
348350
, taskPresent = Map.empty
349351
, taskAllInOne = True
350352
, taskCachePkgSrc = CacheSrcLocal (toFilePath (parent $ lpCabalFile lp))
@@ -451,7 +453,7 @@ buildExtractedTarball pkgDir = do
451453
<- fmap Map.fromList
452454
$ flip filterM (Map.toList (smwProject (bcSMWanted (envConfigBuildConfig envConfig))))
453455
$ fmap not . isPathToRemove . resolvedAbsolute . ppResolvedDir . snd
454-
pp <- mkProjectPackage YesPrintWarnings pkgDir
456+
pp <- mkProjectPackage YesPrintWarnings pkgDir False
455457
let adjustEnvForBuild env =
456458
let updatedEnvConfig = envConfig
457459
{ envConfigSourceMap = updatePackagesInSourceMap (envConfigSourceMap envConfig)

0 commit comments

Comments
 (0)