From 101c522374c2761416f68ba9c0a31e76e975bc21 Mon Sep 17 00:00:00 2001 From: theophilebatoz Date: Mon, 10 Apr 2023 23:14:20 +0000 Subject: [PATCH 01/42] refactoring: move getPackageFile to package file module --- src/Stack/PackageFile.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/Stack/PackageFile.hs b/src/Stack/PackageFile.hs index 8ac13bdac7..b5455ab965 100644 --- a/src/Stack/PackageFile.hs +++ b/src/Stack/PackageFile.hs @@ -42,6 +42,12 @@ import Stack.Types.PackageFile ) import qualified System.FilePath as FilePath import System.IO.Error ( isUserError ) +import Stack.Constants.Config ( distDirFromDir ) +import Stack.Types.Config + ( HasBuildConfig(buildConfigL), cabalVersionL, HasEnvConfig ) +import Stack.Constants + ( relFileSetupHs, relFileSetupLhs, relFileHpackPackageConfig ) +import Path.IO (doesFileExist) -- | Resolve the file, if it can't be resolved, warn for the user -- (purely to be helpful). From 73d2fa4859678bfa5cf72ad0e84e8289555443e0 Mon Sep 17 00:00:00 2001 From: theophilebatoz Date: Sun, 13 Nov 2022 22:58:51 +0000 Subject: [PATCH 02/42] feat: provide component building blocks --- src/Stack/Component.hs | 159 ++++++++++++++++++++++++++++++ src/Stack/PackageFile.hs | 11 ++- src/Stack/Types/CompCollection.hs | 121 +++++++++++++++++++++++ src/Stack/Types/Component.hs | 141 ++++++++++++++++++++++++++ src/Stack/Types/Dependency.hs | 9 +- stack.cabal | 5 +- 6 files changed, 439 insertions(+), 7 deletions(-) create mode 100644 src/Stack/Component.hs create mode 100644 src/Stack/Types/CompCollection.hs create mode 100644 src/Stack/Types/Component.hs diff --git a/src/Stack/Component.hs b/src/Stack/Component.hs new file mode 100644 index 0000000000..4e74d993ba --- /dev/null +++ b/src/Stack/Component.hs @@ -0,0 +1,159 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} + +-- | All utility functions for Components (library, internal library, foreign library, executable, tests, benchmarks) in stack. +-- In particular, this module gathers all the Cabal-to-Stack component translations, which previlously occured in the "Stack.Package" module. +-- See "Stack.Types.Component" for more details about the design choices. + +module Stack.Component + ( isComponentBuildable + , stackLibraryFromCabal + , stackExecutableFromCabal + , stackForeignLibraryFromCabal + , stackBenchmarkFromCabal + , stackTestFromCabal + ) + where +import Stack.Prelude +import Stack.Types.Component +import Stack.Types.Dependency ( cabalExeToStackDep, cabalToStackDep ) +import Distribution.PackageDescription (Library (libName), ForeignLib, TestSuite (testName, testBuildInfo, testInterface), Benchmark (benchmarkBuildInfo, benchmarkName), Executable) +import Distribution.Types.BuildInfo (BuildInfo) +import qualified Distribution.Types.BuildInfo as BI +import Distribution.Types.LibraryName (LibraryName(LMainLibName, LSubLibName)) +import qualified Distribution.Types.Library +import qualified Distribution.Types.ForeignLib +import qualified Distribution.Types.Executable +import Data.Text (pack) +import Distribution.Types.UnqualComponentName (UnqualComponentName) +import qualified Distribution.PackageDescription as Cabal +import qualified Data.Map as Map +import qualified Data.Set as Set +import Distribution.Package (mkPackageName) + +fromCabalName :: UnqualComponentName -> StackUnqualCompName +fromCabalName unqualName = StackUnqualCompName $ pack . Cabal.unUnqualComponentName $ unqualName + +stackLibraryFromCabal :: Library -> StackLibrary +stackLibraryFromCabal cabalLib = StackLibrary { + name=case cabalLib.libName of + LMainLibName -> StackUnqualCompName mempty + LSubLibName v -> fromCabalName v, + buildInfo=stackBuildInfoFromCabal cabalLib.libBuildInfo, + exposedModules=cabalLib.exposedModules + } +stackExecutableFromCabal :: Executable -> StackExecutable +stackExecutableFromCabal cabalExecutable = StackExecutable { + name=fromCabalName cabalExecutable.exeName, + buildInfo=stackBuildInfoFromCabal cabalExecutable.buildInfo, + modulePath=cabalExecutable.modulePath + } +stackForeignLibraryFromCabal :: ForeignLib -> StackForeignLibrary +stackForeignLibraryFromCabal cabalForeignLib = StackForeignLibrary { + name=fromCabalName cabalForeignLib.foreignLibName, + buildInfo=stackBuildInfoFromCabal cabalForeignLib.foreignLibBuildInfo + } +stackBenchmarkFromCabal :: Benchmark -> StackBenchmark +stackBenchmarkFromCabal cabalBenchmark = StackBenchmark { + name=fromCabalName cabalBenchmark.benchmarkName, + interface=cabalBenchmark.benchmarkInterface, + buildInfo=stackBuildInfoFromCabal cabalBenchmark.benchmarkBuildInfo + } +stackTestFromCabal :: TestSuite -> StackTest +stackTestFromCabal cabalTest = StackTest { + name=fromCabalName cabalTest.testName, + interface=cabalTest.testInterface, + buildInfo=stackBuildInfoFromCabal cabalTest.testBuildInfo + } + +isComponentBuildable :: HasBuildInfo component => component -> Bool +isComponentBuildable componentRec = componentRec.buildInfo.sbiBuildable + +stackBuildInfoFromCabal :: BuildInfo -> StackBuildInfo +stackBuildInfoFromCabal buildInfoV = gatherComponentToolsAndDepsFromCabal + buildInfoV.buildTools + buildInfoV.buildToolDepends + buildInfoV.targetBuildDepends + StackBuildInfo { + sbiBuildable = buildInfoV.buildable, + sbiOtherModules = buildInfoV.otherModules, + sbiJsSources = buildInfoV.jsSources, + hsSourceDirs = buildInfoV.hsSourceDirs, + cSource = buildInfoV.cSources, + sbiDependency = mempty, + sbiUnknownTools = mempty + } + +-- | Iterate on all three dependency list given, and transform and sort them between sbiUnknownTools +-- and legitimate 'DepValue' sbiDependency. +-- Bear in mind that this only gathers the component level dependencies. +gatherComponentToolsAndDepsFromCabal + :: [Cabal.LegacyExeDependency] + -- ^ Legacy build tools dependency from [buildTools](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-BuildInfo.html#t:buildTools). + -> [Cabal.ExeDependency] + -- ^ Build tools dependency [buildToolDepends](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-BuildInfo.html#t:buildToolDepends) + -> [Cabal.Dependency] + -- ^ The Cabal defined [targetBuildDepends](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-BuildInfo.html#t:targetBuildDepends), + -- these are the simplest dependencies for a component extracted from the cabal file such as : + -- @ + -- build-depends: + -- foo ^>= 1.2.3.4, + -- bar ^>= 1 + -- @ + -> StackBuildInfo + -> StackBuildInfo +gatherComponentToolsAndDepsFromCabal legacyBuildTools buildTools targetDeps = gatherTargetDependency . gatherToolsDependency . gatherUnknownTools + where + gatherUnknownTools sbi = foldl' processLegacyExeDepency sbi legacyBuildTools + gatherToolsDependency sbi = foldl' processExeDependency sbi buildTools + gatherTargetDependency sbi = foldl' processDependency sbi targetDeps + -- This is similar to [desugarBuildTool](https://hackage.haskell.org/package/Cabal/docs/src/Distribution.Simple.BuildToolDepends.html#desugarBuildTool) + -- from Cabal, however it uses our own hard-coded map which drops tools shipped with + -- GHC (like hsc2hs), and includes some tools from Stackage. + processLegacyExeDepency sbi (Cabal.LegacyExeDependency exeName range) = case isKnownLegacyExe exeName of + Just pName -> processExeDependency sbi (Cabal.ExeDependency pName (Cabal.mkUnqualComponentName exeName) range) + Nothing -> sbi{sbiUnknownTools = Set.insert (pack exeName) $ sbiUnknownTools sbi} + processExeDependency sbi exeDep@(Cabal.ExeDependency pName _ _) + | isPreInstalledPackages pName = sbi + | otherwise = sbi{sbiDependency = Map.insert pName (cabalExeToStackDep exeDep) $ sbiDependency sbi} + processDependency sbi dep@(Cabal.Dependency pName _ _) = sbi{ + sbiDependency = Map.insert pName (cabalToStackDep dep) $ sbiDependency sbi + } + +-- | A hard-coded map for tool dependencies. +-- If a dependency is within this map it's considered "known" (the exe will be found at the execution stage). +-- [It also exists in Cabal](https://hackage.haskell.org/package/Cabal/docs/src/Distribution.Simple.BuildToolDepends.html#local-6989586621679259154) +isKnownLegacyExe :: String -> Maybe PackageName +isKnownLegacyExe input = case input of + "alex" -> justPck "alex" + "happy" -> justPck "happy" + "cpphs" -> justPck "cpphs" + "greencard" -> justPck "greencard" + "c2hs" -> justPck "c2hs" + "hscolour" -> justPck "hscolour" + "hspec-iscover" -> justPck "hspec-discover" + "hsx2hs" -> justPck "hsx2hs" + "gtk2hsC2hs" -> justPck "gtk2hs-buildtools" + "gtk2hsHookGenerator" -> justPck "gtk2hs-buildtools" + "gtk2hsTypeGen" -> justPck "gtk2hs-buildtools" + _ -> Nothing + where justPck = Just . mkPackageName + +-- | Executable-only packages which come pre-installed with GHC and do +-- not need to be built. Without this exception, we would either end +-- up unnecessarily rebuilding these packages, or failing because the +-- packages do not appear in the Stackage snapshot. +isPreInstalledPackages :: PackageName -> Bool +isPreInstalledPackages input = case input of + "hsc2hs" -> True + "haddock" -> True + _ -> False diff --git a/src/Stack/PackageFile.hs b/src/Stack/PackageFile.hs index b5455ab965..a981ee0bd8 100644 --- a/src/Stack/PackageFile.hs +++ b/src/Stack/PackageFile.hs @@ -43,11 +43,12 @@ import Stack.Types.PackageFile import qualified System.FilePath as FilePath import System.IO.Error ( isUserError ) import Stack.Constants.Config ( distDirFromDir ) -import Stack.Types.Config - ( HasBuildConfig(buildConfigL), cabalVersionL, HasEnvConfig ) -import Stack.Constants - ( relFileSetupHs, relFileSetupLhs, relFileHpackPackageConfig ) -import Path.IO (doesFileExist) +import Stack.Types.CompilerPaths ( cabalVersionL ) +import Stack.Types.BuildConfig + ( HasBuildConfig(buildConfigL) ) +import Stack.Constants + ( relFileSetupHs, relFileSetupLhs, relFileHpackPackageConfig ) +import Path.IO (doesFileExist) -- | Resolve the file, if it can't be resolved, warn for the user -- (purely to be helpful). diff --git a/src/Stack/Types/CompCollection.hs b/src/Stack/Types/CompCollection.hs new file mode 100644 index 0000000000..3539ddd9eb --- /dev/null +++ b/src/Stack/Types/CompCollection.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} + +-- | A package has collections of "Stack.Types.Component". +-- In Cabal, the components are grouped as a list in a @PackageDescription@, this is stack's counterpart +-- (See for instance [the foreign libraries field in cabal](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-PackageDescription.html#t:GenericPackageDescription)). +-- Cabal removes all the unbuildable components very early (at the price of slightly worse error messages) and it historically used a list for components. +-- For , as well as set listed for backward compatbility at least, hence this structure. +module Stack.Types.CompCollection + ( CompCollection + , getBuildableSet + , getBuildableSetText + , getBuildableListText + , getBuildableListAs + , foldAndMakeCollection + , hasBuildableComponent + , collectionLookup + , collectionKeyValueList + ) +where +import Stack.Prelude +import Stack.Types.Component (HasName, HasBuildInfo, StackBuildInfo(..), unqualCompToText, StackUnqualCompName(StackUnqualCompName)) +import qualified Data.HashMap.Strict as HM +import qualified Data.Set as Set +import qualified Data.Foldable + +-- | This is a collection discriminating buildable components and non buildable ones. +data CompCollection component + = CompCollection { + buildableOnes :: {-# UNPACK #-} !(InnerCollection component), + unbuildableOnes :: Set StackUnqualCompName + -- ^ Note that the field is lazy beacause it should only serve when users explicitely require + -- unbuildable components to be built (and this field ensure intelligible error messages). + } deriving (Show) +instance Semigroup (CompCollection component) where + a <> b = CompCollection { + buildableOnes = buildableOnes a <> buildableOnes b, + unbuildableOnes = unbuildableOnes a <> unbuildableOnes b + } +instance Monoid (CompCollection component) where + mempty = CompCollection { + buildableOnes = mempty, + unbuildableOnes = mempty + } + +-- | This is a naive collection which trades memory consumption +-- for velocity, the name set is strictly redundant but it takes O(n) +-- to compute it from the map's keys, hence the redundancy. +-- The assumption is 'asNameSet' is always equal to @keySet . asNameMap@, +-- but faster because cached. But this assumption is not checked anywhere, it's simply +-- built into the 'addComponent' function, which should always be used rather than record's fields +-- for inserting new elements. +data InnerCollection component + = InnerCollection { + asNameMap :: !(HashMap StackUnqualCompName component), + asNameSet :: !(Set StackUnqualCompName) + } deriving (Show) +instance Semigroup (InnerCollection component) where + a <> b = InnerCollection { + asNameMap = asNameMap a <> asNameMap b, + asNameSet = asNameSet a <> asNameSet b + } +instance Monoid (InnerCollection component) where + mempty = InnerCollection { + asNameMap = mempty, + asNameSet = mempty + } + +instance Foldable CompCollection where + foldMap fn collection = foldMap fn (asNameMap $ buildableOnes collection) + foldr' fn c collection = HM.foldr' fn c (asNameMap $ buildableOnes collection) + null = HM.null . asNameMap . buildableOnes + + +-- | +-- +-- >>> :set -XOverloadedStrings +-- >>> import Stack.Types.Component (StackUnqualCompName(StackUnqualCompName)) +-- >>> data TestComp = TestComp { name :: StackUnqualCompName } deriving (Show) +-- >>> let ok = TestComp (StackUnqualCompName "some-comp-name") +-- >>> addComponent ok mempty +-- InnerCollection {asNameMap = fromList [(StackUnqualCompName "some-comp-name",TestComp {name = StackUnqualCompName "some-comp-name"})], asNameSet = fromList [StackUnqualCompName "some-comp-name"]} +addComponent :: HasName component => component -> InnerCollection component -> InnerCollection component +addComponent componentV collection = let nameV = componentV.name in collection { + asNameMap=HM.insert nameV componentV (asNameMap collection), + asNameSet=Set.insert nameV (asNameSet collection) + } + +-- | Iterates on a collection of @compA@ and map each element to @compB@ while +-- building the corresponding @CompCollection@ out of it. +-- +foldAndMakeCollection :: (HasBuildInfo compB, HasName compB, Foldable sourceCollection) => (compA -> compB) -> sourceCollection compA -> CompCollection compB +foldAndMakeCollection mapFn = foldl' compIterator mempty + where + compIterator existingCollection component = compCreator existingCollection (mapFn component) + compCreator existingCollection component + | component.buildInfo.sbiBuildable = existingCollection{buildableOnes = addComponent component (buildableOnes existingCollection)} + | otherwise = existingCollection{unbuildableOnes = Set.insert component.name (unbuildableOnes existingCollection)} + + +-- | Get the name set of buildable components from this collection. +getBuildableSet :: CompCollection component -> Set StackUnqualCompName +getBuildableSet = asNameSet . buildableOnes + +getBuildableSetText :: CompCollection component -> Set Text +getBuildableSetText = Set.mapMonotonic unqualCompToText . getBuildableSet +getBuildableListText :: CompCollection component -> [] Text +getBuildableListText = getBuildableListAs unqualCompToText +getBuildableListAs :: (StackUnqualCompName -> something) -> CompCollection component -> [] something +getBuildableListAs fn = Set.foldr' (\v l -> fn v:l) [] . getBuildableSet + +hasBuildableComponent :: CompCollection component -> Bool +hasBuildableComponent = not . null . getBuildableSet + +collectionLookup :: Text -> CompCollection component -> Maybe component +collectionLookup needle haystack = HM.lookup (StackUnqualCompName needle) (asNameMap $ buildableOnes haystack) +collectionKeyValueList :: CompCollection component -> [(Text, component)] +collectionKeyValueList haystack = (\(StackUnqualCompName k, v) -> (k, v)) <$> HM.toList (asNameMap $ buildableOnes haystack) \ No newline at end of file diff --git a/src/Stack/Types/Component.hs b/src/Stack/Types/Component.hs new file mode 100644 index 0000000000..09345a8aad --- /dev/null +++ b/src/Stack/Types/Component.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} + +-- | All component related types (library, internal library, foreign library, executable, tests, benchmarks) in stack. +-- The chosen design replicates many of cabal existing things but in simplified +-- and sometimes more typed versions. It's a work in progress to bring +-- Stack to a more componentized design, and closer to cabal. +module Stack.Types.Component( + HasName, + HasBuildInfo, + StackBenchmark(..), + StackBuildInfo(..), + StackExecutable(..), + StackForeignLibrary(..), + StackLibrary(..), + StackTest(..), + StackUnqualCompName(..), + unqualCompToText +) where + +import Stack.Prelude +import Stack.Types.Dependency (DepValue) +import GHC.Records (HasField) +import Distribution.PackageDescription (BenchmarkInterface, TestSuiteInterface) +import Distribution.ModuleName (ModuleName) +import Distribution.Utils.Path (SymbolicPath, PackageDir, SourceDir) + +type HasName component = HasField "name" component StackUnqualCompName +type HasBuildInfo component = HasField "buildInfo" component StackBuildInfo + +-- | A main or sub library. We do not keep the [Cabal ADT name distinction](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-LibraryName.html#t:LibraryName) +-- because in Cabal 3.0 it's [likely](https://github.com/haskell/cabal/issues/8567) that the main/sub distinction doesn't make sense anymore. +-- Besides, the missing name from main libe can simply be encoded as an empty string for backward compatibility without loosing info. +-- Through this simplification we get a clean name interface for all components (they all have a potentially mempty name of the same type). +-- +-- [Library](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Library.html) is the Cabal equivalent. +-- +data StackLibrary = + StackLibrary + { name :: StackUnqualCompName + , buildInfo :: !StackBuildInfo + , exposedModules :: [ModuleName] + -- ^ This is only used for gathering the files related to this component. + } + deriving (Show, Typeable) + +-- Stack foreign libraries. +-- +-- [ForeignLib](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Foreign-Libraries.html) is the Cabal equivalent. +-- +data StackForeignLibrary = + StackForeignLibrary + { name :: StackUnqualCompName + , buildInfo :: !StackBuildInfo + } + deriving (Show, Typeable) + +-- Stack executable. +-- +-- [Executable](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Executable.html) is the Cabal equivalent. +-- +data StackExecutable = + StackExecutable + { name :: StackUnqualCompName + , buildInfo :: !StackBuildInfo + , modulePath :: FilePath + } + deriving (Show, Typeable) + +-- Stack test. +-- +-- [TestSuite](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-TestSuite.html) is the Cabal equivalent. +-- +data StackTest = + StackTest + { name :: StackUnqualCompName + , buildInfo :: !StackBuildInfo + , interface :: !TestSuiteInterface + } + deriving (Show, Typeable) + +-- Stack benchmark. +-- +-- [Benchmark](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Benchmark.html) is the Cabal equivalent. +-- +data StackBenchmark = + StackBenchmark + { name :: StackUnqualCompName + , buildInfo :: StackBuildInfo + , interface :: BenchmarkInterface + -- ^ This is only used for gathering the files related to this component. + } + deriving (Show, Typeable) + +-- | Name of an executable. +newtype ExeName = ExeName Text + deriving (Show, Eq, Ord, Hashable, IsString, Generic, NFData, Data, Typeable) + +-- | The name of an unqualified component (that is, it can be an executable, a library, anything). +-- The Cabal equivalent is [UnqualComponentName](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-UnqualComponentName.html#t:UnqualComponentName). +-- Ideally, we'd want to use the cabal type behing this newtype and not Text to avoid unnecessary work, but +-- for now this is too much refactoring (also there is no Hashable instance for UnqualComponentName yet). +newtype StackUnqualCompName = StackUnqualCompName Text + deriving (Show, Eq, Ord, Hashable, IsString, Generic, NFData, Data, Typeable) +unqualCompToText :: StackUnqualCompName -> Text +unqualCompToText (StackUnqualCompName v) = v + +-- | This is the Stack equivalent of Cabal's [BuildInfo](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-BuildInfo.html). +-- We don't use the cabal version because Cabal provides a list of dependencies (and we need a Map), and we only need a tiny subset of all +-- the Cabal provided info. +-- It's also the decomposition of @Package@ based information in prior versions of stack, +-- to enable component based builds and backpack. +-- The file gathering related fields are lazy because not always needed. +data StackBuildInfo = + StackBuildInfo {sbiBuildable :: !Bool + -- ^ From BuildInfo in cabal + ,sbiDependency :: !(Map PackageName DepValue) + -- ^ From targetBuildDepends in BuildInfo in cabal. + ,sbiUnknownTools :: Set Text + -- ^ From buildTool in Cabal, we only keep the legacy + -- build tool depends that we know (from a hardcoded list). + -- We only use the deduplication aspect of the Set here, as this + -- field is only used for error reporting in the end. + -- This is kept lazy because it's an error reporting field only. + ,sbiOtherModules :: [ModuleName] + -- ^ Only used in file gathering. See usage in "Stack.ComponentFile" module. + ,sbiJsSources :: [FilePath] + -- ^ Only used in file gathering. See usage in "Stack.ComponentFile" module. + ,hsSourceDirs :: [SymbolicPath PackageDir SourceDir] + -- ^ Only used in file gathering. See usage in "Stack.ComponentFile" module. + ,cSource :: [FilePath] + -- ^ Only used in file gathering. See usage in "Stack.ComponentFile" module. + } + deriving (Show) diff --git a/src/Stack/Types/Dependency.hs b/src/Stack/Types/Dependency.hs index 892ab2911f..405dd3a911 100644 --- a/src/Stack/Types/Dependency.hs +++ b/src/Stack/Types/Dependency.hs @@ -3,12 +3,14 @@ module Stack.Types.Dependency ( DepValue (..) , DepType (..) + , cabalToStackDep + , cabalExeToStackDep ) where import Distribution.Types.VersionRange ( VersionRange ) import Stack.Prelude import Stack.Types.Version ( intersectVersionRanges ) - +import qualified Distribution.PackageDescription as Cabal -- | The value for a map from dependency name. This contains both the version -- range and the type of dependency, and provides a semigroup instance. @@ -32,3 +34,8 @@ data DepType instance Semigroup DepType where AsLibrary <> _ = AsLibrary AsBuildTool <> x = x + +cabalToStackDep :: Cabal.Dependency -> DepValue +cabalToStackDep (Cabal.Dependency _ verRange _libNameSet) = DepValue{dvVersionRange = verRange, dvType=AsLibrary} +cabalExeToStackDep :: Cabal.ExeDependency -> DepValue +cabalExeToStackDep (Cabal.ExeDependency _ _name verRange) = DepValue{dvVersionRange = verRange, dvType=AsBuildTool} \ No newline at end of file diff --git a/stack.cabal b/stack.cabal index fde4aadaff..499e6ac375 100644 --- a/stack.cabal +++ b/stack.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack @@ -326,7 +326,10 @@ library Paths_stack other-modules: GHC.Utils.GhcPkg.Main.Compat + Stack.Component Stack.Config.ConfigureScript + Stack.Types.CompCollection + Stack.Types.Component Stack.Types.FileDigestCache autogen-modules: Build_stack From 8dc2d52d11b349f588808e8054c1f46c8f1cb3c3 Mon Sep 17 00:00:00 2001 From: theophilebatoz Date: Sun, 13 Nov 2022 23:34:56 +0000 Subject: [PATCH 03/42] feat: add component collection fields on Package datatype --- src/Stack/Package.hs | 10 ++++++++++ src/Stack/Types/Component.hs | 3 ++- src/Stack/Types/Package.hs | 8 ++++++++ 3 files changed, 20 insertions(+), 1 deletion(-) diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index a6763e0ee4..8aab28c10c 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -85,6 +85,10 @@ import Stack.Types.Dependency ( DepValue (..), DepType (..) ) import Stack.Types.PackageFile ( DotCabalPath , GetPackageFiles (..) ) import Stack.PackageFile ( getPackageFile ) +import Stack.Types.CompCollection (foldAndMakeCollection) +import Stack.Component +import qualified Stack.Types.Component + -- | Read @.buildinfo@ ancillary files produced by some Setup.hs hooks. -- The file includes Cabal file syntax to be merged into the package description -- derived from the package's Cabal file. @@ -121,6 +125,12 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg , packageFlags = packageConfigFlags packageConfig , packageDefaultFlags = M.fromList [(flagName flag, flagDefault flag) | flag <- pkgFlags] + , packageLibrary = stackLibraryFromCabal <$> library pkg + , packageSubLibraries = foldAndMakeCollection stackLibraryFromCabal $ subLibraries pkg + , packageForeignLibraries = foldAndMakeCollection stackForeignLibraryFromCabal $ foreignLibs pkg + , packageTestSuites = foldAndMakeCollection stackTestFromCabal $ testSuites pkg + , packageBenchmarkSuites = foldAndMakeCollection stackBenchmarkFromCabal $ benchmarks pkg + , packageExecutables = foldAndMakeCollection stackExecutableFromCabal $ executables pkg , packageAllDeps = M.keysSet deps , packageSubLibDeps = subLibDeps , packageLibraries = diff --git a/src/Stack/Types/Component.hs b/src/Stack/Types/Component.hs index 09345a8aad..4c9fd79d87 100644 --- a/src/Stack/Types/Component.hs +++ b/src/Stack/Types/Component.hs @@ -122,7 +122,8 @@ data StackBuildInfo = StackBuildInfo {sbiBuildable :: !Bool -- ^ From BuildInfo in cabal ,sbiDependency :: !(Map PackageName DepValue) - -- ^ From targetBuildDepends in BuildInfo in cabal. + -- ^ From targetBuildDepends in BuildInfo in cabal, and known + -- legacy specified build tools (buildTool). ,sbiUnknownTools :: Set Text -- ^ From buildTool in Cabal, we only keep the legacy -- build tool depends that we know (from a hardcoded list). diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index c2aa3a19d0..abd2e8ff15 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -65,6 +65,8 @@ import Stack.Types.PackageFile ) import Stack.Types.SourceMap ( CommonPackage, FromSnapshot ) import Stack.Types.Version ( VersionRange ) +import Stack.Types.CompCollection ( CompCollection ) +import Stack.Types.Component ( StackLibrary, StackForeignLibrary, StackTest, StackBenchmark, StackExecutable ) -- | Type representing exceptions thrown by functions exported by the -- "Stack.Package" module. @@ -175,6 +177,12 @@ data Package = Package -- ^ Flags used on package. , packageDefaultFlags :: !(Map FlagName Bool) -- ^ Defaults for unspecified flags. + , packageLibrary :: Maybe StackLibrary + , packageSubLibraries :: CompCollection StackLibrary + , packageForeignLibraries :: CompCollection StackForeignLibrary + , packageTestSuites :: CompCollection StackTest + , packageBenchmarkSuites :: CompCollection StackBenchmark + , packageExecutables :: CompCollection StackExecutable , packageLibraries :: !PackageLibraries -- ^ does the package have a buildable library stanza? , packageSubLibraries :: !(Set Text) From af23d5636aeee67ce1ce2e98465971d6b25312c0 Mon Sep 17 00:00:00 2001 From: theophilebatoz Date: Tue, 4 Apr 2023 14:29:10 +0000 Subject: [PATCH 04/42] feat: replace packageLibraries Package field --- src/Stack/Build/ConstructPlan.hs | 13 +++---- src/Stack/Build/Execute.hs | 58 ++++++++++++++------------------ src/Stack/Build/Source.hs | 11 +++--- src/Stack/Component.hs | 1 - src/Stack/Coverage.hs | 13 ++++--- src/Stack/Ghci.hs | 27 ++++++++------- src/Stack/Package.hs | 22 ++++++------ src/Stack/PackageFile.hs | 9 ++--- src/Stack/Types/Package.hs | 3 -- 9 files changed, 69 insertions(+), 88 deletions(-) diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index 7abd5c50c3..86b6af0280 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -28,7 +28,10 @@ import Stack.Build.Cache ( tryGetFlagCache ) import Stack.Build.Haddock ( shouldHaddockDeps ) import Stack.Build.Source ( loadLocalPackage ) import Stack.Constants ( compilerOptionsCabalFlag ) -import Stack.Package ( applyForceCustomBuild ) +import Stack.Package + ( applyForceCustomBuild + , hasMainBuildableLibrary + ) import Stack.Prelude hiding ( loadPackage ) import Stack.SourceMap ( getPLIVersion, mkProjectPackage ) import Stack.Types.Build @@ -67,7 +70,7 @@ import Stack.Types.NamedComponent ( exeComponents, renderComponent ) import Stack.Types.Package ( ExeName (..), InstallLocation (..), Installed (..) , InstalledMap, LocalPackage (..), Package (..) - , PackageLibraries (..), PackageSource (..), installedVersion + , PackageSource (..), installedVersion , packageIdentifier, psVersion, runMemoizedWith ) import Stack.Types.ParentMap ( ParentMap ) @@ -1162,10 +1165,8 @@ addPackageDeps package = do -- make sure we consider sub-libraries as libraries too packageHasLibrary :: Package -> Bool packageHasLibrary p = - not (Set.null (packageSubLibraries p)) || - case packageLibraries p of - HasLibraries _ -> True - NoLibraries -> False + not (null (packageSubLibraries p)) || + hasMainBuildableLibrary p checkDirtiness :: PackageSource diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 167a39e1fa..3c869fde18 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -124,7 +124,7 @@ import Stack.Coverage , generateHpcUnifiedReport, updateTixFile ) import Stack.GhcPkg ( ghcPkg, unregisterGhcPkgIds ) -import Stack.Package ( buildLogPath ) +import Stack.Package ( buildLogPath, hasMainBuildableLibrary ) import Stack.PackageDump ( conduitDumpPackage, ghcPkgDescribe ) import Stack.Prelude import Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) ) @@ -175,7 +175,7 @@ import Stack.Types.NamedComponent ) import Stack.Types.Package ( InstallLocation (..), Installed (..), InstalledMap - , LocalPackage (..), Package (..), PackageLibraries (..) + , LocalPackage (..), Package (..) , installedPackageIdentifier, packageIdentifier , runMemoizedWith ) @@ -195,6 +195,7 @@ import System.IO.Error ( isDoesNotExistError ) import System.PosixCompat.Files ( createLink, getFileStatus, modificationTime ) import System.Random ( randomIO ) +import Stack.Types.CompCollection ( getBuildableListText, getBuildableSetText ) -- | Has an executable been built or not? data ExecutableBuildStatus @@ -1748,11 +1749,8 @@ singleBuild (hasLib, hasSubLib, hasExe) = case taskType of TTLocalMutable lp -> let package = lpPackage lp - hasLibrary = - case packageLibraries package of - NoLibraries -> False - HasLibraries _ -> True - hasSubLibraries = not . Set.null $ packageSubLibraries package + hasLibrary = hasMainBuildableLibrary package + hasSubLibraries = not . null $ packageSubLibraries package hasExecutables = not . Set.null $ exesToBuild executableBuildStatuses lp in (hasLibrary, hasSubLibraries, hasExecutables) @@ -1797,7 +1795,7 @@ singleBuild -- However, we must unregister any such library in the new snapshot, in case -- it was built with different flags. let - subLibNames = Set.toList $ case taskType of + subLibNames = getBuildableListText $ case taskType of TTLocalMutable lp -> packageSubLibraries $ lpPackage lp TTRemotePackage _ p _ -> packageSubLibraries p toMungedPackageId :: Text -> MungedPackageId @@ -2038,12 +2036,9 @@ singleBuild cabal0 keep KeepTHLoading $ "haddock" : args - let hasLibrary = - case packageLibraries package of - NoLibraries -> False - HasLibraries _ -> True + let hasLibrary = hasMainBuildableLibrary package packageHasComponentSet f = not $ Set.null $ f package - hasSubLibraries = packageHasComponentSet packageSubLibraries + hasSubLibraries = not $ null $ packageSubLibraries package hasExecutables = packageHasComponentSet packageExes shouldCopy = not isFinalBuild @@ -2093,10 +2088,10 @@ singleBuild let ident = PackageIdentifier (packageName package) (packageVersion package) -- only pure the sub-libraries to cache them if we also cache the main -- library (that is, if it exists) - (mpkgid, subLibsPkgIds) <- case packageLibraries package of - HasLibraries _ -> do + (mpkgid, subLibsPkgIds) <- if hasMainBuildableLibrary package then + do subLibsPkgIds <- fmap catMaybes $ - forM (Set.toList $ packageSubLibraries package) $ \subLib -> do + forM (getBuildableListText $ packageSubLibraries package) $ \subLib -> do let subLibName = MungedPackageName (packageName package) (LSubLibName $ mkUnqualComponentName $ T.unpack subLib) @@ -2112,10 +2107,10 @@ singleBuild case mpkgid of Nothing -> throwM $ Couldn'tFindPkgId $ packageName package Just pkgid -> pure (Library ident pkgid Nothing, subLibsPkgIds) - NoLibraries -> do + else do markExeInstalled (taskLocation task) pkgId -- TODO unify somehow - -- with writeFlagCache? - pure (Executable ident, []) -- don't pure sub-libraries in this case + -- with writeFlagCache? + pure (Executable ident, []) -- don't pure sublibs in this case case taskType of TTRemotePackage Immutable _ loc -> @@ -2694,22 +2689,19 @@ primaryComponentOptions :: -> LocalPackage -> [String] primaryComponentOptions executableBuildStatuses lp = - -- TODO: get this information from target parsing instead, which will allow - -- users to turn off library building if desired - ( case packageLibraries package of - NoLibraries -> [] - HasLibraries names -> map - T.unpack - ( T.append "lib:" (T.pack (packageNameString (packageName package))) - : map (T.append "flib:") (Set.toList names) - ) - ) + -- TODO: get this information from target parsing instead, + -- which will allow users to turn off library building if + -- desired + (if hasMainBuildableLibrary package then map T.unpack + $ T.append "lib:" (T.pack (packageNameString (packageName package))) + : map (T.append "flib:") (getBuildableListText (packageForeignLibraries package)) + else []) ++ map - (T.unpack . T.append "lib:") - (Set.toList $ packageSubLibraries package) + (T.unpack . T.append "lib:") + (getBuildableListText $ packageSubLibraries package) ++ map - (T.unpack . T.append "exe:") - (Set.toList $ exesToBuild executableBuildStatuses lp) + (T.unpack . T.append "exe:") + (Set.toList $ exesToBuild executableBuildStatuses lp) where package = lpPackage lp diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index 4dd1e45646..93b6bfb817 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -24,7 +24,7 @@ import qualified Distribution.PackageDescription as C import qualified Pantry.SHA256 as SHA256 import Stack.Build.Cache ( tryGetBuildCache ) import Stack.Build.Haddock ( shouldHaddockDeps ) -import Stack.Package ( resolvePackage ) +import Stack.Package ( hasMainBuildableLibrary, resolvePackage ) import Stack.Prelude import Stack.SourceMap ( DumpedGlobalPackage, checkFlagsUsedThrowing @@ -52,7 +52,7 @@ import Stack.Types.NamedComponent ( NamedComponent (..), isCSubLib, splitComponents ) import Stack.Types.Package ( FileCacheInfo (..), LocalPackage (..), Package (..) - , PackageConfig (..), PackageLibraries (..) + , PackageConfig (..) , dotCabalGetPath, memoizeRefWith, runMemoizedWith ) import Stack.Types.PackageFile ( PackageWarning, getPackageFiles ) @@ -334,13 +334,10 @@ loadLocalPackage pp = do -- individual executables or library") is resolved, 'hasLibrary' is only -- relevant if the library is part of the target spec. Just _ -> - let hasLibrary = - case packageLibraries pkg of - NoLibraries -> False - HasLibraries _ -> True + let hasLibrary = hasMainBuildableLibrary pkg in hasLibrary || not (Set.null nonLibComponents) - || not (Set.null $ packageSubLibraries pkg) + || not (null $ packageSubLibraries pkg) filterSkippedComponents = Set.filter (not . (`elem` boptsSkipComponents bopts)) diff --git a/src/Stack/Component.hs b/src/Stack/Component.hs index 4e74d993ba..b5153aeae6 100644 --- a/src/Stack/Component.hs +++ b/src/Stack/Component.hs @@ -29,7 +29,6 @@ import Stack.Types.Dependency ( cabalExeToStackDep, cabalToStackDep ) import Distribution.PackageDescription (Library (libName), ForeignLib, TestSuite (testName, testBuildInfo, testInterface), Benchmark (benchmarkBuildInfo, benchmarkName), Executable) import Distribution.Types.BuildInfo (BuildInfo) import qualified Distribution.Types.BuildInfo as BI -import Distribution.Types.LibraryName (LibraryName(LMainLibName, LSubLibName)) import qualified Distribution.Types.Library import qualified Distribution.Types.ForeignLib import qualified Distribution.Types.Executable diff --git a/src/Stack/Coverage.hs b/src/Stack/Coverage.hs index 8f01572c99..452d888326 100644 --- a/src/Stack/Coverage.hs +++ b/src/Stack/Coverage.hs @@ -40,11 +40,13 @@ import Stack.Constants , relFileHpcIndexHtml, relFileIndexHtml ) import Stack.Constants.Config ( distDirFromDir, hpcRelativeDir ) +import Stack.Package ( hasMainBuildableLibrary ) import Stack.Prelude import Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig ) import Stack.Types.BuildConfig ( BuildConfig (..), HasBuildConfig (..) ) import Stack.Types.Compiler ( getGhcVersion ) +import Stack.Types.CompCollection ( getBuildableSetText ) import Stack.Types.BuildOpts ( BuildOptsCLI (..), defaultBuildOptsCLI ) import Stack.Types.EnvConfig ( EnvConfig (..), HasEnvConfig (..), actualCompilerVersionL @@ -52,7 +54,7 @@ import Stack.Types.EnvConfig ) import Stack.Types.NamedComponent ( NamedComponent (..) ) import Stack.Types.Package - ( Package (..), PackageLibraries (..), packageIdentifier ) + ( Package (..), packageIdentifier ) import Stack.Types.Runner ( Runner ) import Stack.Types.SourceMap ( PackageType (..), SMTargets (..), SMWanted (..) @@ -181,16 +183,13 @@ generateHpcReport pkgDir package tests = do let pkgId = packageIdentifierString (packageIdentifier package) pkgName' = packageNameString $ packageName package ghcVersion = getGhcVersion compilerVersion - hasLibrary = - case packageLibraries package of - NoLibraries -> False - HasLibraries _ -> True + hasLibrary = hasMainBuildableLibrary package subLibs = packageSubLibraries package eincludeName <- -- Pre-7.8 uses plain PKG-version in tix files. if ghcVersion < mkVersion [7, 10] then pure $ Right $ Just [pkgId] -- We don't expect to find a package key if there is no library. - else if not hasLibrary && Set.null subLibs then pure $ Right Nothing + else if not hasLibrary && null subLibs then pure $ Right Nothing -- Look in the inplace DB for the package key. -- See https://github.com/commercialhaskell/stack/issues/1181#issuecomment-148968986 else do @@ -201,7 +200,7 @@ generateHpcReport pkgDir package tests = do findPackageFieldForBuiltPackage pkgDir (packageIdentifier package) - subLibs + (getBuildableSetText subLibs) hpcNameField case eincludeName of Left err -> do diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index 5de6cb05c4..667cdad32b 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -49,7 +49,7 @@ import Stack.Ghci.Script ) import Stack.Package ( PackageDescriptionPair (..), packageFromPackageDescription - , readDotBuildinfo, resolvePackageDescription + , readDotBuildinfo, resolvePackageDescription, hasMainBuildableLibrary ) import Stack.Prelude import Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig ) @@ -74,7 +74,7 @@ import Stack.Types.NamedComponent import Stack.Types.Package ( BuildInfoOpts (..), InstallMap, InstalledMap , LocalPackage (..), Package (..), PackageConfig (..) - , PackageLibraries (..), dotCabalCFilePath, dotCabalGetPath + , dotCabalCFilePath, dotCabalGetPath , dotCabalMainPath, getPackageOpts ) import Stack.Types.PackageFile ( getPackageFiles ) @@ -87,6 +87,7 @@ import Stack.Types.SourceMap ) import System.IO ( putStrLn ) import System.Permissions ( setScriptPerms ) +import Stack.Types.CompCollection ( getBuildableListText ) -- | Type representing exceptions thrown by functions exported by the -- "Stack.Ghci" module. @@ -957,17 +958,17 @@ makeGhciPkgInfo installMap installedMap locals addPkgs mfileTargets pkgDesc = do wantedPackageComponents :: BuildOpts -> Target -> Package -> Set NamedComponent wantedPackageComponents _ (TargetComps cs) _ = cs wantedPackageComponents bopts (TargetAll PTProject) pkg = S.fromList $ - ( case packageLibraries pkg of - NoLibraries -> [] - HasLibraries names -> CLib : map CSubLib (S.toList names) - ) - <> map CExe (S.toList (packageExes pkg)) - <> map CSubLib (S.toList $ packageSubLibraries pkg) - <> (if boptsTests bopts then map CTest (M.keys (packageTests pkg)) else []) - <> ( if boptsBenchmarks bopts - then map CBench (S.toList (packageBenchmarks pkg)) - else [] - ) + ( if hasMainBuildableLibrary pkg + then CLib : map CSubLib (getBuildableListText $ packageForeignLibraries pkg) + else []) ++ + map CExe (S.toList (packageExes pkg)) <> + map CSubLib (getBuildableListText $ packageSubLibraries pkg) <> + (if boptsTests bopts + then map CTest (M.keys (packageTests pkg)) + else []) <> + (if boptsBenchmarks bopts + then map CBench (S.toList (packageBenchmarks pkg)) + else []) wantedPackageComponents _ _ _ = S.empty checkForIssues :: HasTerm env => [GhciPkgInfo] -> RIO env () diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 8aab28c10c..dde2812719 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -18,6 +18,7 @@ module Stack.Package , resolvePackageDescription , packageDependencies , applyForceCustomBuild + , hasMainBuildableLibrary ) where import Data.List ( unzip ) @@ -76,7 +77,7 @@ import Stack.Types.Package ( BuildInfoOpts (..), ExeName (..), GetPackageOpts (..) , InstallMap, Installed (..), InstalledMap, Package (..) , PackageConfig (..), PackageException (..) - , PackageLibraries (..), dotCabalCFilePath, packageIdentifier + , dotCabalCFilePath, packageIdentifier ) import Stack.Types.Version ( VersionRange, intersectVersionRanges, withinRange ) @@ -133,16 +134,6 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg , packageExecutables = foldAndMakeCollection stackExecutableFromCabal $ executables pkg , packageAllDeps = M.keysSet deps , packageSubLibDeps = subLibDeps - , packageLibraries = - let mlib = do - lib <- library pkg - guard $ buildable $ libBuildInfo lib - Just lib - in - case mlib of - Nothing -> NoLibraries - Just _ -> HasLibraries foreignLibNames - , packageSubLibraries = subLibNames , packageTests = M.fromList [ (T.pack (Cabal.unUnqualComponentName $ testName t), testInterface t) | t <- testSuites pkgNoMod @@ -812,3 +803,12 @@ applyForceCustomBuild cabalVersion package forceCustomBuild = packageBuildType package == Simple && not (cabalVersion `withinRange` cabalVersionRange) + +-- | Check if the main library is buildable. +-- +-- Replace legacy logic with cabal shaped types. +-- Previous logic beeing @Package@ field named packageLibraries, equal to either NoLibrary or v foreignLibNames. +-- True here means HasLibraries _ in previous usage. +-- +hasMainBuildableLibrary :: Package -> Bool +hasMainBuildableLibrary package = maybe False isComponentBuildable $ packageLibrary package \ No newline at end of file diff --git a/src/Stack/PackageFile.hs b/src/Stack/PackageFile.hs index a981ee0bd8..6b60b9da8b 100644 --- a/src/Stack/PackageFile.hs +++ b/src/Stack/PackageFile.hs @@ -32,9 +32,9 @@ import Stack.Constants ) import Stack.Constants.Config ( distDirFromDir ) import Stack.Prelude -import Stack.Types.BuildConfig ( HasBuildConfig (..) ) import Stack.Types.CompilerPaths ( cabalVersionL ) -import Stack.Types.EnvConfig ( HasEnvConfig ) +import Stack.Types.EnvConfig + ( HasEnvConfig (..) ) import Stack.Types.NamedComponent ( NamedComponent (..) ) import Stack.Types.PackageFile ( DotCabalPath (..), GetPackageFileContext (..) @@ -42,13 +42,8 @@ import Stack.Types.PackageFile ) import qualified System.FilePath as FilePath import System.IO.Error ( isUserError ) -import Stack.Constants.Config ( distDirFromDir ) -import Stack.Types.CompilerPaths ( cabalVersionL ) import Stack.Types.BuildConfig ( HasBuildConfig(buildConfigL) ) -import Stack.Constants - ( relFileSetupHs, relFileSetupLhs, relFileHpackPackageConfig ) -import Path.IO (doesFileExist) -- | Resolve the file, if it can't be resolved, warn for the user -- (purely to be helpful). diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index abd2e8ff15..2a699fca9f 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -183,9 +183,6 @@ data Package = Package , packageTestSuites :: CompCollection StackTest , packageBenchmarkSuites :: CompCollection StackBenchmark , packageExecutables :: CompCollection StackExecutable - , packageLibraries :: !PackageLibraries - -- ^ does the package have a buildable library stanza? - , packageSubLibraries :: !(Set Text) -- ^ Names of sub-libraries , packageTests :: !(Map Text TestSuiteInterface) -- ^ names and interfaces of test suites From 43f09b65cd701ac7fa6759caf4878cfcdea4b15c Mon Sep 17 00:00:00 2001 From: theophilebatoz Date: Tue, 4 Apr 2023 16:12:51 +0000 Subject: [PATCH 05/42] refactoring: packageHasExposedModules Package field refactoring --- src/Stack/Build/Execute.hs | 4 ++-- src/Stack/Package.hs | 16 +++++++++++----- src/Stack/Types/Package.hs | 2 -- 3 files changed, 13 insertions(+), 9 deletions(-) diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 3c869fde18..6190a36e69 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -124,7 +124,7 @@ import Stack.Coverage , generateHpcUnifiedReport, updateTixFile ) import Stack.GhcPkg ( ghcPkg, unregisterGhcPkgIds ) -import Stack.Package ( buildLogPath, hasMainBuildableLibrary ) +import Stack.Package ( buildLogPath, hasMainBuildableLibrary, mainLibraryHasExposedModules ) import Stack.PackageDump ( conduitDumpPackage, ghcPkgDescribe ) import Stack.Prelude import Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) ) @@ -1714,7 +1714,7 @@ singleBuild && not isFinalBuild -- Works around haddock failing on bytestring-builder since it has no -- modules when bytestring is new enough. - && packageHasExposedModules package + && mainLibraryHasExposedModules package -- Special help for the curator tool to avoid haddocks that are known -- to fail && maybe True (Set.notMember pname . curatorSkipHaddock) mcurator diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index dde2812719..069f6673b6 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -19,6 +19,7 @@ module Stack.Package , packageDependencies , applyForceCustomBuild , hasMainBuildableLibrary + , mainLibraryHasExposedModules ) where import Data.List ( unzip ) @@ -170,10 +171,6 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg pkg componentFiles pure (componentsModules, componentFiles, componentsOpts) - , packageHasExposedModules = maybe - False - (not . null . exposedModules) - (library pkg) , packageBuildType = buildType pkg , packageSetupDeps = msetupDeps , packageCabalSpec = specVersion pkg @@ -811,4 +808,13 @@ applyForceCustomBuild cabalVersion package -- True here means HasLibraries _ in previous usage. -- hasMainBuildableLibrary :: Package -> Bool -hasMainBuildableLibrary package = maybe False isComponentBuildable $ packageLibrary package \ No newline at end of file +hasMainBuildableLibrary package = maybe False isComponentBuildable $ packageLibrary package + +-- | Check if the main library has any exposed modules. +-- +-- Replace legacy packageHasExposedModule. This should become irrelevant at some point +-- since there's nothing inherently wrong or different with packages exposing only modules in +-- internal libraries (for instance). +-- +mainLibraryHasExposedModules :: Package -> Bool +mainLibraryHasExposedModules package = maybe False (not . null . Stack.Types.Component.exposedModules) $ packageLibrary package diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 2a699fca9f..9ec3d04b8f 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -192,8 +192,6 @@ data Package = Package -- ^ names of executables , packageOpts :: !GetPackageOpts -- ^ Args to pass to GHC. - , packageHasExposedModules :: !Bool - -- ^ Does the package have exposed modules? , packageBuildType :: !BuildType -- ^ Package build-type. , packageSetupDeps :: !(Maybe (Map PackageName VersionRange)) From e87ff82104ad0cdd3f1f6650ca3963906a4be099 Mon Sep 17 00:00:00 2001 From: theophilebatoz Date: Fri, 7 Apr 2023 18:20:17 +0000 Subject: [PATCH 06/42] feat: remove packageUnknownTools for component based solution --- src/Stack/Package.hs | 31 +++++++++++++++++++++++++++---- src/Stack/Types/Package.hs | 3 --- 2 files changed, 27 insertions(+), 7 deletions(-) diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 069f6673b6..7f5f026d79 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -20,6 +20,7 @@ module Stack.Package , applyForceCustomBuild , hasMainBuildableLibrary , mainLibraryHasExposedModules + , packageUnknownTools ) where import Data.List ( unzip ) @@ -87,10 +88,12 @@ import Stack.Types.Dependency ( DepValue (..), DepType (..) ) import Stack.Types.PackageFile ( DotCabalPath , GetPackageFiles (..) ) import Stack.PackageFile ( getPackageFile ) -import Stack.Types.CompCollection (foldAndMakeCollection) +import Stack.Types.CompCollection ( foldAndMakeCollection, CompCollection ) import Stack.Component import qualified Stack.Types.Component - +import GHC.Records (getField) +import Stack.Types.Component ( HasBuildInfo ) +import Data.Foldable -- | Read @.buildinfo@ ancillary files produced by some Setup.hs hooks. -- The file includes Cabal file syntax to be merged into the package description -- derived from the package's Cabal file. @@ -121,7 +124,6 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg , packageLicense = licenseRaw pkg , packageDeps = deps , packageFiles = pkgFiles - , packageUnknownTools = unknownTools , packageGhcOptions = packageConfigGhcOptions packageConfig , packageCabalConfigOpts = packageConfigCabalConfigOpts packageConfig , packageFlags = packageConfigFlags packageConfig @@ -204,7 +206,7 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg pkgId = package pkg name = pkgName pkgId - (unknownTools, knownTools) = packageDescTools pkg + (_unknownTools, knownTools) = packageDescTools pkg deps = M.filterWithKey (const . not . isMe) (M.unionsWith (<>) [ asLibrary <$> packageDependencies pkg @@ -818,3 +820,24 @@ hasMainBuildableLibrary package = maybe False isComponentBuildable $ packageLibr -- mainLibraryHasExposedModules :: Package -> Bool mainLibraryHasExposedModules package = maybe False (not . null . Stack.Types.Component.exposedModules) $ packageLibrary package + +-- | Aggregate all unknown tools from all exe. +-- Replaces packageUnknownTools field from Package datatype. +-- Mostly meant for build tools specified in the legacy manner (build-tools:) that failed +-- the hard-coded lookup. +-- See sbiUnknownTools for more info. +packageUnknownTools :: Package -> Set Text +packageUnknownTools pkg = lib (bench <> tests <> flib <> sublib <> exe) + where + lib setT = case packageLibrary pkg of + Just libV -> addUnknownTools libV setT + Nothing -> setT + bench = gatherUnknownTools $ packageBenchmarkSuites pkg + tests = gatherUnknownTools $ packageTestSuites pkg + flib = gatherUnknownTools $ packageForeignLibraries pkg + sublib = gatherUnknownTools $ packageSubLibraries pkg + exe = gatherUnknownTools $ packageExecutables pkg + addUnknownTools :: HasBuildInfo x => x -> Set Text -> Set Text + addUnknownTools = (<>) . Stack.Types.Component.sbiUnknownTools . getField @"buildInfo" + gatherUnknownTools :: HasBuildInfo x => CompCollection x -> Set Text + gatherUnknownTools = foldr' addUnknownTools mempty diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 9ec3d04b8f..8ade05c955 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -162,9 +162,6 @@ data Package = Package -- ^ Get all files of the package. , packageDeps :: !(Map PackageName DepValue) -- ^ Packages that the package depends on, both as libraries and build tools. - , packageUnknownTools :: !(Set ExeName) - -- ^ Build tools specified in the legacy manner (build-tools:) that failed - -- the hard-coded lookup. , packageAllDeps :: !(Set PackageName) -- ^ Original dependencies (not sieved). , packageSubLibDeps :: !(Map MungedPackageName DepValue) From 134c331e7eaf979524429a8755acfebb26db7fae Mon Sep 17 00:00:00 2001 From: theophilebatoz Date: Fri, 7 Apr 2023 18:20:17 +0000 Subject: [PATCH 07/42] feat: remove packageUnknownTools for component based solution --- src/Stack/Build/ConstructPlan.hs | 1 + src/Stack/Package.hs | 1 + 2 files changed, 2 insertions(+) diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index 86b6af0280..9b25c5275d 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -31,6 +31,7 @@ import Stack.Constants ( compilerOptionsCabalFlag ) import Stack.Package ( applyForceCustomBuild , hasMainBuildableLibrary + , packageUnknownTools ) import Stack.Prelude hiding ( loadPackage ) import Stack.SourceMap ( getPLIVersion, mkProjectPackage ) diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 7f5f026d79..69e80b3ef6 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -94,6 +94,7 @@ import qualified Stack.Types.Component import GHC.Records (getField) import Stack.Types.Component ( HasBuildInfo ) import Data.Foldable + -- | Read @.buildinfo@ ancillary files produced by some Setup.hs hooks. -- The file includes Cabal file syntax to be merged into the package description -- derived from the package's Cabal file. From 39a05d0f0f743c1d6669d44230ec2d44fc5357b0 Mon Sep 17 00:00:00 2001 From: theophilebatoz Date: Sat, 8 Apr 2023 18:14:35 +0000 Subject: [PATCH 08/42] refactoring: remove package based packageInternalLibraries --- src/Stack/Build/Execute.hs | 20 ++++++++++++++++++++ src/Stack/Coverage.hs | 2 +- src/Stack/Package.hs | 6 +++++- src/Stack/Types/Package.hs | 1 - 4 files changed, 26 insertions(+), 3 deletions(-) diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 6190a36e69..4702be02d4 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -123,8 +123,13 @@ import Stack.Coverage ( deleteHpcReports, generateHpcMarkupIndex, generateHpcReport , generateHpcUnifiedReport, updateTixFile ) +<<<<<<< HEAD import Stack.GhcPkg ( ghcPkg, unregisterGhcPkgIds ) import Stack.Package ( buildLogPath, hasMainBuildableLibrary, mainLibraryHasExposedModules ) +======= +import Stack.GhcPkg ( ghcPkgPathEnvVar, unregisterGhcPkgIds ) +import Stack.Package ( buildLogPath, hasMainBuildableLibrary, mainLibraryHasExposedModules, packageInternalLibraries ) +>>>>>>> 4a6fb3052 (refactoring: remove package based packageInternalLibraries) import Stack.PackageDump ( conduitDumpPackage, ghcPkgDescribe ) import Stack.Prelude import Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) ) @@ -1750,7 +1755,11 @@ singleBuild TTLocalMutable lp -> let package = lpPackage lp hasLibrary = hasMainBuildableLibrary package +<<<<<<< HEAD hasSubLibraries = not . null $ packageSubLibraries package +======= + hasSubLibrary = not . null $ packageSubLibraries package +>>>>>>> 4a6fb3052 (refactoring: remove package based packageInternalLibraries) hasExecutables = not . Set.null $ exesToBuild executableBuildStatuses lp in (hasLibrary, hasSubLibraries, hasExecutables) @@ -1795,9 +1804,15 @@ singleBuild -- However, we must unregister any such library in the new snapshot, in case -- it was built with different flags. let +<<<<<<< HEAD subLibNames = getBuildableListText $ case taskType of TTLocalMutable lp -> packageSubLibraries $ lpPackage lp TTRemotePackage _ p _ -> packageSubLibraries p +======= + subLibNames = Set.toList $ packageInternalLibraries $ case taskType of + TTLocalMutable lp -> lpPackage lp + TTRemotePackage _ p _ -> p +>>>>>>> 4a6fb3052 (refactoring: remove package based packageInternalLibraries) toMungedPackageId :: Text -> MungedPackageId toMungedPackageId subLib = let subLibName = LSubLibName $ mkUnqualComponentName $ T.unpack subLib @@ -2037,9 +2052,14 @@ singleBuild cabal0 keep KeepTHLoading $ "haddock" : args let hasLibrary = hasMainBuildableLibrary package +<<<<<<< HEAD packageHasComponentSet f = not $ Set.null $ f package hasSubLibraries = not $ null $ packageSubLibraries package hasExecutables = packageHasComponentSet packageExes +======= + hasInternalLibrary = not $ null $ packageSubLibraries package + hasExecutables = not $ null $ packageExes package +>>>>>>> 4a6fb3052 (refactoring: remove package based packageInternalLibraries) shouldCopy = not isFinalBuild && (hasLibrary || hasSubLibraries || hasExecutables) diff --git a/src/Stack/Coverage.hs b/src/Stack/Coverage.hs index 452d888326..87e337f8cc 100644 --- a/src/Stack/Coverage.hs +++ b/src/Stack/Coverage.hs @@ -40,7 +40,7 @@ import Stack.Constants , relFileHpcIndexHtml, relFileIndexHtml ) import Stack.Constants.Config ( distDirFromDir, hpcRelativeDir ) -import Stack.Package ( hasMainBuildableLibrary ) +import Stack.Package ( hasMainBuildableLibrary, packageInternalLibraries ) import Stack.Prelude import Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig ) import Stack.Types.BuildConfig diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 69e80b3ef6..79bbd03788 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -21,6 +21,7 @@ module Stack.Package , hasMainBuildableLibrary , mainLibraryHasExposedModules , packageUnknownTools + , packageInternalLibraries ) where import Data.List ( unzip ) @@ -88,7 +89,7 @@ import Stack.Types.Dependency ( DepValue (..), DepType (..) ) import Stack.Types.PackageFile ( DotCabalPath , GetPackageFiles (..) ) import Stack.PackageFile ( getPackageFile ) -import Stack.Types.CompCollection ( foldAndMakeCollection, CompCollection ) +import Stack.Types.CompCollection ( foldAndMakeCollection, CompCollection, getBuildableSetText ) import Stack.Component import qualified Stack.Types.Component import GHC.Records (getField) @@ -842,3 +843,6 @@ packageUnknownTools pkg = lib (bench <> tests <> flib <> sublib <> exe) addUnknownTools = (<>) . Stack.Types.Component.sbiUnknownTools . getField @"buildInfo" gatherUnknownTools :: HasBuildInfo x => CompCollection x -> Set Text gatherUnknownTools = foldr' addUnknownTools mempty + +packageInternalLibraries :: Package -> Set Text +packageInternalLibraries pkg = getBuildableSetText (packageSubLibraries pkg) \ No newline at end of file diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 8ade05c955..581ec468ec 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -180,7 +180,6 @@ data Package = Package , packageTestSuites :: CompCollection StackTest , packageBenchmarkSuites :: CompCollection StackBenchmark , packageExecutables :: CompCollection StackExecutable - -- ^ Names of sub-libraries , packageTests :: !(Map Text TestSuiteInterface) -- ^ names and interfaces of test suites , packageBenchmarks :: !(Set Text) From e8932cd3872eced37ce1e2197b40ee5f17931e4b Mon Sep 17 00:00:00 2001 From: theophilebatoz Date: Sat, 8 Apr 2023 20:07:53 +0000 Subject: [PATCH 09/42] refactoring: remove package based packageExes --- src/Stack/Build.hs | 2 +- src/Stack/Build/ConstructPlan.hs | 8 +++++--- src/Stack/Build/Execute.hs | 26 +++----------------------- src/Stack/Build/Source.hs | 2 +- src/Stack/Coverage.hs | 2 +- src/Stack/Ghci.hs | 1 + src/Stack/Package.hs | 15 ++++++--------- src/Stack/Types/CompCollection.hs | 5 ++++- src/Stack/Types/Package.hs | 2 -- 9 files changed, 22 insertions(+), 41 deletions(-) diff --git a/src/Stack/Build.hs b/src/Stack/Build.hs index 674d65e4bd..7e718e846e 100644 --- a/src/Stack/Build.hs +++ b/src/Stack/Build.hs @@ -30,7 +30,7 @@ import Stack.Build.Installed ( getInstalled, toInstallMap ) import Stack.Build.Source ( localDependencies, projectLocalPackages ) import Stack.Build.Target ( NeedTargets (..) ) import Stack.FileWatch ( fileWatch, fileWatchPoll ) -import Stack.Package ( resolvePackage ) +import Stack.Package ( resolvePackage, packageExes ) import Stack.Prelude hiding ( loadPackage ) import Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig ) import Stack.Setup ( withNewLocalBuildTargets ) diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index 9b25c5275d..c450a514c5 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -32,6 +32,7 @@ import Stack.Package ( applyForceCustomBuild , hasMainBuildableLibrary , packageUnknownTools + , packageExes ) import Stack.Prelude hiding ( loadPackage ) import Stack.SourceMap ( getPLIVersion, mkProjectPackage ) @@ -85,6 +86,7 @@ import Stack.Types.SourceMap import Stack.Types.Version ( latestApplicableVersion, versionRangeText, withinRange ) import System.Environment ( lookupEnv ) +import Stack.Types.CompCollection ( collectionMember ) -- | Type representing information about packages, namely information about -- whether or not a package is already installed and, unless the package is not @@ -1336,7 +1338,7 @@ checkAndWarnForUnknownTools p = do -- Check whether the tool is on the PATH or a package executable before -- warning about it. warnings <- - fmap catMaybes $ forM unknownTools $ \name@(ExeName toolName) -> + fmap catMaybes $ forM unknownTools $ \name@toolName -> runMaybeT $ notOnPath toolName *> notPackageExe toolName *> warn name tell mempty { wWarnings = (map toolWarningText warnings ++) } pure () @@ -1351,8 +1353,8 @@ checkAndWarnForUnknownTools p = do skipIf $ isRight eFound -- From Cabal 1.12, build-tools can specify another executable in the same -- package. - notPackageExe toolName = MaybeT $ skipIf $ toolName `Set.member` packageExes p - warn name = MaybeT . pure . Just $ ToolWarning name (packageName p) + notPackageExe toolName = MaybeT $ skipIf $ collectionMember toolName (packageExecutables p) + warn name = MaybeT . pure . Just $ ToolWarning (ExeName name) (packageName p) skipIf p' = pure $ if p' then Nothing else Just () -- | Warn about tools in the snapshot definition. States the tool name diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 4702be02d4..17fc77688c 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -123,13 +123,8 @@ import Stack.Coverage ( deleteHpcReports, generateHpcMarkupIndex, generateHpcReport , generateHpcUnifiedReport, updateTixFile ) -<<<<<<< HEAD import Stack.GhcPkg ( ghcPkg, unregisterGhcPkgIds ) -import Stack.Package ( buildLogPath, hasMainBuildableLibrary, mainLibraryHasExposedModules ) -======= -import Stack.GhcPkg ( ghcPkgPathEnvVar, unregisterGhcPkgIds ) -import Stack.Package ( buildLogPath, hasMainBuildableLibrary, mainLibraryHasExposedModules, packageInternalLibraries ) ->>>>>>> 4a6fb3052 (refactoring: remove package based packageInternalLibraries) +import Stack.Package ( buildLogPath, hasMainBuildableLibrary, mainLibraryHasExposedModules, packageSubLibrariesNameSet, packageExes ) import Stack.PackageDump ( conduitDumpPackage, ghcPkgDescribe ) import Stack.Prelude import Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) ) @@ -1755,11 +1750,7 @@ singleBuild TTLocalMutable lp -> let package = lpPackage lp hasLibrary = hasMainBuildableLibrary package -<<<<<<< HEAD hasSubLibraries = not . null $ packageSubLibraries package -======= - hasSubLibrary = not . null $ packageSubLibraries package ->>>>>>> 4a6fb3052 (refactoring: remove package based packageInternalLibraries) hasExecutables = not . Set.null $ exesToBuild executableBuildStatuses lp in (hasLibrary, hasSubLibraries, hasExecutables) @@ -1804,15 +1795,9 @@ singleBuild -- However, we must unregister any such library in the new snapshot, in case -- it was built with different flags. let -<<<<<<< HEAD - subLibNames = getBuildableListText $ case taskType of - TTLocalMutable lp -> packageSubLibraries $ lpPackage lp - TTRemotePackage _ p _ -> packageSubLibraries p -======= - subLibNames = Set.toList $ packageInternalLibraries $ case taskType of + subLibNames = Set.toList $ packageSubLibrariesNameSet $ case taskType of TTLocalMutable lp -> lpPackage lp TTRemotePackage _ p _ -> p ->>>>>>> 4a6fb3052 (refactoring: remove package based packageInternalLibraries) toMungedPackageId :: Text -> MungedPackageId toMungedPackageId subLib = let subLibName = LSubLibName $ mkUnqualComponentName $ T.unpack subLib @@ -2052,14 +2037,9 @@ singleBuild cabal0 keep KeepTHLoading $ "haddock" : args let hasLibrary = hasMainBuildableLibrary package -<<<<<<< HEAD packageHasComponentSet f = not $ Set.null $ f package hasSubLibraries = not $ null $ packageSubLibraries package - hasExecutables = packageHasComponentSet packageExes -======= - hasInternalLibrary = not $ null $ packageSubLibraries package - hasExecutables = not $ null $ packageExes package ->>>>>>> 4a6fb3052 (refactoring: remove package based packageInternalLibraries) + hasExecutables = not $ null $ packageExecutables package shouldCopy = not isFinalBuild && (hasLibrary || hasSubLibraries || hasExecutables) diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index 93b6bfb817..eccbeaa396 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -24,7 +24,7 @@ import qualified Distribution.PackageDescription as C import qualified Pantry.SHA256 as SHA256 import Stack.Build.Cache ( tryGetBuildCache ) import Stack.Build.Haddock ( shouldHaddockDeps ) -import Stack.Package ( hasMainBuildableLibrary, resolvePackage ) +import Stack.Package ( hasMainBuildableLibrary, resolvePackage, packageExes ) import Stack.Prelude import Stack.SourceMap ( DumpedGlobalPackage, checkFlagsUsedThrowing diff --git a/src/Stack/Coverage.hs b/src/Stack/Coverage.hs index 87e337f8cc..452d888326 100644 --- a/src/Stack/Coverage.hs +++ b/src/Stack/Coverage.hs @@ -40,7 +40,7 @@ import Stack.Constants , relFileHpcIndexHtml, relFileIndexHtml ) import Stack.Constants.Config ( distDirFromDir, hpcRelativeDir ) -import Stack.Package ( hasMainBuildableLibrary, packageInternalLibraries ) +import Stack.Package ( hasMainBuildableLibrary ) import Stack.Prelude import Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig ) import Stack.Types.BuildConfig diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index 667cdad32b..b439ad5da1 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -50,6 +50,7 @@ import Stack.Ghci.Script import Stack.Package ( PackageDescriptionPair (..), packageFromPackageDescription , readDotBuildinfo, resolvePackageDescription, hasMainBuildableLibrary + , packageExes ) import Stack.Prelude import Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig ) diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 79bbd03788..85d35a94d8 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -21,7 +21,8 @@ module Stack.Package , hasMainBuildableLibrary , mainLibraryHasExposedModules , packageUnknownTools - , packageInternalLibraries + , packageSubLibrariesNameSet + , packageExes ) where import Data.List ( unzip ) @@ -149,12 +150,6 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg | b <- benchmarks pkgNoMod , buildable (benchmarkBuildInfo b) ] - -- Same comment about buildable applies here too. - , packageExes = S.fromList - [ T.pack (Cabal.unUnqualComponentName $ exeName biBuildInfo) - | biBuildInfo <- executables pkg - , buildable (buildInfo biBuildInfo) - ] -- This is an action used to collect info needed for "stack ghci". -- This info isn't usually needed, so computation of it is deferred. , packageOpts = GetPackageOpts $ @@ -844,5 +839,7 @@ packageUnknownTools pkg = lib (bench <> tests <> flib <> sublib <> exe) gatherUnknownTools :: HasBuildInfo x => CompCollection x -> Set Text gatherUnknownTools = foldr' addUnknownTools mempty -packageInternalLibraries :: Package -> Set Text -packageInternalLibraries pkg = getBuildableSetText (packageSubLibraries pkg) \ No newline at end of file +packageSubLibrariesNameSet :: Package -> Set Text +packageSubLibrariesNameSet pkg = getBuildableSetText (packageSubLibraries pkg) +packageExes :: Package -> Set Text +packageExes pkg = getBuildableSetText (packageExecutables pkg) \ No newline at end of file diff --git a/src/Stack/Types/CompCollection.hs b/src/Stack/Types/CompCollection.hs index 3539ddd9eb..beef29af82 100644 --- a/src/Stack/Types/CompCollection.hs +++ b/src/Stack/Types/CompCollection.hs @@ -19,6 +19,7 @@ module Stack.Types.CompCollection , hasBuildableComponent , collectionLookup , collectionKeyValueList + , collectionMember ) where import Stack.Prelude @@ -118,4 +119,6 @@ hasBuildableComponent = not . null . getBuildableSet collectionLookup :: Text -> CompCollection component -> Maybe component collectionLookup needle haystack = HM.lookup (StackUnqualCompName needle) (asNameMap $ buildableOnes haystack) collectionKeyValueList :: CompCollection component -> [(Text, component)] -collectionKeyValueList haystack = (\(StackUnqualCompName k, v) -> (k, v)) <$> HM.toList (asNameMap $ buildableOnes haystack) \ No newline at end of file +collectionKeyValueList haystack = (\(StackUnqualCompName k, v) -> (k, v)) <$> HM.toList (asNameMap $ buildableOnes haystack) +collectionMember :: Text -> CompCollection component -> Bool +collectionMember needle haystack = isJust $ collectionLookup needle haystack \ No newline at end of file diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 581ec468ec..4a058842e3 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -183,8 +183,6 @@ data Package = Package , packageTests :: !(Map Text TestSuiteInterface) -- ^ names and interfaces of test suites , packageBenchmarks :: !(Set Text) - -- ^ names of benchmarks - , packageExes :: !(Set Text) -- ^ names of executables , packageOpts :: !GetPackageOpts -- ^ Args to pass to GHC. From 936c2ab708828bd8288fbb7dbb8a945fb124b659 Mon Sep 17 00:00:00 2001 From: theophilebatoz Date: Sun, 9 Apr 2023 20:15:37 +0000 Subject: [PATCH 10/42] refactoring: remove packageTests and packageBench --- src/Stack/Build/Execute.hs | 13 +++++++++---- src/Stack/Build/Source.hs | 7 ++++--- src/Stack/Ghci.hs | 10 +++++----- src/Stack/Package.hs | 20 +++++++------------- src/Stack/Types/Package.hs | 7 ++----- 5 files changed, 27 insertions(+), 30 deletions(-) diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 17fc77688c..b7102b28c6 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -195,7 +195,13 @@ import System.IO.Error ( isDoesNotExistError ) import System.PosixCompat.Files ( createLink, getFileStatus, modificationTime ) import System.Random ( randomIO ) -import Stack.Types.CompCollection ( getBuildableListText, getBuildableSetText ) +import Stack.Types.CompCollection + ( getBuildableListText + , collectionKeyValueList + , collectionLookup + ) +import qualified Stack.Types.Component as Component +import GHC.Records ( getField ) -- | Has an executable been built or not? data ExecutableBuildStatus @@ -2037,7 +2043,6 @@ singleBuild cabal0 keep KeepTHLoading $ "haddock" : args let hasLibrary = hasMainBuildableLibrary package - packageHasComponentSet f = not $ Set.null $ f package hasSubLibraries = not $ null $ packageSubLibraries package hasExecutables = not $ null $ packageExecutables package shouldCopy = @@ -2271,7 +2276,7 @@ singleTest topts testsToRun ac ee task installedMap = do let suitesToRun = [ testSuitePair - | testSuitePair <- Map.toList $ packageTests package + | testSuitePair <- (fmap . fmap) (getField @"interface") <$> collectionKeyValueList $ packageTestSuites package , let testName = fst testSuitePair , testName `elem` testsToRun ] @@ -2480,7 +2485,7 @@ singleTest topts testsToRun ac ee task installedMap = do when needHpc $ do let testsToRun' = map f testsToRun f tName = - case Map.lookup tName (packageTests package) of + case getField @"interface" <$> collectionLookup tName (packageTestSuites package) of Just C.TestSuiteLibV09{} -> tName <> "Stub" _ -> tName generateHpcReport pkgDir package testsToRun' diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index eccbeaa396..507b6760ff 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -24,7 +24,7 @@ import qualified Distribution.PackageDescription as C import qualified Pantry.SHA256 as SHA256 import Stack.Build.Cache ( tryGetBuildCache ) import Stack.Build.Haddock ( shouldHaddockDeps ) -import Stack.Package ( hasMainBuildableLibrary, resolvePackage, packageExes ) +import Stack.Package ( hasMainBuildableLibrary, resolvePackage, packageExes, packageBenchmarks ) import Stack.Prelude import Stack.SourceMap ( DumpedGlobalPackage, checkFlagsUsedThrowing @@ -65,6 +65,7 @@ import Stack.Types.SourceMap import Stack.Types.UnusedFlags ( FlagSource (..) ) import System.FilePath ( takeFileName ) import System.IO.Error ( isDoesNotExistError ) +import Stack.Types.CompCollection ( getBuildableSetText ) -- | loads and returns project packages projectLocalPackages :: HasEnvConfig env => RIO env [LocalPackage] @@ -315,7 +316,7 @@ loadLocalPackage pp = do ( packageExes pkg , if boptsTests bopts && maybe True (Set.notMember name . curatorSkipTest) mcurator - then Map.keysSet (packageTests pkg) + then getBuildableSetText (packageTestSuites pkg) else Set.empty , if boptsBenchmarks bopts && maybe @@ -419,7 +420,7 @@ loadLocalPackage pp = do -- must not be buildable. , lpUnbuildable = toComponents (exes `Set.difference` packageExes pkg) - (tests `Set.difference` Map.keysSet (packageTests pkg)) + (tests `Set.difference` getBuildableSetText (packageTestSuites pkg)) (benches `Set.difference` packageBenchmarks pkg) } diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index b439ad5da1..6adcc5726e 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -959,16 +959,16 @@ makeGhciPkgInfo installMap installedMap locals addPkgs mfileTargets pkgDesc = do wantedPackageComponents :: BuildOpts -> Target -> Package -> Set NamedComponent wantedPackageComponents _ (TargetComps cs) _ = cs wantedPackageComponents bopts (TargetAll PTProject) pkg = S.fromList $ - ( if hasMainBuildableLibrary pkg - then CLib : map CSubLib (getBuildableListText $ packageForeignLibraries pkg) - else []) ++ + (if hasMainBuildableLibrary pkg + then CLib : map CSubLib (getBuildableListText $ packageForeignLibraries pkg) + else []) ++ map CExe (S.toList (packageExes pkg)) <> map CSubLib (getBuildableListText $ packageSubLibraries pkg) <> (if boptsTests bopts - then map CTest (M.keys (packageTests pkg)) + then map CTest (getBuildableListText (packageTestSuites pkg)) else []) <> (if boptsBenchmarks bopts - then map CBench (S.toList (packageBenchmarks pkg)) + then map CBench (getBuildableListText (packageBenchmarkSuites pkg)) else []) wantedPackageComponents _ _ _ = S.empty diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 85d35a94d8..e97ec25e7b 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -23,6 +23,7 @@ module Stack.Package , packageUnknownTools , packageSubLibrariesNameSet , packageExes + , packageBenchmarks ) where import Data.List ( unzip ) @@ -135,21 +136,11 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg , packageLibrary = stackLibraryFromCabal <$> library pkg , packageSubLibraries = foldAndMakeCollection stackLibraryFromCabal $ subLibraries pkg , packageForeignLibraries = foldAndMakeCollection stackForeignLibraryFromCabal $ foreignLibs pkg - , packageTestSuites = foldAndMakeCollection stackTestFromCabal $ testSuites pkg - , packageBenchmarkSuites = foldAndMakeCollection stackBenchmarkFromCabal $ benchmarks pkg + , packageTestSuites = foldAndMakeCollection stackTestFromCabal $ testSuites pkgNoMod + , packageBenchmarkSuites = foldAndMakeCollection stackBenchmarkFromCabal $ benchmarks pkgNoMod , packageExecutables = foldAndMakeCollection stackExecutableFromCabal $ executables pkg , packageAllDeps = M.keysSet deps , packageSubLibDeps = subLibDeps - , packageTests = M.fromList - [ (T.pack (Cabal.unUnqualComponentName $ testName t), testInterface t) - | t <- testSuites pkgNoMod - , buildable (testBuildInfo t) - ] - , packageBenchmarks = S.fromList - [ T.pack (Cabal.unUnqualComponentName $ benchmarkName b) - | b <- benchmarks pkgNoMod - , buildable (benchmarkBuildInfo b) - ] -- This is an action used to collect info needed for "stack ghci". -- This info isn't usually needed, so computation of it is deferred. , packageOpts = GetPackageOpts $ @@ -842,4 +833,7 @@ packageUnknownTools pkg = lib (bench <> tests <> flib <> sublib <> exe) packageSubLibrariesNameSet :: Package -> Set Text packageSubLibrariesNameSet pkg = getBuildableSetText (packageSubLibraries pkg) packageExes :: Package -> Set Text -packageExes pkg = getBuildableSetText (packageExecutables pkg) \ No newline at end of file +packageExes pkg = getBuildableSetText (packageExecutables pkg) +-- packageTests :: +packageBenchmarks :: Package -> Set Text +packageBenchmarks pkg = getBuildableSetText (packageBenchmarkSuites pkg) \ No newline at end of file diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 4a058842e3..05b777bf66 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -50,7 +50,7 @@ import qualified Distribution.SPDX.License as SPDX import Distribution.License ( License ) import Distribution.ModuleName ( ModuleName ) import Distribution.PackageDescription - ( TestSuiteInterface, BuildType ) + ( BuildType ) import Distribution.System ( Platform (..) ) import qualified RIO.Text as T import Stack.Prelude @@ -180,10 +180,7 @@ data Package = Package , packageTestSuites :: CompCollection StackTest , packageBenchmarkSuites :: CompCollection StackBenchmark , packageExecutables :: CompCollection StackExecutable - , packageTests :: !(Map Text TestSuiteInterface) - -- ^ names and interfaces of test suites - , packageBenchmarks :: !(Set Text) - -- ^ names of executables + -- ^ does the package have a buildable library stanza? , packageOpts :: !GetPackageOpts -- ^ Args to pass to GHC. , packageBuildType :: !BuildType From a5ff987b0817873666ecf2c8e7dd44ce9747d5c6 Mon Sep 17 00:00:00 2001 From: theophilebatoz Date: Fri, 10 Nov 2023 16:03:10 +0000 Subject: [PATCH 11/42] feat: replace package file gathering for cabal aligned design --- .hlint.yaml | 5 + src/Stack/Build/Source.hs | 7 +- src/Stack/Component.hs | 5 +- src/Stack/ComponentFile.hs | 122 +++++++++++----------- src/Stack/Ghci.hs | 7 +- src/Stack/Package.hs | 12 +-- src/Stack/PackageFile.hs | 136 +++++++++--------------- src/Stack/Types/CompCollection.hs | 2 +- src/Stack/Types/Component.hs | 165 +++++++++++++++--------------- src/Stack/Types/Package.hs | 31 +++--- src/Stack/Types/PackageFile.hs | 28 +++++ 11 files changed, 259 insertions(+), 261 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index 02f1a89d42..7f19231700 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -65,6 +65,11 @@ - MultiWayIf - OverloadedLists - OverloadedStrings + - ConstraintKinds + - FlexibleContexts + - DisambiguateRecordFields + - OverloadedRecordDot + - PartialTypeSignatures - QuasiQuotes - RecordWildCards - ScopedTypeVariables diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index 507b6760ff..e918b84bb6 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -55,7 +55,8 @@ import Stack.Types.Package , PackageConfig (..) , dotCabalGetPath, memoizeRefWith, runMemoizedWith ) -import Stack.Types.PackageFile ( PackageWarning, getPackageFiles ) +import Stack.Types.PackageFile ( PackageWarning, PackageComponentFile (PackageComponentFile) ) +import Stack.PackageFile ( getPackageFile ) import Stack.Types.Platform ( HasPlatform (..) ) import Stack.Types.SourceMap ( CommonPackage (..), DepPackage (..), ProjectPackage (..) @@ -497,8 +498,8 @@ getPackageFilesForTargets :: -> Set NamedComponent -> RIO env (Map NamedComponent (Set (Path Abs File)), [PackageWarning]) getPackageFilesForTargets pkg cabalFP nonLibComponents = do - (components',compFiles,otherFiles,warnings) <- - getPackageFiles (packageFiles pkg) cabalFP + PackageComponentFile components' compFiles otherFiles warnings <- + getPackageFile pkg cabalFP let necessaryComponents = Set.insert CLib $ Set.filter isCSubLib (M.keysSet components') components = necessaryComponents `Set.union` nonLibComponents diff --git a/src/Stack/Component.hs b/src/Stack/Component.hs index b5153aeae6..6dff2fd134 100644 --- a/src/Stack/Component.hs +++ b/src/Stack/Component.hs @@ -8,7 +8,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PartialTypeSignatures #-} -{-# OPTIONS_GHC -Wno-partial-type-signatures #-} -- | All utility functions for Components (library, internal library, foreign library, executable, tests, benchmarks) in stack. -- In particular, this module gathers all the Cabal-to-Stack component translations, which previlously occured in the "Stack.Package" module. @@ -85,9 +84,9 @@ stackBuildInfoFromCabal buildInfoV = gatherComponentToolsAndDepsFromCabal StackBuildInfo { sbiBuildable = buildInfoV.buildable, sbiOtherModules = buildInfoV.otherModules, - sbiJsSources = buildInfoV.jsSources, + jsSources = buildInfoV.jsSources, hsSourceDirs = buildInfoV.hsSourceDirs, - cSource = buildInfoV.cSources, + cSources = buildInfoV.cSources, sbiDependency = mempty, sbiUnknownTools = mempty } diff --git a/src/Stack/ComponentFile.hs b/src/Stack/ComponentFile.hs index 896ff119f0..eef92bf954 100644 --- a/src/Stack/ComponentFile.hs +++ b/src/Stack/ComponentFile.hs @@ -1,21 +1,23 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedRecordDot #-} -- | A module which exports all component-level file-gathering logic. It also -- includes utility functions for handling paths and directories. module Stack.ComponentFile ( resolveOrWarn - , libraryFiles - , executableFiles - , testFiles - , benchmarkFiles , componentOutputDir , componentBuildDir , packageAutogenDir , buildDir , componentAutogenDir + , ComponentFile(..) + , stackLibraryFiles + , stackExecutableFiles + , stackTestFiles + , stackBenchmarkFiles ) where import Control.Exception ( throw ) @@ -27,12 +29,11 @@ import qualified Data.Text as T import Distribution.ModuleName ( ModuleName ) import qualified Distribution.ModuleName as Cabal import Distribution.PackageDescription - ( Benchmark (..), BenchmarkInterface (..), BuildInfo (..) - , Executable (..), Library (..), TestSuite (..) + ( BenchmarkInterface (..) , TestSuiteInterface (..) ) import Distribution.Text ( display ) -import Distribution.Utils.Path ( getSymbolicPath ) +import Distribution.Utils.Path ( getSymbolicPath, SymbolicPath, PackageDir, SourceDir ) import Distribution.Version ( mkVersion ) import qualified HiFileParser as Iface import Path @@ -60,84 +61,86 @@ import Stack.Types.PackageFile ) import qualified System.Directory as D ( doesFileExist ) import qualified System.FilePath as FilePath +import Stack.Types.Component (StackBenchmark, sbiOtherModules, StackTest, unqualCompToText, StackExecutable, StackLibrary) +import qualified Stack.Types.Component +import GHC.Records ( HasField ) + +data ComponentFile = ComponentFile { + moduleFileMap :: !(Map ModuleName (Path Abs File)), + otherFile :: ![DotCabalPath], + packageWarning :: ![PackageWarning] +} -- | Get all files referenced by the benchmark. -benchmarkFiles :: - NamedComponent - -> Benchmark - -> RIO +stackBenchmarkFiles :: StackBenchmark -> RIO GetPackageFileContext - (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning]) -benchmarkFiles component bench = - resolveComponentFiles component build names + (NamedComponent, ComponentFile) +stackBenchmarkFiles bench = + resolveComponentFiles (CBench $ unqualCompToText bench.name) build names where names = bnames <> exposed exposed = - case benchmarkInterface bench of + case bench.interface of BenchmarkExeV10 _ fp -> [DotCabalMain fp] BenchmarkUnsupported _ -> [] - bnames = map DotCabalModule (otherModules build) - build = benchmarkBuildInfo bench + bnames = map DotCabalModule build.sbiOtherModules + build = bench.buildInfo -- | Get all files referenced by the test. -testFiles :: - NamedComponent - -> TestSuite - -> RIO +stackTestFiles :: StackTest -> RIO GetPackageFileContext - (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning]) -testFiles component test = - resolveComponentFiles component build names + (NamedComponent, ComponentFile) +stackTestFiles test = + resolveComponentFiles (CTest $ unqualCompToText test.name) build names where names = bnames <> exposed exposed = - case testInterface test of + case test.interface of TestSuiteExeV10 _ fp -> [DotCabalMain fp] TestSuiteLibV09 _ mn -> [DotCabalModule mn] TestSuiteUnsupported _ -> [] - bnames = map DotCabalModule (otherModules build) - build = testBuildInfo test + bnames = map DotCabalModule build.sbiOtherModules + build = test.buildInfo -- | Get all files referenced by the executable. -executableFiles :: - NamedComponent - -> Executable - -> RIO +stackExecutableFiles :: StackExecutable -> RIO GetPackageFileContext - (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning]) -executableFiles component exe = - resolveComponentFiles component build names + (NamedComponent, ComponentFile) +stackExecutableFiles exe = + resolveComponentFiles (CExe $ unqualCompToText exe.name) build names where - build = buildInfo exe + build = exe.buildInfo names = - map DotCabalModule (otherModules build) ++ - [DotCabalMain (modulePath exe)] + map DotCabalModule build.sbiOtherModules ++ + [DotCabalMain exe.modulePath] -- | Get all files referenced by the library. -libraryFiles :: - NamedComponent - -> Library - -> RIO +-- | Handle all libraries (CLib and SubLib), based on empty name or not. +stackLibraryFiles :: StackLibrary -> RIO GetPackageFileContext - (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning]) -libraryFiles component lib = - resolveComponentFiles component build names + (NamedComponent, ComponentFile) +stackLibraryFiles lib = + resolveComponentFiles componentName build names where - build = libBuildInfo lib + componentRawName = unqualCompToText lib.name + componentName + | componentRawName == mempty = CLib + | otherwise = CSubLib componentRawName + build = lib.buildInfo names = bnames ++ exposed - exposed = map DotCabalModule (exposedModules lib) - bnames = map DotCabalModule (otherModules build) + exposed = map DotCabalModule lib.exposedModules + bnames = map DotCabalModule build.sbiOtherModules -- | Get all files referenced by the component. -resolveComponentFiles :: +resolveComponentFiles :: (CAndJsSources rec, HasField "hsSourceDirs" rec [SymbolicPath PackageDir SourceDir]) => NamedComponent - -> BuildInfo + -> rec -> [DotCabalDescriptor] -> RIO GetPackageFileContext - (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning]) + (NamedComponent, ComponentFile) resolveComponentFiles component build names = do - dirs <- mapMaybeM (resolveDirOrWarn . getSymbolicPath) (hsSourceDirs build) + dirs <- mapMaybeM (resolveDirOrWarn . getSymbolicPath) build.hsSourceDirs dir <- asks (parent . ctxFile) agdirs <- autogenDirs (modules,files,warnings) <- @@ -146,7 +149,7 @@ resolveComponentFiles component build names = do ((if null dirs then [dir] else dirs) ++ agdirs) names cfiles <- buildOtherSources build - pure (modules, files <> cfiles, warnings) + pure (component, ComponentFile modules (files <> cfiles) warnings) where autogenDirs = do cabalVer <- asks ctxCabalVer @@ -444,8 +447,10 @@ logPossibilities dirs mn = do ) dirs +type CAndJsSources rec = (HasField "cSources" rec [FilePath], HasField "jsSources" rec [FilePath]) + -- | Get all C sources and extra source files in a build. -buildOtherSources :: BuildInfo -> RIO GetPackageFileContext [DotCabalPath] +buildOtherSources :: CAndJsSources rec => rec -> RIO GetPackageFileContext [DotCabalPath] buildOtherSources build = do cwd <- liftIO getCurrentDir dir <- asks (parent . ctxFile) @@ -458,14 +463,10 @@ buildOtherSources build = do warnMissingFile "File" cwd fp file pure Nothing Just p -> pure $ Just (toCabalPath p) - csources <- resolveDirFiles (cSources build) DotCabalCFilePath - jsources <- resolveDirFiles (targetJsSources build) DotCabalFilePath + csources <- resolveDirFiles build.cSources DotCabalCFilePath + jsources <- resolveDirFiles build.jsSources DotCabalFilePath pure (csources <> jsources) --- | Get the target's JS sources. -targetJsSources :: BuildInfo -> [FilePath] -targetJsSources = jsSources - -- | Resolve file as a child of a specified directory, symlinks -- don't get followed. resolveDirFile :: @@ -542,7 +543,8 @@ buildDir distDir = distDir relDirBuild -- component names. componentNameToDir :: Text -> Path Rel Dir componentNameToDir name = - fromMaybe (throw ComponentNotParsedBug) (parseRelDir (T.unpack name)) + fromMaybe (throw $ ComponentNotParsedBug sName) (parseRelDir sName) + where sName = T.unpack name -- | See 'Distribution.Simple.LocalBuildInfo.componentBuildDir' componentBuildDir :: Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index 6adcc5726e..a082d033e1 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -78,7 +78,7 @@ import Stack.Types.Package , dotCabalCFilePath, dotCabalGetPath , dotCabalMainPath, getPackageOpts ) -import Stack.Types.PackageFile ( getPackageFiles ) +import Stack.PackageFile ( getPackageFile ) import Stack.Types.Platform ( HasPlatform (..) ) import Stack.Types.Runner ( HasRunner, Runner ) import Stack.Types.SourceMap @@ -89,6 +89,7 @@ import Stack.Types.SourceMap import System.IO ( putStrLn ) import System.Permissions ( setScriptPerms ) import Stack.Types.CompCollection ( getBuildableListText ) +import Stack.Types.PackageFile (PackageComponentFile(PackageComponentFile)) -- | Type representing exceptions thrown by functions exported by the -- "Stack.Ghci" module. @@ -347,7 +348,7 @@ findFileTargets :: -> RIO env (Map PackageName Target, Map PackageName [Path Abs File], [Path Abs File]) findFileTargets locals fileTargets = do filePackages <- forM locals $ \lp -> do - (_,compFiles,_,_) <- getPackageFiles (packageFiles (lpPackage lp)) (lpCabalFile lp) + PackageComponentFile _ compFiles _ _ <- getPackageFile (lpPackage lp) (lpCabalFile lp) pure (lp, M.map (map dotCabalGetPath) compFiles) let foundFileTargetComponents :: [(Path Abs File, [(PackageName, NamedComponent)])] foundFileTargetComponents = @@ -931,7 +932,7 @@ makeGhciPkgInfo installMap installedMap locals addPkgs mfileTargets pkgDesc = do cabalfp = ghciDescCabalFp pkgDesc target = ghciDescTarget pkgDesc name = packageName pkg - (mods,files,opts) <- getPackageOpts (packageOpts pkg) installMap installedMap locals addPkgs cabalfp + (mods,files,opts) <- getPackageOpts (packageOpts pkg) pkg installMap installedMap locals addPkgs cabalfp let filteredOpts = filterWanted opts filterWanted = M.filterWithKey (\k _ -> k `S.member` allWanted) allWanted = wantedPackageComponents bopts target pkg diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index e97ec25e7b..9c93861bd1 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -88,8 +88,8 @@ import Stack.Types.Version ( VersionRange, intersectVersionRanges, withinRange ) import System.FilePath ( replaceExtension ) import Stack.Types.Dependency ( DepValue (..), DepType (..) ) -import Stack.Types.PackageFile ( DotCabalPath , GetPackageFiles (..) ) -import Stack.PackageFile ( getPackageFile ) +import Stack.Types.PackageFile ( DotCabalPath, PackageComponentFile (PackageComponentFile) ) +import Stack.PackageFile ( getPackageFile, stackPackageFileFromCabal ) import Stack.Types.CompCollection ( foldAndMakeCollection, CompCollection, getBuildableSetText ) import Stack.Component @@ -127,7 +127,6 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg , packageVersion = pkgVersion pkgId , packageLicense = licenseRaw pkg , packageDeps = deps - , packageFiles = pkgFiles , packageGhcOptions = packageConfigGhcOptions packageConfig , packageCabalConfigOpts = packageConfigCabalConfigOpts packageConfig , packageFlags = packageConfigFlags packageConfig @@ -143,9 +142,10 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg , packageSubLibDeps = subLibDeps -- This is an action used to collect info needed for "stack ghci". -- This info isn't usually needed, so computation of it is deferred. + -- TODO : move into a function , packageOpts = GetPackageOpts $ - \installMap installedMap omitPkgs addPkgs cabalfp -> do - (componentsModules,componentFiles, _, _) <- getPackageFiles pkgFiles cabalfp + \stackPackage installMap installedMap omitPkgs addPkgs cabalfp -> do + PackageComponentFile !componentsModules componentFiles _ _ <- getPackageFile stackPackage cabalfp let subLibs = S.toList $ subLibComponents $ M.keysSet componentsModules excludedSubLibs <- mapM (parsePackageNameThrowing . T.unpack) subLibs @@ -164,6 +164,7 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg , packageBuildType = buildType pkg , packageSetupDeps = msetupDeps , packageCabalSpec = specVersion pkg + , packageFile = stackPackageFileFromCabal pkg } where extraLibNames = S.union subLibNames foreignLibNames @@ -190,7 +191,6 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg -- Gets all of the modules, files, build files, and data files that constitute -- the package. This is primarily used for dirtiness checking during build, as -- well as use by "stack ghci" - pkgFiles = GetPackageFiles $ getPackageFile pkg pkgId = package pkg name = pkgName pkgId diff --git a/src/Stack/PackageFile.hs b/src/Stack/PackageFile.hs index 6b60b9da8b..b4ea384f38 100644 --- a/src/Stack/PackageFile.hs +++ b/src/Stack/PackageFile.hs @@ -4,28 +4,22 @@ -- | A module which exports all package-level file-gathering logic. module Stack.PackageFile ( getPackageFile - , packageDescModulesAndFiles + , stackPackageFileFromCabal ) where import qualified Data.Map.Strict as M import qualified Data.Set as S -import qualified Data.Text as T import Distribution.CabalSpecVersion ( CabalSpecVersion ) -import Distribution.ModuleName ( ModuleName ) import Distribution.PackageDescription - ( BuildType (..), PackageDescription, benchmarkName - , benchmarks, buildType, dataDir, dataFiles, exeName - , executables, extraSrcFiles, libName, library - , libraryNameString, specVersion, subLibraries, testName - , testSuites ) + ( PackageDescription(dataFiles, extraSrcFiles, dataDir), + BuildType(Custom) ) import Distribution.Simple.Glob ( matchDirFileGlob ) -import qualified Distribution.Types.UnqualComponentName as Cabal import Path ( parent, () ) import Path.Extra ( forgivingResolveFile, rejectMissingFile ) import Path.IO ( doesFileExist ) import Stack.ComponentFile - ( benchmarkFiles, executableFiles, libraryFiles - , resolveOrWarn, testFiles + ( resolveOrWarn, ComponentFile (ComponentFile) + , stackLibraryFiles, stackExecutableFiles, stackBenchmarkFiles ) import Stack.Constants ( relFileHpackPackageConfig, relFileSetupHs, relFileSetupLhs @@ -37,13 +31,15 @@ import Stack.Types.EnvConfig ( HasEnvConfig (..) ) import Stack.Types.NamedComponent ( NamedComponent (..) ) import Stack.Types.PackageFile - ( DotCabalPath (..), GetPackageFileContext (..) - , PackageWarning (..) + ( GetPackageFileContext (..) + , StackPackageFile (StackPackageFile), PackageComponentFile (PackageComponentFile, dfiles) ) import qualified System.FilePath as FilePath import System.IO.Error ( isUserError ) import Stack.Types.BuildConfig ( HasBuildConfig(buildConfigL) ) +import Stack.Types.Package (Package(..)) +import Data.Foldable (Foldable(..)) -- | Resolve the file, if it can't be resolved, warn for the user -- (purely to be helpful). @@ -55,71 +51,30 @@ resolveFileOrWarn = resolveOrWarn "File" f -- | Get all files referenced by the package. packageDescModulesAndFiles :: - PackageDescription + Package -> RIO GetPackageFileContext - ( Map NamedComponent (Map ModuleName (Path Abs File)) - , Map NamedComponent [DotCabalPath] - , Set (Path Abs File) - , [PackageWarning] - ) + PackageComponentFile packageDescModulesAndFiles pkg = do - (libraryMods, libDotCabalFiles, libWarnings) <- - maybe - (pure (M.empty, M.empty, [])) - (asModuleAndFileMap libComponent libraryFiles) - (library pkg) - (subLibrariesMods, subLibDotCabalFiles, subLibWarnings) <- - fmap - foldTuples - ( mapM - (asModuleAndFileMap subLibComponent libraryFiles) - (subLibraries pkg) - ) - (executableMods, exeDotCabalFiles, exeWarnings) <- - fmap - foldTuples - ( mapM - (asModuleAndFileMap exeComponent executableFiles) - (executables pkg) - ) - (testMods, testDotCabalFiles, testWarnings) <- - fmap - foldTuples - (mapM (asModuleAndFileMap testComponent testFiles) (testSuites pkg)) - (benchModules, benchDotCabalPaths, benchWarnings) <- - fmap - foldTuples - ( mapM - (asModuleAndFileMap benchComponent benchmarkFiles) - (benchmarks pkg) - ) - dfiles <- resolveGlobFiles - (specVersion pkg) - ( extraSrcFiles pkg - ++ map (dataDir pkg FilePath.) (dataFiles pkg) - ) - let modules = libraryMods <> subLibrariesMods <> executableMods <> testMods <> - benchModules - files = libDotCabalFiles <> subLibDotCabalFiles <> exeDotCabalFiles <> - testDotCabalFiles <> benchDotCabalPaths - warnings = libWarnings <> subLibWarnings <> exeWarnings <> testWarnings <> - benchWarnings - pure (modules, files, dfiles, warnings) - where - libComponent = const CLib - subLibComponent = - CSubLib . T.pack . maybe - "" Cabal.unUnqualComponentName . libraryNameString . libName - exeComponent = CExe . T.pack . Cabal.unUnqualComponentName . exeName - testComponent = CTest . T.pack . Cabal.unUnqualComponentName . testName - benchComponent = CBench . T.pack . Cabal.unUnqualComponentName . benchmarkName - asModuleAndFileMap label f lib = do - (a, b, c) <- f (label lib) lib - pure (M.singleton (label lib) a, M.singleton (label lib) b, c) - foldTuples = foldl' (<>) (M.empty, M.empty, []) + dfiles <- resolveGlobFilesFromStackPackageFile + (packageCabalSpec pkg) (packageFile pkg) + let initialValue = mempty{dfiles=dfiles} + let accumulator f comp st = (insertComponentFile <$> st) <*> f comp + let gatherCompFileCollection createCompFileFn getCompFn res = foldr' (accumulator createCompFileFn) res (getCompFn pkg) + gatherCompFileCollection stackLibraryFiles packageLibrary + . gatherCompFileCollection stackLibraryFiles packageSubLibraries + . gatherCompFileCollection stackExecutableFiles packageExecutables + . gatherCompFileCollection stackBenchmarkFiles packageBenchmarkSuites $ pure initialValue +resolveGlobFilesFromStackPackageFile :: CabalSpecVersion -> StackPackageFile -> RIO GetPackageFileContext (Set (Path Abs File)) +resolveGlobFilesFromStackPackageFile csvV (StackPackageFile extraSrcFilesV dataDirV dataFilesV) = + resolveGlobFiles + csvV + ( extraSrcFilesV + ++ map (dataDirV FilePath.) dataFilesV + ) + -- | Resolve globbing of files (e.g. data files) to absolute paths. resolveGlobFiles :: CabalSpecVersion -- ^ Cabal file version @@ -158,25 +113,21 @@ resolveGlobFiles cabalFileVersion = -- well as use by "stack ghci" getPackageFile :: ( HasEnvConfig s, MonadReader s m, MonadThrow m, MonadUnliftIO m ) - => PackageDescription + => Package -> Path Abs File - -> m ( Map NamedComponent (Map ModuleName (Path Abs File)) - , Map NamedComponent [DotCabalPath] - , Set (Path Abs File) - , [PackageWarning] - ) + -> m PackageComponentFile getPackageFile pkg cabalfp = debugBracket ("getPackageFiles" <+> pretty cabalfp) $ do let pkgDir = parent cabalfp distDir <- distDirFromDir pkgDir bc <- view buildConfigL cabalVer <- view cabalVersionL - (componentModules, componentFiles, dataFiles', warnings) <- + packageComponentFile <- runRIO (GetPackageFileContext cabalfp distDir bc cabalVer) (packageDescModulesAndFiles pkg) setupFiles <- - if buildType pkg == Custom + if packageBuildType pkg == Custom then do let setupHsPath = pkgDir relFileSetupHs setupLhsPath = pkgDir relFileSetupLhs @@ -189,13 +140,22 @@ getPackageFile pkg cabalfp = then pure (S.singleton setupLhsPath) else pure S.empty else pure S.empty - buildFiles <- 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 - pure - ( componentModules - , componentFiles - , buildFiles <> dataFiles' - , warnings - ) + pure packageComponentFile{dfiles = moreBuildFiles <> dfiles packageComponentFile} + +stackPackageFileFromCabal :: PackageDescription -> StackPackageFile +stackPackageFileFromCabal cabalPkg = + StackPackageFile (extraSrcFiles cabalPkg) (dataDir cabalPkg) (dataFiles cabalPkg) + +insertComponentFile :: PackageComponentFile -> (NamedComponent, ComponentFile) -> PackageComponentFile +insertComponentFile packageCompFile (name, compFile) = + PackageComponentFile nCompFile nDotCollec dfiles nWarnings + where + (ComponentFile modFile dotCabalFile warningsCollec) = compFile + (PackageComponentFile modules files dfiles warnings) = packageCompFile + nCompFile = M.insert name modFile modules + nDotCollec = M.insert name dotCabalFile files + nWarnings = warningsCollec ++ warnings diff --git a/src/Stack/Types/CompCollection.hs b/src/Stack/Types/CompCollection.hs index beef29af82..18e7aa565c 100644 --- a/src/Stack/Types/CompCollection.hs +++ b/src/Stack/Types/CompCollection.hs @@ -119,6 +119,6 @@ hasBuildableComponent = not . null . getBuildableSet collectionLookup :: Text -> CompCollection component -> Maybe component collectionLookup needle haystack = HM.lookup (StackUnqualCompName needle) (asNameMap $ buildableOnes haystack) collectionKeyValueList :: CompCollection component -> [(Text, component)] -collectionKeyValueList haystack = (\(StackUnqualCompName k, v) -> (k, v)) <$> HM.toList (asNameMap $ buildableOnes haystack) +collectionKeyValueList haystack = (\(StackUnqualCompName k, !v) -> (k, v)) <$> HM.toList (asNameMap $ buildableOnes haystack) collectionMember :: Text -> CompCollection component -> Bool collectionMember needle haystack = isJust $ collectionLookup needle haystack \ No newline at end of file diff --git a/src/Stack/Types/Component.hs b/src/Stack/Types/Component.hs index 4c9fd79d87..fce64ca16c 100644 --- a/src/Stack/Types/Component.hs +++ b/src/Stack/Types/Component.hs @@ -1,38 +1,40 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NoImplicitPrelude #-} -- | All component related types (library, internal library, foreign library, executable, tests, benchmarks) in stack. -- The chosen design replicates many of cabal existing things but in simplified -- and sometimes more typed versions. It's a work in progress to bring -- Stack to a more componentized design, and closer to cabal. -module Stack.Types.Component( - HasName, +module Stack.Types.Component + ( HasName, HasBuildInfo, - StackBenchmark(..), - StackBuildInfo(..), - StackExecutable(..), - StackForeignLibrary(..), - StackLibrary(..), - StackTest(..), - StackUnqualCompName(..), - unqualCompToText -) where + StackBenchmark (..), + StackBuildInfo (..), + StackExecutable (..), + StackForeignLibrary (..), + StackLibrary (..), + StackTest (..), + StackUnqualCompName (..), + unqualCompToText, + ) +where -import Stack.Prelude -import Stack.Types.Dependency (DepValue) -import GHC.Records (HasField) -import Distribution.PackageDescription (BenchmarkInterface, TestSuiteInterface) -import Distribution.ModuleName (ModuleName) -import Distribution.Utils.Path (SymbolicPath, PackageDir, SourceDir) +import Distribution.ModuleName (ModuleName) +import Distribution.PackageDescription (BenchmarkInterface, TestSuiteInterface) +import Distribution.Utils.Path (PackageDir, SourceDir, SymbolicPath) +import GHC.Records (HasField) +import Stack.Prelude +import Stack.Types.Dependency (DepValue) type HasName component = HasField "name" component StackUnqualCompName + type HasBuildInfo component = HasField "buildInfo" component StackBuildInfo -- | A main or sub library. We do not keep the [Cabal ADT name distinction](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-LibraryName.html#t:LibraryName) @@ -41,74 +43,69 @@ type HasBuildInfo component = HasField "buildInfo" component StackBuildInfo -- Through this simplification we get a clean name interface for all components (they all have a potentially mempty name of the same type). -- -- [Library](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Library.html) is the Cabal equivalent. --- -data StackLibrary = - StackLibrary - { name :: StackUnqualCompName - , buildInfo :: !StackBuildInfo - , exposedModules :: [ModuleName] - -- ^ This is only used for gathering the files related to this component. - } - deriving (Show, Typeable) +data StackLibrary = StackLibrary + { name :: StackUnqualCompName, + buildInfo :: !StackBuildInfo, + -- | This is only used for gathering the files related to this component. + exposedModules :: [ModuleName] + } + deriving (Show, Typeable) -- Stack foreign libraries. -- -- [ForeignLib](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Foreign-Libraries.html) is the Cabal equivalent. -- -data StackForeignLibrary = - StackForeignLibrary - { name :: StackUnqualCompName - , buildInfo :: !StackBuildInfo - } - deriving (Show, Typeable) +data StackForeignLibrary = StackForeignLibrary + { name :: StackUnqualCompName, + buildInfo :: !StackBuildInfo + } + deriving (Show, Typeable) -- Stack executable. -- -- [Executable](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Executable.html) is the Cabal equivalent. -- -data StackExecutable = - StackExecutable - { name :: StackUnqualCompName - , buildInfo :: !StackBuildInfo - , modulePath :: FilePath - } - deriving (Show, Typeable) +data StackExecutable = StackExecutable + { name :: StackUnqualCompName, + buildInfo :: !StackBuildInfo, + modulePath :: FilePath + } + deriving (Show, Typeable) -- Stack test. -- -- [TestSuite](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-TestSuite.html) is the Cabal equivalent. -- -data StackTest = - StackTest - { name :: StackUnqualCompName - , buildInfo :: !StackBuildInfo - , interface :: !TestSuiteInterface - } - deriving (Show, Typeable) +data StackTest = StackTest + { name :: StackUnqualCompName, + buildInfo :: !StackBuildInfo, + interface :: !TestSuiteInterface + } + deriving (Show, Typeable) -- Stack benchmark. -- -- [Benchmark](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Benchmark.html) is the Cabal equivalent. -- -data StackBenchmark = - StackBenchmark - { name :: StackUnqualCompName - , buildInfo :: StackBuildInfo - , interface :: BenchmarkInterface - -- ^ This is only used for gathering the files related to this component. - } - deriving (Show, Typeable) +data StackBenchmark = StackBenchmark + { name :: StackUnqualCompName, + buildInfo :: StackBuildInfo, + -- | This is only used for gathering the files related to this component. + interface :: BenchmarkInterface + } + deriving (Show, Typeable) -- | Name of an executable. newtype ExeName = ExeName Text - deriving (Show, Eq, Ord, Hashable, IsString, Generic, NFData, Data, Typeable) + deriving (Show, Eq, Ord, Hashable, IsString, Generic, NFData, Data, Typeable) -- | The name of an unqualified component (that is, it can be an executable, a library, anything). -- The Cabal equivalent is [UnqualComponentName](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-UnqualComponentName.html#t:UnqualComponentName). -- Ideally, we'd want to use the cabal type behing this newtype and not Text to avoid unnecessary work, but -- for now this is too much refactoring (also there is no Hashable instance for UnqualComponentName yet). newtype StackUnqualCompName = StackUnqualCompName Text - deriving (Show, Eq, Ord, Hashable, IsString, Generic, NFData, Data, Typeable) + deriving (Show, Eq, Ord, Hashable, IsString, Generic, NFData, Data, Typeable) + unqualCompToText :: StackUnqualCompName -> Text unqualCompToText (StackUnqualCompName v) = v @@ -118,25 +115,25 @@ unqualCompToText (StackUnqualCompName v) = v -- It's also the decomposition of @Package@ based information in prior versions of stack, -- to enable component based builds and backpack. -- The file gathering related fields are lazy because not always needed. -data StackBuildInfo = - StackBuildInfo {sbiBuildable :: !Bool - -- ^ From BuildInfo in cabal - ,sbiDependency :: !(Map PackageName DepValue) - -- ^ From targetBuildDepends in BuildInfo in cabal, and known - -- legacy specified build tools (buildTool). - ,sbiUnknownTools :: Set Text - -- ^ From buildTool in Cabal, we only keep the legacy - -- build tool depends that we know (from a hardcoded list). - -- We only use the deduplication aspect of the Set here, as this - -- field is only used for error reporting in the end. - -- This is kept lazy because it's an error reporting field only. - ,sbiOtherModules :: [ModuleName] - -- ^ Only used in file gathering. See usage in "Stack.ComponentFile" module. - ,sbiJsSources :: [FilePath] - -- ^ Only used in file gathering. See usage in "Stack.ComponentFile" module. - ,hsSourceDirs :: [SymbolicPath PackageDir SourceDir] - -- ^ Only used in file gathering. See usage in "Stack.ComponentFile" module. - ,cSource :: [FilePath] - -- ^ Only used in file gathering. See usage in "Stack.ComponentFile" module. - } - deriving (Show) +data StackBuildInfo = StackBuildInfo + { -- | From BuildInfo in cabal + sbiBuildable :: !Bool, + -- | From targetBuildDepends in BuildInfo in cabal, and known + -- legacy specified build tools (buildTool). + sbiDependency :: !(Map PackageName DepValue), + -- | From buildTool in Cabal, we only keep the legacy + -- build tool depends that we know (from a hardcoded list). + -- We only use the deduplication aspect of the Set here, as this + -- field is only used for error reporting in the end. + -- This is kept lazy because it's an error reporting field only. + sbiUnknownTools :: Set Text, + -- | Only used in file gathering. See usage in "Stack.ComponentFile" module. + sbiOtherModules :: [ModuleName], + -- | Only used in file gathering. See usage in "Stack.ComponentFile" module. + jsSources :: [FilePath], + -- | Only used in file gathering. See usage in "Stack.ComponentFile" module. + hsSourceDirs :: [SymbolicPath PackageDir SourceDir], + -- | Only used in file gathering. See usage in "Stack.ComponentFile" module. + cSources :: [FilePath] + } + deriving (Show) diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 05b777bf66..3d6474cb35 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -60,8 +60,8 @@ import Stack.Types.EnvConfig ( EnvConfig, HasEnvConfig (..) ) import Stack.Types.GhcPkgId ( GhcPkgId ) import Stack.Types.NamedComponent ( NamedComponent ) import Stack.Types.PackageFile - ( GetPackageFiles (..), DotCabalDescriptor (..) - , DotCabalPath (..) + ( DotCabalDescriptor (..) + , DotCabalPath (..), StackPackageFile ) import Stack.Types.SourceMap ( CommonPackage, FromSnapshot ) import Stack.Types.Version ( VersionRange ) @@ -79,7 +79,7 @@ data PackageException | MismatchedCabalIdentifier !PackageIdentifierRevision !PackageIdentifier | CabalFileNameParseFail FilePath | CabalFileNameInvalidPackageName FilePath - | ComponentNotParsedBug + | ComponentNotParsedBug String deriving (Show, Typeable) instance Exception PackageException where @@ -134,8 +134,9 @@ instance Exception PackageException where \extension, the following is invalid: " , fp ] - displayException ComponentNotParsedBug = bugReport "[S-4623]" - "Component names should always parse as directory names." + displayException (ComponentNotParsedBug name)= bugReport "[S-4623]" + ("Component names should always parse as directory names." + <> " The component name without a directory is '" <> name <> "'") -- | Libraries in a package. Since Cabal 2.0, sub-libraries are a thing. data PackageLibraries @@ -158,7 +159,7 @@ data Package = Package -- ^ Version of the package , packageLicense :: !(Either SPDX.License License) -- ^ The license the package was released under. - , packageFiles :: !GetPackageFiles + -- , packageFiles :: !GetPackageFiles -- ^ Get all files of the package. , packageDeps :: !(Map PackageName DepValue) -- ^ Packages that the package depends on, both as libraries and build tools. @@ -174,12 +175,12 @@ data Package = Package -- ^ Flags used on package. , packageDefaultFlags :: !(Map FlagName Bool) -- ^ Defaults for unspecified flags. - , packageLibrary :: Maybe StackLibrary - , packageSubLibraries :: CompCollection StackLibrary - , packageForeignLibraries :: CompCollection StackForeignLibrary - , packageTestSuites :: CompCollection StackTest - , packageBenchmarkSuites :: CompCollection StackBenchmark - , packageExecutables :: CompCollection StackExecutable + , packageLibrary :: !(Maybe StackLibrary) + , packageSubLibraries :: !(CompCollection StackLibrary) + , packageForeignLibraries :: !(CompCollection StackForeignLibrary) + , packageTestSuites :: !(CompCollection StackTest) + , packageBenchmarkSuites :: !(CompCollection StackBenchmark) + , packageExecutables :: !(CompCollection StackExecutable) -- ^ does the package have a buildable library stanza? , packageOpts :: !GetPackageOpts -- ^ Args to pass to GHC. @@ -189,6 +190,9 @@ data Package = Package -- ^ If present: custom-setup dependencies , packageCabalSpec :: !CabalSpecVersion -- ^ Cabal spec range + , packageFile :: StackPackageFile + -- ^ The cabal sourced files related to the package at the package level + -- The components may have file information in their own types } deriving (Show, Typeable) @@ -207,7 +211,8 @@ type InstallMap = Map PackageName (InstallLocation, Version) -- Argument is the location of the Cabal file newtype GetPackageOpts = GetPackageOpts { getPackageOpts :: forall env. HasEnvConfig env - => InstallMap + => Package + -> InstallMap -> InstalledMap -> [PackageName] -> [PackageName] diff --git a/src/Stack/Types/PackageFile.hs b/src/Stack/Types/PackageFile.hs index e42a6fce8e..9d54d4400f 100644 --- a/src/Stack/Types/PackageFile.hs +++ b/src/Stack/Types/PackageFile.hs @@ -11,6 +11,8 @@ module Stack.Types.PackageFile , DotCabalDescriptor (..) , GetPackageFiles (..) , PackageWarning (..) + , StackPackageFile (..) + , PackageComponentFile (..) ) where import Distribution.ModuleName ( ModuleName ) @@ -116,3 +118,29 @@ data PackageWarning | MissingModulesWarning (Path Abs File) (Maybe String) [ModuleName] -- ^ Modules not found in file system, which are listed in Cabal file -} + +-- | This is the information from cabal we need at the package level +-- to track files. +data StackPackageFile = StackPackageFile { + -- specVersion :: CabalSpecVersion, --already in package info + extraSrcFiles :: [FilePath], + dataDir :: FilePath, + dataFiles :: [FilePath] +} deriving (Show, Typeable) + +-- | This is the information from cabal we need at the package level +-- to track files. +data PackageComponentFile = PackageComponentFile { + modules :: Map NamedComponent (Map ModuleName (Path Abs File)), + files :: !(Map NamedComponent [DotCabalPath]), + dfiles :: Set (Path Abs File), + warnings :: [PackageWarning] +} +instance Semigroup PackageComponentFile where + PackageComponentFile x1 x2 x3 x4 <> PackageComponentFile y1 y2 y3 y4 = + PackageComponentFile (x1 <> y1) (x2 <> y2) (x3 <> y3) (x4 <> y4) +instance Monoid PackageComponentFile where + mempty = PackageComponentFile mempty mempty mempty mempty + + + From b0b3098afba29385edb93a9e7c391588b223dad1 Mon Sep 17 00:00:00 2001 From: theophilebatoz Date: Fri, 10 Nov 2023 18:41:48 +0000 Subject: [PATCH 12/42] refacorting: cleaning package libraries --- src/Stack/Package.hs | 4 ++-- src/Stack/PackageFile.hs | 18 +++++++++--------- src/Stack/Types/Package.hs | 9 --------- src/Stack/Types/PackageFile.hs | 29 ++++------------------------- 4 files changed, 15 insertions(+), 45 deletions(-) diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 9c93861bd1..fcb711e0cc 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -834,6 +834,6 @@ packageSubLibrariesNameSet :: Package -> Set Text packageSubLibrariesNameSet pkg = getBuildableSetText (packageSubLibraries pkg) packageExes :: Package -> Set Text packageExes pkg = getBuildableSetText (packageExecutables pkg) --- packageTests :: + packageBenchmarks :: Package -> Set Text -packageBenchmarks pkg = getBuildableSetText (packageBenchmarkSuites pkg) \ No newline at end of file +packageBenchmarks pkg = getBuildableSetText (packageBenchmarkSuites pkg) diff --git a/src/Stack/PackageFile.hs b/src/Stack/PackageFile.hs index b4ea384f38..5db0aba97f 100644 --- a/src/Stack/PackageFile.hs +++ b/src/Stack/PackageFile.hs @@ -32,7 +32,7 @@ import Stack.Types.EnvConfig import Stack.Types.NamedComponent ( NamedComponent (..) ) import Stack.Types.PackageFile ( GetPackageFileContext (..) - , StackPackageFile (StackPackageFile), PackageComponentFile (PackageComponentFile, dfiles) + , StackPackageFile (StackPackageFile), PackageComponentFile (PackageComponentFile, packageExtraFile) ) import qualified System.FilePath as FilePath import System.IO.Error ( isUserError ) @@ -56,9 +56,9 @@ packageDescModulesAndFiles :: GetPackageFileContext PackageComponentFile packageDescModulesAndFiles pkg = do - dfiles <- resolveGlobFilesFromStackPackageFile + packageExtraFile <- resolveGlobFilesFromStackPackageFile (packageCabalSpec pkg) (packageFile pkg) - let initialValue = mempty{dfiles=dfiles} + let initialValue = mempty{packageExtraFile=packageExtraFile} let accumulator f comp st = (insertComponentFile <$> st) <*> f comp let gatherCompFileCollection createCompFileFn getCompFn res = foldr' (accumulator createCompFileFn) res (getCompFn pkg) gatherCompFileCollection stackLibraryFiles packageLibrary @@ -144,7 +144,7 @@ getPackageFile pkg cabalfp = let hpackPath = pkgDir relFileHpackPackageConfig hpackExists <- doesFileExist hpackPath pure $ if hpackExists then S.singleton hpackPath else S.empty - pure packageComponentFile{dfiles = moreBuildFiles <> dfiles packageComponentFile} + pure packageComponentFile{packageExtraFile = moreBuildFiles <> packageExtraFile packageComponentFile} stackPackageFileFromCabal :: PackageDescription -> StackPackageFile stackPackageFileFromCabal cabalPkg = @@ -152,10 +152,10 @@ stackPackageFileFromCabal cabalPkg = insertComponentFile :: PackageComponentFile -> (NamedComponent, ComponentFile) -> PackageComponentFile insertComponentFile packageCompFile (name, compFile) = - PackageComponentFile nCompFile nDotCollec dfiles nWarnings + PackageComponentFile nCompFile nDotCollec packageExtraFile nWarnings where - (ComponentFile modFile dotCabalFile warningsCollec) = compFile - (PackageComponentFile modules files dfiles warnings) = packageCompFile - nCompFile = M.insert name modFile modules - nDotCollec = M.insert name dotCabalFile files + (ComponentFile moduleFileMap dotCabalFileList warningsCollec) = compFile + (PackageComponentFile modules files packageExtraFile warnings) = packageCompFile + nCompFile = M.insert name moduleFileMap modules + nDotCollec = M.insert name dotCabalFileList files nWarnings = warningsCollec ++ warnings diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 3d6474cb35..04be63fe6a 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -19,7 +19,6 @@ module Stack.Types.Package , PackageDatabase (..) , PackageDbVariety (..) , PackageException (..) - , PackageLibraries (..) , PackageSource (..) , dotCabalCFilePath , dotCabalGetPath @@ -138,14 +137,6 @@ instance Exception PackageException where ("Component names should always parse as directory names." <> " The component name without a directory is '" <> name <> "'") --- | Libraries in a package. Since Cabal 2.0, sub-libraries are a thing. -data PackageLibraries - = NoLibraries - | HasLibraries !(Set Text) - -- ^ the foreign library names, sub-libraries get built automatically - -- without explicit component name passing - deriving (Show, Typeable) - -- | Name of an executable. newtype ExeName = ExeName { unExeName :: Text } diff --git a/src/Stack/Types/PackageFile.hs b/src/Stack/Types/PackageFile.hs index 9d54d4400f..5e847fc4c2 100644 --- a/src/Stack/Types/PackageFile.hs +++ b/src/Stack/Types/PackageFile.hs @@ -9,7 +9,6 @@ module Stack.Types.PackageFile ( GetPackageFileContext (..) , DotCabalPath (..) , DotCabalDescriptor (..) - , GetPackageFiles (..) , PackageWarning (..) , StackPackageFile (..) , PackageComponentFile (..) @@ -21,7 +20,6 @@ import Stack.Prelude import Stack.Types.BuildConfig ( BuildConfig (..), HasBuildConfig (..) ) import Stack.Types.Config ( HasConfig (..) ) -import Stack.Types.EnvConfig ( HasEnvConfig ) import Stack.Types.GHCVariant ( HasGHCVariant (..) ) import Stack.Types.NamedComponent ( NamedComponent ) import Stack.Types.Platform ( HasPlatform (..) ) @@ -93,21 +91,6 @@ data DotCabalDescriptor | DotCabalCFile !FilePath deriving (Eq, Ord, Show) --- | Files that the package depends on, relative to package directory. --- Argument is the location of the Cabal file -newtype GetPackageFiles = GetPackageFiles - { getPackageFiles :: forall env. HasEnvConfig env - => Path Abs File - -> RIO env - ( Map NamedComponent (Map ModuleName (Path Abs File)) - , Map NamedComponent [DotCabalPath] - , Set (Path Abs File) - , [PackageWarning] - ) - } -instance Show GetPackageFiles where - show _ = "" - -- | Warning generated when reading a package data PackageWarning = UnlistedModulesWarning NamedComponent [ModuleName] @@ -128,12 +111,11 @@ data StackPackageFile = StackPackageFile { dataFiles :: [FilePath] } deriving (Show, Typeable) --- | This is the information from cabal we need at the package level --- to track files. +-- | Files that the package depends on, relative to package directory. data PackageComponentFile = PackageComponentFile { - modules :: Map NamedComponent (Map ModuleName (Path Abs File)), - files :: !(Map NamedComponent [DotCabalPath]), - dfiles :: Set (Path Abs File), + modulePathMap :: Map NamedComponent (Map ModuleName (Path Abs File)), + cabalFileMap :: !(Map NamedComponent [DotCabalPath]), + packageExtraFile :: Set (Path Abs File), warnings :: [PackageWarning] } instance Semigroup PackageComponentFile where @@ -141,6 +123,3 @@ instance Semigroup PackageComponentFile where PackageComponentFile (x1 <> y1) (x2 <> y2) (x3 <> y3) (x4 <> y4) instance Monoid PackageComponentFile where mempty = PackageComponentFile mempty mempty mempty mempty - - - From c839e91882d8e80bc65cf6d934e7d2e9cef710ea Mon Sep 17 00:00:00 2001 From: theophilebatoz Date: Sun, 12 Nov 2023 10:37:46 +0000 Subject: [PATCH 13/42] feat: remove ghc package opts lambda in package type --- src/Stack/Component.hs | 26 +++++- src/Stack/Ghci.hs | 8 +- src/Stack/Package.hs | 174 ++++++++++++++--------------------- src/Stack/Types/Component.hs | 28 +++++- src/Stack/Types/Package.hs | 42 ++++----- 5 files changed, 140 insertions(+), 138 deletions(-) diff --git a/src/Stack/Component.hs b/src/Stack/Component.hs index 6dff2fd134..0b15fdc45e 100644 --- a/src/Stack/Component.hs +++ b/src/Stack/Component.hs @@ -20,6 +20,8 @@ module Stack.Component , stackForeignLibraryFromCabal , stackBenchmarkFromCabal , stackTestFromCabal + , foldOnNameAndBuildInfo + , stackUnqualToQual ) where import Stack.Prelude @@ -37,10 +39,23 @@ import qualified Distribution.PackageDescription as Cabal import qualified Data.Map as Map import qualified Data.Set as Set import Distribution.Package (mkPackageName) +import GHC.Records (HasField) +import Data.Foldable (foldr') +import Stack.Types.NamedComponent (NamedComponent) fromCabalName :: UnqualComponentName -> StackUnqualCompName fromCabalName unqualName = StackUnqualCompName $ pack . Cabal.unUnqualComponentName $ unqualName +stackUnqualToQual :: (Text -> NamedComponent) -> StackUnqualCompName -> NamedComponent +stackUnqualToQual c (StackUnqualCompName n) = c n + +foldOnNameAndBuildInfo :: (HasField "buildInfo" a StackBuildInfo + , HasField "name" a StackUnqualCompName, Foldable c) => + c a -> (StackUnqualCompName -> StackBuildInfo -> t -> t) -> t -> t +foldOnNameAndBuildInfo initialCollection accumulator input = foldr' iterator input initialCollection + where + iterator comp = accumulator comp.name comp.buildInfo + stackLibraryFromCabal :: Library -> StackLibrary stackLibraryFromCabal cabalLib = StackLibrary { name=case cabalLib.libName of @@ -88,7 +103,16 @@ stackBuildInfoFromCabal buildInfoV = gatherComponentToolsAndDepsFromCabal hsSourceDirs = buildInfoV.hsSourceDirs, cSources = buildInfoV.cSources, sbiDependency = mempty, - sbiUnknownTools = mempty + sbiUnknownTools = mempty, + cppOptions = buildInfoV.cppOptions, + targetBuildDepends = buildInfoV.targetBuildDepends, + options = buildInfoV.options, + allLanguages = Cabal.allLanguages buildInfoV, + usedExtensions = Cabal.usedExtensions buildInfoV, + includeDirs = buildInfoV.includeDirs, + extraLibs = buildInfoV.extraLibs, + extraLibDirs = buildInfoV.extraLibDirs, + frameworks = buildInfoV.frameworks } -- | Iterate on all three dependency list given, and transform and sort them between sbiUnknownTools diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index a082d033e1..b16a16871d 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -50,7 +50,7 @@ import Stack.Ghci.Script import Stack.Package ( PackageDescriptionPair (..), packageFromPackageDescription , readDotBuildinfo, resolvePackageDescription, hasMainBuildableLibrary - , packageExes + , packageExes, getPackageOpts ) import Stack.Prelude import Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig ) @@ -76,7 +76,7 @@ import Stack.Types.Package ( BuildInfoOpts (..), InstallMap, InstalledMap , LocalPackage (..), Package (..), PackageConfig (..) , dotCabalCFilePath, dotCabalGetPath - , dotCabalMainPath, getPackageOpts + , dotCabalMainPath ) import Stack.PackageFile ( getPackageFile ) import Stack.Types.Platform ( HasPlatform (..) ) @@ -89,7 +89,7 @@ import Stack.Types.SourceMap import System.IO ( putStrLn ) import System.Permissions ( setScriptPerms ) import Stack.Types.CompCollection ( getBuildableListText ) -import Stack.Types.PackageFile (PackageComponentFile(PackageComponentFile)) +import Stack.Types.PackageFile (PackageComponentFile(PackageComponentFile)) -- | Type representing exceptions thrown by functions exported by the -- "Stack.Ghci" module. @@ -932,7 +932,7 @@ makeGhciPkgInfo installMap installedMap locals addPkgs mfileTargets pkgDesc = do cabalfp = ghciDescCabalFp pkgDesc target = ghciDescTarget pkgDesc name = packageName pkg - (mods,files,opts) <- getPackageOpts (packageOpts pkg) pkg installMap installedMap locals addPkgs cabalfp + (mods,files,opts) <- getPackageOpts pkg installMap installedMap locals addPkgs cabalfp let filteredOpts = filterWanted opts filterWanted = M.filterWithKey (\k _ -> k `S.member` allWanted) allWanted = wantedPackageComponents bopts target pkg diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index fcb711e0cc..cf5174d25e 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -11,7 +11,6 @@ module Stack.Package , packageFromPackageDescription , Package (..) , PackageDescriptionPair (..) - , GetPackageOpts (..) , PackageConfig (..) , buildLogPath , PackageException (..) @@ -24,6 +23,7 @@ module Stack.Package , packageSubLibrariesNameSet , packageExes , packageBenchmarks + , getPackageOpts ) where import Data.List ( unzip ) @@ -41,9 +41,9 @@ import Distribution.PackageDescription , Dependency (..), Executable (..), ForeignLib (..) , GenericPackageDescription (..), HookedBuildInfo , Library (..), PackageDescription (..), PackageFlag (..) - , SetupBuildInfo (..), TestSuite (..), allLanguages + , SetupBuildInfo (..), TestSuite (..) , allLibraries, buildType, depPkgName, depVerRange - , libraryNameString, maybeToLibraryName, usedExtensions + , libraryNameString, maybeToLibraryName ) import Distribution.Pretty ( prettyShow ) import Distribution.Simple.PackageDescription ( readHookedBuildInfo ) @@ -79,10 +79,10 @@ import Stack.Types.GhcPkgId ( ghcPkgIdString ) import Stack.Types.NamedComponent ( NamedComponent (..), subLibComponents ) import Stack.Types.Package - ( BuildInfoOpts (..), ExeName (..), GetPackageOpts (..) + ( BuildInfoOpts (..), ExeName (..) , InstallMap, Installed (..), InstalledMap, Package (..) , PackageConfig (..), PackageException (..) - , dotCabalCFilePath, packageIdentifier + , dotCabalCFilePath, packageIdentifier, BioInput (..) ) import Stack.Types.Version ( VersionRange, intersectVersionRanges, withinRange ) @@ -93,10 +93,11 @@ import Stack.PackageFile ( getPackageFile, stackPackageFileFromCabal ) import Stack.Types.CompCollection ( foldAndMakeCollection, CompCollection, getBuildableSetText ) import Stack.Component -import qualified Stack.Types.Component +import qualified Stack.Types.Component as Component import GHC.Records (getField) import Stack.Types.Component ( HasBuildInfo ) -import Data.Foldable +import Data.Foldable ( Foldable(foldr') ) +import Distribution.ModuleName (ModuleName) -- | Read @.buildinfo@ ancillary files produced by some Setup.hs hooks. -- The file includes Cabal file syntax to be merged into the package description @@ -140,27 +141,6 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg , packageExecutables = foldAndMakeCollection stackExecutableFromCabal $ executables pkg , packageAllDeps = M.keysSet deps , packageSubLibDeps = subLibDeps - -- This is an action used to collect info needed for "stack ghci". - -- This info isn't usually needed, so computation of it is deferred. - -- TODO : move into a function - , packageOpts = GetPackageOpts $ - \stackPackage installMap installedMap omitPkgs addPkgs cabalfp -> do - PackageComponentFile !componentsModules componentFiles _ _ <- getPackageFile stackPackage cabalfp - let subLibs = - S.toList $ subLibComponents $ M.keysSet componentsModules - excludedSubLibs <- mapM (parsePackageNameThrowing . T.unpack) subLibs - mungedSubLibs <- mapM - (parsePackageNameThrowing . T.unpack . toInternalPackageMungedName) - subLibs - componentsOpts <- generatePkgDescOpts - installMap - installedMap - (excludedSubLibs ++ omitPkgs) - (mungedSubLibs ++ addPkgs) - cabalfp - pkg - componentFiles - pure (componentsModules, componentFiles, componentsOpts) , packageBuildType = buildType pkg , packageSetupDeps = msetupDeps , packageCabalSpec = specVersion pkg @@ -184,10 +164,6 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg $ filter (buildable . foreignLibBuildInfo) $ foreignLibs pkg - toInternalPackageMungedName - = T.pack . prettyShow . MungedPackageName (pkgName pkgId) - . maybeToLibraryName . Just . Cabal.mkUnqualComponentName . T.unpack - -- Gets all of the modules, files, build files, and data files that constitute -- the package. This is primarily used for dirtiness checking during build, as -- well as use by "stack ghci" @@ -228,6 +204,40 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg isMe name' = name' == name || fromString (packageNameString name') `S.member` extraLibNames +toInternalPackageMungedName :: Package -> Text -> Text +toInternalPackageMungedName pkg + = T.pack . prettyShow . MungedPackageName (packageName pkg) + . maybeToLibraryName . Just . Cabal.mkUnqualComponentName . T.unpack + +-- | This is an action used to collect info needed for "stack ghci". +-- This info isn't usually needed, so computation of it is deferred. +getPackageOpts :: (MonadUnliftIO m, MonadThrow m, HasEnvConfig env, MonadReader env m) + => Package + -> InstallMap + -> InstalledMap + -> [PackageName] + -> [PackageName] + -> Path Abs File + -> m ( Map NamedComponent (Map ModuleName (Path Abs File)) + , Map NamedComponent [DotCabalPath] + , Map NamedComponent BuildInfoOpts) +getPackageOpts stackPackage installMap installedMap omitPkgs addPkgs cabalfp = do + PackageComponentFile !componentsModules componentFiles _ _ <- getPackageFile stackPackage cabalfp + let subLibs = + S.toList $ subLibComponents $ M.keysSet componentsModules + excludedSubLibs <- mapM (parsePackageNameThrowing . T.unpack) subLibs + mungedSubLibs <- mapM + (parsePackageNameThrowing . T.unpack . toInternalPackageMungedName stackPackage) + subLibs + componentsOpts <- generatePkgDescOpts + installMap + installedMap + (excludedSubLibs ++ omitPkgs) + (mungedSubLibs ++ addPkgs) + cabalfp + stackPackage + componentFiles + pure (componentsModules, componentFiles, componentsOpts) -- | Generate GHC options for the package's components, and a list of options -- which apply generally to the package, not one specific component. generatePkgDescOpts :: @@ -239,16 +249,14 @@ generatePkgDescOpts :: -> [PackageName] -- ^ Packages to add to the "-package" flags -> Path Abs File - -> PackageDescription + -> Package -> Map NamedComponent [DotCabalPath] -> m (Map NamedComponent BuildInfoOpts) generatePkgDescOpts installMap installedMap omitPkgs addPkgs cabalfp pkg componentPaths = do config <- view configL cabalVer <- view cabalVersionL distDir <- distDirFromDir cabalDir - let generate namedComponent binfo = - ( namedComponent - , generateBuildInfoOpts BioInput + let generate namedComponent binfo = generateBuildInfoOpts BioInput { biInstallMap = installMap , biInstalledMap = installedMap , biCabalDir = cabalDir @@ -263,73 +271,25 @@ generatePkgDescOpts installMap installedMap omitPkgs addPkgs cabalfp pkg compone , biComponentName = namedComponent , biCabalVersion = cabalVer } - ) - pure - ( M.fromList - ( concat - [ maybe - [] - (pure . generate CLib . libBuildInfo) - (library pkg) - , mapMaybe - (\subLib -> do - let maybeLib = - CSubLib . T.pack . Cabal.unUnqualComponentName <$> - (libraryNameString . libName) subLib - flip generate (libBuildInfo subLib) <$> maybeLib - ) - (subLibraries pkg) - , fmap - (\exe -> - generate - (CExe (T.pack (Cabal.unUnqualComponentName (exeName exe)))) - (buildInfo exe) - ) - (executables pkg) - , fmap - (\bench -> - generate - (CBench - (T.pack (Cabal.unUnqualComponentName (benchmarkName bench))) - ) - (benchmarkBuildInfo bench) - ) - (benchmarks pkg) - , fmap - (\test -> - generate - (CTest (T.pack (Cabal.unUnqualComponentName (testName test)))) - (testBuildInfo test) - ) - (testSuites pkg) - ] - ) - ) + let insertInMap name compVal = M.insert name (generate name compVal) + let translatedInsertInMap constructor name = insertInMap (stackUnqualToQual constructor name) + let makeBuildInfoOpts selector constructor = foldOnNameAndBuildInfo (selector pkg) (translatedInsertInMap constructor) + let aggregateAllBuildInfoOpts = + makeBuildInfoOpts packageLibrary (const CLib) + . makeBuildInfoOpts packageSubLibraries CSubLib + . makeBuildInfoOpts packageExecutables CExe + . makeBuildInfoOpts packageBenchmarkSuites CBench + . makeBuildInfoOpts packageTestSuites CTest + pure $ aggregateAllBuildInfoOpts mempty where cabalDir = parent cabalfp --- | Input to 'generateBuildInfoOpts' -data BioInput = BioInput - { biInstallMap :: !InstallMap - , biInstalledMap :: !InstalledMap - , biCabalDir :: !(Path Abs Dir) - , biDistDir :: !(Path Abs Dir) - , biOmitPackages :: ![PackageName] - , biAddPackages :: ![PackageName] - , biBuildInfo :: !BuildInfo - , biDotCabalPaths :: ![DotCabalPath] - , biConfigLibDirs :: ![FilePath] - , biConfigIncludeDirs :: ![FilePath] - , biComponentName :: !NamedComponent - , biCabalVersion :: !Version - } - -- | Generate GHC options for the target. Since Cabal also figures out these -- options, currently this is only used for invoking GHCI (via stack ghci). generateBuildInfoOpts :: BioInput -> BuildInfoOpts generateBuildInfoOpts BioInput {..} = BuildInfoOpts - { bioOpts = ghcOpts ++ fmap ("-optP" <>) (cppOptions biBuildInfo) + { bioOpts = ghcOpts ++ fmap ("-optP" <>) (Component.cppOptions biBuildInfo) -- NOTE for future changes: Due to this use of nubOrd (and other uses -- downstream), these generated options must not rely on multiple -- argument sequences. For example, ["--main-is", "Foo.hs", "--main- @@ -364,22 +324,22 @@ generateBuildInfoOpts BioInput {..} = pkgs = biAddPackages ++ [ name - | Dependency name _ _ <- targetBuildDepends biBuildInfo + | Dependency name _ _ <- Component.targetBuildDepends biBuildInfo -- TODO: cabal 3 introduced multiple public libraries in a single dependency , name `notElem` biOmitPackages ] - PerCompilerFlavor ghcOpts _ = options biBuildInfo + PerCompilerFlavor ghcOpts _ = Component.options biBuildInfo extOpts = - map (("-X" ++) . display) (allLanguages biBuildInfo) - <> map (("-X" ++) . display) (usedExtensions biBuildInfo) + map (("-X" ++) . display) (Component.allLanguages biBuildInfo) + <> map (("-X" ++) . display) (Component.usedExtensions biBuildInfo) srcOpts = map (("-i" <>) . toFilePathNoTrailingSep) (concat [ [ componentBuildDir biCabalVersion biComponentName biDistDir ] , [ biCabalDir - | null (hsSourceDirs biBuildInfo) + | null (Component.hsSourceDirs biBuildInfo) ] - , mapMaybe (toIncludeDir . getSymbolicPath) (hsSourceDirs biBuildInfo) + , mapMaybe (toIncludeDir . getSymbolicPath) (Component.hsSourceDirs biBuildInfo) , [ componentAutogen ] , maybeToList (packageAutogenDir biCabalVersion biDistDir) , [ componentOutputDir biComponentName biDistDir ] @@ -392,22 +352,22 @@ generateBuildInfoOpts BioInput {..} = map ("-I" <>) (biConfigIncludeDirs <> pkgIncludeOpts) pkgIncludeOpts = [ toFilePathNoTrailingSep absDir - | dir <- includeDirs biBuildInfo + | dir <- Component.includeDirs biBuildInfo , absDir <- handleDir dir ] libOpts = - map ("-l" <>) (extraLibs biBuildInfo) <> + map ("-l" <>) (Component.extraLibs biBuildInfo) <> map ("-L" <>) (biConfigLibDirs <> pkgLibDirs) pkgLibDirs = [ toFilePathNoTrailingSep absDir - | dir <- extraLibDirs biBuildInfo + | dir <- Component.extraLibDirs biBuildInfo , absDir <- handleDir dir ] handleDir dir = case (parseAbsDir dir, parseRelDir dir) of (Just ab, _ ) -> [ab] (_ , Just rel) -> [biCabalDir rel] (Nothing, Nothing ) -> [] - fworks = map ("-framework=" <>) (frameworks biBuildInfo) + fworks = map ("-framework=" <>) (Component.frameworks biBuildInfo) -- | Make the .o path from the .c file path for a component. Example: -- @@ -807,7 +767,7 @@ hasMainBuildableLibrary package = maybe False isComponentBuildable $ packageLibr -- internal libraries (for instance). -- mainLibraryHasExposedModules :: Package -> Bool -mainLibraryHasExposedModules package = maybe False (not . null . Stack.Types.Component.exposedModules) $ packageLibrary package +mainLibraryHasExposedModules package = maybe False (not . null . Component.exposedModules) $ packageLibrary package -- | Aggregate all unknown tools from all exe. -- Replaces packageUnknownTools field from Package datatype. @@ -826,7 +786,7 @@ packageUnknownTools pkg = lib (bench <> tests <> flib <> sublib <> exe) sublib = gatherUnknownTools $ packageSubLibraries pkg exe = gatherUnknownTools $ packageExecutables pkg addUnknownTools :: HasBuildInfo x => x -> Set Text -> Set Text - addUnknownTools = (<>) . Stack.Types.Component.sbiUnknownTools . getField @"buildInfo" + addUnknownTools = (<>) . Component.sbiUnknownTools . getField @"buildInfo" gatherUnknownTools :: HasBuildInfo x => CompCollection x -> Set Text gatherUnknownTools = foldr' addUnknownTools mempty diff --git a/src/Stack/Types/Component.hs b/src/Stack/Types/Component.hs index fce64ca16c..c1cfcb709a 100644 --- a/src/Stack/Types/Component.hs +++ b/src/Stack/Types/Component.hs @@ -7,6 +7,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# HLINT ignore "Avoid restricted extensions" #-} -- | All component related types (library, internal library, foreign library, executable, tests, benchmarks) in stack. -- The chosen design replicates many of cabal existing things but in simplified @@ -27,11 +29,13 @@ module Stack.Types.Component where import Distribution.ModuleName (ModuleName) -import Distribution.PackageDescription (BenchmarkInterface, TestSuiteInterface) +import Distribution.PackageDescription (BenchmarkInterface, TestSuiteInterface, Dependency) import Distribution.Utils.Path (PackageDir, SourceDir, SymbolicPath) import GHC.Records (HasField) import Stack.Prelude import Stack.Types.Dependency (DepValue) +import Distribution.Compiler (PerCompilerFlavor) +import Distribution.Simple (Language, Extension) type HasName component = HasField "name" component StackUnqualCompName @@ -131,9 +135,27 @@ data StackBuildInfo = StackBuildInfo sbiOtherModules :: [ModuleName], -- | Only used in file gathering. See usage in "Stack.ComponentFile" module. jsSources :: [FilePath], - -- | Only used in file gathering. See usage in "Stack.ComponentFile" module. + -- | Only used in file & opts gathering. See usage in "Stack.ComponentFile" module for fle gathering. hsSourceDirs :: [SymbolicPath PackageDir SourceDir], -- | Only used in file gathering. See usage in "Stack.ComponentFile" module. - cSources :: [FilePath] + cSources :: [FilePath], + -- | Only used in opts gathering. See usage in "Stack.Package" module. + cppOptions :: [String], + -- | Only used in opts gathering. + targetBuildDepends :: [Dependency], + -- | Only used in opts gathering. + options :: PerCompilerFlavor [String], + -- | Only used in opts gathering. + allLanguages :: [Language], + -- | Only used in opts gathering. + usedExtensions :: [Extension], + -- | Only used in opts gathering. + includeDirs :: [FilePath], + -- | Only used in opts gathering. + extraLibs :: [String], + -- | Only used in opts gathering. + extraLibDirs :: [String], + -- | Only used in opts gathering. + frameworks :: [String] } deriving (Show) diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 04be63fe6a..195737fe30 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -4,9 +4,9 @@ module Stack.Types.Package ( BuildInfoOpts (..) + , BioInput (..) , ExeName (..) , FileCacheInfo (..) - , GetPackageOpts (..) , InstallLocation (..) , InstallMap , Installed (..) @@ -65,7 +65,7 @@ import Stack.Types.PackageFile import Stack.Types.SourceMap ( CommonPackage, FromSnapshot ) import Stack.Types.Version ( VersionRange ) import Stack.Types.CompCollection ( CompCollection ) -import Stack.Types.Component ( StackLibrary, StackForeignLibrary, StackTest, StackBenchmark, StackExecutable ) +import Stack.Types.Component ( StackLibrary, StackForeignLibrary, StackTest, StackBenchmark, StackExecutable, StackBuildInfo ) -- | Type representing exceptions thrown by functions exported by the -- "Stack.Package" module. @@ -173,8 +173,6 @@ data Package = Package , packageBenchmarkSuites :: !(CompCollection StackBenchmark) , packageExecutables :: !(CompCollection StackExecutable) -- ^ does the package have a buildable library stanza? - , packageOpts :: !GetPackageOpts - -- ^ Args to pass to GHC. , packageBuildType :: !BuildType -- ^ Package build-type. , packageSetupDeps :: !(Maybe (Map PackageName VersionRange)) @@ -198,25 +196,6 @@ packageDefinedFlags = M.keysSet . packageDefaultFlags -- or mutable) and package versions. type InstallMap = Map PackageName (InstallLocation, Version) --- | Files that the package depends on, relative to package directory. --- Argument is the location of the Cabal file -newtype GetPackageOpts = GetPackageOpts - { getPackageOpts :: forall env. HasEnvConfig env - => Package - -> InstallMap - -> InstalledMap - -> [PackageName] - -> [PackageName] - -> Path Abs File - -> RIO env - ( Map NamedComponent (Map ModuleName (Path Abs File)) - , Map NamedComponent [DotCabalPath] - , Map NamedComponent BuildInfoOpts - ) - } - -instance Show GetPackageOpts where - show _ = "" -- | GHC options based on cabal information and ghc-options. data BuildInfoOpts = BuildInfoOpts @@ -488,3 +467,20 @@ installedVersion :: Installed -> Version installedVersion i = let PackageIdentifier _ version = installedPackageIdentifier i in version + + +-- | Input to 'generateBuildInfoOpts' +data BioInput = BioInput + { biInstallMap :: !InstallMap + , biInstalledMap :: !InstalledMap + , biCabalDir :: !(Path Abs Dir) + , biDistDir :: !(Path Abs Dir) + , biOmitPackages :: ![PackageName] + , biAddPackages :: ![PackageName] + , biBuildInfo :: !StackBuildInfo + , biDotCabalPaths :: ![DotCabalPath] + , biConfigLibDirs :: ![FilePath] + , biConfigIncludeDirs :: ![FilePath] + , biComponentName :: !NamedComponent + , biCabalVersion :: !Version + } From e9b561591c425e7599d7bf0eee5c231b7016ac32 Mon Sep 17 00:00:00 2001 From: theophilebatoz Date: Sun, 12 Nov 2023 12:01:40 +0000 Subject: [PATCH 14/42] ignore .vscode --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 01dcdc009e..c2c2252f70 100644 --- a/.gitignore +++ b/.gitignore @@ -47,6 +47,7 @@ stan.html # VS Code Counter (Visual Studio Code Extension)-related .VSCodeCounter +.vscode # Unexplained *~ From da2e5a0126f04c59115bc5d3583b33a98d4a0bd5 Mon Sep 17 00:00:00 2001 From: theophilebatoz Date: Sun, 12 Nov 2023 16:00:34 +0000 Subject: [PATCH 15/42] fix: ci layout issues --- .stan.toml | 2 +- stack.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.stan.toml b/.stan.toml index 4511240028..543cfa276e 100644 --- a/.stan.toml +++ b/.stan.toml @@ -52,7 +52,7 @@ # Anti-pattern: Data.ByteString.Char8.pack [[ignore]] - id = "OBS-STAN-0203-fki0nd-1111:21" + id = "OBS-STAN-0203-fki0nd-1118:21" # ✦ Description: Usage of 'pack' function that doesn't handle Unicode characters # ✦ Category: #AntiPattern # ✦ File: src\Stack\Build\Execute.hs diff --git a/stack.cabal b/stack.cabal index 499e6ac375..9fae0428e8 100644 --- a/stack.cabal +++ b/stack.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 --- This file has been generated from package.yaml by hpack version 0.35.1. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack From 7b7f1a7db179d4560772eec07e863413d7ca44b0 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sun, 12 Nov 2023 18:05:44 +0000 Subject: [PATCH 16/42] Improve documentation of .gitignore exclusions --- .gitignore | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index c2c2252f70..95dec1e4bf 100644 --- a/.gitignore +++ b/.gitignore @@ -45,9 +45,11 @@ stan.html # macOS-related .DS_Store +# VS Code workspace settings +.vscode + # VS Code Counter (Visual Studio Code Extension)-related .VSCodeCounter -.vscode # Unexplained *~ From 33b3abd308c4190e4bb811f3f69a7f046980ea80 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sun, 12 Nov 2023 18:09:04 +0000 Subject: [PATCH 17/42] List extensions in alphabetical order --- .hlint.yaml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index 7f19231700..e0781e2bb9 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -57,18 +57,18 @@ # the GHC2021 set. Other extensions can be added, if need be. - name: - NoImplicitPrelude + - ConstraintKinds - DataKinds - DefaultSignatures - DerivingStrategies + - DisambiguateRecordFields + - FlexibleContexts - GADTs - LambdaCase - MultiWayIf - OverloadedLists - - OverloadedStrings - - ConstraintKinds - - FlexibleContexts - - DisambiguateRecordFields - OverloadedRecordDot + - OverloadedStrings - PartialTypeSignatures - QuasiQuotes - RecordWildCards From 97b7f6ca99c54cab9a41e86753ff320fcaff6deb Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sun, 12 Nov 2023 18:11:47 +0000 Subject: [PATCH 18/42] Remove PartialTypeSignatures extension --- .hlint.yaml | 1 - src/Stack/Component.hs | 1 - 2 files changed, 2 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index e0781e2bb9..3a769df0a5 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -69,7 +69,6 @@ - OverloadedLists - OverloadedRecordDot - OverloadedStrings - - PartialTypeSignatures - QuasiQuotes - RecordWildCards - ScopedTypeVariables diff --git a/src/Stack/Component.hs b/src/Stack/Component.hs index 0b15fdc45e..caeab7ad65 100644 --- a/src/Stack/Component.hs +++ b/src/Stack/Component.hs @@ -7,7 +7,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE PartialTypeSignatures #-} -- | All utility functions for Components (library, internal library, foreign library, executable, tests, benchmarks) in stack. -- In particular, this module gathers all the Cabal-to-Stack component translations, which previlously occured in the "Stack.Package" module. From a84368c14c16f7d76d699ff6223c6432d27ce4e9 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sun, 12 Nov 2023 18:16:03 +0000 Subject: [PATCH 19/42] Order imports alphabetically --- src/Stack/Build.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Stack/Build.hs b/src/Stack/Build.hs index 7e718e846e..12367a0583 100644 --- a/src/Stack/Build.hs +++ b/src/Stack/Build.hs @@ -30,7 +30,7 @@ import Stack.Build.Installed ( getInstalled, toInstallMap ) import Stack.Build.Source ( localDependencies, projectLocalPackages ) import Stack.Build.Target ( NeedTargets (..) ) import Stack.FileWatch ( fileWatch, fileWatchPoll ) -import Stack.Package ( resolvePackage, packageExes ) +import Stack.Package ( packageExes, resolvePackage ) import Stack.Prelude hiding ( loadPackage ) import Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig ) import Stack.Setup ( withNewLocalBuildTargets ) From fc4cd0061ab3e8e91308d9dfb5da1625fa191029 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sun, 12 Nov 2023 19:51:52 +0000 Subject: [PATCH 20/42] Explicit import lists and consistent formatting --- src/Stack/Component.hs | 4 +- src/Stack/Package.hs | 277 +++++++++++++++++------------- src/Stack/Types/CompCollection.hs | 165 +++++++++++------- src/Stack/Types/Component.hs | 232 +++++++++++++------------ src/Stack/Types/Package.hs | 42 ++--- 5 files changed, 401 insertions(+), 319 deletions(-) diff --git a/src/Stack/Component.hs b/src/Stack/Component.hs index caeab7ad65..bea678b596 100644 --- a/src/Stack/Component.hs +++ b/src/Stack/Component.hs @@ -21,8 +21,8 @@ module Stack.Component , stackTestFromCabal , foldOnNameAndBuildInfo , stackUnqualToQual - ) - where + ) where + import Stack.Prelude import Stack.Types.Component import Stack.Types.Dependency ( cabalExeToStackDep, cabalToStackDep ) diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index cf5174d25e..c217e7b4a0 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} -- | Dealing with Cabal. @@ -26,6 +26,7 @@ module Stack.Package , getPackageOpts ) where +import Data.Foldable ( Foldable (..) ) import Data.List ( unzip ) import qualified Data.Map.Strict as M import qualified Data.Set as S @@ -34,6 +35,7 @@ import Distribution.CabalSpecVersion ( cabalSpecToVersionDigits ) import qualified Distribution.Compat.NonEmptySet as NES import Distribution.Compiler ( CompilerFlavor (..), PerCompilerFlavor (..) ) +import Distribution.ModuleName ( ModuleName ) import Distribution.Package ( mkPackageName ) import Distribution.PackageDescription ( Benchmark (..), BuildInfo (..), BuildType (..) @@ -41,9 +43,9 @@ import Distribution.PackageDescription , Dependency (..), Executable (..), ForeignLib (..) , GenericPackageDescription (..), HookedBuildInfo , Library (..), PackageDescription (..), PackageFlag (..) - , SetupBuildInfo (..), TestSuite (..) - , allLibraries, buildType, depPkgName, depVerRange - , libraryNameString, maybeToLibraryName + , SetupBuildInfo (..), TestSuite (..), allLibraries + , buildType, depPkgName, depVerRange, libraryNameString + , maybeToLibraryName ) import Distribution.Pretty ( prettyShow ) import Distribution.Simple.PackageDescription ( readHookedBuildInfo ) @@ -57,13 +59,21 @@ import Distribution.Utils.Path ( getSymbolicPath ) import Distribution.Verbosity ( silent ) import Distribution.Version ( anyVersion, mkVersion, orLaterVersion ) +import GHC.Records ( getField ) import Path ( (), parent, parseAbsDir, parseRelDir, parseRelFile , stripProperPrefix ) import Path.Extra ( concatAndCollapseAbsDir, toFilePathNoTrailingSep ) +import Stack.Component + ( foldOnNameAndBuildInfo, isComponentBuildable + , stackBenchmarkFromCabal, stackExecutableFromCabal + , stackForeignLibraryFromCabal, stackLibraryFromCabal + , stackTestFromCabal, stackUnqualToQual + ) import Stack.Constants (relFileCabalMacrosH, relDirLogs) import Stack.Constants.Config ( distDirFromDir ) +import Stack.PackageFile ( getPackageFile, stackPackageFileFromCabal ) import Stack.Prelude hiding ( Display (..) ) import Stack.ComponentFile ( buildDir, componentAutogenDir, componentBuildDir @@ -71,33 +81,31 @@ import Stack.ComponentFile ) import Stack.Types.BuildConfig ( HasBuildConfig (..), getProjectWorkDir ) +import Stack.Types.CompCollection + ( CompCollection, foldAndMakeCollection + , getBuildableSetText + ) import Stack.Types.Compiler ( ActualCompiler (..) ) import Stack.Types.CompilerPaths ( cabalVersionL ) +import Stack.Types.Component ( HasBuildInfo ) +import qualified Stack.Types.Component as Component import Stack.Types.Config ( Config (..), HasConfig (..) ) +import Stack.Types.Dependency ( DepType (..), DepValue (..) ) import Stack.Types.EnvConfig ( HasEnvConfig ) import Stack.Types.GhcPkgId ( ghcPkgIdString ) import Stack.Types.NamedComponent ( NamedComponent (..), subLibComponents ) import Stack.Types.Package - ( BuildInfoOpts (..), ExeName (..) + ( BioInput (..), BuildInfoOpts (..), ExeName (..) , InstallMap, Installed (..), InstalledMap, Package (..) , PackageConfig (..), PackageException (..) - , dotCabalCFilePath, packageIdentifier, BioInput (..) + , dotCabalCFilePath, packageIdentifier ) +import Stack.Types.PackageFile + ( DotCabalPath, PackageComponentFile (..) ) import Stack.Types.Version ( VersionRange, intersectVersionRanges, withinRange ) import System.FilePath ( replaceExtension ) -import Stack.Types.Dependency ( DepValue (..), DepType (..) ) -import Stack.Types.PackageFile ( DotCabalPath, PackageComponentFile (PackageComponentFile) ) -import Stack.PackageFile ( getPackageFile, stackPackageFileFromCabal ) - -import Stack.Types.CompCollection ( foldAndMakeCollection, CompCollection, getBuildableSetText ) -import Stack.Component -import qualified Stack.Types.Component as Component -import GHC.Records (getField) -import Stack.Types.Component ( HasBuildInfo ) -import Data.Foldable ( Foldable(foldr') ) -import Distribution.ModuleName (ModuleName) -- | Read @.buildinfo@ ancillary files produced by some Setup.hs hooks. -- The file includes Cabal file syntax to be merged into the package description @@ -122,30 +130,38 @@ packageFromPackageDescription :: -> [PackageFlag] -> PackageDescriptionPair -> Package -packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkgNoMod pkg) = - Package - { packageName = name - , packageVersion = pkgVersion pkgId - , packageLicense = licenseRaw pkg - , packageDeps = deps - , packageGhcOptions = packageConfigGhcOptions packageConfig - , packageCabalConfigOpts = packageConfigCabalConfigOpts packageConfig - , packageFlags = packageConfigFlags packageConfig - , packageDefaultFlags = M.fromList - [(flagName flag, flagDefault flag) | flag <- pkgFlags] - , packageLibrary = stackLibraryFromCabal <$> library pkg - , packageSubLibraries = foldAndMakeCollection stackLibraryFromCabal $ subLibraries pkg - , packageForeignLibraries = foldAndMakeCollection stackForeignLibraryFromCabal $ foreignLibs pkg - , packageTestSuites = foldAndMakeCollection stackTestFromCabal $ testSuites pkgNoMod - , packageBenchmarkSuites = foldAndMakeCollection stackBenchmarkFromCabal $ benchmarks pkgNoMod - , packageExecutables = foldAndMakeCollection stackExecutableFromCabal $ executables pkg - , packageAllDeps = M.keysSet deps - , packageSubLibDeps = subLibDeps - , packageBuildType = buildType pkg - , packageSetupDeps = msetupDeps - , packageCabalSpec = specVersion pkg - , packageFile = stackPackageFileFromCabal pkg - } +packageFromPackageDescription + packageConfig + pkgFlags + (PackageDescriptionPair pkgNoMod pkg) + = Package + { packageName = name + , packageVersion = pkgVersion pkgId + , packageLicense = licenseRaw pkg + , packageDeps = deps + , packageGhcOptions = packageConfigGhcOptions packageConfig + , packageCabalConfigOpts = packageConfigCabalConfigOpts packageConfig + , packageFlags = packageConfigFlags packageConfig + , packageDefaultFlags = M.fromList + [(flagName flag, flagDefault flag) | flag <- pkgFlags] + , packageLibrary = stackLibraryFromCabal <$> library pkg + , packageSubLibraries = + foldAndMakeCollection stackLibraryFromCabal $ subLibraries pkg + , packageForeignLibraries = + foldAndMakeCollection stackForeignLibraryFromCabal $ foreignLibs pkg + , packageTestSuites = + foldAndMakeCollection stackTestFromCabal $ testSuites pkgNoMod + , packageBenchmarkSuites = + foldAndMakeCollection stackBenchmarkFromCabal $ benchmarks pkgNoMod + , packageExecutables = + foldAndMakeCollection stackExecutableFromCabal $ executables pkg + , packageAllDeps = M.keysSet deps + , packageSubLibDeps = subLibDeps + , packageBuildType = buildType pkg + , packageSetupDeps = msetupDeps + , packageCabalSpec = specVersion pkg + , packageFile = stackPackageFileFromCabal pkg + } where extraLibNames = S.union subLibNames foreignLibNames @@ -206,12 +222,18 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg toInternalPackageMungedName :: Package -> Text -> Text toInternalPackageMungedName pkg - = T.pack . prettyShow . MungedPackageName (packageName pkg) - . maybeToLibraryName . Just . Cabal.mkUnqualComponentName . T.unpack - --- | This is an action used to collect info needed for "stack ghci". --- This info isn't usually needed, so computation of it is deferred. -getPackageOpts :: (MonadUnliftIO m, MonadThrow m, HasEnvConfig env, MonadReader env m) + = T.pack + . prettyShow + . MungedPackageName (packageName pkg) + . maybeToLibraryName + . Just + . Cabal.mkUnqualComponentName + . T.unpack + +-- | This is an action used to collect info needed for "stack ghci". This info +-- isn't usually needed, so computation of it is deferred. +getPackageOpts :: + (HasEnvConfig env, MonadReader env m, MonadThrow m, MonadUnliftIO m ) => Package -> InstallMap -> InstalledMap @@ -220,24 +242,37 @@ getPackageOpts :: (MonadUnliftIO m, MonadThrow m, HasEnvConfig env, MonadReader -> Path Abs File -> m ( Map NamedComponent (Map ModuleName (Path Abs File)) , Map NamedComponent [DotCabalPath] - , Map NamedComponent BuildInfoOpts) -getPackageOpts stackPackage installMap installedMap omitPkgs addPkgs cabalfp = do - PackageComponentFile !componentsModules componentFiles _ _ <- getPackageFile stackPackage cabalfp - let subLibs = - S.toList $ subLibComponents $ M.keysSet componentsModules - excludedSubLibs <- mapM (parsePackageNameThrowing . T.unpack) subLibs - mungedSubLibs <- mapM - (parsePackageNameThrowing . T.unpack . toInternalPackageMungedName stackPackage) - subLibs - componentsOpts <- generatePkgDescOpts - installMap - installedMap - (excludedSubLibs ++ omitPkgs) - (mungedSubLibs ++ addPkgs) - cabalfp - stackPackage - componentFiles - pure (componentsModules, componentFiles, componentsOpts) + , Map NamedComponent BuildInfoOpts + ) +getPackageOpts + stackPackage + installMap + installedMap + omitPkgs + addPkgs + cabalfp + = do + PackageComponentFile !componentsModules componentFiles _ _ <- + getPackageFile stackPackage cabalfp + let subLibs = + S.toList $ subLibComponents $ M.keysSet componentsModules + excludedSubLibs <- mapM (parsePackageNameThrowing . T.unpack) subLibs + mungedSubLibs <- mapM + ( parsePackageNameThrowing + . T.unpack + . toInternalPackageMungedName stackPackage + ) + subLibs + componentsOpts <- generatePkgDescOpts + installMap + installedMap + (excludedSubLibs ++ omitPkgs) + (mungedSubLibs ++ addPkgs) + cabalfp + stackPackage + componentFiles + pure (componentsModules, componentFiles, componentsOpts) + -- | Generate GHC options for the package's components, and a list of options -- which apply generally to the package, not one specific component. generatePkgDescOpts :: @@ -257,25 +292,27 @@ generatePkgDescOpts installMap installedMap omitPkgs addPkgs cabalfp pkg compone cabalVer <- view cabalVersionL distDir <- distDirFromDir cabalDir let generate namedComponent binfo = generateBuildInfoOpts BioInput - { biInstallMap = installMap - , biInstalledMap = installedMap - , biCabalDir = cabalDir - , biDistDir = distDir - , biOmitPackages = omitPkgs - , biAddPackages = addPkgs - , biBuildInfo = binfo - , biDotCabalPaths = - fromMaybe [] (M.lookup namedComponent componentPaths) - , biConfigLibDirs = configExtraLibDirs config - , biConfigIncludeDirs = configExtraIncludeDirs config - , biComponentName = namedComponent - , biCabalVersion = cabalVer - } + { biInstallMap = installMap + , biInstalledMap = installedMap + , biCabalDir = cabalDir + , biDistDir = distDir + , biOmitPackages = omitPkgs + , biAddPackages = addPkgs + , biBuildInfo = binfo + , biDotCabalPaths = + fromMaybe [] (M.lookup namedComponent componentPaths) + , biConfigLibDirs = configExtraLibDirs config + , biConfigIncludeDirs = configExtraIncludeDirs config + , biComponentName = namedComponent + , biCabalVersion = cabalVer + } let insertInMap name compVal = M.insert name (generate name compVal) - let translatedInsertInMap constructor name = insertInMap (stackUnqualToQual constructor name) - let makeBuildInfoOpts selector constructor = foldOnNameAndBuildInfo (selector pkg) (translatedInsertInMap constructor) - let aggregateAllBuildInfoOpts = - makeBuildInfoOpts packageLibrary (const CLib) + let translatedInsertInMap constructor name = + insertInMap (stackUnqualToQual constructor name) + let makeBuildInfoOpts selector constructor = + foldOnNameAndBuildInfo (selector pkg) (translatedInsertInMap constructor) + let aggregateAllBuildInfoOpts = + makeBuildInfoOpts packageLibrary (const CLib) . makeBuildInfoOpts packageSubLibraries CSubLib . makeBuildInfoOpts packageExecutables CExe . makeBuildInfoOpts packageBenchmarkSuites CBench @@ -325,7 +362,8 @@ generateBuildInfoOpts BioInput {..} = biAddPackages ++ [ name | Dependency name _ _ <- Component.targetBuildDepends biBuildInfo - -- TODO: cabal 3 introduced multiple public libraries in a single dependency + -- TODO: Cabal 3.0 introduced multiple public libraries in a single + -- dependency , name `notElem` biOmitPackages ] PerCompilerFlavor ghcOpts _ = Component.options biBuildInfo @@ -339,13 +377,16 @@ generateBuildInfoOpts BioInput {..} = , [ biCabalDir | null (Component.hsSourceDirs biBuildInfo) ] - , mapMaybe (toIncludeDir . getSymbolicPath) (Component.hsSourceDirs biBuildInfo) + , mapMaybe + (toIncludeDir . getSymbolicPath) + (Component.hsSourceDirs biBuildInfo) , [ componentAutogen ] , maybeToList (packageAutogenDir biCabalVersion biDistDir) , [ componentOutputDir biComponentName biDistDir ] ]) ++ [ "-stubdir=" ++ toFilePathNoTrailingSep (buildDir biDistDir) ] - componentAutogen = componentAutogenDir biCabalVersion biComponentName biDistDir + componentAutogen = + componentAutogenDir biCabalVersion biComponentName biDistDir toIncludeDir "." = Just biCabalDir toIncludeDir relDir = concatAndCollapseAbsDir biCabalDir relDir includeOpts = @@ -751,47 +792,43 @@ applyForceCustomBuild cabalVersion package packageBuildType package == Simple && not (cabalVersion `withinRange` cabalVersionRange) --- | Check if the main library is buildable. --- --- Replace legacy logic with cabal shaped types. --- Previous logic beeing @Package@ field named packageLibraries, equal to either NoLibrary or v foreignLibNames. --- True here means HasLibraries _ in previous usage. --- +-- | Check if the package has a main library that is buildable. hasMainBuildableLibrary :: Package -> Bool -hasMainBuildableLibrary package = maybe False isComponentBuildable $ packageLibrary package +hasMainBuildableLibrary package = + maybe False isComponentBuildable $ packageLibrary package -- | Check if the main library has any exposed modules. --- --- Replace legacy packageHasExposedModule. This should become irrelevant at some point --- since there's nothing inherently wrong or different with packages exposing only modules in --- internal libraries (for instance). --- +-- +-- This should become irrelevant at some point since there's nothing inherently +-- wrong or different with packages exposing only modules in internal libraries +-- (for instance). mainLibraryHasExposedModules :: Package -> Bool -mainLibraryHasExposedModules package = maybe False (not . null . Component.exposedModules) $ packageLibrary package +mainLibraryHasExposedModules package = + maybe False (not . null . Component.exposedModules) $ packageLibrary package --- | Aggregate all unknown tools from all exe. --- Replaces packageUnknownTools field from Package datatype. --- Mostly meant for build tools specified in the legacy manner (build-tools:) that failed --- the hard-coded lookup. --- See sbiUnknownTools for more info. +-- | Aggregate all unknown tools from all components. Mostly meant for +-- build tools specified in the legacy manner (build-tools:) that failed the +-- hard-coded lookup. See 'Stack.Types.Component.sbiUnknownTools' for more +-- information. packageUnknownTools :: Package -> Set Text packageUnknownTools pkg = lib (bench <> tests <> flib <> sublib <> exe) - where - lib setT = case packageLibrary pkg of - Just libV -> addUnknownTools libV setT - Nothing -> setT - bench = gatherUnknownTools $ packageBenchmarkSuites pkg - tests = gatherUnknownTools $ packageTestSuites pkg - flib = gatherUnknownTools $ packageForeignLibraries pkg - sublib = gatherUnknownTools $ packageSubLibraries pkg - exe = gatherUnknownTools $ packageExecutables pkg - addUnknownTools :: HasBuildInfo x => x -> Set Text -> Set Text - addUnknownTools = (<>) . Component.sbiUnknownTools . getField @"buildInfo" - gatherUnknownTools :: HasBuildInfo x => CompCollection x -> Set Text - gatherUnknownTools = foldr' addUnknownTools mempty + where + lib setT = case packageLibrary pkg of + Just libV -> addUnknownTools libV setT + Nothing -> setT + bench = gatherUnknownTools $ packageBenchmarkSuites pkg + tests = gatherUnknownTools $ packageTestSuites pkg + flib = gatherUnknownTools $ packageForeignLibraries pkg + sublib = gatherUnknownTools $ packageSubLibraries pkg + exe = gatherUnknownTools $ packageExecutables pkg + addUnknownTools :: HasBuildInfo x => x -> Set Text -> Set Text + addUnknownTools = (<>) . Component.sbiUnknownTools . getField @"buildInfo" + gatherUnknownTools :: HasBuildInfo x => CompCollection x -> Set Text + gatherUnknownTools = foldr' addUnknownTools mempty packageSubLibrariesNameSet :: Package -> Set Text packageSubLibrariesNameSet pkg = getBuildableSetText (packageSubLibraries pkg) + packageExes :: Package -> Set Text packageExes pkg = getBuildableSetText (packageExecutables pkg) diff --git a/src/Stack/Types/CompCollection.hs b/src/Stack/Types/CompCollection.hs index 18e7aa565c..6fdad8cbae 100644 --- a/src/Stack/Types/CompCollection.hs +++ b/src/Stack/Types/CompCollection.hs @@ -1,14 +1,17 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE FlexibleContexts #-} --- | A package has collections of "Stack.Types.Component". --- In Cabal, the components are grouped as a list in a @PackageDescription@, this is stack's counterpart --- (See for instance [the foreign libraries field in cabal](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-PackageDescription.html#t:GenericPackageDescription)). --- Cabal removes all the unbuildable components very early (at the price of slightly worse error messages) and it historically used a list for components. --- For , as well as set listed for backward compatbility at least, hence this structure. +-- | A package has collections of the types exported by "Stack.Types.Component". +-- In Cabal, the components are grouped as a list in a @PackageDescription@; +-- this is Stack's counterpart. See for instance the +-- [foreign libraries field](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-PackageDescription.html#t:GenericPackageDescription) +-- in Cabal. Cabal removes all the unbuildable components very early (at the +-- cost of slightly worse error messages) and it historically used a list for +-- components. For , as well as set listed for backward compatbility at least, +-- hence this structure. module Stack.Types.CompCollection ( CompCollection , getBuildableSet @@ -20,54 +23,62 @@ module Stack.Types.CompCollection , collectionLookup , collectionKeyValueList , collectionMember - ) -where -import Stack.Prelude -import Stack.Types.Component (HasName, HasBuildInfo, StackBuildInfo(..), unqualCompToText, StackUnqualCompName(StackUnqualCompName)) + ) where + import qualified Data.HashMap.Strict as HM import qualified Data.Set as Set -import qualified Data.Foldable - --- | This is a collection discriminating buildable components and non buildable ones. -data CompCollection component - = CompCollection { - buildableOnes :: {-# UNPACK #-} !(InnerCollection component), - unbuildableOnes :: Set StackUnqualCompName - -- ^ Note that the field is lazy beacause it should only serve when users explicitely require - -- unbuildable components to be built (and this field ensure intelligible error messages). - } deriving (Show) +import Data.Foldable ( Foldable (..) ) +import Stack.Prelude +import Stack.Types.Component + ( HasBuildInfo, HasName, StackBuildInfo (..) + , StackUnqualCompName (..), unqualCompToText + ) + +-- | This is a collection discriminating buildable components and non-buildable +-- ones. +data CompCollection component = CompCollection + { buildableOnes :: {-# UNPACK #-} !(InnerCollection component) + , unbuildableOnes :: Set StackUnqualCompName + -- ^ Note that the field is lazy beacause it should only serve when users + -- explicitely require unbuildable components to be built (and this field + -- ensure intelligible error messages). + } + deriving (Show) + instance Semigroup (CompCollection component) where - a <> b = CompCollection { - buildableOnes = buildableOnes a <> buildableOnes b, - unbuildableOnes = unbuildableOnes a <> unbuildableOnes b + a <> b = CompCollection + { buildableOnes = buildableOnes a <> buildableOnes b + , unbuildableOnes = unbuildableOnes a <> unbuildableOnes b } + instance Monoid (CompCollection component) where - mempty = CompCollection { - buildableOnes = mempty, - unbuildableOnes = mempty + mempty = CompCollection + { buildableOnes = mempty + , unbuildableOnes = mempty } --- | This is a naive collection which trades memory consumption --- for velocity, the name set is strictly redundant but it takes O(n) --- to compute it from the map's keys, hence the redundancy. --- The assumption is 'asNameSet' is always equal to @keySet . asNameMap@, --- but faster because cached. But this assumption is not checked anywhere, it's simply --- built into the 'addComponent' function, which should always be used rather than record's fields --- for inserting new elements. -data InnerCollection component - = InnerCollection { - asNameMap :: !(HashMap StackUnqualCompName component), - asNameSet :: !(Set StackUnqualCompName) - } deriving (Show) +-- | This is a naive collection which trades memory consumption for speed, the +-- name set is strictly redundant but it takes O(n) to compute it from the map's +-- keys, hence the redundancy. The assumption is 'asNameSet' is always equal to +-- @keySet . asNameMap@, but faster because cached. But this assumption is not +-- checked anywhere, it's simply built into the 'addComponent' function, which +-- should always be used rather than record's fields for inserting new elements. +data InnerCollection component = InnerCollection + { asNameMap :: !(HashMap StackUnqualCompName component) + , asNameSet :: !(Set StackUnqualCompName) + } + deriving (Show) + instance Semigroup (InnerCollection component) where - a <> b = InnerCollection { - asNameMap = asNameMap a <> asNameMap b, - asNameSet = asNameSet a <> asNameSet b + a <> b = InnerCollection + { asNameMap = asNameMap a <> asNameMap b + , asNameSet = asNameSet a <> asNameSet b } + instance Monoid (InnerCollection component) where - mempty = InnerCollection { - asNameMap = mempty, - asNameSet = mempty + mempty = InnerCollection + { asNameMap = mempty + , asNameSet = mempty } instance Foldable CompCollection where @@ -75,8 +86,7 @@ instance Foldable CompCollection where foldr' fn c collection = HM.foldr' fn c (asNameMap $ buildableOnes collection) null = HM.null . asNameMap . buildableOnes - --- | +-- | -- -- >>> :set -XOverloadedStrings -- >>> import Stack.Types.Component (StackUnqualCompName(StackUnqualCompName)) @@ -84,23 +94,38 @@ instance Foldable CompCollection where -- >>> let ok = TestComp (StackUnqualCompName "some-comp-name") -- >>> addComponent ok mempty -- InnerCollection {asNameMap = fromList [(StackUnqualCompName "some-comp-name",TestComp {name = StackUnqualCompName "some-comp-name"})], asNameSet = fromList [StackUnqualCompName "some-comp-name"]} -addComponent :: HasName component => component -> InnerCollection component -> InnerCollection component -addComponent componentV collection = let nameV = componentV.name in collection { - asNameMap=HM.insert nameV componentV (asNameMap collection), - asNameSet=Set.insert nameV (asNameSet collection) - } +addComponent :: + HasName component + => component + -> InnerCollection component + -> InnerCollection component +addComponent componentV collection = + let nameV = componentV.name + in collection + { asNameMap=HM.insert nameV componentV (asNameMap collection) + , asNameSet=Set.insert nameV (asNameSet collection) + } -- | Iterates on a collection of @compA@ and map each element to @compB@ while -- building the corresponding @CompCollection@ out of it. --- -foldAndMakeCollection :: (HasBuildInfo compB, HasName compB, Foldable sourceCollection) => (compA -> compB) -> sourceCollection compA -> CompCollection compB +foldAndMakeCollection :: + (HasBuildInfo compB, HasName compB, Foldable sourceCollection) + => (compA -> compB) + -> sourceCollection compA + -> CompCollection compB foldAndMakeCollection mapFn = foldl' compIterator mempty - where - compIterator existingCollection component = compCreator existingCollection (mapFn component) - compCreator existingCollection component - | component.buildInfo.sbiBuildable = existingCollection{buildableOnes = addComponent component (buildableOnes existingCollection)} - | otherwise = existingCollection{unbuildableOnes = Set.insert component.name (unbuildableOnes existingCollection)} - + where + compIterator existingCollection component = + compCreator existingCollection (mapFn component) + compCreator existingCollection component + | component.buildInfo.sbiBuildable = existingCollection + { buildableOnes = + addComponent component (buildableOnes existingCollection) + } + | otherwise = existingCollection + { unbuildableOnes = + Set.insert component.name (unbuildableOnes existingCollection) + } -- | Get the name set of buildable components from this collection. getBuildableSet :: CompCollection component -> Set StackUnqualCompName @@ -108,17 +133,27 @@ getBuildableSet = asNameSet . buildableOnes getBuildableSetText :: CompCollection component -> Set Text getBuildableSetText = Set.mapMonotonic unqualCompToText . getBuildableSet + getBuildableListText :: CompCollection component -> [] Text getBuildableListText = getBuildableListAs unqualCompToText -getBuildableListAs :: (StackUnqualCompName -> something) -> CompCollection component -> [] something + +getBuildableListAs :: + (StackUnqualCompName -> something) + -> CompCollection component + -> [] something getBuildableListAs fn = Set.foldr' (\v l -> fn v:l) [] . getBuildableSet hasBuildableComponent :: CompCollection component -> Bool hasBuildableComponent = not . null . getBuildableSet collectionLookup :: Text -> CompCollection component -> Maybe component -collectionLookup needle haystack = HM.lookup (StackUnqualCompName needle) (asNameMap $ buildableOnes haystack) +collectionLookup needle haystack = + HM.lookup (StackUnqualCompName needle) (asNameMap $ buildableOnes haystack) + collectionKeyValueList :: CompCollection component -> [(Text, component)] -collectionKeyValueList haystack = (\(StackUnqualCompName k, !v) -> (k, v)) <$> HM.toList (asNameMap $ buildableOnes haystack) +collectionKeyValueList haystack = + (\(StackUnqualCompName k, !v) -> (k, v)) + <$> HM.toList (asNameMap $ buildableOnes haystack) + collectionMember :: Text -> CompCollection component -> Bool -collectionMember needle haystack = isJust $ collectionLookup needle haystack \ No newline at end of file +collectionMember needle haystack = isJust $ collectionLookup needle haystack diff --git a/src/Stack/Types/Component.hs b/src/Stack/Types/Component.hs index c1cfcb709a..dcb447ba7d 100644 --- a/src/Stack/Types/Component.hs +++ b/src/Stack/Types/Component.hs @@ -1,161 +1,169 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# HLINT ignore "Avoid restricted extensions" #-} +{-# LANGUAGE ScopedTypeVariables #-} --- | All component related types (library, internal library, foreign library, executable, tests, benchmarks) in stack. --- The chosen design replicates many of cabal existing things but in simplified --- and sometimes more typed versions. It's a work in progress to bring --- Stack to a more componentized design, and closer to cabal. +-- | All component-related types in Stack (library, internal library, foreign +-- library, executable, tests and benchmarks). The chosen design replicates many +-- of Cabal existing things but in simplified and sometimes more typed versions. +-- It's a work in progress to bring Stack to a more componentized design, and +-- closer to Cabal. module Stack.Types.Component - ( HasName, - HasBuildInfo, - StackBenchmark (..), - StackBuildInfo (..), - StackExecutable (..), - StackForeignLibrary (..), - StackLibrary (..), - StackTest (..), - StackUnqualCompName (..), - unqualCompToText, - ) -where + ( HasName + , HasBuildInfo + , StackBenchmark (..) + , StackBuildInfo (..) + , StackExecutable (..) + , StackForeignLibrary (..) + , StackLibrary (..) + , StackTest (..) + , StackUnqualCompName (..) + , unqualCompToText + ) where -import Distribution.ModuleName (ModuleName) -import Distribution.PackageDescription (BenchmarkInterface, TestSuiteInterface, Dependency) -import Distribution.Utils.Path (PackageDir, SourceDir, SymbolicPath) -import GHC.Records (HasField) -import Stack.Prelude -import Stack.Types.Dependency (DepValue) -import Distribution.Compiler (PerCompilerFlavor) -import Distribution.Simple (Language, Extension) +import Distribution.Compiler ( PerCompilerFlavor ) +import Distribution.ModuleName ( ModuleName ) +import Distribution.PackageDescription + ( BenchmarkInterface, Dependency, TestSuiteInterface ) +import Distribution.Simple ( Extension, Language ) +import Distribution.Utils.Path ( PackageDir, SourceDir, SymbolicPath ) +import GHC.Records ( HasField ) +import Stack.Prelude +import Stack.Types.Dependency ( DepValue ) type HasName component = HasField "name" component StackUnqualCompName type HasBuildInfo component = HasField "buildInfo" component StackBuildInfo --- | A main or sub library. We do not keep the [Cabal ADT name distinction](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-LibraryName.html#t:LibraryName) --- because in Cabal 3.0 it's [likely](https://github.com/haskell/cabal/issues/8567) that the main/sub distinction doesn't make sense anymore. --- Besides, the missing name from main libe can simply be encoded as an empty string for backward compatibility without loosing info. --- Through this simplification we get a clean name interface for all components (they all have a potentially mempty name of the same type). +-- | A main or sub library. We do not keep the +-- [Cabal ADT name distinction](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-LibraryName.html#t:LibraryName) +-- because in Cabal 3.0 it's +-- [likely](https://github.com/haskell/cabal/issues/8567) that the main/sub +-- distinction doesn't make sense anymore. Besides, the missing name from main +-- lib can simply be encoded as an empty string for backward compatibility +-- without loosing info. Through this simplification we get a clean name +-- interface for all components (they all have a potentially mempty name of the +-- same type). -- --- [Library](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Library.html) is the Cabal equivalent. +-- The Cabal equivalent is +-- [Library](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Library.html). data StackLibrary = StackLibrary - { name :: StackUnqualCompName, - buildInfo :: !StackBuildInfo, - -- | This is only used for gathering the files related to this component. - exposedModules :: [ModuleName] + { name :: StackUnqualCompName + , buildInfo :: !StackBuildInfo + , exposedModules :: [ModuleName] + -- |^ This is only used for gathering the files related to this component. } deriving (Show, Typeable) -- Stack foreign libraries. -- --- [ForeignLib](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Foreign-Libraries.html) is the Cabal equivalent. --- +-- The Cabal equivalent is +-- [ForeignLib](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Foreign-Libraries.html). data StackForeignLibrary = StackForeignLibrary - { name :: StackUnqualCompName, - buildInfo :: !StackBuildInfo + { name :: StackUnqualCompName + , buildInfo :: !StackBuildInfo } deriving (Show, Typeable) -- Stack executable. -- --- [Executable](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Executable.html) is the Cabal equivalent. --- +-- The Cabal equivalent is +-- [Executable](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Executable.html). data StackExecutable = StackExecutable - { name :: StackUnqualCompName, - buildInfo :: !StackBuildInfo, - modulePath :: FilePath + { name :: StackUnqualCompName + , buildInfo :: !StackBuildInfo + , modulePath :: FilePath } deriving (Show, Typeable) -- Stack test. -- --- [TestSuite](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-TestSuite.html) is the Cabal equivalent. --- +-- The Cabal equivalent is +-- [TestSuite](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-TestSuite.html). data StackTest = StackTest - { name :: StackUnqualCompName, - buildInfo :: !StackBuildInfo, - interface :: !TestSuiteInterface + { name :: StackUnqualCompName + , buildInfo :: !StackBuildInfo + , interface :: !TestSuiteInterface } deriving (Show, Typeable) -- Stack benchmark. -- --- [Benchmark](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Benchmark.html) is the Cabal equivalent. --- +-- The Cabal equivalent is +-- [Benchmark](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-Benchmark.html). data StackBenchmark = StackBenchmark - { name :: StackUnqualCompName, - buildInfo :: StackBuildInfo, - -- | This is only used for gathering the files related to this component. - interface :: BenchmarkInterface + { name :: StackUnqualCompName + , buildInfo :: StackBuildInfo + , interface :: BenchmarkInterface + -- ^ This is only used for gathering the files related to this component. } deriving (Show, Typeable) -- | Name of an executable. newtype ExeName = ExeName Text - deriving (Show, Eq, Ord, Hashable, IsString, Generic, NFData, Data, Typeable) + deriving (Data, Eq, Hashable, IsString, Generic, NFData, Ord, Show, Typeable) --- | The name of an unqualified component (that is, it can be an executable, a library, anything). --- The Cabal equivalent is [UnqualComponentName](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-UnqualComponentName.html#t:UnqualComponentName). --- Ideally, we'd want to use the cabal type behing this newtype and not Text to avoid unnecessary work, but --- for now this is too much refactoring (also there is no Hashable instance for UnqualComponentName yet). +-- | The name of an unqualified component (that is, it can be an executable, a +-- library, anything). The Cabal equivalent is +-- [UnqualComponentName](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-UnqualComponentName.html#t:UnqualComponentName). +-- Ideally, we'd want to use the Cabal type behind this newtype and not Text to +-- avoid unnecessary work, but for now this is too much refactoring (also there +-- is no Hashable instance for UnqualComponentName yet). newtype StackUnqualCompName = StackUnqualCompName Text - deriving (Show, Eq, Ord, Hashable, IsString, Generic, NFData, Data, Typeable) + deriving (Data, Eq, Hashable, IsString, Generic, NFData, Ord, Show, Typeable) unqualCompToText :: StackUnqualCompName -> Text unqualCompToText (StackUnqualCompName v) = v --- | This is the Stack equivalent of Cabal's [BuildInfo](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-BuildInfo.html). --- We don't use the cabal version because Cabal provides a list of dependencies (and we need a Map), and we only need a tiny subset of all --- the Cabal provided info. --- It's also the decomposition of @Package@ based information in prior versions of stack, --- to enable component based builds and backpack. --- The file gathering related fields are lazy because not always needed. +-- | This is the Stack equivalent of Cabal's +-- [BuildInfo](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-BuildInfo.html). +-- We don't use the Cabal version because Cabal provides a list of dependencies +-- (and we need a Map), and we only need a tiny subset of all the Cabal-provided +-- info. It's also the decomposition of @Package@ based information in prior +-- versions of Stack, to enable component based builds and backpack. The file +-- gathering related fields are lazy because not always needed. data StackBuildInfo = StackBuildInfo - { -- | From BuildInfo in cabal - sbiBuildable :: !Bool, - -- | From targetBuildDepends in BuildInfo in cabal, and known - -- legacy specified build tools (buildTool). - sbiDependency :: !(Map PackageName DepValue), - -- | From buildTool in Cabal, we only keep the legacy - -- build tool depends that we know (from a hardcoded list). - -- We only use the deduplication aspect of the Set here, as this - -- field is only used for error reporting in the end. - -- This is kept lazy because it's an error reporting field only. - sbiUnknownTools :: Set Text, - -- | Only used in file gathering. See usage in "Stack.ComponentFile" module. - sbiOtherModules :: [ModuleName], - -- | Only used in file gathering. See usage in "Stack.ComponentFile" module. - jsSources :: [FilePath], - -- | Only used in file & opts gathering. See usage in "Stack.ComponentFile" module for fle gathering. - hsSourceDirs :: [SymbolicPath PackageDir SourceDir], - -- | Only used in file gathering. See usage in "Stack.ComponentFile" module. - cSources :: [FilePath], - -- | Only used in opts gathering. See usage in "Stack.Package" module. - cppOptions :: [String], - -- | Only used in opts gathering. - targetBuildDepends :: [Dependency], - -- | Only used in opts gathering. - options :: PerCompilerFlavor [String], - -- | Only used in opts gathering. - allLanguages :: [Language], - -- | Only used in opts gathering. - usedExtensions :: [Extension], - -- | Only used in opts gathering. - includeDirs :: [FilePath], - -- | Only used in opts gathering. - extraLibs :: [String], - -- | Only used in opts gathering. - extraLibDirs :: [String], - -- | Only used in opts gathering. - frameworks :: [String] + { sbiBuildable :: !Bool + -- ^ From BuildInfo in Cabal. + , sbiDependency :: !(Map PackageName DepValue) + -- ^ From targetBuildDepends in BuildInfo in Cabal, and known legacy + -- specified build tools (buildTool). + , sbiUnknownTools :: Set Text + -- ^ From buildTool in Cabal, we only keep the legacy build tool depends + -- that we know (from a hardcoded list). We only use the deduplication + -- aspect of the Set here, as this field is only used for error reporting in + -- the end. This is kept lazy because it's an error reporting field only. + , sbiOtherModules :: [ModuleName] + -- ^ Only used in file gathering. See usage in "Stack.ComponentFile" module. + , jsSources :: [FilePath] + -- ^ Only used in file gathering. See usage in "Stack.ComponentFile" module. + , hsSourceDirs :: [SymbolicPath PackageDir SourceDir] + -- ^ Only used in file & opts gathering. See usage in "Stack.ComponentFile" + -- module for fle gathering. + , cSources :: [FilePath] + -- ^ Only used in file gathering. See usage in "Stack.ComponentFile" module. + , cppOptions :: [String] + -- ^ Only used in opts gathering. See usage in "Stack.Package" module. + , targetBuildDepends :: [Dependency] + -- ^ Only used in opts gathering. + , options :: PerCompilerFlavor [String] + -- ^ Only used in opts gathering. + , allLanguages :: [Language] + -- ^ Only used in opts gathering. + , usedExtensions :: [Extension] + -- ^ Only used in opts gathering. + , includeDirs :: [FilePath] + -- ^ Only used in opts gathering. + , extraLibs :: [String] + -- ^ Only used in opts gathering. + , extraLibDirs :: [String] + -- ^ Only used in opts gathering. + , frameworks :: [String] + -- ^ Only used in opts gathering. } deriving (Show) diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 195737fe30..d9f5917cfa 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} module Stack.Types.Package - ( BuildInfoOpts (..) - , BioInput (..) + ( BioInput (..) + , BuildInfoOpts (..) , ExeName (..) , FileCacheInfo (..) , InstallLocation (..) @@ -48,24 +48,26 @@ import Distribution.Parsec ( PError (..), PWarning (..), showPos ) import qualified Distribution.SPDX.License as SPDX import Distribution.License ( License ) import Distribution.ModuleName ( ModuleName ) -import Distribution.PackageDescription - ( BuildType ) +import Distribution.PackageDescription ( BuildType ) import Distribution.System ( Platform (..) ) import qualified RIO.Text as T import Stack.Prelude +import Stack.Types.CompCollection ( CompCollection ) import Stack.Types.Compiler ( ActualCompiler ) +import Stack.Types.Component + ( StackBenchmark, StackBuildInfo, StackExecutable + , StackForeignLibrary, StackLibrary, StackTest + ) import Stack.Types.Dependency ( DepValue ) import Stack.Types.EnvConfig ( EnvConfig, HasEnvConfig (..) ) import Stack.Types.GhcPkgId ( GhcPkgId ) import Stack.Types.NamedComponent ( NamedComponent ) import Stack.Types.PackageFile - ( DotCabalDescriptor (..) - , DotCabalPath (..), StackPackageFile + ( DotCabalDescriptor (..), DotCabalPath (..) + , StackPackageFile ) import Stack.Types.SourceMap ( CommonPackage, FromSnapshot ) import Stack.Types.Version ( VersionRange ) -import Stack.Types.CompCollection ( CompCollection ) -import Stack.Types.Component ( StackLibrary, StackForeignLibrary, StackTest, StackBenchmark, StackExecutable, StackBuildInfo ) -- | Type representing exceptions thrown by functions exported by the -- "Stack.Package" module. @@ -133,9 +135,12 @@ instance Exception PackageException where \extension, the following is invalid: " , fp ] - displayException (ComponentNotParsedBug name)= bugReport "[S-4623]" - ("Component names should always parse as directory names." - <> " The component name without a directory is '" <> name <> "'") + displayException (ComponentNotParsedBug name) = bugReport "[S-4623]" + ( "Component names should always parse as directory names. The component \ + \name without a directory is '" + <> name + <> "'." + ) -- | Name of an executable. newtype ExeName @@ -150,10 +155,9 @@ data Package = Package -- ^ Version of the package , packageLicense :: !(Either SPDX.License License) -- ^ The license the package was released under. - -- , packageFiles :: !GetPackageFiles - -- ^ Get all files of the package. , packageDeps :: !(Map PackageName DepValue) - -- ^ Packages that the package depends on, both as libraries and build tools. + -- ^ Packages that the package depends on, both as libraries and build + -- tools. , packageAllDeps :: !(Set PackageName) -- ^ Original dependencies (not sieved). , packageSubLibDeps :: !(Map MungedPackageName DepValue) @@ -196,7 +200,6 @@ packageDefinedFlags = M.keysSet . packageDefaultFlags -- or mutable) and package versions. type InstallMap = Map PackageName (InstallLocation, Version) - -- | GHC options based on cabal information and ghc-options. data BuildInfoOpts = BuildInfoOpts { bioOpts :: [String] @@ -468,8 +471,7 @@ installedVersion i = let PackageIdentifier _ version = installedPackageIdentifier i in version - --- | Input to 'generateBuildInfoOpts' +-- | Type representing inputs to 'Stack.Package.generateBuildInfoOpts'. data BioInput = BioInput { biInstallMap :: !InstallMap , biInstalledMap :: !InstalledMap From 75600349ebbfa19c809e5daff29343e622e5490f Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sun, 12 Nov 2023 19:56:51 +0000 Subject: [PATCH 21/42] Add extensions used to .hlint.yaml --- .hlint.yaml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.hlint.yaml b/.hlint.yaml index 3a769df0a5..2a571b0be4 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -60,10 +60,14 @@ - ConstraintKinds - DataKinds - DefaultSignatures + - DeriveDataTypeable + - DeriveGeneric - DerivingStrategies - DisambiguateRecordFields + - DuplicateRecordFields - FlexibleContexts - GADTs + - GeneralizedNewtypeDeriving - LambdaCase - MultiWayIf - OverloadedLists From 852a8be3a6d75fef06e32f5c992754a021333ff4 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sun, 12 Nov 2023 20:04:25 +0000 Subject: [PATCH 22/42] Swap order of packageHasLibrary test, and consistent formatting --- src/Stack/Build/ConstructPlan.hs | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index c450a514c5..1bba8e8548 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -29,10 +29,8 @@ import Stack.Build.Haddock ( shouldHaddockDeps ) import Stack.Build.Source ( loadLocalPackage ) import Stack.Constants ( compilerOptionsCabalFlag ) import Stack.Package - ( applyForceCustomBuild - , hasMainBuildableLibrary - , packageUnknownTools - , packageExes + ( applyForceCustomBuild, hasMainBuildableLibrary + , packageExes, packageUnknownTools ) import Stack.Prelude hiding ( loadPackage ) import Stack.SourceMap ( getPLIVersion, mkProjectPackage ) @@ -50,6 +48,7 @@ import Stack.Types.BuildConfig ( BuildConfig (..), HasBuildConfig (..), stackYamlL ) import Stack.Types.BuildOpts ( BuildOpts (..), BuildOptsCLI (..), BuildSubset (..) ) +import Stack.Types.CompCollection ( collectionMember ) import Stack.Types.Compiler ( WhichCompiler (..) ) import Stack.Types.CompilerPaths ( CompilerPaths (..), HasCompiler (..) ) @@ -72,8 +71,8 @@ import Stack.Types.NamedComponent ( exeComponents, renderComponent ) import Stack.Types.Package ( ExeName (..), InstallLocation (..), Installed (..) , InstalledMap, LocalPackage (..), Package (..) - , PackageSource (..), installedVersion - , packageIdentifier, psVersion, runMemoizedWith + , PackageSource (..), installedVersion, packageIdentifier + , psVersion, runMemoizedWith ) import Stack.Types.ParentMap ( ParentMap ) import Stack.Types.Platform ( HasPlatform (..) ) @@ -86,7 +85,6 @@ import Stack.Types.SourceMap import Stack.Types.Version ( latestApplicableVersion, versionRangeText, withinRange ) import System.Environment ( lookupEnv ) -import Stack.Types.CompCollection ( collectionMember ) -- | Type representing information about packages, namely information about -- whether or not a package is already installed and, unless the package is not @@ -1168,8 +1166,7 @@ addPackageDeps package = do -- make sure we consider sub-libraries as libraries too packageHasLibrary :: Package -> Bool packageHasLibrary p = - not (null (packageSubLibraries p)) || - hasMainBuildableLibrary p + hasMainBuildableLibrary p || not (null (packageSubLibraries p)) checkDirtiness :: PackageSource @@ -1338,8 +1335,8 @@ checkAndWarnForUnknownTools p = do -- Check whether the tool is on the PATH or a package executable before -- warning about it. warnings <- - fmap catMaybes $ forM unknownTools $ \name@toolName -> - runMaybeT $ notOnPath toolName *> notPackageExe toolName *> warn name + fmap catMaybes $ forM unknownTools $ \toolName -> + runMaybeT $ notOnPath toolName *> notPackageExe toolName *> warn toolName tell mempty { wWarnings = (map toolWarningText warnings ++) } pure () where @@ -1353,7 +1350,8 @@ checkAndWarnForUnknownTools p = do skipIf $ isRight eFound -- From Cabal 1.12, build-tools can specify another executable in the same -- package. - notPackageExe toolName = MaybeT $ skipIf $ collectionMember toolName (packageExecutables p) + notPackageExe toolName = + MaybeT $ skipIf $ collectionMember toolName (packageExecutables p) warn name = MaybeT . pure . Just $ ToolWarning (ExeName name) (packageName p) skipIf p' = pure $ if p' then Nothing else Just () From 2a0b2d48e1c5234721552665b95f8784be4295cc Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sun, 12 Nov 2023 21:06:51 +0000 Subject: [PATCH 23/42] Reformat, for consistency --- src/Stack/Build/Execute.hs | 67 +++++++++++++++++++++----------------- 1 file changed, 38 insertions(+), 29 deletions(-) diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index b7102b28c6..e7e603ff1a 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -64,6 +64,7 @@ import Distribution.Types.UnqualComponentName ( mkUnqualComponentName ) import Distribution.Verbosity ( showForCabal ) import Distribution.Version ( mkVersion ) +import GHC.Records ( getField ) import Path ( PathException, (), addExtension, filename , isProperPrefixOf, parent, parseRelDir, parseRelFile @@ -124,7 +125,11 @@ import Stack.Coverage , generateHpcUnifiedReport, updateTixFile ) import Stack.GhcPkg ( ghcPkg, unregisterGhcPkgIds ) -import Stack.Package ( buildLogPath, hasMainBuildableLibrary, mainLibraryHasExposedModules, packageSubLibrariesNameSet, packageExes ) +import Stack.Package + ( buildLogPath, hasMainBuildableLibrary + , mainLibraryHasExposedModules, packageExes + , packageSubLibrariesNameSet + ) import Stack.PackageDump ( conduitDumpPackage, ghcPkgDescribe ) import Stack.Prelude import Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) ) @@ -144,6 +149,10 @@ import Stack.Types.BuildOpts , CabalVerbosity (..), HaddockOpts (..) , ProgressBarFormat (..), TestOpts (..) ) +import Stack.Types.CompCollection + ( collectionKeyValueList, collectionLookup + , getBuildableListText + ) import Stack.Types.Compiler ( ActualCompiler (..), WhichCompiler (..) , compilerVersionString, getGhcVersion, whichCompilerL @@ -152,6 +161,7 @@ import Stack.Types.CompilerPaths ( CompilerPaths (..), GhcPkgExe (..), HasCompiler (..) , cabalVersionL, cpWhich, getCompilerPath, getGhcPkgExe ) +import qualified Stack.Types.Component as Component import Stack.Types.Config ( Config (..), HasConfig (..), buildOptsL, stackRootL ) import Stack.Types.ConfigureOpts @@ -175,9 +185,8 @@ import Stack.Types.NamedComponent ) import Stack.Types.Package ( InstallLocation (..), Installed (..), InstalledMap - , LocalPackage (..), Package (..) - , installedPackageIdentifier, packageIdentifier - , runMemoizedWith + , LocalPackage (..), Package (..), installedPackageIdentifier + , packageIdentifier, runMemoizedWith ) import Stack.Types.PackageFile ( PackageWarning (..) ) import Stack.Types.Platform ( HasPlatform (..) ) @@ -195,13 +204,6 @@ import System.IO.Error ( isDoesNotExistError ) import System.PosixCompat.Files ( createLink, getFileStatus, modificationTime ) import System.Random ( randomIO ) -import Stack.Types.CompCollection - ( getBuildableListText - , collectionKeyValueList - , collectionLookup - ) -import qualified Stack.Types.Component as Component -import GHC.Records ( getField ) -- | Has an executable been built or not? data ExecutableBuildStatus @@ -2093,8 +2095,8 @@ singleBuild let ident = PackageIdentifier (packageName package) (packageVersion package) -- only pure the sub-libraries to cache them if we also cache the main -- library (that is, if it exists) - (mpkgid, subLibsPkgIds) <- if hasMainBuildableLibrary package then - do + (mpkgid, subLibsPkgIds) <- if hasMainBuildableLibrary package + then do subLibsPkgIds <- fmap catMaybes $ forM (getBuildableListText $ packageSubLibraries package) $ \subLib -> do let subLibName = MungedPackageName @@ -2114,7 +2116,7 @@ singleBuild Just pkgid -> pure (Library ident pkgid Nothing, subLibsPkgIds) else do markExeInstalled (taskLocation task) pkgId -- TODO unify somehow - -- with writeFlagCache? + -- with writeFlagCache? pure (Executable ident, []) -- don't pure sublibs in this case case taskType of @@ -2276,7 +2278,9 @@ singleTest topts testsToRun ac ee task installedMap = do let suitesToRun = [ testSuitePair - | testSuitePair <- (fmap . fmap) (getField @"interface") <$> collectionKeyValueList $ packageTestSuites package + | testSuitePair <- + (fmap . fmap) (getField @"interface") <$> + collectionKeyValueList $ packageTestSuites package , let testName = fst testSuitePair , testName `elem` testsToRun ] @@ -2485,9 +2489,11 @@ singleTest topts testsToRun ac ee task installedMap = do when needHpc $ do let testsToRun' = map f testsToRun f tName = - case getField @"interface" <$> collectionLookup tName (packageTestSuites package) of - Just C.TestSuiteLibV09{} -> tName <> "Stub" - _ -> tName + case getField @"interface" <$> mComponent of + Just C.TestSuiteLibV09{} -> tName <> "Stub" + _ -> tName + where + mComponent = collectionLookup tName (packageTestSuites package) generateHpcReport pkgDir package testsToRun' bs <- liftIO $ @@ -2694,19 +2700,22 @@ primaryComponentOptions :: -> LocalPackage -> [String] primaryComponentOptions executableBuildStatuses lp = - -- TODO: get this information from target parsing instead, - -- which will allow users to turn off library building if - -- desired - (if hasMainBuildableLibrary package then map T.unpack - $ T.append "lib:" (T.pack (packageNameString (packageName package))) - : map (T.append "flib:") (getBuildableListText (packageForeignLibraries package)) - else []) + -- TODO: get this information from target parsing instead, which will allow + -- users to turn off library building if desired + ( if hasMainBuildableLibrary package + then map T.unpack + $ T.append "lib:" (T.pack (packageNameString (packageName package))) + : map + (T.append "flib:") + (getBuildableListText (packageForeignLibraries package)) + else [] + ) ++ map - (T.unpack . T.append "lib:") - (getBuildableListText $ packageSubLibraries package) + (T.unpack . T.append "lib:") + (getBuildableListText $ packageSubLibraries package) ++ map - (T.unpack . T.append "exe:") - (Set.toList $ exesToBuild executableBuildStatuses lp) + (T.unpack . T.append "exe:") + (Set.toList $ exesToBuild executableBuildStatuses lp) where package = lpPackage lp From d5be99c2171183dd8306d2f8c25c11965034d490 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sun, 12 Nov 2023 21:15:09 +0000 Subject: [PATCH 24/42] Reformat, for consistency --- src/Stack/Build/Source.hs | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index e918b84bb6..e2d5b006f5 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -24,7 +24,11 @@ import qualified Distribution.PackageDescription as C import qualified Pantry.SHA256 as SHA256 import Stack.Build.Cache ( tryGetBuildCache ) import Stack.Build.Haddock ( shouldHaddockDeps ) -import Stack.Package ( hasMainBuildableLibrary, resolvePackage, packageExes, packageBenchmarks ) +import Stack.Package + ( hasMainBuildableLibrary, packageBenchmarks, packageExes + , resolvePackage + ) +import Stack.PackageFile ( getPackageFile ) import Stack.Prelude import Stack.SourceMap ( DumpedGlobalPackage, checkFlagsUsedThrowing @@ -40,6 +44,7 @@ import Stack.Types.BuildOpts , TestOpts (..), boptsCLIAllProgOptions ) import Stack.Types.CabalConfigKey ( CabalConfigKey (..) ) +import Stack.Types.CompCollection ( getBuildableSetText ) import Stack.Types.CompilerPaths ( HasCompiler, getCompilerPath ) import Stack.Types.Config ( Config (..), HasConfig (..), buildOptsL ) import Stack.Types.Curator ( Curator (..) ) @@ -52,11 +57,11 @@ import Stack.Types.NamedComponent ( NamedComponent (..), isCSubLib, splitComponents ) import Stack.Types.Package ( FileCacheInfo (..), LocalPackage (..), Package (..) - , PackageConfig (..) - , dotCabalGetPath, memoizeRefWith, runMemoizedWith + , PackageConfig (..), dotCabalGetPath, memoizeRefWith + , runMemoizedWith ) -import Stack.Types.PackageFile ( PackageWarning, PackageComponentFile (PackageComponentFile) ) -import Stack.PackageFile ( getPackageFile ) +import Stack.Types.PackageFile + ( PackageComponentFile (..), PackageWarning ) import Stack.Types.Platform ( HasPlatform (..) ) import Stack.Types.SourceMap ( CommonPackage (..), DepPackage (..), ProjectPackage (..) @@ -66,7 +71,6 @@ import Stack.Types.SourceMap import Stack.Types.UnusedFlags ( FlagSource (..) ) import System.FilePath ( takeFileName ) import System.IO.Error ( isDoesNotExistError ) -import Stack.Types.CompCollection ( getBuildableSetText ) -- | loads and returns project packages projectLocalPackages :: HasEnvConfig env => RIO env [LocalPackage] @@ -336,10 +340,9 @@ loadLocalPackage pp = do -- individual executables or library") is resolved, 'hasLibrary' is only -- relevant if the library is part of the target spec. Just _ -> - let hasLibrary = hasMainBuildableLibrary pkg - in hasLibrary - || not (Set.null nonLibComponents) - || not (null $ packageSubLibraries pkg) + hasMainBuildableLibrary pkg + || not (Set.null nonLibComponents) + || not (null $ packageSubLibraries pkg) filterSkippedComponents = Set.filter (not . (`elem` boptsSkipComponents bopts)) From e30bcf03aaa6dd43c1f3dba1de34d729b667e884 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sun, 12 Nov 2023 21:46:59 +0000 Subject: [PATCH 25/42] Add explicit imports and remove redundant imports; reformat --- src/Stack/Component.hs | 252 +++++++++++++++++++++++------------------ 1 file changed, 144 insertions(+), 108 deletions(-) diff --git a/src/Stack/Component.hs b/src/Stack/Component.hs index bea678b596..d1666549b2 100644 --- a/src/Stack/Component.hs +++ b/src/Stack/Component.hs @@ -1,16 +1,18 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} --- | All utility functions for Components (library, internal library, foreign library, executable, tests, benchmarks) in stack. --- In particular, this module gathers all the Cabal-to-Stack component translations, which previlously occured in the "Stack.Package" module. --- See "Stack.Types.Component" for more details about the design choices. +-- | All utility functions for Components in Stack (library, internal library, +-- foreign library, executable, tests, benchmarks). In particular, this module +-- gathers all the Cabal-to-Stack component translations, which previously +-- occurred in the "Stack.Package" module. See "Stack.Types.Component" for more +-- details about the design choices. module Stack.Component ( isComponentBuildable @@ -23,68 +25,86 @@ module Stack.Component , stackUnqualToQual ) where +import Data.Foldable ( foldr' ) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Text ( pack ) +import Distribution.PackageDescription + ( Benchmark (..), Executable, ForeignLib, Library (..) + , TestSuite (..) + ) +import Distribution.Types.BuildInfo ( BuildInfo ) +import Distribution.Types.UnqualComponentName ( UnqualComponentName ) +import Distribution.Package ( mkPackageName ) +import qualified Distribution.PackageDescription as Cabal +import GHC.Records ( HasField ) import Stack.Prelude import Stack.Types.Component + ( HasBuildInfo, StackBenchmark (..), StackBuildInfo (..) + , StackExecutable (..), StackForeignLibrary (..) + , StackLibrary (..), StackTest (..), StackUnqualCompName (..) + ) import Stack.Types.Dependency ( cabalExeToStackDep, cabalToStackDep ) -import Distribution.PackageDescription (Library (libName), ForeignLib, TestSuite (testName, testBuildInfo, testInterface), Benchmark (benchmarkBuildInfo, benchmarkName), Executable) -import Distribution.Types.BuildInfo (BuildInfo) -import qualified Distribution.Types.BuildInfo as BI -import qualified Distribution.Types.Library -import qualified Distribution.Types.ForeignLib -import qualified Distribution.Types.Executable -import Data.Text (pack) -import Distribution.Types.UnqualComponentName (UnqualComponentName) -import qualified Distribution.PackageDescription as Cabal -import qualified Data.Map as Map -import qualified Data.Set as Set -import Distribution.Package (mkPackageName) -import GHC.Records (HasField) -import Data.Foldable (foldr') -import Stack.Types.NamedComponent (NamedComponent) +import Stack.Types.NamedComponent ( NamedComponent ) fromCabalName :: UnqualComponentName -> StackUnqualCompName -fromCabalName unqualName = StackUnqualCompName $ pack . Cabal.unUnqualComponentName $ unqualName +fromCabalName unqualName = + StackUnqualCompName $ pack . Cabal.unUnqualComponentName $ unqualName -stackUnqualToQual :: (Text -> NamedComponent) -> StackUnqualCompName -> NamedComponent +stackUnqualToQual :: + (Text -> NamedComponent) + -> StackUnqualCompName + -> NamedComponent stackUnqualToQual c (StackUnqualCompName n) = c n -foldOnNameAndBuildInfo :: (HasField "buildInfo" a StackBuildInfo - , HasField "name" a StackUnqualCompName, Foldable c) => - c a -> (StackUnqualCompName -> StackBuildInfo -> t -> t) -> t -> t -foldOnNameAndBuildInfo initialCollection accumulator input = foldr' iterator input initialCollection - where - iterator comp = accumulator comp.name comp.buildInfo +foldOnNameAndBuildInfo :: + ( HasField "buildInfo" a StackBuildInfo + , HasField "name" a StackUnqualCompName + , Foldable c + ) + => c a + -> (StackUnqualCompName -> StackBuildInfo -> t -> t) + -> t + -> t +foldOnNameAndBuildInfo initialCollection accumulator input = + foldr' iterator input initialCollection + where + iterator comp = accumulator comp.name comp.buildInfo stackLibraryFromCabal :: Library -> StackLibrary -stackLibraryFromCabal cabalLib = StackLibrary { - name=case cabalLib.libName of +stackLibraryFromCabal cabalLib = StackLibrary + { name = case cabalLib.libName of LMainLibName -> StackUnqualCompName mempty - LSubLibName v -> fromCabalName v, - buildInfo=stackBuildInfoFromCabal cabalLib.libBuildInfo, - exposedModules=cabalLib.exposedModules + LSubLibName v -> fromCabalName v + , buildInfo = stackBuildInfoFromCabal cabalLib.libBuildInfo + , exposedModules = cabalLib.exposedModules } + stackExecutableFromCabal :: Executable -> StackExecutable -stackExecutableFromCabal cabalExecutable = StackExecutable { - name=fromCabalName cabalExecutable.exeName, - buildInfo=stackBuildInfoFromCabal cabalExecutable.buildInfo, - modulePath=cabalExecutable.modulePath +stackExecutableFromCabal cabalExecutable = StackExecutable + { name = fromCabalName cabalExecutable.exeName + , buildInfo = stackBuildInfoFromCabal cabalExecutable.buildInfo + , modulePath = cabalExecutable.modulePath } + stackForeignLibraryFromCabal :: ForeignLib -> StackForeignLibrary -stackForeignLibraryFromCabal cabalForeignLib = StackForeignLibrary { - name=fromCabalName cabalForeignLib.foreignLibName, - buildInfo=stackBuildInfoFromCabal cabalForeignLib.foreignLibBuildInfo +stackForeignLibraryFromCabal cabalForeignLib = StackForeignLibrary + { name = fromCabalName cabalForeignLib.foreignLibName + , buildInfo=stackBuildInfoFromCabal cabalForeignLib.foreignLibBuildInfo } + stackBenchmarkFromCabal :: Benchmark -> StackBenchmark -stackBenchmarkFromCabal cabalBenchmark = StackBenchmark { - name=fromCabalName cabalBenchmark.benchmarkName, - interface=cabalBenchmark.benchmarkInterface, - buildInfo=stackBuildInfoFromCabal cabalBenchmark.benchmarkBuildInfo +stackBenchmarkFromCabal cabalBenchmark = StackBenchmark + { name = fromCabalName cabalBenchmark.benchmarkName + , interface = cabalBenchmark.benchmarkInterface + , buildInfo = stackBuildInfoFromCabal cabalBenchmark.benchmarkBuildInfo } + stackTestFromCabal :: TestSuite -> StackTest -stackTestFromCabal cabalTest = StackTest { - name=fromCabalName cabalTest.testName, - interface=cabalTest.testInterface, - buildInfo=stackBuildInfoFromCabal cabalTest.testBuildInfo +stackTestFromCabal cabalTest = StackTest + { name = fromCabalName cabalTest.testName + , interface = cabalTest.testInterface + , buildInfo = stackBuildInfoFromCabal cabalTest.testBuildInfo } isComponentBuildable :: HasBuildInfo component => component -> Bool @@ -95,63 +115,78 @@ stackBuildInfoFromCabal buildInfoV = gatherComponentToolsAndDepsFromCabal buildInfoV.buildTools buildInfoV.buildToolDepends buildInfoV.targetBuildDepends - StackBuildInfo { - sbiBuildable = buildInfoV.buildable, - sbiOtherModules = buildInfoV.otherModules, - jsSources = buildInfoV.jsSources, - hsSourceDirs = buildInfoV.hsSourceDirs, - cSources = buildInfoV.cSources, - sbiDependency = mempty, - sbiUnknownTools = mempty, - cppOptions = buildInfoV.cppOptions, - targetBuildDepends = buildInfoV.targetBuildDepends, - options = buildInfoV.options, - allLanguages = Cabal.allLanguages buildInfoV, - usedExtensions = Cabal.usedExtensions buildInfoV, - includeDirs = buildInfoV.includeDirs, - extraLibs = buildInfoV.extraLibs, - extraLibDirs = buildInfoV.extraLibDirs, - frameworks = buildInfoV.frameworks + StackBuildInfo + { sbiBuildable = buildInfoV.buildable + , sbiOtherModules = buildInfoV.otherModules + , jsSources = buildInfoV.jsSources + , hsSourceDirs = buildInfoV.hsSourceDirs + , cSources = buildInfoV.cSources + , sbiDependency = mempty + , sbiUnknownTools = mempty + , cppOptions = buildInfoV.cppOptions + , targetBuildDepends = buildInfoV.targetBuildDepends + , options = buildInfoV.options + , allLanguages = Cabal.allLanguages buildInfoV + , usedExtensions = Cabal.usedExtensions buildInfoV + , includeDirs = buildInfoV.includeDirs + , extraLibs = buildInfoV.extraLibs + , extraLibDirs = buildInfoV.extraLibDirs + , frameworks = buildInfoV.frameworks } --- | Iterate on all three dependency list given, and transform and sort them between sbiUnknownTools --- and legitimate 'DepValue' sbiDependency. --- Bear in mind that this only gathers the component level dependencies. +-- | Iterate on all three dependency list given, and transform and sort them +-- between 'sbiUnknownTools' and legitimate 'DepValue' sbiDependency. Bear in +-- mind that this only gathers the component level dependencies. gatherComponentToolsAndDepsFromCabal :: [Cabal.LegacyExeDependency] - -- ^ Legacy build tools dependency from [buildTools](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-BuildInfo.html#t:buildTools). + -- ^ Legacy build tools dependency from + -- [buildTools](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-BuildInfo.html#t:buildTools). -> [Cabal.ExeDependency] - -- ^ Build tools dependency [buildToolDepends](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-BuildInfo.html#t:buildToolDepends) + -- ^ Build tools dependency + -- [buildToolDepends](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-BuildInfo.html#t:buildToolDepends) -> [Cabal.Dependency] - -- ^ The Cabal defined [targetBuildDepends](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-BuildInfo.html#t:targetBuildDepends), - -- these are the simplest dependencies for a component extracted from the cabal file such as : - -- @ - -- build-depends: - -- foo ^>= 1.2.3.4, - -- bar ^>= 1 - -- @ + -- ^ The Cabal defined + -- [targetBuildDepends](https://hackage.haskell.org/package/Cabal-syntax/docs/Distribution-Types-BuildInfo.html#t:targetBuildDepends), + -- these are the simplest dependencies for a component extracted from the + -- Cabal file such as: + -- @ + -- build-depends: + -- foo ^>= 1.2.3.4, + -- bar ^>= 1 + -- @ -> StackBuildInfo -> StackBuildInfo -gatherComponentToolsAndDepsFromCabal legacyBuildTools buildTools targetDeps = gatherTargetDependency . gatherToolsDependency . gatherUnknownTools - where - gatherUnknownTools sbi = foldl' processLegacyExeDepency sbi legacyBuildTools - gatherToolsDependency sbi = foldl' processExeDependency sbi buildTools - gatherTargetDependency sbi = foldl' processDependency sbi targetDeps - -- This is similar to [desugarBuildTool](https://hackage.haskell.org/package/Cabal/docs/src/Distribution.Simple.BuildToolDepends.html#desugarBuildTool) - -- from Cabal, however it uses our own hard-coded map which drops tools shipped with - -- GHC (like hsc2hs), and includes some tools from Stackage. - processLegacyExeDepency sbi (Cabal.LegacyExeDependency exeName range) = case isKnownLegacyExe exeName of - Just pName -> processExeDependency sbi (Cabal.ExeDependency pName (Cabal.mkUnqualComponentName exeName) range) - Nothing -> sbi{sbiUnknownTools = Set.insert (pack exeName) $ sbiUnknownTools sbi} - processExeDependency sbi exeDep@(Cabal.ExeDependency pName _ _) - | isPreInstalledPackages pName = sbi - | otherwise = sbi{sbiDependency = Map.insert pName (cabalExeToStackDep exeDep) $ sbiDependency sbi} - processDependency sbi dep@(Cabal.Dependency pName _ _) = sbi{ - sbiDependency = Map.insert pName (cabalToStackDep dep) $ sbiDependency sbi - } - --- | A hard-coded map for tool dependencies. --- If a dependency is within this map it's considered "known" (the exe will be found at the execution stage). +gatherComponentToolsAndDepsFromCabal legacyBuildTools buildTools targetDeps = + gatherTargetDependency . gatherToolsDependency . gatherUnknownTools + where + gatherUnknownTools sbi = foldl' processLegacyExeDepency sbi legacyBuildTools + gatherToolsDependency sbi = foldl' processExeDependency sbi buildTools + gatherTargetDependency sbi = foldl' processDependency sbi targetDeps + -- This is similar to + -- [desugarBuildTool](https://hackage.haskell.org/package/Cabal/docs/src/Distribution.Simple.BuildToolDepends.html#desugarBuildTool) + -- from Cabal, however it uses our own hard-coded map which drops tools + -- shipped with GHC (like hsc2hs), and includes some tools from Stackage. + processLegacyExeDepency sbi (Cabal.LegacyExeDependency exeName range) = + case isKnownLegacyExe exeName of + Just pName -> + processExeDependency + sbi + (Cabal.ExeDependency pName (Cabal.mkUnqualComponentName exeName) range) + Nothing -> sbi + {sbiUnknownTools = Set.insert (pack exeName) $ sbiUnknownTools sbi} + processExeDependency sbi exeDep@(Cabal.ExeDependency pName _ _) + | isPreInstalledPackages pName = sbi + | otherwise = sbi + { sbiDependency = + Map.insert pName (cabalExeToStackDep exeDep) $ sbiDependency sbi + } + processDependency sbi dep@(Cabal.Dependency pName _ _) = sbi + { sbiDependency = + Map.insert pName (cabalToStackDep dep) $ sbiDependency sbi + } + +-- | A hard-coded map for tool dependencies. If a dependency is within this map +-- it's considered "known" (the exe will be found at the execution stage). -- [It also exists in Cabal](https://hackage.haskell.org/package/Cabal/docs/src/Distribution.Simple.BuildToolDepends.html#local-6989586621679259154) isKnownLegacyExe :: String -> Maybe PackageName isKnownLegacyExe input = case input of @@ -167,12 +202,13 @@ isKnownLegacyExe input = case input of "gtk2hsHookGenerator" -> justPck "gtk2hs-buildtools" "gtk2hsTypeGen" -> justPck "gtk2hs-buildtools" _ -> Nothing - where justPck = Just . mkPackageName + where + justPck = Just . mkPackageName --- | Executable-only packages which come pre-installed with GHC and do --- not need to be built. Without this exception, we would either end --- up unnecessarily rebuilding these packages, or failing because the --- packages do not appear in the Stackage snapshot. +-- | Executable-only packages which come pre-installed with GHC and do not need +-- to be built. Without this exception, we would either end up unnecessarily +-- rebuilding these packages, or failing because the packages do not appear in +-- the Stackage snapshot. isPreInstalledPackages :: PackageName -> Bool isPreInstalledPackages input = case input of "hsc2hs" -> True From 38a4de9b858d6716ad5d1b1b49ffe76214fe9d22 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sun, 12 Nov 2023 22:19:05 +0000 Subject: [PATCH 26/42] Add explicit import lists; reformat, for consistency --- src/Stack/ComponentFile.hs | 91 ++++++++++++++++++++------------------ 1 file changed, 49 insertions(+), 42 deletions(-) diff --git a/src/Stack/ComponentFile.hs b/src/Stack/ComponentFile.hs index eef92bf954..0f0df76ba9 100644 --- a/src/Stack/ComponentFile.hs +++ b/src/Stack/ComponentFile.hs @@ -1,7 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} -- | A module which exports all component-level file-gathering logic. It also -- includes utility functions for handling paths and directories. @@ -13,7 +13,7 @@ module Stack.ComponentFile , packageAutogenDir , buildDir , componentAutogenDir - , ComponentFile(..) + , ComponentFile (..) , stackLibraryFiles , stackExecutableFiles , stackTestFiles @@ -29,12 +29,12 @@ import qualified Data.Text as T import Distribution.ModuleName ( ModuleName ) import qualified Distribution.ModuleName as Cabal import Distribution.PackageDescription - ( BenchmarkInterface (..) - , TestSuiteInterface (..) - ) + ( BenchmarkInterface (..), TestSuiteInterface (..) ) import Distribution.Text ( display ) -import Distribution.Utils.Path ( getSymbolicPath, SymbolicPath, PackageDir, SourceDir ) +import Distribution.Utils.Path + ( PackageDir, SourceDir, SymbolicPath, getSymbolicPath ) import Distribution.Version ( mkVersion ) +import GHC.Records ( HasField ) import qualified HiFileParser as Iface import Path ( (), filename, isProperPrefixOf, parent, parseRelDir @@ -51,6 +51,11 @@ import Stack.Constants , relDirAutogen, relDirBuild, relDirGlobalAutogen ) import Stack.Prelude hiding ( Display (..) ) +import Stack.Types.Component + ( StackBenchmark (..), StackBuildInfo (..) + , StackExecutable (..), StackLibrary (..), StackTest (..) + , sbiOtherModules, unqualCompToText + ) import Stack.Types.Config ( Config (..), HasConfig (..), prettyStackDevL ) import Stack.Types.NamedComponent ( NamedComponent (..) ) @@ -61,20 +66,17 @@ import Stack.Types.PackageFile ) import qualified System.Directory as D ( doesFileExist ) import qualified System.FilePath as FilePath -import Stack.Types.Component (StackBenchmark, sbiOtherModules, StackTest, unqualCompToText, StackExecutable, StackLibrary) -import qualified Stack.Types.Component -import GHC.Records ( HasField ) -data ComponentFile = ComponentFile { - moduleFileMap :: !(Map ModuleName (Path Abs File)), - otherFile :: ![DotCabalPath], - packageWarning :: ![PackageWarning] -} +data ComponentFile = ComponentFile + { moduleFileMap :: !(Map ModuleName (Path Abs File)) + , otherFile :: ![DotCabalPath] + , packageWarning :: ![PackageWarning] + } -- | Get all files referenced by the benchmark. -stackBenchmarkFiles :: StackBenchmark -> RIO - GetPackageFileContext - (NamedComponent, ComponentFile) +stackBenchmarkFiles :: + StackBenchmark + -> RIO GetPackageFileContext (NamedComponent, ComponentFile) stackBenchmarkFiles bench = resolveComponentFiles (CBench $ unqualCompToText bench.name) build names where @@ -87,9 +89,9 @@ stackBenchmarkFiles bench = build = bench.buildInfo -- | Get all files referenced by the test. -stackTestFiles :: StackTest -> RIO - GetPackageFileContext - (NamedComponent, ComponentFile) +stackTestFiles :: + StackTest + -> RIO GetPackageFileContext (NamedComponent, ComponentFile) stackTestFiles test = resolveComponentFiles (CTest $ unqualCompToText test.name) build names where @@ -103,22 +105,21 @@ stackTestFiles test = build = test.buildInfo -- | Get all files referenced by the executable. -stackExecutableFiles :: StackExecutable -> RIO - GetPackageFileContext - (NamedComponent, ComponentFile) +stackExecutableFiles :: + StackExecutable + -> RIO GetPackageFileContext (NamedComponent, ComponentFile) stackExecutableFiles exe = resolveComponentFiles (CExe $ unqualCompToText exe.name) build names where build = exe.buildInfo names = - map DotCabalModule build.sbiOtherModules ++ - [DotCabalMain exe.modulePath] + map DotCabalModule build.sbiOtherModules ++ [DotCabalMain exe.modulePath] --- | Get all files referenced by the library. --- | Handle all libraries (CLib and SubLib), based on empty name or not. -stackLibraryFiles :: StackLibrary -> RIO - GetPackageFileContext - (NamedComponent, ComponentFile) +-- | Get all files referenced by the library. Handle all libraries (CLib and +-- SubLib), based on empty name or not. +stackLibraryFiles :: + StackLibrary + -> RIO GetPackageFileContext (NamedComponent, ComponentFile) stackLibraryFiles lib = resolveComponentFiles componentName build names where @@ -132,13 +133,14 @@ stackLibraryFiles lib = bnames = map DotCabalModule build.sbiOtherModules -- | Get all files referenced by the component. -resolveComponentFiles :: (CAndJsSources rec, HasField "hsSourceDirs" rec [SymbolicPath PackageDir SourceDir]) => - NamedComponent +resolveComponentFiles :: + ( CAndJsSources rec + , HasField "hsSourceDirs" rec [SymbolicPath PackageDir SourceDir] + ) + => NamedComponent -> rec -> [DotCabalDescriptor] - -> RIO - GetPackageFileContext - (NamedComponent, ComponentFile) + -> RIO GetPackageFileContext (NamedComponent, ComponentFile) resolveComponentFiles component build names = do dirs <- mapMaybeM (resolveDirOrWarn . getSymbolicPath) build.hsSourceDirs dir <- asks (parent . ctxFile) @@ -158,10 +160,9 @@ resolveComponentFiles component build names = do pkgDir = maybeToList $ packageAutogenDir cabalVer distDir filterM doesDirExist $ compDir : pkgDir --- | Try to resolve the list of base names in the given directory by --- looking for unique instances of base names applied with the given --- extensions, plus find any of their module and TemplateHaskell --- dependencies. +-- | Try to resolve the list of base names in the given directory by looking for +-- unique instances of base names applied with the given extensions, plus find +-- any of their module and TemplateHaskell dependencies. resolveFilesAndDeps :: NamedComponent -- ^ Package component name -> [Path Abs Dir] -- ^ Directories to look in. @@ -447,10 +448,14 @@ logPossibilities dirs mn = do ) dirs -type CAndJsSources rec = (HasField "cSources" rec [FilePath], HasField "jsSources" rec [FilePath]) +type CAndJsSources rec = + (HasField "cSources" rec [FilePath], HasField "jsSources" rec [FilePath]) -- | Get all C sources and extra source files in a build. -buildOtherSources :: CAndJsSources rec => rec -> RIO GetPackageFileContext [DotCabalPath] +buildOtherSources :: + CAndJsSources rec + => rec + -> RIO GetPackageFileContext [DotCabalPath] buildOtherSources build = do cwd <- liftIO getCurrentDir dir <- asks (parent . ctxFile) @@ -471,7 +476,9 @@ buildOtherSources build = do -- don't get followed. resolveDirFile :: (MonadIO m, MonadThrow m) - => Path Abs Dir -> FilePath.FilePath -> m (Maybe (Path Abs File)) + => Path Abs Dir + -> FilePath.FilePath + -> m (Maybe (Path Abs File)) resolveDirFile x y = do -- The standard canonicalizePath does not work for this case p <- parseCollapsedAbsFile (toFilePath x FilePath. y) From 6106beec606e5d739337c09079c19687fc31f90e Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sun, 12 Nov 2023 22:34:50 +0000 Subject: [PATCH 27/42] Reformatting, for consistency --- src/Stack/Coverage.hs | 218 ++++++++++++++++++++++-------------------- 1 file changed, 115 insertions(+), 103 deletions(-) diff --git a/src/Stack/Coverage.hs b/src/Stack/Coverage.hs index 452d888326..6bd950a2e3 100644 --- a/src/Stack/Coverage.hs +++ b/src/Stack/Coverage.hs @@ -53,8 +53,7 @@ import Stack.Types.EnvConfig , hpcReportDir ) import Stack.Types.NamedComponent ( NamedComponent (..) ) -import Stack.Types.Package - ( Package (..), packageIdentifier ) +import Stack.Types.Package ( Package (..), packageIdentifier ) import Stack.Types.Runner ( Runner ) import Stack.Types.SourceMap ( PackageType (..), SMTargets (..), SMWanted (..) @@ -247,104 +246,113 @@ generateHpcReportInternal :: -> [String] -> [String] -> RIO env (Maybe (Path Abs File)) -generateHpcReportInternal tixSrc reportDir report reportHtml extraMarkupArgs extraReportArgs = do - -- If a .tix file exists, move it to the HPC output directory and generate a - -- report for it. - tixFileExists <- doesFileExist tixSrc - if not tixFileExists - then do - prettyError $ - "[S-4634]" - <> line - <> flow "Didn't find" - <> style File ".tix" - <> "for" - <> report - <> flow "- expected to find it at" - <> pretty tixSrc <> "." - pure Nothing - else (`catch` \(err :: ProcessException) -> do - logError $ displayShow err - generateHpcErrorReport reportDir $ display $ sanitize $ - displayException err - pure Nothing) $ - (`onException` - prettyError - ( "[S-8215]" - <> line - <> flow "Error occurred while producing" - <> report <> "." - )) $ do - -- Directories for .mix files. - hpcRelDir <- hpcRelativeDir - -- Compute arguments used for both "hpc markup" and "hpc report". - pkgDirs <- view $ buildConfigL.to (map ppRoot . Map.elems . smwProject . bcSMWanted) - let args = - -- Use index files from all packages (allows cross-package coverage results). - concatMap (\x -> ["--srcdir", toFilePathNoTrailingSep x]) pkgDirs ++ - -- Look for index files in the correct dir (relative to each pkgdir). - ["--hpcdir", toFilePathNoTrailingSep hpcRelDir, "--reset-hpcdirs"] - prettyInfoL - [ "Generating" - , report <> "." - ] - -- Strip @\r@ characters because Windows. - outputLines <- map (L8.filter (/= '\r')) . L8.lines . fst <$> - proc "hpc" - ( "report" - : toFilePath tixSrc - : (args ++ extraReportArgs) - ) - readProcess_ - if all ("(0/0)" `L8.isSuffixOf`) outputLines +generateHpcReportInternal + tixSrc + reportDir + report + reportHtml + extraMarkupArgs + extraReportArgs + = do + -- If a .tix file exists, move it to the HPC output directory and generate + -- a report for it. + tixFileExists <- doesFileExist tixSrc + if not tixFileExists then do - let msgHtml = - "Error: [S-6829]\n\ - \The " - <> display reportHtml - <> " did not consider any code. One possible cause of this is \ - \if your test-suite builds the library code (see Stack \ - \\ - \issue #1008\ - \\ - \). It may also indicate a bug in Stack or the hpc program. \ - \Please report this issue if you think your coverage report \ - \should have meaningful results." prettyError $ - "[S-6829]" + "[S-4634]" <> line - <> fillSep - [ "The" - , report - , flow "did not consider any code. One possible cause of this \ - \is if your test-suite builds the library code (see \ - \Stack issue #1008). It may also indicate a bug in \ - \Stack or the hpc program. Please report this issue if \ - \you think your coverage report should have meaningful \ - \results." - ] - generateHpcErrorReport reportDir msgHtml + <> flow "Didn't find" + <> style File ".tix" + <> "for" + <> report + <> flow "- expected to find it at" + <> pretty tixSrc <> "." pure Nothing - else do - let reportPath = reportDir relFileHpcIndexHtml - -- Print the summary report to the standard output stream. - putUtf8Builder =<< displayWithColor - ( fillSep - [ "Summary" - , report <> ":" - ] - <> line - ) - forM_ outputLines putStrLn - -- Generate the HTML markup. - void $ proc "hpc" - ( "markup" + else (`catch` \(err :: ProcessException) -> do + logError $ displayShow err + generateHpcErrorReport reportDir $ display $ sanitize $ + displayException err + pure Nothing) $ + (`onException` + prettyError + ( "[S-8215]" + <> line + <> flow "Error occurred while producing" + <> report <> "." + )) $ do + -- Directories for .mix files. + hpcRelDir <- hpcRelativeDir + -- Compute arguments used for both "hpc markup" and "hpc report". + pkgDirs <- view $ buildConfigL.to + (map ppRoot . Map.elems . smwProject . bcSMWanted) + let args = + -- Use index files from all packages (allows cross-package + -- coverage results). + concatMap (\x -> ["--srcdir", toFilePathNoTrailingSep x]) pkgDirs ++ + -- Look for index files in the correct dir (relative to each pkgdir). + ["--hpcdir", toFilePathNoTrailingSep hpcRelDir, "--reset-hpcdirs"] + prettyInfoL + [ "Generating" + , report <> "." + ] + -- Strip @\r@ characters because Windows. + outputLines <- map (L8.filter (/= '\r')) . L8.lines . fst <$> + proc "hpc" + ( "report" : toFilePath tixSrc - : ("--destdir=" ++ toFilePathNoTrailingSep reportDir) - : (args ++ extraMarkupArgs) + : (args ++ extraReportArgs) ) readProcess_ - pure (Just reportPath) + if all ("(0/0)" `L8.isSuffixOf`) outputLines + then do + let msgHtml = + "Error: [S-6829]\n\ + \The " + <> display reportHtml + <> " did not consider any code. One possible cause of this is \ + \if your test-suite builds the library code (see Stack \ + \\ + \issue #1008\ + \\ + \). It may also indicate a bug in Stack or the hpc program. \ + \Please report this issue if you think your coverage report \ + \should have meaningful results." + prettyError $ + "[S-6829]" + <> line + <> fillSep + [ "The" + , report + , flow "did not consider any code. One possible cause of this \ + \is if your test-suite builds the library code (see \ + \Stack issue #1008). It may also indicate a bug in \ + \Stack or the hpc program. Please report this issue if \ + \you think your coverage report should have meaningful \ + \results." + ] + generateHpcErrorReport reportDir msgHtml + pure Nothing + else do + let reportPath = reportDir relFileHpcIndexHtml + -- Print the summary report to the standard output stream. + putUtf8Builder =<< displayWithColor + ( fillSep + [ "Summary" + , report <> ":" + ] + <> line + ) + forM_ outputLines putStrLn + -- Generate the HTML markup. + void $ proc "hpc" + ( "markup" + : toFilePath tixSrc + : ("--destdir=" ++ toFilePathNoTrailingSep reportDir) + : (args ++ extraMarkupArgs) + ) + readProcess_ + pure (Just reportPath) generateHpcReportForTargets :: HasEnvConfig env => HpcReportOpts -> [Text] -> [Text] -> RIO env () @@ -414,11 +422,12 @@ generateHpcUnifiedReport = do outputDir <- hpcReportDir ensureDir outputDir (dirs, _) <- listDir outputDir - tixFiles0 <- fmap (concat . concat) $ forM (filter (("combined" /=) . dirnameString) dirs) $ \dir -> do - (dirs', _) <- listDir dir - forM dirs' $ \dir' -> do - (_, files) <- listDir dir' - pure (filter ((".tix" `L.isSuffixOf`) . toFilePath) files) + tixFiles0 <- + fmap (concat . concat) $ forM (filter (("combined" /=) . dirnameString) dirs) $ \dir -> do + (dirs', _) <- listDir dir + forM dirs' $ \dir' -> do + (_, files) <- listDir dir' + pure (filter ((".tix" `L.isSuffixOf`) . toFilePath) files) extraTixFiles <- findExtraTixFiles let tixFiles = tixFiles0 ++ extraTixFiles reportDir = outputDir relDirCombined relDirAll @@ -462,7 +471,8 @@ generateUnionReport report reportHtml reportDir tixFiles = do ] <> line <> bulletedList (map fromString errs :: [StyleDoc]) - tixDest <- (reportDir ) <$> parseRelFile (dirnameString reportDir ++ ".tix") + tixDest <- + (reportDir ) <$> parseRelFile (dirnameString reportDir ++ ".tix") ensureDir (parent tixDest) liftIO $ writeTix (toFilePath tixDest) tix generateHpcReportInternal tixDest reportDir report reportHtml [] [] @@ -487,10 +497,11 @@ readTixOrLog path = do ] pure mtix --- | Module names which contain '/' have a package name, and so they weren't built into the --- executable. +-- | Module names which contain '/' have a package name, and so they weren't +-- built into the executable. removeExeModules :: Tix -> Tix -removeExeModules (Tix ms) = Tix (filter (\(TixModule name _ _ _) -> '/' `elem` name) ms) +removeExeModules (Tix ms) = + Tix (filter (\(TixModule name _ _ _) -> '/' `elem` name) ms) unionTixes :: [Tix] -> ([String], Tix) unionTixes tixes = (Map.keys errs, Tix (Map.elems outputs)) @@ -499,7 +510,8 @@ unionTixes tixes = (Map.keys errs, Tix (Map.elems outputs)) toMap (Tix ms) = Map.fromList (map (\x@(TixModule k _ _ _) -> (k, Right x)) ms) merge (Right (TixModule k hash1 len1 tix1)) (Right (TixModule _ hash2 len2 tix2)) - | hash1 == hash2 && len1 == len2 = Right (TixModule k hash1 len1 (zipWith (+) tix1 tix2)) + | hash1 == hash2 && len1 == len2 = + Right (TixModule k hash1 len1 (zipWith (+) tix1 tix2)) merge _ _ = Left () generateHpcMarkupIndex :: HasEnvConfig env => RIO env () From 460e8ada84d8060b766bccc523d5c1a787c8aedc Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Mon, 13 Nov 2023 21:01:17 +0000 Subject: [PATCH 28/42] Update ignored Stan observations for code changes --- .stan.toml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.stan.toml b/.stan.toml index 543cfa276e..50116eb123 100644 --- a/.stan.toml +++ b/.stan.toml @@ -52,7 +52,7 @@ # Anti-pattern: Data.ByteString.Char8.pack [[ignore]] - id = "OBS-STAN-0203-fki0nd-1118:21" + id = "OBS-STAN-0203-fki0nd-1120:21" # ✦ Description: Usage of 'pack' function that doesn't handle Unicode characters # ✦ Category: #AntiPattern # ✦ File: src\Stack\Build\Execute.hs @@ -63,7 +63,7 @@ # Anti-pattern: Data.ByteString.Char8.pack [[ignore]] - id = "OBS-STAN-0203-fki0nd-2656:3" + id = "OBS-STAN-0203-fki0nd-2662:3" # ✦ Description: Usage of 'pack' function that doesn't handle Unicode characters # ✦ Category: #AntiPattern # ✦ File: src\Stack\Build\Execute.hs From 7310b248255a1cdddc6bf849af4571772e1fc802 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Mon, 13 Nov 2023 21:22:17 +0000 Subject: [PATCH 29/42] Reformatting, for consistency --- src/Stack/Ghci.hs | 42 ++++++++++++++++++++++-------------------- 1 file changed, 22 insertions(+), 20 deletions(-) diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index b16a16871d..c6d8bcb805 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -48,10 +48,11 @@ import Stack.Ghci.Script , scriptToLazyByteString ) import Stack.Package - ( PackageDescriptionPair (..), packageFromPackageDescription - , readDotBuildinfo, resolvePackageDescription, hasMainBuildableLibrary - , packageExes, getPackageOpts + ( PackageDescriptionPair (..), hasMainBuildableLibrary + , getPackageOpts, packageExes, packageFromPackageDescription + , readDotBuildinfo, resolvePackageDescription ) +import Stack.PackageFile ( getPackageFile ) import Stack.Prelude import Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig ) import Stack.Types.Build.Exception @@ -62,6 +63,7 @@ import Stack.Types.BuildOpts ( ApplyCLIFlag, BenchmarkOpts (..), BuildOpts (..) , BuildOptsCLI (..), TestOpts (..), defaultBuildOptsCLI ) +import Stack.Types.CompCollection ( getBuildableListText ) import Stack.Types.CompilerPaths ( CompilerPaths (..), HasCompiler (..) ) import Stack.Types.Config ( Config (..), HasConfig (..), buildOptsL ) @@ -75,10 +77,9 @@ import Stack.Types.NamedComponent import Stack.Types.Package ( BuildInfoOpts (..), InstallMap, InstalledMap , LocalPackage (..), Package (..), PackageConfig (..) - , dotCabalCFilePath, dotCabalGetPath - , dotCabalMainPath + , dotCabalCFilePath, dotCabalGetPath, dotCabalMainPath ) -import Stack.PackageFile ( getPackageFile ) +import Stack.Types.PackageFile ( PackageComponentFile (..) ) import Stack.Types.Platform ( HasPlatform (..) ) import Stack.Types.Runner ( HasRunner, Runner ) import Stack.Types.SourceMap @@ -88,8 +89,6 @@ import Stack.Types.SourceMap ) import System.IO ( putStrLn ) import System.Permissions ( setScriptPerms ) -import Stack.Types.CompCollection ( getBuildableListText ) -import Stack.Types.PackageFile (PackageComponentFile(PackageComponentFile)) -- | Type representing exceptions thrown by functions exported by the -- "Stack.Ghci" module. @@ -932,7 +931,8 @@ makeGhciPkgInfo installMap installedMap locals addPkgs mfileTargets pkgDesc = do cabalfp = ghciDescCabalFp pkgDesc target = ghciDescTarget pkgDesc name = packageName pkg - (mods,files,opts) <- getPackageOpts pkg installMap installedMap locals addPkgs cabalfp + (mods, files, opts) <- + getPackageOpts pkg installMap installedMap locals addPkgs cabalfp let filteredOpts = filterWanted opts filterWanted = M.filterWithKey (\k _ -> k `S.member` allWanted) allWanted = wantedPackageComponents bopts target pkg @@ -960,17 +960,19 @@ makeGhciPkgInfo installMap installedMap locals addPkgs mfileTargets pkgDesc = do wantedPackageComponents :: BuildOpts -> Target -> Package -> Set NamedComponent wantedPackageComponents _ (TargetComps cs) _ = cs wantedPackageComponents bopts (TargetAll PTProject) pkg = S.fromList $ - (if hasMainBuildableLibrary pkg - then CLib : map CSubLib (getBuildableListText $ packageForeignLibraries pkg) - else []) ++ - map CExe (S.toList (packageExes pkg)) <> - map CSubLib (getBuildableListText $ packageSubLibraries pkg) <> - (if boptsTests bopts - then map CTest (getBuildableListText (packageTestSuites pkg)) - else []) <> - (if boptsBenchmarks bopts - then map CBench (getBuildableListText (packageBenchmarkSuites pkg)) - else []) + ( if hasMainBuildableLibrary pkg + then CLib : map CSubLib buildableForeignLibs + else [] + ) + <> map CExe (S.toList (packageExes pkg)) + <> map CSubLib buildableSubLibs + <> (if boptsTests bopts then map CTest buildableTestSuites else []) + <> (if boptsBenchmarks bopts then map CBench buildableBenchmarks else []) + where + buildableForeignLibs = getBuildableListText $ packageForeignLibraries pkg + buildableSubLibs = getBuildableListText $ packageSubLibraries pkg + buildableTestSuites = getBuildableListText $ packageTestSuites pkg + buildableBenchmarks = getBuildableListText $ packageBenchmarkSuites pkg wantedPackageComponents _ _ _ = S.empty checkForIssues :: HasTerm env => [GhciPkgInfo] -> RIO env () From 0b09feaa7b1a5109dc8843c0ec2b1b2cd45e7ad8 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Mon, 13 Nov 2023 21:24:29 +0000 Subject: [PATCH 30/42] Prefer type `[a]` to `[] a` --- src/Stack/Types/CompCollection.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Stack/Types/CompCollection.hs b/src/Stack/Types/CompCollection.hs index 6fdad8cbae..d55c63940b 100644 --- a/src/Stack/Types/CompCollection.hs +++ b/src/Stack/Types/CompCollection.hs @@ -134,13 +134,13 @@ getBuildableSet = asNameSet . buildableOnes getBuildableSetText :: CompCollection component -> Set Text getBuildableSetText = Set.mapMonotonic unqualCompToText . getBuildableSet -getBuildableListText :: CompCollection component -> [] Text +getBuildableListText :: CompCollection component -> [Text] getBuildableListText = getBuildableListAs unqualCompToText getBuildableListAs :: (StackUnqualCompName -> something) -> CompCollection component - -> [] something + -> [something] getBuildableListAs fn = Set.foldr' (\v l -> fn v:l) [] . getBuildableSet hasBuildableComponent :: CompCollection component -> Bool From 4cafcdc458f974c0ee21373e45c922c6fe675333 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Mon, 13 Nov 2023 21:35:58 +0000 Subject: [PATCH 31/42] Further reformatting, for consistency --- src/Stack/Package.hs | 103 +++++++++++++++++++++++++------------------ 1 file changed, 61 insertions(+), 42 deletions(-) diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index c217e7b4a0..0bd44d55cf 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -71,14 +71,14 @@ import Stack.Component , stackForeignLibraryFromCabal, stackLibraryFromCabal , stackTestFromCabal, stackUnqualToQual ) -import Stack.Constants (relFileCabalMacrosH, relDirLogs) -import Stack.Constants.Config ( distDirFromDir ) -import Stack.PackageFile ( getPackageFile, stackPackageFileFromCabal ) -import Stack.Prelude hiding ( Display (..) ) import Stack.ComponentFile ( buildDir, componentAutogenDir, componentBuildDir , componentOutputDir, packageAutogenDir ) +import Stack.Constants (relFileCabalMacrosH, relDirLogs) +import Stack.Constants.Config ( distDirFromDir ) +import Stack.PackageFile ( getPackageFile, stackPackageFileFromCabal ) +import Stack.Prelude hiding ( Display (..) ) import Stack.Types.BuildConfig ( HasBuildConfig (..), getProjectWorkDir ) import Stack.Types.CompCollection @@ -221,8 +221,8 @@ packageFromPackageDescription || fromString (packageNameString name') `S.member` extraLibNames toInternalPackageMungedName :: Package -> Text -> Text -toInternalPackageMungedName pkg - = T.pack +toInternalPackageMungedName pkg = + T.pack . prettyShow . MungedPackageName (packageName pkg) . maybeToLibraryName @@ -287,37 +287,47 @@ generatePkgDescOpts :: -> Package -> Map NamedComponent [DotCabalPath] -> m (Map NamedComponent BuildInfoOpts) -generatePkgDescOpts installMap installedMap omitPkgs addPkgs cabalfp pkg componentPaths = do - config <- view configL - cabalVer <- view cabalVersionL - distDir <- distDirFromDir cabalDir - let generate namedComponent binfo = generateBuildInfoOpts BioInput - { biInstallMap = installMap - , biInstalledMap = installedMap - , biCabalDir = cabalDir - , biDistDir = distDir - , biOmitPackages = omitPkgs - , biAddPackages = addPkgs - , biBuildInfo = binfo - , biDotCabalPaths = - fromMaybe [] (M.lookup namedComponent componentPaths) - , biConfigLibDirs = configExtraLibDirs config - , biConfigIncludeDirs = configExtraIncludeDirs config - , biComponentName = namedComponent - , biCabalVersion = cabalVer - } - let insertInMap name compVal = M.insert name (generate name compVal) - let translatedInsertInMap constructor name = - insertInMap (stackUnqualToQual constructor name) - let makeBuildInfoOpts selector constructor = - foldOnNameAndBuildInfo (selector pkg) (translatedInsertInMap constructor) - let aggregateAllBuildInfoOpts = - makeBuildInfoOpts packageLibrary (const CLib) - . makeBuildInfoOpts packageSubLibraries CSubLib - . makeBuildInfoOpts packageExecutables CExe - . makeBuildInfoOpts packageBenchmarkSuites CBench - . makeBuildInfoOpts packageTestSuites CTest - pure $ aggregateAllBuildInfoOpts mempty +generatePkgDescOpts + installMap + installedMap + omitPkgs + addPkgs + cabalfp + pkg + componentPaths + = do + config <- view configL + cabalVer <- view cabalVersionL + distDir <- distDirFromDir cabalDir + let generate namedComponent binfo = generateBuildInfoOpts BioInput + { biInstallMap = installMap + , biInstalledMap = installedMap + , biCabalDir = cabalDir + , biDistDir = distDir + , biOmitPackages = omitPkgs + , biAddPackages = addPkgs + , biBuildInfo = binfo + , biDotCabalPaths = + fromMaybe [] (M.lookup namedComponent componentPaths) + , biConfigLibDirs = configExtraLibDirs config + , biConfigIncludeDirs = configExtraIncludeDirs config + , biComponentName = namedComponent + , biCabalVersion = cabalVer + } + let insertInMap name compVal = M.insert name (generate name compVal) + let translatedInsertInMap constructor name = + insertInMap (stackUnqualToQual constructor name) + let makeBuildInfoOpts selector constructor = + foldOnNameAndBuildInfo + (selector pkg) + (translatedInsertInMap constructor) + let aggregateAllBuildInfoOpts = + makeBuildInfoOpts packageLibrary (const CLib) + . makeBuildInfoOpts packageSubLibraries CSubLib + . makeBuildInfoOpts packageExecutables CExe + . makeBuildInfoOpts packageBenchmarkSuites CBench + . makeBuildInfoOpts packageTestSuites CTest + pure $ aggregateAllBuildInfoOpts mempty where cabalDir = parent cabalfp @@ -584,19 +594,28 @@ resolvePackageDescription go modBuildable = desc { library = fmap (resolveConditions rc updateLibDeps) mlib , subLibraries = map - (\(n, v) -> (resolveConditions rc updateLibDeps v){libName=LSubLibName n}) + ( \(n, v) -> + (resolveConditions rc updateLibDeps v){libName = LSubLibName n} + ) subLibs , foreignLibs = map - (\(n, v) -> (resolveConditions rc updateForeignLibDeps v){foreignLibName=n}) + ( \(n, v) -> + (resolveConditions rc updateForeignLibDeps v){foreignLibName = n} + ) foreignLibs' , executables = map - (\(n, v) -> (resolveConditions rc updateExeDeps v){exeName=n}) + ( \(n, v) -> (resolveConditions rc updateExeDeps v){exeName = n} ) exes , testSuites = map - (\(n, v) -> (resolveConditions rc (updateTestDeps modBuildable) v){testName=n}) + ( \(n, v) -> + (resolveConditions rc (updateTestDeps modBuildable) v){testName = n} + ) tests , benchmarks = map - (\(n, v) -> (resolveConditions rc (updateBenchmarkDeps modBuildable) v){benchmarkName=n}) + ( \(n, v) -> + (resolveConditions rc (updateBenchmarkDeps modBuildable) v) + {benchmarkName = n} + ) benches } From 99fd1356028e5b5d38d3bb87a198fa4a1f7c162c Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Mon, 13 Nov 2023 21:53:45 +0000 Subject: [PATCH 32/42] Reformatting, for consistency --- src/Stack/PackageFile.hs | 109 +++++++++++++++++++++------------------ 1 file changed, 59 insertions(+), 50 deletions(-) diff --git a/src/Stack/PackageFile.hs b/src/Stack/PackageFile.hs index 5db0aba97f..16a663348f 100644 --- a/src/Stack/PackageFile.hs +++ b/src/Stack/PackageFile.hs @@ -7,39 +7,35 @@ module Stack.PackageFile , stackPackageFileFromCabal ) where +import Data.Foldable ( Foldable (..) ) import qualified Data.Map.Strict as M import qualified Data.Set as S import Distribution.CabalSpecVersion ( CabalSpecVersion ) -import Distribution.PackageDescription - ( PackageDescription(dataFiles, extraSrcFiles, dataDir), - BuildType(Custom) ) +import qualified Distribution.PackageDescription as Cabal import Distribution.Simple.Glob ( matchDirFileGlob ) import Path ( parent, () ) import Path.Extra ( forgivingResolveFile, rejectMissingFile ) import Path.IO ( doesFileExist ) import Stack.ComponentFile - ( resolveOrWarn, ComponentFile (ComponentFile) - , stackLibraryFiles, stackExecutableFiles, stackBenchmarkFiles + ( ComponentFile (..), resolveOrWarn, stackBenchmarkFiles + , stackExecutableFiles, stackLibraryFiles ) import Stack.Constants ( relFileHpackPackageConfig, relFileSetupHs, relFileSetupLhs ) import Stack.Constants.Config ( distDirFromDir ) import Stack.Prelude +import Stack.Types.BuildConfig ( HasBuildConfig (..) ) import Stack.Types.CompilerPaths ( cabalVersionL ) -import Stack.Types.EnvConfig - ( HasEnvConfig (..) ) +import Stack.Types.EnvConfig ( HasEnvConfig (..) ) import Stack.Types.NamedComponent ( NamedComponent (..) ) +import Stack.Types.Package ( Package(..) ) import Stack.Types.PackageFile - ( GetPackageFileContext (..) - , StackPackageFile (StackPackageFile), PackageComponentFile (PackageComponentFile, packageExtraFile) + ( GetPackageFileContext (..), PackageComponentFile (..) + , StackPackageFile (..) ) import qualified System.FilePath as FilePath import System.IO.Error ( isUserError ) -import Stack.Types.BuildConfig - ( HasBuildConfig(buildConfigL) ) -import Stack.Types.Package (Package(..)) -import Data.Foldable (Foldable(..)) -- | Resolve the file, if it can't be resolved, warn for the user -- (purely to be helpful). @@ -60,20 +56,24 @@ packageDescModulesAndFiles pkg = do (packageCabalSpec pkg) (packageFile pkg) let initialValue = mempty{packageExtraFile=packageExtraFile} let accumulator f comp st = (insertComponentFile <$> st) <*> f comp - let gatherCompFileCollection createCompFileFn getCompFn res = foldr' (accumulator createCompFileFn) res (getCompFn pkg) + let gatherCompFileCollection createCompFileFn getCompFn res = + foldr' (accumulator createCompFileFn) res (getCompFn pkg) gatherCompFileCollection stackLibraryFiles packageLibrary - . gatherCompFileCollection stackLibraryFiles packageSubLibraries - . gatherCompFileCollection stackExecutableFiles packageExecutables - . gatherCompFileCollection stackBenchmarkFiles packageBenchmarkSuites $ pure initialValue + . gatherCompFileCollection stackLibraryFiles packageSubLibraries + . gatherCompFileCollection stackExecutableFiles packageExecutables + . gatherCompFileCollection stackBenchmarkFiles packageBenchmarkSuites + $ pure initialValue - -resolveGlobFilesFromStackPackageFile :: CabalSpecVersion -> StackPackageFile -> RIO GetPackageFileContext (Set (Path Abs File)) -resolveGlobFilesFromStackPackageFile csvV (StackPackageFile extraSrcFilesV dataDirV dataFilesV) = - resolveGlobFiles - csvV - ( extraSrcFilesV - ++ map (dataDirV FilePath.) dataFilesV - ) +resolveGlobFilesFromStackPackageFile :: + CabalSpecVersion + -> StackPackageFile + -> RIO GetPackageFileContext (Set (Path Abs File)) +resolveGlobFilesFromStackPackageFile + csvV + (StackPackageFile extraSrcFilesV dataDirV dataFilesV) + = resolveGlobFiles + csvV + (extraSrcFilesV ++ map (dataDirV FilePath.) dataFilesV) -- | Resolve globbing of files (e.g. data files) to absolute paths. resolveGlobFiles :: @@ -81,8 +81,7 @@ resolveGlobFiles :: -> [String] -> RIO GetPackageFileContext (Set (Path Abs File)) resolveGlobFiles cabalFileVersion = - fmap (S.fromList . catMaybes . concat) . - mapM resolve + fmap (S.fromList . catMaybes . concat) . mapM resolve where resolve name = if '*' `elem` name @@ -127,35 +126,45 @@ getPackageFile pkg cabalfp = (GetPackageFileContext cabalfp distDir bc cabalVer) (packageDescModulesAndFiles pkg) setupFiles <- - if packageBuildType pkg == Custom - then do - let setupHsPath = pkgDir relFileSetupHs - setupLhsPath = pkgDir relFileSetupLhs - setupHsExists <- doesFileExist setupHsPath - if setupHsExists - then pure (S.singleton setupHsPath) - else do - setupLhsExists <- doesFileExist setupLhsPath - if setupLhsExists - then pure (S.singleton setupLhsPath) - else pure S.empty - else pure S.empty + if packageBuildType pkg == Cabal.Custom + then do + let setupHsPath = pkgDir relFileSetupHs + setupLhsPath = pkgDir relFileSetupLhs + setupHsExists <- doesFileExist setupHsPath + if setupHsExists + then pure (S.singleton setupHsPath) + else do + setupLhsExists <- doesFileExist setupLhsPath + if setupLhsExists + then pure (S.singleton setupLhsPath) + else pure S.empty + else pure S.empty 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 - pure packageComponentFile{packageExtraFile = moreBuildFiles <> packageExtraFile packageComponentFile} + pure packageComponentFile + { packageExtraFile = + moreBuildFiles <> packageExtraFile packageComponentFile + } -stackPackageFileFromCabal :: PackageDescription -> StackPackageFile +stackPackageFileFromCabal :: Cabal.PackageDescription -> StackPackageFile stackPackageFileFromCabal cabalPkg = - StackPackageFile (extraSrcFiles cabalPkg) (dataDir cabalPkg) (dataFiles cabalPkg) + StackPackageFile + (Cabal.extraSrcFiles cabalPkg) + (Cabal.dataDir cabalPkg) + (Cabal.dataFiles cabalPkg) -insertComponentFile :: PackageComponentFile -> (NamedComponent, ComponentFile) -> PackageComponentFile +insertComponentFile :: + PackageComponentFile + -> (NamedComponent, ComponentFile) + -> PackageComponentFile insertComponentFile packageCompFile (name, compFile) = PackageComponentFile nCompFile nDotCollec packageExtraFile nWarnings - where - (ComponentFile moduleFileMap dotCabalFileList warningsCollec) = compFile - (PackageComponentFile modules files packageExtraFile warnings) = packageCompFile - nCompFile = M.insert name moduleFileMap modules - nDotCollec = M.insert name dotCabalFileList files - nWarnings = warningsCollec ++ warnings + where + (ComponentFile moduleFileMap dotCabalFileList warningsCollec) = compFile + (PackageComponentFile modules files packageExtraFile warnings) = + packageCompFile + nCompFile = M.insert name moduleFileMap modules + nDotCollec = M.insert name dotCabalFileList files + nWarnings = warningsCollec ++ warnings From ff21030895b95196a1e57ef8f4f2dac817011700 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Mon, 13 Nov 2023 21:57:45 +0000 Subject: [PATCH 33/42] Reformatting, for consistency --- src/Stack/Types/Dependency.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Stack/Types/Dependency.hs b/src/Stack/Types/Dependency.hs index 405dd3a911..3985b8871e 100644 --- a/src/Stack/Types/Dependency.hs +++ b/src/Stack/Types/Dependency.hs @@ -7,10 +7,10 @@ module Stack.Types.Dependency , cabalExeToStackDep ) where +import qualified Distribution.PackageDescription as Cabal import Distribution.Types.VersionRange ( VersionRange ) import Stack.Prelude import Stack.Types.Version ( intersectVersionRanges ) -import qualified Distribution.PackageDescription as Cabal -- | The value for a map from dependency name. This contains both the version -- range and the type of dependency, and provides a semigroup instance. @@ -36,6 +36,8 @@ instance Semigroup DepType where AsBuildTool <> x = x cabalToStackDep :: Cabal.Dependency -> DepValue -cabalToStackDep (Cabal.Dependency _ verRange _libNameSet) = DepValue{dvVersionRange = verRange, dvType=AsLibrary} +cabalToStackDep (Cabal.Dependency _ verRange _libNameSet) = + DepValue{dvVersionRange = verRange, dvType = AsLibrary} cabalExeToStackDep :: Cabal.ExeDependency -> DepValue -cabalExeToStackDep (Cabal.ExeDependency _ _name verRange) = DepValue{dvVersionRange = verRange, dvType=AsBuildTool} \ No newline at end of file +cabalExeToStackDep (Cabal.ExeDependency _ _name verRange) = + DepValue{dvVersionRange = verRange, dvType = AsBuildTool} From 84a5a4a11ecba522c7bd5062fcdf4a0e1fd7cfed Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Mon, 13 Nov 2023 22:04:25 +0000 Subject: [PATCH 34/42] Reformatting, for consistency --- src/Stack/Types/PackageFile.hs | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/src/Stack/Types/PackageFile.hs b/src/Stack/Types/PackageFile.hs index 5e847fc4c2..64b6a1c3ea 100644 --- a/src/Stack/Types/PackageFile.hs +++ b/src/Stack/Types/PackageFile.hs @@ -102,24 +102,26 @@ data PackageWarning -- ^ Modules not found in file system, which are listed in Cabal file -} --- | This is the information from cabal we need at the package level --- to track files. -data StackPackageFile = StackPackageFile { - -- specVersion :: CabalSpecVersion, --already in package info - extraSrcFiles :: [FilePath], - dataDir :: FilePath, - dataFiles :: [FilePath] -} deriving (Show, Typeable) +-- | This is the information from Cabal we need at the package level to track +-- files. +data StackPackageFile = StackPackageFile + { extraSrcFiles :: [FilePath] + , dataDir :: FilePath + , dataFiles :: [FilePath] + } + deriving (Show, Typeable) -- | Files that the package depends on, relative to package directory. -data PackageComponentFile = PackageComponentFile { - modulePathMap :: Map NamedComponent (Map ModuleName (Path Abs File)), - cabalFileMap :: !(Map NamedComponent [DotCabalPath]), - packageExtraFile :: Set (Path Abs File), - warnings :: [PackageWarning] -} +data PackageComponentFile = PackageComponentFile + { modulePathMap :: Map NamedComponent (Map ModuleName (Path Abs File)) + , cabalFileMap :: !(Map NamedComponent [DotCabalPath]) + , packageExtraFile :: Set (Path Abs File) + , warnings :: [PackageWarning] + } + instance Semigroup PackageComponentFile where PackageComponentFile x1 x2 x3 x4 <> PackageComponentFile y1 y2 y3 y4 = PackageComponentFile (x1 <> y1) (x2 <> y2) (x3 <> y3) (x4 <> y4) + instance Monoid PackageComponentFile where mempty = PackageComponentFile mempty mempty mempty mempty From 118531c669cb3b257b73af14460f057e69814145 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Mon, 13 Nov 2023 22:30:33 +0000 Subject: [PATCH 35/42] Add Haddock documentation --- src/Stack/Types/Package.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index d9f5917cfa..d058b7f2b5 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -171,12 +171,17 @@ data Package = Package , packageDefaultFlags :: !(Map FlagName Bool) -- ^ Defaults for unspecified flags. , packageLibrary :: !(Maybe StackLibrary) + -- ^ Does the package have a buildable main library stanza? , packageSubLibraries :: !(CompCollection StackLibrary) + -- ^ The sub-libraries of the package. , packageForeignLibraries :: !(CompCollection StackForeignLibrary) + -- ^ The foreign libraries of the package. , packageTestSuites :: !(CompCollection StackTest) + -- ^ The test suites of the package. , packageBenchmarkSuites :: !(CompCollection StackBenchmark) + -- ^ The benchmarks of the package. , packageExecutables :: !(CompCollection StackExecutable) - -- ^ does the package have a buildable library stanza? + -- ^ The executables of the package. , packageBuildType :: !BuildType -- ^ Package build-type. , packageSetupDeps :: !(Maybe (Map PackageName VersionRange)) From 52f170ff7569d815b8a3aa1c68932c5c00956f07 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Tue, 14 Nov 2023 20:20:21 +0000 Subject: [PATCH 36/42] Prefer `hasBuildableMainLibrary` to `hasMainBuildableLibrary` --- src/Stack/Build/ConstructPlan.hs | 4 ++-- src/Stack/Build/Execute.hs | 10 +++++----- src/Stack/Build/Source.hs | 4 ++-- src/Stack/Coverage.hs | 4 ++-- src/Stack/Ghci.hs | 4 ++-- src/Stack/Package.hs | 6 +++--- 6 files changed, 16 insertions(+), 16 deletions(-) diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index 1bba8e8548..56be6e768b 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -29,7 +29,7 @@ import Stack.Build.Haddock ( shouldHaddockDeps ) import Stack.Build.Source ( loadLocalPackage ) import Stack.Constants ( compilerOptionsCabalFlag ) import Stack.Package - ( applyForceCustomBuild, hasMainBuildableLibrary + ( applyForceCustomBuild, hasBuildableMainLibrary , packageExes, packageUnknownTools ) import Stack.Prelude hiding ( loadPackage ) @@ -1166,7 +1166,7 @@ addPackageDeps package = do -- make sure we consider sub-libraries as libraries too packageHasLibrary :: Package -> Bool packageHasLibrary p = - hasMainBuildableLibrary p || not (null (packageSubLibraries p)) + hasBuildableMainLibrary p || not (null (packageSubLibraries p)) checkDirtiness :: PackageSource diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index e7e603ff1a..53f42a57cd 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -126,7 +126,7 @@ import Stack.Coverage ) import Stack.GhcPkg ( ghcPkg, unregisterGhcPkgIds ) import Stack.Package - ( buildLogPath, hasMainBuildableLibrary + ( buildLogPath, hasBuildableMainLibrary , mainLibraryHasExposedModules, packageExes , packageSubLibrariesNameSet ) @@ -1757,7 +1757,7 @@ singleBuild (hasLib, hasSubLib, hasExe) = case taskType of TTLocalMutable lp -> let package = lpPackage lp - hasLibrary = hasMainBuildableLibrary package + hasLibrary = hasBuildableMainLibrary package hasSubLibraries = not . null $ packageSubLibraries package hasExecutables = not . Set.null $ exesToBuild executableBuildStatuses lp @@ -2044,7 +2044,7 @@ singleBuild cabal0 keep KeepTHLoading $ "haddock" : args - let hasLibrary = hasMainBuildableLibrary package + let hasLibrary = hasBuildableMainLibrary package hasSubLibraries = not $ null $ packageSubLibraries package hasExecutables = not $ null $ packageExecutables package shouldCopy = @@ -2095,7 +2095,7 @@ singleBuild let ident = PackageIdentifier (packageName package) (packageVersion package) -- only pure the sub-libraries to cache them if we also cache the main -- library (that is, if it exists) - (mpkgid, subLibsPkgIds) <- if hasMainBuildableLibrary package + (mpkgid, subLibsPkgIds) <- if hasBuildableMainLibrary package then do subLibsPkgIds <- fmap catMaybes $ forM (getBuildableListText $ packageSubLibraries package) $ \subLib -> do @@ -2702,7 +2702,7 @@ primaryComponentOptions :: primaryComponentOptions executableBuildStatuses lp = -- TODO: get this information from target parsing instead, which will allow -- users to turn off library building if desired - ( if hasMainBuildableLibrary package + ( if hasBuildableMainLibrary package then map T.unpack $ T.append "lib:" (T.pack (packageNameString (packageName package))) : map diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index e2d5b006f5..a5bec0ce72 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -25,7 +25,7 @@ import qualified Pantry.SHA256 as SHA256 import Stack.Build.Cache ( tryGetBuildCache ) import Stack.Build.Haddock ( shouldHaddockDeps ) import Stack.Package - ( hasMainBuildableLibrary, packageBenchmarks, packageExes + ( hasBuildableMainLibrary, packageBenchmarks, packageExes , resolvePackage ) import Stack.PackageFile ( getPackageFile ) @@ -340,7 +340,7 @@ loadLocalPackage pp = do -- individual executables or library") is resolved, 'hasLibrary' is only -- relevant if the library is part of the target spec. Just _ -> - hasMainBuildableLibrary pkg + hasBuildableMainLibrary pkg || not (Set.null nonLibComponents) || not (null $ packageSubLibraries pkg) diff --git a/src/Stack/Coverage.hs b/src/Stack/Coverage.hs index 6bd950a2e3..f051538f9f 100644 --- a/src/Stack/Coverage.hs +++ b/src/Stack/Coverage.hs @@ -40,7 +40,7 @@ import Stack.Constants , relFileHpcIndexHtml, relFileIndexHtml ) import Stack.Constants.Config ( distDirFromDir, hpcRelativeDir ) -import Stack.Package ( hasMainBuildableLibrary ) +import Stack.Package ( hasBuildableMainLibrary ) import Stack.Prelude import Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig ) import Stack.Types.BuildConfig @@ -182,7 +182,7 @@ generateHpcReport pkgDir package tests = do let pkgId = packageIdentifierString (packageIdentifier package) pkgName' = packageNameString $ packageName package ghcVersion = getGhcVersion compilerVersion - hasLibrary = hasMainBuildableLibrary package + hasLibrary = hasBuildableMainLibrary package subLibs = packageSubLibraries package eincludeName <- -- Pre-7.8 uses plain PKG-version in tix files. diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index c6d8bcb805..67b59edda2 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -48,7 +48,7 @@ import Stack.Ghci.Script , scriptToLazyByteString ) import Stack.Package - ( PackageDescriptionPair (..), hasMainBuildableLibrary + ( PackageDescriptionPair (..), hasBuildableMainLibrary , getPackageOpts, packageExes, packageFromPackageDescription , readDotBuildinfo, resolvePackageDescription ) @@ -960,7 +960,7 @@ makeGhciPkgInfo installMap installedMap locals addPkgs mfileTargets pkgDesc = do wantedPackageComponents :: BuildOpts -> Target -> Package -> Set NamedComponent wantedPackageComponents _ (TargetComps cs) _ = cs wantedPackageComponents bopts (TargetAll PTProject) pkg = S.fromList $ - ( if hasMainBuildableLibrary pkg + ( if hasBuildableMainLibrary pkg then CLib : map CSubLib buildableForeignLibs else [] ) diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 0bd44d55cf..a375e2bd60 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -17,7 +17,7 @@ module Stack.Package , resolvePackageDescription , packageDependencies , applyForceCustomBuild - , hasMainBuildableLibrary + , hasBuildableMainLibrary , mainLibraryHasExposedModules , packageUnknownTools , packageSubLibrariesNameSet @@ -812,8 +812,8 @@ applyForceCustomBuild cabalVersion package && not (cabalVersion `withinRange` cabalVersionRange) -- | Check if the package has a main library that is buildable. -hasMainBuildableLibrary :: Package -> Bool -hasMainBuildableLibrary package = +hasBuildableMainLibrary :: Package -> Bool +hasBuildableMainLibrary package = maybe False isComponentBuildable $ packageLibrary package -- | Check if the main library has any exposed modules. From 925a6e6aef68a916be8cbc4d40c95e6990e596ce Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Tue, 14 Nov 2023 20:31:41 +0000 Subject: [PATCH 37/42] Prefer `packageBenchmarks` for field, and `buildableBenchmarks` --- src/Stack/Build/Source.hs | 6 +++--- src/Stack/Ghci.hs | 2 +- src/Stack/Package.hs | 12 ++++++------ src/Stack/PackageFile.hs | 2 +- src/Stack/Types/Package.hs | 2 +- 5 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index a5bec0ce72..155a90af9f 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -25,7 +25,7 @@ import qualified Pantry.SHA256 as SHA256 import Stack.Build.Cache ( tryGetBuildCache ) import Stack.Build.Haddock ( shouldHaddockDeps ) import Stack.Package - ( hasBuildableMainLibrary, packageBenchmarks, packageExes + ( buildableBenchmarks, hasBuildableMainLibrary, packageExes , resolvePackage ) import Stack.PackageFile ( getPackageFile ) @@ -328,7 +328,7 @@ loadLocalPackage pp = do True (Set.notMember name . curatorSkipBenchmark) mcurator - then packageBenchmarks pkg + then buildableBenchmarks pkg else Set.empty ) Nothing -> mempty @@ -425,7 +425,7 @@ loadLocalPackage pp = do , lpUnbuildable = toComponents (exes `Set.difference` packageExes pkg) (tests `Set.difference` getBuildableSetText (packageTestSuites pkg)) - (benches `Set.difference` packageBenchmarks pkg) + (benches `Set.difference` buildableBenchmarks pkg) } -- | Compare the current filesystem state to the cached information, and diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index 67b59edda2..3bfb8a8da4 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -972,7 +972,7 @@ wantedPackageComponents bopts (TargetAll PTProject) pkg = S.fromList $ buildableForeignLibs = getBuildableListText $ packageForeignLibraries pkg buildableSubLibs = getBuildableListText $ packageSubLibraries pkg buildableTestSuites = getBuildableListText $ packageTestSuites pkg - buildableBenchmarks = getBuildableListText $ packageBenchmarkSuites pkg + buildableBenchmarks = getBuildableListText $ packageBenchmarks pkg wantedPackageComponents _ _ _ = S.empty checkForIssues :: HasTerm env => [GhciPkgInfo] -> RIO env () diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index a375e2bd60..bd3a755eb2 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -22,7 +22,7 @@ module Stack.Package , packageUnknownTools , packageSubLibrariesNameSet , packageExes - , packageBenchmarks + , buildableBenchmarks , getPackageOpts ) where @@ -151,7 +151,7 @@ packageFromPackageDescription foldAndMakeCollection stackForeignLibraryFromCabal $ foreignLibs pkg , packageTestSuites = foldAndMakeCollection stackTestFromCabal $ testSuites pkgNoMod - , packageBenchmarkSuites = + , packageBenchmarks = foldAndMakeCollection stackBenchmarkFromCabal $ benchmarks pkgNoMod , packageExecutables = foldAndMakeCollection stackExecutableFromCabal $ executables pkg @@ -325,7 +325,7 @@ generatePkgDescOpts makeBuildInfoOpts packageLibrary (const CLib) . makeBuildInfoOpts packageSubLibraries CSubLib . makeBuildInfoOpts packageExecutables CExe - . makeBuildInfoOpts packageBenchmarkSuites CBench + . makeBuildInfoOpts packageBenchmarks CBench . makeBuildInfoOpts packageTestSuites CTest pure $ aggregateAllBuildInfoOpts mempty where @@ -835,7 +835,7 @@ packageUnknownTools pkg = lib (bench <> tests <> flib <> sublib <> exe) lib setT = case packageLibrary pkg of Just libV -> addUnknownTools libV setT Nothing -> setT - bench = gatherUnknownTools $ packageBenchmarkSuites pkg + bench = gatherUnknownTools $ packageBenchmarks pkg tests = gatherUnknownTools $ packageTestSuites pkg flib = gatherUnknownTools $ packageForeignLibraries pkg sublib = gatherUnknownTools $ packageSubLibraries pkg @@ -851,5 +851,5 @@ packageSubLibrariesNameSet pkg = getBuildableSetText (packageSubLibraries pkg) packageExes :: Package -> Set Text packageExes pkg = getBuildableSetText (packageExecutables pkg) -packageBenchmarks :: Package -> Set Text -packageBenchmarks pkg = getBuildableSetText (packageBenchmarkSuites pkg) +buildableBenchmarks :: Package -> Set Text +buildableBenchmarks pkg = getBuildableSetText (packageBenchmarks pkg) diff --git a/src/Stack/PackageFile.hs b/src/Stack/PackageFile.hs index 16a663348f..a7234967be 100644 --- a/src/Stack/PackageFile.hs +++ b/src/Stack/PackageFile.hs @@ -61,7 +61,7 @@ packageDescModulesAndFiles pkg = do gatherCompFileCollection stackLibraryFiles packageLibrary . gatherCompFileCollection stackLibraryFiles packageSubLibraries . gatherCompFileCollection stackExecutableFiles packageExecutables - . gatherCompFileCollection stackBenchmarkFiles packageBenchmarkSuites + . gatherCompFileCollection stackBenchmarkFiles packageBenchmarks $ pure initialValue resolveGlobFilesFromStackPackageFile :: diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index d058b7f2b5..058ab582a2 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -178,7 +178,7 @@ data Package = Package -- ^ The foreign libraries of the package. , packageTestSuites :: !(CompCollection StackTest) -- ^ The test suites of the package. - , packageBenchmarkSuites :: !(CompCollection StackBenchmark) + , packageBenchmarks :: !(CompCollection StackBenchmark) -- ^ The benchmarks of the package. , packageExecutables :: !(CompCollection StackExecutable) -- ^ The executables of the package. From c64510f5e4150a3f5e2bf4d0d83a7d1d465e7e7a Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Tue, 14 Nov 2023 20:43:07 +0000 Subject: [PATCH 38/42] Prefer `buildableExes` to `packageExes` --- src/Stack/Build.hs | 4 ++-- src/Stack/Build/ConstructPlan.hs | 6 +++--- src/Stack/Build/Execute.hs | 11 +++++------ src/Stack/Build/Source.hs | 6 +++--- src/Stack/Ghci.hs | 9 +++++---- src/Stack/Package.hs | 6 +++--- 6 files changed, 21 insertions(+), 21 deletions(-) diff --git a/src/Stack/Build.hs b/src/Stack/Build.hs index 12367a0583..dc7338f50f 100644 --- a/src/Stack/Build.hs +++ b/src/Stack/Build.hs @@ -30,7 +30,7 @@ import Stack.Build.Installed ( getInstalled, toInstallMap ) import Stack.Build.Source ( localDependencies, projectLocalPackages ) import Stack.Build.Target ( NeedTargets (..) ) import Stack.FileWatch ( fileWatch, fileWatchPoll ) -import Stack.Package ( packageExes, resolvePackage ) +import Stack.Package ( buildableExes, resolvePackage ) import Stack.Prelude hiding ( loadPackage ) import Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig ) import Stack.Setup ( withNewLocalBuildTargets ) @@ -297,7 +297,7 @@ warnIfExecutablesWithSameNameCouldBeOverwritten locals plan = do collect [ (exe, packageName pkg) | pkg <- map lpPackage locals - , exe <- Set.toList (packageExes pkg) + , exe <- Set.toList (buildableExes pkg) ] collect :: Ord k => [(k, v)] -> Map k (NonEmpty v) collect = Map.mapMaybe nonEmpty . Map.fromDistinctAscList . groupSort diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index 56be6e768b..7d8281e2aa 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -29,8 +29,8 @@ import Stack.Build.Haddock ( shouldHaddockDeps ) import Stack.Build.Source ( loadLocalPackage ) import Stack.Constants ( compilerOptionsCabalFlag ) import Stack.Package - ( applyForceCustomBuild, hasBuildableMainLibrary - , packageExes, packageUnknownTools + ( applyForceCustomBuild, buildableExes + , hasBuildableMainLibrary, packageUnknownTools ) import Stack.Prelude hiding ( loadPackage ) import Stack.SourceMap ( getPLIVersion, mkProjectPackage ) @@ -803,7 +803,7 @@ tellExecutablesPackage loc p = do tell mempty { wInstall = Map.fromList $ - map (, loc) $ Set.toList $ filterComps myComps $ packageExes p + map (, loc) $ Set.toList $ filterComps myComps $ buildableExes p } where filterComps myComps x diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 53f42a57cd..365e91f074 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -126,9 +126,8 @@ import Stack.Coverage ) import Stack.GhcPkg ( ghcPkg, unregisterGhcPkgIds ) import Stack.Package - ( buildLogPath, hasBuildableMainLibrary - , mainLibraryHasExposedModules, packageExes - , packageSubLibrariesNameSet + ( buildLogPath, buildableExes, hasBuildableMainLibrary + , mainLibraryHasExposedModules, packageSubLibrariesNameSet ) import Stack.PackageDump ( conduitDumpPackage, ghcPkgDescribe ) import Stack.Prelude @@ -2128,7 +2127,7 @@ singleBuild (configCacheHaddock cache) mpkgid subLibsPkgIds - (packageExes package) + (buildableExes package) _ -> pure () case taskType of @@ -2176,7 +2175,7 @@ getExecutableBuildStatuses package pkgDir = do platform <- view platformL fmap Map.fromList - (mapM (checkExeStatus platform distDir) (Set.toList (packageExes package))) + (mapM (checkExeStatus platform distDir) (Set.toList (buildableExes package))) -- | Check whether the given executable is defined in the given dist directory. checkExeStatus :: @@ -2735,7 +2734,7 @@ exesToBuild :: Map Text ExecutableBuildStatus -> LocalPackage -> Set Text exesToBuild executableBuildStatuses lp = if cabalIsSatisfied executableBuildStatuses && lpWanted lp then exeComponents (lpComponents lp) - else packageExes (lpPackage lp) + else buildableExes (lpPackage lp) -- | Do the current executables satisfy Cabal's bugged out requirements? cabalIsSatisfied :: Map k ExecutableBuildStatus -> Bool diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index 155a90af9f..bf4919c27a 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -25,7 +25,7 @@ import qualified Pantry.SHA256 as SHA256 import Stack.Build.Cache ( tryGetBuildCache ) import Stack.Build.Haddock ( shouldHaddockDeps ) import Stack.Package - ( buildableBenchmarks, hasBuildableMainLibrary, packageExes + ( buildableBenchmarks, buildableExes, hasBuildableMainLibrary , resolvePackage ) import Stack.PackageFile ( getPackageFile ) @@ -318,7 +318,7 @@ loadLocalPackage pp = do let (_s, e, t, b) = splitComponents $ Set.toList comps in (e, t, b) Just (TargetAll _packageType) -> - ( packageExes pkg + ( buildableExes pkg , if boptsTests bopts && maybe True (Set.notMember name . curatorSkipTest) mcurator then getBuildableSetText (packageTestSuites pkg) @@ -423,7 +423,7 @@ loadLocalPackage pp = do -- through component parsing, but the components aren't present, then they -- must not be buildable. , lpUnbuildable = toComponents - (exes `Set.difference` packageExes pkg) + (exes `Set.difference` buildableExes pkg) (tests `Set.difference` getBuildableSetText (packageTestSuites pkg)) (benches `Set.difference` buildableBenchmarks pkg) } diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index 3bfb8a8da4..5227e97941 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -48,9 +48,10 @@ import Stack.Ghci.Script , scriptToLazyByteString ) import Stack.Package - ( PackageDescriptionPair (..), hasBuildableMainLibrary - , getPackageOpts, packageExes, packageFromPackageDescription - , readDotBuildinfo, resolvePackageDescription + ( PackageDescriptionPair (..), buildableExes + , hasBuildableMainLibrary, getPackageOpts + , packageFromPackageDescription, readDotBuildinfo + , resolvePackageDescription ) import Stack.PackageFile ( getPackageFile ) import Stack.Prelude @@ -964,7 +965,7 @@ wantedPackageComponents bopts (TargetAll PTProject) pkg = S.fromList $ then CLib : map CSubLib buildableForeignLibs else [] ) - <> map CExe (S.toList (packageExes pkg)) + <> map CExe (S.toList (buildableExes pkg)) <> map CSubLib buildableSubLibs <> (if boptsTests bopts then map CTest buildableTestSuites else []) <> (if boptsBenchmarks bopts then map CBench buildableBenchmarks else []) diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index bd3a755eb2..b299ea7313 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -21,7 +21,7 @@ module Stack.Package , mainLibraryHasExposedModules , packageUnknownTools , packageSubLibrariesNameSet - , packageExes + , buildableExes , buildableBenchmarks , getPackageOpts ) where @@ -848,8 +848,8 @@ packageUnknownTools pkg = lib (bench <> tests <> flib <> sublib <> exe) packageSubLibrariesNameSet :: Package -> Set Text packageSubLibrariesNameSet pkg = getBuildableSetText (packageSubLibraries pkg) -packageExes :: Package -> Set Text -packageExes pkg = getBuildableSetText (packageExecutables pkg) +buildableExes :: Package -> Set Text +buildableExes pkg = getBuildableSetText (packageExecutables pkg) buildableBenchmarks :: Package -> Set Text buildableBenchmarks pkg = getBuildableSetText (packageBenchmarks pkg) From 2c5c099bd116aa56653a0bdb3df472c4e6126ffb Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Tue, 14 Nov 2023 20:48:27 +0000 Subject: [PATCH 39/42] Prefer `buildableSubLibs` to `packageSubLibrariesNameSet` --- src/Stack/Build/Execute.hs | 6 +++--- src/Stack/Package.hs | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 365e91f074..c9099db537 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -126,8 +126,8 @@ import Stack.Coverage ) import Stack.GhcPkg ( ghcPkg, unregisterGhcPkgIds ) import Stack.Package - ( buildLogPath, buildableExes, hasBuildableMainLibrary - , mainLibraryHasExposedModules, packageSubLibrariesNameSet + ( buildLogPath, buildableExes, buildableSubLibs + , hasBuildableMainLibrary, mainLibraryHasExposedModules ) import Stack.PackageDump ( conduitDumpPackage, ghcPkgDescribe ) import Stack.Prelude @@ -1802,7 +1802,7 @@ singleBuild -- However, we must unregister any such library in the new snapshot, in case -- it was built with different flags. let - subLibNames = Set.toList $ packageSubLibrariesNameSet $ case taskType of + subLibNames = Set.toList $ buildableSubLibs $ case taskType of TTLocalMutable lp -> lpPackage lp TTRemotePackage _ p _ -> p toMungedPackageId :: Text -> MungedPackageId diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index b299ea7313..939aa2d7f3 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -20,7 +20,7 @@ module Stack.Package , hasBuildableMainLibrary , mainLibraryHasExposedModules , packageUnknownTools - , packageSubLibrariesNameSet + , buildableSubLibs , buildableExes , buildableBenchmarks , getPackageOpts @@ -845,8 +845,8 @@ packageUnknownTools pkg = lib (bench <> tests <> flib <> sublib <> exe) gatherUnknownTools :: HasBuildInfo x => CompCollection x -> Set Text gatherUnknownTools = foldr' addUnknownTools mempty -packageSubLibrariesNameSet :: Package -> Set Text -packageSubLibrariesNameSet pkg = getBuildableSetText (packageSubLibraries pkg) +buildableSubLibs :: Package -> Set Text +buildableSubLibs pkg = getBuildableSetText (packageSubLibraries pkg) buildableExes :: Package -> Set Text buildableExes pkg = getBuildableSetText (packageExecutables pkg) From d63ac92555d86375ae1e2aa4b78b30795339ef57 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Tue, 14 Nov 2023 21:01:40 +0000 Subject: [PATCH 40/42] Introduce `Stack.Package.buildableTestSuites` --- src/Stack/Build/Source.hs | 9 ++++----- src/Stack/Package.hs | 4 ++++ 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index bf4919c27a..0a33756fb8 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -25,8 +25,8 @@ import qualified Pantry.SHA256 as SHA256 import Stack.Build.Cache ( tryGetBuildCache ) import Stack.Build.Haddock ( shouldHaddockDeps ) import Stack.Package - ( buildableBenchmarks, buildableExes, hasBuildableMainLibrary - , resolvePackage + ( buildableBenchmarks, buildableExes, buildableTestSuites + , hasBuildableMainLibrary, resolvePackage ) import Stack.PackageFile ( getPackageFile ) import Stack.Prelude @@ -44,7 +44,6 @@ import Stack.Types.BuildOpts , TestOpts (..), boptsCLIAllProgOptions ) import Stack.Types.CabalConfigKey ( CabalConfigKey (..) ) -import Stack.Types.CompCollection ( getBuildableSetText ) import Stack.Types.CompilerPaths ( HasCompiler, getCompilerPath ) import Stack.Types.Config ( Config (..), HasConfig (..), buildOptsL ) import Stack.Types.Curator ( Curator (..) ) @@ -321,7 +320,7 @@ loadLocalPackage pp = do ( buildableExes pkg , if boptsTests bopts && maybe True (Set.notMember name . curatorSkipTest) mcurator - then getBuildableSetText (packageTestSuites pkg) + then buildableTestSuites pkg else Set.empty , if boptsBenchmarks bopts && maybe @@ -424,7 +423,7 @@ loadLocalPackage pp = do -- must not be buildable. , lpUnbuildable = toComponents (exes `Set.difference` buildableExes pkg) - (tests `Set.difference` getBuildableSetText (packageTestSuites pkg)) + (tests `Set.difference` buildableTestSuites pkg) (benches `Set.difference` buildableBenchmarks pkg) } diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 939aa2d7f3..f66dc6b3fa 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -22,6 +22,7 @@ module Stack.Package , packageUnknownTools , buildableSubLibs , buildableExes + , buildableTestSuites , buildableBenchmarks , getPackageOpts ) where @@ -851,5 +852,8 @@ buildableSubLibs pkg = getBuildableSetText (packageSubLibraries pkg) buildableExes :: Package -> Set Text buildableExes pkg = getBuildableSetText (packageExecutables pkg) +buildableTestSuites :: Package -> Set Text +buildableTestSuites pkg = getBuildableSetText (packageTestSuites pkg) + buildableBenchmarks :: Package -> Set Text buildableBenchmarks pkg = getBuildableSetText (packageBenchmarks pkg) From 82266a8b7573e73e9ec86db9e1f527e36aec93f4 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Tue, 14 Nov 2023 21:26:08 +0000 Subject: [PATCH 41/42] Introduce `Stack.Package.buildableForeignLibs` --- src/Stack/Ghci.hs | 13 +++++++------ src/Stack/Package.hs | 4 ++++ 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index 5227e97941..ceaad19b7d 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -49,9 +49,9 @@ import Stack.Ghci.Script ) import Stack.Package ( PackageDescriptionPair (..), buildableExes - , hasBuildableMainLibrary, getPackageOpts - , packageFromPackageDescription, readDotBuildinfo - , resolvePackageDescription + , buildableForeignLibs, hasBuildableMainLibrary + , getPackageOpts, packageFromPackageDescription + , readDotBuildinfo, resolvePackageDescription ) import Stack.PackageFile ( getPackageFile ) import Stack.Prelude @@ -962,16 +962,17 @@ wantedPackageComponents :: BuildOpts -> Target -> Package -> Set NamedComponent wantedPackageComponents _ (TargetComps cs) _ = cs wantedPackageComponents bopts (TargetAll PTProject) pkg = S.fromList $ ( if hasBuildableMainLibrary pkg - then CLib : map CSubLib buildableForeignLibs + then CLib : map CSubLib buildableForeignLibs' else [] ) - <> map CExe (S.toList (buildableExes pkg)) + <> map CExe buildableExes' <> map CSubLib buildableSubLibs <> (if boptsTests bopts then map CTest buildableTestSuites else []) <> (if boptsBenchmarks bopts then map CBench buildableBenchmarks else []) where - buildableForeignLibs = getBuildableListText $ packageForeignLibraries pkg + buildableForeignLibs' = S.toList $ buildableForeignLibs pkg buildableSubLibs = getBuildableListText $ packageSubLibraries pkg + buildableExes' = S.toList $ buildableExes pkg buildableTestSuites = getBuildableListText $ packageTestSuites pkg buildableBenchmarks = getBuildableListText $ packageBenchmarks pkg wantedPackageComponents _ _ _ = S.empty diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index f66dc6b3fa..06a3332dfd 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -20,6 +20,7 @@ module Stack.Package , hasBuildableMainLibrary , mainLibraryHasExposedModules , packageUnknownTools + , buildableForeignLibs , buildableSubLibs , buildableExes , buildableTestSuites @@ -846,6 +847,9 @@ packageUnknownTools pkg = lib (bench <> tests <> flib <> sublib <> exe) gatherUnknownTools :: HasBuildInfo x => CompCollection x -> Set Text gatherUnknownTools = foldr' addUnknownTools mempty +buildableForeignLibs :: Package -> Set Text +buildableForeignLibs pkg = getBuildableSetText (packageForeignLibraries pkg) + buildableSubLibs :: Package -> Set Text buildableSubLibs pkg = getBuildableSetText (packageSubLibraries pkg) From 85cc8f9ee912a7bed6b2afb0b223a0263cdc9d46 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Tue, 14 Nov 2023 21:34:51 +0000 Subject: [PATCH 42/42] Update ignored Stan observations for code changes --- .stan.toml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.stan.toml b/.stan.toml index 50116eb123..99909c5b33 100644 --- a/.stan.toml +++ b/.stan.toml @@ -52,7 +52,7 @@ # Anti-pattern: Data.ByteString.Char8.pack [[ignore]] - id = "OBS-STAN-0203-fki0nd-1120:21" + id = "OBS-STAN-0203-fki0nd-1119:21" # ✦ Description: Usage of 'pack' function that doesn't handle Unicode characters # ✦ Category: #AntiPattern # ✦ File: src\Stack\Build\Execute.hs @@ -63,7 +63,7 @@ # Anti-pattern: Data.ByteString.Char8.pack [[ignore]] - id = "OBS-STAN-0203-fki0nd-2662:3" + id = "OBS-STAN-0203-fki0nd-2661:3" # ✦ Description: Usage of 'pack' function that doesn't handle Unicode characters # ✦ Category: #AntiPattern # ✦ File: src\Stack\Build\Execute.hs