diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index fdd44ef535..54704ebea1 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -447,11 +447,11 @@ addFinal lp package isAllInOne buildHaddocks = do True -- local Mutable package - , buildHaddock = buildHaddocks - , present = present + , buildHaddocks + , present , taskType = TTLocalMutable lp , allInOne = isAllInOne - , cachePkgSrc = CacheSrcLocal (toFilePath (parent lp.cabalFile)) + , cachePkgSrc = CacheSrcLocal (toFilePath (parent lp.cabalFP)) , buildTypeConfig = packageBuildTypeConfig package } tell mempty { wFinals = Map.singleton package.name res } @@ -632,7 +632,7 @@ installPackage name ps minstalled = do <> "." package <- ctx.loadPackage pkgLoc cp.flags cp.ghcOptions cp.cabalConfigOpts - resolveDepsAndInstall True cp.haddocks ps package minstalled + resolveDepsAndInstall True cp.buildHaddocks ps package minstalled PSFilePath lp -> do case lp.testBench of Nothing -> do @@ -760,8 +760,8 @@ installPackageGivenDeps isAllInOne buildHaddocks ps package minstalled (psLocal ps) mutable package - , buildHaddock = buildHaddocks - , present = present + , buildHaddocks + , present , taskType = case ps of PSFilePath lp -> diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 61c39b6bc8..7cbcea38d9 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -186,7 +186,7 @@ displayTask task = fillSep $ <> "," , "source=" <> ( case task.taskType of - TTLocalMutable lp -> pretty $ parent lp.cabalFile + TTLocalMutable lp -> pretty $ parent lp.cabalFP TTRemotePackage _ _ pl -> fromString $ T.unpack $ textDisplay pl ) <> if Set.null missing @@ -419,7 +419,7 @@ executePlan' installedMap0 targets plan ee = do generateHpcMarkupIndex unless (null errs) $ prettyThrowM $ ExecutionFailure errs - when buildOpts.haddock $ do + when buildOpts.buildHaddocks $ do if buildOpts.haddockForHackage then generateLocalHaddockForHackageArchives ee.locals diff --git a/src/Stack/Build/ExecuteEnv.hs b/src/Stack/Build/ExecuteEnv.hs index 0d46995582..79d3b56edf 100644 --- a/src/Stack/Build/ExecuteEnv.hs +++ b/src/Stack/Build/ExecuteEnv.hs @@ -577,10 +577,10 @@ withSingleContext allDeps msuffix inner0 - = withPackage $ \package cabalfp pkgDir -> + = withPackage $ \package cabalFP pkgDir -> withOutputType pkgDir package $ \outputType -> withCabal package pkgDir outputType $ \cabal -> - inner0 package cabalfp pkgDir cabal announce outputType + inner0 package cabalFP pkgDir cabal announce outputType where pkgId = taskTypePackageIdentifier taskType announce = announceTask ee taskType @@ -610,9 +610,9 @@ withSingleContext withPackage inner = case taskType of TTLocalMutable lp -> do - let root = parent lp.cabalFile + let root = parent lp.cabalFP withLockedDistDir prettyAnnounce root $ - inner lp.package lp.cabalFile root + inner lp.package lp.cabalFP root TTRemotePackage _ package pkgloc -> do suffix <- parseRelDir $ packageIdentifierString $ packageIdentifier package @@ -635,8 +635,8 @@ withSingleContext let name = pkgName pkgId cabalfpRel <- parseRelFile $ packageNameString name ++ ".cabal" - let cabalfp = dir cabalfpRel - inner package cabalfp dir + let cabalFP = dir cabalfpRel + inner package cabalFP dir withOutputType pkgDir package inner -- Not in interleaved mode. When building a single wanted package, dump diff --git a/src/Stack/Build/ExecutePackage.hs b/src/Stack/Build/ExecutePackage.hs index f21015f9bd..1694d1f39b 100644 --- a/src/Stack/Build/ExecutePackage.hs +++ b/src/Stack/Build/ExecutePackage.hs @@ -196,7 +196,7 @@ getConfigCache ee task installedMap enableTest enableBench = do TTLocalMutable lp -> Set.map (encodeUtf8 . renderComponent) lp.components TTRemotePackage{} -> Set.empty - , haddock = task.buildHaddock + , haddock = task.buildHaddocks , pkgSrc = task.cachePkgSrc , pathEnvVar = ee.pathEnvVar } @@ -213,9 +213,9 @@ ensureConfig :: HasEnvConfig env -> Path Abs File -- ^ Cabal file -> Task -> RIO env Bool -ensureConfig newConfigCache pkgDir buildOpts announce cabal cabalfp task = do +ensureConfig newConfigCache pkgDir buildOpts announce cabal cabalFP task = do newCabalMod <- - liftIO $ modificationTime <$> getFileStatus (toFilePath cabalfp) + liftIO $ modificationTime <$> getFileStatus (toFilePath cabalFP) setupConfigfp <- setupConfigFromDir pkgDir let getNewSetupConfigMod = liftIO $ either (const Nothing) (Just . modificationTime) <$> @@ -381,7 +381,7 @@ singleBuild pkgId = taskProvides task PackageIdentifier pname _ = pkgId doHaddock curator package = - task.buildHaddock + task.buildHaddocks && not isFinalBuild -- Works around haddock failing on bytestring-builder since it has no -- modules when bytestring is new enough. @@ -417,7 +417,7 @@ singleBuild realConfigAndBuild cache mcurator allDepsMap = withSingleContext ac ee task.taskType allDepsMap Nothing $ - \package cabalfp pkgDir cabal0 announce _outputType -> do + \package cabalFP pkgDir cabal0 announce _outputType -> do let cabal = cabal0 CloseOnException executableBuildStatuses <- getExecutableBuildStatuses package pkgDir when ( not (cabalIsSatisfied executableBuildStatuses) @@ -440,7 +440,7 @@ singleBuild ) ) cabal - cabalfp + cabalFP task let installedMapHasThisPkg :: Bool installedMapHasThisPkg = @@ -506,7 +506,7 @@ singleBuild TTLocalMutable lp -> do warnings <- checkForUnlistedFiles task.taskType pkgDir -- TODO: Perhaps only emit these warnings for non extra-dep? - pure (Just (lp.cabalFile, warnings)) + pure (Just (lp.cabalFP, warnings)) _ -> pure Nothing -- NOTE: once -- https://github.com/commercialhaskell/stack/issues/2649 @@ -522,11 +522,11 @@ singleBuild (style Good . fromString . C.display) modules ) - forM_ mlocalWarnings $ \(cabalfp, warnings) -> + forM_ mlocalWarnings $ \(cabalFP, warnings) -> unless (null warnings) $ prettyWarn $ flow "The following modules should be added to \ \exposed-modules or other-modules in" <+> - pretty cabalfp + pretty cabalFP <> ":" <> line <> indent 4 ( mconcat @@ -904,7 +904,7 @@ checkForUnlistedFiles (TTLocalMutable lp) pkgDir = do (addBuildCache,warnings) <- addUnlistedToBuildCache lp.package - lp.cabalFile + lp.cabalFP lp.components caches forM_ (Map.toList addBuildCache) $ \(component, newToCache) -> do diff --git a/src/Stack/Build/Haddock.hs b/src/Stack/Build/Haddock.hs index dd679f617c..3ab6a8bc35 100644 --- a/src/Stack/Build/Haddock.hs +++ b/src/Stack/Build/Haddock.hs @@ -110,12 +110,12 @@ shouldHaddockPackage :: -> Bool shouldHaddockPackage bopts wanted name = if Set.member name wanted - then bopts.haddock + then bopts.buildHaddocks else shouldHaddockDeps bopts -- | Determine whether to build haddocks for dependencies. shouldHaddockDeps :: BuildOpts -> Bool -shouldHaddockDeps bopts = fromMaybe bopts.haddock bopts.haddockDeps +shouldHaddockDeps bopts = fromMaybe bopts.buildHaddocks bopts.haddockDeps -- | Generate Haddock index and contents for local packages. generateLocalHaddockIndex :: @@ -341,7 +341,7 @@ generateLocalHaddockForHackageArchives = ( \lp -> let pkg = lp.package pkgId = PackageIdentifier pkg.name pkg.version - pkgDir = parent lp.cabalFile + pkgDir = parent lp.cabalFP in generateLocalHaddockForHackageArchive pkgDir pkgId ) diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index 18772c39a7..fb063c5fa0 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -125,9 +125,9 @@ loadSourceMap targets boptsCli sma = do ghcOptions ++ common.ghcOptions , cabalConfigOpts = cabalConfigOpts ++ common.cabalConfigOpts - , haddocks = + , buildHaddocks = if isTarget - then bopts.haddock + then bopts.buildHaddocks else shouldHaddockDeps bopts } packageCliFlags = Map.fromList $ @@ -135,7 +135,7 @@ loadSourceMap targets boptsCli sma = do Map.toList boptsCli.flags maybeProjectFlags (ACFByName name, fs) = Just (name, fs) maybeProjectFlags _ = Nothing - globalPkgs = pruneGlobals sma.global (Map.keysSet deps) + globalPkgs = pruneGlobals sma.globals (Map.keysSet deps) logDebug "Checking flags" checkFlagsUsedThrowing packageCliFlags FSCommandLine project deps logDebug "SourceMap constructed" @@ -200,7 +200,7 @@ depPackageHashableContent dp = flags = map flagToBs $ Map.toList dp.depCommon.flags ghcOptions = map display dp.depCommon.ghcOptions cabalConfigOpts = map display dp.depCommon.cabalConfigOpts - haddocks = if dp.depCommon.haddocks then "haddocks" else "" + haddocks = if dp.depCommon.buildHaddocks then "haddocks" else "" hash = immutableLocSha pli pure $ hash @@ -409,11 +409,11 @@ loadLocalPackage pp = do { package = pkg , testBench = btpkg , componentFiles - , buildHaddocks = pp.projectCommon.haddocks + , buildHaddocks = pp.projectCommon.buildHaddocks , forceDirty = bopts.forceDirty , dirtyFiles , newBuildCaches - , cabalFile = pp.cabalFP + , cabalFP = pp.cabalFP , wanted = isWanted , components = nonLibComponents -- TODO: refactor this so that it's easier to be sure that these diff --git a/src/Stack/Build/Target.hs b/src/Stack/Build/Target.hs index 710628349f..0f3b9666be 100644 --- a/src/Stack/Build/Target.hs +++ b/src/Stack/Build/Target.hs @@ -258,7 +258,7 @@ resolveRawTarget sma allLocs (rawInput, rt) = where locals = sma.project deps = sma.deps - globals = sma.global + globals = sma.globals -- Helper function: check if a 'NamedComponent' matches the given -- 'ComponentName' isCompNamed :: ComponentName -> NamedComponent -> Bool diff --git a/src/Stack/BuildOpts.hs b/src/Stack/BuildOpts.hs index 3f30d0d318..7dcfdeb6e7 100644 --- a/src/Stack/BuildOpts.hs +++ b/src/Stack/BuildOpts.hs @@ -27,7 +27,7 @@ defaultBuildOpts = BuildOpts , exeProfile = defaultFirstFalse buildMonoid.exeProfile , libStrip = defaultFirstTrue buildMonoid.libStrip , exeStrip = defaultFirstTrue buildMonoid.exeStrip - , haddock = False + , buildHaddocks = False , haddockOpts = defaultHaddockOpts , openHaddocks = defaultFirstFalse buildMonoid.openHaddocks , haddockDeps = Nothing diff --git a/src/Stack/BuildPlan.hs b/src/Stack/BuildPlan.hs index e4c4709a1b..ffc74d62f9 100644 --- a/src/Stack/BuildPlan.hs +++ b/src/Stack/BuildPlan.hs @@ -390,7 +390,7 @@ checkSnapBuildPlan pkgDirs flags snapCandidate = do | otherwise = Nothing snapPkgs = Map.union (Map.mapMaybe depVersion sma.deps) - (Map.map globalVersion sma.global) + (Map.map globalVersion sma.globals) (f, errs) = checkBundleBuildPlan platform compiler snapPkgs flags gpds cerrs = compilerErrors compiler errs diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs index aed2e409a7..4151af45f2 100644 --- a/src/Stack/Config.hs +++ b/src/Stack/Config.hs @@ -857,7 +857,7 @@ fillProjectWanted stackYamlFP config project locCache snapCompiler snapPackages packages0 <- for project.packages $ \fp@(RelFilePath t) -> do abs' <- resolveDir (parent stackYamlFP) (T.unpack t) let resolved = ResolvedPath fp abs' - pp <- mkProjectPackage YesPrintWarnings resolved bopts.haddock + pp <- mkProjectPackage YesPrintWarnings resolved bopts.buildHaddocks pure (pp.projectCommon.name, pp) -- prefetch git repos to avoid cloning per subdirectory diff --git a/src/Stack/Config/Build.hs b/src/Stack/Config/Build.hs index 73feb2e80c..d8798aa7fd 100644 --- a/src/Stack/Config/Build.hs +++ b/src/Stack/Config/Build.hs @@ -46,7 +46,7 @@ buildOptsFromMonoid buildMonoid = BuildOpts ( buildMonoid.exeStrip <> FirstTrue (if noStripping then Just False else Nothing) ) - , haddock = fromFirstFalse buildMonoid.haddock + , buildHaddocks = fromFirstFalse buildMonoid.buildHaddocks , haddockOpts = haddockOptsFromMonoid buildMonoid.haddockOpts , openHaddocks = not isHaddockFromHackage diff --git a/src/Stack/DependencyGraph.hs b/src/Stack/DependencyGraph.hs index 0eddb1fd37..7e6a5c3172 100644 --- a/src/Stack/DependencyGraph.hs +++ b/src/Stack/DependencyGraph.hs @@ -116,7 +116,7 @@ withDotConfig opts inner = { compiler = actual , project = buildConfig.smWanted.project , deps = buildConfig.smWanted.deps - , global = Map.mapWithKey toDump globals + , globals = Map.mapWithKey toDump globals } toDump :: PackageName -> Version -> DumpPackage toDump name version = DumpPackage @@ -136,14 +136,14 @@ withDotConfig opts inner = actualPkgs = Map.keysSet smActual.deps <> Map.keysSet smActual.project prunedActual = smActual - { global = pruneGlobals smActual.global actualPkgs } + { globals = pruneGlobals smActual.globals actualPkgs } targets <- parseTargets NeedTargets False boptsCLI prunedActual logDebug "Loading source map" sourceMap <- loadSourceMap targets boptsCLI smActual let dc = DotConfig { buildConfig , sourceMap - , globalDump = toList smActual.global + , globalDump = toList smActual.globals } logDebug "DotConfig fully loaded" runRIO dc inner @@ -216,7 +216,7 @@ projectPackageDependencies :: -> [(PackageName, (Set PackageName, DotPayload))] projectPackageDependencies dotOpts locals = map (\lp -> let pkg = localPackageToPackage lp - pkgDir = parent lp.cabalFile + pkgDir = parent lp.cabalFP packageDepsSet = setOfPackageDeps pkg loc = PLMutable $ ResolvedPath (RelFilePath "N/A") pkgDir in (pkg.name, (deps pkg packageDepsSet, lpPayload pkg loc))) diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index a3600af0f7..27986c8de8 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -238,7 +238,7 @@ ghci opts = do { compiler = sourceMap.compiler , project = sourceMap.project , deps = sourceMap.deps - , global = sourceMap.globalPkgs + , globals = sourceMap.globalPkgs } -- Parse --main-is argument. mainIsTargets <- parseMainIsTargets buildOptsCLI sma opts.mainIs @@ -356,7 +356,7 @@ findFileTargets :: -> RIO env (Map PackageName Target, Map PackageName [Path Abs File], [Path Abs File]) findFileTargets locals fileTargets = do filePackages <- forM locals $ \lp -> do - PackageComponentFile _ compFiles _ _ <- getPackageFile lp.package lp.cabalFile + PackageComponentFile _ compFiles _ _ <- getPackageFile lp.package lp.cabalFP pure (lp, M.map (map dotCabalGetPath) compFiles) let foundFileTargetComponents :: [(Path Abs File, [(PackageName, NamedComponent)])] foundFileTargetComponents = @@ -831,8 +831,8 @@ loadGhciPkgDescs :: -> [(PackageName, (Path Abs File, Target))] -> RIO env [GhciPkgDesc] loadGhciPkgDescs buildOptsCLI localTargets = - forM localTargets $ \(name, (cabalfp, target)) -> - loadGhciPkgDesc buildOptsCLI name cabalfp target + forM localTargets $ \(name, (cabalFP, target)) -> + loadGhciPkgDesc buildOptsCLI name cabalFP target -- | Load package description information for a ghci target. loadGhciPkgDesc :: @@ -868,11 +868,11 @@ loadGhciPkgDesc buildOptsCLI name cabalFP target = do , compilerVersion = compilerVersion , platform = view platformL econfig } - -- TODO we've already parsed this information, otherwise we - -- wouldn't have figured out the cabalfp already. In the future: - -- retain that GenericPackageDescription in the relevant data - -- structures to avoid reparsing. - (gpdio, _name, _cabalfp) <- + -- TODO we've already parsed this information, otherwise we wouldn't have + -- figured out the cabalFP already. In the future: retain that + -- GenericPackageDescription in the relevant data structures to avoid + -- reparsing. + (gpdio, _name, _cabalFP) <- loadCabalFilePath (Just stackProgName') (parent cabalFP) gpkgdesc <- liftIO $ gpdio YesPrintWarnings @@ -924,18 +924,18 @@ makeGhciPkgInfo :: makeGhciPkgInfo installMap installedMap locals addPkgs mfileTargets pkgDesc = do bopts <- view buildOptsL let pkg = pkgDesc.package - cabalfp = pkgDesc.cabalFP + cabalFP = pkgDesc.cabalFP target = pkgDesc.target name = pkg.name (mods, files, opts) <- - getPackageOpts pkg installMap installedMap locals addPkgs cabalfp + getPackageOpts pkg installMap installedMap locals addPkgs cabalFP let filteredOpts = filterWanted opts filterWanted = M.filterWithKey (\k _ -> k `S.member` allWanted) allWanted = wantedPackageComponents bopts target pkg pure GhciPkgInfo { name , opts = M.toList filteredOpts - , dir = parent cabalfp + , dir = parent cabalFP , modules = unionModuleMaps $ map ( \(comp, mp) -> M.map @@ -1211,7 +1211,7 @@ getExtraLoadDeps loadAllDeps localMap targets = shouldLoad <- or <$> mapM go deps if shouldLoad then do - modify (M.insert name (Just (lp.cabalFile, TargetComps (S.singleton CLib)))) + modify (M.insert name (Just (lp.cabalFP, TargetComps (S.singleton CLib)))) pure True else do modify (M.insert name Nothing) diff --git a/src/Stack/Init.hs b/src/Stack/Init.hs index cd7c253d9b..3dc80c2b82 100644 --- a/src/Stack/Init.hs +++ b/src/Stack/Init.hs @@ -695,10 +695,10 @@ cabalPackagesCheck cabaldirs = do -- Pantry's 'loadCabalFilePath' throws 'MismatchedCabalName' (error -- [S-910]) if the Cabal file name does not match the package it -- defines. - (gpdio, _name, cabalfp) <- loadCabalFilePath (Just stackProgName') dir + (gpdio, _name, cabalFP) <- loadCabalFilePath (Just stackProgName') dir eres <- liftIO $ try (gpdio YesPrintWarnings) case eres :: Either PantryException C.GenericPackageDescription of - Right gpd -> pure $ Right (cabalfp, gpd) + Right gpd -> pure $ Right (cabalFP, gpd) Left (MismatchedCabalName fp name) -> pure $ Left (fp, name) Left e -> throwIO e let (nameMismatchPkgs, packages) = partitionEithers ePackages diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 04941a1bfa..d1cae336f7 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -200,10 +200,10 @@ getPackageOpts installedMap omitPkgs addPkgs - cabalfp + cabalFP = do PackageComponentFile !componentsModules componentFiles _ _ <- - getPackageFile stackPackage cabalfp + getPackageFile stackPackage cabalFP let subLibs = S.toList $ subLibComponents $ M.keysSet componentsModules excludedSubLibs <- mapM (parsePackageNameThrowing . T.unpack) subLibs @@ -212,7 +212,7 @@ getPackageOpts installedMap (excludedSubLibs ++ omitPkgs) addPkgs - cabalfp + cabalFP stackPackage componentFiles pure (componentsModules, componentFiles, componentsOpts) @@ -236,7 +236,7 @@ generatePkgDescOpts installedMap omitPackages addPackages - cabalfp + cabalFP pkg componentPaths = do @@ -273,7 +273,7 @@ generatePkgDescOpts . makeBuildInfoOpts (.testSuites) CTest pure $ aggregateAllBuildInfoOpts mempty where - cabalDir = parent cabalfp + cabalDir = parent cabalFP -- | Generate GHC options for the target. Since Cabal also figures out these -- options, currently this is only used for invoking GHCI (via stack ghci). diff --git a/src/Stack/PackageFile.hs b/src/Stack/PackageFile.hs index 6d378cea16..4052d93ee9 100644 --- a/src/Stack/PackageFile.hs +++ b/src/Stack/PackageFile.hs @@ -117,15 +117,15 @@ getPackageFile :: => Package -> Path Abs File -> m PackageComponentFile -getPackageFile pkg cabalfp = - debugBracket ("getPackageFiles" <+> pretty cabalfp) $ do - let pkgDir = parent cabalfp +getPackageFile pkg cabalFP = + debugBracket ("getPackageFiles" <+> pretty cabalFP) $ do + let pkgDir = parent cabalFP distDir <- distDirFromDir pkgDir bc <- view buildConfigL cabalVer <- view cabalVersionL packageComponentFile <- runRIO - (GetPackageFileContext cabalfp distDir bc cabalVer) + (GetPackageFileContext cabalFP distDir bc cabalVer) (packageDescModulesAndFiles pkg) setupFiles <- if pkg.buildType == Cabal.Custom @@ -141,7 +141,7 @@ getPackageFile pkg cabalfp = then pure (S.singleton setupLhsPath) else pure S.empty else pure S.empty - moreBuildFiles <- fmap (S.insert cabalfp . S.union setupFiles) $ do + moreBuildFiles <- fmap (S.insert cabalFP . S.union setupFiles) $ do let hpackPath = pkgDir relFileHpackPackageConfig hpackExists <- doesFileExist hpackPath pure $ if hpackExists then S.singleton hpackPath else S.empty diff --git a/src/Stack/Query.hs b/src/Stack/Query.hs index 83d5ebe001..fcc3200124 100644 --- a/src/Stack/Query.hs +++ b/src/Stack/Query.hs @@ -108,7 +108,8 @@ queryBuildInfo selectors0 = rawBuildInfo :: HasEnvConfig env => RIO env Value rawBuildInfo = do locals <- projectLocalPackages - wantedCompiler <- view $ wantedCompilerVersionL . to (utf8BuilderToText . display) + wantedCompiler <- + view $ wantedCompilerVersionL . to (utf8BuilderToText . display) actualCompiler <- view $ actualCompilerVersionL . to compilerVersionText pure $ object [ "locals" .= Object (KeyMap.fromList $ map localToPair locals) @@ -124,5 +125,5 @@ rawBuildInfo = do p = lp.package value = object [ "version" .= CabalString p.version - , "path" .= toFilePath (parent lp.cabalFile) + , "path" .= toFilePath (parent lp.cabalFP) ] diff --git a/src/Stack/SDist.hs b/src/Stack/SDist.hs index 34e6e7effb..65ba45cf5a 100644 --- a/src/Stack/SDist.hs +++ b/src/Stack/SDist.hs @@ -111,15 +111,15 @@ instance Pretty SDistPrettyException where <> flow "Package check reported the following errors:" <> line <> bulletedList (map (string . show) (NE.toList xs) :: [StyleDoc]) - pretty (CabalFilePathsInconsistentBug cabalfp cabalfp') = + pretty (CabalFilePathsInconsistentBug cabalFP cabalFP') = "[S-9595]" <> line <> fillSep [ flow "The impossible happened! Two Cabal file paths are \ \inconsistent:" - , pretty cabalfp + , pretty cabalFP , "and" - , pretty cabalfp' <> "." + , pretty cabalFP' <> "." ] pretty (ToTarPathException e) = "[S-7875]" @@ -234,7 +234,7 @@ getSDistTarball mpvpBounds pkgDir = do [ flow "Getting the file list for" , style File (fromString pkgFp) <> "." ] - (fileList, cabalfp) <- getSDistFileList lp deps + (fileList, cabalFP) <- getSDistFileList lp deps prettyInfoL [ flow "Building a compressed archive file in the sdist format for" , style File (fromString pkgFp) <> "." @@ -263,18 +263,18 @@ getSDistTarball mpvpBounds pkgDir = do -- This is a Cabal file, we're going to tweak it, but only tweak it as a -- revision. | tweakCabal && isCabalFp fp && asRevision = do - lbsIdent <- getCabalLbs pvpBounds (Just 1) cabalfp sourceMap + lbsIdent <- getCabalLbs pvpBounds (Just 1) cabalFP sourceMap liftIO (writeIORef cabalFileRevisionRef (Just lbsIdent)) packWith packFileEntry False fp -- Same, except we'll include the Cabal file in the original tarball -- upload. | tweakCabal && isCabalFp fp = do - (_ident, lbs) <- getCabalLbs pvpBounds Nothing cabalfp sourceMap + (_ident, lbs) <- getCabalLbs pvpBounds Nothing cabalFP sourceMap currTime <- liftIO getPOSIXTime -- Seconds from UNIX epoch tp <- liftIO $ tarPath False fp pure $ (Tar.fileEntry tp lbs) { Tar.entryTime = floor currTime } | otherwise = packWith packFileEntry False fp - isCabalFp fp = toFilePath pkgDir FP. fp == toFilePath cabalfp + isCabalFp fp = toFilePath pkgDir FP. fp == toFilePath cabalFP tarName = pkgIdName FP.<.> "tar.gz" pkgIdName = packageIdentifierString pkgId pkgId = packageIdentifier lp.package @@ -295,12 +295,12 @@ getCabalLbs :: -> Path Abs File -- ^ Cabal file -> SourceMap -> RIO env (PackageIdentifier, L.ByteString) -getCabalLbs pvpBounds mrev cabalfp sourceMap = do - (gpdio, _name, cabalfp') <- - loadCabalFilePath (Just stackProgName') (parent cabalfp) +getCabalLbs pvpBounds mrev cabalFP sourceMap = do + (gpdio, _name, cabalFP') <- + loadCabalFilePath (Just stackProgName') (parent cabalFP) gpd <- liftIO $ gpdio NoPrintWarnings - unless (cabalfp == cabalfp') $ - prettyThrowIO $ CabalFilePathsInconsistentBug cabalfp cabalfp' + unless (cabalFP == cabalFP') $ + prettyThrowIO $ CabalFilePathsInconsistentBug cabalFP cabalFP' installMap <- toInstallMap sourceMap (installedMap, _, _, _) <- getInstalled installMap let subLibPackages = Set.fromList $ @@ -334,7 +334,7 @@ getCabalLbs pvpBounds mrev cabalfp sourceMap = do fillSep [ flow "Bug detected in Cabal library. ((parse . render . parse) \ \=== id) does not hold for the Cabal file at" - , pretty cabalfp + , pretty cabalFP ] <> blankLine (_warnings, eres) = Cabal.runParseResult @@ -456,14 +456,14 @@ gtraverseT f = readLocalPackage :: HasEnvConfig env => Path Abs Dir -> RIO env LocalPackage readLocalPackage pkgDir = do config <- getDefaultPackageConfig - (gpdio, _, cabalfp) <- loadCabalFilePath (Just stackProgName') pkgDir + (gpdio, _, cabalFP) <- loadCabalFilePath (Just stackProgName') pkgDir gpd <- liftIO $ gpdio YesPrintWarnings let package = resolvePackage config gpd pure LocalPackage - { package = package + { package , wanted = False -- HACK: makes it so that sdist output goes to a log -- instead of a file. - , cabalFile = cabalfp + , cabalFP -- NOTE: these aren't the 'correct' values, but aren't used in the usage of -- this function in this module. , testBench = Nothing @@ -494,14 +494,14 @@ getSDistFileList lp deps = -- custom Setup.hs files $ \ee -> withSingleContext ac ee taskType deps (Just "sdist") $ - \_package cabalfp _pkgDir cabal _announce _outputType -> do + \_package cabalFP _pkgDir cabal _announce _outputType -> do let outFile = toFilePath tmpdir FP. "source-files-list" cabal CloseOnException KeepTHLoading ["sdist", "--list-sources", outFile] contents <- liftIO (S.readFile outFile) - pure (T.unpack $ T.decodeUtf8With T.lenientDecode contents, cabalfp) + pure (T.unpack $ T.decodeUtf8With T.lenientDecode contents, cabalFP) where ac = ActionContext Set.empty [] ConcurrencyAllowed taskType = TTLocalMutable lp diff --git a/src/Stack/Setup.hs b/src/Stack/Setup.hs index 00912eb522..21eb00afb0 100644 --- a/src/Stack/Setup.hs +++ b/src/Stack/Setup.hs @@ -684,7 +684,7 @@ setupEnv needTargets buildOptsCLI mResolveMissingGHC = do let actualPkgs = Map.keysSet smActual.deps <> Map.keysSet smActual.project prunedActual = smActual - { global = pruneGlobals smActual.global actualPkgs } + { globals = pruneGlobals smActual.globals actualPkgs } haddockDeps = shouldHaddockDeps config.build targets <- parseTargets needTargets haddockDeps buildOptsCLI prunedActual sourceMap <- loadSourceMap targets buildOptsCLI smActual @@ -958,7 +958,7 @@ rebuildEnv envConfig needTargets haddockDeps boptsCLI = do let actualPkgs = Map.keysSet smActual.deps <> Map.keysSet smActual.project prunedActual = smActual - { global = pruneGlobals smActual.global actualPkgs } + { globals = pruneGlobals smActual.globals actualPkgs } targets <- parseTargets needTargets haddockDeps boptsCLI prunedActual sourceMap <- loadSourceMap targets boptsCLI smActual pure $ envConfig diff --git a/src/Stack/SourceMap.hs b/src/Stack/SourceMap.hs index fb4830bec1..b9f93924dc 100644 --- a/src/Stack/SourceMap.hs +++ b/src/Stack/SourceMap.hs @@ -60,20 +60,20 @@ mkProjectPackage :: -> Bool -- ^ Should Haddock documentation be built for the package? -> RIO env ProjectPackage -mkProjectPackage printWarnings dir buildHaddocks = do - (gpd, name, cabalfp) <- - loadCabalFilePath (Just stackProgName') (resolvedAbsolute dir) +mkProjectPackage printWarnings resolvedDir buildHaddocks = do + (gpd, name, cabalFP) <- + loadCabalFilePath (Just stackProgName') (resolvedAbsolute resolvedDir) pure ProjectPackage - { cabalFP = cabalfp - , resolvedDir = dir + { cabalFP + , resolvedDir , projectCommon = CommonPackage { gpd = gpd printWarnings - , name = name + , name , flags = mempty , ghcOptions = mempty , cabalConfigOpts = mempty - , haddocks = buildHaddocks + , buildHaddocks } } @@ -85,29 +85,29 @@ additionalDepPackage :: -- ^ Should Haddock documentation be built for the package? -> PackageLocation -> RIO env DepPackage -additionalDepPackage buildHaddocks pl = do - (name, gpdio) <- - case pl of +additionalDepPackage buildHaddocks location = do + (name, gpd) <- + case location of PLMutable dir -> do - (gpdio, name, _cabalfp) <- + (gpd, name, _cabalfp) <- loadCabalFilePath (Just stackProgName') (resolvedAbsolute dir) - pure (name, gpdio NoPrintWarnings) + pure (name, gpd NoPrintWarnings) PLImmutable pli -> do let PackageIdentifier name _ = packageLocationIdent pli run <- askRunInIO pure (name, run $ loadCabalFileImmutable pli) pure DepPackage - { location = pl + { location , hidden = False , fromSnapshot = NotFromSnapshot , depCommon = CommonPackage - { gpd = gpdio - , name = name + { gpd + , name , flags = mempty , ghcOptions = mempty , cabalConfigOpts = mempty - , haddocks = buildHaddocks + , buildHaddocks } } @@ -127,11 +127,11 @@ snapToDepPackage buildHaddocks name sp = do , depCommon = CommonPackage { gpd = run $ loadCabalFileImmutable sp.spLocation - , name = name + , name , flags = sp.spFlags , ghcOptions = sp.spGhcOptions , cabalConfigOpts = [] -- No spCabalConfigOpts, not present in snapshots - , haddocks = buildHaddocks + , buildHaddocks } } @@ -178,14 +178,14 @@ actualFromGhc :: => SMWanted -> ActualCompiler -> RIO env (SMActual DumpedGlobalPackage) -actualFromGhc smw ac = do +actualFromGhc smw compiler = do globals <- view $ compilerPathsL . to (.globalDump) pure SMActual - { compiler = ac + { compiler , project = smw.project , deps = smw.deps - , global = globals + , globals } actualFromHints :: @@ -193,14 +193,14 @@ actualFromHints :: => SMWanted -> ActualCompiler -> RIO env (SMActual GlobalPackageVersion) -actualFromHints smw ac = do - globals <- globalsFromHints (actualToWanted ac) +actualFromHints smw compiler = do + globals <- globalsFromHints (actualToWanted compiler) pure SMActual - { compiler = ac + { compiler , project = smw.project , deps = smw.deps - , global = Map.map GlobalPackageVersion globals + , globals = Map.map GlobalPackageVersion globals } -- | Simple cond check for boot packages - checks only OS and Arch @@ -296,14 +296,14 @@ loadProjectSnapshotCandidate loc printWarnings buildHaddocks = do let wc = snapshotCompiler snapshot globals <- Map.map GlobalPackageVersion <$> globalsFromHints wc pure $ \projectPackages -> do - prjPkgs <- fmap Map.fromList . for projectPackages $ \resolved -> do + project <- fmap Map.fromList . for projectPackages $ \resolved -> do pp <- mkProjectPackage printWarnings resolved buildHaddocks pure (pp.projectCommon.name, pp) compiler <- either throwIO pure $ wantedToActual $ snapshotCompiler snapshot pure SMActual - { compiler = compiler - , project = prjPkgs - , deps = Map.difference deps prjPkgs - , global = globals + { compiler + , project + , deps = Map.difference deps project + , globals } diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs index e6fbe1a489..c5415ad7ef 100644 --- a/src/Stack/Types/Build.hs +++ b/src/Stack/Types/Build.hs @@ -129,7 +129,7 @@ instance PersistFieldSql CachePkgSrc where toCachePkgSrc :: PackageSource -> CachePkgSrc toCachePkgSrc (PSFilePath lp) = - CacheSrcLocal (toFilePath (parent lp.cabalFile)) + CacheSrcLocal (toFilePath (parent lp.cabalFP)) toCachePkgSrc PSRemote{} = CacheSrcUpstream -- | A type representing tasks to perform when building. @@ -140,7 +140,7 @@ data Task = Task -- ^ A set of the package identifiers of dependencies for which 'GhcPkgId' -- are missing and a function which yields configure options, given a -- dictionary of those identifiers and their 'GhcPkgId'. - , buildHaddock :: !Bool + , buildHaddocks :: !Bool , present :: !(Map PackageIdentifier GhcPkgId) -- ^ A dictionary of the package identifiers of already-installed -- dependencies, and their 'GhcPkgId'. diff --git a/src/Stack/Types/BuildOpts.hs b/src/Stack/Types/BuildOpts.hs index aba14c7082..b93057486c 100644 --- a/src/Stack/Types/BuildOpts.hs +++ b/src/Stack/Types/BuildOpts.hs @@ -24,8 +24,8 @@ data BuildOpts = BuildOpts , exeProfile :: !Bool , libStrip :: !Bool , exeStrip :: !Bool - , haddock :: !Bool - -- ^ Build haddocks? + , buildHaddocks :: !Bool + -- ^ Build Haddock documentation? , haddockOpts :: !HaddockOpts -- ^ Options to pass to haddock , openHaddocks :: !Bool @@ -111,4 +111,5 @@ buildOptsInstallExesL = lens (.installExes) (\bopts t -> bopts {installExes = t}) buildOptsHaddockL :: Lens' BuildOpts Bool -buildOptsHaddockL = lens (.haddock) (\bopts t -> bopts {haddock = t}) +buildOptsHaddockL = + lens (.buildHaddocks) (\bopts t -> bopts {buildHaddocks = t}) diff --git a/src/Stack/Types/BuildOptsMonoid.hs b/src/Stack/Types/BuildOptsMonoid.hs index 87012fc3d1..84ac516e57 100644 --- a/src/Stack/Types/BuildOptsMonoid.hs +++ b/src/Stack/Types/BuildOptsMonoid.hs @@ -41,7 +41,7 @@ data BuildOptsMonoid = BuildOptsMonoid , exeProfile :: !FirstFalse , libStrip :: !FirstTrue , exeStrip :: !FirstTrue - , haddock :: !FirstFalse + , buildHaddocks :: !FirstFalse , haddockOpts :: !HaddockOptsMonoid , openHaddocks :: !FirstFalse , haddockDeps :: !(First Bool) @@ -77,7 +77,7 @@ instance FromJSON (WithJSONWarnings BuildOptsMonoid) where exeProfile <-FirstFalse <$> o ..:? exeProfileArgName libStrip <- FirstTrue <$> o ..:? libStripArgName exeStrip <-FirstTrue <$> o ..:? exeStripArgName - haddock <- FirstFalse <$> o ..:? haddockArgName + buildHaddocks <- FirstFalse <$> o ..:? haddockArgName haddockOpts <- jsonSubWarnings (o ..:? haddockOptsArgName ..!= mempty) openHaddocks <- FirstFalse <$> o ..:? openHaddocksArgName haddockDeps <- First <$> o ..:? haddockDepsArgName @@ -111,7 +111,7 @@ instance FromJSON (WithJSONWarnings BuildOptsMonoid) where , exeProfile , libStrip , exeStrip - , haddock + , buildHaddocks , haddockOpts , openHaddocks , haddockDeps @@ -355,8 +355,8 @@ instance Parsec CabalVerbosity where buildOptsMonoidHaddockL :: Lens' BuildOptsMonoid (Maybe Bool) buildOptsMonoidHaddockL = - lens (.haddock.getFirstFalse) - (\buildMonoid t -> buildMonoid {haddock = FirstFalse t}) + lens (.buildHaddocks.getFirstFalse) + (\buildMonoid t -> buildMonoid {buildHaddocks = FirstFalse t}) buildOptsMonoidTestsL :: Lens' BuildOptsMonoid (Maybe Bool) buildOptsMonoidTestsL = diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 6484c1350a..8d53459b3e 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -291,8 +291,8 @@ data LocalPackage = LocalPackage , testBench :: !(Maybe Package) -- ^ This stores the 'Package' with tests and benchmarks enabled, if either -- is asked for by the user. - , cabalFile :: !(Path Abs File) - -- ^ The Cabal file + , cabalFP :: !(Path Abs File) + -- ^ Absolute path to the Cabal file. , buildHaddocks :: !Bool -- ^ Is Haddock documentation being built for this package? , forceDirty :: !Bool diff --git a/src/Stack/Types/SourceMap.hs b/src/Stack/Types/SourceMap.hs index bcd691a564..4b363a5c1d 100644 --- a/src/Stack/Types/SourceMap.hs +++ b/src/Stack/Types/SourceMap.hs @@ -51,7 +51,7 @@ data CommonPackage = CommonPackage , ghcOptions :: ![Text] -- also lets us know if we're doing profiling , cabalConfigOpts :: ![Text] - , haddocks :: !Bool + , buildHaddocks :: !Bool -- ^ Should Haddock documentation be built for this package? } @@ -117,7 +117,7 @@ data SMActual global = SMActual { compiler :: !ActualCompiler , project :: !(Map PackageName ProjectPackage) , deps :: !(Map PackageName DepPackage) - , global :: !(Map PackageName global) + , globals :: !(Map PackageName global) } newtype GlobalPackageVersion diff --git a/tests/unit/Stack/ConfigSpec.hs b/tests/unit/Stack/ConfigSpec.hs index 610d5a5856..d8dde37d51 100644 --- a/tests/unit/Stack/ConfigSpec.hs +++ b/tests/unit/Stack/ConfigSpec.hs @@ -193,7 +193,7 @@ spec = beforeAll setup $ do let bopts = config.build bopts.libProfile `shouldBe` True bopts.exeProfile `shouldBe` True - bopts.haddock `shouldBe` True + bopts.buildHaddocks `shouldBe` True bopts.haddockDeps `shouldBe` Just True bopts.installExes `shouldBe` True bopts.preFetch `shouldBe` True