From de5211a8a9aaaea725e8315d07dcc14517e22644 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 30 Apr 2026 08:58:33 -0400 Subject: [PATCH 1/2] Move ProjectConfigSkeleton to new Import module - Move fetchImportConfig to Import module - Move fetchImportParse to Import module - Nest fetchImportConfig within fetchImportParse - Move cyclicalImportMsg to cabal-install - Move untrimmedUriImportMsg to cabal-install - Move docProjectConfigFiles to cabal-install - Add compareLexically & compareSegmentally - Update hops test expectation for lexical sort - Remove +legacy-comparison - Satisfy fourmolu - Add change log entry - s/lexically/lexicographically/ - s/fetchImportParse/fetchImport/ --- .../Solver/Types/ProjectConfigPath.hs | 161 ++++++++---------- cabal-install/cabal-install.cabal | 1 + .../src/Distribution/Client/ProjectConfig.hs | 1 + .../Client/ProjectConfig/Import.hs | 147 ++++++++++++++++ .../Client/ProjectConfig/Legacy.hs | 44 +---- .../Client/ProjectConfig/Parsec.hs | 36 +--- .../Distribution/Client/ProjectPlanning.hs | 1 + .../src/Distribution/Client/ScriptUtils.hs | 4 +- .../ConditionalAndImport/hops.expect.txt | 26 +-- cabal.validate.project | 2 +- changelog.d/pr11773 | 10 ++ 11 files changed, 268 insertions(+), 165 deletions(-) create mode 100644 cabal-install/src/Distribution/Client/ProjectConfig/Import.hs create mode 100644 changelog.d/pr11773 diff --git a/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs b/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs index 68c7346208b..af377bc6f0a 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs @@ -5,6 +5,8 @@ module Distribution.Solver.Types.ProjectConfigPath ( -- * Project Config Path Manipulation ProjectConfigPath(..) + , compareLexicographically + , compareSegmentally , projectConfigPathRoot , nullProjectConfigPath , consProjectConfigPath @@ -14,9 +16,6 @@ module Distribution.Solver.Types.ProjectConfigPath -- * Messages , docProjectConfigPath , docProjectImportedBy - , docProjectConfigFiles - , cyclicalImportMsg - , untrimmedUriImportMsg , docProjectConfigPathFailReason , quoteUntrimmed @@ -44,7 +43,6 @@ import Distribution.Solver.Modular.Version (VR) import Distribution.Pretty (prettyShow, Pretty(..)) import Distribution.Utils.String (trim) import Text.PrettyPrint -import Distribution.Simple.Utils (ordNub) import Distribution.System (OS(Windows), buildOS) -- | Path to a configuration file, either a singleton project root, or a longer @@ -59,10 +57,10 @@ import Distribution.System (OS(Windows), buildOS) -- List elements are relative to each other but once canonicalized, elements are -- relative to the directory of the project root. newtype ProjectConfigPath = ProjectConfigPath (NonEmpty FilePath) - deriving (Eq, Show, Generic) + deriving (Eq, Generic) -instance Pretty ProjectConfigPath where - pretty = docProjectConfigPath +instance Pretty ProjectConfigPath where pretty = docProjectConfigPath +instance Show ProjectConfigPath where show = prettyShow -- | Sorts URIs after local file paths and longer file paths after shorter ones -- as measured by the number of path segments. If still equal, then sorting is @@ -79,43 +77,91 @@ instance Pretty ProjectConfigPath where -- >>> let abBwd = ProjectConfigPath $ "a\\b.config" :| [] -- >>> compare abFwd abBwd -- EQ +-- +-- >>> let abc = ProjectConfigPath $ "a/b/c.config" :| [] +-- >>> let yz = ProjectConfigPath $ "y/z.config" :| [] +-- >>> (compare abc yz, let xs = [abc, yz] in xs == sort xs) +-- (GT,False) +-- +-- >>> let abc = ProjectConfigPath $ "C.config" :| ["B.config", "A.project"] +-- >>> let bcd = ProjectConfigPath $ "D.config" :| ["C.config", "B.project"] +-- >>> (compare abc bcd, let xs = [abc, bcd] in xs == sort xs) +-- (LT,True) +-- +-- >>> let abc = ProjectConfigPath $ "C.config" :| ["B.config", "A.project"] +-- >>> let yz = ProjectConfigPath $ "Z.config" :| ["Y.project"] +-- >>> (compare abc yz, let xs = [abc, yz] in xs == sort xs) +-- (GT,False) instance Ord ProjectConfigPath where - compare pa@(ProjectConfigPath (NE.toList -> as)) pb@(ProjectConfigPath (NE.toList -> bs)) = + compare = compareSegmentally + +-- | A comparison that puts projects first, URLs last and sorts the other paths +-- lexically. +compareLexicographically :: ProjectConfigPath -> ProjectConfigPath -> Ordering +compareLexicographically (ProjectConfigPath as) (ProjectConfigPath bs) = + case (as, bs) of + -- Single element paths are projects, they should always sort first. + (a :| [], b :| []) -> compare (splitPath a) (splitPath b) + (_ :| [], _) -> LT + (_, _ :| []) -> GT + + (a :| aImporters, b :| bImporters) -> case (parseAbsoluteURI a, parseAbsoluteURI b) of + (Just ua, Just ub) -> compare ua ub P.<> compare aImporters bImporters + (Just _, Nothing) -> GT + (Nothing, Just _) -> LT + (Nothing, Nothing) -> compare (splitPath a) (splitPath b) P.<> compare aImporters bImporters + +-- | A comparison that puts projects first, URLs last and sorts the other paths +-- by putting longer paths after shorter ones as measured by the number of path +-- segments. If still equal, then sorting is lexical. +compareSegmentally:: ProjectConfigPath -> ProjectConfigPath -> Ordering +compareSegmentally pa@(ProjectConfigPath as) pb@(ProjectConfigPath bs) = case (as, bs) of -- There should only ever be one root project path, only one path -- with length 1. Comparing it to itself should be EQ. Don't assume -- this though, do a comparison anyway when both sides have length -- 1. The root path, the project itself, should always be the first -- path in a sorted listing. - ([a], [b]) -> compare (splitPath a) (splitPath b) - ([_], _) -> LT - (_, [_]) -> GT + (a :| [], b :| []) -> + let aPaths = splitPath a + bPaths = splitPath b + in + compare (length aPaths) (length bPaths) + P.<> compare aPaths bPaths + + (_ :| [], _) -> LT + (_, _ :| []) -> GT - (a:_, b:_) -> case (parseAbsoluteURI a, parseAbsoluteURI b) of + (a :| _, b :| _) -> case (parseAbsoluteURI a, parseAbsoluteURI b) of (Just ua, Just ub) -> compare ua ub P.<> compare aImporters bImporters (Just _, Nothing) -> GT (Nothing, Just _) -> LT - (Nothing, Nothing) -> compare (splitPath a) (splitPath b) P.<> compare aImporters bImporters - _ -> - compare (length as) (length bs) - P.<> compare (length aPaths) (length bPaths) - P.<> compare aPaths bPaths + (Nothing, Nothing) -> + let aPaths = splitPath a + bPaths = splitPath b + in + compare (length as) (length bs) + P.<> compare asPaths bsPaths + P.<> compare (length aPaths) (length bPaths) + P.<> compare aPaths bPaths + P.<> compare aImporters bImporters where - splitPath = FP.splitPath . normSep where - normSep p = - if buildOS == Windows - then - Windows.joinPath $ Windows.splitDirectories - [if Posix.isPathSeparator c then Windows.pathSeparator else c| c <- p] - else - Posix.joinPath $ Posix.splitDirectories - [if Windows.isPathSeparator c then Posix.pathSeparator else c| c <- p] - - aPaths = splitPath <$> as - bPaths = splitPath <$> bs + asPaths = splitPath <$> as + bsPaths = splitPath <$> bs aImporters = snd $ unconsProjectConfigPath pa bImporters = snd $ unconsProjectConfigPath pb +splitPath :: FilePath -> [FilePath] +splitPath = FP.splitPath . normSep + where + normSep p = + if buildOS == Windows then + Windows.joinPath $ Windows.splitDirectories + [if Posix.isPathSeparator c then Windows.pathSeparator else c| c <- p] + else + Posix.joinPath $ Posix.splitDirectories + [if Windows.isPathSeparator c then Posix.pathSeparator else c| c <- p] + instance Binary ProjectConfigPath instance NFData ProjectConfigPath instance Structured ProjectConfigPath @@ -140,67 +186,10 @@ docProjectImportedBy (ProjectConfigPath (_ :| [])) = text "" docProjectImportedBy (ProjectConfigPath (_ :| ps)) = vcat $ [ text " " <+> text "imported by:" <+> quoteUntrimmed l | l <- ps ] - -- | If the path has leading or trailing spaces then show it quoted. quoteUntrimmed :: FilePath -> Doc quoteUntrimmed s = if trim s /= s then quotes (text s) else text s --- | Renders the paths as a list without showing which path imports another, --- like this; --- --- >- cabal.project --- >- project-cabal/constraints.config --- >- project-cabal/ghc-latest.config --- >- project-cabal/ghc-options.config --- >- project-cabal/pkgs.config --- >- project-cabal/pkgs/benchmarks.config --- >- project-cabal/pkgs/buildinfo.config --- >- project-cabal/pkgs/cabal.config --- >- project-cabal/pkgs/install.config --- >- project-cabal/pkgs/integration-tests.config --- >- project-cabal/pkgs/tests.config --- --- --- >>> :{ --- do --- let ps = --- [ ProjectConfigPath ("cabal.project" :| []) --- , ProjectConfigPath ("project-cabal/constraints.config" :| ["cabal.project"]) --- , ProjectConfigPath ("project-cabal/ghc-latest.config" :| ["cabal.project"]) --- , ProjectConfigPath ("project-cabal/ghc-options.config" :| ["cabal.project"]) --- , ProjectConfigPath ("project-cabal/pkgs.config" :| ["cabal.project"]) --- , ProjectConfigPath ("project-cabal/pkgs/benchmarks.config" :| ["project-cabal/pkgs.config","cabal.project"]) --- , ProjectConfigPath ("project-cabal/pkgs/buildinfo.config" :| ["project-cabal/pkgs.config","cabal.project"]) --- , ProjectConfigPath ("project-cabal/pkgs/cabal.config" :| ["project-cabal/pkgs.config","cabal.project"]) --- , ProjectConfigPath ("project-cabal/pkgs/install.config" :| ["project-cabal/pkgs.config","cabal.project"]) --- , ProjectConfigPath ("project-cabal/pkgs/integration-tests.config" :| ["project-cabal/pkgs.config","cabal.project"]) --- , ProjectConfigPath ("project-cabal/pkgs/tests.config" :| ["project-cabal/pkgs.config","cabal.project"]) --- ] --- return . render $ docProjectConfigFiles ps --- :} --- "- cabal.project\n- project-cabal/constraints.config\n- project-cabal/ghc-latest.config\n- project-cabal/ghc-options.config\n- project-cabal/pkgs.config\n- project-cabal/pkgs/benchmarks.config\n- project-cabal/pkgs/buildinfo.config\n- project-cabal/pkgs/cabal.config\n- project-cabal/pkgs/install.config\n- project-cabal/pkgs/integration-tests.config\n- project-cabal/pkgs/tests.config" -docProjectConfigFiles :: [ProjectConfigPath] -> Doc -docProjectConfigFiles ps = vcat - [ text "-" <+> text p - | p <- ordNub [ p | ProjectConfigPath (p :| _) <- ps ] - ] - --- | A message for a cyclical import, a "cyclical import of". -cyclicalImportMsg :: ProjectConfigPath -> Doc -cyclicalImportMsg path@(ProjectConfigPath (duplicate :| _)) = - vcat - [ text "cyclical import of" <+> text duplicate <> semi - , nest 2 (docProjectConfigPath path) - ] - --- | A message for an import that has leading or trailing spaces. -untrimmedUriImportMsg :: Doc -> ProjectConfigPath -> Doc -untrimmedUriImportMsg intro path = - vcat - [ intro <+> text "import has leading or trailing whitespace" <> semi - , nest 2 (docProjectConfigPath path) - ] - docProjectConfigPathFailReason :: VR -> ProjectConfigPath -> Doc docProjectConfigPathFailReason vr pcp | ProjectConfigPath (p :| []) <- pcp = diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index eeae37f45d5..207fbf92967 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -185,6 +185,7 @@ library Distribution.Client.ProjectBuilding.Types Distribution.Client.ProjectConfig Distribution.Client.ProjectConfig.FieldGrammar + Distribution.Client.ProjectConfig.Import Distribution.Client.ProjectConfig.Legacy Distribution.Client.ProjectConfig.Lens Distribution.Client.ProjectConfig.Parsec diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index c81b9c16535..4192d121a5b 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -255,6 +255,7 @@ import System.IO , withBinaryFile ) +import Distribution.Client.ProjectConfig.Import (ProjectConfigSkeleton, docProjectConfigFiles, projectSkeletonImports) import Distribution.Deprecated.ProjectParseUtils (ProjectParseError (..), ProjectParseWarning) import Distribution.Solver.Types.ProjectConfigPath diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Import.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Import.hs new file mode 100644 index 00000000000..c6fa0fbff09 --- /dev/null +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Import.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | Project configuration imports. +module Distribution.Client.ProjectConfig.Import + ( -- * Parsing skeleton + ProjectConfigSkeleton + , projectSkeletonImports + , fetchImport + + -- * Messages + , docProjectConfigFiles + , cyclicalImportMsg + , untrimmedUriImportMsg + ) where + +import Control.Arrow (Kleisli (..), arr, (>>>)) +import qualified Data.ByteString.Char8 as BS +import Data.Coerce (coerce) +import Distribution.Client.Compat.Prelude hiding (empty, (<>)) +import Distribution.Client.HttpUtils +import Distribution.Client.ProjectConfig.Types +import Distribution.Compat.Lens (view) +import Distribution.PackageDescription (ConfVar (..)) +import Distribution.Simple.Utils (debug, ordNub) +import Distribution.Solver.Types.ProjectConfigPath +import Distribution.Types.CondTree (CondTree (..), traverseCondTreeA) +import Distribution.Utils.String (trim) +import Network.URI (URI (..), parseURI) +import System.Directory (createDirectoryIfMissing) +import System.FilePath (isAbsolute, isPathSeparator, makeValid, ()) +import Text.PrettyPrint + +-- | ProjectConfigSkeleton is a tree of conditional blocks and imports wrapping +-- a config. It can be finalized by providing the conditional resolution info +-- and then resolving and downloading the imports +type ProjectConfigSkeleton = CondTree ConfVar ([ProjectConfigPath], ProjectConfig) + +projectSkeletonImports :: ProjectConfigSkeleton -> [ProjectConfigPath] +projectSkeletonImports = fst . view traverseCondTreeA + +-- | Fetch a local file import or remote URL import and parse it. +fetchImport + :: (ProjectConfigToParse -> IO a) + -> FilePath + -> HttpTransport + -> Verbosity + -> FilePath + -> ProjectConfigPath + -> IO a +fetchImport parser cacheDir httpTransport verbosity projectDir normLocPath = + fetchImportConfig normLocPath >>= runKleisli (arr ProjectConfigToParse >>> Kleisli parser) . snd + where + fetchImportConfig :: ProjectConfigPath -> IO (Maybe URI, BS.ByteString) + fetchImportConfig (ProjectConfigPath (pci :| _)) = do + debug verbosity $ "fetching import: " ++ pci + let mbUri = parseURI (trim pci) + (mbUri,) <$> case mbUri of + Just uri -> do + let fp = cacheDir map (\x -> if isPathSeparator x then '_' else x) (makeValid $ show uri) + createDirectoryIfMissing True cacheDir + _ <- downloadURI httpTransport verbosity uri fp + BS.readFile fp + Nothing -> + BS.readFile $ + if isAbsolute pci then pci else coerce projectDir pci + +-- | Renders the paths as a list without showing which path imports another, +-- like this; +-- +-- >- cabal.project +-- >- project-cabal/constraints.config +-- >- project-cabal/ghc-latest.config +-- >- project-cabal/ghc-options.config +-- >- project-cabal/pkgs.config +-- >- project-cabal/pkgs/benchmarks.config +-- >- project-cabal/pkgs/buildinfo.config +-- >- project-cabal/pkgs/cabal.config +-- >- project-cabal/pkgs/install.config +-- >- project-cabal/pkgs/integration-tests.config +-- >- project-cabal/pkgs/tests.config +-- +-- +-- >>> :{ +-- do +-- let ps = +-- [ ProjectConfigPath ("cabal.project" :| []) +-- , ProjectConfigPath ("project-cabal/constraints.config" :| ["cabal.project"]) +-- , ProjectConfigPath ("project-cabal/ghc-latest.config" :| ["cabal.project"]) +-- , ProjectConfigPath ("project-cabal/ghc-options.config" :| ["cabal.project"]) +-- , ProjectConfigPath ("project-cabal/pkgs.config" :| ["cabal.project"]) +-- , ProjectConfigPath ("project-cabal/pkgs/benchmarks.config" :| ["project-cabal/pkgs.config","cabal.project"]) +-- , ProjectConfigPath ("project-cabal/pkgs/buildinfo.config" :| ["project-cabal/pkgs.config","cabal.project"]) +-- , ProjectConfigPath ("project-cabal/pkgs/cabal.config" :| ["project-cabal/pkgs.config","cabal.project"]) +-- , ProjectConfigPath ("project-cabal/pkgs/install.config" :| ["project-cabal/pkgs.config","cabal.project"]) +-- , ProjectConfigPath ("project-cabal/pkgs/integration-tests.config" :| ["project-cabal/pkgs.config","cabal.project"]) +-- , ProjectConfigPath ("project-cabal/pkgs/tests.config" :| ["project-cabal/pkgs.config","cabal.project"]) +-- ] +-- return . render $ docProjectConfigFiles ps +-- :} +-- "- cabal.project\n- project-cabal/constraints.config\n- project-cabal/ghc-latest.config\n- project-cabal/ghc-options.config\n- project-cabal/pkgs.config\n- project-cabal/pkgs/benchmarks.config\n- project-cabal/pkgs/buildinfo.config\n- project-cabal/pkgs/cabal.config\n- project-cabal/pkgs/install.config\n- project-cabal/pkgs/integration-tests.config\n- project-cabal/pkgs/tests.config" +-- +-- The listing puts projects first, URLs last and sorts the other paths +-- lexically, dropping any duplicates, like this: +-- +-- >- cabal.project +-- >- 0.config +-- >- 2.config +-- >- cfg/1.config +-- >- cfg/3.config +-- >- with-ghc.config +-- >- https://www.stackage.org/lts-21.25/cabal.config +-- +-- >>> let p = ProjectConfigPath $ "cabal.project" :| [] +-- >>> let a = ProjectConfigPath $ "0.config" :| ["cabal.project"] +-- >>> let b = ProjectConfigPath $ "cfg/1.config" :| ["0.config", "cabal.project"] +-- >>> let c = ProjectConfigPath $ "with.config" :| ["0.config", "cabal.project"] +-- >>> let d = ProjectConfigPath $ "2.config" :| ["cfg/1.config", "0.config", "cabal.project"] +-- >>> let e = ProjectConfigPath $ "cfg/3.config" :| ["2.config", "cfg/1.config", "0.config", "cabal.project"] +-- >>> let f = ProjectConfigPath $ "https://www.stackage.org/lts-21.25/cabal.config" :| ["2.config", "cfg/1.config", "0.config", "cabal.project"] +-- >>> let g = ProjectConfigPath $ "https://www.stackage.org/lts-21.25/cabal.config" :| ["cfg/3.config", "2.config", "cfg/1.config", "0.config", "cabal.project"] +-- >>> let ps = [p, a, b, c, d, e, f, g] +-- >>> render $ docProjectConfigFiles ps +-- "- cabal.project\n- 0.config\n- 2.config\n- cfg/1.config\n- cfg/3.config\n- with.config\n- https://www.stackage.org/lts-21.25/cabal.config" +docProjectConfigFiles :: [ProjectConfigPath] -> Doc +docProjectConfigFiles (sortBy compareLexicographically -> ps) = + vcat + [ text "-" <+> text p + | p <- ordNub [p | ProjectConfigPath (p :| _) <- ps] + ] + +-- | A message for a cyclical import, a "cyclical import of". +cyclicalImportMsg :: ProjectConfigPath -> Doc +cyclicalImportMsg path@(ProjectConfigPath (duplicate :| _)) = + vcat + [ text "cyclical import of" <+> text duplicate <> semi + , nest 2 (docProjectConfigPath path) + ] + +-- | A message for an import that has leading or trailing spaces. +untrimmedUriImportMsg :: Doc -> ProjectConfigPath -> Doc +untrimmedUriImportMsg intro path = + vcat + [ intro <+> text "import has leading or trailing whitespace" <> semi + , nest 2 (docProjectConfigPath path) + ] diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index fc4faa6a64a..68d8520cc4c 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -11,12 +11,10 @@ -- | Project configuration, implementation in terms of legacy types. module Distribution.Client.ProjectConfig.Legacy ( -- Project config skeletons - ProjectConfigSkeleton - , parseProject + parseProject , instantiateProjectConfigSkeletonFetchingCompiler , instantiateProjectConfigSkeletonWithCompiler , singletonProjectConfigSkeleton - , projectSkeletonImports -- * Project config in terms of legacy types , LegacyProjectConfig @@ -34,7 +32,6 @@ module Distribution.Client.ProjectConfig.Legacy , renderPackageLocationToken ) where -import Data.Coerce (coerce) import Distribution.Client.Compat.Prelude import Distribution.Types.Flag (FlagName, parsecFlagAssignment) @@ -57,12 +54,13 @@ import Distribution.Client.CmdInstall.ClientInstallFlags , defaultClientInstallFlags ) -import Distribution.Compat.Lens (toListOf, view) +import Distribution.Compat.Lens (toListOf) import Distribution.Solver.Types.ConstraintSource import Distribution.Solver.Types.ProjectConfigPath import Distribution.Client.NixStyleOptions (NixStyleFlags (..)) +import Distribution.Client.ProjectConfig.Import (ProjectConfigSkeleton, cyclicalImportMsg, fetchImport, untrimmedUriImportMsg) import Distribution.Client.ProjectFlags (ProjectFlags (..), defaultProjectFlags, projectFlagsOptions) import Distribution.Client.Setup ( ConfigExFlags (..) @@ -140,7 +138,6 @@ import Distribution.Types.CondTree , ignoreConditions , mapTreeConds , mapTreeData - , traverseCondTreeA , traverseCondTreeV ) import Distribution.Types.SourceRepo (RepoType) @@ -149,7 +146,6 @@ import Distribution.Utils.NubList , overNubList , toNubList ) -import Distribution.Utils.String (trim) import Distribution.Client.HttpUtils import Distribution.Client.ParseUtils @@ -200,9 +196,9 @@ import qualified Data.ByteString.Char8 as BS import Data.Functor ((<&>)) import qualified Data.Map as Map import qualified Data.Set as Set -import Network.URI (URI (..), nullURIAuth, parseURI) -import System.Directory (createDirectoryIfMissing, makeAbsolute) -import System.FilePath (isAbsolute, isPathSeparator, makeValid, splitFileName, ()) +import Network.URI (URI (..), nullURIAuth) +import System.Directory (makeAbsolute) +import System.FilePath (splitFileName) import Text.PrettyPrint ( Doc , render @@ -214,10 +210,6 @@ import qualified Text.PrettyPrint as Disp -- Handle extended project config files with conditionals and imports. -- --- | ProjectConfigSkeleton is a tree of conditional blocks and imports wrapping a config. It can be finalized by providing the conditional resolution info --- and then resolving and downloading the imports -type ProjectConfigSkeleton = CondTree ConfVar ([ProjectConfigPath], ProjectConfig) - singletonProjectConfigSkeleton :: ProjectConfig -> ProjectConfigSkeleton singletonProjectConfigSkeleton x = CondNode (mempty, x) mempty @@ -241,9 +233,6 @@ instantiateProjectConfigSkeletonWithCompiler os arch impl _flags skel = go $ map (Lit False) -> maybe ([]) ((: []) . go) mf _ -> error $ "unable to process condition: " ++ show cnd -- TODO it would be nice if there were a pretty printer -projectSkeletonImports :: ProjectConfigSkeleton -> [ProjectConfigPath] -projectSkeletonImports = fst . view traverseCondTreeA - -- | Parses a project from its root config file, typically cabal.project. parseProject :: FilePath @@ -293,9 +282,10 @@ parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (Project when (isUntrimmedUriConfigPath importLocPath) (noticeDoc verbosity $ untrimmedUriImportMsg (Disp.text "Warning:") importLocPath) - let fs = (\z -> CondNode ([normLocPath], z) mempty) <$> fieldsToConfig normSource (reverse acc) - res <- parseProjectSkeleton cacheDir httpTransport verbosity projectDir importLocPath . ProjectConfigToParse =<< fetchImportConfig normLocPath + let parser = parseProjectSkeleton cacheDir httpTransport verbosity projectDir importLocPath + res <- fetchImport parser cacheDir httpTransport verbosity projectDir normLocPath rest <- go [] xs + let fs = (\z -> CondNode ([normLocPath], z) mempty) <$> fieldsToConfig normSource (reverse acc) pure . fmap mconcat . sequence $ [projectParse Nothing normSource fs, res, rest] (ParseUtils.Section l "if" p xs') -> do normSource <- canonicalizeConfigPath projectDir source @@ -361,22 +351,6 @@ parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (Project addWarnings x' = x' liftPR p _ (ParseFailed e) = pure $ projectParseFail Nothing (Just p) e - fetchImportConfig :: ProjectConfigPath -> IO BS.ByteString - fetchImportConfig (ProjectConfigPath (pci :| _)) = do - debug verbosity $ "fetching import: " ++ pci - fetch pci - - fetch :: FilePath -> IO BS.ByteString - fetch pci = case parseURI $ trim pci of - Just uri -> do - let fp = cacheDir map (\x -> if isPathSeparator x then '_' else x) (makeValid $ show uri) - createDirectoryIfMissing True cacheDir - _ <- downloadURI httpTransport verbosity uri fp - BS.readFile fp - Nothing -> - BS.readFile $ - if isAbsolute pci then pci else coerce projectDir pci - modifiesCompiler :: ProjectConfig -> Bool modifiesCompiler pc = isSet projectConfigHcFlavor || isSet projectConfigHcPath || isSet projectConfigHcPkg where diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs index 90740fc7a93..866d635bff6 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs @@ -4,9 +4,7 @@ -- | Parsing project configuration. module Distribution.Client.ProjectConfig.Parsec ( -- * Package configuration - parseProjectSkeleton - , parseProject - , ProjectConfigSkeleton + parseProject , ProjectConfig (..) -- ** Parsing @@ -17,7 +15,7 @@ module Distribution.Client.ProjectConfig.Parsec import Distribution.CabalSpecVersion import Distribution.Client.HttpUtils import Distribution.Client.ProjectConfig.FieldGrammar (packageConfigFieldGrammar, projectConfigFieldGrammar) -import Distribution.Client.ProjectConfig.Legacy (ProjectConfigSkeleton) +import Distribution.Client.ProjectConfig.Import (ProjectConfigSkeleton, cyclicalImportMsg, fetchImport, untrimmedUriImportMsg) import qualified Distribution.Client.ProjectConfig.Lens as L import Distribution.Client.ProjectConfig.Types import Distribution.Client.Types.Repo hiding (repoName) @@ -48,19 +46,17 @@ import Distribution.Types.ConfVar (ConfVar (..)) import Distribution.Types.PackageName (PackageName) import Distribution.Utils.Generic (fromUTF8BS, toUTF8BS, validateUTF8) import Distribution.Utils.NubList (toNubList) -import Distribution.Utils.String (trim) import Distribution.Verbosity import Control.Monad.State.Strict (StateT, execStateT, lift) import qualified Data.ByteString as BS -import Data.Coerce (coerce) import qualified Data.Map.Strict as Map import qualified Data.Set as Set import Distribution.Client.Errors.Parser (ProjectFileSource (..)) import qualified Distribution.Compat.CharParsing as P -import Network.URI (parseURI, uriFragment, uriPath, uriScheme) -import System.Directory (createDirectoryIfMissing, makeAbsolute) -import System.FilePath (isAbsolute, isPathSeparator, makeValid, splitFileName, ()) +import Network.URI (uriFragment, uriPath, uriScheme) +import System.Directory (makeAbsolute) +import System.FilePath (splitFileName) import qualified Text.Parsec import Text.PrettyPrint (render) import qualified Text.PrettyPrint as Disp @@ -136,10 +132,10 @@ parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (Project when (isUntrimmedUriConfigPath importLocPath) (noticeDoc verbosity $ untrimmedUriImportMsg (Disp.text "Warning:") importLocPath) - let fs = (\z -> CondNode ([normLocPath], z) mempty) <$> fieldsToConfig normSource (reverse acc) - importParseResult <- parseProjectSkeleton cacheDir httpTransport verbosity projectDir importLocPath . ProjectConfigToParse =<< fetchImportConfig normLocPath - + let parser = parseProjectSkeleton cacheDir httpTransport verbosity projectDir importLocPath + importParseResult <- fetchImport parser cacheDir httpTransport verbosity projectDir normLocPath rest <- go [] xs + let fs = (\z -> CondNode ([normLocPath], z) mempty) <$> fieldsToConfig normSource (reverse acc) pure . fmap mconcat . sequence $ [fs, importParseResult, rest] ) (parseImport pos importLines) @@ -191,22 +187,6 @@ parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (Project config' <- view stateConfig <$> execStateT (goSections programDb sections) (SectionS config) return config' - fetchImportConfig :: ProjectConfigPath -> IO BS.ByteString - fetchImportConfig (ProjectConfigPath (pci :| _)) = do - debug verbosity $ "fetching import: " ++ pci - fetch pci - - fetch :: FilePath -> IO BS.ByteString - fetch pci = case parseURI (trim pci) of - Just uri -> do - let fp = cacheDir map (\x -> if isPathSeparator x then '_' else x) (makeValid $ show uri) - createDirectoryIfMissing True cacheDir - _ <- downloadURI httpTransport verbosity uri fp - BS.readFile fp - Nothing -> - BS.readFile $ - if isAbsolute pci then pci else coerce projectDir pci - modifiesCompiler :: ProjectConfig -> Bool modifiesCompiler pc = isSet projectConfigHcFlavor || isSet projectConfigHcPath || isSet projectConfigHcPkg where diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 5be55634324..a27683886cd 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -121,6 +121,7 @@ import Distribution.Client.HttpUtils import Distribution.Client.JobControl import Distribution.Client.PackageHash import Distribution.Client.ProjectConfig +import Distribution.Client.ProjectConfig.Import (docProjectConfigFiles) import Distribution.Client.ProjectConfig.Legacy import Distribution.Client.ProjectConfig.Types (defaultProjectFileParser) import Distribution.Client.ProjectPlanOutput diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index c4f2925651e..6127e544e1b 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -58,9 +58,9 @@ import Distribution.Client.ProjectConfig , withGlobalConfig , withProjectOrGlobalConfig ) +import Distribution.Client.ProjectConfig.Import (ProjectConfigSkeleton) import Distribution.Client.ProjectConfig.Legacy - ( ProjectConfigSkeleton - , instantiateProjectConfigSkeletonFetchingCompiler + ( instantiateProjectConfigSkeletonFetchingCompiler , parseProject ) import Distribution.Client.ProjectConfig.Types (ProjectConfigToParse (..)) diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/hops.expect.txt b/cabal-testsuite/PackageTests/ConditionalAndImport/hops.expect.txt index bf3ea9bc001..aa2a17291d1 100644 --- a/cabal-testsuite/PackageTests/ConditionalAndImport/hops.expect.txt +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/hops.expect.txt @@ -1,42 +1,42 @@ Configuration is affected by the following files: - hops-0.project +- hops/hops-1.config + imported by: hops-0.project - hops-2.config imported by: hops/hops-1.config imported by: hops-0.project +- hops/hops-3.config + imported by: hops-2.config + imported by: hops/hops-1.config + imported by: hops-0.project - hops-4.config imported by: hops/hops-3.config imported by: hops-2.config imported by: hops/hops-1.config imported by: hops-0.project -- hops-6.config - imported by: hops/hops-5.config +- hops/hops-5.config imported by: hops-4.config imported by: hops/hops-3.config imported by: hops-2.config imported by: hops/hops-1.config imported by: hops-0.project -- hops-8.config - imported by: hops/hops-7.config - imported by: hops-6.config +- hops-6.config imported by: hops/hops-5.config imported by: hops-4.config imported by: hops/hops-3.config imported by: hops-2.config imported by: hops/hops-1.config imported by: hops-0.project -- hops/hops-1.config - imported by: hops-0.project -- hops/hops-3.config - imported by: hops-2.config - imported by: hops/hops-1.config - imported by: hops-0.project -- hops/hops-5.config +- hops/hops-7.config + imported by: hops-6.config + imported by: hops/hops-5.config imported by: hops-4.config imported by: hops/hops-3.config imported by: hops-2.config imported by: hops/hops-1.config imported by: hops-0.project -- hops/hops-7.config +- hops-8.config + imported by: hops/hops-7.config imported by: hops-6.config imported by: hops/hops-5.config imported by: hops-4.config diff --git a/cabal.validate.project b/cabal.validate.project index bf2552af2d0..d1d57e0feba 100644 --- a/cabal.validate.project +++ b/cabal.validate.project @@ -13,7 +13,7 @@ program-options -- The +legacy-comparison flag is to set the default project file parser to compare -- the result of the legacy and parsec parser and fail if they are not equal. package cabal-install - flags: +git-rev +legacy-comparison + flags: +git-rev package Cabal flags: +git-rev diff --git a/changelog.d/pr11773 b/changelog.d/pr11773 new file mode 100644 index 00000000000..f8d633b535d --- /dev/null +++ b/changelog.d/pr11773 @@ -0,0 +1,10 @@ +packages: cabal-install-solver cabal-install +prs: #11773 +issues: #9562 #10512 +synopsis: Move project configuration import path functions to `cabal-install` +description: + Move these functions from `cabal-install-solver` to `cabal-install`: + + - `docProjectConfigFiles` + - `cyclicalImportMsg` + - `untrimmedUriImportMsg` From b7d97c3977705df7c5f8dfbbbdc841149e42fcba Mon Sep 17 00:00:00 2001 From: Ilia Baryshnikov Date: Sat, 9 May 2026 13:17:22 +0300 Subject: [PATCH 2/2] tests for asm-options, ld-options, cpp-options --- .hlint.yaml | 7 ++++--- .../{ => Cmm}/CmmSources/cabal.out | 0 .../{ => Cmm}/CmmSources/cabal.project | 0 .../{ => Cmm}/CmmSources/cabal.test.hs | 0 .../{ => Cmm}/CmmSources/cbits/HeapPrim.cmm | 0 .../{ => Cmm}/CmmSources/cmmexperiment.cabal | 0 .../{ => Cmm}/CmmSources/demo/Main.hs | 0 .../{ => Cmm}/CmmSources/setup.out | 0 .../{ => Cmm}/CmmSources/setup.test.hs | 0 .../{ => Cmm}/CmmSources/src/Demo.hs | 0 .../{ => Cmm}/CmmSourcesDyn/cabal.out | 0 .../{ => Cmm}/CmmSourcesDyn/cabal.project | 0 .../{ => Cmm}/CmmSourcesDyn/cabal.test.hs | 0 .../{ => Cmm}/CmmSourcesDyn/cbits/HeapPrim.cmm | 0 .../CmmSourcesDyn/cmmexperiment.cabal | 0 .../{ => Cmm}/CmmSourcesDyn/demo/Main.hs | 0 .../{ => Cmm}/CmmSourcesDyn/setup.out | 0 .../{ => Cmm}/CmmSourcesDyn/setup.test.hs | 0 .../{ => Cmm}/CmmSourcesDyn/src/Demo.hs | 0 .../{ => Cmm}/CmmSourcesExe/cabal.out | 0 .../{ => Cmm}/CmmSourcesExe/cabal.project | 0 .../{ => Cmm}/CmmSourcesExe/cabal.test.hs | 0 .../{ => Cmm}/CmmSourcesExe/cbits/HeapPrim.cmm | 0 .../CmmSourcesExe/cmmexperiment.cabal | 0 .../{ => Cmm}/CmmSourcesExe/demo/Main.hs | 0 .../{ => Cmm}/CmmSourcesExe/setup.out | 0 .../{ => Cmm}/CmmSourcesExe/setup.test.hs | 0 .../{ => Cmm}/CmmSourcesExe/src/Demo.hs | 0 .../PackageTests/CppOptions/CppOpts/Main.hs | 15 +++++++++++++++ .../PackageTests/CppOptions/CppOpts/cabal.out | 0 .../CppOptions/CppOpts/cabal.project | 1 + .../CppOptions/CppOpts/cabal.test.hs | 5 +++++ .../CppOptions/CppOpts/cpp-opts.cabal | 10 ++++++++++ .../PackageTests/FFI/ForeignOptsAsm/Main.hs | 16 ++++++++++++++++ .../FFI/ForeignOptsAsm/abits/asmlib.h | 6 ++++++ .../abits/asmlib_aarch64_darwin.S | 11 +++++++++++ .../ForeignOptsAsm/abits/asmlib_x86_64_linux.S | 7 +++++++ .../abits/asmlib_x86_64_windows.S | 6 ++++++ .../PackageTests/FFI/ForeignOptsAsm/cabal.out | 0 .../FFI/ForeignOptsAsm/cabal.project | 1 + .../FFI/ForeignOptsAsm/cabal.test.hs | 12 ++++++++++++ .../FFI/ForeignOptsAsm/foreign-opts-asm.cabal | 17 +++++++++++++++++ .../PackageTests/FFI/ForeignOptsCxx/Main.hs | 2 +- .../PackageTests/FFI/ForeignOptsLd/Main.hs | 18 ++++++++++++++++++ .../PackageTests/FFI/ForeignOptsLd/cabal.out | 0 .../FFI/ForeignOptsLd/cabal.project | 1 + .../FFI/ForeignOptsLd/cabal.test.hs | 8 ++++++++ .../FFI/ForeignOptsLd/cbits/ldlib.c | 14 ++++++++++++++ .../FFI/ForeignOptsLd/cbits/ldlib.h | 10 ++++++++++ .../FFI/ForeignOptsLd/foreign-opts-ld.cabal | 15 +++++++++++++++ 50 files changed, 178 insertions(+), 4 deletions(-) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSources/cabal.out (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSources/cabal.project (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSources/cabal.test.hs (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSources/cbits/HeapPrim.cmm (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSources/cmmexperiment.cabal (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSources/demo/Main.hs (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSources/setup.out (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSources/setup.test.hs (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSources/src/Demo.hs (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesDyn/cabal.out (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesDyn/cabal.project (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesDyn/cabal.test.hs (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesDyn/cbits/HeapPrim.cmm (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesDyn/cmmexperiment.cabal (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesDyn/demo/Main.hs (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesDyn/setup.out (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesDyn/setup.test.hs (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesDyn/src/Demo.hs (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesExe/cabal.out (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesExe/cabal.project (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesExe/cabal.test.hs (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesExe/cbits/HeapPrim.cmm (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesExe/cmmexperiment.cabal (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesExe/demo/Main.hs (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesExe/setup.out (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesExe/setup.test.hs (100%) rename cabal-testsuite/PackageTests/{ => Cmm}/CmmSourcesExe/src/Demo.hs (100%) create mode 100644 cabal-testsuite/PackageTests/CppOptions/CppOpts/Main.hs create mode 100644 cabal-testsuite/PackageTests/CppOptions/CppOpts/cabal.out create mode 100644 cabal-testsuite/PackageTests/CppOptions/CppOpts/cabal.project create mode 100644 cabal-testsuite/PackageTests/CppOptions/CppOpts/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/CppOptions/CppOpts/cpp-opts.cabal create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/Main.hs create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib.h create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib_aarch64_darwin.S create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib_x86_64_linux.S create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib_x86_64_windows.S create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/cabal.out create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/cabal.project create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/foreign-opts-asm.cabal create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsLd/Main.hs create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cabal.out create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cabal.project create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cbits/ldlib.c create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cbits/ldlib.h create mode 100644 cabal-testsuite/PackageTests/FFI/ForeignOptsLd/foreign-opts-ld.cabal diff --git a/.hlint.yaml b/.hlint.yaml index e5672ae408a..752f69a8a1c 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -52,10 +52,11 @@ - --ignore-glob=Cabal-tests/tests/custom-setup/CabalDoctestSetup.hs - --ignore-glob=Cabal-tests/tests/custom-setup/IdrisSetup.hs - --ignore-glob=cabal-testsuite/PackageTests/BuildWays/q/app/Main.hs + - --ignore-glob=cabal-testsuite/PackageTests/CppOptions/CppOpts/Main.hs - --ignore-glob=cabal-testsuite/PackageTests/CMain/10168/src/Lib.hs - - --ignore-glob=cabal-testsuite/PackageTests/CmmSources/src/Demo.hs - - --ignore-glob=cabal-testsuite/PackageTests/CmmSourcesDyn/src/Demo.hs - - --ignore-glob=cabal-testsuite/PackageTests/CmmSourcesExe/src/Demo.hs + - --ignore-glob=cabal-testsuite/PackageTests/Cmm/CmmSources/src/Demo.hs + - --ignore-glob=cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/src/Demo.hs + - --ignore-glob=cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/src/Demo.hs - --ignore-glob=cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/script.hs - --ignore-glob=cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/script.lhs - --ignore-glob=cabal-testsuite/PackageTests/Regression/T5309/lib/Bio/Character/Exportable/Class.hs diff --git a/cabal-testsuite/PackageTests/CmmSources/cabal.out b/cabal-testsuite/PackageTests/Cmm/CmmSources/cabal.out similarity index 100% rename from cabal-testsuite/PackageTests/CmmSources/cabal.out rename to cabal-testsuite/PackageTests/Cmm/CmmSources/cabal.out diff --git a/cabal-testsuite/PackageTests/CmmSources/cabal.project b/cabal-testsuite/PackageTests/Cmm/CmmSources/cabal.project similarity index 100% rename from cabal-testsuite/PackageTests/CmmSources/cabal.project rename to cabal-testsuite/PackageTests/Cmm/CmmSources/cabal.project diff --git a/cabal-testsuite/PackageTests/CmmSources/cabal.test.hs b/cabal-testsuite/PackageTests/Cmm/CmmSources/cabal.test.hs similarity index 100% rename from cabal-testsuite/PackageTests/CmmSources/cabal.test.hs rename to cabal-testsuite/PackageTests/Cmm/CmmSources/cabal.test.hs diff --git a/cabal-testsuite/PackageTests/CmmSources/cbits/HeapPrim.cmm b/cabal-testsuite/PackageTests/Cmm/CmmSources/cbits/HeapPrim.cmm similarity index 100% rename from cabal-testsuite/PackageTests/CmmSources/cbits/HeapPrim.cmm rename to cabal-testsuite/PackageTests/Cmm/CmmSources/cbits/HeapPrim.cmm diff --git a/cabal-testsuite/PackageTests/CmmSources/cmmexperiment.cabal b/cabal-testsuite/PackageTests/Cmm/CmmSources/cmmexperiment.cabal similarity index 100% rename from cabal-testsuite/PackageTests/CmmSources/cmmexperiment.cabal rename to cabal-testsuite/PackageTests/Cmm/CmmSources/cmmexperiment.cabal diff --git a/cabal-testsuite/PackageTests/CmmSources/demo/Main.hs b/cabal-testsuite/PackageTests/Cmm/CmmSources/demo/Main.hs similarity index 100% rename from cabal-testsuite/PackageTests/CmmSources/demo/Main.hs rename to cabal-testsuite/PackageTests/Cmm/CmmSources/demo/Main.hs diff --git a/cabal-testsuite/PackageTests/CmmSources/setup.out b/cabal-testsuite/PackageTests/Cmm/CmmSources/setup.out similarity index 100% rename from cabal-testsuite/PackageTests/CmmSources/setup.out rename to cabal-testsuite/PackageTests/Cmm/CmmSources/setup.out diff --git a/cabal-testsuite/PackageTests/CmmSources/setup.test.hs b/cabal-testsuite/PackageTests/Cmm/CmmSources/setup.test.hs similarity index 100% rename from cabal-testsuite/PackageTests/CmmSources/setup.test.hs rename to cabal-testsuite/PackageTests/Cmm/CmmSources/setup.test.hs diff --git a/cabal-testsuite/PackageTests/CmmSources/src/Demo.hs b/cabal-testsuite/PackageTests/Cmm/CmmSources/src/Demo.hs similarity index 100% rename from cabal-testsuite/PackageTests/CmmSources/src/Demo.hs rename to cabal-testsuite/PackageTests/Cmm/CmmSources/src/Demo.hs diff --git a/cabal-testsuite/PackageTests/CmmSourcesDyn/cabal.out b/cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/cabal.out similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesDyn/cabal.out rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/cabal.out diff --git a/cabal-testsuite/PackageTests/CmmSourcesDyn/cabal.project b/cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/cabal.project similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesDyn/cabal.project rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/cabal.project diff --git a/cabal-testsuite/PackageTests/CmmSourcesDyn/cabal.test.hs b/cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/cabal.test.hs similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesDyn/cabal.test.hs rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/cabal.test.hs diff --git a/cabal-testsuite/PackageTests/CmmSourcesDyn/cbits/HeapPrim.cmm b/cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/cbits/HeapPrim.cmm similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesDyn/cbits/HeapPrim.cmm rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/cbits/HeapPrim.cmm diff --git a/cabal-testsuite/PackageTests/CmmSourcesDyn/cmmexperiment.cabal b/cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/cmmexperiment.cabal similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesDyn/cmmexperiment.cabal rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/cmmexperiment.cabal diff --git a/cabal-testsuite/PackageTests/CmmSourcesDyn/demo/Main.hs b/cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/demo/Main.hs similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesDyn/demo/Main.hs rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/demo/Main.hs diff --git a/cabal-testsuite/PackageTests/CmmSourcesDyn/setup.out b/cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/setup.out similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesDyn/setup.out rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/setup.out diff --git a/cabal-testsuite/PackageTests/CmmSourcesDyn/setup.test.hs b/cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/setup.test.hs similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesDyn/setup.test.hs rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/setup.test.hs diff --git a/cabal-testsuite/PackageTests/CmmSourcesDyn/src/Demo.hs b/cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/src/Demo.hs similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesDyn/src/Demo.hs rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesDyn/src/Demo.hs diff --git a/cabal-testsuite/PackageTests/CmmSourcesExe/cabal.out b/cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/cabal.out similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesExe/cabal.out rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/cabal.out diff --git a/cabal-testsuite/PackageTests/CmmSourcesExe/cabal.project b/cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/cabal.project similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesExe/cabal.project rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/cabal.project diff --git a/cabal-testsuite/PackageTests/CmmSourcesExe/cabal.test.hs b/cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/cabal.test.hs similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesExe/cabal.test.hs rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/cabal.test.hs diff --git a/cabal-testsuite/PackageTests/CmmSourcesExe/cbits/HeapPrim.cmm b/cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/cbits/HeapPrim.cmm similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesExe/cbits/HeapPrim.cmm rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/cbits/HeapPrim.cmm diff --git a/cabal-testsuite/PackageTests/CmmSourcesExe/cmmexperiment.cabal b/cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/cmmexperiment.cabal similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesExe/cmmexperiment.cabal rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/cmmexperiment.cabal diff --git a/cabal-testsuite/PackageTests/CmmSourcesExe/demo/Main.hs b/cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/demo/Main.hs similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesExe/demo/Main.hs rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/demo/Main.hs diff --git a/cabal-testsuite/PackageTests/CmmSourcesExe/setup.out b/cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/setup.out similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesExe/setup.out rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/setup.out diff --git a/cabal-testsuite/PackageTests/CmmSourcesExe/setup.test.hs b/cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/setup.test.hs similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesExe/setup.test.hs rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/setup.test.hs diff --git a/cabal-testsuite/PackageTests/CmmSourcesExe/src/Demo.hs b/cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/src/Demo.hs similarity index 100% rename from cabal-testsuite/PackageTests/CmmSourcesExe/src/Demo.hs rename to cabal-testsuite/PackageTests/Cmm/CmmSourcesExe/src/Demo.hs diff --git a/cabal-testsuite/PackageTests/CppOptions/CppOpts/Main.hs b/cabal-testsuite/PackageTests/CppOptions/CppOpts/Main.hs new file mode 100644 index 00000000000..cdd4f68347a --- /dev/null +++ b/cabal-testsuite/PackageTests/CppOptions/CppOpts/Main.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} + +module Main where + +#ifndef __TESTOPT_CPP__ +#error "Did not get required __TESTOPT_CPP__ from cpp-options" +#endif + +main :: IO () +main = do + -- The value 44 comes from __TESTOPT_CPP__ - see the cabal file. + let secret = __TESTOPT_CPP__ :: Int + if secret == 44 + then putStrLn ("The secret is " ++ show secret) + else error ("Expected value 44, got " ++ show secret) diff --git a/cabal-testsuite/PackageTests/CppOptions/CppOpts/cabal.out b/cabal-testsuite/PackageTests/CppOptions/CppOpts/cabal.out new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-testsuite/PackageTests/CppOptions/CppOpts/cabal.project b/cabal-testsuite/PackageTests/CppOptions/CppOpts/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/CppOptions/CppOpts/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/CppOptions/CppOpts/cabal.test.hs b/cabal-testsuite/PackageTests/CppOptions/CppOpts/cabal.test.hs new file mode 100644 index 00000000000..185491f22c9 --- /dev/null +++ b/cabal-testsuite/PackageTests/CppOptions/CppOpts/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +main = cabalTest $ recordMode DoNotRecord $ do + cabal "v2-build" ["cpp-opts-exe"] + withPlan $ runPlanExe "cpp-opts" "cpp-opts-exe" [] diff --git a/cabal-testsuite/PackageTests/CppOptions/CppOpts/cpp-opts.cabal b/cabal-testsuite/PackageTests/CppOptions/CppOpts/cpp-opts.cabal new file mode 100644 index 00000000000..9913b86d720 --- /dev/null +++ b/cabal-testsuite/PackageTests/CppOptions/CppOpts/cpp-opts.cabal @@ -0,0 +1,10 @@ +cabal-version: 2.2 +name: cpp-opts +version: 0.1 +build-type: Simple + +executable cpp-opts-exe + main-is: Main.hs + build-depends: base + default-language: Haskell2010 + cpp-options: -D__TESTOPT_CPP__=44 diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/Main.hs b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/Main.hs new file mode 100644 index 00000000000..ec92f1779fa --- /dev/null +++ b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/Main.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +module Main where + +import Foreign.C (CInt (..)) + +foreign import ccall "asmlib.h meaning_of_life_asm" + meaning_of_life_asm :: IO CInt + +main :: IO () +main = do + secret <- meaning_of_life_asm + -- The value 33 comes from meaning_of_life_val - see asm-options in the cabal file. + if (secret == 33) + then putStrLn ("The secret is " ++ show secret) + else error ("Expected value 33, got " ++ show secret) diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib.h b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib.h new file mode 100644 index 00000000000..0b373105531 --- /dev/null +++ b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib.h @@ -0,0 +1,6 @@ +#ifndef ASMLIB_H +#define ASMLIB_H + +int meaning_of_life_asm(); + +#endif diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib_aarch64_darwin.S b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib_aarch64_darwin.S new file mode 100644 index 00000000000..3a13064e4cc --- /dev/null +++ b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib_aarch64_darwin.S @@ -0,0 +1,11 @@ + # macOS/AArch64 (Mach-O) + .macro func name + .globl _\name +_\name: + .endm + + .text + func meaning_of_life_asm + + mov w0, #MEANING_OF_LIFE_VAL + ret \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib_x86_64_linux.S b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib_x86_64_linux.S new file mode 100644 index 00000000000..2c1dfb2f758 --- /dev/null +++ b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib_x86_64_linux.S @@ -0,0 +1,7 @@ + .text + .globl meaning_of_life_asm + .type meaning_of_life_asm, @function +meaning_of_life_asm: + movl $MEANING_OF_LIFE_VAL, %eax + ret + .size meaning_of_life_asm, .-meaning_of_life_asm \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib_x86_64_windows.S b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib_x86_64_windows.S new file mode 100644 index 00000000000..0669d7acfd7 --- /dev/null +++ b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/abits/asmlib_x86_64_windows.S @@ -0,0 +1,6 @@ + .text + .globl meaning_of_life_asm + +meaning_of_life_asm: + movl $MEANING_OF_LIFE_VAL, %eax + ret \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/cabal.out b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/cabal.out new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/cabal.project b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/cabal.test.hs b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/cabal.test.hs new file mode 100644 index 00000000000..06e7f7b439d --- /dev/null +++ b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/cabal.test.hs @@ -0,0 +1,12 @@ +import Test.Cabal.Prelude +import Distribution.System (Arch (..), buildArch, OS (..), buildOS) + +main = do + skipUnlessIO "needs x86_64 or aarch64" + ( (buildArch == X86_64 && buildOS == Windows) + || (buildArch == X86_64 && buildOS == Linux) + || (buildArch == AArch64 && buildOS == OSX) + ) + cabalTest $ recordMode DoNotRecord $ do + cabal "v2-build" ["foreign-opts-asm-exe"] + withPlan $ runPlanExe "foreign-opts-asm" "foreign-opts-asm-exe" [] diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/foreign-opts-asm.cabal b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/foreign-opts-asm.cabal new file mode 100644 index 00000000000..2623c36aa3f --- /dev/null +++ b/cabal-testsuite/PackageTests/FFI/ForeignOptsAsm/foreign-opts-asm.cabal @@ -0,0 +1,17 @@ +cabal-version: 3.0 +name: foreign-opts-asm +version: 0.1 +build-type: Simple + +executable foreign-opts-asm-exe + main-is: Main.hs + build-depends: base + default-language: Haskell2010 + include-dirs: abits + if os(windows) && arch(x86_64) + asm-sources: abits/asmlib_x86_64_windows.S + elif os(darwin) && arch(aarch64) + asm-sources: abits/asmlib_aarch64_darwin.S + elif os(linux) && arch(x86_64) + asm-sources: abits/asmlib_x86_64_linux.S + asm-options: -DMEANING_OF_LIFE_VAL=33 diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsCxx/Main.hs b/cabal-testsuite/PackageTests/FFI/ForeignOptsCxx/Main.hs index 2343305fc39..50e2d727d7e 100644 --- a/cabal-testsuite/PackageTests/FFI/ForeignOptsCxx/Main.hs +++ b/cabal-testsuite/PackageTests/FFI/ForeignOptsCxx/Main.hs @@ -11,6 +11,6 @@ main :: IO () main = do secret <- meaning_of_life_cxx -- The value 22 comes from __TESTOPT_CXX__ - see the cabal file. - if (secret == 22) + if secret == 22 then putStrLn ("The secret is " ++ show secret) else error ("Expected value 22, got " ++ show secret) diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/Main.hs b/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/Main.hs new file mode 100644 index 00000000000..33e31fe719c --- /dev/null +++ b/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/Main.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +module Main where + +import Foreign.C (CInt (..)) + +-- With ld-options: -Wl,--wrap=meaning_of_life_ld_real, the linker redirects +-- this call to __wrap_meaning_of_life_ld_real, which returns 55. +foreign import ccall "ldlib.h meaning_of_life_ld_real" + meaning_of_life_ld_real :: IO CInt + +main :: IO () +main = do + secret <- meaning_of_life_ld_real + -- The value 55 comes from __wrap_meaning_of_life_ld_real - see ld-options in the cabal file. + if secret == 55 + then putStrLn ("The secret is " ++ show secret) + else error ("Expected value 55, got " ++ show secret) diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cabal.out b/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cabal.out new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cabal.project b/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cabal.test.hs b/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cabal.test.hs new file mode 100644 index 00000000000..395bebb60dc --- /dev/null +++ b/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cabal.test.hs @@ -0,0 +1,8 @@ +import Test.Cabal.Prelude + +main = do + skipIfOSX "Apple linker does not support --wrap" + skipIfWindows "Windows linker does not support --wrap" + cabalTest $ recordMode DoNotRecord $ do + cabal "v2-build" ["foreign-opts-ld-exe"] + withPlan $ runPlanExe "foreign-opts-ld" "foreign-opts-ld-exe" [] diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cbits/ldlib.c b/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cbits/ldlib.c new file mode 100644 index 00000000000..67e7972c6b2 --- /dev/null +++ b/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cbits/ldlib.c @@ -0,0 +1,14 @@ +#include "ldlib.h" + +/* The "real" implementation - returns 0, the wrong value. + * With ld-options: -Wl,--wrap=meaning_of_life_ld_real, the linker redirects + * all calls to this function to __wrap_meaning_of_life_ld_real below. */ +int meaning_of_life_ld_real() { + return 0; +} + +/* The wrapper that the linker substitutes in place of the real function. + * Returns 55 - see ld-options in the cabal file. */ +int __wrap_meaning_of_life_ld_real() { + return 55; +} diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cbits/ldlib.h b/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cbits/ldlib.h new file mode 100644 index 00000000000..773c3dc6853 --- /dev/null +++ b/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/cbits/ldlib.h @@ -0,0 +1,10 @@ +#ifndef LDLIB_H +#define LDLIB_H + +/* The "real" function; with --wrap, calls to this are redirected by the linker. */ +int meaning_of_life_ld_real(); + +/* The wrapper that the linker calls instead of the real function. */ +int __wrap_meaning_of_life_ld_real(); + +#endif diff --git a/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/foreign-opts-ld.cabal b/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/foreign-opts-ld.cabal new file mode 100644 index 00000000000..741874d0a56 --- /dev/null +++ b/cabal-testsuite/PackageTests/FFI/ForeignOptsLd/foreign-opts-ld.cabal @@ -0,0 +1,15 @@ +cabal-version: 2.2 +name: foreign-opts-ld +version: 0.1 +build-type: Simple + +executable foreign-opts-ld-exe + main-is: Main.hs + build-depends: base + default-language: Haskell2010 + include-dirs: cbits + c-sources: cbits/ldlib.c + -- Redirect calls to meaning_of_life_ld_real to __wrap_meaning_of_life_ld_real. + -- If ld-options are not passed the real function (returning 0) is called instead + -- of the wrapper (returning 55), and the test fails at runtime. + ld-options: -Wl,--wrap=meaning_of_life_ld_real