From 18e39bffa63874f0220755eb61f3174c4a3c3970 Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Tue, 31 Oct 2023 21:37:17 +0000 Subject: [PATCH 01/70] add more breadcrumbs for how to use remote packages. --- doc/cabal-project.rst | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index fedf8c4e935..8a5ffc07ede 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -194,8 +194,8 @@ Specifying Packages from Remote Version Control Locations ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Starting with Cabal 2.4, there is now a stanza -``source-repository-package`` for specifying packages from an external -version control. +``source-repository-package`` for specifying remote packages that cabal will vendor from an external version control system. +This allows sharing of packages across different projects. .. code-block:: cabal @@ -218,8 +218,8 @@ version control. tag: e76fdc753e660dfa615af6c8b6a2ad9ddf6afe70 post-checkout-command: autoreconf -i -cabal-install 3.4 sdists the ``source-repository-package`` repositories and uses resulting tarballs as project packages. -This allows sharing of packages across different projects. +cabal-install 3.4 sdists the ``source-repository-package`` repositories provided and uses the resulting tarballs as project packages. +It gathers the names of the packages from the appropriate .cabal file in the version control repository, and allows their use just like hackage or locally defined packages. .. cfg-field:: type: VCS kind From 00e2718219ce82fd05a2b1f1c0dcf41408f31a81 Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Wed, 1 Nov 2023 21:25:27 +0000 Subject: [PATCH 02/70] Hackage should be capitalized --- doc/cabal-project.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index 8a5ffc07ede..27befd6a32e 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -219,7 +219,7 @@ This allows sharing of packages across different projects. post-checkout-command: autoreconf -i cabal-install 3.4 sdists the ``source-repository-package`` repositories provided and uses the resulting tarballs as project packages. -It gathers the names of the packages from the appropriate .cabal file in the version control repository, and allows their use just like hackage or locally defined packages. +It gathers the names of the packages from the appropriate .cabal file in the version control repository, and allows their use just like Hackage or locally defined packages. .. cfg-field:: type: VCS kind From 46da089ffe3c3f8355c5a222aa2df2093799a4e9 Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Thu, 2 Nov 2023 22:03:02 +0000 Subject: [PATCH 03/70] Update doc/cabal-project.rst reword. --- doc/cabal-project.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index 27befd6a32e..490a513aa1a 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -194,7 +194,7 @@ Specifying Packages from Remote Version Control Locations ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Starting with Cabal 2.4, there is now a stanza -``source-repository-package`` for specifying remote packages that cabal will vendor from an external version control system. +``source-repository-package`` for specifying remote packages from a version control system that cabal should consider during package retrieval. This allows sharing of packages across different projects. .. code-block:: cabal From a5f0253dc84f9a0f7b4afb97fee5ef71dc8f4a52 Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Thu, 2 Nov 2023 22:05:07 +0000 Subject: [PATCH 04/70] Update doc/cabal-project.rst reword. --- doc/cabal-project.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index 490a513aa1a..16d8d24eb5f 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -195,7 +195,7 @@ Specifying Packages from Remote Version Control Locations Starting with Cabal 2.4, there is now a stanza ``source-repository-package`` for specifying remote packages from a version control system that cabal should consider during package retrieval. -This allows sharing of packages across different projects. +This allows use of a remote package in version control, rather than looking for a package in Hackage. .. code-block:: cabal From 88768cb002d1fdf3043efb8c2c0e1e5544ec580a Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Thu, 2 Nov 2023 23:29:31 +0000 Subject: [PATCH 05/70] Update doc/cabal-project.rst clearer. --- doc/cabal-project.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index 16d8d24eb5f..a99bdd63a46 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -194,7 +194,7 @@ Specifying Packages from Remote Version Control Locations ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Starting with Cabal 2.4, there is now a stanza -``source-repository-package`` for specifying remote packages from a version control system that cabal should consider during package retrieval. +``source-repository-package`` for specifying packages stored in a remote version control system that cabal should consider during package retrieval. This allows use of a remote package in version control, rather than looking for a package in Hackage. .. code-block:: cabal From 03ec810b07921dcd53330ae6f4b3aa89368f01e0 Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Thu, 2 Nov 2023 23:30:56 +0000 Subject: [PATCH 06/70] Update doc/cabal-project.rst clearer! --- doc/cabal-project.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index a99bdd63a46..ea0d1831fbd 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -195,7 +195,7 @@ Specifying Packages from Remote Version Control Locations Starting with Cabal 2.4, there is now a stanza ``source-repository-package`` for specifying packages stored in a remote version control system that cabal should consider during package retrieval. -This allows use of a remote package in version control, rather than looking for a package in Hackage. +This allows use of a package in a remote version control system, rather than looking for a package in Hackage. .. code-block:: cabal From 9dee2a17b8a8f6576ad894a86b13fad03c2a06aa Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Thu, 2 Nov 2023 23:35:23 +0000 Subject: [PATCH 07/70] Update doc/cabal-project.rst good mechanical description. --- doc/cabal-project.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index ea0d1831fbd..f7d50b1cb74 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -218,7 +218,7 @@ This allows use of a package in a remote version control system, rather than loo tag: e76fdc753e660dfa615af6c8b6a2ad9ddf6afe70 post-checkout-command: autoreconf -i -cabal-install 3.4 sdists the ``source-repository-package`` repositories provided and uses the resulting tarballs as project packages. +Since version 3.4, cabal-install creates tarballs for each package coming from a source-repository-package stanza (effectively applying cabal sdists to such packages). It gathers the names of the packages from the appropriate .cabal file in the version control repository, and allows their use just like Hackage or locally defined packages. .. cfg-field:: type: VCS kind From 6262ddc55c12688c9eca085c0194f375f15b2345 Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Fri, 3 Nov 2023 00:01:49 +0000 Subject: [PATCH 08/70] wrap. --- doc/cabal-project.rst | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index f7d50b1cb74..6d57816b13a 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -194,8 +194,10 @@ Specifying Packages from Remote Version Control Locations ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Starting with Cabal 2.4, there is now a stanza -``source-repository-package`` for specifying packages stored in a remote version control system that cabal should consider during package retrieval. -This allows use of a package in a remote version control system, rather than looking for a package in Hackage. +``source-repository-package`` for specifying packages stored in a remote +version control system that cabal should consider during package retrieval. +This allows use of a package in a remote version control system, rather +than looking for a package in Hackage. .. code-block:: cabal @@ -218,8 +220,11 @@ This allows use of a package in a remote version control system, rather than loo tag: e76fdc753e660dfa615af6c8b6a2ad9ddf6afe70 post-checkout-command: autoreconf -i -Since version 3.4, cabal-install creates tarballs for each package coming from a source-repository-package stanza (effectively applying cabal sdists to such packages). -It gathers the names of the packages from the appropriate .cabal file in the version control repository, and allows their use just like Hackage or locally defined packages. +Since version 3.4, cabal-install creates tarballs for each package coming +from a source-repository-package stanza (effectively applying cabal +sdists to such packages). It gathers the names of the packages from the +appropriate .cabal file in the version control repository, and allows +their use just like Hackage or locally defined packages. .. cfg-field:: type: VCS kind From ad6d34091618bbf8ee864621c629f46737afaec4 Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Sat, 4 Nov 2023 01:42:22 +0000 Subject: [PATCH 09/70] Update doc/cabal-project.rst add missing double ticks. --- doc/cabal-project.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index 6d57816b13a..5fb9ed60905 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -221,7 +221,7 @@ than looking for a package in Hackage. post-checkout-command: autoreconf -i Since version 3.4, cabal-install creates tarballs for each package coming -from a source-repository-package stanza (effectively applying cabal +from a ``source-repository-package`` stanza (effectively applying cabal sdists to such packages). It gathers the names of the packages from the appropriate .cabal file in the version control repository, and allows their use just like Hackage or locally defined packages. From 99a3790857fa1bc9d4614da750dddc9e1625d127 Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Sun, 26 Nov 2023 21:34:29 +0000 Subject: [PATCH 10/70] clarify english, and follow a linguistic pattern better. --- doc/cabal-project.rst | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index 5fb9ed60905..10af4ec6130 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -193,11 +193,11 @@ Formally, the format is described by the following BNF: Specifying Packages from Remote Version Control Locations ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Starting with Cabal 2.4, there is now a stanza -``source-repository-package`` for specifying packages stored in a remote -version control system that cabal should consider during package retrieval. -This allows use of a package in a remote version control system, rather -than looking for a package in Hackage. +Since version 2.4, the ``source-repository-package`` stanza allows for +specifying packages in a remote version control system that cabal should +consider during package retrieval. This allows use of a package from a +remote version control system, rather than looking for that package in +Hackage. .. code-block:: cabal @@ -234,7 +234,7 @@ their use just like Hackage or locally defined packages. .. cfg-field:: subdir: subdirectory list - Use one or more subdirectories of the repository. + look in one or more subdirectories of the repository for cabal files, rather than the root. .. cfg-field:: post-checkout-command: command From 0aa249bb3faeb9f4fdf7bf48f136960715868575 Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Sat, 2 Dec 2023 22:02:31 +0000 Subject: [PATCH 11/70] Update doc/cabal-project.rst --- doc/cabal-project.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index 10af4ec6130..c139239fe9d 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -234,7 +234,7 @@ their use just like Hackage or locally defined packages. .. cfg-field:: subdir: subdirectory list - look in one or more subdirectories of the repository for cabal files, rather than the root. + Look in one or more subdirectories of the repository for cabal files, rather than the root. .. cfg-field:: post-checkout-command: command From 547d4e1dc694ec25d3bc1f2c28f64f9033dfdb9e Mon Sep 17 00:00:00 2001 From: Artem Pelenitsyn Date: Wed, 1 Nov 2023 13:25:18 -0400 Subject: [PATCH 12/70] doc: render math with HTML to make it selectable (fix #8453) (#9361) * doc: render math with HTML to make it selectable (fix #8453) * Update doc/conf.py Co-authored-by: Bryan Richter --------- Co-authored-by: Bryan Richter Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com> --- doc/conf.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/conf.py b/doc/conf.py index 51ab333f80e..84ea8de0f2d 100644 --- a/doc/conf.py +++ b/doc/conf.py @@ -102,8 +102,8 @@ # Output file base name for HTML help builder. htmlhelp_basename = 'CabalUsersGuide' -# MathJax to use SVG rendering by default -mathjax_path = 'https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/latest.js?config=TeX-AMS-MML_SVG' +# MathJax to use HTML rendering by default (makes the text selectable, see #8453) +mathjax_path = 'https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/latest.js?config=TeX-AMS_CHTML' # -- Options for LaTeX output --------------------------------------------- From 8a06e9ecd3820cab64e495c0b84559becc8a9e59 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 28 Oct 2023 15:35:49 -0400 Subject: [PATCH 13/70] Avoid double space in "Executing install plan ..." --- cabal-install/src/Distribution/Client/ProjectBuilding.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs index fa917b9f1bf..e0c97aca924 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs @@ -672,9 +672,9 @@ rebuildTargets info verbosity $ "Executing install plan " ++ case buildSettingNumJobs of - NumJobs n -> " in parallel using " ++ show n ++ " threads." - UseSem n -> " in parallel using a semaphore with " ++ show n ++ " slots." - Serial -> " serially." + NumJobs n -> "in parallel using " ++ show n ++ " threads." + UseSem n -> "in parallel using a semaphore with " ++ show n ++ " slots." + Serial -> "serially." createDirectoryIfMissingVerbose verbosity True distBuildRootDirectory createDirectoryIfMissingVerbose verbosity True distTempDirectory From f77f140886d9b78c4c662117b7252df757820e7d Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 30 Oct 2023 14:31:13 -0400 Subject: [PATCH 14/70] Add a change log entry for double space avoidance --- changelog.d/pr-9376 | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 changelog.d/pr-9376 diff --git a/changelog.d/pr-9376 b/changelog.d/pr-9376 new file mode 100644 index 00000000000..d85dc9bf49a --- /dev/null +++ b/changelog.d/pr-9376 @@ -0,0 +1,6 @@ +synopsis: Avoid a double space in "Executing install plan ..." +description: + The "Executing·install·plan··serially" and other similar "Executing install + plan··..." outputs no longer contain double spaces. +packages: cabal-install +prs: #9376 \ No newline at end of file From a70382fda13d06fe4bdf2c5fb684e6cf3844790a Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 21 Aug 2023 07:41:51 -0400 Subject: [PATCH 15/70] Ignore CmmSourcesExe Demo Ignore because it warns about missing MachDeps.h --- .hlint.yaml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.hlint.yaml b/.hlint.yaml index f425ae527a8..e38cc7be72e 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -94,9 +94,10 @@ - ignore: {name: "Use when"} # 1 hint - arguments: + - --ignore-glob=Cabal-syntax/src/Distribution/Fields/Lexer.hs - --ignore-glob=cabal-testsuite/PackageTests/CmmSources/src/Demo.hs - --ignore-glob=cabal-testsuite/PackageTests/CmmSourcesDyn/src/Demo.hs - - --ignore-glob=Cabal-syntax/src/Distribution/Fields/Lexer.hs + - --ignore-glob=cabal-testsuite/PackageTests/CmmSourcesExe/src/Demo.hs - --ignore-glob=templates/Paths_pkg.template.hs - --ignore-glob=templates/SPDX.LicenseExceptionId.template.hs - --ignore-glob=templates/SPDX.LicenseId.template.hs From 37ab6580fa2ae8e282f1b33b3e31b7eef2307fb9 Mon Sep 17 00:00:00 2001 From: Yvan Sraka Date: Wed, 21 Jun 2023 15:40:43 +0200 Subject: [PATCH 16/70] [cabal-7825] Implement external command system Fix #2349 and #7825 --- Cabal/src/Distribution/Make.hs | 7 ++-- Cabal/src/Distribution/Simple.hs | 5 ++- Cabal/src/Distribution/Simple/Command.hs | 35 ++++++++++++++----- cabal-install/src/Distribution/Client/Main.hs | 7 ++-- .../src/Distribution/Client/SavedFlags.hs | 1 + doc/external-commands.rst | 8 +++++ doc/index.rst | 1 + 7 files changed, 51 insertions(+), 13 deletions(-) create mode 100644 doc/external-commands.rst diff --git a/Cabal/src/Distribution/Make.hs b/Cabal/src/Distribution/Make.hs index 716033e42a3..aaa63a94bdb 100644 --- a/Cabal/src/Distribution/Make.hs +++ b/Cabal/src/Distribution/Make.hs @@ -88,8 +88,10 @@ defaultMainArgs :: [String] -> IO () defaultMainArgs = defaultMainHelper defaultMainHelper :: [String] -> IO () -defaultMainHelper args = - case commandsRun (globalCommand commands) commands args of +defaultMainHelper args = do + command <- commandsRun (globalCommand commands) commands args + case command of + CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs @@ -98,6 +100,7 @@ defaultMainHelper args = _ | fromFlag (globalVersion flags) -> printVersion | fromFlag (globalNumericVersion flags) -> printNumericVersion + CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs diff --git a/Cabal/src/Distribution/Simple.hs b/Cabal/src/Distribution/Simple.hs index 024a445f1dc..0649a085260 100644 --- a/Cabal/src/Distribution/Simple.hs +++ b/Cabal/src/Distribution/Simple.hs @@ -168,7 +168,9 @@ defaultMainWithHooksNoReadArgs hooks pkg_descr = defaultMainHelper :: UserHooks -> Args -> IO () defaultMainHelper hooks args = topHandler $ do args' <- expandResponse args - case commandsRun (globalCommand commands) commands args' of + command <- commandsRun (globalCommand commands) commands args' + case command of + CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs @@ -177,6 +179,7 @@ defaultMainHelper hooks args = topHandler $ do _ | fromFlag (globalVersion flags) -> printVersion | fromFlag (globalNumericVersion flags) -> printNumericVersion + CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs diff --git a/Cabal/src/Distribution/Simple/Command.hs b/Cabal/src/Distribution/Simple/Command.hs index f55a510c8bd..dc2be1a698b 100644 --- a/Cabal/src/Distribution/Simple/Command.hs +++ b/Cabal/src/Distribution/Simple/Command.hs @@ -85,12 +85,15 @@ module Distribution.Simple.Command import Distribution.Compat.Prelude hiding (get) import Prelude () +import Control.Exception (try) import qualified Data.Array as Array import qualified Data.List as List import Distribution.Compat.Lens (ALens', (#~), (^#)) import qualified Distribution.GetOpt as GetOpt import Distribution.ReadE import Distribution.Simple.Utils +import System.Directory (findExecutable) +import System.Process (callProcess) data CommandUI flags = CommandUI { commandName :: String @@ -596,11 +599,13 @@ data CommandParse flags | CommandList [String] | CommandErrors [String] | CommandReadyToGo flags + | CommandDelegate instance Functor CommandParse where fmap _ (CommandHelp help) = CommandHelp help fmap _ (CommandList opts) = CommandList opts fmap _ (CommandErrors errs) = CommandErrors errs fmap f (CommandReadyToGo flags) = CommandReadyToGo (f flags) + fmap _ CommandDelegate = CommandDelegate data CommandType = NormalCommand | HiddenCommand data Command action @@ -631,25 +636,38 @@ commandsRun :: CommandUI a -> [Command action] -> [String] - -> CommandParse (a, CommandParse action) + -> IO (CommandParse (a, CommandParse action)) commandsRun globalCommand commands args = case commandParseArgs globalCommand True args of - CommandHelp help -> CommandHelp help - CommandList opts -> CommandList (opts ++ commandNames) - CommandErrors errs -> CommandErrors errs + CommandDelegate -> pure CommandDelegate + CommandHelp help -> pure $ CommandHelp help + CommandList opts -> pure $ CommandList (opts ++ commandNames) + CommandErrors errs -> pure $ CommandErrors errs CommandReadyToGo (mkflags, args') -> case args' of - ("help" : cmdArgs) -> handleHelpCommand cmdArgs + ("help" : cmdArgs) -> pure $ handleHelpCommand cmdArgs (name : cmdArgs) -> case lookupCommand name of [Command _ _ action _] -> - CommandReadyToGo (flags, action cmdArgs) - _ -> CommandReadyToGo (flags, badCommand name) - [] -> CommandReadyToGo (flags, noCommand) + pure $ CommandReadyToGo (flags, action cmdArgs) + _ -> do + mCommand <- findExecutable $ "cabal-" <> name + case mCommand of + Just exec -> callExternal flags exec cmdArgs + Nothing -> pure $ CommandReadyToGo (flags, badCommand name) + [] -> pure $ CommandReadyToGo (flags, noCommand) where flags = mkflags (commandDefaultFlags globalCommand) where lookupCommand cname = [ cmd | cmd@(Command cname' _ _ _) <- commands', cname' == cname ] + + callExternal :: a -> String -> [String] -> IO (CommandParse (a, CommandParse action)) + callExternal flags exec cmdArgs = do + result <- try $ callProcess exec cmdArgs + case result of + Left ex -> pure $ CommandErrors ["Error executing external command: " ++ show (ex :: SomeException)] + Right _ -> pure $ CommandReadyToGo (flags, CommandDelegate) + noCommand = CommandErrors ["no command given (try --help)\n"] -- Print suggested command if edit distance is < 5 @@ -679,6 +697,7 @@ commandsRun globalCommand commands args = -- furthermore, support "prog help command" as "prog command --help" handleHelpCommand cmdArgs = case commandParseArgs helpCommandUI True cmdArgs of + CommandDelegate -> CommandDelegate CommandHelp help -> CommandHelp help CommandList list -> CommandList (list ++ commandNames) CommandErrors _ -> CommandHelp globalHelp diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 6d8c0e187aa..c7772434060 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -322,8 +322,10 @@ warnIfAssertionsAreEnabled = -- into IO actions for execution. mainWorker :: [String] -> IO () mainWorker args = do - topHandler $ - case commandsRun (globalCommand commands) commands args of + topHandler $ do + command <- commandsRun (globalCommand commands) commands args + case command of + CommandDelegate -> pure () CommandHelp help -> printGlobalHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs @@ -334,6 +336,7 @@ mainWorker args = do printVersion | fromFlagOrDefault False (globalNumericVersion globalFlags) -> printNumericVersion + CommandDelegate -> pure () CommandHelp help -> printCommandHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> do diff --git a/cabal-install/src/Distribution/Client/SavedFlags.hs b/cabal-install/src/Distribution/Client/SavedFlags.hs index 1a598a58fd7..5fa417a8578 100644 --- a/cabal-install/src/Distribution/Client/SavedFlags.hs +++ b/cabal-install/src/Distribution/Client/SavedFlags.hs @@ -51,6 +51,7 @@ readCommandFlags :: FilePath -> CommandUI flags -> IO flags readCommandFlags path command = do savedArgs <- fmap (fromMaybe []) (readSavedArgs path) case (commandParseArgs command True savedArgs) of + CommandDelegate -> error "CommandDelegate Flags evaluated, this should never occur" CommandHelp _ -> throwIO (SavedArgsErrorHelp savedArgs) CommandList _ -> throwIO (SavedArgsErrorList savedArgs) CommandErrors errs -> throwIO (SavedArgsErrorOther savedArgs errs) diff --git a/doc/external-commands.rst b/doc/external-commands.rst new file mode 100644 index 00000000000..047d8f4dca0 --- /dev/null +++ b/doc/external-commands.rst @@ -0,0 +1,8 @@ +External Commands +================= + +Cabal provides a system for external commands, akin to the ones used by tools like ``git`` or ``cargo``. + +If you execute ``cabal my-custom-command``, Cabal will search the path for an executable named ``cabal-my-custom-command`` and execute it, passing any remaining arguments to this external command. An error will be thrown in case the custom command is not found. + +For ideas or existing external commands, visit `this Discourse thread `_. diff --git a/doc/index.rst b/doc/index.rst index b97dd245346..faaa3bac628 100644 --- a/doc/index.rst +++ b/doc/index.rst @@ -18,3 +18,4 @@ Welcome to the Cabal User Guide buildinfo-fields-reference bugs-and-stability nix-integration + external-commands From 0425f5e4db2fcd3c630091e48997b737405c318e Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 25 Oct 2023 22:32:29 +0200 Subject: [PATCH 17/70] Bump to latest dependencies for GHC 9.8.1 --- Cabal-tests/Cabal-tests.cabal | 24 +++++++++---------- cabal-benchmarks/cabal-benchmarks.cabal | 2 +- .../cabal-install-solver.cabal | 6 ++--- cabal-install/cabal-install.cabal | 6 ++--- cabal-testsuite/cabal-testsuite.cabal | 8 +++---- 5 files changed, 23 insertions(+), 23 deletions(-) diff --git a/Cabal-tests/Cabal-tests.cabal b/Cabal-tests/Cabal-tests.cabal index bb42abc7fc7..f6a8c2c1481 100644 --- a/Cabal-tests/Cabal-tests.cabal +++ b/Cabal-tests/Cabal-tests.cabal @@ -60,7 +60,7 @@ test-suite unit-tests , Cabal-QuickCheck , containers , deepseq - , Diff >=0.4 && <0.5 + , Diff >=0.4 && <0.6 , directory , filepath , integer-logarithms >=1.0.2 && <1.1 @@ -68,7 +68,7 @@ test-suite unit-tests , QuickCheck >=2.14 && <2.15 , rere >=0.1 && <0.3 , tagged - , tasty >=1.2.3 && <1.5 + , tasty >=1.2.3 && <1.6 , tasty-hunit , tasty-quickcheck , temporary @@ -84,14 +84,14 @@ test-suite parser-tests main-is: ParserTests.hs build-depends: base - , base-compat >=0.11.0 && <0.13 + , base-compat >=0.11.0 && <0.14 , bytestring , Cabal-syntax , Cabal-tree-diff - , Diff >=0.4 && <0.5 + , Diff >=0.4 && <0.6 , directory , filepath - , tasty >=1.2.3 && <1.5 + , tasty >=1.2.3 && <1.6 , tasty-golden >=2.3.1.1 && <2.4 , tasty-hunit , tasty-quickcheck @@ -109,10 +109,10 @@ test-suite check-tests , bytestring , Cabal , Cabal-syntax - , Diff >=0.4 && <0.5 + , Diff >=0.4 && <0.6 , directory , filepath - , tasty >=1.2.3 && <1.5 + , tasty >=1.2.3 && <1.6 , tasty-expected-failure , tasty-golden >=2.3.1.1 && <2.4 @@ -155,10 +155,10 @@ test-suite hackage-tests , filepath build-depends: - base-compat >=0.11.0 && <0.13 - , base-orphans >=0.6 && <0.9 + base-compat >=0.11.0 && <0.14 + , base-orphans >=0.6 && <0.10 , clock >=0.8 && <0.9 - , optparse-applicative >=0.13.2.0 && <0.17 + , optparse-applicative >=0.13.2.0 && <0.19 , stm >=2.4.5.0 && <2.6 , tar >=0.5.0.3 && <0.6 , tree-diff >=0.1 && <0.4 @@ -178,7 +178,7 @@ test-suite rpmvercmp build-depends: QuickCheck - , tasty >=1.2.3 && <1.5 + , tasty >=1.2.3 && <1.6 , tasty-hunit , tasty-quickcheck @@ -197,7 +197,7 @@ test-suite no-thunks-test base , bytestring , Cabal-syntax - , tasty >=1.2.3 && <1.5 + , tasty >=1.2.3 && <1.6 , tasty-hunit -- this is test is buildable on old GHCs diff --git a/cabal-benchmarks/cabal-benchmarks.cabal b/cabal-benchmarks/cabal-benchmarks.cabal index 4e911918321..d2e9cb328b2 100644 --- a/cabal-benchmarks/cabal-benchmarks.cabal +++ b/cabal-benchmarks/cabal-benchmarks.cabal @@ -31,4 +31,4 @@ test-suite cabal-benchmarks base , bytestring , Cabal-syntax - , criterion >=1.5.6.2 && <1.6 + , criterion >=1.5.6.2 && <1.7 diff --git a/cabal-install-solver/cabal-install-solver.cabal b/cabal-install-solver/cabal-install-solver.cabal index 98f8253b102..4157d98283b 100644 --- a/cabal-install-solver/cabal-install-solver.cabal +++ b/cabal-install-solver/cabal-install-solver.cabal @@ -105,7 +105,7 @@ library build-depends: , array >=0.4 && <0.6 - , base >=4.10 && <4.19 + , base >=4.10 && <4.20 , bytestring >=0.10.6.0 && <0.13 , Cabal ^>=3.11 , Cabal-syntax ^>=3.11 @@ -138,10 +138,10 @@ Test-Suite unit-tests UnitTests.Distribution.Solver.Modular.MessageUtils build-depends: - , base >= 4.10 && <4.19 + , base >= 4.10 && <4.20 , Cabal , Cabal-syntax , cabal-install-solver - , tasty >= 1.2.3 && <1.5 + , tasty >= 1.2.3 && <1.6 , tasty-quickcheck , tasty-hunit >= 0.10 diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index d47f5494c2c..e45dc58a408 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -46,7 +46,7 @@ common warnings ghc-options: -Wunused-packages common base-dep - build-depends: base >=4.10 && <4.19 + build-depends: base >=4.10 && <4.20 common cabal-dep build-depends: Cabal ^>=3.11 @@ -229,7 +229,7 @@ library time >= 1.5.0.1 && < 1.13, zlib >= 0.5.3 && < 0.7, hackage-security >= 0.6.2.0 && < 0.7, - text >= 1.2.3 && < 1.3 || >= 2.0 && < 2.1, + text >= 1.2.3 && < 1.3 || >= 2.0 && < 2.2, parsec >= 3.1.13.0 && < 3.2, regex-base >= 0.94.0.0 && <0.95, regex-posix >= 0.96.0.0 && <0.97, @@ -332,7 +332,7 @@ test-suite unit-tests tar, time, zlib, - tasty >= 1.2.3 && <1.5, + tasty >= 1.2.3 && <1.6, tasty-golden >=2.3.1.1 && <2.4, tasty-quickcheck, tasty-hunit >= 0.10, diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index 125ba5ecd55..d4206163210 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -26,7 +26,7 @@ common shared default-language: Haskell2010 build-depends: - , base >= 4.9 && <4.19 + , base >= 4.9 && <4.20 -- this needs to match the in-tree lib:Cabal version , Cabal ^>= 3.11.0.0 , Cabal-syntax ^>= 3.11.0.0 @@ -57,7 +57,7 @@ library Test.Cabal.ScriptEnv0 build-depends: - , aeson ^>= 1.4.2.0 || ^>=1.5.0.0 || ^>= 2.0.0.0 || ^>= 2.1.0.0 + , aeson ^>= 1.4.2.0 || ^>=1.5.0.0 || ^>= 2.0.0.0 || ^>= 2.1.0.0 || ^>= 2.2.1.0 , async ^>= 2.2.1 , attoparsec ^>= 0.13.2.2 || ^>=0.14.1 , base64-bytestring ^>= 1.0.0.0 || ^>= 1.1.0.0 || ^>= 1.2.0.0 @@ -68,14 +68,14 @@ library , exceptions ^>= 0.10.0 , filepath ^>= 1.3.0.1 || ^>= 1.4.0.0 , network-wait ^>= 0.1.2.0 || ^>= 0.2.0.0 - , optparse-applicative ^>= 0.14.3.0 || ^>=0.15.1.0 || ^>=0.16.0.0 || ^>= 0.17.0.0 + , optparse-applicative ^>= 0.14.3.0 || ^>=0.15.1.0 || ^>=0.16.0.0 || ^>= 0.17.0.0 || ^>= 0.18.1.0 , process ^>= 1.2.1.0 || ^>= 1.4.2.0 || ^>= 1.6.1.0 , regex-base ^>= 0.94.0.1 , regex-tdfa ^>= 1.2.3.1 || ^>=1.3.1.0 , retry ^>= 0.9.1.0 , array ^>= 0.4.0.1 || ^>= 0.5.0.0 , temporary ^>= 1.3 - , text ^>= 1.2.3.1 || ^>= 2.0.1 + , text ^>= 1.2.3.1 || ^>= 2.0.1 || ^>= 2.1 , transformers ^>= 0.3.0.0 || ^>= 0.4.2.0 || ^>= 0.5.2.0 || ^>= 0.6.0.2 if !os(windows) From d140693f6e7423838147f5170ab8155da3a5977f Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 31 Oct 2023 20:08:20 +0100 Subject: [PATCH 18/70] cabal.project: clean out obsolete `allow-newer`s --- cabal.project | 8 -------- 1 file changed, 8 deletions(-) diff --git a/cabal.project b/cabal.project index f98fec9889b..d0b2fbabc1f 100644 --- a/cabal.project +++ b/cabal.project @@ -15,17 +15,9 @@ packages: cabal-benchmarks/ optional-packages: ./vendored/*/*.cabal -allow-newer: - hackage-security:Cabal - -- avoiding extra dependencies constraints: rere -rere-cfg constraints: these -assoc --- Andreas, 2022-08-19, https://github.com/haskell/cabal/issues/8377 --- Force latest dependencies in the development version: -constraints: text >= 2.0 -constraints: time >= 1.12 - program-options ghc-options: -fno-ignore-asserts From f9d472eeae89c17dbb53bf3881d14da94aa6e35a Mon Sep 17 00:00:00 2001 From: Jens Petersen Date: Fri, 3 Nov 2023 17:57:04 +0800 Subject: [PATCH 19/70] update GH validate workflow to ghc 9.2.8, 9.4.7, 9.6.3 --- .github/workflows/validate.yml | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/.github/workflows/validate.yml b/.github/workflows/validate.yml index b1fc53a2352..3f44655fd58 100644 --- a/.github/workflows/validate.yml +++ b/.github/workflows/validate.yml @@ -23,10 +23,10 @@ on: env: # We choose a stable ghc version across all os's # which will be used to do the next release - GHC_FOR_RELEASE: '9.2.7' + GHC_FOR_RELEASE: '9.2.8' # Ideally we should use the version about to be released for hackage tests and benchmarks - GHC_FOR_SOLVER_BENCHMARKS: '9.2.7' - GHC_FOR_COMPLETE_HACKAGE_TESTS: '9.2.7' + GHC_FOR_SOLVER_BENCHMARKS: '9.2.8' + GHC_FOR_COMPLETE_HACKAGE_TESTS: '9.2.8' COMMON_FLAGS: '-j 2 -v' jobs: @@ -38,7 +38,7 @@ jobs: strategy: matrix: os: ["ubuntu-latest", "macos-latest", "windows-latest"] - ghc: ["9.6.1", "9.4.4", "9.2.7", "9.0.2", "8.10.7", "8.8.4", "8.6.5", "8.4.4"] + ghc: ["9.6.3", "9.4.7", "9.2.8", "9.0.2", "8.10.7", "8.8.4", "8.6.5", "8.4.4"] exclude: # corrupts GHA cache or the fabric of reality itself, see https://github.com/haskell/cabal/issues/8356 - os: "windows-latest" @@ -107,7 +107,7 @@ jobs: echo "FLAGS=$FLAGS" >> $GITHUB_ENV - name: Allow newer dependencies when built with latest GHC - if: ${{ matrix.ghc }} == '9.6.1' + if: ${{ matrix.ghc }} == '9.6.3' run: | echo "allow-newer: rere:base, rere:transformers" >> cabal.project.validate @@ -161,7 +161,7 @@ jobs: # Have to disable *-suite validation: # - the Windows@9.6.1 problem is tracked at https://github.com/haskell/cabal/issues/8858 # - but curently can't run it with GHC 9.6, tracking: https://github.com/haskell/cabal/issues/8883 - if: (runner.os != 'Windows') || (matrix.ghc != '9.6.1') + if: (runner.os != 'Windows') || (matrix.ghc != '9.6.3') run: sh validate.sh $FLAGS -s lib-suite - name: Validate cli-tests @@ -169,7 +169,7 @@ jobs: - name: Validate cli-suite # Have to disable *-suite validation, see above the comment for lib-suite - if: (runner.os != 'Windows') || (matrix.ghc != '9.6.1') + if: (runner.os != 'Windows') || (matrix.ghc != '9.6.3') run: sh validate.sh $FLAGS -s cli-suite validate-old-ghcs: From 315fd08fda04eb663a1503f0a62eb9f0585dd4c0 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Sat, 4 Nov 2023 14:59:20 +0800 Subject: [PATCH 20/70] Revert #3639 (Don't pass -package-db and -package flags to --abi-hash) (#9384) * Revert #3639 (Don't pass -package-db and -package flags to --abi-hash) With ghc>=9.6 `ghc --abi-hash` initialises the plugins so it will fail if a cabal file specifies `ghc-options: -fplugin=Foo`. Closes: #9375 * Also revert in GHC.hs --------- Co-authored-by: Hamish Mackenzie Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com> --- Cabal/src/Distribution/Simple/GHC.hs | 10 +--------- Cabal/src/Distribution/Simple/GHCJS.hs | 10 +--------- 2 files changed, 2 insertions(+), 18 deletions(-) diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index 3c380a41a86..f218d7c117a 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -2052,20 +2052,12 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do libBi = libBuildInfo lib comp = compiler lbi platform = hostPlatform lbi - vanillaArgs0 = + vanillaArgs = (componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi)) `mappend` mempty { ghcOptMode = toFlag GhcModeAbiHash , ghcOptInputModules = toNubListR $ exposedModules lib } - vanillaArgs = - -- Package DBs unnecessary, and break ghc-cabal. See #3633 - -- BUT, put at least the global database so that 7.4 doesn't - -- break. - vanillaArgs0 - { ghcOptPackageDBs = [GlobalPackageDB] - , ghcOptPackages = mempty - } sharedArgs = vanillaArgs `mappend` mempty diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs index 58194f5ffa3..5ed2d9327e9 100644 --- a/Cabal/src/Distribution/Simple/GHCJS.hs +++ b/Cabal/src/Distribution/Simple/GHCJS.hs @@ -1739,20 +1739,12 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do libBi = libBuildInfo lib comp = compiler lbi platform = hostPlatform lbi - vanillaArgs0 = + vanillaArgs = (componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi)) `mappend` mempty { ghcOptMode = toFlag GhcModeAbiHash , ghcOptInputModules = toNubListR $ exposedModules lib } - vanillaArgs = - -- Package DBs unnecessary, and break ghc-cabal. See #3633 - -- BUT, put at least the global database so that 7.4 doesn't - -- break. - vanillaArgs0 - { ghcOptPackageDBs = [GlobalPackageDB] - , ghcOptPackages = mempty - } sharedArgs = vanillaArgs `mappend` mempty From c7f0909a5edc6f9c23643a227005976947f8e7e6 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 30 Oct 2023 14:57:03 -0400 Subject: [PATCH 21/70] Use the newer haskell-actions organisation --- .github/workflows/lint.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/lint.yml b/.github/workflows/lint.yml index fa12e98b878..5e8e95c2c8b 100644 --- a/.github/workflows/lint.yml +++ b/.github/workflows/lint.yml @@ -9,10 +9,10 @@ jobs: runs-on: ubuntu-latest steps: - uses: actions/checkout@v4 - - uses: haskell/actions/hlint-setup@v2 + - uses: haskell-actions/hlint-setup@v2 with: version: "3.5" - - uses: haskell/actions/hlint-run@v2 + - uses: haskell-actions/hlint-run@v2 with: path: "." fail-on: suggestion \ No newline at end of file From 902c919e3191aa817d94f7da3b2c97428d1aeb88 Mon Sep 17 00:00:00 2001 From: Malte Neuss Date: Sat, 28 Oct 2023 23:04:37 +0200 Subject: [PATCH 22/70] Restructure Cabal documentation top-level parts The goal is for users to easier find pages for typical problems through search engines and page navigation. - The top-level layout is based on the popular documentation structure by https://documentation.divio.com/ to give a clear structure to users and future documentation contributors: * Guides: Present a solution to a single, atomic, typical user problem. * Reference: Describe user API (CLI fields, syntax etc) with technical rigour and completeness. * Explanation: Discuss background information, scope, design decisions etc. - Move existing documentation roughly into these categories with minimal editing as the basis for further editing. - Rename guide titles to mention how-to for improving SEO. - Rename some files to improve SEO since that name becomes part of the URL (often called slug). Important page keywords should appear in the slug as well to make pages rank higher in search engines. --- .gitignore | 2 + doc/_templates/layout.html | 5 +- doc/bugs-and-stability.rst | 6 - doc/{intro.rst => cabal-context.rst} | 6 +- ...misc.rst => cabal-interface-stability.rst} | 10 - ...rst => cabal-package-description-file.rst} | 6 +- ...rst => cabal-project-description-file.rst} | 4 +- doc/cabaldomain.py | 6 +- doc/concepts-and-development.rst | 7 - doc/getting-started.rst | 2 +- ...overview.rst => how-to-build-like-nix.rst} | 4 +- doc/how-to-package-haskell-code.rst | 291 +++++++++++++++++ doc/how-to-report-bugs.rst | 9 + doc/index.rst | 39 ++- doc/nix-integration.rst | 64 ---- doc/nix-local-build.rst | 2 +- ...ping-packages.rst => package-concepts.rst} | 305 ------------------ 17 files changed, 349 insertions(+), 419 deletions(-) delete mode 100644 doc/bugs-and-stability.rst rename doc/{intro.rst => cabal-context.rst} (98%) rename doc/{misc.rst => cabal-interface-stability.rst} (89%) rename doc/{cabal-package.rst => cabal-package-description-file.rst} (99%) rename doc/{cabal-project.rst => cabal-project-description-file.rst} (99%) delete mode 100644 doc/concepts-and-development.rst rename doc/{nix-local-build-overview.rst => how-to-build-like-nix.rst} (97%) create mode 100644 doc/how-to-package-haskell-code.rst create mode 100644 doc/how-to-report-bugs.rst delete mode 100644 doc/nix-integration.rst rename doc/{developing-packages.rst => package-concepts.rst} (56%) diff --git a/.gitignore b/.gitignore index e9ec3b6322f..72a16455c82 100644 --- a/.gitignore +++ b/.gitignore @@ -73,6 +73,8 @@ cabal-testsuite/**/haddocks # python artifacts from documentation builds *.pyc .python-sphinx-virtualenv/ +venv +.venv /doc/.skjold_cache/ # macOS folder metadata diff --git a/doc/_templates/layout.html b/doc/_templates/layout.html index d8ced7f65a4..7add67b61eb 100644 --- a/doc/_templates/layout.html +++ b/doc/_templates/layout.html @@ -1,8 +1,7 @@ {% extends "!layout.html" %} {% block menu %} - {{ super() }} - Reference +{{ super() }} + Cabal Syntax Quicklinks Index {% endblock %} - diff --git a/doc/bugs-and-stability.rst b/doc/bugs-and-stability.rst deleted file mode 100644 index 81d27d3dd1a..00000000000 --- a/doc/bugs-and-stability.rst +++ /dev/null @@ -1,6 +0,0 @@ -Reporting Bugs and Stability of Cabal Interfaces -================================================ - -.. toctree:: - misc - diff --git a/doc/intro.rst b/doc/cabal-context.rst similarity index 98% rename from doc/intro.rst rename to doc/cabal-context.rst index d2219ab32d1..ce152cca713 100644 --- a/doc/intro.rst +++ b/doc/cabal-context.rst @@ -14,8 +14,8 @@ use Hackage_ which is Haskell's central package archive that contains thousands of libraries and applications in the Cabal package format. -Introduction -============ +What Cabal does +=============== Cabal is a package system for Haskell software. The point of a package system is to enable software developers and users to easily distribute, @@ -122,7 +122,7 @@ the package depends on. For full details on what goes in the ``.cabal`` and ``Setup.hs`` files, and for all the other features provided by the build system, see the -section on :doc:`developing packages `. +section on :doc:`How to package Haskell code `. Cabal featureset ---------------- diff --git a/doc/misc.rst b/doc/cabal-interface-stability.rst similarity index 89% rename from doc/misc.rst rename to doc/cabal-interface-stability.rst index 5d01198f0e5..2993f8ab0ff 100644 --- a/doc/misc.rst +++ b/doc/cabal-interface-stability.rst @@ -1,13 +1,3 @@ -Reporting bugs and deficiencies -=============================== - -Please report any flaws or feature requests in the `bug -tracker `__. - -For general discussion or queries email the libraries mailing list -libraries@haskell.org. There is also a development mailing list -cabal-devel@haskell.org. - Stability of Cabal interfaces ============================= diff --git a/doc/cabal-package.rst b/doc/cabal-package-description-file.rst similarity index 99% rename from doc/cabal-package.rst rename to doc/cabal-package-description-file.rst index 75ec9ff40ed..485389a0916 100644 --- a/doc/cabal-package.rst +++ b/doc/cabal-package-description-file.rst @@ -1,6 +1,8 @@ -Package Description -=================== +Package Description — .cabal File +========================================== +The package description file, commonly known as "the Cabal file", +describes the contents of a package. The Cabal package is the unit of distribution. When installed, its purpose is to make available: diff --git a/doc/cabal-project.rst b/doc/cabal-project-description-file.rst similarity index 99% rename from doc/cabal-project.rst rename to doc/cabal-project-description-file.rst index c139239fe9d..1bf238063c7 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project-description-file.rst @@ -1,5 +1,5 @@ -cabal.project Reference -======================= +Project Description — cabal.project File +======================================== ``cabal.project`` files support a variety of options which configure the details of your build. The general syntax of a ``cabal.project`` file is diff --git a/doc/cabaldomain.py b/doc/cabaldomain.py index 19c37dea229..2d318f8508f 100644 --- a/doc/cabaldomain.py +++ b/doc/cabaldomain.py @@ -598,9 +598,9 @@ class CabalConfigFieldXRef(CabalFieldXRef): # class ConfigFieldIndex(Index): - name = 'projectindex' - localname = "Cabal reference" - shortname = "Reference" + name = 'syntax-quicklinks' + localname = "Cabal Syntax Quicklinks" + shortname = "Quicklinks" class Entry(object): def __init__(self, typ, name, doc, anchor, meta): diff --git a/doc/concepts-and-development.rst b/doc/concepts-and-development.rst deleted file mode 100644 index c0e8b481356..00000000000 --- a/doc/concepts-and-development.rst +++ /dev/null @@ -1,7 +0,0 @@ -Package Concepts and Development -================================ - -.. toctree:: - :maxdepth: 2 - - developing-packages diff --git a/doc/getting-started.rst b/doc/getting-started.rst index 4d5ebfe810f..39a095a7453 100644 --- a/doc/getting-started.rst +++ b/doc/getting-started.rst @@ -228,4 +228,4 @@ What Next? Now that you know how to set up a simple Haskell package using Cabal, check out some of the resources on the Haskell website's `documentation page `__ or read more about packages and -Cabal on the :doc:`introduction ` page. +Cabal on the :doc:`What Cabal does ` page. diff --git a/doc/nix-local-build-overview.rst b/doc/how-to-build-like-nix.rst similarity index 97% rename from doc/nix-local-build-overview.rst rename to doc/how-to-build-like-nix.rst index 61e59b84d76..0714b4b02f1 100644 --- a/doc/nix-local-build-overview.rst +++ b/doc/how-to-build-like-nix.rst @@ -1,7 +1,7 @@ .. _nix-style-builds: -Nix-style Local Builds -====================== +How to build locally like in Nix +================================ Nix-style local builds are a new build system implementation inspired by Nix. The Nix-style local build system is commonly called "v2-build" for short diff --git a/doc/how-to-package-haskell-code.rst b/doc/how-to-package-haskell-code.rst new file mode 100644 index 00000000000..bd68681654b --- /dev/null +++ b/doc/how-to-package-haskell-code.rst @@ -0,0 +1,291 @@ +How to package Haskell code +=========================== + +.. TIP:: + If this is your first time using `cabal` you should check out the :doc:`Getting Started guide `. + +Starting from scratch, we're going to walk you through creating a simple +Haskell application. + +**TL;DR;** ``mkdir proglet && cd proglet && cabal init --simple --exe && cabal run proglet`` + + +Introduction +------------ + +Every application needs a name, we'll call ours "proglet" and start by +creating an empty directory. + +.. highlight:: console + +:: + + $ mkdir proglet + $ cd proglet/ + + +.. _init quickstart: + +Using ``cabal init`` +-------------------- + +The ``cabal init`` command creates the necessary files for a Cabal package, +it has both an ``--interactive`` (default) and ``--non-interactive`` +mode. The interactive mode will walk you through many of the package +options and metadata, the non-interactive mode will simply pick reasonable +defaults which is sufficient if you're just trying something out. + +.. highlight:: console + +:: + + $ cabal init --non-interactive + # You can also use -n which is the short version of --non-interactive + +If you want, you can also try out the interactive mode, for now chose +"Executable" when asked what type of package you want to build. + +.. highlight:: console + +:: + + $ cabal init + ... + What does the package build: + 1) Executable + 2) Library + 3) Library and Executable + 4) Test suite + Your choice? + +One of the important questions is whether the package contains a library +and/or an executable. Libraries are collections of Haskell modules that +can be re-used by other Haskell libraries and programs, while executables +are standalone programs. Test suites can both depend on a library or be +standalone. + +For the moment these are the only choices. For more complex packages +(e.g. a library and multiple executables) the ``.cabal`` +file can be edited afterwards. + +After you make your selection (executable; library; library +and executable; or: test suite) cabal asks us a number of questions starting with +which version of the cabal specification to use, our package's name +(for example, "proglet"), and our package's version. + +:: + + Generating CHANGELOG.md... + Generating Main.hs... + Generating proglet.cabal... + +Use the ``ls`` command to see the created files: + +:: + + $ ls + CHANGELOG.md Main.hs proglet.cabal + + +Running the program +------------------- + +Now that we have our Haskell code and the extra files that Cabal needs, we +can build and run our application. + +:: + + $ cabal build + Resolving dependencies... + ... + Linking /path/to/proglet ... + + $ cabal run proglet + ... + Hello, Haskell! + +Since we have an executable we can use ``cabal run proglet`` which will build +our executable (and re-build it if we've made any changes) and then run the +binary. The ``cabal run`` command works for any ``component-name`` (tests for +example), not just the main executable. + + +About the Cabal package structure +--------------------------------- + +It is assumed that all the files that make up a package live under a common +root directory (apart from external dependencies). This simple example has +all the package files in one directory, but most packages use one or more +subdirectories. + +Cabal needs one extra file in the package's root directory: + +- ``proglet.cabal``: contains package metadata and build information. + + +Editing the .cabal file +----------------------- + +.. highlight:: cabal + +Load up the ``.cabal`` file in a text editor. The first part of the +``.cabal`` file has the package metadata and towards the end of the file +you will find the :pkg-section:`executable` or :pkg-section:`library` +section. + +You will see that the fields that have yet to be filled in are commented +out. Cabal files use "``--``" Haskell-style comment syntax. + +.. NOTE:: + Comments are only allowed on lines on their own. Trailing comments on + other lines are not allowed because they could be confused with program + options. + + +:: + + executable proglet + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base >=4.11 && <4.12 + -- hs-source-dirs: + default-language: Haskell2010 + + +If you selected earlier to create a library package then your ``.cabal`` +file will have a section that looks like this: + +:: + + library + exposed-modules: MyLib + -- other-modules: + -- build-depends: + build-depends: base >=4.11 && <4.12 + -- hs-source-dirs: + default-language: Haskell2010 + + +The build information fields listed (but commented out) are just the few +most important and common fields. There are many others that are covered +later in this chapter. + +Most of the build information fields are the same between libraries and +executables. The difference is that libraries have a number of "exposed" +modules that make up the public interface of the library, while +executables have a file containing a ``Main`` module. + +The name of a library always matches the name of the package, so it is +not specified in the library section. Executables often follow the name +of the package too, but this is not required and the name is given +explicitly. + + +Modules included in the package +------------------------------- + +For an executable, ``cabal init`` creates the ``Main.hs`` file which +contains your program's ``Main`` module. It will also fill in the +:pkg-field:`executable:main-is` field with the file name of your program's +``Main`` module, including the ``.hs`` (or ``.lhs``) extension. Other +modules included in the executable should be listed in the +:pkg-field:`other-modules` field. + +For a library, ``cabal init`` looks in the project directory for files +that look like Haskell modules and adds all the modules to the +:pkg-field:`library:exposed-modules` field. For modules that do not form part +of your package's public interface, you can move those modules to the +:pkg-field:`other-modules` field. Either way, all modules in the library need +to be listed. + + +Modules imported from other packages +------------------------------------ + +While your library or executable may include a number of modules, it +almost certainly also imports a number of external modules from the +standard libraries or other pre-packaged libraries. (These other +libraries are of course just Cabal packages that contain one or more libraries.) + +You have to list all of the library packages that your library or +executable imports modules from. Or to put it another way: you have to +list all the other packages that your package depends on. + +For example, suppose the example ``Proglet`` module imports the module +``Data.Map``. The ``Data.Map`` module comes from the ``containers`` +package, so we must list it: + +:: + + library + exposed-modules: Proglet + other-modules: + build-depends: containers, base >=4.11 && <4.12 + +In addition, almost every package also depends on the ``base`` library +package because it exports the standard ``Prelude`` module plus other +basic modules like ``Data.List``. + +You will notice that we have listed ``base >=4.11 && <4.12``. This gives a +constraint on the version of the base package that our package will work +with. The most common kinds of constraints are: + +- ``pkgname >=n`` +- ``pkgname ^>=n`` +- ``pkgname >=n && =4 && <5``. Please refer to the documentation +on the :pkg-field:`build-depends` field for more information. + +Also, you can factor out shared ``build-depends`` (and other fields such +as ``ghc-options``) into a ``common`` stanza which you can ``import`` in +your libraries and executable sections. For example: + +:: + + common shared-properties + default-language: Haskell2010 + build-depends: + base == 4.* + ghc-options: + -Wall + + library + import: shared-properties + exposed-modules: + Proglet + +Note that the ``import`` **must** be the first thing in the stanza. For more +information see the :ref:`common-stanzas` section. + +.. _building-packages: + +Building the package +-------------------- + +For simple packages that's it! We can now try building the package, +which also downloads and builds all required dependencies: + +.. code-block:: console + + $ cabal build + +If the package contains an executable, you can run it with: + +.. code-block:: console + + $ cabal run + +and the executable can also be installed for convenience: + +.. code-block:: console + + $ cabal install + +When installed, the executable program lands in a special directory +for binaries that may or may not already be on your system's ``PATH``. +If it is, the executable can be run by typing its filename on commandline. +For installing libraries see the :ref:`adding-libraries` section. diff --git a/doc/how-to-report-bugs.rst b/doc/how-to-report-bugs.rst new file mode 100644 index 00000000000..20910cdf1a3 --- /dev/null +++ b/doc/how-to-report-bugs.rst @@ -0,0 +1,9 @@ +How to report Cabal bugs and feature requests +============================================= + +Please report any flaws or feature requests in the `bug +tracker `__. + +For general discussion or queries email the libraries mailing list +libraries@haskell.org. There is also a development mailing list +cabal-devel@haskell.org. diff --git a/doc/index.rst b/doc/index.rst index faaa3bac628..ed882247ea7 100644 --- a/doc/index.rst +++ b/doc/index.rst @@ -1,21 +1,40 @@ - Welcome to the Cabal User Guide =============================== .. toctree:: - :maxdepth: 2 + :caption: Getting Started :numbered: + :maxdepth: 2 getting-started - intro - concepts-and-development - nix-local-build-overview + +.. toctree:: + :caption: Cabal Guide + :numbered: + :maxdepth: 2 + + how-to-package-haskell-code + how-to-build-like-nix + how-to-report-bugs + +.. toctree:: + :caption: Cabal Reference + :numbered: + :maxdepth: 2 + + cabal-package-description-file + cabal-project-description-file cabal-config-and-commands - cabal-package - cabal-project + external-commands setup-commands file-format-changelog buildinfo-fields-reference - bugs-and-stability - nix-integration - external-commands + +.. toctree:: + :caption: Cabal Explanation + :numbered: + :maxdepth: 2 + + cabal-context + package-concepts + cabal-interface-stability diff --git a/doc/nix-integration.rst b/doc/nix-integration.rst deleted file mode 100644 index 5d4fa695cd4..00000000000 --- a/doc/nix-integration.rst +++ /dev/null @@ -1,64 +0,0 @@ -Nix Integration -=============== - -.. warning:: - - Nix integration has been deprecated and will be removed in a future release. - - The original mechanism can still be easily replicated with the following commands: - - - for a ``shell.nix``: ``nix-shell --run "cabal ..."`` - - for a ``flake.nix``: ``nix develop -c cabal ...`` - -.. note:: - - This functionality doesn't work with nix-style builds. - Nix-style builds are not related to Nix integration. - -`Nix `_ is a package manager popular with some Haskell developers due to its focus on reliability and reproducibility. ``cabal`` now has the ability to integrate with Nix for dependency management during local package development. - -Enabling Nix Integration ------------------------- - -To enable Nix integration, simply pass the ``--enable-nix`` global option when you call ``cabal`` (eg. ``cabal --enable-nix v1-build``). -To use this option everywhere, edit your :ref:`global configuration file` (default: ``~/.config/cabal/config``) to include: - -.. code-block:: cabal - - nix: True - -If the package (which must be locally unpacked) provides a ``shell.nix`` or ``default.nix`` file, this flag will cause ``cabal`` to run most commands through ``nix-shell``. If both expressions are present, ``shell.nix`` is preferred. The following commands are affected: - -- ``cabal v1-configure`` -- ``cabal v1-build`` -- ``cabal v1-repl`` -- ``cabal v1-install`` (only if installing into a sandbox) -- ``cabal v1-haddock`` -- ``cabal v1-freeze`` -- ``cabal v1-gen-bounds`` -- ``cabal v1-run`` - -If the package does not provide a Nix expression, ``cabal`` runs normally. - -Creating Nix Expressions ------------------------- - -The Nix package manager is based on a lazy, pure, functional programming language; packages are defined by expressions in this language. The fastest way to create a Nix expression for a Cabal package is with the `cabal2nix `_ tool. To create a ``shell.nix`` expression for the package in the current directory, run this command: - -.. code-block:: console - - $ cabal2nix --shell ./. >shell.nix - -Nix Expression Evaluation -------------------------- - -(This section describes for advanced users how Nix expressions are evaluated.) - -First, the Nix expression (``shell.nix`` or ``default.nix``) is instantiated with ``nix-instantiate``. The ``--add-root`` and ``--indirect`` options are used to create an indirect root in the Cabal build directory, preventing Nix from garbage collecting the derivation while in use. The ``IN_NIX_SHELL`` environment variable is set so that ``builtins.getEnv`` works as it would in ``nix-shell``. - -Next, the commands above are run through ``nix-shell`` using the instantiated derivation. Again, ``--add-root`` and ``--indirect`` are used to prevent Nix from garbage collecting the packages in the environment. The child ``cabal`` process reads the ``CABAL_IN_NIX_SHELL`` environment variable to prevent it from spawning additional child shells. - -Further Reading ----------------- - -The `Nix manual `_ provides further instructions for writing Nix expressions. The `Nixpkgs manual `_ describes the infrastructure provided for Haskell packages. diff --git a/doc/nix-local-build.rst b/doc/nix-local-build.rst index c086f642d24..7a47dacc923 100644 --- a/doc/nix-local-build.rst +++ b/doc/nix-local-build.rst @@ -5,7 +5,7 @@ Quickstart Suppose that you are in a directory containing a single Cabal package which you wish to build (if you haven't set up a package yet check -out :doc:`developing packages ` for +out :doc:`How to package Haskell code ` for instructions). You can configure and build it using Nix-style local builds with this command (configuring is not necessary): diff --git a/doc/developing-packages.rst b/doc/package-concepts.rst similarity index 56% rename from doc/developing-packages.rst rename to doc/package-concepts.rst index 28f2c7847df..25cfeb13fba 100644 --- a/doc/developing-packages.rst +++ b/doc/package-concepts.rst @@ -1,308 +1,3 @@ -Quickstart -========== - -.. TIP:: - If this is your first time using `cabal` you should check out the :doc:`Getting Started guide `. - -Starting from scratch, we're going to walk you through creating a simple -Haskell application. - -**TL;DR;** ``mkdir proglet && cd proglet && cabal init --simple --exe && cabal run proglet`` - - -Introduction ------------- - -Every application needs a name, we'll call ours "proglet" and start by -creating an empty directory. - -.. highlight:: console - -:: - - $ mkdir proglet - $ cd proglet/ - - -.. _init quickstart: - -Using ``cabal init`` --------------------- - -The ``cabal init`` command creates the necessary files for a Cabal package, -it has both an ``--interactive`` (default) and ``--non-interactive`` -mode. The interactive mode will walk you through many of the package -options and metadata, the non-interactive mode will simply pick reasonable -defaults which is sufficient if you're just trying something out. - -.. highlight:: console - -:: - - $ cabal init --non-interactive - # You can also use -n which is the short version of --non-interactive - -If you want, you can also try out the interactive mode, for now chose -"Executable" when asked what type of package you want to build. - -.. highlight:: console - -:: - - $ cabal init - ... - What does the package build: - 1) Executable - 2) Library - 3) Library and Executable - 4) Test suite - Your choice? - -One of the important questions is whether the package contains a library -and/or an executable. Libraries are collections of Haskell modules that -can be re-used by other Haskell libraries and programs, while executables -are standalone programs. Test suites can both depend on a library or be -standalonely generated. - -For the moment these are the only choices. For more complex packages -(e.g. a library and multiple executables) the ``.cabal`` -file can be edited afterwards. - -After you make your selection (executable; library; library -and executable; or: test suite) cabal asks us a number of questions starting with -which version of the cabal specification to use, our package's name -(for example, "proglet"), and our package's version. - -:: - - Generating CHANGELOG.md... - Generating Main.hs... - Generating proglet.cabal... - -Use the ``ls`` command to see the created files: - -:: - - $ ls - CHANGELOG.md Main.hs proglet.cabal - - -Running the program -------------------- - -Now that we have our Haskell code and the extra files that Cabal needs we -can build and run our application. - -:: - - $ cabal build - Resolving dependencies... - ... - Linking /path/to/proglet ... - - $ cabal run proglet - ... - Hello, Haskell! - -Since we have an executable we can use ``cabal run proglet`` which will build -our executable (and re-build it if we've made any changes) and then run the -binary. The ``cabal run`` command works for any ``component-name`` (tests for -example), not just the main executable. - - -About the Cabal package structure ---------------------------------- - -It is assumed that all the files that make up a package live under a common -root directory (apart from external dependencies). This simple example has -all the package files in one directory, but most packages use one or more -subdirectories. - -Cabal needs one extra file in the package's root directory: - -- ``proglet.cabal``: contains package metadata and build information. - - -Editing the .cabal file ------------------------ - -.. highlight:: cabal - -Load up the ``.cabal`` file in a text editor. The first part of the -``.cabal`` file has the package metadata and towards the end of the file -you will find the :pkg-section:`executable` or :pkg-section:`library` -section. - -You will see that the fields that have yet to be filled in are commented -out. Cabal files use "``--``" Haskell-style comment syntax. - -.. NOTE:: - Comments are only allowed on lines on their own. Trailing comments on - other lines are not allowed because they could be confused with program - options. - - -:: - - executable proglet - main-is: Main.hs - -- other-modules: - -- other-extensions: - build-depends: base >=4.11 && <4.12 - -- hs-source-dirs: - default-language: Haskell2010 - - -If you selected earlier to create a library package then your ``.cabal`` -file will have a section that looks like this: - -:: - - library - exposed-modules: MyLib - -- other-modules: - -- build-depends: - build-depends: base >=4.11 && <4.12 - -- hs-source-dirs: - default-language: Haskell2010 - - -The build information fields listed (but commented out) are just the few -most important and common fields. There are many others that are covered -later in this chapter. - -Most of the build information fields are the same between libraries and -executables. The difference is that libraries have a number of "exposed" -modules that make up the public interface of the library, while -executables have a file containing a ``Main`` module. - -The name of a library always matches the name of the package, so it is -not specified in the library section. Executables often follow the name -of the package too, but this is not required and the name is given -explicitly. - - -Modules included in the package -------------------------------- - -For an executable, ``cabal init`` creates the ``Main.hs`` file which -contains your program's ``Main`` module. It will also fill in the -:pkg-field:`executable:main-is` field with the file name of your program's -``Main`` module, including the ``.hs`` (or ``.lhs``) extension. Other -modules included in the executable should be listed in the -:pkg-field:`other-modules` field. - -For a library, ``cabal init`` looks in the project directory for files -that look like Haskell modules and adds all the modules to the -:pkg-field:`library:exposed-modules` field. For modules that do not form part -of your package's public interface, you can move those modules to the -:pkg-field:`other-modules` field. Either way, all modules in the library need -to be listed. - - -Modules imported from other packages ------------------------------------- - -While your library or executable may include a number of modules, it -almost certainly also imports a number of external modules from the -standard libraries or other pre-packaged libraries. (These other -libraries are of course just Cabal packages that contain a library.) - -You have to list all of the library packages that your library or -executable imports modules from. Or to put it another way: you have to -list all the other packages that your package depends on. - -For example, suppose the example ``Proglet`` module imports the module -``Data.Map``. The ``Data.Map`` module comes from the ``containers`` -package, so we must list it: - -:: - - library - exposed-modules: Proglet - other-modules: - build-depends: containers, base >=4.11 && <4.12 - -In addition, almost every package also depends on the ``base`` library -package because it exports the standard ``Prelude`` module plus other -basic modules like ``Data.List``. - -You will notice that we have listed ``base >=4.11 && <4.12``. This gives a -constraint on the version of the base package that our package will work -with. The most common kinds of constraints are: - -- ``pkgname >=n`` -- ``pkgname ^>=n`` (since Cabal 2.0) -- ``pkgname >=n && =4 && <5``. Please refer to the documentation -on the :pkg-field:`build-depends` field for more information. - -Also, you can factor out shared ``build-depends`` (and other fields such -as ``ghc-options``) into a ``common`` stanza which you can ``import`` in -your libraries and executable sections. For example: - -:: - - common shared-properties - default-language: Haskell2010 - build-depends: - base == 4.* - ghc-options: - -Wall - - library - import: shared-properties - exposed-modules: - Proglet - -Note that the ``import`` **must** be the first thing in the stanza. For more -information see the :ref:`common-stanzas` section. - -.. _building-packages: - -Building the package --------------------- - -For simple packages that's it! We can now try building the package, -which also downloads and builds all required dependencies: - -.. code-block:: console - - $ cabal build - -If the package contains an executable, you can run it with: - -.. code-block:: console - - $ cabal run - -and the executable can also be installed for convenience: - -.. code-block:: console - - $ cabal install - -When installed, the executable program lands in a special directory -for binaries that may or may not already be on your system's ``PATH``. -If it is, the executable can be run by typing its filename on commandline. -For installing libraries see the :ref:`adding-libraries` section. - -Next steps ----------- - -What we have covered so far should be enough for very simple packages -that you use on your own system. - -The next few sections cover more details needed for more complex -packages and details needed for distributing packages to other people. - -The previous chapter covers building and installing packages -- your own -packages or ones developed by other people. - - Package concepts ================ From 9103d5eccdd55a735ed3c872cf890641b8aca606 Mon Sep 17 00:00:00 2001 From: Malte Neuss Date: Sat, 28 Oct 2023 23:04:52 +0200 Subject: [PATCH 23/70] Rename master_doc to root_doc (changed in version 4.0 of Sphynx) --- doc/conf.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/conf.py b/doc/conf.py index 84ea8de0f2d..b630823e5fa 100644 --- a/doc/conf.py +++ b/doc/conf.py @@ -25,7 +25,7 @@ templates_path = ['_templates'] source_suffix = '.rst' source_encoding = 'utf-8-sig' -master_doc = 'index' +root_doc = 'index' # extlinks -- see http://www.sphinx-doc.org/en/stable/ext/extlinks.html extlinks = { From 4ce4e480317ca342934cd4468aa57a7b93b9a79f Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Tue, 31 Oct 2023 23:38:37 +0000 Subject: [PATCH 24/70] Add instance Ord for Field, FieldLine, SectionArg and Name --- Cabal-syntax/src/Distribution/Fields/Field.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index c119ca5f1c0..c7d63533e52 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE StandaloneDeriving #-} -- | Cabal-like file AST types: 'Field', 'Section' etc -- @@ -51,6 +52,9 @@ data Field ann | Section !(Name ann) [SectionArg ann] [Field ann] deriving (Eq, Show, Functor, Foldable, Traversable) +-- | @since 3.12.0.0 +deriving instance Ord ann => Ord (Field ann) + -- | Section of field name fieldName :: Field ann -> Name ann fieldName (Field n _) = n @@ -73,6 +77,9 @@ fieldUniverse f@(Field _ _) = [f] data FieldLine ann = FieldLine !ann !ByteString deriving (Eq, Show, Functor, Foldable, Traversable) +-- | @since 3.12.0.0 +deriving instance Ord ann => Ord (FieldLine ann) + -- | @since 3.0.0.0 fieldLineAnn :: FieldLine ann -> ann fieldLineAnn (FieldLine ann _) = ann @@ -91,6 +98,9 @@ data SectionArg ann SecArgOther !ann !ByteString deriving (Eq, Show, Functor, Foldable, Traversable) +-- | @since 3.12.0.0 +deriving instance Ord ann => Ord (SectionArg ann) + -- | Extract annotation from 'SectionArg'. sectionArgAnn :: SectionArg ann -> ann sectionArgAnn (SecArgName ann _) = ann @@ -109,6 +119,9 @@ type FieldName = ByteString data Name ann = Name !ann !FieldName deriving (Eq, Show, Functor, Foldable, Traversable) +-- | @since 3.12.0.0 +deriving instance Ord ann => Ord (Name ann) + mkName :: ann -> FieldName -> Name ann mkName ann bs = Name ann (B.map Char.toLower bs) From c4d0a034d0057447b6a4ee639b58042f327586cd Mon Sep 17 00:00:00 2001 From: David Binder Date: Fri, 20 Oct 2023 12:25:07 +0200 Subject: [PATCH 25/70] Do not run CI for documentation changes The github workflows are not run if the changes are completely contained within the doc/ subdirectory. The only exception is the users-guide.yml github action. --- .github/workflows/lint.yml | 2 +- .github/workflows/validate.skip.yml | 33 +++++++++++++++++++++++++++++ .github/workflows/validate.yml | 5 +++++ 3 files changed, 39 insertions(+), 1 deletion(-) create mode 100644 .github/workflows/validate.skip.yml diff --git a/.github/workflows/lint.yml b/.github/workflows/lint.yml index 5e8e95c2c8b..1bae4d3d71b 100644 --- a/.github/workflows/lint.yml +++ b/.github/workflows/lint.yml @@ -15,4 +15,4 @@ jobs: - uses: haskell-actions/hlint-run@v2 with: path: "." - fail-on: suggestion \ No newline at end of file + fail-on: suggestion diff --git a/.github/workflows/validate.skip.yml b/.github/workflows/validate.skip.yml new file mode 100644 index 00000000000..b67d41dd2c4 --- /dev/null +++ b/.github/workflows/validate.skip.yml @@ -0,0 +1,33 @@ +name: Validate Skip + +# This Workflow is special and contains a workaround for a known limitation of GitHub CI. +# +# The problem: We don't want to run the "validate" jobs on PRs which contain only changes +# to the docs, since these jobs take a long time to complete without providing any benefit. +# We therefore use path-filtering in the workflow triggers for the validate jobs, namely +# "paths_ignore: doc/**". But the "Validate post job" is a required job, therefore a PR cannot +# be merged unless the "Validate post job" completes succesfully, which it doesn't do if we +# filter it out. +# +# The solution: We use a second job with the same name which always returns the exit code 0. +# The logic implemented for "required" workflows accepts if 1) at least one job with that name +# runs through, AND 2) If multiple jobs of that name exist, then all jobs of that name have to +# finish successfully. +on: + push: + paths: 'doc/**' + branches: + - master + pull_request: + paths: 'doc/**' + release: + types: + - created + +jobs: + validate-post-job: + if: always() + name: Validate post job + runs-on: ubuntu-latest + steps: + - run: exit 0 diff --git a/.github/workflows/validate.yml b/.github/workflows/validate.yml index 3f44655fd58..259fcfdca7c 100644 --- a/.github/workflows/validate.yml +++ b/.github/workflows/validate.yml @@ -11,11 +11,16 @@ concurrency: group: ${{ github.ref }}-${{ github.workflow }} cancel-in-progress: true +# Note: This workflow file contains the required job "Validate post job". We are using path filtering +# here to ignore PRs which only change documentation. This can cause a problem, see the workflow file +# "validate.skip.yml" for a description of the problem and the solution provided in that file. on: push: + paths-ignore: 'doc/**' branches: - master pull_request: + paths-ignore: 'doc/**' release: types: - created From 653e8747ac2467c4976f2f2127f4c174924f0f94 Mon Sep 17 00:00:00 2001 From: David Binder Date: Mon, 6 Nov 2023 02:45:56 +0100 Subject: [PATCH 26/70] Move Backpack section to user guides --- doc/cabal-package-description-file.rst | 123 +------------------------ doc/how-to-use-backpack.rst | 117 +++++++++++++++++++++++ doc/index.rst | 1 + 3 files changed, 121 insertions(+), 120 deletions(-) create mode 100644 doc/how-to-use-backpack.rst diff --git a/doc/cabal-package-description-file.rst b/doc/cabal-package-description-file.rst index 485389a0916..64b347c031c 100644 --- a/doc/cabal-package-description-file.rst +++ b/doc/cabal-package-description-file.rst @@ -890,7 +890,7 @@ The library section should contain the following fields: Supported only in GHC 8.2 and later. A list of `module signatures `__ required by this package. - Module signatures are part of the Backpack_ extension to + Module signatures are part of the :ref:`Backpack` extension to the Haskell module system. Packages that do not export any modules and only export required signatures @@ -2211,7 +2211,7 @@ system-dependent values for these fields. See the :pkg-field:`library:signatures` field for more details. - Mixin packages are part of the Backpack_ extension to the + Mixin packages are part of the :ref:`Backpack` extension to the Haskell module system. The matching of the module signatures required by a @@ -2224,7 +2224,7 @@ system-dependent values for these fields. .. Warning:: - Backpack_ has the limitation that implementation modules that instantiate + :ref:`Backpack` has the limitation that implementation modules that instantiate signatures required by a :pkg-field:`build-depends` dependency can't reside in the same component that has the dependency. They must reside in a different package dependency, or at least in a separate internal @@ -3305,123 +3305,6 @@ a few options: library for all or part of the work. One option is to copy the source of ``Distribution.Simple``, and alter it for your needs. Good luck. -.. _Backpack: - -Backpack --------- - -Cabal and GHC jointly support Backpack, an extension to Haskell's module -system which makes it possible to parametrize a package over some -modules, which can be instantiated later arbitrarily by a user. This -means you can write a library to be agnostic over some data -representation, and then instantiate it several times with different -data representations. Like C++ templates, instantiated packages are -recompiled for each instantiation, which means you do not pay any -runtime cost for parametrizing packages in this way. Backpack modules -are somewhat experimental; while fully supported by cabal-install, they are currently -`not supported by Stack `__. - -A Backpack package is defined by use of the -:pkg-field:`library:signatures` field, or by (transitive) dependency on -a package that defines some requirements. To define a parametrized -package, define a signature file (file extension ``hsig``) that -specifies the signature of the module you want to parametrize over, and -add it to your Cabal file in the :pkg-field:`library:signatures` field. - -.. code-block:: haskell - :caption: .hsig - - signature Str where - - data Str - - concat :: [Str] -> Str - -.. code-block:: cabal - :caption: parametrized.cabal - - cabal-version: 2.2 - name: parametrized - - library - build-depends: base - signatures: Str - exposed-modules: MyModule - -You can define any number of regular modules (e.g., ``MyModule``) that -import signatures and use them as regular modules. - -If you are familiar with ML modules, you might now expect there to be -some way to apply the parametrized package with an implementation of -the ``Str`` module to get a concrete instantiation of the package. -Backpack operates slightly differently with a concept of *mix-in -linking*, where you provide an implementation of ``Str`` simply by -bringing another module into scope with the same name as the -requirement. For example, if you had a package ``str-impl`` that provided a -module named ``Str``, instantiating ``parametrized`` is as simple as -just depending on both ``str-impl`` and ``parametrized``: - -.. code-block:: cabal - :caption: combined.cabal - - cabal-version: 2.2 - name: combined - - library - build-depends: base, str-impl, parametrized - -Note that due to technical limitations, you cannot directly define -``Str`` in the ``combined`` library; it must be placed in its own -library (you can use :ref:`Sublibraries ` to conveniently -define a sub-library). - -However, a more common situation is that your names don't match up -exactly. The :pkg-field:`library:mixins` field can be used to rename -signatures and modules to line up names as necessary. If you have -a requirement ``Str`` and an implementation ``Data.Text``, you can -line up the names in one of two ways: - -* Rename the requirement to match the implementation: - ``mixins: parametrized requires (Str as Data.Text)`` -* Rename the implementation to match the requirement: - ``mixins: text (Data.Text as Str)`` - -The :pkg-field:`library:mixins` field can also be used to disambiguate -between multiple instantiations of the same package; for each -instantiation of the package, give it a separate entry in mixins with -the requirements and provided modules renamed to be distinct. - -.. code-block:: cabal - :caption: .cabal - - cabal-version: 2.2 - name: double-combined - - library - build-depends: base, text, bytestring, parametrized - mixins: - parametrized (MyModule as MyModule.Text) requires (Str as Data.Text), - parametrized (MyModule as MyModule.BS) requires (Str as Data.ByteString) - -Intensive use of Backpack sometimes involves creating lots of small -parametrized libraries; :ref:`Sublibraries ` can be used -to define all of these libraries in a single package without having to -create many separate Cabal packages. You may also find it useful to use -:pkg-field:`library:reexported-modules` to reexport instantiated -libraries to Backpack-unware users (e.g., Backpack can be used entirely -as an implementation detail.) - -Backpack imposes a limitation on Template Haskell that goes beyond the usual TH -stage restriction: it's not possible to splice TH code imported from a -compilation unit that is still "indefinite", that is, a unit for which some -module signatures still haven't been matched with implementations. The reason -is that indefinite units are typechecked, but not compiled, so there's no -actual TH code to run while splicing. Splicing TH code from a definite -compilation unit into an indefinite one works normally. - -For more information about Backpack, check out the -`GHC wiki page `__. - .. include:: references.inc .. rubric:: Footnotes diff --git a/doc/how-to-use-backpack.rst b/doc/how-to-use-backpack.rst new file mode 100644 index 00000000000..23d58298b2d --- /dev/null +++ b/doc/how-to-use-backpack.rst @@ -0,0 +1,117 @@ +.. _Backpack: + +How to use Backpack modules +=========================== + +Cabal and GHC jointly support Backpack, an extension to Haskell's module +system which makes it possible to parametrize a package over some +modules, which can be instantiated later arbitrarily by a user. This +means you can write a library to be agnostic over some data +representation, and then instantiate it several times with different +data representations. Like C++ templates, instantiated packages are +recompiled for each instantiation, which means you do not pay any +runtime cost for parametrizing packages in this way. Backpack modules +are somewhat experimental; while fully supported by cabal-install, they are currently +`not supported by Stack `__. + +A Backpack package is defined by use of the +:pkg-field:`library:signatures` field, or by (transitive) dependency on +a package that defines some requirements. To define a parametrized +package, define a signature file (file extension ``hsig``) that +specifies the signature of the module you want to parametrize over, and +add it to your Cabal file in the :pkg-field:`library:signatures` field. + +.. code-block:: haskell + :caption: .hsig + + signature Str where + + data Str + + concat :: [Str] -> Str + +.. code-block:: cabal + :caption: parametrized.cabal + + cabal-version: 2.2 + name: parametrized + + library + build-depends: base + signatures: Str + exposed-modules: MyModule + +You can define any number of regular modules (e.g., ``MyModule``) that +import signatures and use them as regular modules. + +If you are familiar with ML modules, you might now expect there to be +some way to apply the parametrized package with an implementation of +the ``Str`` module to get a concrete instantiation of the package. +Backpack operates slightly differently with a concept of *mix-in +linking*, where you provide an implementation of ``Str`` simply by +bringing another module into scope with the same name as the +requirement. For example, if you had a package ``str-impl`` that provided a +module named ``Str``, instantiating ``parametrized`` is as simple as +just depending on both ``str-impl`` and ``parametrized``: + +.. code-block:: cabal + :caption: combined.cabal + + cabal-version: 2.2 + name: combined + + library + build-depends: base, str-impl, parametrized + +Note that due to technical limitations, you cannot directly define +``Str`` in the ``combined`` library; it must be placed in its own +library (you can use :ref:`Sublibraries ` to conveniently +define a sub-library). + +However, a more common situation is that your names don't match up +exactly. The :pkg-field:`library:mixins` field can be used to rename +signatures and modules to line up names as necessary. If you have +a requirement ``Str`` and an implementation ``Data.Text``, you can +line up the names in one of two ways: + +* Rename the requirement to match the implementation: + ``mixins: parametrized requires (Str as Data.Text)`` +* Rename the implementation to match the requirement: + ``mixins: text (Data.Text as Str)`` + +The :pkg-field:`library:mixins` field can also be used to disambiguate +between multiple instantiations of the same package; for each +instantiation of the package, give it a separate entry in mixins with +the requirements and provided modules renamed to be distinct. + +.. code-block:: cabal + :caption: .cabal + + cabal-version: 2.2 + name: double-combined + + library + build-depends: base, text, bytestring, parametrized + mixins: + parametrized (MyModule as MyModule.Text) requires (Str as Data.Text), + parametrized (MyModule as MyModule.BS) requires (Str as Data.ByteString) + +Intensive use of Backpack sometimes involves creating lots of small +parametrized libraries; :ref:`Sublibraries ` can be used +to define all of these libraries in a single package without having to +create many separate Cabal packages. You may also find it useful to use +:pkg-field:`library:reexported-modules` to reexport instantiated +libraries to Backpack-unware users (e.g., Backpack can be used entirely +as an implementation detail.) + +Backpack imposes a limitation on Template Haskell that goes beyond the usual TH +stage restriction: it's not possible to splice TH code imported from a +compilation unit that is still "indefinite", that is, a unit for which some +module signatures still haven't been matched with implementations. The reason +is that indefinite units are typechecked, but not compiled, so there's no +actual TH code to run while splicing. Splicing TH code from a definite +compilation unit into an indefinite one works normally. + +For more information about Backpack, check out the +`GHC wiki page `__. + diff --git a/doc/index.rst b/doc/index.rst index ed882247ea7..69109a67685 100644 --- a/doc/index.rst +++ b/doc/index.rst @@ -15,6 +15,7 @@ Welcome to the Cabal User Guide how-to-package-haskell-code how-to-build-like-nix + how-to-use-backpack how-to-report-bugs .. toctree:: From c79eeb10822eca22ca7b209bbbeaeb706d194ca6 Mon Sep 17 00:00:00 2001 From: David Binder Date: Mon, 6 Nov 2023 02:48:10 +0100 Subject: [PATCH 27/70] Remove TBW virtual modules section --- doc/buildinfo-fields-reference.rst | 2 +- doc/cabal-package-description-file.rst | 10 ---------- 2 files changed, 1 insertion(+), 11 deletions(-) diff --git a/doc/buildinfo-fields-reference.rst b/doc/buildinfo-fields-reference.rst index 910bcf6813c..9deea2ba4d3 100644 --- a/doc/buildinfo-fields-reference.rst +++ b/doc/buildinfo-fields-reference.rst @@ -504,7 +504,7 @@ pkgconfig-depends virtual-modules * Monoidal field * Available since ``cabal-version: 2.2``. - * Documentation of :pkg-field:`virtual-modules` + * Documentation of :pkg-field:`library:virtual-modules` .. math:: \mathrm{commalist}\left({\left(\mathop{\mathit{upper}}{\left\{ \mathop{\mathit{alpha\text{-}num}}\mid[\mathop{\mathord{``}\mathtt{\text{'}}\mathord{"}}\mathop{\mathord{``}\mathtt{\text{_}}\mathord{"}}] \right\}}^\ast_{}\right)}^+_{\mathop{\mathord{``}\mathtt{\text{.}}\mathord{"}}}\right) diff --git a/doc/cabal-package-description-file.rst b/doc/cabal-package-description-file.rst index 64b347c031c..10cd6e51704 100644 --- a/doc/cabal-package-description-file.rst +++ b/doc/cabal-package-description-file.rst @@ -2923,16 +2923,6 @@ Right now :pkg-field:`executable:main-is` modules are not supported on (e.g. by a ``configure`` script). Autogenerated header files are not packaged by ``sdist`` command. -Virtual modules ---------------- - -TBW - -.. pkg-field:: virtual-modules: module list - :since: 2.2 - - TBW - .. _accessing-data-files: From 413f3368db5701af014210b5887fb2375d82363f Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 22 Oct 2023 16:40:50 -0400 Subject: [PATCH 28/70] Add reinstall test to LinkerOptions/NonignoredConfigs --- .../LinkerOptions/NonignoredConfigs/cabal.out | 28 +++++++++++++++++++ .../NonignoredConfigs/cabal.test.hs | 5 +++- 2 files changed, 32 insertions(+), 1 deletion(-) diff --git a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out index 242bb523282..f789801ca19 100644 --- a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out +++ b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out @@ -10,6 +10,13 @@ Building library for basic-0.1... Installing library in # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Error: [Cabal-7145] +Packages requested to install already exist in environment file at /cabal.dist/basic0.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Resolving dependencies... +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -20,7 +27,28 @@ Building library for basic-0.1... Installing library in # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Error: [Cabal-7145] +Packages requested to install already exist in environment file at /cabal.dist/basic1.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Resolving dependencies... +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Error: [Cabal-7145] +Packages requested to install already exist in environment file at /cabal.dist/basic2.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Resolving dependencies... +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Resolving dependencies... +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Error: [Cabal-7145] +Packages requested to install already exist in environment file at /cabal.dist/basic3.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... diff --git a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs index 9da924366f4..23d88570aa1 100644 --- a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs +++ b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs @@ -70,7 +70,10 @@ main = cabalTest $ do -- (see 'testCurrentDir').) withDirectory ".." $ do packageEnv <- ( ("basic" ++ show idx ++ ".env")) . testWorkDir <$> getTestEnv - cabal "v2-install" $ ["--disable-deterministic", "--lib", "--package-env=" ++ packageEnv] ++ linkConfigFlags linking ++ ["basic"] + let installOptions = ["--disable-deterministic", "--lib", "--package-env=" ++ packageEnv] ++ linkConfigFlags linking ++ ["basic"] + cabal "v2-install" installOptions + fails $ cabal "v2-install" installOptions + cabal "v2-install" $ "--force-reinstalls" : installOptions let exIPID s = takeWhile (/= '\n') . head . filter (\t -> any (`isPrefixOf` t) ["basic-0.1-", "bsc-0.1-"]) $ tails s hashedIpid <- exIPID <$> liftIO (readFile packageEnv) return $ ((idx, linking), hashedIpid) From 4c63a980c17adec53f6593d02857b86c591def59 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 6 Nov 2023 10:20:28 -0500 Subject: [PATCH 29/70] Record install options --- .../LinkerOptions/NonignoredConfigs/cabal.out | 12 ++++++++++++ .../LinkerOptions/NonignoredConfigs/cabal.test.hs | 10 +++++++--- 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out index f789801ca19..34592d494be 100644 --- a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out +++ b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out @@ -1,3 +1,4 @@ +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic0.env basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... @@ -8,13 +9,16 @@ Configuring library for basic-0.1... Preprocessing library for basic-0.1... Building library for basic-0.1... Installing library in +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic0.env basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Error: [Cabal-7145] Packages requested to install already exist in environment file at /cabal.dist/basic0.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# install options: --force-reinstalls --disable-deterministic --lib --package-env=/cabal.dist/basic0.env basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic1.env --enable-shared --enable-executable-dynamic --disable-library-vanilla basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... @@ -25,30 +29,38 @@ Configuring library for basic-0.1... Preprocessing library for basic-0.1... Building library for basic-0.1... Installing library in +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic1.env --enable-shared --enable-executable-dynamic --disable-library-vanilla basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Error: [Cabal-7145] Packages requested to install already exist in environment file at /cabal.dist/basic1.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# install options: --force-reinstalls --disable-deterministic --lib --package-env=/cabal.dist/basic1.env --enable-shared --enable-executable-dynamic --disable-library-vanilla basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic2.env basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic2.env basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Error: [Cabal-7145] Packages requested to install already exist in environment file at /cabal.dist/basic2.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# install options: --force-reinstalls --disable-deterministic --lib --package-env=/cabal.dist/basic2.env basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic3.env --enable-shared --enable-executable-dynamic --disable-library-vanilla basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic3.env --enable-shared --enable-executable-dynamic --disable-library-vanilla basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Error: [Cabal-7145] Packages requested to install already exist in environment file at /cabal.dist/basic3.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# install options: --force-reinstalls --disable-deterministic --lib --package-env=/cabal.dist/basic3.env --enable-shared --enable-executable-dynamic --disable-library-vanilla basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... diff --git a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs index 23d88570aa1..899bb03b430 100644 --- a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs +++ b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs @@ -71,9 +71,13 @@ main = cabalTest $ do withDirectory ".." $ do packageEnv <- ( ("basic" ++ show idx ++ ".env")) . testWorkDir <$> getTestEnv let installOptions = ["--disable-deterministic", "--lib", "--package-env=" ++ packageEnv] ++ linkConfigFlags linking ++ ["basic"] - cabal "v2-install" installOptions - fails $ cabal "v2-install" installOptions - cabal "v2-install" $ "--force-reinstalls" : installOptions + recordMode RecordMarked $ do + recordHeader $ "install options:" : installOptions + cabal "v2-install" installOptions + recordHeader $ "install options:" : installOptions + fails $ cabal "v2-install" installOptions + recordHeader $ "install options:" : "--force-reinstalls" : installOptions + cabal "v2-install" $ "--force-reinstalls" : installOptions let exIPID s = takeWhile (/= '\n') . head . filter (\t -> any (`isPrefixOf` t) ["basic-0.1-", "bsc-0.1-"]) $ tails s hashedIpid <- exIPID <$> liftIO (readFile packageEnv) return $ ((idx, linking), hashedIpid) From 13247e8bb65756fef5474cb3e94acca162b4032d Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 9 Nov 2023 10:32:45 +0100 Subject: [PATCH 30/70] Reject index-states after last known index-state (#8944) Co-authored-by: Javier Sagredo Co-authored-by: Andrea Bedini Co-authored-by: Andrea Bedini --- .gitignore | 3 + .../src/Distribution/Client/CmdUpdate.hs | 31 ++-- .../src/Distribution/Client/Errors.hs | 21 +++ .../src/Distribution/Client/IndexUtils.hs | 174 ++++++++++-------- .../Client/IndexUtils/Timestamp.hs | 62 +++---- .../Distribution/Client/ArbitraryInstances.hs | 2 +- .../Client/IndexUtils/Timestamp.hs | 27 +-- .../Get/OnlyDescription/cabal.test.hs | 1 + .../PackageTests/Get/T7248/cabal.out | 6 +- .../RejectFutureIndexStates/cabal.out.in | 13 ++ .../RejectFutureIndexStates/cabal.project | 1 + .../RejectFutureIndexStates/cabal.test.hs | 19 ++ .../RejectFutureIndexStates/fake-pkg/Main.hs | 3 + .../fake-pkg/fake-pkg.cabal | 8 + .../repo/pkg-1.0/Foo.hs | 3 + .../repo/pkg-1.0/pkg.cabal | 8 + changelog.d/die-on-missing-pkg-list | 11 ++ changelog.d/index-state-cabal-update | 14 ++ 18 files changed, 258 insertions(+), 149 deletions(-) create mode 100644 cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out.in create mode 100644 cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.project create mode 100644 cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/Main.hs create mode 100644 cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/fake-pkg.cabal create mode 100644 cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/Foo.hs create mode 100644 cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/pkg.cabal create mode 100644 changelog.d/die-on-missing-pkg-list create mode 100644 changelog.d/index-state-cabal-update diff --git a/.gitignore b/.gitignore index 72a16455c82..4ade63478ab 100644 --- a/.gitignore +++ b/.gitignore @@ -85,3 +85,6 @@ bench.html # Emacs .projectile + +# I'm unsure how to ignore these generated golden files +cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out diff --git a/cabal-install/src/Distribution/Client/CmdUpdate.hs b/cabal-install/src/Distribution/Client/CmdUpdate.hs index 8f66a33a363..c0f4e05a137 100644 --- a/cabal-install/src/Distribution/Client/CmdUpdate.hs +++ b/cabal-install/src/Distribution/Client/CmdUpdate.hs @@ -98,7 +98,7 @@ import Distribution.Simple.Command import System.FilePath (dropExtension, (<.>)) import Distribution.Client.Errors -import Distribution.Client.IndexUtils.Timestamp (nullTimestamp) +import Distribution.Client.IndexUtils.Timestamp (Timestamp (NoTimestamp)) import qualified Hackage.Security.Client as Sec updateCommand :: CommandUI (NixStyleFlags ()) @@ -257,18 +257,19 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do updateRepoIndexCache verbosity (RepoIndex repoCtxt repo) RepoSecure{} -> repoContextWithSecureRepo repoCtxt repo $ \repoSecure -> do let index = RepoIndex repoCtxt repo - -- NB: This may be a nullTimestamp if we've never updated before - current_ts <- currentIndexTimestamp (lessVerbose verbosity) repoCtxt repo + -- NB: This may be a NoTimestamp if we've never updated before + current_ts <- currentIndexTimestamp (lessVerbose verbosity) index -- NB: always update the timestamp, even if we didn't actually -- download anything writeIndexTimestamp index indexState - ce <- - if repoContextIgnoreExpiry repoCtxt - then Just `fmap` getCurrentTime - else return Nothing - updated <- Sec.uncheckClientErrors $ Sec.checkForUpdates repoSecure ce - -- this resolves indexState (which could be HEAD) into a timestamp - new_ts <- currentIndexTimestamp (lessVerbose verbosity) repoCtxt repo + + updated <- do + ce <- + if repoContextIgnoreExpiry repoCtxt + then Just <$> getCurrentTime + else return Nothing + Sec.uncheckClientErrors $ Sec.checkForUpdates repoSecure ce + let rname = remoteRepoName (repoRemote repo) -- Update cabal's internal index as well so that it's not out of sync @@ -277,7 +278,8 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do Sec.NoUpdates -> do now <- getCurrentTime setModificationTime (indexBaseName repo <.> "tar") now - `catchIO` (\e -> warn verbosity $ "Could not set modification time of index tarball -- " ++ displayException e) + `catchIO` \e -> + warn verbosity $ "Could not set modification time of index tarball -- " ++ displayException e noticeNoWrap verbosity $ "Package list of " ++ prettyShow rname ++ " is up to date." Sec.HasUpdates -> do @@ -285,6 +287,11 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do noticeNoWrap verbosity $ "Package list of " ++ prettyShow rname ++ " has been updated." + -- This resolves indexState (which could be HEAD) into a timestamp + -- This could be null but should not be, since the above guarantees + -- we have an updated index. + new_ts <- currentIndexTimestamp (lessVerbose verbosity) index + noticeNoWrap verbosity $ "The index-state is set to " ++ prettyShow (IndexStateTime new_ts) ++ "." @@ -294,7 +301,7 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do -- In case current_ts is a valid timestamp different from new_ts, let -- the user know how to go back to current_ts - when (current_ts /= nullTimestamp && new_ts /= current_ts) $ + when (current_ts /= NoTimestamp && new_ts /= current_ts) $ noticeNoWrap verbosity $ "To revert to previous state run:\n" ++ " cabal v2-update '" diff --git a/cabal-install/src/Distribution/Client/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs index 5db31ba5d3b..ada3eca5268 100644 --- a/cabal-install/src/Distribution/Client/Errors.hs +++ b/cabal-install/src/Distribution/Client/Errors.hs @@ -25,6 +25,9 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as BS8 import Data.List (groupBy) +import Distribution.Client.IndexUtils.Timestamp +import Distribution.Client.Types.Repo +import Distribution.Client.Types.RepoName (RepoName (..)) import Distribution.Compat.Prelude import Distribution.Deprecated.ParseUtils (PWarning, showPWarning) import Distribution.Package @@ -179,6 +182,8 @@ data CabalInstallException | FreezeException String | PkgSpecifierException [String] | CorruptedIndexCache String + | UnusableIndexState RemoteRepo Timestamp Timestamp + | MissingPackageList RemoteRepo deriving (Show, Typeable) exceptionCodeCabalInstall :: CabalInstallException -> Int @@ -327,6 +332,8 @@ exceptionCodeCabalInstall e = case e of FreezeException{} -> 7156 PkgSpecifierException{} -> 7157 CorruptedIndexCache{} -> 7158 + UnusableIndexState{} -> 7159 + MissingPackageList{} -> 7160 exceptionMessageCabalInstall :: CabalInstallException -> String exceptionMessageCabalInstall e = case e of @@ -828,6 +835,20 @@ exceptionMessageCabalInstall e = case e of FreezeException errs -> errs PkgSpecifierException errorStr -> unlines errorStr CorruptedIndexCache str -> str + UnusableIndexState repoRemote maxFound requested -> + "Latest known index-state for '" + ++ unRepoName (remoteRepoName repoRemote) + ++ "' (" + ++ prettyShow maxFound + ++ ") is older than the requested index-state (" + ++ prettyShow requested + ++ ").\nRun 'cabal update' or set the index-state to a value at or before " + ++ prettyShow maxFound + ++ "." + MissingPackageList repoRemote -> + "The package list for '" + ++ unRepoName (remoteRepoName repoRemote) + ++ "' does not exist. Run 'cabal update' to download it." instance Exception (VerboseException CabalInstallException) where displayException :: VerboseException CabalInstallException -> [Char] diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index e2ea4486426..2dc7d37e29c 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -212,7 +212,7 @@ data IndexStateInfo = IndexStateInfo } emptyStateInfo :: IndexStateInfo -emptyStateInfo = IndexStateInfo nullTimestamp nullTimestamp +emptyStateInfo = IndexStateInfo NoTimestamp NoTimestamp -- | Filters a 'Cache' according to an 'IndexState' -- specification. Also returns 'IndexStateInfo' describing the @@ -318,40 +318,31 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do IndexStateHead -> do info verbosity ("index-state(" ++ unRepoName rname ++ ") = " ++ prettyShow (isiHeadTime isi)) return () - IndexStateTime ts0 -> do + IndexStateTime ts0 -> + -- isiMaxTime is the latest timestamp in the filtered view returned by + -- `readRepoIndex` above. It is always true that isiMaxTime is less or + -- equal to a requested IndexStateTime. When `isiMaxTime isi /= ts0` (or + -- equivalently `isiMaxTime isi < ts0`) it means that ts0 falls between + -- two timestamps in the index. when (isiMaxTime isi /= ts0) $ - if ts0 > isiMaxTime isi - then - warn verbosity $ - "Requested index-state " - ++ prettyShow ts0 - ++ " is newer than '" + let commonMsg = + "There is no index-state for '" ++ unRepoName rname - ++ "'!" - ++ " Falling back to older state (" - ++ prettyShow (isiMaxTime isi) - ++ ")." - else - info verbosity $ - "Requested index-state " + ++ "' exactly at the requested timestamp (" ++ prettyShow ts0 - ++ " does not exist in '" - ++ unRepoName rname - ++ "'!" - ++ " Falling back to older state (" - ++ prettyShow (isiMaxTime isi) - ++ ")." - info - verbosity - ( "index-state(" - ++ unRepoName rname - ++ ") = " - ++ prettyShow (isiMaxTime isi) - ++ " (HEAD = " - ++ prettyShow (isiHeadTime isi) - ++ ")" - ) - + ++ "). " + in if isNothing $ timestampToUTCTime (isiMaxTime isi) + then + warn verbosity $ + commonMsg + ++ "Also, there are no index-states before the one requested, so the repository '" + ++ unRepoName rname + ++ "' will be empty." + else + info verbosity $ + commonMsg + ++ "Falling back to the previous index-state that exists: " + ++ prettyShow (isiMaxTime isi) pure RepoData { rdRepoName = rname @@ -381,7 +372,7 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do [ (n, IndexStateTime ts) | (RepoData n ts _idx _prefs, _strategy) <- pkgss' , -- e.g. file+noindex have nullTimestamp as their timestamp - ts /= nullTimestamp + ts /= NoTimestamp ] let addIndex @@ -439,15 +430,16 @@ readRepoIndex -> IO (PackageIndex UnresolvedSourcePackage, [Dependency], IndexStateInfo) readRepoIndex verbosity repoCtxt repo idxState = handleNotFound $ do - when (isRepoRemote repo) $ warnIfIndexIsOld =<< getIndexFileAge repo - -- note that if this step fails due to a bad repo cache, the the procedure can still succeed by reading from the existing cache, which is updated regardless. - updateRepoIndexCache verbosity (RepoIndex repoCtxt repo) - `catchIO` (\e -> warn verbosity $ "unable to update the repo index cache -- " ++ displayException e) - readPackageIndexCacheFile - verbosity - mkAvailablePackage - (RepoIndex repoCtxt repo) - idxState + ret@(_, _, isi) <- + readPackageIndexCacheFile + verbosity + mkAvailablePackage + (RepoIndex repoCtxt repo) + idxState + when (isRepoRemote repo) $ do + warnIfIndexIsOld =<< getIndexFileAge repo + dieIfRequestedIdxIsNewer isi + pure ret where mkAvailablePackage pkgEntry = SourcePackage @@ -468,8 +460,8 @@ readRepoIndex verbosity repoCtxt repo idxState = if isDoesNotExistError e then do case repo of - RepoRemote{..} -> warn verbosity $ errMissingPackageList repoRemote - RepoSecure{..} -> warn verbosity $ errMissingPackageList repoRemote + RepoRemote{..} -> dieWithException verbosity $ MissingPackageList repoRemote + RepoSecure{..} -> dieWithException verbosity $ MissingPackageList repoRemote RepoLocalNoIndex local _ -> warn verbosity $ "Error during construction of local+noindex " @@ -479,18 +471,25 @@ readRepoIndex verbosity repoCtxt repo idxState = return (mempty, mempty, emptyStateInfo) else ioError e + isOldThreshold :: Double isOldThreshold = 15 -- days warnIfIndexIsOld dt = do when (dt >= isOldThreshold) $ case repo of - RepoRemote{..} -> warn verbosity $ errOutdatedPackageList repoRemote dt - RepoSecure{..} -> warn verbosity $ errOutdatedPackageList repoRemote dt + RepoRemote{..} -> warn verbosity $ warnOutdatedPackageList repoRemote dt + RepoSecure{..} -> warn verbosity $ warnOutdatedPackageList repoRemote dt RepoLocalNoIndex{} -> return () - errMissingPackageList repoRemote = - "The package list for '" - ++ unRepoName (remoteRepoName repoRemote) - ++ "' does not exist. Run 'cabal update' to download it." - errOutdatedPackageList repoRemote dt = + dieIfRequestedIdxIsNewer isi = + let latestTime = isiHeadTime isi + in case idxState of + IndexStateTime t -> when (t > latestTime) $ case repo of + RepoSecure{..} -> + dieWithException verbosity $ UnusableIndexState repoRemote latestTime t + RepoRemote{} -> pure () + RepoLocalNoIndex{} -> return () + IndexStateHead -> pure () + + warnOutdatedPackageList repoRemote dt = "The package list for '" ++ unRepoName (remoteRepoName repoRemote) ++ "' is " @@ -852,9 +851,8 @@ withIndexEntries _ (RepoIndex repoCtxt repo@RepoSecure{}) callback _ = where blockNo = Sec.directoryEntryBlockNo dirEntry timestamp = - fromMaybe (error "withIndexEntries: invalid timestamp") $ - epochTimeToTimestamp $ - Sec.indexEntryTime sie + epochTimeToTimestamp $ + Sec.indexEntryTime sie withIndexEntries verbosity (RepoIndex _repoCtxt (RepoLocalNoIndex (LocalRepo name localDir _) _cacheDir)) _ callback = do dirContents <- listDirectory localDir let contentSet = Set.fromList dirContents @@ -942,10 +940,14 @@ withIndexEntries verbosity index callback _ = do callback $ map toCache (catMaybes pkgsOrPrefs) where toCache :: PackageOrDep -> IndexCacheEntry - toCache (Pkg (NormalPackage pkgid _ _ blockNo)) = CachePackageId pkgid blockNo nullTimestamp + toCache (Pkg (NormalPackage pkgid _ _ blockNo)) = CachePackageId pkgid blockNo NoTimestamp toCache (Pkg (BuildTreeRef refType _ _ _ blockNo)) = CacheBuildTreeRef refType blockNo - toCache (Dep d) = CachePreference d 0 nullTimestamp + toCache (Dep d) = CachePreference d 0 NoTimestamp +-- | Read package data from a repository. +-- Throws IOException if any arise while accessing the index +-- (unless the repo is local+no-index) and dies if the cache +-- is corrupted and cannot be regenerated correctly. readPackageIndexCacheFile :: Package pkg => Verbosity @@ -959,12 +961,18 @@ readPackageIndexCacheFile verbosity mkPkg index idxState (pkgs, prefs) <- packageNoIndexFromCache verbosity mkPkg cache0 pure (pkgs, prefs, emptyStateInfo) | otherwise = do - cache0 <- readIndexCache verbosity index + (cache, isi) <- getIndexCache verbosity index idxState indexHnd <- openFile (indexFile index) ReadMode - let (cache, isi) = filterCache idxState cache0 (pkgs, deps) <- packageIndexFromCache verbosity mkPkg indexHnd cache pure (pkgs, deps, isi) +-- | Read 'Cache' and 'IndexStateInfo' from the repository index file. +-- Throws IOException if any arise (e.g. the index or its cache are missing). +-- Dies if the index cache is corrupted and cannot be regenerated correctly. +getIndexCache :: Verbosity -> Index -> RepoIndexState -> IO (Cache, IndexStateInfo) +getIndexCache verbosity index idxState = + filterCache idxState <$> readIndexCache verbosity index + packageIndexFromCache :: Package pkg => Verbosity @@ -1087,7 +1095,7 @@ packageListFromCache verbosity mkPkg hnd Cache{..} = accum mempty [] mempty cach ------------------------------------------------------------------------ -- Index cache data structure -- --- | Read the 'Index' cache from the filesystem +-- | Read a repository cache from the filesystem -- -- If a corrupted index cache is detected this function regenerates -- the index cache and then reattempt to read the index once (and @@ -1110,6 +1118,11 @@ readIndexCache verbosity index = do either (dieWithException verbosity . CorruptedIndexCache) (return . hashConsCache) =<< readIndexCache' index Right res -> return (hashConsCache res) +-- | Read a no-index repository cache from the filesystem +-- +-- If a corrupted index cache is detected this function regenerates +-- the index cache and then reattempts to read the index once (and +-- 'dieWithException's if it fails again). Throws IOException if any arise. readNoIndexCache :: Verbosity -> Index -> IO NoIndexCache readNoIndexCache verbosity index = do cacheOrFail <- readNoIndexCache' index @@ -1130,11 +1143,12 @@ readNoIndexCache verbosity index = do -- we don't hash cons local repository cache, they are hopefully small Right res -> return res --- | Read the 'Index' cache from the filesystem without attempting to --- regenerate on parsing failures. +-- | Read the 'Index' cache from the filesystem. Throws IO exceptions +-- if any arise and returns Left on invalid input. readIndexCache' :: Index -> IO (Either String Cache) readIndexCache' index - | is01Index index = structuredDecodeFileOrFail (cacheFile index) + | is01Index index = + structuredDecodeFileOrFail (cacheFile index) | otherwise = Right . read00IndexCache <$> BSS.readFile (cacheFile index) @@ -1159,15 +1173,27 @@ writeIndexTimestamp index st = writeFile (timestampFile index) (prettyShow st) -- | Read out the "current" index timestamp, i.e., what --- timestamp you would use to revert to this version -currentIndexTimestamp :: Verbosity -> RepoContext -> Repo -> IO Timestamp -currentIndexTimestamp verbosity repoCtxt r = do - mb_is <- readIndexTimestamp verbosity (RepoIndex repoCtxt r) +-- timestamp you would use to revert to this version. +-- +-- Note: this is not the same as 'readIndexTimestamp'! +-- This resolves HEAD to the index's 'isiHeadTime', i.e. +-- the index latest known timestamp. +-- +-- Return NoTimestamp if the index has never been updated. +currentIndexTimestamp :: Verbosity -> Index -> IO Timestamp +currentIndexTimestamp verbosity index = do + mb_is <- readIndexTimestamp verbosity index case mb_is of - Just (IndexStateTime ts) -> return ts - _ -> do - (_, _, isi) <- readRepoIndex verbosity repoCtxt r IndexStateHead - return (isiHeadTime isi) + -- If the index timestamp file specifies an index state time, use that + Just (IndexStateTime ts) -> + return ts + -- Otherwise used the head time as stored in the index cache + _otherwise -> + fmap (isiHeadTime . snd) (getIndexCache verbosity index IndexStateHead) + `catchIO` \e -> + if isDoesNotExistError e + then return NoTimestamp + else ioError e -- | Read the 'IndexState' from the filesystem readIndexTimestamp :: Verbosity -> Index -> IO (Maybe RepoIndexState) @@ -1259,7 +1285,7 @@ instance NFData NoIndexCacheEntry where rnf (NoIndexCachePreference dep) = rnf dep cacheEntryTimestamp :: IndexCacheEntry -> Timestamp -cacheEntryTimestamp (CacheBuildTreeRef _ _) = nullTimestamp +cacheEntryTimestamp (CacheBuildTreeRef _ _) = NoTimestamp cacheEntryTimestamp (CachePreference _ _ ts) = ts cacheEntryTimestamp (CachePackageId _ _ ts) = ts @@ -1311,7 +1337,7 @@ preferredVersionKey = "pref-ver:" read00IndexCache :: BSS.ByteString -> Cache read00IndexCache bs = Cache - { cacheHeadTs = nullTimestamp + { cacheHeadTs = NoTimestamp , cacheEntries = mapMaybe read00IndexCacheEntry $ BSS.lines bs } @@ -1329,7 +1355,7 @@ read00IndexCacheEntry = \line -> ( CachePackageId (PackageIdentifier pkgname pkgver) blockno - nullTimestamp + NoTimestamp ) _ -> Nothing [key, typecodestr, blocknostr] | key == BSS.pack buildTreeRefKey -> @@ -1339,7 +1365,7 @@ read00IndexCacheEntry = \line -> _ -> Nothing (key : remainder) | key == BSS.pack preferredVersionKey -> do pref <- simpleParsecBS (BSS.unwords remainder) - return $ CachePreference pref 0 nullTimestamp + return $ CachePreference pref 0 NoTimestamp _ -> Nothing where parseName str diff --git a/cabal-install/src/Distribution/Client/IndexUtils/Timestamp.hs b/cabal-install/src/Distribution/Client/IndexUtils/Timestamp.hs index 3dfe2963437..10034472277 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils/Timestamp.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils/Timestamp.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -12,8 +12,7 @@ -- -- Timestamp type used in package indexes module Distribution.Client.IndexUtils.Timestamp - ( Timestamp - , nullTimestamp + ( Timestamp (NoTimestamp) , epochTimeToTimestamp , timestampToUTCTime , utcTimeToTimestamp @@ -33,38 +32,30 @@ import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp -- | UNIX timestamp (expressed in seconds since unix epoch, i.e. 1970). -newtype Timestamp = TS Int64 -- Tar.EpochTime - deriving (Eq, Ord, Enum, NFData, Show, Generic) +data Timestamp = NoTimestamp | TS Int64 -- Tar.EpochTime + deriving (Eq, Ord, NFData, Show, Generic) -epochTimeToTimestamp :: Tar.EpochTime -> Maybe Timestamp -epochTimeToTimestamp et - | ts == nullTimestamp = Nothing - | otherwise = Just ts - where - ts = TS et +epochTimeToTimestamp :: Tar.EpochTime -> Timestamp +epochTimeToTimestamp = TS timestampToUTCTime :: Timestamp -> Maybe UTCTime -timestampToUTCTime (TS t) - | t == minBound = Nothing - | otherwise = Just $ posixSecondsToUTCTime (fromIntegral t) +timestampToUTCTime NoTimestamp = Nothing +timestampToUTCTime (TS t) = Just $ posixSecondsToUTCTime (fromIntegral t) -utcTimeToTimestamp :: UTCTime -> Maybe Timestamp -utcTimeToTimestamp utct - | minTime <= t, t <= maxTime = Just (TS (fromIntegral t)) - | otherwise = Nothing - where - maxTime = toInteger (maxBound :: Int64) - minTime = toInteger (succ minBound :: Int64) - t :: Integer - t = round . utcTimeToPOSIXSeconds $ utct +utcTimeToTimestamp :: UTCTime -> Timestamp +utcTimeToTimestamp = + TS + . (fromIntegral :: Integer -> Int64) + . round + . utcTimeToPOSIXSeconds -- | Compute the maximum 'Timestamp' value -- --- Returns 'nullTimestamp' for the empty list. Also note that --- 'nullTimestamp' compares as smaller to all non-'nullTimestamp' +-- Returns 'NoTimestamp' for the empty list. Also note that +-- 'NoTimestamp' compares as smaller to all non-'NoTimestamp' -- values. maximumTimestamp :: [Timestamp] -> Timestamp -maximumTimestamp [] = nullTimestamp +maximumTimestamp [] = NoTimestamp maximumTimestamp xs@(_ : _) = maximum xs -- returns 'Nothing' if not representable as 'Timestamp' @@ -76,17 +67,11 @@ posixSecondsToTimestamp pt maxTs = toInteger (maxBound :: Int64) minTs = toInteger (succ minBound :: Int64) --- | Pretty-prints 'Timestamp' in ISO8601/RFC3339 format --- (e.g. @"2017-12-31T23:59:59Z"@) --- --- Returns empty string for 'nullTimestamp' in order for --- --- > null (display nullTimestamp) == True --- --- to hold. +-- | Pretty-prints non-null 'Timestamp' in ISO8601/RFC3339 format +-- (e.g. @"2017-12-31T23:59:59Z"@). showTimestamp :: Timestamp -> String showTimestamp ts = case timestampToUTCTime ts of - Nothing -> "" + Nothing -> "Unknown or invalid timestamp" -- Note: we don't use 'formatTime' here to avoid incurring a -- dependency on 'old-locale' for older `time` libs Just UTCTime{..} -> showGregorian utctDay ++ ('T' : showTOD utctDayTime) ++ "Z" @@ -141,7 +126,7 @@ instance Parsec Timestamp where let utc = UTCTime{..} - maybe (fail (show utc ++ " is not representable as timestamp")) return $ utcTimeToTimestamp utc + return $ utcTimeToTimestamp utc parseTwoDigits = do d1 <- P.satisfy isDigit @@ -156,8 +141,3 @@ instance Parsec Timestamp where ds <- P.munch1 isDigit when (length ds < 4) $ fail "Year should have at least 4 digits" return (read (sign : ds)) - --- | Special timestamp value to be used when 'timestamp' is --- missing/unknown/invalid -nullTimestamp :: Timestamp -nullTimestamp = TS minBound diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs index bcd6e4134d1..13e06172f80 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs @@ -184,7 +184,7 @@ instance Arbitrary Timestamp where -- >>> utcTimeToPOSIXSeconds $ UTCTime (fromGregorian 100000 01 01) 0 -- >>> 3093527980800s -- - arbitrary = maybe (toEnum 0) id . epochTimeToTimestamp . (`mod` 3093527980800) . abs <$> arbitrary + arbitrary = epochTimeToTimestamp . (`mod` 3093527980800) . abs <$> arbitrary instance Arbitrary RepoIndexState where arbitrary = diff --git a/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs b/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs index 3b53e66c219..29c9fe587e0 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs @@ -23,23 +23,19 @@ tests = prop_timestamp1 :: NonNegative Int -> Bool prop_timestamp1 (NonNegative t0) = Just t == simpleParsec ('@' : show t0) where - t = toEnum t0 :: Timestamp + t = epochTimeToTimestamp $ toEnum t0 :: Timestamp -- test prettyShow/simpleParse roundtrip prop_timestamp2 :: Int -> Bool -prop_timestamp2 t0 - | t /= nullTimestamp = simpleParsec (prettyShow t) == Just t - | otherwise = prettyShow t == "" +prop_timestamp2 t0 = simpleParsec (prettyShow t) == Just t where - t = toEnum t0 :: Timestamp + t = epochTimeToTimestamp $ toEnum t0 :: Timestamp -- test prettyShow against reference impl prop_timestamp3 :: Int -> Bool -prop_timestamp3 t0 - | t /= nullTimestamp = refDisp t == prettyShow t - | otherwise = prettyShow t == "" +prop_timestamp3 t0 = refDisp t == prettyShow t where - t = toEnum t0 :: Timestamp + t = epochTimeToTimestamp $ toEnum t0 :: Timestamp refDisp = maybe undefined (formatTime undefined "%FT%TZ") @@ -47,16 +43,13 @@ prop_timestamp3 t0 -- test utcTimeToTimestamp/timestampToUTCTime roundtrip prop_timestamp4 :: Int -> Bool -prop_timestamp4 t0 - | t /= nullTimestamp = (utcTimeToTimestamp =<< timestampToUTCTime t) == Just t - | otherwise = timestampToUTCTime t == Nothing +prop_timestamp4 t0 = + (utcTimeToTimestamp <$> timestampToUTCTime t) == Just t where - t = toEnum t0 :: Timestamp + t = epochTimeToTimestamp $ toEnum t0 :: Timestamp prop_timestamp5 :: Int -> Bool -prop_timestamp5 t0 - | t /= nullTimestamp = timestampToUTCTime t == Just ut - | otherwise = timestampToUTCTime t == Nothing +prop_timestamp5 t0 = timestampToUTCTime t == Just ut where - t = toEnum t0 :: Timestamp + t = epochTimeToTimestamp $ toEnum t0 :: Timestamp ut = posixSecondsToUTCTime (fromIntegral t0) diff --git a/cabal-testsuite/PackageTests/Get/OnlyDescription/cabal.test.hs b/cabal-testsuite/PackageTests/Get/OnlyDescription/cabal.test.hs index 3b4a36553c7..359d29a33de 100644 --- a/cabal-testsuite/PackageTests/Get/OnlyDescription/cabal.test.hs +++ b/cabal-testsuite/PackageTests/Get/OnlyDescription/cabal.test.hs @@ -9,3 +9,4 @@ main = cabalTest $ withRepo "repo" $ do cabal "get" [ "criterion", "--only-package-description" ] + void (shell "rm" ["criterion-1.1.4.0.cabal"]) diff --git a/cabal-testsuite/PackageTests/Get/T7248/cabal.out b/cabal-testsuite/PackageTests/Get/T7248/cabal.out index 0c6e3ce035c..a172b425d4d 100644 --- a/cabal-testsuite/PackageTests/Get/T7248/cabal.out +++ b/cabal-testsuite/PackageTests/Get/T7248/cabal.out @@ -1,6 +1,4 @@ # cabal get Warning: /cabal.config: Unrecognized stanza on line 3 -Warning: The package list for 'repo.invalid' does not exist. Run 'cabal update' to download it. -Error: [Cabal-7100] -There is no package named 'a-b-s-e-n-t'. -You may need to run 'cabal update' to get the latest list of available packages. +Error: [Cabal-7160] +The package list for 'repo.invalid' does not exist. Run 'cabal update' to download it. diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out.in b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out.in new file mode 100644 index 00000000000..969b189c7b8 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out.in @@ -0,0 +1,13 @@ +# cabal build +Error: [Cabal-7159] +Latest known index-state for 'repository.localhost' (REPLACEME) is older than the requested index-state (4000-01-01T00:00:00Z). +Run 'cabal update' or set the index-state to a value at or before REPLACEME. +# cabal build +Warning: There is no index-state for 'repository.localhost' exactly at the requested timestamp (2023-01-01T00:00:00Z). Also, there are no index-states before the one requested, so the repository 'repository.localhost' will be empty. +Resolving dependencies... +Error: [Cabal-7107] +Could not resolve dependencies: +[__0] trying: fake-pkg-1.0 (user goal) +[__1] unknown package: pkg (dependency of fake-pkg) +[__1] fail (backjumping, conflict set: fake-pkg, pkg) +After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: fake-pkg (2), pkg (1) diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.project b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.project new file mode 100644 index 00000000000..a6de7296b36 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.project @@ -0,0 +1 @@ +packages: fake-pkg diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs new file mode 100644 index 00000000000..ca26a482d16 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs @@ -0,0 +1,19 @@ +import Test.Cabal.Prelude +import Data.List (isPrefixOf) + +main = cabalTest $ withProjectFile "cabal.project" $ withRemoteRepo "repo" $ do + output <- last + . words + . head + . filter ("Index cache updated to index-state " `isPrefixOf`) + . lines + . resultOutput + <$> recordMode DoNotRecord (cabal' "update" []) + -- update golden output with actual timestamp + shell "cp" ["cabal.out.in", "cabal.out"] + shell "sed" ["-i''", "-e", "s/REPLACEME/" <> output <> "/g", "cabal.out"] + -- This shall fail with an error message as specified in `cabal.out` + fails $ cabal "build" ["--index-state=4000-01-01T00:00:00Z", "fake-pkg"] + -- This shall fail by not finding the package, what indicates that it + -- accepted an older index-state. + fails $ cabal "build" ["--index-state=2023-01-01T00:00:00Z", "fake-pkg"] diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/Main.hs b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/Main.hs new file mode 100644 index 00000000000..e5f1c882aeb --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/Main.hs @@ -0,0 +1,3 @@ +module Main where + +main = print "hello" diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/fake-pkg.cabal b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/fake-pkg.cabal new file mode 100644 index 00000000000..813542d87f3 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/fake-pkg.cabal @@ -0,0 +1,8 @@ +version: 1.0 +name: fake-pkg +build-type: Simple +cabal-version: >= 1.2 + +executable my-exe + main-is: Main.hs + build-depends: base, pkg diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/Foo.hs b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/Foo.hs new file mode 100644 index 00000000000..9bb6374ab6c --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/Foo.hs @@ -0,0 +1,3 @@ +module Foo (someFunc) where + +someFunc = "hello" diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/pkg.cabal b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/pkg.cabal new file mode 100644 index 00000000000..b046359bf55 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/pkg.cabal @@ -0,0 +1,8 @@ +name: pkg +version: 1.0 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: Foo + build-depends: base diff --git a/changelog.d/die-on-missing-pkg-list b/changelog.d/die-on-missing-pkg-list new file mode 100644 index 00000000000..78e25843197 --- /dev/null +++ b/changelog.d/die-on-missing-pkg-list @@ -0,0 +1,11 @@ +synopsis: Die if package list is missing +packages: cabal-install +prs: #8944 + +description: { + +If a package list is missing, `cabal` will now die and suggest the user to run +`cabal update` instead of continuing into not being able to find packages coming +from the remote package server. + +} diff --git a/changelog.d/index-state-cabal-update b/changelog.d/index-state-cabal-update new file mode 100644 index 00000000000..f40ae672709 --- /dev/null +++ b/changelog.d/index-state-cabal-update @@ -0,0 +1,14 @@ +synopsis: Reject index-state younger than cached index file +packages: cabal-install +prs: #8944 + +description: { + +Requesting to use an index-state younger than the cached version will now fail, +telling the user to use an index-state older or equal to the cached file, or to +run `cabal update`. + +The warning for a non-existing index-state has been also demoted to appear only +on verbose logging. + +} From 9a27b91c92942a55d75e3fcfd1fb417e2a6cfa9c Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 30 Oct 2023 09:51:33 -0400 Subject: [PATCH 31/70] Note how to do "not equal" with constraints --- doc/cabal-package-description-file.rst | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/doc/cabal-package-description-file.rst b/doc/cabal-package-description-file.rst index 10cd6e51704..e8ab16fbce8 100644 --- a/doc/cabal-package-description-file.rst +++ b/doc/cabal-package-description-file.rst @@ -1479,8 +1479,22 @@ system-dependent values for these fields. Version constraints use the operators ``==, >=, >, <, <=`` and a version number. Multiple constraints can be combined using ``&&`` or - ``||``. If no version constraint is specified, any version is - assumed to be acceptable. For example: + ``||``. + + .. Note:: + + Even though there is no ``/=`` operator, by combining operators we can + skip over one or more versions, to skip a deprecated version or to skip + versions that upset the constraint solving. + + For example, the ``time =1.12.*`` series depends on ``base >=4.13 && <5`` + but ``time-1.12.3`` bumps the lower bound on base to ``>=4.14``. If we + still want to compile with a ``ghc-8.8.*`` version of GHC that ships with + ``base-4.13`` and with later GHC versions then we can use ``time >=1.12 + && (time <1.12.3 || time >1.12.3)``. + + If no version constraint is specified, any version is assumed to be + acceptable. For example: :: From 3c8d79b320aca851f0de2aa04c9211effc7deaa7 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 30 Oct 2023 13:25:16 -0400 Subject: [PATCH 32/70] Use comma with then Co-authored-by: Artem Pelenitsyn --- doc/cabal-package-description-file.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/cabal-package-description-file.rst b/doc/cabal-package-description-file.rst index e8ab16fbce8..96cc54e9c61 100644 --- a/doc/cabal-package-description-file.rst +++ b/doc/cabal-package-description-file.rst @@ -1490,7 +1490,7 @@ system-dependent values for these fields. For example, the ``time =1.12.*`` series depends on ``base >=4.13 && <5`` but ``time-1.12.3`` bumps the lower bound on base to ``>=4.14``. If we still want to compile with a ``ghc-8.8.*`` version of GHC that ships with - ``base-4.13`` and with later GHC versions then we can use ``time >=1.12 + ``base-4.13`` and with later GHC versions, then we can use ``time >=1.12 && (time <1.12.3 || time >1.12.3)``. If no version constraint is specified, any version is assumed to be From 4e6500539fc9b80c1aed35d1aaff748302dae630 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 30 Oct 2023 13:34:32 -0400 Subject: [PATCH 33/70] Use narrow rather than upset --- doc/cabal-package-description-file.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/cabal-package-description-file.rst b/doc/cabal-package-description-file.rst index 96cc54e9c61..a0ef15bbe14 100644 --- a/doc/cabal-package-description-file.rst +++ b/doc/cabal-package-description-file.rst @@ -1485,7 +1485,7 @@ system-dependent values for these fields. Even though there is no ``/=`` operator, by combining operators we can skip over one or more versions, to skip a deprecated version or to skip - versions that upset the constraint solving. + versions that narrow the constraint solving more than we'd like. For example, the ``time =1.12.*`` series depends on ``base >=4.13 && <5`` but ``time-1.12.3`` bumps the lower bound on base to ``>=4.14``. If we From 591e49b0b0c1b508a1964510bd84b6283636c56b Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 30 Oct 2023 13:52:41 -0400 Subject: [PATCH 34/70] Say something about hackage deprecations --- doc/cabal-package-description-file.rst | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/doc/cabal-package-description-file.rst b/doc/cabal-package-description-file.rst index a0ef15bbe14..ae07f3ff3bc 100644 --- a/doc/cabal-package-description-file.rst +++ b/doc/cabal-package-description-file.rst @@ -1493,6 +1493,13 @@ system-dependent values for these fields. ``base-4.13`` and with later GHC versions, then we can use ``time >=1.12 && (time <1.12.3 || time >1.12.3)``. + Hackage shows deprecated and preferred versions for packages, such as for + `containers `_ + and `aeson `_ for + example. Deprecating package versions is not the same deprecating a + package as a whole, for which hackage keeps a `deprecated packages list + `_. + If no version constraint is specified, any version is assumed to be acceptable. For example: From f382433d4e143eb0a93c82fe2c530444735b175c Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Mon, 6 Nov 2023 11:46:20 +0000 Subject: [PATCH 35/70] Fix AutogenModulesToggling test By converting this to a setupTest we use the in-tree Cabal library rather than relying on a proxy of the GHC version to provide the right Cabal library version. Supersedes #9398 --- .../AutogenModulesToggling/cabal.out | 22 ------------------- .../AutogenModulesToggling/cabal.test.hs | 13 +++++++---- 2 files changed, 9 insertions(+), 26 deletions(-) delete mode 100644 cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.out diff --git a/cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.out b/cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.out deleted file mode 100644 index 3b848ef431a..00000000000 --- a/cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.out +++ /dev/null @@ -1,22 +0,0 @@ -# cabal v2-run -Resolving dependencies... -Build profile: -w ghc- -O1 -In order, the following will be built: - - test-0.1 (exe:autogen-toggle-test) (first run) -Configuring test-0.1... -Preprocessing library for test-0.1... -Building library for test-0.1... -Preprocessing executable 'autogen-toggle-test' for test-0.1... -Building executable 'autogen-toggle-test' for test-0.1... -The module says: Real module, ship to production -# cabal v2-run -Resolving dependencies... -Build profile: -w ghc- -O1 -In order, the following will be built: - - test-0.1 (exe:autogen-toggle-test) (configuration changed) -Configuring test-0.1... -Preprocessing library for test-0.1... -Building library for test-0.1... -Preprocessing executable 'autogen-toggle-test' for test-0.1... -Building executable 'autogen-toggle-test' for test-0.1... -The module says: Prebuilt module, don't use in production diff --git a/cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.test.hs b/cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.test.hs index 4b0e1639c12..5c6e866b2d1 100644 --- a/cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.test.hs +++ b/cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.test.hs @@ -1,7 +1,12 @@ import Test.Cabal.Prelude main :: IO () -main = cabalTest . recordMode RecordMarked $ do - skipUnlessGhcVersion ">= 9.7" - cabal "v2-run" ["-fgenerate", "autogen-toggle-test"] - cabal "v2-run" ["-f-generate", "autogen-toggle-test"] +main = setupTest . recordMode DoNotRecord . withPackageDb $ do + -- This test exposes a recompilation bug in ghc versions 9.0.2 and 9.2.8 + skipIfGhcVersion "== 9.0.2 || == 9.2.8 || < 8.0 " + setup_install ["-fgenerate"] + r1 <- runInstalledExe' "autogen-toggle-test" [] + setup_install ["-f-generate"] + r2 <- runInstalledExe' "autogen-toggle-test" [] + assertOutputContains "Real module, ship to production" r1 + assertOutputContains "Prebuilt module, don't use in production" r2 From 811ba610ea81ceb662093608d55047c9ea9086e9 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 30 Aug 2023 11:45:36 +0100 Subject: [PATCH 36/70] Require version 3,11 of Cabal to support --semaphore flag Fixes #9197 --- cabal-install/src/Distribution/Client/ProjectPlanning.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 44372967fdb..3cb0d8033e8 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -4284,8 +4284,9 @@ setupHsBuildFlags par_strat elab _ verbosity builddir = , buildDistPref = toFlag builddir , buildNumJobs = mempty -- TODO: [nice to have] sometimes want to use toFlag (Just numBuildJobs), , buildUseSemaphore = - if elabSetupScriptCliVersion elab >= mkVersion [3, 9, 0, 0] - then par_strat + if elabSetupScriptCliVersion elab >= mkVersion [3, 11, 0, 0] + then -- Cabal 3.11 is the first version that supports parallelism semaphores + par_strat else mempty , buildArgs = mempty -- unused, passed via args not flags , buildCabalFilePath = mempty From 78c1c24489c011b02b2a50c6cf88b83784838d99 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 4 Nov 2023 13:38:49 +0100 Subject: [PATCH 37/70] Add dependencies used by `PackageTests` to exe:cabal-tests The runner allows the tests to use extra dependencies and the custom Prelude from 'cabal-testsuite'. However, if the tests use a dependency, say 'directory', and there are two packages with the same unit id available in the store, the test fails since it doesn't know which one to pick. By including an extra dependency to directory, we force the test runner to use a specific version directory, fixing the test failure. --- cabal-testsuite/cabal-testsuite.cabal | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index d4206163210..72221b316d5 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -101,6 +101,18 @@ executable cabal-tests , transformers -- dependencies specific to exe:cabal-tests , clock ^>= 0.7.2 || ^>=0.8 + -- Extra dependencies used by PackageTests. + -- + -- The runner allows the tests to use extra dependencies and the custom Prelude + -- from 'cabal-testsuite'. + -- However, if the tests use a dependency, say 'directory', and there are two + -- packages with the same unit id available in the store, the test fails since + -- it doesn't know which one to pick. + -- By including an extra dependency to directory, we force the test runner to + -- use a specific version directory, fixing the test failure. + -- + -- See issue description and discussion: https://github.com/haskell/cabal/issues/8356 + , directory build-tool-depends: cabal-testsuite:setup default-extensions: TypeOperators From d36b9f190ba01ac049ac01a48ba9d0cab4df5e01 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?H=C3=A9cate=20Moonlight?= Date: Sat, 11 Nov 2023 12:56:20 +0100 Subject: [PATCH 38/70] Use Paths_cabal_install for cabal-install version number (#9421) * Use PackageInfo for cabal-install version number * Use Paths_cabal_install instead * Adjust documentation --------- Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com> --- cabal-install/cabal-install.cabal | 2 ++ cabal-install/src/Distribution/Client/Version.hs | 12 +++++------- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index e45dc58a408..0a5e55bc3f1 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -63,6 +63,8 @@ library default-extensions: TypeOperators hs-source-dirs: src + other-modules: + Paths_cabal_install exposed-modules: -- this modules are moved from Cabal -- they are needed for as long until cabal-install moves to parsec parser diff --git a/cabal-install/src/Distribution/Client/Version.hs b/cabal-install/src/Distribution/Client/Version.hs index dc06552350f..f5c6bec510d 100644 --- a/cabal-install/src/Distribution/Client/Version.hs +++ b/cabal-install/src/Distribution/Client/Version.hs @@ -5,11 +5,9 @@ module Distribution.Client.Version import Distribution.Version --- This value determines the `cabal-install --version` output. --- --- It is used in several places throughout the project, including anonymous build reports, client configuration, --- and project planning output. Historically, this was a @Paths_*@ module, however, this conflicted with --- program coverage information generated by HPC, and hence was moved to be a standalone value. --- +import qualified Paths_cabal_install as PackageInfo + +-- | +-- This value determines the output of `cabal-install --version`. cabalInstallVersion :: Version -cabalInstallVersion = mkVersion [3, 11] +cabalInstallVersion = mkVersion' PackageInfo.version From 2ca93491f7bf5145c6c9e30c1d730464fc3b282e Mon Sep 17 00:00:00 2001 From: Andreas Klebinger Date: Thu, 2 Nov 2023 14:02:04 +0100 Subject: [PATCH 39/70] Document --profiling-detail in setup-commands. Fixes #9182 --- doc/setup-commands.rst | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/setup-commands.rst b/doc/setup-commands.rst index 28cd9e988be..20bdafabfae 100644 --- a/doc/setup-commands.rst +++ b/doc/setup-commands.rst @@ -710,6 +710,14 @@ Miscellaneous options each module, whether top level or local. In GHC specifically, this is for non-inline toplevel or where-bound functions or values. + late-toplevel + Like top-level but costs will be assigned to top level definitions after + optimization. This lowers profiling overhead massively while giving similar + levels of detail as toplevle-functions. However it means functions introduced + by GHC during optimization will show up in profiles as well. + Corresponds to ``-fprof-late`` if supported and ``-fprof-auto-top`` otherwise. + late + Currently an alias for late-toplevel This flag is new in Cabal-1.24. Prior versions used the equivalent of ``none`` above. From 914b0908bd2af5f0bba0f5f2114d9c478e585cc8 Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Mon, 6 Nov 2023 20:57:58 +0100 Subject: [PATCH 40/70] Add test requirement to PR template MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Adding test becomes a checkmark instead of “bonus points”. --- .github/pull_request_template.md | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index aa0b2b96c4e..8b36d183025 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -10,8 +10,7 @@ Include the following checklist in your PR: * [ ] Any changes that could be relevant to users [have been recorded in the changelog](https://github.com/haskell/cabal/blob/master/CONTRIBUTING.md#changelog). * [ ] The documentation has been updated, if necessary. * [ ] [Manual QA notes](https://github.com/haskell/cabal/blob/master/CONTRIBUTING.md#qa-notes) have been included. - -Bonus points for added automated tests! +* [ ] Tests have been added. (*Ask for help if you don’t know how to write them! Ask for an exemption if tests are too complex for too little coverage!*) --- From cede29448e890716aecc2fd0dbd705d13c9efa47 Mon Sep 17 00:00:00 2001 From: Troels Henriksen Date: Mon, 13 Nov 2023 15:18:44 +0100 Subject: [PATCH 41/70] A 'cabal path' command. (#8879) * Add a 'cabal path' command. * Formatting fix. * Another formatting fix. * Categorise "cabal path" as global command. * Allow individual paths to be printed. * Less duplication. * Add config-file to "cabal path". * Use sum type instead of strings. * cabal path: support --installdir. * Add documentation. * Better text. * Formatting. * Add some tests. * Improve tests. * Add changelog entry. * Mention "cabal path" in directory documentation. --------- Co-authored-by: Artem Pelenitsyn --- cabal-install/src/Distribution/Client/Main.hs | 41 +++++++++++ .../src/Distribution/Client/Setup.hs | 72 +++++++++++++++++++ .../PackageTests/Path/All/cabal.out | 6 ++ .../PackageTests/Path/All/cabal.test.hs | 3 + .../PackageTests/Path/Single/cabal.out | 2 + .../PackageTests/Path/Single/cabal.test.hs | 3 + cabal-testsuite/src/Test/Cabal/Prelude.hs | 1 + changelog.d/pr-8879 | 12 ++++ doc/cabal-commands.rst | 33 +++++++++ doc/config.rst | 3 + 10 files changed, 176 insertions(+) create mode 100644 cabal-testsuite/PackageTests/Path/All/cabal.out create mode 100644 cabal-testsuite/PackageTests/Path/All/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Path/Single/cabal.out create mode 100644 cabal-testsuite/PackageTests/Path/Single/cabal.test.hs create mode 100644 changelog.d/pr-8879 diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index c7772434060..9114102f2bf 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -33,6 +33,8 @@ import Distribution.Client.Setup , InitFlags (initHcPath, initVerbosity) , InstallFlags (..) , ListFlags (..) + , Path (..) + , PathFlags (..) , ReportFlags (..) , UploadFlags (..) , UserConfigFlags (..) @@ -60,6 +62,8 @@ import Distribution.Client.Setup , listCommand , listNeedsCompiler , manpageCommand + , pathCommand + , pathName , reconfigureCommand , registerCommand , replCommand @@ -97,7 +101,11 @@ import Prelude () import Distribution.Client.Config ( SavedConfig (..) , createDefaultConfigFile + , defaultCacheDir , defaultConfigFile + , defaultInstallPath + , defaultLogsDir + , defaultStoreDir , getConfigFilePath , loadConfig , userConfigDiff @@ -143,6 +151,7 @@ import Distribution.Client.Install (install) -- import Distribution.Client.Clean (clean) +import Distribution.Client.CmdInstall.ClientInstallFlags (ClientInstallFlags (cinstInstalldir)) import Distribution.Client.Get (get) import Distribution.Client.Init (initCmd) import Distribution.Client.Manpage (manpageCmd) @@ -227,6 +236,7 @@ import Distribution.Simple.Utils , notice , topHandler , tryFindPackageDesc + , withOutputMarker ) import Distribution.Text ( display @@ -242,6 +252,7 @@ import Distribution.Version ) import Control.Exception (AssertionFailed, assert, try) +import Control.Monad (mapM_) import Data.Monoid (Any (..)) import Distribution.Client.Errors import Distribution.Compat.ResponseFile @@ -395,6 +406,7 @@ mainWorker args = do , regularCmd reportCommand reportAction , regularCmd initCommand initAction , regularCmd userConfigCommand userConfigAction + , regularCmd pathCommand pathAction , regularCmd genBoundsCommand genBoundsAction , regularCmd CmdOutdated.outdatedCommand CmdOutdated.outdatedAction , wrapperCmd hscolourCommand hscolourVerbosity hscolourDistPref @@ -1347,3 +1359,32 @@ manpageAction commands flags extraArgs _ = do then dropExtension pname else pname manpageCmd cabalCmd commands flags + +pathAction :: PathFlags -> [String] -> Action +pathAction pathflags extraArgs globalFlags = do + let verbosity = fromFlag (pathVerbosity pathflags) + unless (null extraArgs) $ + dieWithException verbosity $ + ManpageAction extraArgs + cfg <- loadConfig verbosity mempty + let getDir getDefault getGlobal = + maybe + getDefault + pure + (flagToMaybe $ getGlobal $ savedGlobalFlags cfg) + getSomeDir PathCacheDir = getDir defaultCacheDir globalCacheDir + getSomeDir PathLogsDir = getDir defaultLogsDir globalLogsDir + getSomeDir PathStoreDir = getDir defaultStoreDir globalStoreDir + getSomeDir PathConfigFile = getConfigFilePath (globalConfigFile globalFlags) + getSomeDir PathInstallDir = + fromFlagOrDefault defaultInstallPath (pure <$> cinstInstalldir (savedClientInstallFlags cfg)) + printPath p = putStrLn . withOutputMarker verbosity . ((pathName p ++ ": ") ++) =<< getSomeDir p + -- If no paths have been requested, print all paths with labels. + -- + -- If a single path has been requested, print that path without any label. + -- + -- If multiple paths have been requested, print each of them with labels. + case fromFlag $ pathDirs pathflags of + [] -> mapM_ printPath [minBound .. maxBound] + [d] -> putStrLn . withOutputMarker verbosity =<< getSomeDir d + ds -> mapM_ printPath ds diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index 6d04d401a8a..e752b573aad 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -85,6 +85,10 @@ module Distribution.Client.Setup , cleanCommand , copyCommand , registerCommand + , Path (..) + , pathName + , PathFlags (..) + , pathCommand , liftOptions , yesNoOpt ) where @@ -343,6 +347,7 @@ globalCommand commands = ++ unlines ( [ startGroup "global" , addCmd "user-config" + , addCmd "path" , addCmd "help" , par , startGroup "package database" @@ -3322,6 +3327,73 @@ userConfigCommand = -- ------------------------------------------------------------ +-- * Dirs + +-- ------------------------------------------------------------ + +-- | A path that can be retrieved by the @cabal path@ command. +data Path + = PathCacheDir + | PathLogsDir + | PathStoreDir + | PathConfigFile + | PathInstallDir + deriving (Eq, Ord, Show, Enum, Bounded) + +-- | The configuration name for this path. +pathName :: Path -> String +pathName PathCacheDir = "cache-dir" +pathName PathLogsDir = "logs-dir" +pathName PathStoreDir = "store-dir" +pathName PathConfigFile = "config-file" +pathName PathInstallDir = "installdir" + +data PathFlags = PathFlags + { pathVerbosity :: Flag Verbosity + , pathDirs :: Flag [Path] + } + deriving (Generic) + +instance Monoid PathFlags where + mempty = + PathFlags + { pathVerbosity = toFlag normal + , pathDirs = toFlag [] + } + mappend = (<>) + +instance Semigroup PathFlags where + (<>) = gmappend + +pathCommand :: CommandUI PathFlags +pathCommand = + CommandUI + { commandName = "path" + , commandSynopsis = "Display paths used by cabal" + , commandDescription = Just $ \_ -> + wrapText $ + "This command prints the directories that are used by cabal," + ++ " taking into account the contents of the configuration file and any" + ++ " environment variables." + , commandNotes = Nothing + , commandUsage = \pname -> "Usage: " ++ pname ++ " path\n" + , commandDefaultFlags = mempty + , commandOptions = \_ -> + map pathOption [minBound .. maxBound] + ++ [optionVerbosity pathVerbosity (\v flags -> flags{pathVerbosity = v})] + } + where + pathOption s = + option + [] + [pathName s] + ("Print " <> pathName s) + pathDirs + (\v flags -> flags{pathDirs = Flag $ concat (flagToList (pathDirs flags) ++ flagToList v)}) + (noArg (Flag [s])) + +-- ------------------------------------------------------------ + -- * GetOpt Utils -- ------------------------------------------------------------ diff --git a/cabal-testsuite/PackageTests/Path/All/cabal.out b/cabal-testsuite/PackageTests/Path/All/cabal.out new file mode 100644 index 00000000000..55d8b94bc3a --- /dev/null +++ b/cabal-testsuite/PackageTests/Path/All/cabal.out @@ -0,0 +1,6 @@ +# cabal path +cache-dir: /cabal.dist/home/.cabal/packages +logs-dir: /cabal.dist/home/.cabal/logs +store-dir: /cabal.dist/home/.cabal/store +config-file: /cabal.dist/home/.cabal/config +installdir: /cabal.dist/home/.cabal/bin diff --git a/cabal-testsuite/PackageTests/Path/All/cabal.test.hs b/cabal-testsuite/PackageTests/Path/All/cabal.test.hs new file mode 100644 index 00000000000..b8157a83ee8 --- /dev/null +++ b/cabal-testsuite/PackageTests/Path/All/cabal.test.hs @@ -0,0 +1,3 @@ +import Test.Cabal.Prelude + +main = cabalTest . void $ cabal "path" [] diff --git a/cabal-testsuite/PackageTests/Path/Single/cabal.out b/cabal-testsuite/PackageTests/Path/Single/cabal.out new file mode 100644 index 00000000000..1ae82037846 --- /dev/null +++ b/cabal-testsuite/PackageTests/Path/Single/cabal.out @@ -0,0 +1,2 @@ +# cabal path +/cabal.dist/home/.cabal/bin diff --git a/cabal-testsuite/PackageTests/Path/Single/cabal.test.hs b/cabal-testsuite/PackageTests/Path/Single/cabal.test.hs new file mode 100644 index 00000000000..8eac59024f3 --- /dev/null +++ b/cabal-testsuite/PackageTests/Path/Single/cabal.test.hs @@ -0,0 +1,3 @@ +import Test.Cabal.Prelude + +main = cabalTest . void $ cabal "path" ["--installdir"] diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index e0e63ac18f6..48016765e91 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -295,6 +295,7 @@ cabalGArgs global_args cmd args input = do , "info" , "init" , "haddock-project" + , "path" ] = [ ] diff --git a/changelog.d/pr-8879 b/changelog.d/pr-8879 new file mode 100644 index 00000000000..079d642289b --- /dev/null +++ b/changelog.d/pr-8879 @@ -0,0 +1,12 @@ +synopsis: Add `cabal path` command +packages: cabal-install +prs: #8879 + +description: { + +The `cabal path` command prints the file system paths used by Cabal. +It is intended for use by tooling that needs to read or modify Cabal +data, such that it does not need to replicate the complicated logic +for respecting `CABAL_DIR`, `CABAL_CONFIG`, etc. + +} diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index 88803232bf6..05f1666279d 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -19,6 +19,7 @@ Commands [global] user-config Display and update the user's global cabal configuration. help Help about commands. + path Display paths used by cabal. [package database] update Updates list of known packages. @@ -284,6 +285,38 @@ cabal preferences. It is very useful when you are e.g. first configuring Note how ``--augment`` syntax follows ``cabal user-config diff`` output. +cabal path +^^^^^^^^^^ + +``cabal path`` prints the file system paths used by ``cabal`` for +cache, store, installed binaries, and so on. When run without any +options, it will show all paths, labeled with how they are namen in +the configuration file: + +:: + $ cabal path + cache-dir: /home/haskell/.cache/cabal/packages + logs-dir: /home/haskell/.cache/cabal/logs + store-dir: /home/haskell/.local/state/cabal/store + config-file: /home/haskell/.config/cabal/config + installdir: /home/haskell/.local/bin + ... + +If ``cabal path`` is passed a single option naming a path, then that +path will be printed *without* any label: + +:: + + $ cabal path --installdir + /home/haskell/.local/bin + +This is a stable interface and is intended to be used for scripting. +For example: + +:: + $ ls $(cabal path --installdir) + ... + .. _command-group-database: Package database commands diff --git a/doc/config.rst b/doc/config.rst index d7717ca95a8..5c85498b181 100644 --- a/doc/config.rst +++ b/doc/config.rst @@ -120,6 +120,9 @@ file: * ``~/.local/bin`` for executables installed with ``cabal install``. +You can run ``cabal path`` to see a list of the directories that +``cabal`` will use with the active configuration. + Repository specification ------------------------ From 0d382b116adaf12367ee6f058c434a305837395a Mon Sep 17 00:00:00 2001 From: ffaf1 Date: Mon, 13 Nov 2023 20:01:02 +0100 Subject: [PATCH 42/70] Reimplement `cabal check` (#8427) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Fix Semigroup target instance When two target names are the same, `mappend`ing them should not error but just pick the first name. * Add `desugarBuildToolSimple` * Reimplement cabal check * Reorder test output * Fix autogen modules tests .cabal files * Add a number of tests * Add test for #7423 i.e. Do not warn on -O2 if under off-by-default package configuration flag conditional. * Add a regression for: * Add another -WErrr test This is to make sure we do *not* report it if it is under a user, off-by-default flag. * Add test for non manual user flags. * Add “absolute path in extra-lib-dirs” test * Add if/else test * Add “dircheck on abspath” check * Add Package version internal test * Add PackageVersionsStraddle test * Add changelog for #8427 * Integrate various reviews * Integrate Artem’s review (review) Clarify `combineNames` documentation By explaining the way it operates (working if the two names are equal or one is empty) and renaming the function from `combineName` to `combineNames`. (review) Use guards instead of if/then/else (review) Match inside argument list (review) Replace “white” with “allow” (review) Fix typo in comment (review) Fix typo in Check module documentation (review) Harmonise indentation for `data` decls First field goes in a new line than the data constructor, so we have more space. (review) Rename `Prim` module to `Types` (review) Add checkPackageFilesGPD `checkPackageFiles` — which works on PD — was used to perform IO. We introduce a function that does the same thing but works on GPD (which is more principled). `checkPackageFiles` cannot just be removed, since it is part of the interface of Distribution.PackageDescription.Check. Deprecation can be planned once “new check” is up and running. * Integrate Andreas’ review (review) Add named section to missing upper bound check “miss upper bound” checks will now list target type and name (“On executable 'myexe', these packages miss upper bounds”) for easier fixing by the user. (review) remove `cabal gen-bounds` suggestion Reasonable as `cabal gen-bounds` is stricter than `cabal check`, see https://github.com/haskell/cabal/pull/8427#issuecomment-1446712486 Once `gen-bounds` behaves in line with `check` we can readd the suggestion. (review) Do not warn on shared bounds When a target which depends on an internal library shares some dependencies with the latter, do not warn on upper bounds. An example is clearer library build-depends: text < 5 ⁝ build-depends: myPackage, ← no warning, internal text, ← no warning, shared bound monadacme ← warning! * Integrate Artem’s review /II (review) Split Check.hs Check.hs has been split in multiple file, each une sub 1000 lines: Check 857 lines Check.Common 147 lines Check.Conditional 204 lines Check.Monad 352 lines Check.Paths 387 lines Check.Target 765 lines Check.Warning 865 lines Migration guide: - Check GPD/PD checks plus work-tree checks. - Check.Common common types and functions that are *not* part of monadic checking setup. - Check.Conditional checks on CondTree and related matter (variables, duplicate modules). - Check.Monad Backbone of the checks, monadic inter- face and related functions. - Check.Paths Checks on files, directories, globs. - Check.Target Checks on realised targets (libraries, executables, benchmarks, testsuites). - Check.Warning Datatypes and strings for warnings and severities. (review) remove useless section header (review) Fix typo (review) Add warnings documentation (list) For each warning, we document constructor/brief description in the manual. This might not be much useful as not but it will come handy when introducing `--ignore=WARN` and similar flags. * (review Andreas) Clarify CheckExplanation comment Whoever modifies `CheckExplanation` data constructors needs to be aware that the documentation in doc/cabal-commands.rst has to be updated too. * Move internal Check modules to `other-modules` No need to expose Distribution.PackageDescription.Check.* to the world. API for checking, for cabal-install and other tools, should be in Distribution.PackageDescription.Check. * Make fourmolu happy Cabal codebase has now a formatter/style standard (see #8950). “Ravioli ravioli, give me the formuoli” * Do not check for OptO in scripts See #8963 for reason and clarification requests. * Remove useless PackageId parameter It is now in the Reader part of CheckM monad. * Do not check PVP on internal targets Internal: testsuite, benchmark. See #8361. * Make hlint happy * Fix #9122 When checking internal version ranges, we need to make sure we are not mistaking a libraries with the same name but from different packages. See #9132. * Fix grammar neither…nor, completing what done in #9162 * Integrate Brandon’s review: grammar * Remove unnecessary `-fvia-C` check Brandon’s review/II. --------- Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com> --- .../src/Distribution/Types/Benchmark.hs | 14 +- .../src/Distribution/Types/Executable.hs | 14 +- .../src/Distribution/Types/ForeignLib.hs | 14 +- .../src/Distribution/Types/TestSuite.hs | 14 +- .../Distribution/Types/UnqualComponentName.hs | 33 +- Cabal-tests/tests/CheckTests.hs | 2 +- Cabal-tests/tests/HackageTests.hs | 2 +- .../regressions/all-upper-bound.check | 6 +- .../regressions/bad-glob-syntax.check | 2 +- .../regressions/decreasing-indentation.cabal | 10 +- .../regressions/denormalised-paths.check | 15 +- .../regressions/ghc-option-j.check | 4 +- .../ParserTests/regressions/issue-774.check | 4 +- .../regressions/nothing-unicode.check | 2 +- .../regressions/pre-2.4-globstar.check | 2 +- Cabal/Cabal.cabal | 6 + .../Distribution/PackageDescription/Check.hs | 3995 ++++------------- .../PackageDescription/Check/Common.hs | 149 + .../PackageDescription/Check/Conditional.hs | 221 + .../PackageDescription/Check/Monad.hs | 372 ++ .../PackageDescription/Check/Paths.hs | 412 ++ .../PackageDescription/Check/Target.hs | 1050 +++++ .../PackageDescription/Check/Warning.hs | 1009 +++++ .../Distribution/Simple/BuildToolDepends.hs | 53 +- Cabal/src/Distribution/Simple/Configure.hs | 2 +- .../src/Distribution/Client/Check.hs | 19 +- .../Distribution/Solver/Modular/DSL.hs | 2 +- .../AutogenModules/Package/my.cabal | 8 +- .../SrcDist/AutogenModules.cabal | 8 +- .../ImpossibleVersionRangeLib/cabal.out | 2 +- .../ImpossibleVersionRangeLib/pkg.cabal | 2 +- .../GHCOptions/NoWarnFlag/cabal.out | 2 + .../GHCOptions/NoWarnFlag/cabal.test.hs | 4 + .../GHCOptions/NoWarnFlag/pkg.cabal | 18 + .../GHCOptions/NoWarnFlagManual/cabal.out | 4 + .../GHCOptions/NoWarnFlagManual/cabal.test.hs | 5 + .../GHCOptions/NoWarnFlagManual/pkg.cabal | 17 + .../GHCOptions/NoWarnFlagOut/cabal.out | 4 + .../GHCOptions/NoWarnFlagOut/cabal.test.hs | 4 + .../GHCOptions/NoWarnFlagOut/pkg.cabal | 19 + .../Paths/AbsolutePathExtraLibDirs/cabal.out | 2 + .../AbsolutePathExtraLibDirs/cabal.test.hs | 5 + .../Paths/AbsolutePathExtraLibDirs/pkg.cabal | 13 + .../Paths/DistPoint/cabal.out | 2 +- .../Paths/RecursiveGlobInRoot/cabal.out | 2 +- .../Sanity/AutogenIncludes/cabal.out | 2 +- .../Sanity/NoDupNames/cabal.out | 3 + .../DevOnlyFlags/ElseCheck/LICENSE | 0 .../DevOnlyFlags/ElseCheck/cabal.out | 4 + .../DevOnlyFlags/ElseCheck/cabal.test.hs | 5 + .../DevOnlyFlags/ElseCheck/pkg.cabal | 25 + .../NonConfCheck/DevOnlyFlags/Jn/cabal.out | 2 +- .../DevOnlyFlags/WErrorGuarded/cabal.out | 2 + .../DevOnlyFlags/WErrorGuarded/cabal.test.hs | 5 + .../DevOnlyFlags/WErrorGuarded/pkg.cabal | 20 + .../PackageVersionsInternal/cabal.out | 2 + .../PackageVersionsInternal/cabal.test.hs | 5 + .../PackageVersionsInternal/pkg.cabal | 19 + .../PackageVersionsInternalSimple/cabal.out | 5 + .../cabal.test.hs | 5 + .../PackageVersionsInternalSimple/pkg.cabal | 22 + .../PackageVersionsLibInt/cabal.out | 5 + .../PackageVersionsLibInt/cabal.test.hs | 5 + .../PackageVersionsLibInt/pkg.cabal | 20 + .../PackageVersionsStraddle/cabal.out | 2 + .../PackageVersionsStraddle/cabal.test.hs | 6 + .../PackageVersionsStraddle/pkg.cabal | 15 + .../Check/PackageFiles/DirExistAbs/LICENSE | 0 .../Check/PackageFiles/DirExistAbs/cabal.out | 2 + .../PackageFiles/DirExistAbs/cabal.test.hs | 5 + .../Check/PackageFiles/DirExistAbs/pkg.cabal | 17 + .../Check/PackageFiles/VCSInfo/cabal.out | 2 +- changelog.d/pr-8427 | 19 + doc/cabal-commands.rst | 136 + 74 files changed, 4697 insertions(+), 3212 deletions(-) create mode 100644 Cabal/src/Distribution/PackageDescription/Check/Common.hs create mode 100644 Cabal/src/Distribution/PackageDescription/Check/Conditional.hs create mode 100644 Cabal/src/Distribution/PackageDescription/Check/Monad.hs create mode 100644 Cabal/src/Distribution/PackageDescription/Check/Paths.hs create mode 100644 Cabal/src/Distribution/PackageDescription/Check/Target.hs create mode 100644 Cabal/src/Distribution/PackageDescription/Check/Warning.hs create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/LICENSE create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/LICENSE create mode 100644 cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/pkg.cabal create mode 100644 changelog.d/pr-8427 diff --git a/Cabal-syntax/src/Distribution/Types/Benchmark.hs b/Cabal-syntax/src/Distribution/Types/Benchmark.hs index be0911432ec..13e5fe104e5 100644 --- a/Cabal-syntax/src/Distribution/Types/Benchmark.hs +++ b/Cabal-syntax/src/Distribution/Types/Benchmark.hs @@ -48,24 +48,12 @@ instance Monoid Benchmark where instance Semigroup Benchmark where a <> b = Benchmark - { benchmarkName = combine' benchmarkName + { benchmarkName = combineNames a b benchmarkName "benchmark" , benchmarkInterface = combine benchmarkInterface , benchmarkBuildInfo = combine benchmarkBuildInfo } where combine field = field a `mappend` field b - combine' field = case ( unUnqualComponentName $ field a - , unUnqualComponentName $ field b - ) of - ("", _) -> field b - (_, "") -> field a - (x, y) -> - error $ - "Ambiguous values for test field: '" - ++ x - ++ "' and '" - ++ y - ++ "'" emptyBenchmark :: Benchmark emptyBenchmark = mempty diff --git a/Cabal-syntax/src/Distribution/Types/Executable.hs b/Cabal-syntax/src/Distribution/Types/Executable.hs index 618f91dc5f3..5362d7122b0 100644 --- a/Cabal-syntax/src/Distribution/Types/Executable.hs +++ b/Cabal-syntax/src/Distribution/Types/Executable.hs @@ -40,25 +40,13 @@ instance Monoid Executable where instance Semigroup Executable where a <> b = Executable - { exeName = combine' exeName + { exeName = combineNames a b exeName "executable" , modulePath = combine modulePath , exeScope = combine exeScope , buildInfo = combine buildInfo } where combine field = field a `mappend` field b - combine' field = case ( unUnqualComponentName $ field a - , unUnqualComponentName $ field b - ) of - ("", _) -> field b - (_, "") -> field a - (x, y) -> - error $ - "Ambiguous values for executable field: '" - ++ x - ++ "' and '" - ++ y - ++ "'" emptyExecutable :: Executable emptyExecutable = mempty diff --git a/Cabal-syntax/src/Distribution/Types/ForeignLib.hs b/Cabal-syntax/src/Distribution/Types/ForeignLib.hs index 9d714f9895f..7e31a6cc7c0 100644 --- a/Cabal-syntax/src/Distribution/Types/ForeignLib.hs +++ b/Cabal-syntax/src/Distribution/Types/ForeignLib.hs @@ -140,7 +140,7 @@ instance NFData ForeignLib where rnf = genericRnf instance Semigroup ForeignLib where a <> b = ForeignLib - { foreignLibName = combine' foreignLibName + { foreignLibName = combineNames a b foreignLibName "foreign library" , foreignLibType = combine foreignLibType , foreignLibOptions = combine foreignLibOptions , foreignLibBuildInfo = combine foreignLibBuildInfo @@ -150,18 +150,6 @@ instance Semigroup ForeignLib where } where combine field = field a `mappend` field b - combine' field = case ( unUnqualComponentName $ field a - , unUnqualComponentName $ field b - ) of - ("", _) -> field b - (_, "") -> field a - (x, y) -> - error $ - "Ambiguous values for executable field: '" - ++ x - ++ "' and '" - ++ y - ++ "'" combine'' field = field b instance Monoid ForeignLib where diff --git a/Cabal-syntax/src/Distribution/Types/TestSuite.hs b/Cabal-syntax/src/Distribution/Types/TestSuite.hs index 5e72965b815..6b3107cae71 100644 --- a/Cabal-syntax/src/Distribution/Types/TestSuite.hs +++ b/Cabal-syntax/src/Distribution/Types/TestSuite.hs @@ -51,25 +51,13 @@ instance Monoid TestSuite where instance Semigroup TestSuite where a <> b = TestSuite - { testName = combine' testName + { testName = combineNames a b testName "test" , testInterface = combine testInterface , testBuildInfo = combine testBuildInfo , testCodeGenerators = combine testCodeGenerators } where combine field = field a `mappend` field b - combine' field = case ( unUnqualComponentName $ field a - , unUnqualComponentName $ field b - ) of - ("", _) -> field b - (_, "") -> field a - (x, y) -> - error $ - "Ambiguous values for test field: '" - ++ x - ++ "' and '" - ++ y - ++ "'" emptyTestSuite :: TestSuite emptyTestSuite = mempty diff --git a/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs b/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs index a13fc917633..93feff2fbbe 100644 --- a/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs +++ b/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs @@ -9,11 +9,12 @@ module Distribution.Types.UnqualComponentName , mkUnqualComponentName , packageNameToUnqualComponentName , unqualComponentNameToPackageName + , combineNames ) where import Distribution.Compat.Prelude import Distribution.Utils.ShortText -import Prelude () +import Prelude as P (null) import Distribution.Parsec import Distribution.Pretty @@ -105,3 +106,33 @@ packageNameToUnqualComponentName = UnqualComponentName . unPackageNameST -- @since 2.0.0.2 unqualComponentNameToPackageName :: UnqualComponentName -> PackageName unqualComponentNameToPackageName = mkPackageNameST . unUnqualComponentNameST + +-- | Combine names in targets if one name is empty or both names are equal +-- (partial function). +-- Useful in 'Semigroup' and similar instances. +combineNames + :: a + -> a + -> (a -> UnqualComponentName) + -> String + -> UnqualComponentName +combineNames a b tacc tt + -- One empty or the same. + | P.null unb + || una == unb = + na + | P.null una = nb + -- Both non-empty, different. + | otherwise = + error $ + "Ambiguous values for " + ++ tt + ++ " field: '" + ++ una + ++ "' and '" + ++ unb + ++ "'" + where + (na, nb) = (tacc a, tacc b) + una = unUnqualComponentName na + unb = unUnqualComponentName nb diff --git a/Cabal-tests/tests/CheckTests.hs b/Cabal-tests/tests/CheckTests.hs index ad9a93feebe..220cc7d1458 100644 --- a/Cabal-tests/tests/CheckTests.hs +++ b/Cabal-tests/tests/CheckTests.hs @@ -71,7 +71,7 @@ checkTest fp = cabalGoldenTest fp correct $ do -- Note: parser warnings are reported by `cabal check`, but not by -- D.PD.Check functionality. unlines (map (showPWarning fp) ws) ++ - unlines (map show (checkPackage gpd Nothing)) + unlines (map show (checkPackage gpd)) Left (_, errs) -> unlines $ map (("ERROR: " ++) . showPError fp) $ NE.toList errs where input = "tests" "ParserTests" "regressions" fp diff --git a/Cabal-tests/tests/HackageTests.hs b/Cabal-tests/tests/HackageTests.hs index df27938d221..9bff0ce05cc 100644 --- a/Cabal-tests/tests/HackageTests.hs +++ b/Cabal-tests/tests/HackageTests.hs @@ -196,7 +196,7 @@ parseCheckTest fpath bs = do Parsec.parseGenericPackageDescription bs case parsec of Right gpd -> do - let checks = checkPackage gpd Nothing + let checks = checkPackage gpd let w [] = 0 w _ = 1 diff --git a/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check b/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check index 0da0e871ebb..ad65af510aa 100644 --- a/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check +++ b/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check @@ -1,6 +1,6 @@ -These packages miss upper bounds: +On library, these packages miss upper bounds: + - somelib - alphalib - betalib - deltalib - - somelib -Please add them, using `cabal gen-bounds` for suggestions. For more information see: https://pvp.haskell.org/ +Please add them. There is more information at https://pvp.haskell.org/ diff --git a/Cabal-tests/tests/ParserTests/regressions/bad-glob-syntax.check b/Cabal-tests/tests/ParserTests/regressions/bad-glob-syntax.check index 5b7a0a12552..5f52530791f 100644 --- a/Cabal-tests/tests/ParserTests/regressions/bad-glob-syntax.check +++ b/Cabal-tests/tests/ParserTests/regressions/bad-glob-syntax.check @@ -1,2 +1,2 @@ -In the 'extra-source-files' field: invalid file glob 'foo/blah-*.hs'. Wildcards '*' may only totally replace the file's base name, not only parts of it. In the 'extra-source-files' field: invalid file glob 'foo/*/bar'. A wildcard '**' is only allowed as the final parent directory. Stars must not otherwise appear in the parent directories. +In the 'extra-source-files' field: invalid file glob 'foo/blah-*.hs'. Wildcards '*' may only totally replace the file's base name, not only parts of it. diff --git a/Cabal-tests/tests/ParserTests/regressions/decreasing-indentation.cabal b/Cabal-tests/tests/ParserTests/regressions/decreasing-indentation.cabal index 5a019b281d2..eb0a14724dc 100644 --- a/Cabal-tests/tests/ParserTests/regressions/decreasing-indentation.cabal +++ b/Cabal-tests/tests/ParserTests/regressions/decreasing-indentation.cabal @@ -24,7 +24,7 @@ Flag UseBinary Description: Use the binary package for serializing keys. Library - build-depends: base >= 3 + build-depends: base < 3 if flag(UseBinary) build-depends: binary <10 CPP-Options: -DUSE_BINARY @@ -34,7 +34,7 @@ Library exposed-modules: Codec.Crypto.RSA Executable test_rsa - build-depends: base >= 3 + build-depends: base < 3 CPP-Options: -DRSA_TEST Main-Is: Test.hs Other-Modules: Codec.Crypto.RSA @@ -52,7 +52,7 @@ Executable warnings -- Increasing indentation is also possible if we use braces to delimit field contents. Executable warnings2 - build-depends: { base <5 } + build-depends: { base < 5 } main-is: { warnings2.hs } Other-Modules: FooBar @@ -62,9 +62,9 @@ flag splitBase Executable warnings3 if flag(splitBase) - build-depends: base >= 3 + build-depends: base < 3 else - build-depends: base < 3 + build-depends: base < 5 Main-Is: warnings3.hs Other-Modules: diff --git a/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.check b/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.check index 84eade4e941..9b631589990 100644 --- a/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.check +++ b/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.check @@ -1,11 +1,14 @@ -The 'subdir' field of a source-repository is not a good relative path: "trailing same directory segment: ." -The paths 'files/<>/*.txt', 'c/**/*.c', 'C:foo/bar', '||s' are invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|" and there a few reserved names including "aux", "nul", "con", "prn", "com1-9", "lpt1-9" and "clock$". 'hs-source-dirs: ../../assoc/src' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. +The 'subdir' field of a source-repository is not a good relative path: "trailing same directory segment: ." 'extra-source-files: files/**/*.txt/' is not a good relative path: "trailing slash" 'extra-source-files: files/../foo.txt' is not a good relative path: "parent directory segment: .." -'license-file: LICENSE2/' is not a good relative path: "trailing slash" -'license-file: .' is not a good relative path: "trailing dot segment" +'hs-source-dirs: ../../assoc/src' is not a good relative path: "parent directory segment: .." 'hs-source-dirs: src/.' is not a good relative path: "trailing same directory segment: ." -'hs-source-dirs: src/../src' is not a good relative path: "parent directory segment: .." 'hs-source-dirs: src/../../assoc/src' is not a good relative path: "parent directory segment: .." -'hs-source-dirs: ../../assoc/src' is not a good relative path: "parent directory segment: .." +'hs-source-dirs: src/../src' is not a good relative path: "parent directory segment: .." +'license-file: .' is not a good relative path: "trailing dot segment" +'license-file: LICENSE2/' is not a good relative path: "trailing slash" +The path 'C:foo/bar' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|" and there a few reserved names including "aux", "nul", "con", "prn", "com1-9", "lpt1-9" and "clock$". +The path 'c/**/*.c' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|" and there a few reserved names including "aux", "nul", "con", "prn", "com1-9", "lpt1-9" and "clock$". +The path 'files/<>/*.txt' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|" and there a few reserved names including "aux", "nul", "con", "prn", "com1-9", "lpt1-9" and "clock$". +The path '||s' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|" and there a few reserved names including "aux", "nul", "con", "prn", "com1-9", "lpt1-9" and "clock$". diff --git a/Cabal-tests/tests/ParserTests/regressions/ghc-option-j.check b/Cabal-tests/tests/ParserTests/regressions/ghc-option-j.check index 3643c13a0ec..8e6ed9f432a 100644 --- a/Cabal-tests/tests/ParserTests/regressions/ghc-option-j.check +++ b/Cabal-tests/tests/ParserTests/regressions/ghc-option-j.check @@ -1,2 +1,2 @@ -'ghc-options: -j[N]' can make sense for specific user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. -'ghc-shared-options: -j[N]' can make sense for specific user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. +'ghc-options: -j[N]' can make sense for a particular user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. +'ghc-shared-options: -j[N]' can make sense for a particular user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-774.check b/Cabal-tests/tests/ParserTests/regressions/issue-774.check index 27bea8fc70b..84bf5272856 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-774.check +++ b/Cabal-tests/tests/ParserTests/regressions/issue-774.check @@ -1,6 +1,6 @@ issue-774.cabal:13:22: Packages with 'cabal-version: 1.12' or later should specify a specific version of the Cabal spec of the form 'cabal-version: x.y'. Use 'cabal-version: 1.12'. +'ghc-options: -rtsopts' has no effect for libraries. It should only be used for executables. +'ghc-options: -with-rtsopts' has no effect for libraries. It should only be used for executables. No 'category' field. No 'maintainer' field. The 'license' field is missing or is NONE. -'ghc-options: -rtsopts' has no effect for libraries. It should only be used for executables. -'ghc-options: -with-rtsopts' has no effect for libraries. It should only be used for executables. diff --git a/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.check b/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.check index aa57fe96240..6a21d7ccae8 100644 --- a/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.check +++ b/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.check @@ -2,5 +2,5 @@ No 'category' field. No 'maintainer' field. No 'description' field. The 'license' field is missing or is NONE. -Suspicious flag names: 無. To avoid ambiguity in command line interfaces, flag shouldn't start with a dash. Also for better compatibility, flag names shouldn't contain non-ascii characters. +Suspicious flag names: 無. To avoid ambiguity in command line interfaces, a flag shouldn't start with a dash. Also for better compatibility, flag names shouldn't contain non-ascii characters. Non ascii custom fields: x-無. For better compatibility, custom field names shouldn't contain non-ascii characters. diff --git a/Cabal-tests/tests/ParserTests/regressions/pre-2.4-globstar.check b/Cabal-tests/tests/ParserTests/regressions/pre-2.4-globstar.check index 331d5a0ade9..ac3bd4bc76d 100644 --- a/Cabal-tests/tests/ParserTests/regressions/pre-2.4-globstar.check +++ b/Cabal-tests/tests/ParserTests/regressions/pre-2.4-globstar.check @@ -1,3 +1,3 @@ In the 'data-files' field: invalid file glob 'foo/**/*.dat'. Using the double-star syntax requires 'cabal-version: 2.4' or greater. Alternatively, for compatibility with earlier Cabal versions, list the included directories explicitly. -In the 'extra-source-files' field: invalid file glob 'foo/**/*.hs'. Using the double-star syntax requires 'cabal-version: 2.4' or greater. Alternatively, for compatibility with earlier Cabal versions, list the included directories explicitly. In the 'extra-doc-files' field: invalid file glob 'foo/**/*.html'. Using the double-star syntax requires 'cabal-version: 2.4' or greater. Alternatively, for compatibility with earlier Cabal versions, list the included directories explicitly. +In the 'extra-source-files' field: invalid file glob 'foo/**/*.hs'. Using the double-star syntax requires 'cabal-version: 2.4' or greater. Alternatively, for compatibility with earlier Cabal versions, list the included directories explicitly. diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index da7eeda354c..c5dd237a5f8 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -322,6 +322,12 @@ library Distribution.Compat.SnocList Distribution.GetOpt Distribution.Lex + Distribution.PackageDescription.Check.Common + Distribution.PackageDescription.Check.Conditional + Distribution.PackageDescription.Check.Monad + Distribution.PackageDescription.Check.Paths + Distribution.PackageDescription.Check.Target + Distribution.PackageDescription.Check.Warning Distribution.Simple.Build.Macros.Z Distribution.Simple.Build.PackageInfoModule.Z Distribution.Simple.Build.PathsModule.Z diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 2c9806a1ae5..fb3c05a64b6 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -1,10 +1,8 @@ -{-# LANGUAGE LambdaCase #-} - ------------------------------------------------------------------------------ +{-# LANGUAGE ScopedTypeVariables #-} -- | -- Module : Distribution.PackageDescription.Check --- Copyright : Lennart Kolmodin 2008 +-- Copyright : Lennart Kolmodin 2008, Francesco Ariis 2022 -- License : BSD3 -- -- Maintainer : cabal-devel@haskell.org @@ -34,55 +32,37 @@ module Distribution.PackageDescription.Check -- ** Checking package contents , checkPackageFiles + , checkPackageFilesGPD , checkPackageContent , CheckPackageContentOps (..) - , checkPackageFileNames ) where -import Data.Foldable (foldrM) import Distribution.Compat.Prelude import Prelude () -import Data.List (delete, group) +import Data.List (group) import Distribution.CabalSpecVersion import Distribution.Compat.Lens import Distribution.Compiler import Distribution.License -import Distribution.ModuleName (ModuleName) import Distribution.Package import Distribution.PackageDescription -import Distribution.PackageDescription.Configuration -import Distribution.Parsec.Warning (PWarning, showPWarning) +import Distribution.PackageDescription.Check.Common +import Distribution.PackageDescription.Check.Conditional +import Distribution.PackageDescription.Check.Monad +import Distribution.PackageDescription.Check.Paths +import Distribution.PackageDescription.Check.Target +import Distribution.Parsec.Warning (PWarning) import Distribution.Pretty (prettyShow) -import Distribution.Simple.BuildPaths (autogenPackageInfoModuleName, autogenPathsModuleName) -import Distribution.Simple.BuildToolDepends -import Distribution.Simple.CCompiler import Distribution.Simple.Glob import Distribution.Simple.Utils hiding (findPackageDesc, notice) -import Distribution.System -import Distribution.Types.ComponentRequestedSpec -import Distribution.Types.PackageName.Magic import Distribution.Utils.Generic (isAscii) import Distribution.Utils.Path import Distribution.Verbosity import Distribution.Version -import Language.Haskell.Extension -import System.FilePath - ( makeRelative - , normalise - , splitDirectories - , splitExtension - , splitPath - , takeExtension - , takeFileName - , (<.>) - , () - ) - -import qualified Control.Monad as CM +import System.FilePath (splitExtension, takeFileName, (<.>), ()) + import qualified Data.ByteString.Lazy as BS -import qualified Data.Map as Map -import qualified Distribution.Compat.DList as DList import qualified Distribution.SPDX as SPDX import qualified System.Directory as System @@ -92,1358 +72,552 @@ import qualified System.FilePath.Windows as FilePath.Windows (isValid) import qualified Data.Set as Set import qualified Distribution.Utils.ShortText as ShortText -import qualified Distribution.Types.BuildInfo.Lens as L import qualified Distribution.Types.GenericPackageDescription.Lens as L -import qualified Distribution.Types.PackageDescription.Lens as L + +import Control.Monad -- $setup -- >>> import Control.Arrow ((&&&)) --- ------------------------------------------------------------ - --- * Warning messages - --- ------------------------------------------------------------ - --- | Which stanza does `CheckExplanation` refer to? -data CEType = CETLibrary | CETExecutable | CETTest | CETBenchmark - deriving (Eq, Ord, Show) - --- | Pretty printing `CEType`. -ppCE :: CEType -> String -ppCE CETLibrary = "library" -ppCE CETExecutable = "executable" -ppCE CETTest = "test suite" -ppCE CETBenchmark = "benchmark" - --- | Which field does `CheckExplanation` refer to? -data CEField - = CEFCategory - | CEFMaintainer - | CEFSynopsis - | CEFDescription - | CEFSynOrDesc - deriving (Eq, Ord, Show) - --- | Pretty printing `CEField`. -ppCEField :: CEField -> String -ppCEField CEFCategory = "category" -ppCEField CEFMaintainer = "maintainer" -ppCEField CEFSynopsis = "synopsis" -ppCEField CEFDescription = "description" -ppCEField CEFSynOrDesc = "synopsis' or 'description" - --- | Explanations of 'PackageCheck`'s errors/warnings. -data CheckExplanation - = ParseWarning FilePath PWarning - | NoNameField - | NoVersionField - | NoTarget - | UnnamedInternal - | DuplicateSections [UnqualComponentName] - | IllegalLibraryName PackageDescription - | NoModulesExposed Library - | SignaturesCabal2 - | AutogenNotExposed - | AutogenIncludesNotIncluded - | NoMainIs Executable - | NoHsLhsMain - | MainCCabal1_18 - | AutogenNoOther CEType UnqualComponentName - | AutogenIncludesNotIncludedExe - | TestsuiteTypeNotKnown TestType - | TestsuiteNotSupported TestType - | BenchmarkTypeNotKnown BenchmarkType - | BenchmarkNotSupported BenchmarkType - | NoHsLhsMainBench - | InvalidNameWin PackageDescription - | ZPrefix - | NoBuildType - | NoCustomSetup - | UnknownCompilers [String] - | UnknownLanguages [String] - | UnknownExtensions [String] - | LanguagesAsExtension [String] - | DeprecatedExtensions [(Extension, Maybe Extension)] - | MissingField CEField - | SynopsisTooLong - | ShortDesc - | InvalidTestWith [Dependency] - | ImpossibleInternalDep [Dependency] - | ImpossibleInternalExe [ExeDependency] - | MissingInternalExe [ExeDependency] - | NONELicense - | NoLicense - | AllRightsReservedLicense - | LicenseMessParse PackageDescription - | UnrecognisedLicense String - | UncommonBSD4 - | UnknownLicenseVersion License [Version] - | NoLicenseFile - | UnrecognisedSourceRepo String - | MissingType - | MissingLocation - | MissingModule - | MissingTag - | SubdirRelPath - | SubdirGoodRelPath String - | OptFasm String - | OptViaC String - | OptHpc String - | OptProf String - | OptO String - | OptHide String - | OptMake String - | OptONot String - | OptOOne String - | OptOTwo String - | OptSplitSections String - | OptSplitObjs String - | OptWls String - | OptExts String - | OptRts String - | OptWithRts String - | COptONumber String String - | COptCPP String - | OptAlternatives String String [(String, String)] - | RelativeOutside String FilePath - | AbsolutePath String FilePath - | BadRelativePAth String FilePath String - | DistPoint (Maybe String) FilePath - | GlobSyntaxError String String - | RecursiveGlobInRoot String FilePath - | InvalidOnWin [FilePath] - | FilePathTooLong FilePath - | FilePathNameTooLong FilePath - | FilePathSplitTooLong FilePath - | FilePathEmpty - | CVTestSuite - | CVDefaultLanguage - | CVDefaultLanguageComponent - | CVExtraDocFiles - | CVMultiLib - | CVReexported - | CVMixins - | CVExtraFrameworkDirs - | CVDefaultExtensions - | CVExtensionsDeprecated - | CVSources - | CVExtraDynamic [[String]] - | CVVirtualModules - | CVSourceRepository - | CVExtensions CabalSpecVersion [Extension] - | CVCustomSetup - | CVExpliticDepsCustomSetup - | CVAutogenPaths - | CVAutogenPackageInfo - | GlobNoMatch String String - | GlobExactMatch String String FilePath - | GlobNoDir String String FilePath - | UnknownOS [String] - | UnknownArch [String] - | UnknownCompiler [String] - | BaseNoUpperBounds - | MissingUpperBounds [PackageName] - | SuspiciousFlagName [String] - | DeclaredUsedFlags (Set FlagName) (Set FlagName) - | NonASCIICustomField [String] - | RebindableClashPaths - | RebindableClashPackageInfo - | WErrorUnneeded String - | JUnneeded String - | FDeferTypeErrorsUnneeded String - | DynamicUnneeded String - | ProfilingUnneeded String - | UpperBoundSetup String - | DuplicateModule String [ModuleName] - | PotentialDupModule String [ModuleName] - | BOMStart FilePath - | NotPackageName FilePath String - | NoDesc - | MultiDesc [String] - | UnknownFile String (SymbolicPath PackageDir LicenseFile) - | MissingSetupFile - | MissingConfigureScript - | UnknownDirectory String FilePath - | MissingSourceControl - | MissingExpectedDocFiles Bool [FilePath] - | WrongFieldForExpectedDocFiles Bool String [FilePath] - deriving (Eq, Ord, Show) - --- | Wraps `ParseWarning` into `PackageCheck`. -wrapParseWarning :: FilePath -> PWarning -> PackageCheck -wrapParseWarning fp pw = PackageDistSuspicious (ParseWarning fp pw) - --- TODO: as Jul 2022 there is no severity indication attached PWarnType. --- Once that is added, we can output something more appropriate --- than PackageDistSuspicious for every parse warning. --- (see: Cabal-syntax/src/Distribution/Parsec/Warning.hs) - --- | Pretty printing `CheckExplanation`. -ppExplanation :: CheckExplanation -> String -ppExplanation (ParseWarning fp pp) = showPWarning fp pp -ppExplanation NoNameField = "No 'name' field." -ppExplanation NoVersionField = "No 'version' field." -ppExplanation NoTarget = - "No executables, libraries, tests, or benchmarks found. Nothing to do." -ppExplanation UnnamedInternal = - "Found one or more unnamed internal libraries. Only the non-internal" - ++ " library can have the same name as the package." -ppExplanation (DuplicateSections duplicateNames) = - "Duplicate sections: " - ++ commaSep (map unUnqualComponentName duplicateNames) - ++ ". The name of every library, executable, test suite," - ++ " and benchmark section in the package must be unique." -ppExplanation (IllegalLibraryName pkg) = - "Illegal internal library name " - ++ prettyShow (packageName pkg) - ++ ". Internal libraries cannot have the same name as the package." - ++ " Maybe you wanted a non-internal library?" - ++ " If so, rewrite the section stanza" - ++ " from 'library: '" - ++ prettyShow (packageName pkg) - ++ "' to 'library'." -ppExplanation (NoModulesExposed lib) = - showLibraryName (libName lib) ++ " does not expose any modules" -ppExplanation SignaturesCabal2 = - "To use the 'signatures' field the package needs to specify " - ++ "at least 'cabal-version: 2.0'." -ppExplanation AutogenNotExposed = - "An 'autogen-module' is neither on 'exposed-modules' nor 'other-modules'." -ppExplanation AutogenIncludesNotIncluded = - "An include in 'autogen-includes' is neither in 'includes' or " - ++ "'install-includes'." -ppExplanation (NoMainIs exe) = - "No 'main-is' field found for executable " ++ prettyShow (exeName exe) -ppExplanation NoHsLhsMain = - "The 'main-is' field must specify a '.hs' or '.lhs' file " - ++ "(even if it is generated by a preprocessor), " - ++ "or it may specify a C/C++/obj-C source file." -ppExplanation MainCCabal1_18 = - "The package uses a C/C++/obj-C source file for the 'main-is' field. " - ++ "To use this feature you need to specify 'cabal-version: 1.18' or" - ++ " higher." -ppExplanation (AutogenNoOther ct ucn) = - "On " - ++ ppCE ct - ++ " '" - ++ prettyShow ucn - ++ "' an 'autogen-module'" - ++ " is not on 'other-modules'" -ppExplanation AutogenIncludesNotIncludedExe = - "An include in 'autogen-includes' is not in 'includes'." -ppExplanation (TestsuiteTypeNotKnown tt) = - quote (prettyShow tt) - ++ " is not a known type of test suite. " - ++ "Either remove the 'type' field or use a known type. " - ++ "The known test suite types are: " - ++ commaSep (map prettyShow knownTestTypes) -ppExplanation (TestsuiteNotSupported tt) = - quote (prettyShow tt) - ++ " is not a supported test suite version. " - ++ "Either remove the 'type' field or use a known type. " - ++ "The known test suite types are: " - ++ commaSep (map prettyShow knownTestTypes) -ppExplanation (BenchmarkTypeNotKnown tt) = - quote (prettyShow tt) - ++ " is not a known type of benchmark. " - ++ "Either remove the 'type' field or use a known type. " - ++ "The known benchmark types are: " - ++ commaSep (map prettyShow knownBenchmarkTypes) -ppExplanation (BenchmarkNotSupported tt) = - quote (prettyShow tt) - ++ " is not a supported benchmark version. " - ++ "Either remove the 'type' field or use a known type. " - ++ "The known benchmark types are: " - ++ commaSep (map prettyShow knownBenchmarkTypes) -ppExplanation NoHsLhsMainBench = - "The 'main-is' field must specify a '.hs' or '.lhs' file " - ++ "(even if it is generated by a preprocessor)." -ppExplanation (InvalidNameWin pkg) = - "The package name '" - ++ prettyShow (packageName pkg) - ++ "' is " - ++ "invalid on Windows. Many tools need to convert package names to " - ++ "file names so using this name would cause problems." -ppExplanation ZPrefix = - "Package names with the prefix 'z-' are reserved by Cabal and " - ++ "cannot be used." -ppExplanation NoBuildType = - "No 'build-type' specified. If you do not need a custom Setup.hs or " - ++ "./configure script then use 'build-type: Simple'." -ppExplanation NoCustomSetup = - "Ignoring the 'custom-setup' section because the 'build-type' is " - ++ "not 'Custom'. Use 'build-type: Custom' if you need to use a " - ++ "custom Setup.hs script." -ppExplanation (UnknownCompilers unknownCompilers) = - "Unknown compiler " - ++ commaSep (map quote unknownCompilers) - ++ " in 'tested-with' field." -ppExplanation (UnknownLanguages unknownLanguages) = - "Unknown languages: " ++ commaSep unknownLanguages -ppExplanation (UnknownExtensions unknownExtensions) = - "Unknown extensions: " ++ commaSep unknownExtensions -ppExplanation (LanguagesAsExtension languagesUsedAsExtensions) = - "Languages listed as extensions: " - ++ commaSep languagesUsedAsExtensions - ++ ". Languages must be specified in either the 'default-language' " - ++ " or the 'other-languages' field." -ppExplanation (DeprecatedExtensions ourDeprecatedExtensions) = - "Deprecated extensions: " - ++ commaSep (map (quote . prettyShow . fst) ourDeprecatedExtensions) - ++ ". " - ++ unwords - [ "Instead of '" - ++ prettyShow ext - ++ "' use '" - ++ prettyShow replacement - ++ "'." - | (ext, Just replacement) <- ourDeprecatedExtensions - ] -ppExplanation (MissingField cef) = - "No '" ++ ppCEField cef ++ "' field." -ppExplanation SynopsisTooLong = - "The 'synopsis' field is rather long (max 80 chars is recommended)." -ppExplanation ShortDesc = - "The 'description' field should be longer than the 'synopsis' field. " - ++ "It's useful to provide an informative 'description' to allow " - ++ "Haskell programmers who have never heard about your package to " - ++ "understand the purpose of your package. " - ++ "The 'description' field content is typically shown by tooling " - ++ "(e.g. 'cabal info', Haddock, Hackage) below the 'synopsis' which " - ++ "serves as a headline. " - ++ "Please refer to for more details." -ppExplanation (InvalidTestWith testedWithImpossibleRanges) = - "Invalid 'tested-with' version range: " - ++ commaSep (map prettyShow testedWithImpossibleRanges) - ++ ". To indicate that you have tested a package with multiple " - ++ "different versions of the same compiler use multiple entries, " - ++ "for example 'tested-with: GHC==6.10.4, GHC==6.12.3' and not " - ++ "'tested-with: GHC==6.10.4 && ==6.12.3'." -ppExplanation (ImpossibleInternalDep depInternalLibWithImpossibleVersion) = - "The package has an impossible version range for a dependency on an " - ++ "internal library: " - ++ commaSep (map prettyShow depInternalLibWithImpossibleVersion) - ++ ". This version range does not include the current package, and must " - ++ "be removed as the current package's library will always be used." -ppExplanation (ImpossibleInternalExe depInternalExecWithImpossibleVersion) = - "The package has an impossible version range for a dependency on an " - ++ "internal executable: " - ++ commaSep (map prettyShow depInternalExecWithImpossibleVersion) - ++ ". This version range does not include the current package, and must " - ++ "be removed as the current package's executable will always be used." -ppExplanation (MissingInternalExe depInternalExeWithImpossibleVersion) = - "The package depends on a missing internal executable: " - ++ commaSep (map prettyShow depInternalExeWithImpossibleVersion) -ppExplanation NONELicense = "The 'license' field is missing or is NONE." -ppExplanation NoLicense = "The 'license' field is missing." -ppExplanation AllRightsReservedLicense = - "The 'license' is AllRightsReserved. Is that really what you want?" -ppExplanation (LicenseMessParse pkg) = - "Unfortunately the license " - ++ quote (prettyShow (license pkg)) - ++ " messes up the parser in earlier Cabal versions so you need to " - ++ "specify 'cabal-version: >= 1.4'. Alternatively if you require " - ++ "compatibility with earlier Cabal versions then use 'OtherLicense'." -ppExplanation (UnrecognisedLicense l) = - quote ("license: " ++ l) - ++ " is not a recognised license. The " - ++ "known licenses are: " - ++ commaSep (map prettyShow knownLicenses) -ppExplanation UncommonBSD4 = - "Using 'license: BSD4' is almost always a misunderstanding. 'BSD4' " - ++ "refers to the old 4-clause BSD license with the advertising " - ++ "clause. 'BSD3' refers the new 3-clause BSD license." -ppExplanation (UnknownLicenseVersion lic known) = - "'license: " - ++ prettyShow lic - ++ "' is not a known " - ++ "version of that license. The known versions are " - ++ commaSep (map prettyShow known) - ++ ". If this is not a mistake and you think it should be a known " - ++ "version then please file a ticket." -ppExplanation NoLicenseFile = "A 'license-file' is not specified." -ppExplanation (UnrecognisedSourceRepo kind) = - quote kind - ++ " is not a recognised kind of source-repository. " - ++ "The repo kind is usually 'head' or 'this'" -ppExplanation MissingType = - "The source-repository 'type' is a required field." -ppExplanation MissingLocation = - "The source-repository 'location' is a required field." -ppExplanation MissingModule = - "For a CVS source-repository, the 'module' is a required field." -ppExplanation MissingTag = - "For the 'this' kind of source-repository, the 'tag' is a required " - ++ "field. It should specify the tag corresponding to this version " - ++ "or release of the package." -ppExplanation SubdirRelPath = - "The 'subdir' field of a source-repository must be a relative path." -ppExplanation (SubdirGoodRelPath err) = - "The 'subdir' field of a source-repository is not a good relative path: " - ++ show err -ppExplanation (OptFasm fieldName) = - "'" - ++ fieldName - ++ ": -fasm' is unnecessary and will not work on CPU " - ++ "architectures other than x86, x86-64, ppc or sparc." -ppExplanation (OptViaC fieldName) = - "'" - ++ fieldName - ++ ": -fvia-C' is usually unnecessary. If your package " - ++ "needs -via-C for correctness rather than performance then it " - ++ "is using the FFI incorrectly and will probably not work with GHC " - ++ "6.10 or later." -ppExplanation (OptHpc fieldName) = - "'" - ++ fieldName - ++ ": -fhpc' is not necessary. Use the configure flag " - ++ " --enable-coverage instead." -ppExplanation (OptProf fieldName) = - "'" - ++ fieldName - ++ ": -prof' is not necessary and will lead to problems " - ++ "when used on a library. Use the configure flag " - ++ "--enable-library-profiling and/or --enable-profiling." -ppExplanation (OptO fieldName) = - "'" - ++ fieldName - ++ ": -o' is not needed. " - ++ "The output files are named automatically." -ppExplanation (OptHide fieldName) = - "'" - ++ fieldName - ++ ": -hide-package' is never needed. " - ++ "Cabal hides all packages." -ppExplanation (OptMake fieldName) = - "'" - ++ fieldName - ++ ": --make' is never needed. Cabal uses this automatically." -ppExplanation (OptONot fieldName) = - "'" - ++ fieldName - ++ ": -O0' is not needed. " - ++ "Use the --disable-optimization configure flag." -ppExplanation (OptOOne fieldName) = - "'" - ++ fieldName - ++ ": -O' is not needed. " - ++ "Cabal automatically adds the '-O' flag. " - ++ "Setting it yourself interferes with the --disable-optimization flag." -ppExplanation (OptOTwo fieldName) = - "'" - ++ fieldName - ++ ": -O2' is rarely needed. " - ++ "Check that it is giving a real benefit " - ++ "and not just imposing longer compile times on your users." -ppExplanation (OptSplitSections fieldName) = - "'" - ++ fieldName - ++ ": -split-sections' is not needed. " - ++ "Use the --enable-split-sections configure flag." -ppExplanation (OptSplitObjs fieldName) = - "'" - ++ fieldName - ++ ": -split-objs' is not needed. " - ++ "Use the --enable-split-objs configure flag." -ppExplanation (OptWls fieldName) = - "'" - ++ fieldName - ++ ": -optl-Wl,-s' is not needed and is not portable to" - ++ " all operating systems. Cabal 1.4 and later automatically strip" - ++ " executables. Cabal also has a flag --disable-executable-stripping" - ++ " which is necessary when building packages for some Linux" - ++ " distributions and using '-optl-Wl,-s' prevents that from working." -ppExplanation (OptExts fieldName) = - "Instead of '" - ++ fieldName - ++ ": -fglasgow-exts' it is preferable to use " - ++ "the 'extensions' field." -ppExplanation (OptRts fieldName) = - "'" - ++ fieldName - ++ ": -rtsopts' has no effect for libraries. It should " - ++ "only be used for executables." -ppExplanation (OptWithRts fieldName) = - "'" - ++ fieldName - ++ ": -with-rtsopts' has no effect for libraries. It " - ++ "should only be used for executables." -ppExplanation (COptONumber prefix label) = - "'" - ++ prefix - ++ ": -O[n]' is generally not needed. When building with " - ++ " optimisations Cabal automatically adds '-O2' for " - ++ label - ++ " code. Setting it yourself interferes with the" - ++ " --disable-optimization flag." -ppExplanation (COptCPP opt) = - "'cpp-options: " ++ opt ++ "' is not a portable C-preprocessor flag." -ppExplanation (OptAlternatives badField goodField flags) = - "Instead of " - ++ quote (badField ++ ": " ++ unwords badFlags) - ++ " use " - ++ quote (goodField ++ ": " ++ unwords goodFlags) - where - (badFlags, goodFlags) = unzip flags -ppExplanation (RelativeOutside field path) = - quote (field ++ ": " ++ path) - ++ " is a relative path outside of the source tree. " - ++ "This will not work when generating a tarball with 'sdist'." -ppExplanation (AbsolutePath field path) = - quote (field ++ ": " ++ path) - ++ " specifies an absolute path, but the " - ++ quote field - ++ " field must use relative paths." -ppExplanation (BadRelativePAth field path err) = - quote (field ++ ": " ++ path) - ++ " is not a good relative path: " - ++ show err -ppExplanation (DistPoint mfield path) = - incipit - ++ " points inside the 'dist' " - ++ "directory. This is not reliable because the location of this " - ++ "directory is configurable by the user (or package manager). In " - ++ "addition the layout of the 'dist' directory is subject to change " - ++ "in future versions of Cabal." - where - -- mfiled Nothing -> the path is inside `ghc-options` - incipit = - maybe - ("'ghc-options' path " ++ quote path) - (\field -> quote (field ++ ": " ++ path)) - mfield -ppExplanation (GlobSyntaxError field expl) = - "In the '" ++ field ++ "' field: " ++ expl -ppExplanation (RecursiveGlobInRoot field glob) = - "In the '" - ++ field - ++ "': glob '" - ++ glob - ++ "' starts at project root directory, this might " - ++ "include `.git/`, ``dist-newstyle/``, or other large directories!" -ppExplanation (InvalidOnWin paths) = - "The " - ++ quotes paths - ++ " invalid on Windows, which " - ++ "would cause portability problems for this package. Windows file " - ++ "names cannot contain any of the characters \":*?<>|\" and there " - ++ "a few reserved names including \"aux\", \"nul\", \"con\", " - ++ "\"prn\", \"com1-9\", \"lpt1-9\" and \"clock$\"." - where - quotes [failed] = "path " ++ quote failed ++ " is" - quotes failed = - "paths " - ++ intercalate ", " (map quote failed) - ++ " are" -ppExplanation (FilePathTooLong path) = - "The following file name is too long to store in a portable POSIX " - ++ "format tar archive. The maximum length is 255 ASCII characters.\n" - ++ "The file in question is:\n " - ++ path -ppExplanation (FilePathNameTooLong path) = - "The following file name is too long to store in a portable POSIX " - ++ "format tar archive. The maximum length for the name part (including " - ++ "extension) is 100 ASCII characters. The maximum length for any " - ++ "individual directory component is 155.\n" - ++ "The file in question is:\n " - ++ path -ppExplanation (FilePathSplitTooLong path) = - "The following file name is too long to store in a portable POSIX " - ++ "format tar archive. While the total length is less than 255 ASCII " - ++ "characters, there are unfortunately further restrictions. It has to " - ++ "be possible to split the file path on a directory separator into " - ++ "two parts such that the first part fits in 155 characters or less " - ++ "and the second part fits in 100 characters or less. Basically you " - ++ "have to make the file name or directory names shorter, or you could " - ++ "split a long directory name into nested subdirectories with shorter " - ++ "names.\nThe file in question is:\n " - ++ path -ppExplanation FilePathEmpty = - "Encountered a file with an empty name, something is very wrong! " - ++ "Files with an empty name cannot be stored in a tar archive or in " - ++ "standard file systems." -ppExplanation CVTestSuite = - "The 'test-suite' section is new in Cabal 1.10. " - ++ "Unfortunately it messes up the parser in older Cabal versions " - ++ "so you must specify at least 'cabal-version: >= 1.8', but note " - ++ "that only Cabal 1.10 and later can actually run such test suites." -ppExplanation CVDefaultLanguage = - "To use the 'default-language' field the package needs to specify " - ++ "at least 'cabal-version: >= 1.10'." -ppExplanation CVDefaultLanguageComponent = - "Packages using 'cabal-version: >= 1.10' and before 'cabal-version: 3.4' " - ++ "must specify the 'default-language' field for each component (e.g. " - ++ "Haskell98 or Haskell2010). If a component uses different languages " - ++ "in different modules then list the other ones in the " - ++ "'other-languages' field." -ppExplanation CVExtraDocFiles = - "To use the 'extra-doc-files' field the package needs to specify " - ++ "'cabal-version: 1.18' or higher." -ppExplanation CVMultiLib = - "To use multiple 'library' sections or a named library section " - ++ "the package needs to specify at least 'cabal-version: 2.0'." -ppExplanation CVReexported = - "To use the 'reexported-module' field the package needs to specify " - ++ "'cabal-version: 1.22' or higher." -ppExplanation CVMixins = - "To use the 'mixins' field the package needs to specify " - ++ "at least 'cabal-version: 2.0'." -ppExplanation CVExtraFrameworkDirs = - "To use the 'extra-framework-dirs' field the package needs to specify" - ++ " 'cabal-version: 1.24' or higher." -ppExplanation CVDefaultExtensions = - "To use the 'default-extensions' field the package needs to specify " - ++ "at least 'cabal-version: >= 1.10'." -ppExplanation CVExtensionsDeprecated = - "For packages using 'cabal-version: >= 1.10' the 'extensions' " - ++ "field is deprecated. The new 'default-extensions' field lists " - ++ "extensions that are used in all modules in the component, while " - ++ "the 'other-extensions' field lists extensions that are used in " - ++ "some modules, e.g. via the {-# LANGUAGE #-} pragma." -ppExplanation CVSources = - "The use of 'asm-sources', 'cmm-sources', 'extra-bundled-libraries' " - ++ " and 'extra-library-flavours' requires the package " - ++ " to specify at least 'cabal-version: 3.0'." -ppExplanation (CVExtraDynamic flavs) = - "The use of 'extra-dynamic-library-flavours' requires the package " - ++ " to specify at least 'cabal-version: 3.0'. The flavours are: " - ++ commaSep (concat flavs) -ppExplanation CVVirtualModules = - "The use of 'virtual-modules' requires the package " - ++ " to specify at least 'cabal-version: 2.2'." -ppExplanation CVSourceRepository = - "The 'source-repository' section is new in Cabal 1.6. " - ++ "Unfortunately it messes up the parser in earlier Cabal versions " - ++ "so you need to specify 'cabal-version: >= 1.6'." -ppExplanation (CVExtensions version extCab12) = - "Unfortunately the language extensions " - ++ commaSep (map (quote . prettyShow) extCab12) - ++ " break the parser in earlier Cabal versions so you need to " - ++ "specify 'cabal-version: >= " - ++ showCabalSpecVersion version - ++ "'. Alternatively if you require compatibility with earlier " - ++ "Cabal versions then you may be able to use an equivalent " - ++ "compiler-specific flag." -ppExplanation CVCustomSetup = - "Packages using 'cabal-version: 1.24' or higher with 'build-type: Custom' " - ++ "must use a 'custom-setup' section with a 'setup-depends' field " - ++ "that specifies the dependencies of the Setup.hs script itself. " - ++ "The 'setup-depends' field uses the same syntax as 'build-depends', " - ++ "so a simple example would be 'setup-depends: base, Cabal'." -ppExplanation CVExpliticDepsCustomSetup = - "From version 1.24 cabal supports specifying explicit dependencies " - ++ "for Custom setup scripts. Consider using 'cabal-version: 1.24' or " - ++ "higher and adding a 'custom-setup' section with a 'setup-depends' " - ++ "field that specifies the dependencies of the Setup.hs script " - ++ "itself. The 'setup-depends' field uses the same syntax as " - ++ "'build-depends', so a simple example would be 'setup-depends: base, " - ++ "Cabal'." -ppExplanation CVAutogenPaths = - "Packages using 'cabal-version: 2.0' and the autogenerated " - ++ "module Paths_* must include it also on the 'autogen-modules' field " - ++ "besides 'exposed-modules' and 'other-modules'. This specifies that " - ++ "the module does not come with the package and is generated on " - ++ "setup. Modules built with a custom Setup.hs script also go here " - ++ "to ensure that commands like sdist don't fail." -ppExplanation CVAutogenPackageInfo = - "Packages using 'cabal-version: 2.0' and the autogenerated " - ++ "module PackageInfo_* must include it in 'autogen-modules' as well as" - ++ " 'exposed-modules' and 'other-modules'. This specifies that " - ++ "the module does not come with the package and is generated on " - ++ "setup. Modules built with a custom Setup.hs script also go here " - ++ "to ensure that commands like sdist don't fail." -ppExplanation (GlobNoMatch field glob) = - "In '" - ++ field - ++ "': the pattern '" - ++ glob - ++ "' does not" - ++ " match any files." -ppExplanation (GlobExactMatch field glob file) = - "In '" - ++ field - ++ "': the pattern '" - ++ glob - ++ "' does not" - ++ " match the file '" - ++ file - ++ "' because the extensions do not" - ++ " exactly match (e.g., foo.en.html does not exactly match *.html)." - ++ " To enable looser suffix-only matching, set 'cabal-version: 2.4' or" - ++ " higher." -ppExplanation (GlobNoDir field glob dir) = - "In '" - ++ field - ++ "': the pattern '" - ++ glob - ++ "' attempts to" - ++ " match files in the directory '" - ++ dir - ++ "', but there is no" - ++ " directory by that name." -ppExplanation (UnknownOS unknownOSs) = - "Unknown operating system name " ++ commaSep (map quote unknownOSs) -ppExplanation (UnknownArch unknownArches) = - "Unknown architecture name " ++ commaSep (map quote unknownArches) -ppExplanation (UnknownCompiler unknownImpls) = - "Unknown compiler name " ++ commaSep (map quote unknownImpls) -ppExplanation (MissingUpperBounds names) = - let separator = "\n - " - in "These packages miss upper bounds:" - ++ separator - ++ (intercalate separator (unPackageName <$> names)) - ++ "\n" - ++ "Please add them, using `cabal gen-bounds` for suggestions." - ++ " For more information see: " - ++ " https://pvp.haskell.org/" -ppExplanation BaseNoUpperBounds = - "The dependency 'build-depends: base' does not specify an upper " - ++ "bound on the version number. Each major release of the 'base' " - ++ "package changes the API in various ways and most packages will " - ++ "need some changes to compile with it. The recommended practice " - ++ "is to specify an upper bound on the version of the 'base' " - ++ "package. This ensures your package will continue to build when a " - ++ "new major version of the 'base' package is released. If you are " - ++ "not sure what upper bound to use then use the next major " - ++ "version. For example if you have tested your package with 'base' " - ++ "version 4.5 and 4.6 then use 'build-depends: base >= 4.5 && < 4.7'." -ppExplanation (SuspiciousFlagName invalidFlagNames) = - "Suspicious flag names: " - ++ unwords invalidFlagNames - ++ ". " - ++ "To avoid ambiguity in command line interfaces, flag shouldn't " - ++ "start with a dash. Also for better compatibility, flag names " - ++ "shouldn't contain non-ascii characters." -ppExplanation (DeclaredUsedFlags declared used) = - "Declared and used flag sets differ: " - ++ s declared - ++ " /= " - ++ s used - ++ ". " - where - s :: Set.Set FlagName -> String - s = commaSep . map unFlagName . Set.toList -ppExplanation (NonASCIICustomField nonAsciiXFields) = - "Non ascii custom fields: " - ++ unwords nonAsciiXFields - ++ ". " - ++ "For better compatibility, custom field names " - ++ "shouldn't contain non-ascii characters." -ppExplanation RebindableClashPaths = - "Packages using RebindableSyntax with OverloadedStrings or" - ++ " OverloadedLists in default-extensions, in conjunction with the" - ++ " autogenerated module Paths_*, are known to cause compile failures" - ++ " with Cabal < 2.2. To use these default-extensions with a Paths_*" - ++ " autogen module, specify at least 'cabal-version: 2.2'." -ppExplanation RebindableClashPackageInfo = - "Packages using RebindableSyntax with OverloadedStrings or" - ++ " OverloadedLists in default-extensions, in conjunction with the" - ++ " autogenerated module PackageInfo_*, are known to cause compile failures" - ++ " with Cabal < 2.2. To use these default-extensions with a PackageInfo_*" - ++ " autogen module, specify at least 'cabal-version: 2.2'." -ppExplanation (WErrorUnneeded fieldName) = - addConditionalExp $ - "'" - ++ fieldName - ++ ": -Werror' makes the package easy to " - ++ "break with future GHC versions because new GHC versions often " - ++ "add new warnings." -ppExplanation (JUnneeded fieldName) = - addConditionalExp $ - "'" - ++ fieldName - ++ ": -j[N]' can make sense for specific user's setup," - ++ " but it is not appropriate for a distributed package." -ppExplanation (FDeferTypeErrorsUnneeded fieldName) = - addConditionalExp $ - "'" - ++ fieldName - ++ ": -fdefer-type-errors' is fine during development " - ++ "but is not appropriate for a distributed package." -ppExplanation (DynamicUnneeded fieldName) = - addConditionalExp $ - "'" - ++ fieldName - ++ ": -d*' debug flags are not appropriate " - ++ "for a distributed package." -ppExplanation (ProfilingUnneeded fieldName) = - addConditionalExp $ - "'" - ++ fieldName - ++ ": -fprof*' profiling flags are typically not " - ++ "appropriate for a distributed library package. These flags are " - ++ "useful to profile this package, but when profiling other packages " - ++ "that use this one these flags clutter the profile output with " - ++ "excessive detail. If you think other packages really want to see " - ++ "cost centres from this package then use '-fprof-auto-exported' " - ++ "which puts cost centres only on exported functions." -ppExplanation (UpperBoundSetup nm) = - "The dependency 'setup-depends: '" - ++ nm - ++ "' does not specify an " - ++ "upper bound on the version number. Each major release of the " - ++ "'" - ++ nm - ++ "' package changes the API in various ways and most " - ++ "packages will need some changes to compile with it. If you are " - ++ "not sure what upper bound to use then use the next major " - ++ "version." -ppExplanation (DuplicateModule s dupLibsLax) = - "Duplicate modules in " - ++ s - ++ ": " - ++ commaSep (map prettyShow dupLibsLax) -ppExplanation (PotentialDupModule s dupLibsStrict) = - "Potential duplicate modules (subject to conditionals) in " - ++ s - ++ ": " - ++ commaSep (map prettyShow dupLibsStrict) -ppExplanation (BOMStart pdfile) = - pdfile - ++ " starts with an Unicode byte order mark (BOM)." - ++ " This may cause problems with older cabal versions." -ppExplanation (NotPackageName pdfile expectedCabalname) = - "The filename " - ++ quote pdfile - ++ " does not match package name " - ++ "(expected: " - ++ quote expectedCabalname - ++ ")" -ppExplanation NoDesc = - "No cabal file found.\n" - ++ "Please create a package description file .cabal" -ppExplanation (MultiDesc multiple) = - "Multiple cabal files found while checking.\n" - ++ "Please use only one of: " - ++ intercalate ", " multiple -ppExplanation (UnknownFile fieldname file) = - "The '" - ++ fieldname - ++ "' field refers to the file " - ++ quote (getSymbolicPath file) - ++ " which does not exist." -ppExplanation MissingSetupFile = - "The package is missing a Setup.hs or Setup.lhs script." -ppExplanation MissingConfigureScript = - "The 'build-type' is 'Configure' but there is no 'configure' script. " - ++ "You probably need to run 'autoreconf -i' to generate it." -ppExplanation (UnknownDirectory kind dir) = - quote (kind ++ ": " ++ dir) - ++ " specifies a directory which does not exist." -ppExplanation MissingSourceControl = - "When distributing packages it is encouraged to specify source " - ++ "control information in the .cabal file using one or more " - ++ "'source-repository' sections. See the Cabal user guide for " - ++ "details." -ppExplanation (MissingExpectedDocFiles extraDocFileSupport paths) = - "Please consider including the " - ++ quotes paths - ++ " in the '" - ++ targetField - ++ "' section of the .cabal file " - ++ "if it contains useful information for users of the package." - where - quotes [p] = "file " ++ quote p - quotes ps = "files " ++ intercalate ", " (map quote ps) - targetField = - if extraDocFileSupport - then "extra-doc-files" - else "extra-source-files" -ppExplanation (WrongFieldForExpectedDocFiles extraDocFileSupport field paths) = - "Please consider moving the " - ++ quotes paths - ++ " from the '" - ++ field - ++ "' section of the .cabal file " - ++ "to the section '" - ++ targetField - ++ "'." - where - quotes [p] = "file " ++ quote p - quotes ps = "files " ++ intercalate ", " (map quote ps) - targetField = - if extraDocFileSupport - then "extra-doc-files" - else "extra-source-files" - --- | Results of some kind of failed package check. +-- ☞ N.B. -- --- There are a range of severities, from merely dubious to totally insane. --- All of them come with a human readable explanation. In future we may augment --- them with more machine readable explanations, for example to help an IDE --- suggest automatic corrections. -data PackageCheck - = -- | This package description is no good. There's no way it's going to - -- build sensibly. This should give an error at configure time. - PackageBuildImpossible {explanation :: CheckExplanation} - | -- | A problem that is likely to affect building the package, or an - -- issue that we'd like every package author to be aware of, even if - -- the package is never distributed. - PackageBuildWarning {explanation :: CheckExplanation} - | -- | An issue that might not be a problem for the package author but - -- might be annoying or detrimental when the package is distributed to - -- users. We should encourage distributed packages to be free from these - -- issues, but occasionally there are justifiable reasons so we cannot - -- ban them entirely. - PackageDistSuspicious {explanation :: CheckExplanation} - | -- | Like PackageDistSuspicious but will only display warnings - -- rather than causing abnormal exit when you run 'cabal check'. - PackageDistSuspiciousWarn {explanation :: CheckExplanation} - | -- | An issue that is OK in the author's environment but is almost - -- certain to be a portability problem for other environments. We can - -- quite legitimately refuse to publicly distribute packages with these - -- problems. - PackageDistInexcusable {explanation :: CheckExplanation} - deriving (Eq, Ord) - --- | Would Hackage refuse a package because of this error? -isHackageDistError :: PackageCheck -> Bool -isHackageDistError = \case - (PackageBuildImpossible{}) -> True - (PackageBuildWarning{}) -> True - (PackageDistInexcusable{}) -> True - (PackageDistSuspicious{}) -> False - (PackageDistSuspiciousWarn{}) -> False - --- | Pretty printing 'PackageCheck'. -ppPackageCheck :: PackageCheck -> String -ppPackageCheck e = ppExplanation (explanation e) - -instance Show PackageCheck where - show notice = ppPackageCheck notice - -check :: Bool -> PackageCheck -> Maybe PackageCheck -check False _ = Nothing -check True pc = Just pc - -checkSpecVersion - :: PackageDescription - -> CabalSpecVersion - -> Bool - -> PackageCheck - -> Maybe PackageCheck -checkSpecVersion pkg specver cond pc - | specVersion pkg >= specver = Nothing - | otherwise = check cond pc +-- Part of the tools/scaffold used to perform check is found in +-- Distribution.PackageDescription.Check.Types. Summary of that module (for +-- how we use it here): +-- 1. we work inside a 'CheckM m a' monad (where `m` is an abstraction to +-- run non-pure checks); +-- 2. 'checkP', 'checkPre' functions perform checks (respectively pure and +-- non-pure); +-- 3. 'PackageCheck' and 'CheckExplanation' are types for warning severity +-- and description. -- ------------------------------------------------------------ - --- * Standard checks - +-- Checking interface -- ------------------------------------------------------------ +-- | 'checkPackagePrim' is the most general way to invoke package checks. +-- We pass to it two interfaces (one to check contents of packages, the +-- other to inspect working tree for orphan files) and before that a +-- Boolean to indicate whether we want pure checks or not. Based on these +-- parameters, some checks will be performed, some omitted. +-- Generality over @m@ means we could do non pure checks in monads other +-- than IO (e.g. a virtual filesystem, like a zip file, a VCS filesystem, +-- etc). +checkPackagePrim + :: Monad m + => Bool -- Perform pure checks? + -> Maybe (CheckPackageContentOps m) -- Package content interface. + -> Maybe (CheckPreDistributionOps m) -- Predist checks interface. + -> GenericPackageDescription -- GPD to check. + -> m [PackageCheck] +checkPackagePrim b mco mpdo gpd = do + let cm = checkGenericPackageDescription gpd + ci = CheckInterface b mco mpdo + ctx = pristineCheckCtx ci gpd + execCheckM cm ctx + -- | Check for common mistakes and problems in package descriptions. -- -- This is the standard collection of checks covering all aspects except -- for checks that require looking at files within the package. For those -- see 'checkPackageFiles'. +checkPackage :: GenericPackageDescription -> [PackageCheck] +checkPackage gpd = runIdentity $ checkPackagePrim True Nothing Nothing gpd + +-- | This function is an oddity due to the historical +-- GenericPackageDescription/PackageDescription split. It is only maintained +-- not to break interface, use `checkPackage` if possible. +checkConfiguredPackage :: PackageDescription -> [PackageCheck] +checkConfiguredPackage pd = checkPackage (pd2gpd pd) + +-- | Sanity check things that requires looking at files in the package. +-- This is a generalised version of 'checkPackageFiles' that can work in any +-- monad for which you can provide 'CheckPackageContentOps' operations. -- --- It requires the 'GenericPackageDescription' and optionally a particular --- configuration of that package. If you pass 'Nothing' then we just check --- a version of the generic description using 'flattenPackageDescription'. -checkPackage - :: GenericPackageDescription - -> Maybe PackageDescription - -> [PackageCheck] -checkPackage gpkg mpkg = - checkConfiguredPackage pkg - ++ checkConditionals gpkg - ++ checkPackageVersions gpkg - ++ checkDevelopmentOnlyFlags gpkg - ++ checkFlagNames gpkg - ++ checkUnusedFlags gpkg - ++ checkUnicodeXFields gpkg - ++ checkPathsModuleExtensions pkg - ++ checkPackageInfoModuleExtensions pkg - ++ checkSetupVersions gpkg - ++ checkDuplicateModules gpkg +-- The point of this extra generality is to allow doing checks in some virtual +-- file system, for example a tarball in memory. +checkPackageContent + :: Monad m + => CheckPackageContentOps m + -> GenericPackageDescription + -> m [PackageCheck] +checkPackageContent pops gpd = checkPackagePrim False (Just pops) Nothing gpd + +-- | Sanity checks that require IO. 'checkPackageFiles' looks at the files +-- in the package and expects to find the package unpacked at the given +-- filepath. +checkPackageFilesGPD + :: Verbosity -- Glob warn message verbosity. + -> GenericPackageDescription + -> FilePath -- Package root. + -> IO [PackageCheck] +checkPackageFilesGPD verbosity gpd root = + checkPackagePrim False (Just checkFilesIO) (Just checkPreIO) gpd where - pkg = fromMaybe (flattenPackageDescription gpkg) mpkg + checkFilesIO = + CheckPackageContentOps + { doesFileExist = System.doesFileExist . relative + , doesDirectoryExist = System.doesDirectoryExist . relative + , getDirectoryContents = System.Directory.getDirectoryContents . relative + , getFileContents = BS.readFile . relative + } --- TODO: make this variant go away --- we should always know the GenericPackageDescription -checkConfiguredPackage :: PackageDescription -> [PackageCheck] -checkConfiguredPackage pkg = - checkSanity pkg - ++ checkFields pkg - ++ checkLicense pkg - ++ checkSourceRepos pkg - ++ checkAllGhcOptions pkg - ++ checkCCOptions pkg - ++ checkCxxOptions pkg - ++ checkCPPOptions pkg - ++ checkPaths pkg - ++ checkCabalVersion pkg + checkPreIO = + CheckPreDistributionOps + { runDirFileGlobM = \fp g -> runDirFileGlob verbosity (root fp) g + , getDirectoryContentsM = System.Directory.getDirectoryContents . relative + } --- ------------------------------------------------------------ + relative path = root path --- * Basic sanity checks +-- | Same as 'checkPackageFilesGPD', but working with 'PackageDescription'. +-- +-- This function is included for legacy reasons, use 'checkPackageFilesGPD' +-- if you are working with 'GenericPackageDescription'. +checkPackageFiles + :: Verbosity -- Glob warn message verbosity. + -> PackageDescription + -> FilePath -- Package root. + -> IO [PackageCheck] +checkPackageFiles verbosity pd oot = + checkPackageFilesGPD verbosity (pd2gpd pd) oot -- ------------------------------------------------------------ +-- Package description +-- ------------------------------------------------------------ --- | Check that this package description is sane. -checkSanity :: PackageDescription -> [PackageCheck] -checkSanity pkg = - catMaybes - [ check (null . unPackageName . packageName $ pkg) $ - PackageBuildImpossible NoNameField - , check (nullVersion == packageVersion pkg) $ - PackageBuildImpossible NoVersionField - , check - ( all - ($ pkg) - [ null . executables - , null . testSuites - , null . benchmarks - , null . allLibraries - , null . foreignLibs +-- Here lies the meat of the module. Starting from 'GenericPackageDescription', +-- we walk the data while doing a number of checks. +-- +-- Where applicable we do a full pattern match (if the data changes, code will +-- break: a gentle reminder to add more checks). +-- Pattern matching variables convention: matching accessor + underscore. +-- This way it is easier to see which one we are missing if we run into +-- an “GPD should have 20 arguments but has been given only 19” error. + +-- | 'GenericPackageDescription' checks. Remember that for historical quirks +-- in the cabal codebase we have both `GenericPackageDescription` and +-- `PackageDescription` and that PD is both a *field* of GPD and a concept +-- of its own (i.e. a fully realised GPD). +-- In this case we are checking (correctly) GPD, so for target info/checks +-- you should walk condLibrary_ etc. and *not* the (empty) target info in +-- PD. See 'pd2gpd' for a convenient hack when you only have +-- 'PackageDescription'. +checkGenericPackageDescription + :: Monad m + => GenericPackageDescription + -> CheckM m () +checkGenericPackageDescription + gpd@( GenericPackageDescription + packageDescription_ + _gpdScannedVersion_ + genPackageFlags_ + condLibrary_ + condSubLibraries_ + condForeignLibs_ + condExecutables_ + condTestSuites_ + condBenchmarks_ + ) = + do + -- § Description and names. + checkPackageDescription packageDescription_ + -- Targets should be present... + let condAllLibraries = + maybeToList condLibrary_ + ++ (map snd condSubLibraries_) + checkP + ( and + [ null condExecutables_ + , null condTestSuites_ + , null condBenchmarks_ + , null condAllLibraries + , null condForeignLibs_ ] ) - $ PackageBuildImpossible NoTarget - , check (any (== LMainLibName) (map libName $ subLibraries pkg)) $ - PackageBuildImpossible UnnamedInternal - , check (not (null duplicateNames)) $ - PackageBuildImpossible (DuplicateSections duplicateNames) - , -- NB: but it's OK for executables to have the same name! - -- TODO shouldn't need to compare on the string level - check - ( any - (== prettyShow (packageName pkg)) - (prettyShow <$> subLibNames) + (PackageBuildImpossible NoTarget) + -- ... and have unique names (names are not under conditional, it is + -- appropriate to check here. + (nsubs, nexes, ntests, nbenchs) <- + asksCM + ( ( \n -> + ( pnSubLibs n + , pnExecs n + , pnTests n + , pnBenchs n + ) + ) + . ccNames + ) + let names = concat [nsubs, nexes, ntests, nbenchs] + dupes = dups names + checkP + (not . null $ dups names) + (PackageBuildImpossible $ DuplicateSections dupes) + -- PackageDescription checks. + checkPackageDescription packageDescription_ + -- Flag names. + mapM_ checkFlagName genPackageFlags_ + + -- § Feature checks. + checkSpecVer + CabalSpecV2_0 + (not . null $ condSubLibraries_) + (PackageDistInexcusable CVMultiLib) + checkSpecVer + CabalSpecV1_8 + (not . null $ condTestSuites_) + (PackageDistInexcusable CVTestSuite) + + -- § Conditional targets + + -- Extract dependencies from libraries, to be passed along for + -- PVP checks purposes. + pName <- + asksCM + ( packageNameToUnqualComponentName + . pkgName + . pnPackageId + . ccNames + ) + let ads = + maybe [] ((: []) . extractAssocDeps pName) condLibrary_ + ++ map (uncurry extractAssocDeps) condSubLibraries_ + + case condLibrary_ of + Just cl -> + checkCondTarget + genPackageFlags_ + (checkLibrary False ads) + (const id) + (mempty, cl) + Nothing -> return () + mapM_ + ( checkCondTarget + genPackageFlags_ + (checkLibrary False ads) + (\u l -> l{libName = maybeToLibraryName (Just u)}) ) - $ PackageBuildImpossible (IllegalLibraryName pkg) - ] - -- TODO: check for name clashes case insensitively: windows file systems cannot - -- cope. - - ++ concatMap (checkLibrary pkg) (allLibraries pkg) - ++ concatMap (checkExecutable pkg) (executables pkg) - ++ concatMap (checkTestSuite pkg) (testSuites pkg) - ++ concatMap (checkBenchmark pkg) (benchmarks pkg) - where - -- The public 'library' gets special dispensation, because it - -- is common practice to export a library and name the executable - -- the same as the package. - subLibNames = mapMaybe (libraryNameString . libName) $ subLibraries pkg - exeNames = map exeName $ executables pkg - testNames = map testName $ testSuites pkg - bmNames = map benchmarkName $ benchmarks pkg - duplicateNames = dups $ subLibNames ++ exeNames ++ testNames ++ bmNames - -checkLibrary :: PackageDescription -> Library -> [PackageCheck] -checkLibrary pkg lib = - catMaybes - [ -- TODO: This check is bogus if a required-signature was passed through - check (null (explicitLibModules lib) && null (reexportedModules lib)) $ - PackageDistSuspiciousWarn (NoModulesExposed lib) - , -- check use of signatures sections - checkVersion CabalSpecV2_0 (not (null (signatures lib))) $ - PackageDistInexcusable SignaturesCabal2 - , -- check that all autogen-modules appear on other-modules or exposed-modules - check - (not $ and $ map (flip elem (explicitLibModules lib)) (libModulesAutogen lib)) - $ PackageBuildImpossible AutogenNotExposed - , -- check that all autogen-includes appear on includes or install-includes - check - (not $ and $ map (flip elem (allExplicitIncludes lib)) (view L.autogenIncludes lib)) - $ PackageBuildImpossible AutogenIncludesNotIncluded - ] - where - checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck - checkVersion ver cond pc - | specVersion pkg >= ver = Nothing - | otherwise = check cond pc - -allExplicitIncludes :: L.HasBuildInfo a => a -> [FilePath] -allExplicitIncludes x = view L.includes x ++ view L.installIncludes x - -checkExecutable :: PackageDescription -> Executable -> [PackageCheck] -checkExecutable pkg exe = - catMaybes - [ check (null (modulePath exe)) $ - PackageBuildImpossible (NoMainIs exe) - , -- This check does not apply to scripts. - check - ( package pkg /= fakePackageId - && not (null (modulePath exe)) - && not (fileExtensionSupportedLanguage $ modulePath exe) + condSubLibraries_ + mapM_ + ( checkCondTarget + genPackageFlags_ + checkForeignLib + (const id) ) - $ PackageBuildImpossible NoHsLhsMain - , checkSpecVersion - pkg - CabalSpecV1_18 - ( fileExtensionSupportedLanguage (modulePath exe) - && takeExtension (modulePath exe) `notElem` [".hs", ".lhs"] + condForeignLibs_ + mapM_ + ( checkCondTarget + genPackageFlags_ + (checkExecutable ads) + (const id) ) - $ PackageDistInexcusable MainCCabal1_18 - , -- check that all autogen-modules appear on other-modules - check - (not $ and $ map (flip elem (exeModules exe)) (exeModulesAutogen exe)) - $ PackageBuildImpossible (AutogenNoOther CETExecutable (exeName exe)) - , -- check that all autogen-includes appear on includes - check - (not $ and $ map (flip elem (view L.includes exe)) (view L.autogenIncludes exe)) - $ PackageBuildImpossible AutogenIncludesNotIncludedExe - ] - -checkTestSuite :: PackageDescription -> TestSuite -> [PackageCheck] -checkTestSuite pkg test = - catMaybes - [ case testInterface test of - TestSuiteUnsupported tt@(TestTypeUnknown _ _) -> - Just $ - PackageBuildWarning (TestsuiteTypeNotKnown tt) - TestSuiteUnsupported tt -> - Just $ - PackageBuildWarning (TestsuiteNotSupported tt) - _ -> Nothing - , check mainIsWrongExt $ - PackageBuildImpossible NoHsLhsMain - , checkSpecVersion pkg CabalSpecV1_18 (mainIsNotHsExt && not mainIsWrongExt) $ - PackageDistInexcusable MainCCabal1_18 - , -- check that all autogen-modules appear on other-modules - check - (not $ and $ map (flip elem (testModules test)) (testModulesAutogen test)) - $ PackageBuildImpossible (AutogenNoOther CETTest (testName test)) - , -- check that all autogen-includes appear on includes - check - (not $ and $ map (flip elem (view L.includes test)) (view L.autogenIncludes test)) - $ PackageBuildImpossible AutogenIncludesNotIncludedExe - ] - where - mainIsWrongExt = case testInterface test of - TestSuiteExeV10 _ f -> not $ fileExtensionSupportedLanguage f - _ -> False - - mainIsNotHsExt = case testInterface test of - TestSuiteExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"] - _ -> False - -checkBenchmark :: PackageDescription -> Benchmark -> [PackageCheck] -checkBenchmark _pkg bm = - catMaybes - [ case benchmarkInterface bm of - BenchmarkUnsupported tt@(BenchmarkTypeUnknown _ _) -> - Just $ - PackageBuildWarning (BenchmarkTypeNotKnown tt) - BenchmarkUnsupported tt -> - Just $ - PackageBuildWarning (BenchmarkNotSupported tt) - _ -> Nothing - , check mainIsWrongExt $ - PackageBuildImpossible NoHsLhsMainBench - , -- check that all autogen-modules appear on other-modules - check - (not $ and $ map (flip elem (benchmarkModules bm)) (benchmarkModulesAutogen bm)) - $ PackageBuildImpossible (AutogenNoOther CETBenchmark (benchmarkName bm)) - , -- check that all autogen-includes appear on includes - check - (not $ and $ map (flip elem (view L.includes bm)) (view L.autogenIncludes bm)) - $ PackageBuildImpossible AutogenIncludesNotIncludedExe - ] - where - mainIsWrongExt = case benchmarkInterface bm of - BenchmarkExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"] - _ -> False - --- ------------------------------------------------------------ - --- * Additional pure checks - --- ------------------------------------------------------------ - -checkFields :: PackageDescription -> [PackageCheck] -checkFields pkg = - catMaybes - [ check (not . FilePath.Windows.isValid . prettyShow . packageName $ pkg) $ - PackageDistInexcusable (InvalidNameWin pkg) - , check (isPrefixOf "z-" . prettyShow . packageName $ pkg) $ - PackageDistInexcusable ZPrefix - , check (isNothing (buildTypeRaw pkg) && specVersion pkg < CabalSpecV2_2) $ - PackageBuildWarning NoBuildType - , check (isJust (setupBuildInfo pkg) && buildType pkg /= Custom) $ - PackageBuildWarning NoCustomSetup - , check (not (null unknownCompilers)) $ - PackageBuildWarning (UnknownCompilers unknownCompilers) - , check (not (null unknownLanguages)) $ - PackageBuildWarning (UnknownLanguages unknownLanguages) - , check (not (null unknownExtensions)) $ - PackageBuildWarning (UnknownExtensions unknownExtensions) - , check (not (null languagesUsedAsExtensions)) $ - PackageBuildWarning (LanguagesAsExtension languagesUsedAsExtensions) - , check (not (null ourDeprecatedExtensions)) $ - PackageDistSuspicious (DeprecatedExtensions ourDeprecatedExtensions) - , check (ShortText.null (category pkg)) $ - PackageDistSuspicious (MissingField CEFCategory) - , check (ShortText.null (maintainer pkg)) $ - PackageDistSuspicious (MissingField CEFMaintainer) - , check (ShortText.null (synopsis pkg) && ShortText.null (description pkg)) $ - PackageDistInexcusable (MissingField CEFSynOrDesc) - , check (ShortText.null (description pkg) && not (ShortText.null (synopsis pkg))) $ - PackageDistSuspicious (MissingField CEFDescription) - , check (ShortText.null (synopsis pkg) && not (ShortText.null (description pkg))) $ - PackageDistSuspicious (MissingField CEFSynopsis) - , -- TODO: recommend the bug reports URL, author and homepage fields - -- TODO: recommend not using the stability field - -- TODO: recommend specifying a source repo - - check (ShortText.length (synopsis pkg) > 80) $ - PackageDistSuspicious SynopsisTooLong - , -- See also https://github.com/haskell/cabal/pull/3479 - check - ( not (ShortText.null (description pkg)) - && ShortText.length (description pkg) <= ShortText.length (synopsis pkg) + condExecutables_ + mapM_ + ( checkCondTarget + genPackageFlags_ + (checkTestSuite ads) + (\u l -> l{testName = u}) ) - $ PackageDistSuspicious ShortDesc - , -- check use of impossible constraints "tested-with: GHC== 6.10 && ==6.12" - check (not (null testedWithImpossibleRanges)) $ - PackageDistInexcusable (InvalidTestWith testedWithImpossibleRanges) - , -- for more details on why the following was commented out, - -- check https://github.com/haskell/cabal/pull/7470#issuecomment-875878507 - -- , check (not (null depInternalLibraryWithExtraVersion)) $ - -- PackageBuildWarning $ - -- "The package has an extraneous version range for a dependency on an " - -- ++ "internal library: " - -- ++ commaSep (map prettyShow depInternalLibraryWithExtraVersion) - -- ++ ". This version range includes the current package but isn't needed " - -- ++ "as the current package's library will always be used." - - check (not (null depInternalLibraryWithImpossibleVersion)) $ - PackageBuildImpossible - (ImpossibleInternalDep depInternalLibraryWithImpossibleVersion) - , -- , check (not (null depInternalExecutableWithExtraVersion)) $ - -- PackageBuildWarning $ - -- "The package has an extraneous version range for a dependency on an " - -- ++ "internal executable: " - -- ++ commaSep (map prettyShow depInternalExecutableWithExtraVersion) - -- ++ ". This version range includes the current package but isn't needed " - -- ++ "as the current package's executable will always be used." - - check (not (null depInternalExecutableWithImpossibleVersion)) $ - PackageBuildImpossible - (ImpossibleInternalExe depInternalExecutableWithImpossibleVersion) - , check (not (null depMissingInternalExecutable)) $ - PackageBuildImpossible (MissingInternalExe depMissingInternalExecutable) - ] - where - unknownCompilers = [name | (OtherCompiler name, _) <- testedWith pkg] - unknownLanguages = - [ name | bi <- allBuildInfo pkg, UnknownLanguage name <- allLanguages bi - ] - unknownExtensions = - [ name | bi <- allBuildInfo pkg, UnknownExtension name <- allExtensions bi, name `notElem` map prettyShow knownLanguages - ] - ourDeprecatedExtensions = - nub $ - catMaybes - [ find ((== ext) . fst) deprecatedExtensions - | bi <- allBuildInfo pkg - , ext <- allExtensions bi + condTestSuites_ + mapM_ + ( checkCondTarget + genPackageFlags_ + (checkBenchmark ads) + (\u l -> l{benchmarkName = u}) + ) + condBenchmarks_ + + -- For unused flags it is clearer and more convenient to fold the + -- data rather than walk it, an exception to the rule. + checkP + (decFlags /= usedFlags) + (PackageDistSuspicious $ DeclaredUsedFlags decFlags usedFlags) + + -- Duplicate modules. + mapM_ tellP (checkDuplicateModules gpd) + where + -- todo is this caught at parse time? + checkFlagName :: Monad m => PackageFlag -> CheckM m () + checkFlagName pf = + let fn = unFlagName . flagName $ pf + + invalidFlagName ('-' : _) = True -- starts with dash + invalidFlagName cs = any (not . isAscii) cs -- non ASCII + in checkP + (invalidFlagName fn) + (PackageDistInexcusable $ SuspiciousFlagName [fn]) + + decFlags :: Set.Set FlagName + decFlags = toSetOf (L.genPackageFlags . traverse . L.flagName) gpd + + usedFlags :: Set.Set FlagName + usedFlags = + mconcat + [ toSetOf (L.condLibrary . traverse . traverseCondTreeV . L._PackageFlag) gpd + , toSetOf (L.condSubLibraries . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd + , toSetOf (L.condForeignLibs . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd + , toSetOf (L.condExecutables . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd + , toSetOf (L.condTestSuites . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd + , toSetOf (L.condBenchmarks . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd ] - languagesUsedAsExtensions = - [ name | bi <- allBuildInfo pkg, UnknownExtension name <- allExtensions bi, name `elem` map prettyShow knownLanguages - ] - - testedWithImpossibleRanges = - [ Dependency (mkPackageName (prettyShow compiler)) vr mainLibSet - | (compiler, vr) <- testedWith pkg - , isNoVersion vr - ] - - internalExecutables = map exeName $ executables pkg - internalLibDeps = - [ dep - | bi <- allBuildInfo pkg - , dep@(Dependency name _ _) <- targetBuildDepends bi - , name == packageName pkg - ] - - internalExeDeps = - [ dep - | bi <- allBuildInfo pkg - , dep <- getAllToolDependencies pkg bi - , isInternal pkg dep - ] - - -- depInternalLibraryWithExtraVersion = - -- [ dep - -- | dep@(Dependency _ versionRange _) <- internalLibDeps - -- , not $ isAnyVersion versionRange - -- , packageVersion pkg `withinRange` versionRange - -- ] - - depInternalLibraryWithImpossibleVersion = - [ dep - | dep@(Dependency _ versionRange _) <- internalLibDeps - , not $ packageVersion pkg `withinRange` versionRange - ] - - -- depInternalExecutableWithExtraVersion = - -- [ dep - -- | dep@(ExeDependency _ _ versionRange) <- internalExeDeps - -- , not $ isAnyVersion versionRange - -- , packageVersion pkg `withinRange` versionRange - -- ] - - depInternalExecutableWithImpossibleVersion = - [ dep - | dep@(ExeDependency _ _ versionRange) <- internalExeDeps - , not $ packageVersion pkg `withinRange` versionRange - ] +checkPackageDescription :: Monad m => PackageDescription -> CheckM m () +checkPackageDescription + pkg@( PackageDescription + specVersion_ + package_ + licenseRaw_ + licenseFiles_ + _copyright_ + maintainer_ + _author_ + _stability_ + testedWith_ + _homepage_ + _pkgUrl_ + _bugReports_ + sourceRepos_ + synopsis_ + description_ + category_ + customFieldsPD_ + buildTypeRaw_ + setupBuildInfo_ + _library_ + _subLibraries_ + _executables_ + _foreignLibs_ + _testSuites_ + _benchmarks_ + dataFiles_ + dataDir_ + extraSrcFiles_ + extraTmpFiles_ + extraDocFiles_ + ) = do + -- § Sanity checks. + checkPackageId package_ + -- TODO `name` is caught at parse level, remove this test. + let pn = packageName package_ + checkP + (null . unPackageName $ pn) + (PackageBuildImpossible NoNameField) + -- TODO `version` is caught at parse level, remove this test. + checkP + (nullVersion == packageVersion package_) + (PackageBuildImpossible NoVersionField) + -- But it is OK for executables to have the same name. + nsubs <- asksCM (pnSubLibs . ccNames) + checkP + (any (== prettyShow pn) (prettyShow <$> nsubs)) + (PackageBuildImpossible $ IllegalLibraryName pn) + + -- § Fields check. + checkNull + category_ + (PackageDistSuspicious $ MissingField CEFCategory) + checkNull + maintainer_ + (PackageDistSuspicious $ MissingField CEFMaintainer) + checkP + (ShortText.null synopsis_ && not (ShortText.null description_)) + (PackageDistSuspicious $ MissingField CEFSynopsis) + checkP + (ShortText.null description_ && not (ShortText.null synopsis_)) + (PackageDistSuspicious $ MissingField CEFDescription) + checkP + (all ShortText.null [synopsis_, description_]) + (PackageDistInexcusable $ MissingField CEFSynOrDesc) + checkP + (ShortText.length synopsis_ > 80) + (PackageDistSuspicious SynopsisTooLong) + checkP + ( not (ShortText.null description_) + && ShortText.length description_ <= ShortText.length synopsis_ + ) + (PackageDistSuspicious ShortDesc) + + -- § Paths. + mapM_ (checkPath False "extra-source-files" PathKindGlob) extraSrcFiles_ + mapM_ (checkPath False "extra-tmp-files" PathKindFile) extraTmpFiles_ + mapM_ (checkPath False "extra-doc-files" PathKindGlob) extraDocFiles_ + mapM_ (checkPath False "data-files" PathKindGlob) dataFiles_ + checkPath True "data-dir" PathKindDirectory dataDir_ + let licPaths = map getSymbolicPath licenseFiles_ + mapM_ (checkPath False "license-file" PathKindFile) licPaths + mapM_ checkLicFileExist licenseFiles_ + + -- § Globs. + dataGlobs <- mapM (checkGlob "data-files") dataFiles_ + extraGlobs <- mapM (checkGlob "extra-source-files") extraSrcFiles_ + docGlobs <- mapM (checkGlob "extra-doc-files") extraDocFiles_ + -- We collect globs to feed them to checkMissingDocs. + + -- § Missing documentation. + checkMissingDocs + (catMaybes dataGlobs) + (catMaybes extraGlobs) + (catMaybes docGlobs) + + -- § Datafield checks. + checkSetupBuildInfo setupBuildInfo_ + mapM_ checkTestedWith testedWith_ + either + checkNewLicense + (checkOldLicense $ null licenseFiles_) + licenseRaw_ + checkSourceRepos sourceRepos_ + mapM_ checkCustomField customFieldsPD_ + + -- Feature checks. + checkSpecVer + CabalSpecV1_18 + (not . null $ extraDocFiles_) + (PackageDistInexcusable CVExtraDocFiles) + checkSpecVer + CabalSpecV1_6 + (not . null $ sourceRepos_) + (PackageDistInexcusable CVSourceRepository) + checkP + ( specVersion_ >= CabalSpecV1_24 + && isNothing setupBuildInfo_ + && buildTypeRaw_ == Just Custom + ) + (PackageBuildWarning CVCustomSetup) + checkSpecVer + CabalSpecV1_24 + ( isNothing setupBuildInfo_ + && buildTypeRaw_ == Just Custom + ) + (PackageDistSuspiciousWarn CVExpliticDepsCustomSetup) + checkP + (isNothing buildTypeRaw_ && specVersion_ < CabalSpecV2_2) + (PackageBuildWarning NoBuildType) + checkP + (isJust setupBuildInfo_ && buildType pkg /= Custom) + (PackageBuildWarning NoCustomSetup) + + -- Contents. + checkConfigureExists (buildType pkg) + checkSetupExists (buildType pkg) + checkCabalFile (packageName pkg) + mapM_ (checkGlobFile specVersion_ "." "extra-source-files") extraSrcFiles_ + mapM_ (checkGlobFile specVersion_ "." "extra-doc-files") extraDocFiles_ + mapM_ (checkGlobFile specVersion_ dataDir_ "data-files") dataFiles_ + where + checkNull + :: Monad m + => ShortText.ShortText + -> PackageCheck + -> CheckM m () + checkNull st c = checkP (ShortText.null st) c + + checkTestedWith + :: Monad m + => (CompilerFlavor, VersionRange) + -> CheckM m () + checkTestedWith (OtherCompiler n, _) = + tellP (PackageBuildWarning $ UnknownCompilers [n]) + checkTestedWith (compiler, versionRange) = + checkVersionRange compiler versionRange + + checkVersionRange + :: Monad m + => CompilerFlavor + -> VersionRange + -> CheckM m () + checkVersionRange cmp vr = + when + (isNoVersion vr) + ( let dep = + [ Dependency + (mkPackageName (prettyShow cmp)) + vr + mainLibSet + ] + in tellP (PackageDistInexcusable (InvalidTestWith dep)) + ) - depMissingInternalExecutable = - [ dep - | dep@(ExeDependency _ eName _) <- internalExeDeps - , not $ eName `elem` internalExecutables +checkSetupBuildInfo :: Monad m => Maybe SetupBuildInfo -> CheckM m () +checkSetupBuildInfo Nothing = return () +checkSetupBuildInfo (Just (SetupBuildInfo ds _)) = do + let uqs = map mkUnqualComponentName ["base", "Cabal"] + (is, rs) <- partitionDeps [] uqs ds + let ick = PackageDistInexcusable . UpperBoundSetup + rck = + PackageDistSuspiciousWarn + . MissingUpperBounds CETSetup + checkPVP ick is + checkPVPs rck rs + +checkPackageId :: Monad m => PackageIdentifier -> CheckM m () +checkPackageId (PackageIdentifier pkgName_ _pkgVersion_) = do + checkP + (not . FilePath.Windows.isValid . prettyShow $ pkgName_) + (PackageDistInexcusable $ InvalidNameWin pkgName_) + checkP (isPrefixOf "z-" . prettyShow $ pkgName_) $ + (PackageDistInexcusable ZPrefix) + +checkNewLicense :: Monad m => SPDX.License -> CheckM m () +checkNewLicense lic = do + checkP + (lic == SPDX.NONE) + (PackageDistInexcusable NONELicense) + +checkOldLicense + :: Monad m + => Bool -- Flag: no license file? + -> License + -> CheckM m () +checkOldLicense nullLicFiles lic = do + checkP + (lic == UnspecifiedLicense) + (PackageDistInexcusable NoLicense) + checkP + (lic == AllRightsReserved) + (PackageDistSuspicious AllRightsReservedLicense) + checkSpecVer + CabalSpecV1_4 + (lic `notElem` compatLicenses) + (PackageDistInexcusable (LicenseMessParse lic)) + checkP + (lic == BSD4) + (PackageDistSuspicious UncommonBSD4) + case lic of + UnknownLicense l -> + tellP (PackageBuildWarning (UnrecognisedLicense l)) + _ -> return () + checkP + ( lic + `notElem` [ AllRightsReserved + , UnspecifiedLicense + , PublicDomain + ] + && + -- AllRightsReserved and PublicDomain are not strictly + -- licenses so don't need license files. + nullLicFiles + ) + $ (PackageDistSuspicious NoLicenseFile) + case unknownLicenseVersion lic of + Just knownVersions -> + tellP + (PackageDistSuspicious $ UnknownLicenseVersion lic knownVersions) + _ -> return () + where + compatLicenses = + [ GPL Nothing + , LGPL Nothing + , AGPL Nothing + , BSD3 + , BSD4 + , PublicDomain + , AllRightsReserved + , UnspecifiedLicense + , OtherLicense ] -checkLicense :: PackageDescription -> [PackageCheck] -checkLicense pkg = case licenseRaw pkg of - Right l -> checkOldLicense pkg l - Left l -> checkNewLicense pkg l - -checkNewLicense :: PackageDescription -> SPDX.License -> [PackageCheck] -checkNewLicense _pkg lic = - catMaybes - [ check (lic == SPDX.NONE) $ - PackageDistInexcusable NONELicense - ] - -checkOldLicense :: PackageDescription -> License -> [PackageCheck] -checkOldLicense pkg lic = - catMaybes - [ check (lic == UnspecifiedLicense) $ - PackageDistInexcusable NoLicense - , check (lic == AllRightsReserved) $ - PackageDistSuspicious AllRightsReservedLicense - , checkVersion CabalSpecV1_4 (lic `notElem` compatLicenses) $ - PackageDistInexcusable (LicenseMessParse pkg) - , case lic of - UnknownLicense l -> Just $ PackageBuildWarning (UnrecognisedLicense l) - _ -> Nothing - , check (lic == BSD4) $ - PackageDistSuspicious UncommonBSD4 - , case unknownLicenseVersion lic of - Just knownVersions -> - Just $ - PackageDistSuspicious (UnknownLicenseVersion lic knownVersions) - _ -> Nothing - , check - ( lic - `notElem` [ AllRightsReserved - , UnspecifiedLicense - , PublicDomain - ] - -- AllRightsReserved and PublicDomain are not strictly - -- licenses so don't need license files. - && null (licenseFiles pkg) - ) - $ PackageDistSuspicious NoLicenseFile - ] - where unknownLicenseVersion (GPL (Just v)) | v `notElem` knownVersions = Just knownVersions where @@ -1462,1773 +636,432 @@ checkOldLicense pkg lic = knownVersions = [v' | Apache (Just v') <- knownLicenses] unknownLicenseVersion _ = Nothing - checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck - checkVersion ver cond pc - | specVersion pkg >= ver = Nothing - | otherwise = check cond pc - - compatLicenses = - [ GPL Nothing - , LGPL Nothing - , AGPL Nothing - , BSD3 - , BSD4 - , PublicDomain - , AllRightsReserved - , UnspecifiedLicense - , OtherLicense - ] - -checkSourceRepos :: PackageDescription -> [PackageCheck] -checkSourceRepos pkg = - catMaybes $ - concat - [ [ case repoKind repo of - RepoKindUnknown kind -> - Just $ - PackageDistInexcusable $ - UnrecognisedSourceRepo kind - _ -> Nothing - , check (isNothing (repoType repo)) $ - PackageDistInexcusable MissingType - , check (isNothing (repoLocation repo)) $ - PackageDistInexcusable MissingLocation - , check (repoType repo == Just (KnownRepoType CVS) && isNothing (repoModule repo)) $ - PackageDistInexcusable MissingModule - , check (repoKind repo == RepoThis && isNothing (repoTag repo)) $ - PackageDistInexcusable MissingTag - , check (maybe False isAbsoluteOnAnyPlatform (repoSubdir repo)) $ - PackageDistInexcusable SubdirRelPath - , do - subdir <- repoSubdir repo - err <- isGoodRelativeDirectoryPath subdir - return $ PackageDistInexcusable (SubdirGoodRelPath err) - ] - | repo <- sourceRepos pkg - ] - --- TODO: check location looks like a URL for some repo types. - --- | Checks GHC options from all ghc-*-options fields in the given --- PackageDescription and reports commonly misused or non-portable flags -checkAllGhcOptions :: PackageDescription -> [PackageCheck] -checkAllGhcOptions pkg = - checkGhcOptions "ghc-options" (hcOptions GHC) pkg - ++ checkGhcOptions "ghc-prof-options" (hcProfOptions GHC) pkg - ++ checkGhcOptions "ghc-shared-options" (hcSharedOptions GHC) pkg - --- | Extracts GHC options belonging to the given field from the given --- PackageDescription using given function and checks them for commonly misused --- or non-portable flags -checkGhcOptions :: String -> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck] -checkGhcOptions fieldName getOptions pkg = - catMaybes - [ checkFlags ["-fasm"] $ - PackageDistInexcusable (OptFasm fieldName) - , checkFlags ["-fvia-C"] $ - PackageDistSuspicious (OptViaC fieldName) - , checkFlags ["-fhpc"] $ - PackageDistInexcusable (OptHpc fieldName) - , checkFlags ["-prof"] $ - PackageBuildWarning (OptProf fieldName) - , unlessScript . checkFlags ["-o"] $ - PackageBuildWarning (OptO fieldName) - , checkFlags ["-hide-package"] $ - PackageBuildWarning (OptHide fieldName) - , checkFlags ["--make"] $ - PackageBuildWarning (OptMake fieldName) - , checkNonTestAndBenchmarkFlags ["-O0", "-Onot"] $ - PackageDistSuspicious (OptONot fieldName) - , checkTestAndBenchmarkFlags ["-O0", "-Onot"] $ - PackageDistSuspiciousWarn (OptONot fieldName) - , checkFlags ["-O", "-O1"] $ - PackageDistInexcusable (OptOOne fieldName) - , checkFlags ["-O2"] $ - PackageDistSuspiciousWarn (OptOTwo fieldName) - , checkFlags ["-split-sections"] $ - PackageBuildWarning (OptSplitSections fieldName) - , checkFlags ["-split-objs"] $ - PackageBuildWarning (OptSplitObjs fieldName) - , checkFlags ["-optl-Wl,-s", "-optl-s"] $ - PackageDistInexcusable (OptWls fieldName) - , checkFlags ["-fglasgow-exts"] $ - PackageDistSuspicious (OptExts fieldName) - , check ("-rtsopts" `elem` lib_ghc_options) $ - PackageBuildWarning (OptRts fieldName) - , check (any (\opt -> "-with-rtsopts" `isPrefixOf` opt) lib_ghc_options) $ - PackageBuildWarning (OptWithRts fieldName) - , checkAlternatives - fieldName - "extensions" - [ (flag, prettyShow extension) | flag <- ghc_options_no_rtsopts, Just extension <- [ghcExtension flag] - ] - , checkAlternatives - fieldName - "extensions" - [(flag, extension) | flag@('-' : 'X' : extension) <- ghc_options_no_rtsopts] - , checkAlternatives fieldName "cpp-options" $ - [(flag, flag) | flag@('-' : 'D' : _) <- ghc_options_no_rtsopts] - ++ [(flag, flag) | flag@('-' : 'U' : _) <- ghc_options_no_rtsopts] - , checkAlternatives - fieldName - "include-dirs" - [(flag, dir) | flag@('-' : 'I' : dir) <- ghc_options_no_rtsopts] - , checkAlternatives - fieldName - "extra-libraries" - [(flag, lib) | flag@('-' : 'l' : lib) <- ghc_options_no_rtsopts] - , checkAlternatives - fieldName - "extra-libraries-static" - [(flag, lib) | flag@('-' : 'l' : lib) <- ghc_options_no_rtsopts] - , checkAlternatives - fieldName - "extra-lib-dirs" - [(flag, dir) | flag@('-' : 'L' : dir) <- ghc_options_no_rtsopts] - , checkAlternatives - fieldName - "extra-lib-dirs-static" - [(flag, dir) | flag@('-' : 'L' : dir) <- ghc_options_no_rtsopts] - , checkAlternatives - fieldName - "frameworks" - [ (flag, fmwk) - | (flag@"-framework", fmwk) <- - zip ghc_options_no_rtsopts (safeTail ghc_options_no_rtsopts) - ] - , checkAlternatives - fieldName - "extra-framework-dirs" - [ (flag, dir) - | (flag@"-framework-path", dir) <- - zip ghc_options_no_rtsopts (safeTail ghc_options_no_rtsopts) - ] - ] - where - all_ghc_options = concatMap getOptions (allBuildInfo pkg) - ghc_options_no_rtsopts = rmRtsOpts all_ghc_options - lib_ghc_options = - concatMap - (getOptions . libBuildInfo) - (allLibraries pkg) - test_ghc_options = - concatMap - (getOptions . testBuildInfo) - (testSuites pkg) - benchmark_ghc_options = - concatMap - (getOptions . benchmarkBuildInfo) - (benchmarks pkg) - test_and_benchmark_ghc_options = - test_ghc_options - ++ benchmark_ghc_options - non_test_and_benchmark_ghc_options = - concatMap - getOptions - ( allBuildInfo - ( pkg - { testSuites = [] - , benchmarks = [] - } - ) - ) - - checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck - checkFlags flags = check (any (`elem` flags) all_ghc_options) - - unlessScript :: Maybe PackageCheck -> Maybe PackageCheck - unlessScript pc - | packageId pkg == fakePackageId = Nothing - | otherwise = pc - - checkTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck - checkTestAndBenchmarkFlags flags = check (any (`elem` flags) test_and_benchmark_ghc_options) - - checkNonTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck - checkNonTestAndBenchmarkFlags flags = check (any (`elem` flags) non_test_and_benchmark_ghc_options) - - ghcExtension ('-' : 'f' : name) = case name of - "allow-overlapping-instances" -> enable OverlappingInstances - "no-allow-overlapping-instances" -> disable OverlappingInstances - "th" -> enable TemplateHaskell - "no-th" -> disable TemplateHaskell - "ffi" -> enable ForeignFunctionInterface - "no-ffi" -> disable ForeignFunctionInterface - "fi" -> enable ForeignFunctionInterface - "no-fi" -> disable ForeignFunctionInterface - "monomorphism-restriction" -> enable MonomorphismRestriction - "no-monomorphism-restriction" -> disable MonomorphismRestriction - "mono-pat-binds" -> enable MonoPatBinds - "no-mono-pat-binds" -> disable MonoPatBinds - "allow-undecidable-instances" -> enable UndecidableInstances - "no-allow-undecidable-instances" -> disable UndecidableInstances - "allow-incoherent-instances" -> enable IncoherentInstances - "no-allow-incoherent-instances" -> disable IncoherentInstances - "arrows" -> enable Arrows - "no-arrows" -> disable Arrows - "generics" -> enable Generics - "no-generics" -> disable Generics - "implicit-prelude" -> enable ImplicitPrelude - "no-implicit-prelude" -> disable ImplicitPrelude - "implicit-params" -> enable ImplicitParams - "no-implicit-params" -> disable ImplicitParams - "bang-patterns" -> enable BangPatterns - "no-bang-patterns" -> disable BangPatterns - "scoped-type-variables" -> enable ScopedTypeVariables - "no-scoped-type-variables" -> disable ScopedTypeVariables - "extended-default-rules" -> enable ExtendedDefaultRules - "no-extended-default-rules" -> disable ExtendedDefaultRules - _ -> Nothing - ghcExtension "-cpp" = enable CPP - ghcExtension _ = Nothing - - enable e = Just (EnableExtension e) - disable e = Just (DisableExtension e) - - rmRtsOpts :: [String] -> [String] - rmRtsOpts ("-with-rtsopts" : _ : xs) = rmRtsOpts xs - rmRtsOpts (x : xs) = x : rmRtsOpts xs - rmRtsOpts [] = [] - -checkCCOptions :: PackageDescription -> [PackageCheck] -checkCCOptions = checkCLikeOptions "C" "cc-options" ccOptions - -checkCxxOptions :: PackageDescription -> [PackageCheck] -checkCxxOptions = checkCLikeOptions "C++" "cxx-options" cxxOptions - -checkCLikeOptions :: String -> String -> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck] -checkCLikeOptions label prefix accessor pkg = - catMaybes - [ checkAlternatives - prefix - "include-dirs" - [(flag, dir) | flag@('-' : 'I' : dir) <- all_cLikeOptions] - , checkAlternatives - prefix - "extra-libraries" - [(flag, lib) | flag@('-' : 'l' : lib) <- all_cLikeOptions] - , checkAlternatives - prefix - "extra-lib-dirs" - [(flag, dir) | flag@('-' : 'L' : dir) <- all_cLikeOptions] - , checkAlternatives - "ld-options" - "extra-libraries" - [(flag, lib) | flag@('-' : 'l' : lib) <- all_ldOptions] - , checkAlternatives - "ld-options" - "extra-lib-dirs" - [(flag, dir) | flag@('-' : 'L' : dir) <- all_ldOptions] - , checkCCFlags ["-O", "-Os", "-O0", "-O1", "-O2", "-O3"] $ - PackageDistSuspicious (COptONumber prefix label) - ] - where - all_cLikeOptions = - [ opts | bi <- allBuildInfo pkg, opts <- accessor bi - ] - all_ldOptions = - [ opts | bi <- allBuildInfo pkg, opts <- ldOptions bi - ] - - checkCCFlags :: [String] -> PackageCheck -> Maybe PackageCheck - checkCCFlags flags = check (any (`elem` flags) all_cLikeOptions) - -checkCPPOptions :: PackageDescription -> [PackageCheck] -checkCPPOptions pkg = - catMaybes - [ checkAlternatives - "cpp-options" - "include-dirs" - [(flag, dir) | flag@('-' : 'I' : dir) <- all_cppOptions] - ] - ++ [ PackageBuildWarning (COptCPP opt) - | opt <- all_cppOptions - , -- "-I" is handled above, we allow only -DNEWSTUFF and -UOLDSTUFF - not $ any (`isPrefixOf` opt) ["-D", "-U", "-I"] - ] - where - all_cppOptions = [opts | bi <- allBuildInfo pkg, opts <- cppOptions bi] - -checkAlternatives - :: String - -> String - -> [(String, String)] - -> Maybe PackageCheck -checkAlternatives badField goodField flags = - check (not (null badFlags)) $ - PackageBuildWarning (OptAlternatives badField goodField flags) +checkSourceRepos :: Monad m => [SourceRepo] -> CheckM m () +checkSourceRepos rs = do + mapM_ repoCheck rs + checkMissingVcsInfo rs where - (badFlags, _) = unzip flags - -data PathKind - = PathKindFile - | PathKindDirectory - | PathKindGlob - deriving (Eq) - -checkPaths :: PackageDescription -> [PackageCheck] -checkPaths pkg = - checkPackageFileNamesWithGlob - [ (kind == PathKindGlob, path) - | (path, _, kind) <- relPaths ++ absPaths - ] - ++ [ PackageBuildWarning (RelativeOutside field path) - | (path, field, _) <- relPaths ++ absPaths - , isOutsideTree path - ] - ++ [ PackageDistInexcusable (AbsolutePath field path) - | (path, field, _) <- relPaths - , isAbsoluteOnAnyPlatform path - ] - ++ [ PackageDistInexcusable (BadRelativePAth field path err) - | (path, field, kind) <- relPaths - , -- these are not paths, but globs... - err <- maybeToList $ case kind of - PathKindFile -> isGoodRelativeFilePath path - PathKindGlob -> isGoodRelativeGlob path - PathKindDirectory -> isGoodRelativeDirectoryPath path - ] - ++ [ PackageDistInexcusable $ DistPoint (Just field) path - | (path, field, _) <- relPaths ++ absPaths - , isInsideDist path - ] - ++ [ PackageDistInexcusable (DistPoint Nothing path) - | bi <- allBuildInfo pkg - , (GHC, flags) <- perCompilerFlavorToList $ options bi - , path <- flags - , isInsideDist path - ] - ++ [ PackageDistInexcusable $ - GlobSyntaxError "data-files" (explainGlobSyntaxError pat err) - | (Left err, pat) <- zip globsDataFiles $ dataFiles pkg - ] - ++ [ PackageDistInexcusable - (GlobSyntaxError "extra-source-files" (explainGlobSyntaxError pat err)) - | (Left err, pat) <- zip globsExtraSrcFiles $ extraSrcFiles pkg - ] - ++ [ PackageDistInexcusable $ - GlobSyntaxError "extra-doc-files" (explainGlobSyntaxError pat err) - | (Left err, pat) <- zip globsExtraDocFiles $ extraDocFiles pkg - ] - ++ [ PackageDistSuspiciousWarn $ - RecursiveGlobInRoot "data-files" pat - | (Right glob, pat) <- zip globsDataFiles $ dataFiles pkg - , isRecursiveInRoot glob - ] - ++ [ PackageDistSuspiciousWarn $ - RecursiveGlobInRoot "extra-source-files" pat - | (Right glob, pat) <- zip globsExtraSrcFiles $ extraSrcFiles pkg - , isRecursiveInRoot glob - ] - ++ [ PackageDistSuspiciousWarn $ - RecursiveGlobInRoot "extra-doc-files" pat - | (Right glob, pat) <- zip globsExtraDocFiles $ extraDocFiles pkg - , isRecursiveInRoot glob - ] - where - isOutsideTree path = case splitDirectories path of - ".." : _ -> True - "." : ".." : _ -> True - _ -> False - isInsideDist path = case map lowercase (splitDirectories path) of - "dist" : _ -> True - "." : "dist" : _ -> True - _ -> False - - -- paths that must be relative - relPaths :: [(FilePath, String, PathKind)] - relPaths = - [(path, "extra-source-files", PathKindGlob) | path <- extraSrcFiles pkg] - ++ [(path, "extra-tmp-files", PathKindFile) | path <- extraTmpFiles pkg] - ++ [(path, "extra-doc-files", PathKindGlob) | path <- extraDocFiles pkg] - ++ [(path, "data-files", PathKindGlob) | path <- dataFiles pkg] - ++ [(path, "data-dir", PathKindDirectory) | path <- [dataDir pkg]] - ++ [(path, "license-file", PathKindFile) | path <- map getSymbolicPath $ licenseFiles pkg] - ++ concat - [ [(path, "asm-sources", PathKindFile) | path <- asmSources bi] - ++ [(path, "cmm-sources", PathKindFile) | path <- cmmSources bi] - ++ [(path, "c-sources", PathKindFile) | path <- cSources bi] - ++ [(path, "cxx-sources", PathKindFile) | path <- cxxSources bi] - ++ [(path, "js-sources", PathKindFile) | path <- jsSources bi] - ++ [(path, "install-includes", PathKindFile) | path <- installIncludes bi] - ++ [(path, "hs-source-dirs", PathKindDirectory) | path <- map getSymbolicPath $ hsSourceDirs bi] - | bi <- allBuildInfo pkg - ] - - -- paths that are allowed to be absolute - absPaths :: [(FilePath, String, PathKind)] - absPaths = - concat - [ [(path, "includes", PathKindFile) | path <- includes bi] - ++ [(path, "include-dirs", PathKindDirectory) | path <- includeDirs bi] - ++ [(path, "extra-lib-dirs", PathKindDirectory) | path <- extraLibDirs bi] - ++ [(path, "extra-lib-dirs-static", PathKindDirectory) | path <- extraLibDirsStatic bi] - | bi <- allBuildInfo pkg - ] - globsDataFiles :: [Either GlobSyntaxError Glob] - globsDataFiles = parseFileGlob (specVersion pkg) <$> dataFiles pkg - globsExtraSrcFiles :: [Either GlobSyntaxError Glob] - globsExtraSrcFiles = parseFileGlob (specVersion pkg) <$> extraSrcFiles pkg - globsExtraDocFiles :: [Either GlobSyntaxError Glob] - globsExtraDocFiles = parseFileGlob (specVersion pkg) <$> extraDocFiles pkg - --- TODO: check sets of paths that would be interpreted differently between Unix --- and windows, ie case-sensitive or insensitive. Things that might clash, or --- conversely be distinguished. - --- TODO: use the tar path checks on all the above paths - --- | Check that the package declares the version in the @\"cabal-version\"@ --- field correctly. -checkCabalVersion :: PackageDescription -> [PackageCheck] -checkCabalVersion pkg = - catMaybes - [ -- check use of test suite sections - checkVersion CabalSpecV1_8 (not (null $ testSuites pkg)) $ - PackageDistInexcusable CVTestSuite - , -- check use of default-language field - -- note that we do not need to do an equivalent check for the - -- other-language field since that one does not change behaviour - checkVersion CabalSpecV1_10 (any isJust (buildInfoField defaultLanguage)) $ - PackageBuildWarning CVDefaultLanguage - , check - ( specVersion pkg >= CabalSpecV1_10 - && specVersion pkg < CabalSpecV3_4 - && any isNothing (buildInfoField defaultLanguage) - ) - $ PackageBuildWarning CVDefaultLanguageComponent - , checkVersion - CabalSpecV1_18 - (not . null $ extraDocFiles pkg) - $ PackageDistInexcusable CVExtraDocFiles - , checkVersion - CabalSpecV2_0 - (not (null (subLibraries pkg))) - $ PackageDistInexcusable CVMultiLib - , -- check use of reexported-modules sections - checkVersion - CabalSpecV1_22 - (any (not . null . reexportedModules) (allLibraries pkg)) - $ PackageDistInexcusable CVReexported - , -- check use of thinning and renaming - checkVersion CabalSpecV2_0 usesBackpackIncludes $ - PackageDistInexcusable CVMixins - , -- check use of 'extra-framework-dirs' field - checkVersion CabalSpecV1_24 (any (not . null) (buildInfoField extraFrameworkDirs)) $ - -- Just a warning, because this won't break on old Cabal versions. - PackageDistSuspiciousWarn CVExtraFrameworkDirs - , -- check use of default-extensions field - -- don't need to do the equivalent check for other-extensions - checkVersion CabalSpecV1_10 (any (not . null) (buildInfoField defaultExtensions)) $ - PackageBuildWarning CVDefaultExtensions - , -- check use of extensions field - check - ( specVersion pkg >= CabalSpecV1_10 - && any (not . null) (buildInfoField oldExtensions) - ) - $ PackageBuildWarning CVExtensionsDeprecated - , checkVersion - CabalSpecV3_0 - ( any - (not . null) - ( concatMap - buildInfoField - [ asmSources - , cmmSources - , extraBundledLibs - , extraLibFlavours - ] - ) - ) - $ PackageDistInexcusable CVSources - , checkVersion CabalSpecV3_0 (any (not . null) $ buildInfoField extraDynLibFlavours) $ - PackageDistInexcusable - (CVExtraDynamic $ buildInfoField extraDynLibFlavours) - , checkVersion - CabalSpecV2_2 - ( any - (not . null) - (buildInfoField virtualModules) - ) - $ PackageDistInexcusable CVVirtualModules - , -- check use of "source-repository" section - checkVersion CabalSpecV1_6 (not (null (sourceRepos pkg))) $ - PackageDistInexcusable CVSourceRepository - , -- check for new language extensions - checkVersion CabalSpecV1_2 (not (null mentionedExtensionsThatNeedCabal12)) $ - PackageDistInexcusable - (CVExtensions CabalSpecV1_2 mentionedExtensionsThatNeedCabal12) - , checkVersion CabalSpecV1_4 (not (null mentionedExtensionsThatNeedCabal14)) $ - PackageDistInexcusable - (CVExtensions CabalSpecV1_4 mentionedExtensionsThatNeedCabal14) - , check - ( specVersion pkg >= CabalSpecV1_24 - && isNothing (setupBuildInfo pkg) - && buildType pkg == Custom - ) - $ PackageBuildWarning CVCustomSetup - , check - ( specVersion pkg < CabalSpecV1_24 - && isNothing (setupBuildInfo pkg) - && buildType pkg == Custom - ) - $ PackageDistSuspiciousWarn CVExpliticDepsCustomSetup - , check - ( specVersion pkg >= CabalSpecV2_0 - && elem (autogenPathsModuleName pkg) allModuleNames - && not (elem (autogenPathsModuleName pkg) allModuleNamesAutogen) - ) - $ PackageDistInexcusable CVAutogenPaths - , check - ( specVersion pkg >= CabalSpecV2_0 - && elem (autogenPackageInfoModuleName pkg) allModuleNames - && not (elem (autogenPackageInfoModuleName pkg) allModuleNamesAutogen) + -- Single repository checks. + repoCheck :: Monad m => SourceRepo -> CheckM m () + repoCheck + ( SourceRepo + repoKind_ + repoType_ + repoLocation_ + repoModule_ + _repoBranch_ + repoTag_ + repoSubdir_ + ) = do + case repoKind_ of + RepoKindUnknown kind -> + tellP + (PackageDistInexcusable $ UnrecognisedSourceRepo kind) + _ -> return () + checkP + (isNothing repoType_) + (PackageDistInexcusable MissingType) + checkP + (isNothing repoLocation_) + (PackageDistInexcusable MissingLocation) + checkP + ( repoType_ == Just (KnownRepoType CVS) + && isNothing repoModule_ + ) + (PackageDistInexcusable MissingModule) + checkP + (repoKind_ == RepoThis && isNothing repoTag_) + (PackageDistInexcusable MissingTag) + checkP + (any isAbsoluteOnAnyPlatform repoSubdir_) + (PackageDistInexcusable SubdirRelPath) + case join . fmap isGoodRelativeDirectoryPath $ repoSubdir_ of + Just err -> + tellP + (PackageDistInexcusable $ SubdirGoodRelPath err) + Nothing -> return () + +checkMissingVcsInfo :: Monad m => [SourceRepo] -> CheckM m () +checkMissingVcsInfo rs = + let rdirs = concatMap repoTypeDirname knownRepoTypes + in checkPkg + ( \ops -> do + us <- or <$> traverse (doesDirectoryExist ops) rdirs + return (null rs && us) ) - $ PackageDistInexcusable CVAutogenPackageInfo - ] + (PackageDistSuspicious MissingSourceControl) where - -- Perform a check on packages that use a version of the spec less than - -- the version given. This is for cases where a new Cabal version adds - -- a new feature and we want to check that it is not used prior to that - -- version. - checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck - checkVersion ver cond pc - | specVersion pkg >= ver = Nothing - | otherwise = check cond pc - - buildInfoField field = map field (allBuildInfo pkg) - - usesBackpackIncludes = any (not . null . mixins) (allBuildInfo pkg) - - mentionedExtensions = - [ ext | bi <- allBuildInfo pkg, ext <- allExtensions bi - ] - mentionedExtensionsThatNeedCabal12 = - nub (filter (`elem` compatExtensionsExtra) mentionedExtensions) - - -- As of Cabal-1.4 we can add new extensions without worrying about - -- breaking old versions of cabal. - mentionedExtensionsThatNeedCabal14 = - nub (filter (`notElem` compatExtensions) mentionedExtensions) - - -- The known extensions in Cabal-1.2.3 - compatExtensions = - map - EnableExtension - [ OverlappingInstances - , UndecidableInstances - , IncoherentInstances - , RecursiveDo - , ParallelListComp - , MultiParamTypeClasses - , FunctionalDependencies - , Rank2Types - , RankNTypes - , PolymorphicComponents - , ExistentialQuantification - , ScopedTypeVariables - , ImplicitParams - , FlexibleContexts - , FlexibleInstances - , EmptyDataDecls - , CPP - , BangPatterns - , TypeSynonymInstances - , TemplateHaskell - , ForeignFunctionInterface - , Arrows - , Generics - , NamedFieldPuns - , PatternGuards - , GeneralizedNewtypeDeriving - , ExtensibleRecords - , RestrictedTypeSynonyms - , HereDocuments - ] - ++ map - DisableExtension - [MonomorphismRestriction, ImplicitPrelude] - ++ compatExtensionsExtra - - -- The extra known extensions in Cabal-1.2.3 vs Cabal-1.1.6 - -- (Cabal-1.1.6 came with ghc-6.6. Cabal-1.2 came with ghc-6.8) - compatExtensionsExtra = - map - EnableExtension - [ KindSignatures - , MagicHash - , TypeFamilies - , StandaloneDeriving - , UnicodeSyntax - , PatternSignatures - , UnliftedFFITypes - , LiberalTypeSynonyms - , TypeOperators - , RecordWildCards - , RecordPuns - , DisambiguateRecordFields - , OverloadedStrings - , GADTs - , RelaxedPolyRec - , ExtendedDefaultRules - , UnboxedTuples - , DeriveDataTypeable - , ConstrainedClassMethods - ] - ++ map - DisableExtension - [MonoPatBinds] - - allModuleNames = - ( case library pkg of - Nothing -> [] - (Just lib) -> explicitLibModules lib - ) - ++ concatMap otherModules (allBuildInfo pkg) - - allModuleNamesAutogen = concatMap autogenModules (allBuildInfo pkg) + repoTypeDirname :: KnownRepoType -> [FilePath] + repoTypeDirname Darcs = ["_darcs"] + repoTypeDirname Git = [".git"] + repoTypeDirname SVN = [".svn"] + repoTypeDirname CVS = ["CVS"] + repoTypeDirname Mercurial = [".hg"] + repoTypeDirname GnuArch = [".arch-params"] + repoTypeDirname Bazaar = [".bzr"] + repoTypeDirname Monotone = ["_MTN"] + repoTypeDirname Pijul = [".pijul"] -- ------------------------------------------------------------ - --- * Checks on the GenericPackageDescription - +-- Package and distribution checks -- ------------------------------------------------------------ --- | Check the build-depends fields for any weirdness or bad practice. -checkPackageVersions :: GenericPackageDescription -> [PackageCheck] -checkPackageVersions pkg = - -- if others is empty, - -- the error will still fire but listing no dependencies. - -- so we have to check - if length others > 0 - then PackageDistSuspiciousWarn (MissingUpperBounds others) : baseErrors - else baseErrors - where - baseErrors = PackageDistInexcusable BaseNoUpperBounds <$ bases - deps = toDependencyVersionsMap allNonInternalBuildDepends pkg - -- base gets special treatment (it's more critical) - (bases, others) = - partition (("base" ==) . unPackageName) $ - [ name - | (name, vr) <- Map.toList deps - , not (hasUpperBound vr) - ] - - -- Get the combined build-depends entries of all components. - allNonInternalBuildDepends :: PackageDescription -> [Dependency] - allNonInternalBuildDepends = targetBuildDepends CM.<=< allNonInternalBuildInfo - - allNonInternalBuildInfo :: PackageDescription -> [BuildInfo] - allNonInternalBuildInfo pkg_descr = - [bi | lib <- allLibraries pkg_descr, let bi = libBuildInfo lib] - ++ [bi | flib <- foreignLibs pkg_descr, let bi = foreignLibBuildInfo flib] - ++ [bi | exe <- executables pkg_descr, let bi = buildInfo exe] - -checkConditionals :: GenericPackageDescription -> [PackageCheck] -checkConditionals pkg = - catMaybes - [ check (not $ null unknownOSs) $ - PackageDistInexcusable (UnknownOS unknownOSs) - , check (not $ null unknownArches) $ - PackageDistInexcusable (UnknownArch unknownArches) - , check (not $ null unknownImpls) $ - PackageDistInexcusable (UnknownCompiler unknownImpls) - ] - where - unknownOSs = [os | OS (OtherOS os) <- conditions] - unknownArches = [arch | Arch (OtherArch arch) <- conditions] - unknownImpls = [impl | Impl (OtherCompiler impl) _ <- conditions] - conditions = - concatMap fvs (maybeToList (condLibrary pkg)) - ++ concatMap (fvs . snd) (condSubLibraries pkg) - ++ concatMap (fvs . snd) (condForeignLibs pkg) - ++ concatMap (fvs . snd) (condExecutables pkg) - ++ concatMap (fvs . snd) (condTestSuites pkg) - ++ concatMap (fvs . snd) (condBenchmarks pkg) - fvs (CondNode _ _ ifs) = concatMap compfv ifs -- free variables - compfv (CondBranch c ct mct) = condfv c ++ fvs ct ++ maybe [] fvs mct - condfv c = case c of - Var v -> [v] - Lit _ -> [] - CNot c1 -> condfv c1 - COr c1 c2 -> condfv c1 ++ condfv c2 - CAnd c1 c2 -> condfv c1 ++ condfv c2 - -checkFlagNames :: GenericPackageDescription -> [PackageCheck] -checkFlagNames gpd - | null invalidFlagNames = [] - | otherwise = - [PackageDistInexcusable (SuspiciousFlagName invalidFlagNames)] - where - invalidFlagNames = - [ fn - | flag <- genPackageFlags gpd - , let fn = unFlagName (flagName flag) - , invalidFlagName fn +-- | Find a package description file in the given directory. Looks for +-- @.cabal@ files. Like 'Distribution.Simple.Utils.findPackageDesc', +-- but generalized over monads. +findPackageDesc :: Monad m => CheckPackageContentOps m -> m [FilePath] +findPackageDesc ops = do + let dir = "." + files <- getDirectoryContents ops dir + -- to make sure we do not mistake a ~/.cabal/ dir for a .cabal + -- file we filter to exclude dirs and null base file names: + cabalFiles <- + filterM + (doesFileExist ops) + [ dir file + | file <- files + , let (name, ext) = splitExtension file + , not (null name) && ext == ".cabal" ] - -- starts with dash - invalidFlagName ('-' : _) = True - -- mon ascii letter - invalidFlagName cs = any (not . isAscii) cs - -checkUnusedFlags :: GenericPackageDescription -> [PackageCheck] -checkUnusedFlags gpd - | declared == used = [] - | otherwise = - [PackageDistSuspicious (DeclaredUsedFlags declared used)] - where - declared :: Set.Set FlagName - declared = toSetOf (L.genPackageFlags . traverse . L.flagName) gpd - - used :: Set.Set FlagName - used = - mconcat - [ toSetOf (L.condLibrary . traverse . traverseCondTreeV . L._PackageFlag) gpd - , toSetOf (L.condSubLibraries . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd - , toSetOf (L.condForeignLibs . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd - , toSetOf (L.condExecutables . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd - , toSetOf (L.condTestSuites . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd - , toSetOf (L.condBenchmarks . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd - ] - -checkUnicodeXFields :: GenericPackageDescription -> [PackageCheck] -checkUnicodeXFields gpd - | null nonAsciiXFields = [] - | otherwise = - [PackageDistInexcusable (NonASCIICustomField nonAsciiXFields)] - where - nonAsciiXFields :: [String] - nonAsciiXFields = [n | (n, _) <- xfields, any (not . isAscii) n] - - xfields :: [(String, String)] - xfields = - DList.runDList $ - mconcat - [ toDListOf (L.packageDescription . L.customFieldsPD . traverse) gpd - , toDListOf (L.traverseBuildInfos . L.customFieldsBI . traverse) gpd - ] - --- | cabal-version <2.2 + Paths_module + default-extensions: doesn't build. -checkPathsModuleExtensions :: PackageDescription -> [PackageCheck] -checkPathsModuleExtensions = checkAutogenModuleExtensions autogenPathsModuleName RebindableClashPaths - --- | cabal-version <2.2 + PackageInfo_module + default-extensions: doesn't build. -checkPackageInfoModuleExtensions :: PackageDescription -> [PackageCheck] -checkPackageInfoModuleExtensions = checkAutogenModuleExtensions autogenPackageInfoModuleName RebindableClashPackageInfo - --- | cabal-version <2.2 + *_module + default-extensions: doesn't build. -checkAutogenModuleExtensions - :: (PackageDescription -> ModuleName) - -> CheckExplanation - -> PackageDescription - -> [PackageCheck] -checkAutogenModuleExtensions autogenModuleName rebindableClashExplanation pd - | specVersion pd >= CabalSpecV2_2 = [] - | any checkBI (allBuildInfo pd) || any checkLib (allLibraries pd) = - return (PackageBuildImpossible rebindableClashExplanation) - | otherwise = [] - where - mn = autogenModuleName pd - - checkLib :: Library -> Bool - checkLib l = mn `elem` exposedModules l && checkExts (l ^. L.defaultExtensions) - - checkBI :: BuildInfo -> Bool - checkBI bi = - (mn `elem` otherModules bi || mn `elem` autogenModules bi) - && checkExts (bi ^. L.defaultExtensions) - - checkExts exts = rebind `elem` exts && (strings `elem` exts || lists `elem` exts) - where - rebind = EnableExtension RebindableSyntax - strings = EnableExtension OverloadedStrings - lists = EnableExtension OverloadedLists - --- | Checks GHC options from all ghc-*-options fields from the given BuildInfo --- and reports flags that are OK during development process, but are --- unacceptable in a distributed package -checkDevelopmentOnlyFlagsBuildInfo :: BuildInfo -> [PackageCheck] -checkDevelopmentOnlyFlagsBuildInfo bi = - checkDevelopmentOnlyFlagsOptions "ghc-options" (hcOptions GHC bi) - ++ checkDevelopmentOnlyFlagsOptions "ghc-prof-options" (hcProfOptions GHC bi) - ++ checkDevelopmentOnlyFlagsOptions "ghc-shared-options" (hcSharedOptions GHC bi) - --- | Checks the given list of flags belonging to the given field and reports --- flags that are OK during development process, but are unacceptable in a --- distributed package -checkDevelopmentOnlyFlagsOptions :: String -> [String] -> [PackageCheck] -checkDevelopmentOnlyFlagsOptions fieldName ghcOptions = - catMaybes - [ check has_Werror $ - PackageDistInexcusable (WErrorUnneeded fieldName) - , check has_J $ - PackageDistInexcusable (JUnneeded fieldName) - , checkFlags ["-fdefer-type-errors"] $ - PackageDistInexcusable (FDeferTypeErrorsUnneeded fieldName) - , -- -dynamic is not a debug flag - check - ( any - (\opt -> "-d" `isPrefixOf` opt && opt /= "-dynamic") - ghcOptions - ) - $ PackageDistInexcusable (DynamicUnneeded fieldName) - , checkFlags - [ "-fprof-auto" - , "-fprof-auto-top" - , "-fprof-auto-calls" - , "-fprof-cafs" - , "-fno-prof-count-entries" - , "-auto-all" - , "-auto" - , "-caf-all" - ] - $ PackageDistSuspicious (ProfilingUnneeded fieldName) - ] - where - has_Werror = "-Werror" `elem` ghcOptions - has_J = - any - ( \o -> case o of - "-j" -> True - ('-' : 'j' : d : _) -> isDigit d - _ -> False - ) - ghcOptions - checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck - checkFlags flags = check (any (`elem` flags) ghcOptions) - -checkDevelopmentOnlyFlags :: GenericPackageDescription -> [PackageCheck] -checkDevelopmentOnlyFlags pkg = - concatMap - checkDevelopmentOnlyFlagsBuildInfo - [ bi - | (conditions, bi) <- allConditionalBuildInfo - , not (any guardedByManualFlag conditions) - ] - where - guardedByManualFlag = definitelyFalse - - -- We've basically got three-values logic here: True, False or unknown - -- hence this pattern to propagate the unknown cases properly. - definitelyFalse (Var (PackageFlag n)) = maybe False not (Map.lookup n manualFlags) - definitelyFalse (Var _) = False - definitelyFalse (Lit b) = not b - definitelyFalse (CNot c) = definitelyTrue c - definitelyFalse (COr c1 c2) = definitelyFalse c1 && definitelyFalse c2 - definitelyFalse (CAnd c1 c2) = definitelyFalse c1 || definitelyFalse c2 - - definitelyTrue (Var (PackageFlag n)) = fromMaybe False (Map.lookup n manualFlags) - definitelyTrue (Var _) = False - definitelyTrue (Lit b) = b - definitelyTrue (CNot c) = definitelyFalse c - definitelyTrue (COr c1 c2) = definitelyTrue c1 || definitelyTrue c2 - definitelyTrue (CAnd c1 c2) = definitelyTrue c1 && definitelyTrue c2 - - manualFlags = - Map.fromList - [ (flagName flag, flagDefault flag) - | flag <- genPackageFlags pkg - , flagManual flag - ] - - allConditionalBuildInfo :: [([Condition ConfVar], BuildInfo)] - allConditionalBuildInfo = - concatMap - (collectCondTreePaths libBuildInfo) - (maybeToList (condLibrary pkg)) - ++ concatMap - (collectCondTreePaths libBuildInfo . snd) - (condSubLibraries pkg) - ++ concatMap - (collectCondTreePaths buildInfo . snd) - (condExecutables pkg) - ++ concatMap - (collectCondTreePaths testBuildInfo . snd) - (condTestSuites pkg) - ++ concatMap - (collectCondTreePaths benchmarkBuildInfo . snd) - (condBenchmarks pkg) - - -- get all the leaf BuildInfo, paired up with the path (in the tree sense) - -- of if-conditions that guard it - collectCondTreePaths - :: (a -> b) - -> CondTree v c a - -> [([Condition v], b)] - collectCondTreePaths mapData = go [] - where - go conditions condNode = - -- the data at this level in the tree: - (reverse conditions, mapData (condTreeData condNode)) - : concat - [ go (condition : conditions) ifThen - | (CondBranch condition ifThen _) <- condTreeComponents condNode - ] - ++ concat - [ go (condition : conditions) elseThen - | (CondBranch condition _ (Just elseThen)) <- condTreeComponents condNode - ] - --- ------------------------------------------------------------ - --- * Checks involving files in the package - --- ------------------------------------------------------------ - --- | Sanity check things that requires IO. It looks at the files in the --- package and expects to find the package unpacked in at the given file path. -checkPackageFiles :: Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck] -checkPackageFiles verbosity pkg root = do - contentChecks <- checkPackageContent checkFilesIO pkg - preDistributionChecks <- checkPackageFilesPreDistribution verbosity pkg root - -- Sort because different platforms will provide files from - -- `getDirectoryContents` in different orders, and we'd like to be - -- stable for test output. - return (sort contentChecks ++ sort preDistributionChecks) + return cabalFiles + +checkCabalFile :: Monad m => PackageName -> CheckM m () +checkCabalFile pn = do + -- liftInt is a bit more messy than stricter interface, but since + -- each of the following check is exclusive, we can simplify the + -- condition flow. + liftInt + ciPackageOps + ( \ops -> do + -- 1. Get .cabal files. + ds <- findPackageDesc ops + case ds of + [] -> return [PackageBuildImpossible NoDesc] + -- No .cabal file. + [d] -> do + bc <- bomf ops d + return (catMaybes [bc, noMatch d]) + -- BOM + no matching .cabal checks. + _ -> return [PackageBuildImpossible $ MultiDesc ds] + ) where - checkFilesIO = - CheckPackageContentOps - { doesFileExist = System.doesFileExist . relative - , doesDirectoryExist = System.doesDirectoryExist . relative - , getDirectoryContents = System.Directory.getDirectoryContents . relative - , getFileContents = BS.readFile . relative - } - relative path = root path + -- Multiple .cabal files. --- | A record of operations needed to check the contents of packages. --- Used by 'checkPackageContent'. -data CheckPackageContentOps m = CheckPackageContentOps - { doesFileExist :: FilePath -> m Bool - , doesDirectoryExist :: FilePath -> m Bool - , getDirectoryContents :: FilePath -> m [FilePath] - , getFileContents :: FilePath -> m BS.ByteString - } + bomf + :: Monad m + => CheckPackageContentOps m + -> FilePath + -> m (Maybe PackageCheck) + bomf wops wfp = do + b <- BS.isPrefixOf bomUtf8 <$> getFileContents wops wfp + if b + then (return . Just) (PackageDistInexcusable $ BOMStart wfp) + else return Nothing --- | Sanity check things that requires looking at files in the package. --- This is a generalised version of 'checkPackageFiles' that can work in any --- monad for which you can provide 'CheckPackageContentOps' operations. --- --- The point of this extra generality is to allow doing checks in some virtual --- file system, for example a tarball in memory. -checkPackageContent - :: (Monad m, Applicative m) - => CheckPackageContentOps m - -> PackageDescription - -> m [PackageCheck] -checkPackageContent ops pkg = do - cabalBomError <- checkCabalFileBOM ops - cabalNameError <- checkCabalFileName ops pkg - licenseErrors <- checkLicensesExist ops pkg - setupError <- checkSetupExists ops pkg - configureError <- checkConfigureExists ops pkg - localPathErrors <- checkLocalPathsExist ops pkg - vcsLocation <- checkMissingVcsInfo ops pkg - - return $ - licenseErrors - ++ catMaybes [cabalBomError, cabalNameError, setupError, configureError] - ++ localPathErrors - ++ vcsLocation - -checkCabalFileBOM - :: Monad m - => CheckPackageContentOps m - -> m (Maybe PackageCheck) -checkCabalFileBOM ops = do - epdfile <- findPackageDesc ops - case epdfile of - -- MASSIVE HACK. If the Cabal file doesn't exist, that is - -- a very strange situation to be in, because the driver code - -- in 'Distribution.Setup' ought to have noticed already! - -- But this can be an issue, see #3552 and also when - -- --cabal-file is specified. So if you can't find the file, - -- just don't bother with this check. - Left _ -> return Nothing - Right pdfile -> - (flip check pc . BS.isPrefixOf bomUtf8) - `liftM` getFileContents ops pdfile - where - pc = PackageDistInexcusable (BOMStart pdfile) - where bomUtf8 :: BS.ByteString bomUtf8 = BS.pack [0xef, 0xbb, 0xbf] -- U+FEFF encoded as UTF8 - -checkCabalFileName + noMatch :: FilePath -> Maybe PackageCheck + noMatch wd = + let expd = unPackageName pn <.> "cabal" + in if takeFileName wd /= expd + then Just (PackageDistInexcusable $ NotPackageName wd expd) + else Nothing + +checkLicFileExist :: Monad m - => CheckPackageContentOps m - -> PackageDescription - -> m (Maybe PackageCheck) -checkCabalFileName ops pkg = do - -- findPackageDesc already takes care to detect missing/multiple - -- .cabal files; we don't include this check in 'findPackageDesc' in - -- order not to short-cut other checks which call 'findPackageDesc' - epdfile <- findPackageDesc ops - case epdfile of - -- see "MASSIVE HACK" note in 'checkCabalFileBOM' - Left _ -> return Nothing - Right pdfile - | takeFileName pdfile == expectedCabalname -> return Nothing - | otherwise -> - return $ - Just $ - PackageDistInexcusable - (NotPackageName pdfile expectedCabalname) - where - pkgname = unPackageName . packageName $ pkg - expectedCabalname = pkgname <.> "cabal" - --- | Find a package description file in the given directory. Looks for --- @.cabal@ files. Like 'Distribution.Simple.Utils.findPackageDesc', --- but generalized over monads. -findPackageDesc - :: Monad m - => CheckPackageContentOps m - -> m (Either PackageCheck FilePath) - -- ^ .cabal -findPackageDesc ops = - do - let dir = "." - files <- getDirectoryContents ops dir - -- to make sure we do not mistake a ~/.cabal/ dir for a .cabal - -- file we filter to exclude dirs and null base file names: - cabalFiles <- - filterM - (doesFileExist ops) - [ dir file - | file <- files - , let (name, ext) = splitExtension file - , not (null name) && ext == ".cabal" - ] - case cabalFiles of - [] -> return (Left $ PackageBuildImpossible NoDesc) - [cabalFile] -> return (Right cabalFile) - multiple -> - return - ( Left $ - PackageBuildImpossible - (MultiDesc multiple) - ) - -checkLicensesExist - :: (Monad m, Applicative m) - => CheckPackageContentOps m - -> PackageDescription - -> m [PackageCheck] -checkLicensesExist ops pkg = do - exists <- traverse (doesFileExist ops . getSymbolicPath) (licenseFiles pkg) - return - [ PackageBuildWarning (UnknownFile fieldname file) - | (file, False) <- zip (licenseFiles pkg) exists - ] - where - fieldname - | length (licenseFiles pkg) == 1 = "license-file" - | otherwise = "license-files" - -checkSetupExists - :: Monad m - => CheckPackageContentOps m - -> PackageDescription - -> m (Maybe PackageCheck) -checkSetupExists ops pkg = do - let simpleBuild = buildType pkg == Simple - hsexists <- doesFileExist ops "Setup.hs" - lhsexists <- doesFileExist ops "Setup.lhs" - return $ - check (not simpleBuild && not hsexists && not lhsexists) $ - PackageDistInexcusable MissingSetupFile - -checkConfigureExists - :: Monad m - => CheckPackageContentOps m - -> PackageDescription - -> m (Maybe PackageCheck) -checkConfigureExists ops pd - | buildType pd == Configure = do - exists <- doesFileExist ops "configure" - return $ - check (not exists) $ - PackageBuildWarning MissingConfigureScript - | otherwise = return Nothing - -checkLocalPathsExist - :: Monad m - => CheckPackageContentOps m - -> PackageDescription - -> m [PackageCheck] -checkLocalPathsExist ops pkg = do - let dirs = - [ (dir, kind) - | bi <- allBuildInfo pkg - , (dir, kind) <- - [(dir, "extra-lib-dirs") | dir <- extraLibDirs bi] - ++ [(dir, "extra-lib-dirs-static") | dir <- extraLibDirsStatic bi] - ++ [ (dir, "extra-framework-dirs") - | dir <- extraFrameworkDirs bi - ] - ++ [(dir, "include-dirs") | dir <- includeDirs bi] - ++ [(getSymbolicPath dir, "hs-source-dirs") | dir <- hsSourceDirs bi] - , isRelativeOnAnyPlatform dir - ] - missing <- filterM (liftM not . doesDirectoryExist ops . fst) dirs - return - [ PackageBuildWarning (UnknownDirectory kind dir) - | (dir, kind) <- missing - ] - -checkMissingVcsInfo - :: (Monad m, Applicative m) - => CheckPackageContentOps m - -> PackageDescription - -> m [PackageCheck] -checkMissingVcsInfo ops pkg | null (sourceRepos pkg) = do - vcsInUse <- liftM or $ traverse (doesDirectoryExist ops) repoDirnames - if vcsInUse - then return [PackageDistSuspicious MissingSourceControl] - else return [] - where - repoDirnames = - [ dirname | repo <- knownRepoTypes, dirname <- repoTypeDirname repo - ] -checkMissingVcsInfo _ _ = return [] - -repoTypeDirname :: KnownRepoType -> [FilePath] -repoTypeDirname Darcs = ["_darcs"] -repoTypeDirname Git = [".git"] -repoTypeDirname SVN = [".svn"] -repoTypeDirname CVS = ["CVS"] -repoTypeDirname Mercurial = [".hg"] -repoTypeDirname GnuArch = [".arch-params"] -repoTypeDirname Bazaar = [".bzr"] -repoTypeDirname Monotone = ["_MTN"] -repoTypeDirname Pijul = [".pijul"] - --- ------------------------------------------------------------ - --- * Checks involving files in the package - --- ------------------------------------------------------------ - --- | Check the names of all files in a package for portability problems. This --- should be done for example when creating or validating a package tarball. -checkPackageFileNames :: [FilePath] -> [PackageCheck] -checkPackageFileNames = checkPackageFileNamesWithGlob . zip (repeat True) - -checkPackageFileNamesWithGlob :: [(Bool, FilePath)] -> [PackageCheck] -checkPackageFileNamesWithGlob files = - catMaybes $ - checkWindowsPaths files - : [ checkTarPath file - | (_, file) <- files - ] - -checkWindowsPaths :: [(Bool, FilePath)] -> Maybe PackageCheck -checkWindowsPaths paths = - case filter (not . FilePath.Windows.isValid . escape) paths of - [] -> Nothing - ps -> - Just $ - PackageDistInexcusable (InvalidOnWin $ map snd ps) - where - -- force a relative name to catch invalid file names like "f:oo" which - -- otherwise parse as file "oo" in the current directory on the 'f' drive. - escape (isGlob, path) = - (".\\" ++) - -- glob paths will be expanded before being dereferenced, so asterisks - -- shouldn't count against them. - $ - map (\c -> if c == '*' && isGlob then 'x' else c) path - --- | Check a file name is valid for the portable POSIX tar format. --- --- The POSIX tar format has a restriction on the length of file names. It is --- unfortunately not a simple restriction like a maximum length. The exact --- restriction is that either the whole path be 100 characters or less, or it --- be possible to split the path on a directory separator such that the first --- part is 155 characters or less and the second part 100 characters or less. -checkTarPath :: FilePath -> Maybe PackageCheck -checkTarPath path - | length path > 255 = Just longPath - | otherwise = case pack nameMax (reverse (splitPath path)) of - Left err -> Just err - Right [] -> Nothing - Right (h : rest) -> case pack prefixMax remainder of - Left err -> Just err - Right [] -> Nothing - Right (_ : _) -> Just noSplit - where - -- drop the '/' between the name and prefix: - remainder = safeInit h : rest - where - nameMax, prefixMax :: Int - nameMax = 100 - prefixMax = 155 - - pack _ [] = Left emptyName - pack maxLen (c : cs) - | n > maxLen = Left longName - | otherwise = Right (pack' maxLen n cs) - where - n = length c - - pack' maxLen n (c : cs) - | n' <= maxLen = pack' maxLen n' cs - where - n' = n + length c - pack' _ _ cs = cs - - longPath = PackageDistInexcusable (FilePathTooLong path) - longName = PackageDistInexcusable (FilePathNameTooLong path) - noSplit = PackageDistInexcusable (FilePathSplitTooLong path) - emptyName = PackageDistInexcusable FilePathEmpty - --- -------------------------------------------------------------- - --- * Checks for missing content and other pre-distribution checks - --- -------------------------------------------------------------- + => SymbolicPath PackageDir LicenseFile + -> CheckM m () +checkLicFileExist sp = do + let fp = getSymbolicPath sp + checkPkg + (\ops -> not <$> doesFileExist ops fp) + (PackageBuildWarning $ UnknownFile "license-file" sp) + +checkConfigureExists :: Monad m => BuildType -> CheckM m () +checkConfigureExists Configure = + checkPkg + (\ops -> not <$> doesFileExist ops "configure") + (PackageBuildWarning MissingConfigureScript) +checkConfigureExists _ = return () + +checkSetupExists :: Monad m => BuildType -> CheckM m () +checkSetupExists Simple = return () +checkSetupExists _ = + checkPkg + ( \ops -> do + ba <- doesFileExist ops "Setup.hs" + bb <- doesFileExist ops "Setup.lhs" + return (not $ ba || bb) + ) + (PackageDistInexcusable MissingSetupFile) --- | Similar to 'checkPackageContent', 'checkPackageFilesPreDistribution' --- inspects the files included in the package, but is primarily looking for --- files in the working tree that may have been missed or other similar --- problems that can only be detected pre-distribution. +-- The following functions are similar to 'CheckPackageContentOps m' ones, +-- but, as they inspect the files included in the package, but are primarily +-- looking for files in the working tree that may have been missed or other +-- similar problems that can only be detected pre-distribution. -- -- Because Hackage necessarily checks the uploaded tarball, it is too late to -- check these on the server; these checks only make sense in the development --- and package-creation environment. Hence we can use IO, rather than needing --- to pass a 'CheckPackageContentOps' dictionary around. -checkPackageFilesPreDistribution :: Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck] +-- and package-creation environment. +-- This most likely means we need to use IO, but a dictionary +-- 'CheckPreDistributionOps m' is provided in case in the future such +-- information can come from somewhere else (e.g. VCS filesystem). +-- -- Note: this really shouldn't return any 'Inexcusable' warnings, -- because that will make us say that Hackage would reject the package. --- But, because Hackage doesn't run these tests, that will be a lie! -checkPackageFilesPreDistribution = checkGlobFiles +-- But, because Hackage doesn't yet run these tests, that will be a lie! --- | Discover problems with the package's wildcards. -checkGlobFiles - :: Verbosity - -> PackageDescription - -> FilePath - -> IO [PackageCheck] -checkGlobFiles verbosity pkg root = do - -- Get the desirable doc files from package’s directory - rootContents <- System.Directory.getDirectoryContents root - docFiles0 <- - filterM - System.doesFileExist - [ file - | file <- rootContents - , isDesirableExtraDocFile desirableDocFiles file - ] - -- Check the globs - (warnings, unlisted) <- foldrM checkGlob ([], docFiles0) allGlobs - - return $ - if null unlisted - then -- No missing desirable file - warnings - else -- Some missing desirable files - - warnings - ++ let unlisted' = (root ) <$> unlisted - in [ PackageDistSuspiciousWarn - (MissingExpectedDocFiles extraDocFilesSupport unlisted') - ] +checkGlobFile + :: Monad m + => CabalSpecVersion + -> FilePath -- Glob pattern. + -> FilePath -- Folder to check. + -> CabalField -- .cabal field we are checking. + -> CheckM m () +checkGlobFile cv ddir title fp = do + let adjDdir = if null ddir then "." else ddir + dir + | title == "data-files" = adjDdir + | otherwise = "." + + case parseFileGlob cv fp of + -- We just skip over parse errors here; they're reported elsewhere. + Left _ -> return () + Right parsedGlob -> do + liftInt ciPreDistOps $ \po -> do + rs <- runDirFileGlobM po dir parsedGlob + return $ checkGlobResult title fp rs + +-- | Checks for matchless globs and too strict matching (<2.4 spec). +checkGlobResult + :: CabalField -- .cabal field we are checking + -> FilePath -- Glob pattern (to show the user + -- which pattern is the offending + -- one). + -> [GlobResult FilePath] -- List of glob results. + -> [PackageCheck] +checkGlobResult title fp rs = dirCheck ++ catMaybes (map getWarning rs) where - -- `extra-doc-files` is supported only from version 1.18 - extraDocFilesSupport = specVersion pkg >= CabalSpecV1_18 - adjustedDataDir = if null (dataDir pkg) then root else root dataDir pkg - -- Cabal fields with globs - allGlobs :: [(String, Bool, FilePath, FilePath)] - allGlobs = - concat - [ (,,,) "extra-source-files" (not extraDocFilesSupport) root - <$> extraSrcFiles pkg - , (,,,) "extra-doc-files" True root <$> extraDocFiles pkg - , (,,,) "data-files" False adjustedDataDir <$> dataFiles pkg - ] - - -- For each field with globs (see allGlobs), look for: - -- • errors (missing directory, no match) - -- • omitted documentation files (changelog) - checkGlob - :: (String, Bool, FilePath, FilePath) - -> ([PackageCheck], [FilePath]) - -> IO ([PackageCheck], [FilePath]) - checkGlob (field, isDocField, dir, glob) acc@(warnings, docFiles1) = - -- Note: we just skip over parse errors here; they're reported elsewhere. - case parseFileGlob (specVersion pkg) glob of - Left _ -> return acc - Right parsedGlob -> do - results <- runDirFileGlob verbosity (root dir) parsedGlob - let acc0 = (warnings, True, docFiles1, []) - return $ case foldr checkGlobResult acc0 results of - (individualWarn, noMatchesWarn, docFiles1', wrongPaths) -> - let wrongFieldWarnings = - [ PackageDistSuspiciousWarn - ( WrongFieldForExpectedDocFiles - extraDocFilesSupport - field - wrongPaths - ) - | not (null wrongPaths) - ] - in ( if noMatchesWarn - then - [PackageDistSuspiciousWarn (GlobNoMatch field glob)] - ++ individualWarn - ++ wrongFieldWarnings - else individualWarn ++ wrongFieldWarnings - , docFiles1' - ) - where - checkGlobResult - :: GlobResult FilePath - -> ([PackageCheck], Bool, [FilePath], [FilePath]) - -> ([PackageCheck], Bool, [FilePath], [FilePath]) - checkGlobResult result (ws, noMatchesWarn, docFiles2, wrongPaths) = - let noMatchesWarn' = - noMatchesWarn - && not (suppressesNoMatchesWarning result) - in case getWarning field glob result of - -- No match: add warning and do no further check - Left w -> - ( w : ws - , noMatchesWarn' - , docFiles2 - , wrongPaths - ) - -- Match: check doc files - Right path -> - let path' = makeRelative root (normalise path) - (docFiles2', wrongPaths') = - checkDoc - isDocField - path' - docFiles2 - wrongPaths - in ( ws - , noMatchesWarn' - , docFiles2' - , wrongPaths' - ) - - -- Check whether a path is a desirable doc: if so, check if it is in the - -- field "extra-doc-files". - checkDoc - :: Bool -- Is it "extra-doc-files" ? - -> FilePath -- Path to test - -> [FilePath] -- Pending doc files to check - -> [FilePath] -- Previous wrong paths - -> ([FilePath], [FilePath]) -- Updated paths - checkDoc isDocField path docFiles wrongFieldPaths = - if path `elem` docFiles - then -- Found desirable doc file - - ( delete path docFiles - , if isDocField then wrongFieldPaths else path : wrongFieldPaths - ) - else -- Not a desirable doc file - - ( docFiles - , wrongFieldPaths - ) - - -- Predicate for desirable documentation file on Hackage server - isDesirableExtraDocFile :: ([FilePath], [FilePath]) -> FilePath -> Bool - isDesirableExtraDocFile (basenames, extensions) path = - basename `elem` basenames && ext `elem` extensions - where - (basename, ext) = splitExtension (map toLower path) - - -- Changelog patterns (basenames & extensions) - -- Source: hackage-server/src/Distribution/Server/Packages/ChangeLog.hs - desirableChangeLog = - [ "news" - , "changelog" - , "change_log" - , "changes" - ] - desirableChangeLogExtensions = ["", ".txt", ".md", ".markdown", ".rst"] - -- [TODO] Check readme. Observations: - -- • Readme is not necessary if package description is good. - -- • Some readmes exists only for repository browsing. - -- • There is currently no reliable way to check what a good - -- description is; there will be complains if the criterion is - -- based on the length or number of words (can of worms). - -- -- Readme patterns - -- -- Source: hackage-server/src/Distribution/Server/Packages/Readme.hs - -- desirableReadme = ["readme"] - desirableDocFiles = (desirableChangeLog, desirableChangeLogExtensions) + dirCheck + | all (not . withoutNoMatchesWarning) rs = + [PackageDistSuspiciousWarn $ GlobNoMatch title fp] + | otherwise = [] -- If there's a missing directory in play, since our globs don't - -- (currently) support disjunction, that will always mean there are no - -- matches. The no matches error in this case is strictly less informative - -- than the missing directory error, so sit on it. - suppressesNoMatchesWarning (GlobMatch _) = True - suppressesNoMatchesWarning (GlobWarnMultiDot _) = False - suppressesNoMatchesWarning (GlobMissingDirectory _) = True - - getWarning - :: String - -> FilePath - -> GlobResult FilePath - -> Either PackageCheck FilePath - getWarning _ _ (GlobMatch path) = - Right path + -- (currently) support disjunction, that will always mean there are + -- no matches. The no matches error in this case is strictly less + -- informative than the missing directory error. + withoutNoMatchesWarning (GlobMatch _) = True + withoutNoMatchesWarning (GlobWarnMultiDot _) = False + withoutNoMatchesWarning (GlobMissingDirectory _) = True + + getWarning :: GlobResult FilePath -> Maybe PackageCheck + getWarning (GlobMatch _) = Nothing -- Before Cabal 2.4, the extensions of globs had to match the file -- exactly. This has been relaxed in 2.4 to allow matching only the - -- suffix. This warning detects when pre-2.4 package descriptions are - -- omitting files purely because of the stricter check. - getWarning field glob (GlobWarnMultiDot file) = - Left (PackageDistSuspiciousWarn (GlobExactMatch field glob file)) - getWarning field glob (GlobMissingDirectory dir) = - Left (PackageDistSuspiciousWarn (GlobNoDir field glob dir)) - --- | Check that setup dependencies, have proper bounds. --- In particular, @base@ and @Cabal@ upper bounds are mandatory. -checkSetupVersions :: GenericPackageDescription -> [PackageCheck] -checkSetupVersions pkg = - [ emitError nameStr - | (name, vr) <- Map.toList deps - , not (hasUpperBound vr) - , let nameStr = unPackageName name - , nameStr `elem` criticalPkgs - ] - where - criticalPkgs = ["Cabal", "base"] - deps = toDependencyVersionsMap (foldMap setupDepends . setupBuildInfo) pkg - emitError nm = - PackageDistInexcusable (UpperBoundSetup nm) - -checkDuplicateModules :: GenericPackageDescription -> [PackageCheck] -checkDuplicateModules pkg = - concatMap checkLib (maybe id (:) (condLibrary pkg) . map snd $ condSubLibraries pkg) - ++ concatMap checkExe (map snd $ condExecutables pkg) - ++ concatMap checkTest (map snd $ condTestSuites pkg) - ++ concatMap checkBench (map snd $ condBenchmarks pkg) - where - -- the duplicate modules check is has not been thoroughly vetted for backpack - checkLib = checkDups "library" (\l -> explicitLibModules l ++ map moduleReexportName (reexportedModules l)) - checkExe = checkDups "executable" exeModules - checkTest = checkDups "test suite" testModules - checkBench = checkDups "benchmark" benchmarkModules - checkDups s getModules t = - let sumPair (x, x') (y, y') = (x + x' :: Int, y + y' :: Int) - mergePair (x, x') (y, y') = (x + x', max y y') - maxPair (x, x') (y, y') = (max x x', max y y') - libMap = - foldCondTree - Map.empty - (\(_, v) -> Map.fromListWith sumPair . map (\x -> (x, (1, 1))) $ getModules v) - (Map.unionWith mergePair) -- if a module may occur in nonexclusive branches count it twice strictly and once loosely. - (Map.unionWith maxPair) -- a module occurs the max of times it might appear in exclusive branches - t - dupLibsStrict = Map.keys $ Map.filter ((> 1) . fst) libMap - dupLibsLax = Map.keys $ Map.filter ((> 1) . snd) libMap - in if not (null dupLibsLax) - then - [ PackageBuildImpossible - (DuplicateModule s dupLibsLax) - ] - else - if not (null dupLibsStrict) - then - [ PackageDistSuspicious - (PotentialDupModule s dupLibsStrict) - ] - else [] + -- suffix. This warning detects when pre-2.4 package descriptions + -- are omitting files purely because of the stricter check. + getWarning (GlobWarnMultiDot file) = + Just $ PackageDistSuspiciousWarn (GlobExactMatch title fp file) + getWarning (GlobMissingDirectory dir) = + Just $ PackageDistSuspiciousWarn (GlobNoDir title fp dir) -- ------------------------------------------------------------ +-- Other exports +-- ------------------------------------------------------------ --- * Utils +-- | Wraps `ParseWarning` into `PackageCheck`. +wrapParseWarning :: FilePath -> PWarning -> PackageCheck +wrapParseWarning fp pw = PackageDistSuspicious (ParseWarning fp pw) + +-- TODO: as Jul 2022 there is no severity indication attached PWarnType. +-- Once that is added, we can output something more appropriate +-- than PackageDistSuspicious for every parse warning. +-- (see: Cabal-syntax/src/Distribution/Parsec/Warning.hs) +-- ------------------------------------------------------------ +-- Ancillaries -- ------------------------------------------------------------ -toDependencyVersionsMap :: (PackageDescription -> [Dependency]) -> GenericPackageDescription -> Map PackageName VersionRange -toDependencyVersionsMap selectDependencies pkg = case typicalPkg pkg of - Right (pkgs', _) -> - let - self :: PackageName - self = pkgName $ package pkgs' - in - Map.fromListWith intersectVersionRanges $ - [ (pname, vr) - | Dependency pname vr _ <- selectDependencies pkgs' - , pname /= self - ] - -- Just in case finalizePD fails for any reason, - -- or if the package doesn't depend on the base package at all, - -- no deps is no checks. - _ -> Map.empty - -quote :: String -> String -quote s = "'" ++ s ++ "'" - -commaSep :: [String] -> String -commaSep = intercalate ", " +-- Gets a list of dependencies from a Library target to pass to PVP related +-- functions. We are not doing checks here: this is not imprecise, as the +-- library itself *will* be checked for PVP errors. +-- Same for branch merging, +-- each of those branch will be checked one by one. +extractAssocDeps + :: UnqualComponentName -- Name of the target library + -> CondTree ConfVar [Dependency] Library + -> AssocDep +extractAssocDeps n ct = + let a = ignoreConditions ct + in -- Merging is fine here, remember the specific + -- library dependencies will be checked branch + -- by branch. + (n, snd a) + +-- | August 2022: this function is an oddity due to the historical +-- GenericPackageDescription/PackageDescription split (check +-- Distribution.Types.PackageDescription for a description of the relationship +-- between GPD and PD. +-- It is only maintained not to break interface, should be deprecated in the +-- future in favour of `checkPackage` when PD and GPD are refactored sensibly. +pd2gpd :: PackageDescription -> GenericPackageDescription +pd2gpd pd = gpd + where + gpd :: GenericPackageDescription + gpd = + emptyGenericPackageDescription + { packageDescription = pd + , condLibrary = fmap t2c (library pd) + , condSubLibraries = map (t2cName ln id) (subLibraries pd) + , condForeignLibs = + map + (t2cName foreignLibName id) + (foreignLibs pd) + , condExecutables = + map + (t2cName exeName id) + (executables pd) + , condTestSuites = + map + (t2cName testName remTest) + (testSuites pd) + , condBenchmarks = + map + (t2cName benchmarkName remBench) + (benchmarks pd) + } -dups :: Ord a => [a] -> [a] -dups xs = [x | (x : _ : _) <- group (sort xs)] + -- From target to simple, unconditional CondTree. + t2c :: a -> CondTree ConfVar [Dependency] a + t2c a = CondNode a [] [] + + -- From named target to unconditional CondTree. Notice we have + -- a function to extract the name *and* a function to modify + -- the target. This is needed for 'initTargetAnnotation' to work + -- properly and to contain all the quirks inside 'pd2gpd'. + t2cName + :: (a -> UnqualComponentName) + -> (a -> a) + -> a + -> (UnqualComponentName, CondTree ConfVar [Dependency] a) + t2cName nf mf a = (nf a, t2c . mf $ a) + + ln :: Library -> UnqualComponentName + ln wl = case libName wl of + (LSubLibName u) -> u + LMainLibName -> mkUnqualComponentName "main-library" + + remTest :: TestSuite -> TestSuite + remTest t = t{testName = mempty} + + remBench :: Benchmark -> Benchmark + remBench b = b{benchmarkName = mempty} + +-- checkMissingDocs will check that we don’t have an interesting file +-- (changes.txt, Changelog.md, NEWS, etc.) in our work-tree which is not +-- present in our .cabal file. +checkMissingDocs + :: Monad m + => [Glob] -- data-files globs. + -> [Glob] -- extra-source-files globs. + -> [Glob] -- extra-doc-files globs. + -> CheckM m () +checkMissingDocs dgs esgs edgs = do + extraDocSupport <- (>= CabalSpecV1_18) <$> asksCM ccSpecVersion + + -- Everything in this block uses CheckPreDistributionOps interface. + liftInt + ciPreDistOps + ( \ops -> do + -- 1. Get root files, see if they are interesting to us. + rootContents <- getDirectoryContentsM ops "." + -- Recall getDirectoryContentsM arg is relative to root path. + let des = filter isDesirableExtraDocFile rootContents + + -- 2. Realise Globs. + let realGlob t = + concatMap globMatches + <$> mapM (runDirFileGlobM ops "") t + rgs <- realGlob dgs + res <- realGlob esgs + red <- realGlob edgs + + -- 3. Check if anything in 1. is missing in 2. + let mcs = checkDoc extraDocSupport des (rgs ++ res ++ red) + + -- 4. Check if files are present but in the wrong field. + let pcsData = checkDocMove extraDocSupport "data-files" des rgs + pcsSource = + if extraDocSupport + then + checkDocMove + extraDocSupport + "extra-source-files" + des + res + else [] + pcs = pcsData ++ pcsSource -fileExtensionSupportedLanguage :: FilePath -> Bool -fileExtensionSupportedLanguage path = - isHaskell || isC + return (mcs ++ pcs) + ) where - extension = takeExtension path - isHaskell = extension `elem` [".hs", ".lhs"] - isC = isJust (filenameCDialect extension) + -- From Distribution.Simple.Glob. + globMatches :: [GlobResult a] -> [a] + globMatches input = [a | GlobMatch a <- input] --- | Whether a path is a good relative path. We aren't worried about perfect --- cross-platform compatibility here; this function just checks the paths in --- the (local) @.cabal@ file, while only Hackage needs the portability. --- --- >>> let test fp = putStrLn $ show (isGoodRelativeDirectoryPath fp) ++ "; " ++ show (isGoodRelativeFilePath fp) --- --- Note that "foo./bar.hs" would be invalid on Windows. --- --- >>> traverse_ test ["foo/bar/quu", "a/b.hs", "foo./bar.hs"] --- Nothing; Nothing --- Nothing; Nothing --- Nothing; Nothing --- --- Trailing slash is not allowed for files, for directories it is ok. --- --- >>> test "foo/" --- Nothing; Just "trailing slash" --- --- Leading @./@ is fine, but @.@ and @./@ are not valid files. --- --- >>> traverse_ test [".", "./", "./foo/bar"] --- Nothing; Just "trailing dot segment" --- Nothing; Just "trailing slash" --- Nothing; Nothing --- --- Lastly, not good file nor directory cases: --- --- >>> traverse_ test ["", "/tmp/src", "foo//bar", "foo/.", "foo/./bar", "foo/../bar"] --- Just "empty path"; Just "empty path" --- Just "posix absolute path"; Just "posix absolute path" --- Just "empty path segment"; Just "empty path segment" --- Just "trailing same directory segment: ."; Just "trailing same directory segment: ." --- Just "same directory segment: ."; Just "same directory segment: ." --- Just "parent directory segment: .."; Just "parent directory segment: .." --- --- For the last case, 'isGoodRelativeGlob' doesn't warn: --- --- >>> traverse_ (print . isGoodRelativeGlob) ["foo/../bar"] --- Just "parent directory segment: .." -isGoodRelativeFilePath :: FilePath -> Maybe String -isGoodRelativeFilePath = state0 - where - -- initial state - state0 [] = Just "empty path" - state0 (c : cs) - | c == '.' = state1 cs - | c == '/' = Just "posix absolute path" - | otherwise = state5 cs - - -- after initial . - state1 [] = Just "trailing dot segment" - state1 (c : cs) - | c == '.' = state4 cs - | c == '/' = state2 cs - | otherwise = state5 cs - - -- after ./ or after / between segments - state2 [] = Just "trailing slash" - state2 (c : cs) - | c == '.' = state3 cs - | c == '/' = Just "empty path segment" - | otherwise = state5 cs - - -- after non-first segment's . - state3 [] = Just "trailing same directory segment: ." - state3 (c : cs) - | c == '.' = state4 cs - | c == '/' = Just "same directory segment: ." - | otherwise = state5 cs - - -- after .. - state4 [] = Just "trailing parent directory segment: .." - state4 (c : cs) - | c == '.' = state5 cs - | c == '/' = Just "parent directory segment: .." - | otherwise = state5 cs - - -- in a segment which is ok. - state5 [] = Nothing - state5 (c : cs) - | c == '.' = state5 cs - | c == '/' = state2 cs - | otherwise = state5 cs - --- | See 'isGoodRelativeFilePath'. --- --- This is barebones function. We check whether the glob is a valid file --- by replacing stars @*@ with @x@ses. -isGoodRelativeGlob :: FilePath -> Maybe String -isGoodRelativeGlob = isGoodRelativeFilePath . map f - where - f '*' = 'x' - f c = c + checkDoc + :: Bool -- Cabal spec ≥ 1.18? + -> [FilePath] -- Desirables. + -> [FilePath] -- Actuals. + -> [PackageCheck] + checkDoc b ds as = + let fds = map ("." ) $ filter (flip notElem as) ds + in if null fds + then [] + else + [ PackageDistSuspiciousWarn $ + MissingExpectedDocFiles b fds + ] + + checkDocMove + :: Bool -- Cabal spec ≥ 1.18? + -> CabalField -- Name of the field. + -> [FilePath] -- Desirables. + -> [FilePath] -- Actuals. + -> [PackageCheck] + checkDocMove b field ds as = + let fds = filter (flip elem as) ds + in if null fds + then [] + else + [ PackageDistSuspiciousWarn $ + WrongFieldForExpectedDocFiles b field fds + ] --- | See 'isGoodRelativeFilePath'. -isGoodRelativeDirectoryPath :: FilePath -> Maybe String -isGoodRelativeDirectoryPath = state0 +-- Predicate for desirable documentation file on Hackage server. +isDesirableExtraDocFile :: FilePath -> Bool +isDesirableExtraDocFile path = + basename `elem` desirableChangeLog + && ext `elem` desirableChangeLogExtensions where - -- initial state - state0 [] = Just "empty path" - state0 (c : cs) - | c == '.' = state5 cs - | c == '/' = Just "posix absolute path" - | otherwise = state4 cs - - -- after initial ./ or after / between segments - state1 [] = Nothing - state1 (c : cs) - | c == '.' = state2 cs - | c == '/' = Just "empty path segment" - | otherwise = state4 cs - - -- after non-first setgment's . - state2 [] = Just "trailing same directory segment: ." - state2 (c : cs) - | c == '.' = state3 cs - | c == '/' = Just "same directory segment: ." - | otherwise = state4 cs - - -- after .. - state3 [] = Just "trailing parent directory segment: .." - state3 (c : cs) - | c == '.' = state4 cs - | c == '/' = Just "parent directory segment: .." - | otherwise = state4 cs - - -- in a segment which is ok. - state4 [] = Nothing - state4 (c : cs) - | c == '.' = state4 cs - | c == '/' = state1 cs - | otherwise = state4 cs - - -- after initial . - state5 [] = Nothing -- "." - state5 (c : cs) - | c == '.' = state3 cs - | c == '/' = state1 cs - | otherwise = state4 cs - --- [Note: Good relative paths] --- --- Using @kleene@ we can define an extended regex: --- --- @ --- import Algebra.Lattice --- import Kleene --- import Kleene.ERE (ERE (..), intersections) --- --- data C = CDot | CSlash | CChar --- deriving (Eq, Ord, Enum, Bounded, Show) --- --- reservedR :: ERE C --- reservedR = notChar CSlash --- --- pathPieceR :: ERE C --- pathPieceR = intersections --- [ plus reservedR --- , ERENot (string [CDot]) --- , ERENot (string [CDot,CDot]) --- ] --- --- filePathR :: ERE C --- filePathR = optional (string [CDot, CSlash]) <> pathPieceR <> star (char CSlash <> pathPieceR) --- --- dirPathR :: ERE C --- dirPathR = (char CDot \/ filePathR) <> optional (char CSlash) --- --- plus :: ERE C -> ERE C --- plus r = r <> star r --- --- optional :: ERE C -> ERE C --- optional r = mempty \/ r --- @ --- --- Results in following state machine for @filePathR@ --- --- @ --- 0 -> \x -> if --- | x <= CDot -> 1 --- | otherwise -> 5 --- 1 -> \x -> if --- | x <= CDot -> 4 --- | x <= CSlash -> 2 --- | otherwise -> 5 --- 2 -> \x -> if --- | x <= CDot -> 3 --- | otherwise -> 5 --- 3 -> \x -> if --- | x <= CDot -> 4 --- | otherwise -> 5 --- 4 -> \x -> if --- | x <= CDot -> 5 --- | otherwise -> 5 --- 5+ -> \x -> if --- | x <= CDot -> 5 --- | x <= CSlash -> 2 --- | otherwise -> 5 --- @ --- --- and @dirPathR@: --- --- @ --- 0 -> \x -> if --- | x <= CDot -> 5 --- | otherwise -> 4 --- 1+ -> \x -> if --- | x <= CDot -> 2 --- | otherwise -> 4 --- 2 -> \x -> if --- | x <= CDot -> 3 --- | otherwise -> 4 --- 3 -> \x -> if --- | x <= CDot -> 4 --- | otherwise -> 4 --- 4+ -> \x -> if --- | x <= CDot -> 4 --- | x <= CSlash -> 1 --- | otherwise -> 4 --- 5+ -> \x -> if --- | x <= CDot -> 3 --- | x <= CSlash -> 1 --- | otherwise -> 4 --- @ + (basename, ext) = splitExtension (map toLower path) --- --- TODO: What we really want to do is test if there exists any --- configuration in which the base version is unbounded above. --- However that's a bit tricky because there are many possible --- configurations. As a cheap easy and safe approximation we will --- pick a single "typical" configuration and check if that has an --- open upper bound. To get a typical configuration we finalise --- using no package index and the current platform. -typicalPkg - :: GenericPackageDescription - -> Either [Dependency] (PackageDescription, FlagAssignment) -typicalPkg = - finalizePD - mempty - defaultComponentRequestedSpec - (const True) - buildPlatform - ( unknownCompilerInfo - (CompilerId buildCompilerFlavor nullVersion) - NoAbiTag - ) - [] - -addConditionalExp :: String -> String -addConditionalExp expl = - expl - ++ " Alternatively, if you want to use this, make it conditional based " - ++ "on a Cabal configuration flag (with 'manual: True' and 'default: " - ++ "False') and enable that flag during development." + -- Changelog patterns (basenames & extensions) + -- Source: hackage-server/src/Distribution/Server/Packages/ChangeLog.hs + desirableChangeLog = ["news", "changelog", "change_log", "changes"] + desirableChangeLogExtensions = ["", ".txt", ".md", ".markdown", ".rst"] + +-- [TODO] Check readme. Observations: +-- • Readme is not necessary if package description is good. +-- • Some readmes exists only for repository browsing. +-- • There is currently no reliable way to check what a good +-- description is; there will be complains if the criterion +-- is based on the length or number of words (can of worms). +-- -- Readme patterns +-- -- Source: hackage-server/src/Distribution/Server/Packages/Readme.hs +-- desirableReadme = ["readme"] + +-- Remove duplicates from list. +dups :: Ord a => [a] -> [a] +dups xs = [x | (x : _ : _) <- group (sort xs)] diff --git a/Cabal/src/Distribution/PackageDescription/Check/Common.hs b/Cabal/src/Distribution/PackageDescription/Check/Common.hs new file mode 100644 index 00000000000..4c528831430 --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Common.hs @@ -0,0 +1,149 @@ +-- | +-- Module : Distribution.PackageDescription.Check.Common +-- Copyright : Francesco Ariis 2022 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Common types/functions to various check modules which are *no* part of +-- Distribution.PackageDescription.Check.Monad. +module Distribution.PackageDescription.Check.Common + ( AssocDep + , CabalField + , PathKind (..) + , checkCustomField + , partitionDeps + , checkPVP + , checkPVPs + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.Compat.NonEmptySet (toNonEmpty) +import Distribution.Package +import Distribution.PackageDescription +import Distribution.PackageDescription.Check.Monad +import Distribution.Utils.Generic (isAscii) +import Distribution.Version + +import Control.Monad + +-- Type of FilePath. +data PathKind + = PathKindFile + | PathKindDirectory + | PathKindGlob + deriving (Eq) + +-- | .cabal field we are referring to. As now it is just a synonym to help +-- reading the code, in the future it might take advantage of typification +-- in Cabal-syntax. +type CabalField = String + +checkCustomField :: Monad m => (String, String) -> CheckM m () +checkCustomField (n, _) = + checkP + (any (not . isAscii) n) + (PackageDistInexcusable $ NonASCIICustomField [n]) + +-- ------------------------------------------------------------ +-- PVP types/functions +-- ------------------------------------------------------------ + +-- A library name / dependencies association list. Ultimately to be +-- fed to PVP check. +type AssocDep = (UnqualComponentName, [Dependency]) + +-- Convenience function to partition important dependencies by name. To +-- be used together with checkPVP. Important: usually “base” or “Cabal”, +-- as the error is slightly different. +-- Note that `partitionDeps` will also filter out dependencies which are +-- already present in a inherithed fashion (e.g. an exe which imports the +-- main library will not need to specify upper bounds on shared dependencies, +-- hence we do not return those). +-- +partitionDeps + :: Monad m + => [AssocDep] -- Possibly inherited dependencies, i.e. + -- dependencies from internal/main libs. + -> [UnqualComponentName] -- List of package names ("base", "Cabal"…) + -> [Dependency] -- Dependencies to check. + -> CheckM m ([Dependency], [Dependency]) +partitionDeps ads ns ds = do + -- Shared dependencies from “intra .cabal” libraries. + let + -- names of our dependencies + dqs = map unqualName ds + -- shared targets that match + fads = filter (flip elem dqs . fst) ads + -- the names of such targets + inNam = nub $ map fst fads :: [UnqualComponentName] + -- the dependencies of such targets + inDep = concatMap snd fads :: [Dependency] + + -- We exclude from checks: + -- 1. dependencies which are shared with main library / a + -- sublibrary; and of course + -- 2. the names of main library / sub libraries themselves. + -- + -- So in myPackage.cabal + -- library + -- build-depends: text < 5 + -- ⁝ + -- build-depends: myPackage, ← no warning, internal + -- text, ← no warning, inherited + -- monadacme ← warning! + let fFun d = + notElem (unqualName d) inNam + && notElem + (unqualName d) + (map unqualName inDep) + ds' = filter fFun ds + + return $ partition (flip elem ns . unqualName) ds' + where + -- Return *sublibrary* name if exists (internal), + -- otherwise package name. + unqualName :: Dependency -> UnqualComponentName + unqualName (Dependency n _ nel) = + case head (toNonEmpty nel) of + (LSubLibName ln) -> ln + _ -> packageNameToUnqualComponentName n + +-- PVP dependency check (one warning message per dependency, usually +-- for important dependencies like base). +checkPVP + :: Monad m + => (String -> PackageCheck) -- Warn message dependend on name + -- (e.g. "base", "Cabal"). + -> [Dependency] + -> CheckM m () +checkPVP ckf ds = do + let ods = checkPVPPrim ds + mapM_ (tellP . ckf . unPackageName . depPkgName) ods + +-- PVP dependency check for a list of dependencies. Some code duplication +-- is sadly needed to provide more ergonimic error messages. +checkPVPs + :: Monad m + => ( [String] + -> PackageCheck -- Grouped error message, depends on a + -- set of names. + ) + -> [Dependency] -- Deps to analyse. + -> CheckM m () +checkPVPs cf ds + | null ns = return () + | otherwise = tellP (cf ns) + where + ods = checkPVPPrim ds + ns = map (unPackageName . depPkgName) ods + +-- Returns dependencies without upper bounds. +checkPVPPrim :: [Dependency] -> [Dependency] +checkPVPPrim ds = filter withoutUpper ds + where + withoutUpper :: Dependency -> Bool + withoutUpper (Dependency _ ver _) = not . hasUpperBound $ ver diff --git a/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs b/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs new file mode 100644 index 00000000000..2d4963e434a --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs @@ -0,0 +1,221 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +-- | +-- Module : Distribution.PackageDescription.Check.Conditional +-- Copyright : Lennart Kolmodin 2008, Francesco Ariis 2023 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Checks on conditional targets (libraries, executables, etc. that are +-- still inside a CondTree and related checks that can only be performed +-- here (variables, duplicated modules). +module Distribution.PackageDescription.Check.Conditional + ( checkCondTarget + , checkDuplicateModules + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.Compiler +import Distribution.ModuleName (ModuleName) +import Distribution.Package +import Distribution.PackageDescription +import Distribution.PackageDescription.Check.Monad +import Distribution.System + +import qualified Data.Map as Map + +import Control.Monad + +-- As a prerequisite to some checks, we transform a target CondTree into +-- a CondTree of “target + useful context”. +-- This is slightly clearer, is easier to walk without resorting to +-- list comprehensions, allows us in the future to apply some sensible +-- “optimisations” to checks (exclusive branches, etc.). + +-- | @nf@ function is needed to appropriately name some targets which need +-- to be spoonfed (otherwise name appears as ""). +initTargetAnnotation + :: Monoid a + => (UnqualComponentName -> a -> a) -- Naming function for targets. + -> UnqualComponentName + -> TargetAnnotation a +initTargetAnnotation nf n = TargetAnnotation (nf n mempty) False + +-- | We “build up” target from various slices. +updateTargetAnnotation + :: Monoid a + => a -- A target (lib, exe, test, …) + -> TargetAnnotation a + -> TargetAnnotation a +updateTargetAnnotation t ta = ta{taTarget = taTarget ta <> t} + +-- | Before walking a target 'CondTree', we need to annotate it with +-- information relevant to the checks (read 'TaraAnn' and 'checkCondTarget' +-- doc for more info). +annotateCondTree + :: forall a + . Monoid a + => [PackageFlag] -- User flags. + -> TargetAnnotation a + -> CondTree ConfVar [Dependency] a + -> CondTree ConfVar [Dependency] (TargetAnnotation a) +annotateCondTree fs ta (CondNode a c bs) = + let ta' = updateTargetAnnotation a ta + bs' = map (annotateBranch ta') bs + in CondNode ta' c bs' + where + annotateBranch + :: TargetAnnotation a + -> CondBranch ConfVar [Dependency] a + -> CondBranch + ConfVar + [Dependency] + (TargetAnnotation a) + annotateBranch wta (CondBranch k t mf) = + let uf = isPkgFlagCond k + wta' = wta{taPackageFlag = taPackageFlag wta || uf} + atf = annotateCondTree fs + in CondBranch + k + (atf wta' t) + (atf wta <$> mf) + -- Note how we are passing the *old* wta + -- in the `else` branch, since we are not + -- under that flag. + + -- We only want to pick up variables that are flags and that are + -- \*off* by default. + isPkgFlagCond :: Condition ConfVar -> Bool + isPkgFlagCond (Lit _) = False + isPkgFlagCond (Var (PackageFlag f)) = elem f defOffFlags + isPkgFlagCond (Var _) = False + isPkgFlagCond (CNot cn) = not (isPkgFlagCond cn) + isPkgFlagCond (CAnd ca cb) = isPkgFlagCond ca || isPkgFlagCond cb + isPkgFlagCond (COr ca cb) = isPkgFlagCond ca && isPkgFlagCond cb + + -- Package flags that are off by default *and* that are manual. + defOffFlags = + map flagName $ + filter + ( \f -> + not (flagDefault f) + && flagManual f + ) + fs + +-- | A conditional target is a library, exe, benchmark etc., destructured +-- in a CondTree. Traversing method: we render the branches, pass a +-- relevant context, collect checks. +checkCondTarget + :: forall m a + . (Monad m, Monoid a) + => [PackageFlag] -- User flags. + -> (a -> CheckM m ()) -- Check function (a = target). + -> (UnqualComponentName -> a -> a) + -- Naming function (some targets + -- need to have their name + -- spoonfed to them. + -> (UnqualComponentName, CondTree ConfVar [Dependency] a) + -- Target name/condtree. + -> CheckM m () +checkCondTarget fs cf nf (unqualName, ct) = + wTree $ annotateCondTree fs (initTargetAnnotation nf unqualName) ct + where + -- Walking the tree. Remember that CondTree is not a binary + -- tree but a /rose/tree. + wTree + :: CondTree ConfVar [Dependency] (TargetAnnotation a) + -> CheckM m () + wTree (CondNode ta _ bs) + -- There are no branches (and [] == True) *or* every branch + -- is “simple” (i.e. missing a 'condBranchIfFalse' part). + -- This is convenient but not necessarily correct in all + -- cases; a more precise way would be to check incompatibility + -- among simple branches conditions (or introduce a principled + -- `cond` construct in `.cabal` files. + | all isSimple bs = do + localCM (initCheckCtx ta) (cf $ taTarget ta) + mapM_ wBranch bs + -- If there are T/F conditions, there is no need to check + -- the intermediate 'TargetAnnotation' too. + | otherwise = do + mapM_ wBranch bs + + isSimple + :: CondBranch ConfVar [Dependency] (TargetAnnotation a) + -> Bool + isSimple (CondBranch _ _ Nothing) = True + isSimple (CondBranch _ _ (Just _)) = False + + wBranch + :: CondBranch ConfVar [Dependency] (TargetAnnotation a) + -> CheckM m () + wBranch (CondBranch k t mf) = do + checkCondVars k + wTree t + maybe (return ()) wTree mf + +-- | Condvar checking (misspelled OS in if conditions, etc). +checkCondVars :: Monad m => Condition ConfVar -> CheckM m () +checkCondVars cond = + let (_, vs) = simplifyCondition cond (\v -> Left v) + in -- Using simplifyCondition is convenient and correct, + -- if checks become more complex we can always walk + -- 'Condition'. + mapM_ vcheck vs + where + vcheck :: Monad m => ConfVar -> CheckM m () + vcheck (OS (OtherOS os)) = + tellP (PackageDistInexcusable $ UnknownOS [os]) + vcheck (Arch (OtherArch arch)) = + tellP (PackageDistInexcusable $ UnknownArch [arch]) + vcheck (Impl (OtherCompiler os) _) = + tellP (PackageDistInexcusable $ UnknownCompiler [os]) + vcheck _ = return () + +-- Checking duplicated modules cannot unfortunately be done in the +-- “tree checking”. This is because of the monoidal instance in some targets, +-- where e.g. merged dependencies are `nub`’d, hence losing information for +-- this particular check. +checkDuplicateModules :: GenericPackageDescription -> [PackageCheck] +checkDuplicateModules pkg = + concatMap checkLib (maybe id (:) (condLibrary pkg) . map snd $ condSubLibraries pkg) + ++ concatMap checkExe (map snd $ condExecutables pkg) + ++ concatMap checkTest (map snd $ condTestSuites pkg) + ++ concatMap checkBench (map snd $ condBenchmarks pkg) + where + -- the duplicate modules check is has not been thoroughly vetted for backpack + checkLib = checkDups "library" (\l -> explicitLibModules l ++ map moduleReexportName (reexportedModules l)) + checkExe = checkDups "executable" exeModules + checkTest = checkDups "test suite" testModules + checkBench = checkDups "benchmark" benchmarkModules + checkDups :: String -> (a -> [ModuleName]) -> CondTree v c a -> [PackageCheck] + checkDups s getModules t = + let sumPair (x, x') (y, y') = (x + x' :: Int, y + y' :: Int) + mergePair (x, x') (y, y') = (x + x', max y y') + maxPair (x, x') (y, y') = (max x x', max y y') + libMap = + foldCondTree + Map.empty + (\(_, v) -> Map.fromListWith sumPair . map (\x -> (x, (1, 1))) $ getModules v) + (Map.unionWith mergePair) -- if a module may occur in nonexclusive branches count it twice strictly and once loosely. + (Map.unionWith maxPair) -- a module occurs the max of times it might appear in exclusive branches + t + dupLibsStrict = Map.keys $ Map.filter ((> 1) . fst) libMap + dupLibsLax = Map.keys $ Map.filter ((> 1) . snd) libMap + in if not (null dupLibsLax) + then + [ PackageBuildImpossible + (DuplicateModule s dupLibsLax) + ] + else + if not (null dupLibsStrict) + then + [ PackageDistSuspicious + (PotentialDupModule s dupLibsStrict) + ] + else [] diff --git a/Cabal/src/Distribution/PackageDescription/Check/Monad.hs b/Cabal/src/Distribution/PackageDescription/Check/Monad.hs new file mode 100644 index 00000000000..9e375e8d9b8 --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Monad.hs @@ -0,0 +1,372 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | +-- Module : Distribution.PackageDescription.Check.Monad +-- Copyright : Francesco Ariis 2022 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Primitives for package checking: check types and monadic interface. +-- Having these primitives in a different module allows us to appropriately +-- limit/manage the interface to suit checking needs. +module Distribution.PackageDescription.Check.Monad + ( -- * Types and constructors + CheckM (..) + , execCheckM + , CheckInterface (..) + , CheckPackageContentOps (..) + , CheckPreDistributionOps (..) + , TargetAnnotation (..) + , PackageCheck (..) + , CheckExplanation (..) + , CEField (..) + , CEType (..) + , WarnLang (..) + , CheckCtx (..) + , pristineCheckCtx + , initCheckCtx + , PNames (..) + + -- * Operations + , ppPackageCheck + , isHackageDistError + , asksCM + , localCM + , checkP + , checkPkg + , liftInt + , tellP + , checkSpecVer + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.CabalSpecVersion (CabalSpecVersion) +import Distribution.Package (packageName) +import Distribution.PackageDescription.Check.Warning +import Distribution.Simple.BuildToolDepends (desugarBuildToolSimple) +import Distribution.Simple.Glob (Glob, GlobResult) +import Distribution.Types.ExeDependency (ExeDependency) +import Distribution.Types.GenericPackageDescription +import Distribution.Types.LegacyExeDependency (LegacyExeDependency) +import Distribution.Types.PackageDescription (package, specVersion) +import Distribution.Types.PackageId (PackageIdentifier) +import Distribution.Types.UnqualComponentName + +import qualified Control.Monad.Reader as Reader +import qualified Control.Monad.Trans.Class as Trans +import qualified Control.Monad.Writer as Writer +import qualified Data.ByteString.Lazy as BS +import qualified Data.Set as Set + +import Control.Monad + +-- Monadic interface for for Distribution.PackageDescription.Check. +-- +-- Monadic checking allows us to have a fine grained control on checks +-- (e.g. omitting warning checks in certain situations). + +-- * Interfaces + +-- + +-- | Which interface to we have available/should we use? (to perform: pure +-- checks, package checks, pre-distribution checks.) +data CheckInterface m = CheckInterface + { ciPureChecks :: Bool + , -- Perform pure checks? + ciPackageOps :: Maybe (CheckPackageContentOps m) + , -- If you want to perform package contents + -- checks, provide an interface. + ciPreDistOps :: Maybe (CheckPreDistributionOps m) + -- If you want to work-tree checks, provide + -- an interface. + } + +-- | A record of operations needed to check the contents of packages. +-- Abstracted over `m` to provide flexibility (could be IO, a .tar.gz +-- file, etc). +data CheckPackageContentOps m = CheckPackageContentOps + { doesFileExist :: FilePath -> m Bool + , doesDirectoryExist :: FilePath -> m Bool + , getDirectoryContents :: FilePath -> m [FilePath] + , getFileContents :: FilePath -> m BS.ByteString + } + +-- | A record of operations needed to check contents *of the work tree* +-- (compare it with 'CheckPackageContentOps'). This is still `m` abstracted +-- in case in the future we can obtain the same infos other than from IO +-- (e.g. a VCS work tree). +data CheckPreDistributionOps m = CheckPreDistributionOps + { runDirFileGlobM :: FilePath -> Glob -> m [GlobResult FilePath] + , getDirectoryContentsM :: FilePath -> m [FilePath] + } + +-- | Context to perform checks (will be the Reader part in your monad). +data CheckCtx m = CheckCtx + { ccInterface :: CheckInterface m + , -- Interface for checks. + + -- Contextual infos for checks. + ccFlag :: Bool + , -- Are we under a user flag? + + -- Convenience bits that we prefer to carry + -- in our Reader monad instead of passing it + -- via ->, as they are often useful and often + -- in deeply nested places in the GPD tree. + ccSpecVersion :: CabalSpecVersion + , -- Cabal version. + ccDesugar :: LegacyExeDependency -> Maybe ExeDependency + , -- A desugaring function from + -- Distribution.Simple.BuildToolDepends + -- (desugarBuildToolSimple). Again since it + -- eats PackageName and a list of executable + -- names, it is more convenient to pass it + -- via Reader. + ccNames :: PNames + -- Various names (id, libs, execs, tests, + -- benchs), convenience. + } + +-- | Creates a pristing 'CheckCtx'. With pristine we mean everything that +-- can be deduced by GPD but *not* user flags information. +pristineCheckCtx + :: Monad m + => CheckInterface m + -> GenericPackageDescription + -> CheckCtx m +pristineCheckCtx ci gpd = + let ens = map fst (condExecutables gpd) + in CheckCtx + ci + False + (specVersion . packageDescription $ gpd) + (desugarBuildToolSimple (packageName gpd) ens) + (initPNames gpd) + +-- | Adds useful bits to 'CheckCtx' (as now, whether we are operating under +-- a user off-by-default flag). +initCheckCtx :: Monad m => TargetAnnotation a -> CheckCtx m -> CheckCtx m +initCheckCtx t c = c{ccFlag = taPackageFlag t} + +-- | 'TargetAnnotation' collects contextual information on the target we are +-- realising: a buildup of the various slices of the target (a library, +-- executable, etc. — is a monoid) whether we are under an off-by-default +-- package flag. +data TargetAnnotation a = TargetAnnotation + { taTarget :: a + , -- The target we are building (lib, exe, etc.) + taPackageFlag :: Bool + -- Whether we are under an off-by-default package flag. + } + deriving (Show, Eq, Ord) + +-- | A collection os names, shipping tuples around is annoying. +data PNames = PNames + { pnPackageId :: PackageIdentifier -- Package ID… + -- … and a bunch of lib, exe, test, bench names. + , pnSubLibs :: [UnqualComponentName] + , pnExecs :: [UnqualComponentName] + , pnTests :: [UnqualComponentName] + , pnBenchs :: [UnqualComponentName] + } + +-- | Init names from a GPD. +initPNames :: GenericPackageDescription -> PNames +initPNames gpd = + PNames + (package . packageDescription $ gpd) + (map fst $ condSubLibraries gpd) + (map fst $ condExecutables gpd) + (map fst $ condTestSuites gpd) + (map fst $ condBenchmarks gpd) + +-- | Check monad, carrying a context, collecting 'PackageCheck's. +-- Using Set for writer (automatic sort) is useful for output stability +-- on different platforms. +-- It is nothing more than a monad stack with Reader+Writer. +-- `m` is the monad that could be used to do package/file checks. +newtype CheckM m a + = CheckM + ( Reader.ReaderT + (CheckCtx m) + ( Writer.WriterT + (Set.Set PackageCheck) + m + ) + a + ) + deriving (Functor, Applicative, Monad) + +-- Not autoderiving MonadReader and MonadWriter gives us better +-- control on the interface of CheckM. + +-- | Execute a CheckM monad, leaving `m [PackageCheck]` which can be +-- run in the appropriate `m` environment (IO, pure, …). +execCheckM :: Monad m => CheckM m () -> CheckCtx m -> m [PackageCheck] +execCheckM (CheckM rwm) ctx = + let wm = Reader.runReaderT rwm ctx + m = Writer.execWriterT wm + in Set.toList <$> m + +-- | As 'checkP' but always succeeding. +tellP :: Monad m => PackageCheck -> CheckM m () +tellP = checkP True + +-- | Add a package warning withoutu performing any check. +tellCM :: Monad m => PackageCheck -> CheckM m () +tellCM ck = do + cf <- asksCM ccFlag + unless + (cf && canSkip ck) + -- Do not push this message if the warning is not severe *and* + -- we are under a non-default package flag. + (CheckM . Writer.tell $ Set.singleton ck) + where + -- Check if we can skip this error if we are under a + -- non-default user flag. + canSkip :: PackageCheck -> Bool + canSkip wck = not (isSevereLocal wck) || isErrAllowable wck + + isSevereLocal :: PackageCheck -> Bool + isSevereLocal (PackageBuildImpossible _) = True + isSevereLocal (PackageBuildWarning _) = True + isSevereLocal (PackageDistSuspicious _) = False + isSevereLocal (PackageDistSuspiciousWarn _) = False + isSevereLocal (PackageDistInexcusable _) = True + + -- There are some errors which, even though severe, will + -- be allowed by Hackage *if* under a non-default flag. + isErrAllowable :: PackageCheck -> Bool + isErrAllowable c = case extractCheckExplantion c of + (WErrorUnneeded _) -> True + (JUnneeded _) -> True + (FDeferTypeErrorsUnneeded _) -> True + (DynamicUnneeded _) -> True + (ProfilingUnneeded _) -> True + _ -> False + +-- | Lift a monadic computation to CM. +liftCM :: Monad m => m a -> CheckM m a +liftCM ma = CheckM . Trans.lift . Trans.lift $ ma + +-- | Lift a monadic action via an interface. Missing interface, no action. +liftInt + :: forall m i + . Monad m + => (CheckInterface m -> Maybe (i m)) + -- Check interface, may or may not exist. If it does not, + -- the check simply will not be performed. + -> (i m -> m [PackageCheck]) + -- The actual check to perform with the above-mentioned + -- interface. Note the [] around `PackageCheck`, this is + -- meant to perform/collect multiple checks. + -> CheckM m () +liftInt acc f = do + ops <- asksCM (acc . ccInterface) + maybe (return ()) l ops + where + l :: i m -> CheckM m () + l wi = do + cks <- liftCM (f wi) + mapM_ (check True) cks + +-- | Most basic check function. You do not want to export this, rather export +-- “smart” functions (checkP, checkPkg) to enforce relevant properties. +check + :: Monad m + => Bool -- Is there something to warn about? + -> PackageCheck -- Warn message. + -> CheckM m () +check True ck = tellCM ck +check False _ = return () + +-- | Pure check not requiring IO or other interfaces. +checkP + :: Monad m + => Bool -- Is there something to warn about? + -> PackageCheck -- Warn message. + -> CheckM m () +checkP b ck = do + pb <- asksCM (ciPureChecks . ccInterface) + when pb (check b ck) + +-- Check with 'CheckPackageContentOps' operations (i.e. package file checks). +-- +checkPkg + :: forall m + . Monad m + => (CheckPackageContentOps m -> m Bool) + -- Actual check to perform with CPC interface + -> PackageCheck + -- Warn message. + -> CheckM m () +checkPkg f ck = checkInt ciPackageOps f ck + +-- | Generalised version for checks that need an interface. We pass a Reader +-- accessor to such interface ‘i’, a check function. +checkIntDep + :: forall m i + . Monad m + => (CheckInterface m -> Maybe (i m)) + -- Check interface, may or may not exist. If it does not, + -- the check simply will not be performed. + -> (i m -> m (Maybe PackageCheck)) + -- The actual check to perform (single check). + -> CheckM m () +checkIntDep acc mck = do + po <- asksCM (acc . ccInterface) + maybe (return ()) (lc . mck) po + where + lc :: Monad m => m (Maybe PackageCheck) -> CheckM m () + lc wmck = do + b <- liftCM wmck + maybe (return ()) (check True) b + +-- | As 'checkIntDep', but 'PackageCheck' does not depend on the monadic +-- computation. +checkInt + :: forall m i + . Monad m + => (CheckInterface m -> Maybe (i m)) + -- Where to get the interface (if available). + -> (i m -> m Bool) + -- Condition to check + -> PackageCheck + -- Warning message to add (does not depend on `m`). + -> CheckM m () +checkInt acc f ck = + checkIntDep + acc + ( \ops -> do + b <- f ops + if b + then return $ Just ck + else return Nothing + ) + +-- | `local` (from Control.Monad.Reader) for CheckM. +localCM :: Monad m => (CheckCtx m -> CheckCtx m) -> CheckM m () -> CheckM m () +localCM cf (CheckM im) = CheckM $ Reader.local cf im + +-- | `ask` (from Control.Monad.Reader) for CheckM. +asksCM :: Monad m => (CheckCtx m -> a) -> CheckM m a +asksCM f = CheckM $ Reader.asks f + +-- As checkP, but with an additional condition: the check will be performed +-- only if our spec version is < `vc`. +checkSpecVer + :: Monad m + => CabalSpecVersion -- Perform this check only if our + -- spec version is < than this. + -> Bool -- Check condition. + -> PackageCheck -- Check message. + -> CheckM m () +checkSpecVer vc cond c = do + vp <- asksCM ccSpecVersion + unless (vp >= vc) (checkP cond c) diff --git a/Cabal/src/Distribution/PackageDescription/Check/Paths.hs b/Cabal/src/Distribution/PackageDescription/Check/Paths.hs new file mode 100644 index 00000000000..f389c6797be --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Paths.hs @@ -0,0 +1,412 @@ +-- | +-- Module : Distribution.PackageDescription.Check.Paths +-- Copyright : Lennart Kolmodin 2008, Francesco Ariis 2023 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Functions to check filepaths, directories, globs, etc. +module Distribution.PackageDescription.Check.Paths + ( checkGlob + , checkPath + , fileExtensionSupportedLanguage + , isGoodRelativeDirectoryPath + , isGoodRelativeFilePath + , isGoodRelativeGlob + , isInsideDist + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.PackageDescription.Check.Common +import Distribution.PackageDescription.Check.Monad +import Distribution.Simple.CCompiler +import Distribution.Simple.Glob +import Distribution.Simple.Utils hiding (findPackageDesc, notice) +import System.FilePath (splitDirectories, splitPath, takeExtension) + +import qualified System.FilePath.Windows as FilePath.Windows (isValid) + +fileExtensionSupportedLanguage :: FilePath -> Bool +fileExtensionSupportedLanguage path = + isHaskell || isC + where + extension = takeExtension path + isHaskell = extension `elem` [".hs", ".lhs"] + isC = isJust (filenameCDialect extension) + +-- Boolean: are absolute paths allowed? +checkPath + :: Monad m + => Bool -- Can be absolute path? + -> CabalField -- .cabal field that we are checking. + -> PathKind -- Path type. + -> FilePath -- Path. + -> CheckM m () +checkPath isAbs title kind path = do + checkP + (isOutsideTree path) + (PackageBuildWarning $ RelativeOutside title path) + checkP + (isInsideDist path) + (PackageDistInexcusable $ DistPoint (Just title) path) + checkPackageFileNamesWithGlob kind path + + -- Skip if "can be absolute path". + checkP + (not isAbs && isAbsoluteOnAnyPlatform path) + (PackageDistInexcusable $ AbsolutePath title path) + case grl path kind of + Just e -> + checkP + (not isAbs) + (PackageDistInexcusable $ BadRelativePath title path e) + Nothing -> return () + checkWindowsPath (kind == PathKindGlob) path + where + isOutsideTree wpath = case splitDirectories wpath of + ".." : _ -> True + "." : ".." : _ -> True + _ -> False + + -- These are not paths, but globs... + grl wfp PathKindFile = isGoodRelativeFilePath wfp + grl wfp PathKindGlob = isGoodRelativeGlob wfp + grl wfp PathKindDirectory = isGoodRelativeDirectoryPath wfp + +-- | Is a 'FilePath' inside `dist`, `dist-newstyle` and friends? +isInsideDist :: FilePath -> Bool +isInsideDist path = + case map lowercase (splitDirectories path) of + "dist" : _ -> True + "." : "dist" : _ -> True + "dist-newstyle" : _ -> True + "." : "dist-newstyle" : _ -> True + _ -> False + +checkPackageFileNamesWithGlob + :: Monad m + => PathKind + -> FilePath -- Filepath or possibly a glob pattern. + -> CheckM m () +checkPackageFileNamesWithGlob kind fp = do + checkWindowsPath (kind == PathKindGlob) fp + checkTarPath fp + +checkWindowsPath + :: Monad m + => Bool -- Is it a glob pattern? + -> FilePath -- Path. + -> CheckM m () +checkWindowsPath isGlob path = + checkP + (not . FilePath.Windows.isValid $ escape isGlob path) + (PackageDistInexcusable $ InvalidOnWin [path]) + where + -- Force a relative name to catch invalid file names like "f:oo" which + -- otherwise parse as file "oo" in the current directory on the 'f' drive. + escape :: Bool -> String -> String + escape wisGlob wpath = + (".\\" ++) + -- Glob paths will be expanded before being dereferenced, so asterisks + -- shouldn't count against them. + $ + map (\c -> if c == '*' && wisGlob then 'x' else c) wpath + +-- | Check a file name is valid for the portable POSIX tar format. +-- +-- The POSIX tar format has a restriction on the length of file names. It is +-- unfortunately not a simple restriction like a maximum length. The exact +-- restriction is that either the whole path be 100 characters or less, or it +-- be possible to split the path on a directory separator such that the first +-- part is 155 characters or less and the second part 100 characters or less. +checkTarPath :: Monad m => FilePath -> CheckM m () +checkTarPath path + | length path > 255 = tellP longPath + | otherwise = case pack nameMax (reverse (splitPath path)) of + Left err -> tellP err + Right [] -> return () + Right (h : rest) -> case pack prefixMax remainder of + Left err -> tellP err + Right [] -> return () + Right (_ : _) -> tellP noSplit + where + -- drop the '/' between the name and prefix: + remainder = safeInit h : rest + where + nameMax, prefixMax :: Int + nameMax = 100 + prefixMax = 155 + + pack _ [] = Left emptyName + pack maxLen (c : cs) + | n > maxLen = Left longName + | otherwise = Right (pack' maxLen n cs) + where + n = length c + + pack' maxLen n (c : cs) + | n' <= maxLen = pack' maxLen n' cs + where + n' = n + length c + pack' _ _ cs = cs + + longPath = PackageDistInexcusable (FilePathTooLong path) + longName = PackageDistInexcusable (FilePathNameTooLong path) + noSplit = PackageDistInexcusable (FilePathSplitTooLong path) + emptyName = PackageDistInexcusable FilePathEmpty + +-- `checkGlob` checks glob patterns and returns good ones for further +-- processing. +checkGlob + :: Monad m + => CabalField -- .cabal field we are checking. + -> FilePath -- glob filepath pattern + -> CheckM m (Maybe Glob) +checkGlob title pat = do + ver <- asksCM ccSpecVersion + + -- Glob sanity check. + case parseFileGlob ver pat of + Left e -> do + tellP + ( PackageDistInexcusable $ + GlobSyntaxError title (explainGlobSyntaxError pat e) + ) + return Nothing + Right wglob -> do + -- \* Miscellaneous checks on sane glob. + -- Checks for recursive glob in root. + checkP + (isRecursiveInRoot wglob) + ( PackageDistSuspiciousWarn $ + RecursiveGlobInRoot title pat + ) + return (Just wglob) + +-- | Whether a path is a good relative path. We aren't worried about perfect +-- cross-platform compatibility here; this function just checks the paths in +-- the (local) @.cabal@ file, while only Hackage needs the portability. +-- +-- >>> let test fp = putStrLn $ show (isGoodRelativeDirectoryPath fp) ++ "; " ++ show (isGoodRelativeFilePath fp) +-- +-- Note that "foo./bar.hs" would be invalid on Windows. +-- +-- >>> traverse_ test ["foo/bar/quu", "a/b.hs", "foo./bar.hs"] +-- Nothing; Nothing +-- Nothing; Nothing +-- Nothing; Nothing +-- +-- Trailing slash is not allowed for files, for directories it is ok. +-- +-- >>> test "foo/" +-- Nothing; Just "trailing slash" +-- +-- Leading @./@ is fine, but @.@ and @./@ are not valid files. +-- +-- >>> traverse_ test [".", "./", "./foo/bar"] +-- Nothing; Just "trailing dot segment" +-- Nothing; Just "trailing slash" +-- Nothing; Nothing +-- +-- Lastly, not good file nor directory cases: +-- +-- >>> traverse_ test ["", "/tmp/src", "foo//bar", "foo/.", "foo/./bar", "foo/../bar"] +-- Just "empty path"; Just "empty path" +-- Just "posix absolute path"; Just "posix absolute path" +-- Just "empty path segment"; Just "empty path segment" +-- Just "trailing same directory segment: ."; Just "trailing same directory segment: ." +-- Just "same directory segment: ."; Just "same directory segment: ." +-- Just "parent directory segment: .."; Just "parent directory segment: .." +-- +-- For the last case, 'isGoodRelativeGlob' doesn't warn: +-- +-- >>> traverse_ (print . isGoodRelativeGlob) ["foo/../bar"] +-- Just "parent directory segment: .." +isGoodRelativeFilePath :: FilePath -> Maybe String +isGoodRelativeFilePath = state0 + where + -- initial state + state0 [] = Just "empty path" + state0 (c : cs) + | c == '.' = state1 cs + | c == '/' = Just "posix absolute path" + | otherwise = state5 cs + + -- after initial . + state1 [] = Just "trailing dot segment" + state1 (c : cs) + | c == '.' = state4 cs + | c == '/' = state2 cs + | otherwise = state5 cs + + -- after ./ or after / between segments + state2 [] = Just "trailing slash" + state2 (c : cs) + | c == '.' = state3 cs + | c == '/' = Just "empty path segment" + | otherwise = state5 cs + + -- after non-first segment's . + state3 [] = Just "trailing same directory segment: ." + state3 (c : cs) + | c == '.' = state4 cs + | c == '/' = Just "same directory segment: ." + | otherwise = state5 cs + + -- after .. + state4 [] = Just "trailing parent directory segment: .." + state4 (c : cs) + | c == '.' = state5 cs + | c == '/' = Just "parent directory segment: .." + | otherwise = state5 cs + + -- in a segment which is ok. + state5 [] = Nothing + state5 (c : cs) + | c == '.' = state5 cs + | c == '/' = state2 cs + | otherwise = state5 cs + +-- | See 'isGoodRelativeFilePath'. +-- +-- This is barebones function. We check whether the glob is a valid file +-- by replacing stars @*@ with @x@ses. +isGoodRelativeGlob :: FilePath -> Maybe String +isGoodRelativeGlob = isGoodRelativeFilePath . map f + where + f '*' = 'x' + f c = c + +-- | See 'isGoodRelativeFilePath'. +isGoodRelativeDirectoryPath :: FilePath -> Maybe String +isGoodRelativeDirectoryPath = state0 + where + -- initial state + state0 [] = Just "empty path" + state0 (c : cs) + | c == '.' = state5 cs + | c == '/' = Just "posix absolute path" + | otherwise = state4 cs + + -- after initial ./ or after / between segments + state1 [] = Nothing + state1 (c : cs) + | c == '.' = state2 cs + | c == '/' = Just "empty path segment" + | otherwise = state4 cs + + -- after non-first setgment's . + state2 [] = Just "trailing same directory segment: ." + state2 (c : cs) + | c == '.' = state3 cs + | c == '/' = Just "same directory segment: ." + | otherwise = state4 cs + + -- after .. + state3 [] = Just "trailing parent directory segment: .." + state3 (c : cs) + | c == '.' = state4 cs + | c == '/' = Just "parent directory segment: .." + | otherwise = state4 cs + + -- in a segment which is ok. + state4 [] = Nothing + state4 (c : cs) + | c == '.' = state4 cs + | c == '/' = state1 cs + | otherwise = state4 cs + + -- after initial . + state5 [] = Nothing -- "." + state5 (c : cs) + | c == '.' = state3 cs + | c == '/' = state1 cs + | otherwise = state4 cs + +-- [Note: Good relative paths] +-- +-- Using @kleene@ we can define an extended regex: +-- +-- @ +-- import Algebra.Lattice +-- import Kleene +-- import Kleene.ERE (ERE (..), intersections) +-- +-- data C = CDot | CSlash | CChar +-- deriving (Eq, Ord, Enum, Bounded, Show) +-- +-- reservedR :: ERE C +-- reservedR = notChar CSlash +-- +-- pathPieceR :: ERE C +-- pathPieceR = intersections +-- [ plus reservedR +-- , ERENot (string [CDot]) +-- , ERENot (string [CDot,CDot]) +-- ] +-- +-- filePathR :: ERE C +-- filePathR = optional (string [CDot, CSlash]) <> pathPieceR <> star (char CSlash <> pathPieceR) +-- +-- dirPathR :: ERE C +-- dirPathR = (char CDot \/ filePathR) <> optional (char CSlash) +-- +-- plus :: ERE C -> ERE C +-- plus r = r <> star r +-- +-- optional :: ERE C -> ERE C +-- optional r = mempty \/ r +-- @ +-- +-- Results in following state machine for @filePathR@ +-- +-- @ +-- 0 -> \x -> if +-- | x <= CDot -> 1 +-- | otherwise -> 5 +-- 1 -> \x -> if +-- | x <= CDot -> 4 +-- | x <= CSlash -> 2 +-- | otherwise -> 5 +-- 2 -> \x -> if +-- | x <= CDot -> 3 +-- | otherwise -> 5 +-- 3 -> \x -> if +-- | x <= CDot -> 4 +-- | otherwise -> 5 +-- 4 -> \x -> if +-- | x <= CDot -> 5 +-- | otherwise -> 5 +-- 5+ -> \x -> if +-- | x <= CDot -> 5 +-- | x <= CSlash -> 2 +-- | otherwise -> 5 +-- @ +-- +-- and @dirPathR@: +-- +-- @ +-- 0 -> \x -> if +-- | x <= CDot -> 5 +-- | otherwise -> 4 +-- 1+ -> \x -> if +-- | x <= CDot -> 2 +-- | otherwise -> 4 +-- 2 -> \x -> if +-- | x <= CDot -> 3 +-- | otherwise -> 4 +-- 3 -> \x -> if +-- | x <= CDot -> 4 +-- | otherwise -> 4 +-- 4+ -> \x -> if +-- | x <= CDot -> 4 +-- | x <= CSlash -> 1 +-- | otherwise -> 4 +-- 5+ -> \x -> if +-- | x <= CDot -> 3 +-- | x <= CSlash -> 1 +-- | otherwise -> 4 +-- @ diff --git a/Cabal/src/Distribution/PackageDescription/Check/Target.hs b/Cabal/src/Distribution/PackageDescription/Check/Target.hs new file mode 100644 index 00000000000..99ae5a8d379 --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Target.hs @@ -0,0 +1,1050 @@ +-- | +-- Module : Distribution.PackageDescription.Check.Target +-- Copyright : Lennart Kolmodin 2008, Francesco Ariis 2023 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Fully-realised target (library, executable, …) checking functions. +module Distribution.PackageDescription.Check.Target + ( checkLibrary + , checkForeignLib + , checkExecutable + , checkTestSuite + , checkBenchmark + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.CabalSpecVersion +import Distribution.Compat.Lens +import Distribution.Compiler +import Distribution.ModuleName (ModuleName) +import Distribution.Package +import Distribution.PackageDescription +import Distribution.PackageDescription.Check.Common +import Distribution.PackageDescription.Check.Monad +import Distribution.PackageDescription.Check.Paths +import Distribution.Pretty (prettyShow) +import Distribution.Simple.BuildPaths + ( autogenPackageInfoModuleName + , autogenPathsModuleName + ) +import Distribution.Simple.Utils hiding (findPackageDesc, notice) +import Distribution.Types.PackageName.Magic +import Distribution.Utils.Path +import Distribution.Version +import Language.Haskell.Extension +import System.FilePath (takeExtension) + +import Control.Monad + +import qualified Distribution.Types.BuildInfo.Lens as L + +checkLibrary + :: Monad m + => Bool -- Is this a sublibrary? + -> [AssocDep] -- “Inherited” dependencies for PVP checks. + -> Library + -> CheckM m () +checkLibrary + isSub + ads + lib@( Library + libName_ + _exposedModules_ + reexportedModules_ + signatures_ + _libExposed_ + _libVisibility_ + libBuildInfo_ + ) = do + checkP + (libName_ == LMainLibName && isSub) + (PackageBuildImpossible UnnamedInternal) + -- TODO: bogus if a required-signature was passed through. + checkP + (null (explicitLibModules lib) && null reexportedModules_) + (PackageDistSuspiciousWarn (NoModulesExposed libName_)) + -- TODO parse-caught check, can safely remove. + checkSpecVer + CabalSpecV2_0 + (not . null $ signatures_) + (PackageDistInexcusable SignaturesCabal2) + -- autogen/includes checks. + checkP + ( not $ + all + (flip elem (explicitLibModules lib)) + (libModulesAutogen lib) + ) + (PackageBuildImpossible AutogenNotExposed) + -- check that all autogen-includes appear on includes or + -- install-includes. + checkP + ( not $ + all + (flip elem (allExplicitIncludes lib)) + (view L.autogenIncludes lib) + ) + $ (PackageBuildImpossible AutogenIncludesNotIncluded) + + -- § Build infos. + checkBuildInfo + (CETLibrary libName_) + (explicitLibModules lib) + ads + libBuildInfo_ + + -- Feature checks. + -- check use of reexported-modules sections + checkSpecVer + CabalSpecV1_22 + (not . null $ reexportedModules_) + (PackageDistInexcusable CVReexported) + where + allExplicitIncludes :: L.HasBuildInfo a => a -> [FilePath] + allExplicitIncludes x = + view L.includes x + ++ view L.installIncludes x + +checkForeignLib :: Monad m => ForeignLib -> CheckM m () +checkForeignLib + ( ForeignLib + foreignLibName_ + _foreignLibType_ + _foreignLibOptions_ + foreignLibBuildInfo_ + _foreignLibVersionInfo_ + _foreignLibVersionLinux_ + _foreignLibModDefFile_ + ) = do + checkBuildInfo + (CETForeignLibrary foreignLibName_) + [] + [] + foreignLibBuildInfo_ + +checkExecutable + :: Monad m + => [AssocDep] -- “Inherited” dependencies for PVP checks. + -> Executable + -> CheckM m () +checkExecutable + ads + exe@( Executable + exeName_ + modulePath_ + _exeScope_ + buildInfo_ + ) = do + -- Target type/name (exe). + let cet = CETExecutable exeName_ + + -- § Exe specific checks + checkP + (null modulePath_) + (PackageBuildImpossible (NoMainIs exeName_)) + -- This check does not apply to scripts. + pid <- asksCM (pnPackageId . ccNames) + checkP + ( pid /= fakePackageId + && not (null modulePath_) + && not (fileExtensionSupportedLanguage $ modulePath_) + ) + (PackageBuildImpossible NoHsLhsMain) + + -- § Features check + checkSpecVer + CabalSpecV1_18 + ( fileExtensionSupportedLanguage modulePath_ + && takeExtension modulePath_ `notElem` [".hs", ".lhs"] + ) + (PackageDistInexcusable MainCCabal1_18) + + -- Alas exeModules ad exeModulesAutogen (exported from + -- Distribution.Types.Executable) take `Executable` as a parameter. + checkP + (not $ all (flip elem (exeModules exe)) (exeModulesAutogen exe)) + (PackageBuildImpossible $ AutogenNoOther cet) + checkP + ( not $ + all + (flip elem (view L.includes exe)) + (view L.autogenIncludes exe) + ) + (PackageBuildImpossible AutogenIncludesNotIncludedExe) + + -- § Build info checks. + checkBuildInfo cet [] ads buildInfo_ + +checkTestSuite + :: Monad m + => [AssocDep] -- “Inherited” dependencies for PVP checks. + -> TestSuite + -> CheckM m () +checkTestSuite + ads + ts@( TestSuite + testName_ + testInterface_ + testBuildInfo_ + _testCodeGenerators_ + ) = do + -- Target type/name (test). + let cet = CETTest testName_ + + -- § TS specific checks. + -- TODO caught by the parser, can remove safely + case testInterface_ of + TestSuiteUnsupported tt@(TestTypeUnknown _ _) -> + tellP (PackageBuildWarning $ TestsuiteTypeNotKnown tt) + TestSuiteUnsupported tt -> + tellP (PackageBuildWarning $ TestsuiteNotSupported tt) + _ -> return () + checkP + mainIsWrongExt + (PackageBuildImpossible NoHsLhsMain) + checkP + ( not $ + all + (flip elem (testModules ts)) + (testModulesAutogen ts) + ) + (PackageBuildImpossible $ AutogenNoOther cet) + checkP + ( not $ + all + (flip elem (view L.includes ts)) + (view L.autogenIncludes ts) + ) + (PackageBuildImpossible AutogenIncludesNotIncludedExe) + + -- § Feature checks. + checkSpecVer + CabalSpecV1_18 + (mainIsNotHsExt && not mainIsWrongExt) + (PackageDistInexcusable MainCCabal1_18) + + -- § Build info checks. + checkBuildInfo cet [] ads testBuildInfo_ + where + mainIsWrongExt = + case testInterface_ of + TestSuiteExeV10 _ f -> not (fileExtensionSupportedLanguage f) + _ -> False + + mainIsNotHsExt = + case testInterface_ of + TestSuiteExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"] + _ -> False + +checkBenchmark + :: Monad m + => [AssocDep] -- “Inherited” dependencies for PVP checks. + -> Benchmark + -> CheckM m () +checkBenchmark + ads + bm@( Benchmark + benchmarkName_ + benchmarkInterface_ + benchmarkBuildInfo_ + ) = do + -- Target type/name (benchmark). + let cet = CETBenchmark benchmarkName_ + + -- § Interface & bm specific tests. + case benchmarkInterface_ of + BenchmarkUnsupported tt@(BenchmarkTypeUnknown _ _) -> + tellP (PackageBuildWarning $ BenchmarkTypeNotKnown tt) + BenchmarkUnsupported tt -> + tellP (PackageBuildWarning $ BenchmarkNotSupported tt) + _ -> return () + checkP + mainIsWrongExt + (PackageBuildImpossible NoHsLhsMainBench) + + checkP + ( not $ + all + (flip elem (benchmarkModules bm)) + (benchmarkModulesAutogen bm) + ) + (PackageBuildImpossible $ AutogenNoOther cet) + + checkP + ( not $ + all + (flip elem (view L.includes bm)) + (view L.autogenIncludes bm) + ) + (PackageBuildImpossible AutogenIncludesNotIncludedExe) + + -- § BuildInfo checks. + checkBuildInfo cet [] ads benchmarkBuildInfo_ + where + -- Cannot abstract with similar function in checkTestSuite, + -- they are different. + mainIsWrongExt = + case benchmarkInterface_ of + BenchmarkExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"] + _ -> False + +-- ------------------------------------------------------------ +-- Build info +-- ------------------------------------------------------------ + +-- Check a great deal of things in buildInfo. +-- With 'checkBuildInfo' we cannot follow the usual “pattern match +-- everything” method, for the number of BuildInfo fields (almost 50) +-- but more importantly because accessing options, etc. is done +-- with functions from 'Distribution.Types.BuildInfo' (e.g. 'hcOptions'). +-- Duplicating the effort here means risk of diverging definitions for +-- little gain (most likely if a field is added to BI, the relevant +-- function will be tweaked in Distribution.Types.BuildInfo too). +checkBuildInfo + :: Monad m + => CEType -- Name and type of the target. + -> [ModuleName] -- Additional module names which cannot be + -- extracted from BuildInfo (mainly: exposed + -- library modules). + -> [AssocDep] -- Inherited “internal” (main lib, named + -- internal libs) dependencies. + -> BuildInfo + -> CheckM m () +checkBuildInfo cet ams ads bi = do + -- For the sake of clarity, we split che checks in various + -- (top level) functions, even if we are not actually going + -- deeper in the traversal. + + checkBuildInfoOptions (cet2bit cet) bi + checkBuildInfoPathsContent bi + checkBuildInfoPathsWellFormedness bi + + sv <- asksCM ccSpecVersion + checkBuildInfoFeatures bi sv + + checkAutogenModules ams bi + + -- PVP: we check for base and all other deps. + (ids, rds) <- + partitionDeps + ads + [mkUnqualComponentName "base"] + (mergeDependencies $ targetBuildDepends bi) + let ick = const (PackageDistInexcusable BaseNoUpperBounds) + rck = PackageDistSuspiciousWarn . MissingUpperBounds cet + checkPVP ick ids + unless + (isInternalTarget cet) + (checkPVPs rck rds) + + -- Custom fields well-formedness (ASCII). + mapM_ checkCustomField (customFieldsBI bi) + + -- Content. + mapM_ (checkLocalPathExist "extra-lib-dirs") (extraLibDirs bi) + mapM_ + (checkLocalPathExist "extra-lib-dirs-static") + (extraLibDirsStatic bi) + mapM_ + (checkLocalPathExist "extra-framework-dirs") + (extraFrameworkDirs bi) + mapM_ (checkLocalPathExist "include-dirs") (includeDirs bi) + mapM_ + (checkLocalPathExist "hs-source-dirs" . getSymbolicPath) + (hsSourceDirs bi) + +-- Well formedness of BI contents (no `Haskell2015`, no deprecated +-- extensions etc). +checkBuildInfoPathsContent :: Monad m => BuildInfo -> CheckM m () +checkBuildInfoPathsContent bi = do + mapM_ checkLang (allLanguages bi) + mapM_ checkExt (allExtensions bi) + mapM_ checkIntDep (targetBuildDepends bi) + df <- asksCM ccDesugar + -- This way we can use the same function for legacy&non exedeps. + let ds = buildToolDepends bi ++ catMaybes (map df $ buildTools bi) + mapM_ checkBTDep ds + where + checkLang :: Monad m => Language -> CheckM m () + checkLang (UnknownLanguage n) = + tellP (PackageBuildWarning (UnknownLanguages [n])) + checkLang _ = return () + + checkExt :: Monad m => Extension -> CheckM m () + checkExt (UnknownExtension n) + | n `elem` map prettyShow knownLanguages = + tellP (PackageBuildWarning (LanguagesAsExtension [n])) + | otherwise = + tellP (PackageBuildWarning (UnknownExtensions [n])) + checkExt n = do + let dss = filter (\(a, _) -> a == n) deprecatedExtensions + checkP + (not . null $ dss) + (PackageDistSuspicious $ DeprecatedExtensions dss) + + checkIntDep :: Monad m => Dependency -> CheckM m () + checkIntDep d@(Dependency name vrange _) = do + mpn <- + asksCM + ( packageNameToUnqualComponentName + . pkgName + . pnPackageId + . ccNames + ) + lns <- asksCM (pnSubLibs . ccNames) + pVer <- asksCM (pkgVersion . pnPackageId . ccNames) + let allLibNs = mpn : lns + when + ( mpn == packageNameToUnqualComponentName name + -- Make sure it is not a library with the + -- same name from another package. + && packageNameToUnqualComponentName name `elem` allLibNs + ) + ( checkP + (not $ pVer `withinRange` vrange) + (PackageBuildImpossible $ ImpossibleInternalDep [d]) + ) + + checkBTDep :: Monad m => ExeDependency -> CheckM m () + checkBTDep ed@(ExeDependency n name vrange) = do + exns <- asksCM (pnExecs . ccNames) + pVer <- asksCM (pkgVersion . pnPackageId . ccNames) + pNam <- asksCM (pkgName . pnPackageId . ccNames) + checkP + ( n == pNam + && name `notElem` exns -- internal + -- not present + ) + (PackageBuildImpossible $ MissingInternalExe [ed]) + when + (name `elem` exns) + ( checkP + (not $ pVer `withinRange` vrange) + (PackageBuildImpossible $ ImpossibleInternalExe [ed]) + ) + +-- Paths well-formedness check for BuildInfo. +checkBuildInfoPathsWellFormedness :: Monad m => BuildInfo -> CheckM m () +checkBuildInfoPathsWellFormedness bi = do + mapM_ (checkPath False "asm-sources" PathKindFile) (asmSources bi) + mapM_ (checkPath False "cmm-sources" PathKindFile) (cmmSources bi) + mapM_ (checkPath False "c-sources" PathKindFile) (cSources bi) + mapM_ (checkPath False "cxx-sources" PathKindFile) (cxxSources bi) + mapM_ (checkPath False "js-sources" PathKindFile) (jsSources bi) + mapM_ + (checkPath False "install-includes" PathKindFile) + (installIncludes bi) + mapM_ + (checkPath False "hs-source-dirs" PathKindDirectory . getSymbolicPath) + (hsSourceDirs bi) + -- Possibly absolute paths. + mapM_ (checkPath True "includes" PathKindFile) (includes bi) + mapM_ + (checkPath True "include-dirs" PathKindDirectory) + (includeDirs bi) + mapM_ + (checkPath True "extra-lib-dirs" PathKindDirectory) + (extraLibDirs bi) + mapM_ + (checkPath True "extra-lib-dirs-static" PathKindDirectory) + (extraLibDirsStatic bi) + mapM_ checkOptionPath (perCompilerFlavorToList $ options bi) + where + checkOptionPath + :: Monad m + => (CompilerFlavor, [FilePath]) + -> CheckM m () + checkOptionPath (GHC, paths) = + mapM_ + ( \path -> + checkP + (isInsideDist path) + (PackageDistInexcusable $ DistPoint Nothing path) + ) + paths + checkOptionPath _ = return () + +-- Checks for features that can be present in BuildInfo only with certain +-- CabalSpecVersion. +checkBuildInfoFeatures + :: Monad m + => BuildInfo + -> CabalSpecVersion + -> CheckM m () +checkBuildInfoFeatures bi sv = do + -- Default language can be used only w/ spec ≥ 1.10 + checkSpecVer + CabalSpecV1_10 + (isJust $ defaultLanguage bi) + (PackageBuildWarning CVDefaultLanguage) + -- CheckSpecVer sv. + checkP + ( sv >= CabalSpecV1_10 + && sv < CabalSpecV3_4 + && isNothing (defaultLanguage bi) + ) + (PackageBuildWarning CVDefaultLanguageComponent) + -- Check use of 'extra-framework-dirs' field. + checkSpecVer + CabalSpecV1_24 + (not . null $ extraFrameworkDirs bi) + (PackageDistSuspiciousWarn CVExtraFrameworkDirs) + -- Check use of default-extensions field don't need to do the + -- equivalent check for other-extensions. + checkSpecVer + CabalSpecV1_10 + (not . null $ defaultExtensions bi) + (PackageBuildWarning CVDefaultExtensions) + -- Check use of extensions field + checkP + (sv >= CabalSpecV1_10 && (not . null $ oldExtensions bi)) + (PackageBuildWarning CVExtensionsDeprecated) + + -- asm-sources, cmm-sources and friends only w/ spec ≥ 1.10 + checkCVSources (asmSources bi) + checkCVSources (cmmSources bi) + checkCVSources (extraBundledLibs bi) + checkCVSources (extraLibFlavours bi) + + -- extra-dynamic-library-flavours requires ≥ 3.0 + checkSpecVer + CabalSpecV3_0 + (not . null $ extraDynLibFlavours bi) + (PackageDistInexcusable $ CVExtraDynamic [extraDynLibFlavours bi]) + -- virtual-modules requires ≥ 2.2 + checkSpecVer CabalSpecV2_2 (not . null $ virtualModules bi) $ + (PackageDistInexcusable CVVirtualModules) + -- Check use of thinning and renaming. + checkSpecVer + CabalSpecV2_0 + (not . null $ mixins bi) + (PackageDistInexcusable CVMixins) + + checkBuildInfoExtensions bi + where + checkCVSources :: Monad m => [FilePath] -> CheckM m () + checkCVSources cvs = + checkSpecVer + CabalSpecV3_0 + (not . null $ cvs) + (PackageDistInexcusable CVSources) + +-- Tests for extensions usage which can break Cabal < 1.4. +checkBuildInfoExtensions :: Monad m => BuildInfo -> CheckM m () +checkBuildInfoExtensions bi = do + let exts = allExtensions bi + extCabal1_2 = nub $ filter (`elem` compatExtensionsExtra) exts + extCabal1_4 = nub $ filter (`notElem` compatExtensions) exts + -- As of Cabal-1.4 we can add new extensions without worrying + -- about breaking old versions of cabal. + checkSpecVer + CabalSpecV1_2 + (not . null $ extCabal1_2) + ( PackageDistInexcusable $ + CVExtensions CabalSpecV1_2 extCabal1_2 + ) + checkSpecVer + CabalSpecV1_4 + (not . null $ extCabal1_4) + ( PackageDistInexcusable $ + CVExtensions CabalSpecV1_4 extCabal1_4 + ) + where + -- The known extensions in Cabal-1.2.3 + compatExtensions :: [Extension] + compatExtensions = + map + EnableExtension + [ OverlappingInstances + , UndecidableInstances + , IncoherentInstances + , RecursiveDo + , ParallelListComp + , MultiParamTypeClasses + , FunctionalDependencies + , Rank2Types + , RankNTypes + , PolymorphicComponents + , ExistentialQuantification + , ScopedTypeVariables + , ImplicitParams + , FlexibleContexts + , FlexibleInstances + , EmptyDataDecls + , CPP + , BangPatterns + , TypeSynonymInstances + , TemplateHaskell + , ForeignFunctionInterface + , Arrows + , Generics + , NamedFieldPuns + , PatternGuards + , GeneralizedNewtypeDeriving + , ExtensibleRecords + , RestrictedTypeSynonyms + , HereDocuments + ] + ++ map + DisableExtension + [MonomorphismRestriction, ImplicitPrelude] + ++ compatExtensionsExtra + + -- The extra known extensions in Cabal-1.2.3 vs Cabal-1.1.6 + -- (Cabal-1.1.6 came with ghc-6.6. Cabal-1.2 came with ghc-6.8) + compatExtensionsExtra :: [Extension] + compatExtensionsExtra = + map + EnableExtension + [ KindSignatures + , MagicHash + , TypeFamilies + , StandaloneDeriving + , UnicodeSyntax + , PatternSignatures + , UnliftedFFITypes + , LiberalTypeSynonyms + , TypeOperators + , RecordWildCards + , RecordPuns + , DisambiguateRecordFields + , OverloadedStrings + , GADTs + , RelaxedPolyRec + , ExtendedDefaultRules + , UnboxedTuples + , DeriveDataTypeable + , ConstrainedClassMethods + ] + ++ map + DisableExtension + [MonoPatBinds] + +-- Autogenerated modules (Paths_, PackageInfo_) checks. We could pass this +-- function something more specific than the whole BuildInfo, but it would be +-- a tuple of [ModuleName] lists, error prone. +checkAutogenModules + :: Monad m + => [ModuleName] -- Additional modules not present + -- in BuildInfo (e.g. exposed library + -- modules). + -> BuildInfo + -> CheckM m () +checkAutogenModules ams bi = do + pkgId <- asksCM (pnPackageId . ccNames) + let + -- It is an unfortunate reality that autogenPathsModuleName + -- and autogenPackageInfoModuleName work on PackageDescription + -- while not needing it all, but just the `package` bit. + minimalPD = emptyPackageDescription{package = pkgId} + autoPathsName = autogenPathsModuleName minimalPD + autoInfoModuleName = autogenPackageInfoModuleName minimalPD + + -- Autogenerated module + some default extension build failure. + autogenCheck autoPathsName CVAutogenPaths + rebindableClashCheck autoPathsName RebindableClashPaths + + -- Paths_* module + some default extension build failure. + autogenCheck autoInfoModuleName CVAutogenPackageInfo + rebindableClashCheck autoInfoModuleName RebindableClashPackageInfo + where + autogenCheck + :: Monad m + => ModuleName + -> CheckExplanation + -> CheckM m () + autogenCheck name warning = do + sv <- asksCM ccSpecVersion + let allModsForAuto = ams ++ otherModules bi + checkP + ( sv >= CabalSpecV2_0 + && elem name allModsForAuto + && notElem name (autogenModules bi) + ) + (PackageDistInexcusable warning) + + rebindableClashCheck + :: Monad m + => ModuleName + -> CheckExplanation + -> CheckM m () + rebindableClashCheck name warning = do + checkSpecVer + CabalSpecV2_2 + ( ( name `elem` otherModules bi + || name `elem` autogenModules bi + ) + && checkExts + ) + (PackageBuildImpossible warning) + + -- Do we have some peculiar extensions active which would interfere + -- (cabal-version <2.2) with Paths_modules? + checkExts :: Bool + checkExts = + let exts = defaultExtensions bi + in rebind `elem` exts + && (strings `elem` exts || lists `elem` exts) + where + rebind = EnableExtension RebindableSyntax + strings = EnableExtension OverloadedStrings + lists = EnableExtension OverloadedLists + +checkLocalPathExist + :: Monad m + => String -- .cabal field where we found the error. + -> FilePath + -> CheckM m () +checkLocalPathExist title dir = + checkPkg + ( \ops -> do + dn <- not <$> doesDirectoryExist ops dir + let rp = not (isAbsoluteOnAnyPlatform dir) + return (rp && dn) + ) + (PackageBuildWarning $ UnknownDirectory title dir) + +-- PVP -- + +-- Sometimes we read (or end up with) “straddle” deps declarations +-- like this: +-- +-- build-depends: base > 3, base < 4 +-- +-- `mergeDependencies` reduces that to base > 3 && < 4, _while_ maintaining +-- dependencies order in the list (better UX). +mergeDependencies :: [Dependency] -> [Dependency] +mergeDependencies [] = [] +mergeDependencies l@(d : _) = + let (sames, diffs) = partition ((== depName d) . depName) l + merged = + Dependency + (depPkgName d) + ( foldl intersectVersionRanges anyVersion $ + map depVerRange sames + ) + (depLibraries d) + in merged : mergeDependencies diffs + where + depName :: Dependency -> String + depName wd = unPackageName . depPkgName $ wd + +-- Is this an internal target? We do not perform PVP checks on those, +-- see https://github.com/haskell/cabal/pull/8361#issuecomment-1577547091 +isInternalTarget :: CEType -> Bool +isInternalTarget (CETLibrary{}) = False +isInternalTarget (CETForeignLibrary{}) = False +isInternalTarget (CETExecutable{}) = False +isInternalTarget (CETTest{}) = True +isInternalTarget (CETBenchmark{}) = True +isInternalTarget (CETSetup{}) = False + +-- ------------------------------------------------------------ +-- Options +-- ------------------------------------------------------------ + +-- Target type for option checking. +data BITarget = BITLib | BITTestBench | BITOther + deriving (Eq, Show) + +cet2bit :: CEType -> BITarget +cet2bit (CETLibrary{}) = BITLib +cet2bit (CETForeignLibrary{}) = BITLib +cet2bit (CETExecutable{}) = BITOther +cet2bit (CETTest{}) = BITTestBench +cet2bit (CETBenchmark{}) = BITTestBench +cet2bit CETSetup = BITOther + +-- General check on all options (ghc, C, C++, …) for common inaccuracies. +checkBuildInfoOptions :: Monad m => BITarget -> BuildInfo -> CheckM m () +checkBuildInfoOptions t bi = do + checkGHCOptions "ghc-options" t (hcOptions GHC bi) + checkGHCOptions "ghc-prof-options" t (hcProfOptions GHC bi) + checkGHCOptions "ghc-shared-options" t (hcSharedOptions GHC bi) + let ldOpts = ldOptions bi + checkCLikeOptions LangC "cc-options" (ccOptions bi) ldOpts + checkCLikeOptions LangCPlusPlus "cxx-options" (cxxOptions bi) ldOpts + checkCPPOptions (cppOptions bi) + +-- | Checks GHC options for commonly misused or non-portable flags. +checkGHCOptions + :: Monad m + => CabalField -- .cabal field name where we found the error. + -> BITarget -- Target type. + -> [String] -- Options (alas in String form). + -> CheckM m () +checkGHCOptions title t opts = do + checkGeneral + case t of + BITLib -> sequence_ [checkLib, checkNonTestBench] + BITTestBench -> checkTestBench + BITOther -> checkNonTestBench + where + checkFlags :: Monad m => [String] -> PackageCheck -> CheckM m () + checkFlags fs ck = checkP (any (`elem` fs) opts) ck + + checkFlagsP + :: Monad m + => (String -> Bool) + -> (String -> PackageCheck) + -> CheckM m () + checkFlagsP p ckc = + case filter p opts of + [] -> return () + (_ : _) -> tellP (ckc title) + + checkGeneral = do + checkFlags + ["-fasm"] + (PackageDistInexcusable $ OptFasm title) + checkFlags + ["-fhpc"] + (PackageDistInexcusable $ OptHpc title) + checkFlags + ["-prof"] + (PackageBuildWarning $ OptProf title) + -- Does not apply to scripts. + -- Why do we need this? See #8963. + pid <- asksCM (pnPackageId . ccNames) + unless (pid == fakePackageId) $ + checkFlags + ["-o"] + (PackageBuildWarning $ OptO title) + checkFlags + ["-hide-package"] + (PackageBuildWarning $ OptHide title) + checkFlags + ["--make"] + (PackageBuildWarning $ OptMake title) + checkFlags + ["-O", "-O1"] + (PackageDistInexcusable $ OptOOne title) + checkFlags + ["-O2"] + (PackageDistSuspiciousWarn $ OptOTwo title) + checkFlags + ["-split-sections"] + (PackageBuildWarning $ OptSplitSections title) + checkFlags + ["-split-objs"] + (PackageBuildWarning $ OptSplitObjs title) + checkFlags + ["-optl-Wl,-s", "-optl-s"] + (PackageDistInexcusable $ OptWls title) + checkFlags + ["-fglasgow-exts"] + (PackageDistSuspicious $ OptExts title) + let ghcNoRts = rmRtsOpts opts + checkAlternatives + title + "extensions" + [ (flag, prettyShow extension) + | flag <- ghcNoRts + , Just extension <- [ghcExtension flag] + ] + checkAlternatives + title + "extensions" + [ (flag, extension) + | flag@('-' : 'X' : extension) <- ghcNoRts + ] + checkAlternatives + title + "cpp-options" + ( [(flag, flag) | flag@('-' : 'D' : _) <- ghcNoRts] + ++ [(flag, flag) | flag@('-' : 'U' : _) <- ghcNoRts] + ) + checkAlternatives + title + "include-dirs" + [(flag, dir) | flag@('-' : 'I' : dir) <- ghcNoRts] + checkAlternatives + title + "extra-libraries" + [(flag, lib) | flag@('-' : 'l' : lib) <- ghcNoRts] + checkAlternatives + title + "extra-libraries-static" + [(flag, lib) | flag@('-' : 'l' : lib) <- ghcNoRts] + checkAlternatives + title + "extra-lib-dirs" + [(flag, dir) | flag@('-' : 'L' : dir) <- ghcNoRts] + checkAlternatives + title + "extra-lib-dirs-static" + [(flag, dir) | flag@('-' : 'L' : dir) <- ghcNoRts] + checkAlternatives + title + "frameworks" + [ (flag, fmwk) + | (flag@"-framework", fmwk) <- + zip ghcNoRts (safeTail ghcNoRts) + ] + checkAlternatives + title + "extra-framework-dirs" + [ (flag, dir) + | (flag@"-framework-path", dir) <- + zip ghcNoRts (safeTail ghcNoRts) + ] + -- Old `checkDevelopmentOnlyFlagsOptions` section + checkFlags + ["-Werror"] + (PackageDistInexcusable $ WErrorUnneeded title) + checkFlags + ["-fdefer-type-errors"] + (PackageDistInexcusable $ FDeferTypeErrorsUnneeded title) + checkFlags + [ "-fprof-auto" + , "-fprof-auto-top" + , "-fprof-auto-calls" + , "-fprof-cafs" + , "-fno-prof-count-entries" + , "-auto-all" + , "-auto" + , "-caf-all" + ] + (PackageDistSuspicious $ ProfilingUnneeded title) + checkFlagsP + ( \opt -> + "-d" `isPrefixOf` opt + && opt /= "-dynamic" + ) + (PackageDistInexcusable . DynamicUnneeded) + checkFlagsP + ( \opt -> case opt of + "-j" -> True + ('-' : 'j' : d : _) -> isDigit d + _ -> False + ) + (PackageDistInexcusable . JUnneeded) + + checkLib = do + checkP + ("-rtsopts" `elem` opts) + (PackageBuildWarning $ OptRts title) + checkP + (any (\opt -> "-with-rtsopts" `isPrefixOf` opt) opts) + (PackageBuildWarning $ OptWithRts title) + + checkTestBench = do + checkFlags + ["-O0", "-Onot"] + (PackageDistSuspiciousWarn $ OptONot title) + + checkNonTestBench = do + checkFlags + ["-O0", "-Onot"] + (PackageDistSuspicious $ OptONot title) + + ghcExtension ('-' : 'f' : name) = case name of + "allow-overlapping-instances" -> enable OverlappingInstances + "no-allow-overlapping-instances" -> disable OverlappingInstances + "th" -> enable TemplateHaskell + "no-th" -> disable TemplateHaskell + "ffi" -> enable ForeignFunctionInterface + "no-ffi" -> disable ForeignFunctionInterface + "fi" -> enable ForeignFunctionInterface + "no-fi" -> disable ForeignFunctionInterface + "monomorphism-restriction" -> enable MonomorphismRestriction + "no-monomorphism-restriction" -> disable MonomorphismRestriction + "mono-pat-binds" -> enable MonoPatBinds + "no-mono-pat-binds" -> disable MonoPatBinds + "allow-undecidable-instances" -> enable UndecidableInstances + "no-allow-undecidable-instances" -> disable UndecidableInstances + "allow-incoherent-instances" -> enable IncoherentInstances + "no-allow-incoherent-instances" -> disable IncoherentInstances + "arrows" -> enable Arrows + "no-arrows" -> disable Arrows + "generics" -> enable Generics + "no-generics" -> disable Generics + "implicit-prelude" -> enable ImplicitPrelude + "no-implicit-prelude" -> disable ImplicitPrelude + "implicit-params" -> enable ImplicitParams + "no-implicit-params" -> disable ImplicitParams + "bang-patterns" -> enable BangPatterns + "no-bang-patterns" -> disable BangPatterns + "scoped-type-variables" -> enable ScopedTypeVariables + "no-scoped-type-variables" -> disable ScopedTypeVariables + "extended-default-rules" -> enable ExtendedDefaultRules + "no-extended-default-rules" -> disable ExtendedDefaultRules + _ -> Nothing + ghcExtension "-cpp" = enable CPP + ghcExtension _ = Nothing + + enable e = Just (EnableExtension e) + disable e = Just (DisableExtension e) + + rmRtsOpts :: [String] -> [String] + rmRtsOpts ("-with-rtsopts" : _ : xs) = rmRtsOpts xs + rmRtsOpts (x : xs) = x : rmRtsOpts xs + rmRtsOpts [] = [] + +checkCLikeOptions + :: Monad m + => WarnLang -- Language we are warning about (C or C++). + -> CabalField -- Field where we found the error. + -> [String] -- Options in string form. + -> [String] -- Link options in String form. + -> CheckM m () +checkCLikeOptions label prefix opts ldOpts = do + checkAlternatives + prefix + "include-dirs" + [(flag, dir) | flag@('-' : 'I' : dir) <- opts] + checkAlternatives + prefix + "extra-libraries" + [(flag, lib) | flag@('-' : 'l' : lib) <- opts] + checkAlternatives + prefix + "extra-lib-dirs" + [(flag, dir) | flag@('-' : 'L' : dir) <- opts] + + checkAlternatives + "ld-options" + "extra-libraries" + [(flag, lib) | flag@('-' : 'l' : lib) <- ldOpts] + checkAlternatives + "ld-options" + "extra-lib-dirs" + [(flag, dir) | flag@('-' : 'L' : dir) <- ldOpts] + + checkP + (any (`elem` ["-O", "-Os", "-O0", "-O1", "-O2", "-O3"]) opts) + (PackageDistSuspicious $ COptONumber prefix label) + +checkAlternatives + :: Monad m + => CabalField -- Wrong field. + -> CabalField -- Appropriate field. + -> [(String, String)] -- List of good and bad flags. + -> CheckM m () +checkAlternatives badField goodField flags = do + let (badFlags, _) = unzip flags + checkP + (not $ null badFlags) + (PackageBuildWarning $ OptAlternatives badField goodField flags) + +checkCPPOptions + :: Monad m + => [String] -- Options in String form. + -> CheckM m () +checkCPPOptions opts = do + checkAlternatives + "cpp-options" + "include-dirs" + [(flag, dir) | flag@('-' : 'I' : dir) <- opts] + mapM_ + ( \opt -> + checkP + (not $ any (`isPrefixOf` opt) ["-D", "-U", "-I"]) + (PackageBuildWarning (COptCPP opt)) + ) + opts diff --git a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs new file mode 100644 index 00000000000..a8d9ac78195 --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs @@ -0,0 +1,1009 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | +-- Module : Distribution.PackageDescription.Check.Warning +-- Copyright : Francesco Ariis 2022 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Warning types, messages, severity and associated functions. +module Distribution.PackageDescription.Check.Warning + ( -- * Types and constructors + PackageCheck (..) + , CheckExplanation (..) + , CEField (..) + , CEType (..) + , WarnLang (..) + + -- * Operations + , ppPackageCheck + , isHackageDistError + , extractCheckExplantion + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.CabalSpecVersion (CabalSpecVersion, showCabalSpecVersion) +import Distribution.License (License, knownLicenses) +import Distribution.ModuleName (ModuleName) +import Distribution.Parsec.Warning (PWarning, showPWarning) +import Distribution.Pretty (prettyShow) +import Distribution.Types.BenchmarkType (BenchmarkType, knownBenchmarkTypes) +import Distribution.Types.Dependency (Dependency (..)) +import Distribution.Types.ExeDependency (ExeDependency) +import Distribution.Types.Flag (FlagName, unFlagName) +import Distribution.Types.LibraryName (LibraryName (..), showLibraryName) +import Distribution.Types.PackageName (PackageName) +import Distribution.Types.TestType (TestType, knownTestTypes) +import Distribution.Types.UnqualComponentName +import Distribution.Types.Version (Version) +import Distribution.Utils.Path + ( LicenseFile + , PackageDir + , SymbolicPath + , getSymbolicPath + ) +import Language.Haskell.Extension (Extension) + +import qualified Data.List as List +import qualified Data.Set as Set + +-- ------------------------------------------------------------ +-- Check types and explanations +-- ------------------------------------------------------------ + +-- | Results of some kind of failed package check. +-- +-- There are a range of severities, from merely dubious to totally insane. +-- All of them come with a human readable explanation. In future we may augment +-- them with more machine readable explanations, for example to help an IDE +-- suggest automatic corrections. +data PackageCheck + = -- | This package description is no good. There's no way it's going to + -- build sensibly. This should give an error at configure time. + PackageBuildImpossible {explanation :: CheckExplanation} + | -- | A problem that is likely to affect building the package, or an + -- issue that we'd like every package author to be aware of, even if + -- the package is never distributed. + PackageBuildWarning {explanation :: CheckExplanation} + | -- | An issue that might not be a problem for the package author but + -- might be annoying or detrimental when the package is distributed to + -- users. We should encourage distributed packages to be free from these + -- issues, but occasionally there are justifiable reasons so we cannot + -- ban them entirely. + PackageDistSuspicious {explanation :: CheckExplanation} + | -- | Like PackageDistSuspicious but will only display warnings + -- rather than causing abnormal exit when you run 'cabal check'. + PackageDistSuspiciousWarn {explanation :: CheckExplanation} + | -- | An issue that is OK in the author's environment but is almost + -- certain to be a portability problem for other environments. We can + -- quite legitimately refuse to publicly distribute packages with these + -- problems. + PackageDistInexcusable {explanation :: CheckExplanation} + deriving (Eq, Ord) + +-- | Pretty printing 'PackageCheck'. +ppPackageCheck :: PackageCheck -> String +ppPackageCheck e = ppExplanation (explanation e) + +-- | Broken 'Show' instance (not bijective with Read), alas external packages +-- depend on it. +instance Show PackageCheck where + show notice = ppPackageCheck notice + +-- | Would Hackage refuse a package because of this error? +isHackageDistError :: PackageCheck -> Bool +isHackageDistError = \case + (PackageBuildImpossible{}) -> True + (PackageBuildWarning{}) -> True + (PackageDistInexcusable{}) -> True + (PackageDistSuspicious{}) -> False + (PackageDistSuspiciousWarn{}) -> False + +-- | Explanations of 'PackageCheck`'s errors/warnings. +-- +-- ☞ N.B: if you add a constructor here, remeber to change the documentation +-- in @doc/cabal-commands.rst@! Same if you modify it, you need to adjust the +-- documentation! +data CheckExplanation + = ParseWarning FilePath PWarning + | NoNameField + | NoVersionField + | NoTarget + | UnnamedInternal + | DuplicateSections [UnqualComponentName] + | IllegalLibraryName PackageName + | NoModulesExposed LibraryName + | SignaturesCabal2 + | AutogenNotExposed + | AutogenIncludesNotIncluded + | NoMainIs UnqualComponentName + | NoHsLhsMain + | MainCCabal1_18 + | AutogenNoOther CEType + | AutogenIncludesNotIncludedExe + | TestsuiteTypeNotKnown TestType + | TestsuiteNotSupported TestType + | BenchmarkTypeNotKnown BenchmarkType + | BenchmarkNotSupported BenchmarkType + | NoHsLhsMainBench + | InvalidNameWin PackageName + | ZPrefix + | NoBuildType + | NoCustomSetup + | UnknownCompilers [String] + | UnknownLanguages [String] + | UnknownExtensions [String] + | LanguagesAsExtension [String] + | DeprecatedExtensions [(Extension, Maybe Extension)] + | MissingField CEField + | SynopsisTooLong + | ShortDesc + | InvalidTestWith [Dependency] + | ImpossibleInternalDep [Dependency] + | ImpossibleInternalExe [ExeDependency] + | MissingInternalExe [ExeDependency] + | NONELicense + | NoLicense + | AllRightsReservedLicense + | LicenseMessParse License + | UnrecognisedLicense String + | UncommonBSD4 + | UnknownLicenseVersion License [Version] + | NoLicenseFile + | UnrecognisedSourceRepo String + | MissingType + | MissingLocation + | MissingModule + | MissingTag + | SubdirRelPath + | SubdirGoodRelPath String + | OptFasm String + | OptHpc String + | OptProf String + | OptO String + | OptHide String + | OptMake String + | OptONot String + | OptOOne String + | OptOTwo String + | OptSplitSections String + | OptSplitObjs String + | OptWls String + | OptExts String + | OptRts String + | OptWithRts String + | COptONumber String WarnLang + | COptCPP String + | OptAlternatives String String [(String, String)] + | RelativeOutside String FilePath + | AbsolutePath String FilePath + | BadRelativePath String FilePath String + | DistPoint (Maybe String) FilePath + | GlobSyntaxError String String + | RecursiveGlobInRoot String FilePath + | InvalidOnWin [FilePath] + | FilePathTooLong FilePath + | FilePathNameTooLong FilePath + | FilePathSplitTooLong FilePath + | FilePathEmpty + | CVTestSuite + | CVDefaultLanguage + | CVDefaultLanguageComponent + | CVExtraDocFiles + | CVMultiLib + | CVReexported + | CVMixins + | CVExtraFrameworkDirs + | CVDefaultExtensions + | CVExtensionsDeprecated + | CVSources + | CVExtraDynamic [[String]] + | CVVirtualModules + | CVSourceRepository + | CVExtensions CabalSpecVersion [Extension] + | CVCustomSetup + | CVExpliticDepsCustomSetup + | CVAutogenPaths + | CVAutogenPackageInfo + | GlobNoMatch String String + | GlobExactMatch String String FilePath + | GlobNoDir String String FilePath + | UnknownOS [String] + | UnknownArch [String] + | UnknownCompiler [String] + | BaseNoUpperBounds + | MissingUpperBounds CEType [String] + | SuspiciousFlagName [String] + | DeclaredUsedFlags (Set.Set FlagName) (Set.Set FlagName) + | NonASCIICustomField [String] + | RebindableClashPaths + | RebindableClashPackageInfo + | WErrorUnneeded String + | JUnneeded String + | FDeferTypeErrorsUnneeded String + | DynamicUnneeded String + | ProfilingUnneeded String + | UpperBoundSetup String + | DuplicateModule String [ModuleName] + | PotentialDupModule String [ModuleName] + | BOMStart FilePath + | NotPackageName FilePath String + | NoDesc + | MultiDesc [String] + | UnknownFile String (SymbolicPath PackageDir LicenseFile) + | MissingSetupFile + | MissingConfigureScript + | UnknownDirectory String FilePath + | MissingSourceControl + | MissingExpectedDocFiles Bool [FilePath] + | WrongFieldForExpectedDocFiles Bool String [FilePath] + deriving (Eq, Ord, Show) + +-- TODO Some checks have a constructor in list form +-- (e.g. `SomeWarn [n]`), CheckM m () correctly catches warnings in +-- different stanzas in different checks (so it is not one soup). +-- +-- Ideally [SomeWar [a], SomeWar [b]] would be translated into +-- SomeWar [a,b] in the few cases where it is appropriate for UX +-- and left separated otherwise. +-- To achieve this the Writer part of CheckM could be modified +-- to be a ad hoc monoid. + +-- Convenience. +extractCheckExplantion :: PackageCheck -> CheckExplanation +extractCheckExplantion (PackageBuildImpossible e) = e +extractCheckExplantion (PackageBuildWarning e) = e +extractCheckExplantion (PackageDistSuspicious e) = e +extractCheckExplantion (PackageDistSuspiciousWarn e) = e +extractCheckExplantion (PackageDistInexcusable e) = e + +-- | Which stanza does `CheckExplanation` refer to? +data CEType + = CETLibrary LibraryName + | CETForeignLibrary UnqualComponentName + | CETExecutable UnqualComponentName + | CETTest UnqualComponentName + | CETBenchmark UnqualComponentName + | CETSetup + deriving (Eq, Ord, Show) + +-- | Pretty printing `CEType`. +ppCET :: CEType -> String +ppCET cet = case cet of + CETLibrary ln -> showLibraryName ln + CETForeignLibrary n -> "foreign library" ++ qn n + CETExecutable n -> "executable" ++ qn n + CETTest n -> "test suite" ++ qn n + CETBenchmark n -> "benchmark" ++ qn n + CETSetup -> "custom-setup" + where + qn :: UnqualComponentName -> String + qn wn = (" " ++) . quote . prettyShow $ wn + +-- | Which field does `CheckExplanation` refer to? +data CEField + = CEFCategory + | CEFMaintainer + | CEFSynopsis + | CEFDescription + | CEFSynOrDesc + deriving (Eq, Ord, Show) + +-- | Pretty printing `CEField`. +ppCEField :: CEField -> String +ppCEField CEFCategory = "category" +ppCEField CEFMaintainer = "maintainer" +ppCEField CEFSynopsis = "synopsis" +ppCEField CEFDescription = "description" +ppCEField CEFSynOrDesc = "synopsis' or 'description" + +-- | Which language are we referring to in our warning message? +data WarnLang = LangC | LangCPlusPlus + deriving (Eq, Ord, Show) + +-- | Pretty printing `WarnLang`. +ppWarnLang :: WarnLang -> String +ppWarnLang LangC = "C" +ppWarnLang LangCPlusPlus = "C++" + +-- | Pretty printing `CheckExplanation`. +ppExplanation :: CheckExplanation -> String +ppExplanation (ParseWarning fp pp) = showPWarning fp pp +ppExplanation NoNameField = "No 'name' field." +ppExplanation NoVersionField = "No 'version' field." +ppExplanation NoTarget = + "No executables, libraries, tests, or benchmarks found. Nothing to do." +ppExplanation UnnamedInternal = + "Found one or more unnamed internal libraries. Only the non-internal" + ++ " library can have the same name as the package." +ppExplanation (DuplicateSections duplicateNames) = + "Duplicate sections: " + ++ commaSep (map unUnqualComponentName duplicateNames) + ++ ". The name of every library, executable, test suite," + ++ " and benchmark section in the package must be unique." +ppExplanation (IllegalLibraryName pname) = + "Illegal internal library name " + ++ prettyShow pname + ++ ". Internal libraries cannot have the same name as the package." + ++ " Maybe you wanted a non-internal library?" + ++ " If so, rewrite the section stanza" + ++ " from 'library: '" + ++ prettyShow pname + ++ "' to 'library'." +ppExplanation (NoModulesExposed lName) = + showLibraryName lName ++ " does not expose any modules" +ppExplanation SignaturesCabal2 = + "To use the 'signatures' field the package needs to specify " + ++ "at least 'cabal-version: 2.0'." +ppExplanation AutogenNotExposed = + "An 'autogen-module' is neither on 'exposed-modules' nor 'other-modules'." +ppExplanation AutogenIncludesNotIncluded = + "An include in 'autogen-includes' is neither in 'includes' nor " + ++ "'install-includes'." +ppExplanation (NoMainIs eName) = + "No 'main-is' field found for executable " ++ prettyShow eName +ppExplanation NoHsLhsMain = + "The 'main-is' field must specify a '.hs' or '.lhs' file " + ++ "(even if it is generated by a preprocessor), " + ++ "or it may specify a C/C++/obj-C source file." +ppExplanation MainCCabal1_18 = + "The package uses a C/C++/obj-C source file for the 'main-is' field. " + ++ "To use this feature you need to specify 'cabal-version: 1.18' or" + ++ " higher." +ppExplanation (AutogenNoOther ct) = + "On " + ++ ppCET ct + ++ " an 'autogen-module'" + ++ " is not on 'other-modules'" +ppExplanation AutogenIncludesNotIncludedExe = + "An include in 'autogen-includes' is not in 'includes'." +ppExplanation (TestsuiteTypeNotKnown tt) = + quote (prettyShow tt) + ++ " is not a known type of test suite. " + ++ "Either remove the 'type' field or use a known type. " + ++ "The known test suite types are: " + ++ commaSep (map prettyShow knownTestTypes) +ppExplanation (TestsuiteNotSupported tt) = + quote (prettyShow tt) + ++ " is not a supported test suite version. " + ++ "Either remove the 'type' field or use a known type. " + ++ "The known test suite types are: " + ++ commaSep (map prettyShow knownTestTypes) +ppExplanation (BenchmarkTypeNotKnown tt) = + quote (prettyShow tt) + ++ " is not a known type of benchmark. " + ++ "Either remove the 'type' field or use a known type. " + ++ "The known benchmark types are: " + ++ commaSep (map prettyShow knownBenchmarkTypes) +ppExplanation (BenchmarkNotSupported tt) = + quote (prettyShow tt) + ++ " is not a supported benchmark version. " + ++ "Either remove the 'type' field or use a known type. " + ++ "The known benchmark types are: " + ++ commaSep (map prettyShow knownBenchmarkTypes) +ppExplanation NoHsLhsMainBench = + "The 'main-is' field must specify a '.hs' or '.lhs' file " + ++ "(even if it is generated by a preprocessor)." +ppExplanation (InvalidNameWin pkg) = + "The package name '" + ++ prettyShow pkg + ++ "' is " + ++ "invalid on Windows. Many tools need to convert package names to " + ++ "file names, so using this name would cause problems." +ppExplanation ZPrefix = + "Package names with the prefix 'z-' are reserved by Cabal and " + ++ "cannot be used." +ppExplanation NoBuildType = + "No 'build-type' specified. If you do not need a custom Setup.hs or " + ++ "./configure script then use 'build-type: Simple'." +ppExplanation NoCustomSetup = + "Ignoring the 'custom-setup' section because the 'build-type' is " + ++ "not 'Custom'. Use 'build-type: Custom' if you need to use a " + ++ "custom Setup.hs script." +ppExplanation (UnknownCompilers unknownCompilers) = + "Unknown compiler " + ++ commaSep (map quote unknownCompilers) + ++ " in 'tested-with' field." +ppExplanation (UnknownLanguages unknownLanguages) = + "Unknown languages: " ++ commaSep unknownLanguages +ppExplanation (UnknownExtensions unknownExtensions) = + "Unknown extensions: " ++ commaSep unknownExtensions +ppExplanation (LanguagesAsExtension languagesUsedAsExtensions) = + "Languages listed as extensions: " + ++ commaSep languagesUsedAsExtensions + ++ ". Languages must be specified in either the 'default-language' " + ++ " or the 'other-languages' field." +ppExplanation (DeprecatedExtensions ourDeprecatedExtensions) = + "Deprecated extensions: " + ++ commaSep (map (quote . prettyShow . fst) ourDeprecatedExtensions) + ++ ". " + ++ unwords + [ "Instead of '" + ++ prettyShow ext + ++ "' use '" + ++ prettyShow replacement + ++ "'." + | (ext, Just replacement) <- ourDeprecatedExtensions + ] +ppExplanation (MissingField cef) = + "No '" ++ ppCEField cef ++ "' field." +ppExplanation SynopsisTooLong = + "The 'synopsis' field is rather long (max 80 chars is recommended)." +ppExplanation ShortDesc = + "The 'description' field should be longer than the 'synopsis' field. " + ++ "It's useful to provide an informative 'description' to allow " + ++ "Haskell programmers who have never heard about your package to " + ++ "understand the purpose of your package. " + ++ "The 'description' field content is typically shown by tooling " + ++ "(e.g. 'cabal info', Haddock, Hackage) below the 'synopsis' which " + ++ "serves as a headline. " + ++ "Please refer to for more details." +ppExplanation (InvalidTestWith testedWithImpossibleRanges) = + "Invalid 'tested-with' version range: " + ++ commaSep (map prettyShow testedWithImpossibleRanges) + ++ ". To indicate that you have tested a package with multiple " + ++ "different versions of the same compiler use multiple entries, " + ++ "for example 'tested-with: GHC==6.10.4, GHC==6.12.3' and not " + ++ "'tested-with: GHC==6.10.4 && ==6.12.3'." +ppExplanation (ImpossibleInternalDep depInternalLibWithImpossibleVersion) = + "The package has an impossible version range for a dependency on an " + ++ "internal library: " + ++ commaSep (map prettyShow depInternalLibWithImpossibleVersion) + ++ ". This version range does not include the current package, and must " + ++ "be removed as the current package's library will always be used." +ppExplanation (ImpossibleInternalExe depInternalExecWithImpossibleVersion) = + "The package has an impossible version range for a dependency on an " + ++ "internal executable: " + ++ commaSep (map prettyShow depInternalExecWithImpossibleVersion) + ++ ". This version range does not include the current package, and must " + ++ "be removed as the current package's executable will always be used." +ppExplanation (MissingInternalExe depInternalExeWithImpossibleVersion) = + "The package depends on a missing internal executable: " + ++ commaSep (map prettyShow depInternalExeWithImpossibleVersion) +ppExplanation NONELicense = "The 'license' field is missing or is NONE." +ppExplanation NoLicense = "The 'license' field is missing." +ppExplanation AllRightsReservedLicense = + "The 'license' is AllRightsReserved. Is that really what you want?" +ppExplanation (LicenseMessParse lic) = + "Unfortunately the license " + ++ quote (prettyShow lic) + ++ " messes up the parser in earlier Cabal versions so you need to " + ++ "specify 'cabal-version: >= 1.4'. Alternatively if you require " + ++ "compatibility with earlier Cabal versions then use 'OtherLicense'." +ppExplanation (UnrecognisedLicense l) = + quote ("license: " ++ l) + ++ " is not a recognised license. The " + ++ "known licenses are: " + ++ commaSep (map prettyShow knownLicenses) +ppExplanation UncommonBSD4 = + "Using 'license: BSD4' is almost always a misunderstanding. 'BSD4' " + ++ "refers to the old 4-clause BSD license with the advertising " + ++ "clause. 'BSD3' refers the new 3-clause BSD license." +ppExplanation (UnknownLicenseVersion lic known) = + "'license: " + ++ prettyShow lic + ++ "' is not a known " + ++ "version of that license. The known versions are " + ++ commaSep (map prettyShow known) + ++ ". If this is not a mistake and you think it should be a known " + ++ "version then please file a ticket." +ppExplanation NoLicenseFile = "A 'license-file' is not specified." +ppExplanation (UnrecognisedSourceRepo kind) = + quote kind + ++ " is not a recognised kind of source-repository. " + ++ "The repo kind is usually 'head' or 'this'" +ppExplanation MissingType = + "The source-repository 'type' is a required field." +ppExplanation MissingLocation = + "The source-repository 'location' is a required field." +ppExplanation MissingModule = + "For a CVS source-repository, the 'module' is a required field." +ppExplanation MissingTag = + "For the 'this' kind of source-repository, the 'tag' is a required " + ++ "field. It should specify the tag corresponding to this version " + ++ "or release of the package." +ppExplanation SubdirRelPath = + "The 'subdir' field of a source-repository must be a relative path." +ppExplanation (SubdirGoodRelPath err) = + "The 'subdir' field of a source-repository is not a good relative path: " + ++ show err +ppExplanation (OptFasm fieldName) = + "'" + ++ fieldName + ++ ": -fasm' is unnecessary and will not work on CPU " + ++ "architectures other than x86, x86-64, ppc or sparc." +ppExplanation (OptHpc fieldName) = + "'" + ++ fieldName + ++ ": -fhpc' is not necessary. Use the configure flag " + ++ " --enable-coverage instead." +ppExplanation (OptProf fieldName) = + "'" + ++ fieldName + ++ ": -prof' is not necessary and will lead to problems " + ++ "when used on a library. Use the configure flag " + ++ "--enable-library-profiling and/or --enable-profiling." +ppExplanation (OptO fieldName) = + "'" + ++ fieldName + ++ ": -o' is not needed. " + ++ "The output files are named automatically." +ppExplanation (OptHide fieldName) = + "'" + ++ fieldName + ++ ": -hide-package' is never needed. " + ++ "Cabal hides all packages." +ppExplanation (OptMake fieldName) = + "'" + ++ fieldName + ++ ": --make' is never needed. Cabal uses this automatically." +ppExplanation (OptONot fieldName) = + "'" + ++ fieldName + ++ ": -O0' is not needed. " + ++ "Use the --disable-optimization configure flag." +ppExplanation (OptOOne fieldName) = + "'" + ++ fieldName + ++ ": -O' is not needed. " + ++ "Cabal automatically adds the '-O' flag. " + ++ "Setting it yourself interferes with the --disable-optimization flag." +ppExplanation (OptOTwo fieldName) = + "'" + ++ fieldName + ++ ": -O2' is rarely needed. " + ++ "Check that it is giving a real benefit " + ++ "and not just imposing longer compile times on your users." +ppExplanation (OptSplitSections fieldName) = + "'" + ++ fieldName + ++ ": -split-sections' is not needed. " + ++ "Use the --enable-split-sections configure flag." +ppExplanation (OptSplitObjs fieldName) = + "'" + ++ fieldName + ++ ": -split-objs' is not needed. " + ++ "Use the --enable-split-objs configure flag." +ppExplanation (OptWls fieldName) = + "'" + ++ fieldName + ++ ": -optl-Wl,-s' is not needed and is not portable to" + ++ " all operating systems. Cabal 1.4 and later automatically strip" + ++ " executables. Cabal also has a flag --disable-executable-stripping" + ++ " which is necessary when building packages for some Linux" + ++ " distributions and using '-optl-Wl,-s' prevents that from working." +ppExplanation (OptExts fieldName) = + "Instead of '" + ++ fieldName + ++ ": -fglasgow-exts' it is preferable to use " + ++ "the 'extensions' field." +ppExplanation (OptRts fieldName) = + "'" + ++ fieldName + ++ ": -rtsopts' has no effect for libraries. It should " + ++ "only be used for executables." +ppExplanation (OptWithRts fieldName) = + "'" + ++ fieldName + ++ ": -with-rtsopts' has no effect for libraries. It " + ++ "should only be used for executables." +ppExplanation (COptONumber prefix label) = + "'" + ++ prefix + ++ ": -O[n]' is generally not needed. When building with " + ++ " optimisations Cabal automatically adds '-O2' for " + ++ ppWarnLang label + ++ " code. Setting it yourself interferes with the" + ++ " --disable-optimization flag." +ppExplanation (COptCPP opt) = + "'cpp-options: " ++ opt ++ "' is not a portable C-preprocessor flag." +ppExplanation (OptAlternatives badField goodField flags) = + "Instead of " + ++ quote (badField ++ ": " ++ unwords badFlags) + ++ " use " + ++ quote (goodField ++ ": " ++ unwords goodFlags) + where + (badFlags, goodFlags) = unzip flags +ppExplanation (RelativeOutside field path) = + quote (field ++ ": " ++ path) + ++ " is a relative path outside of the source tree. " + ++ "This will not work when generating a tarball with 'sdist'." +ppExplanation (AbsolutePath field path) = + quote (field ++ ": " ++ path) + ++ " specifies an absolute path, but the " + ++ quote field + ++ " field must use relative paths." +ppExplanation (BadRelativePath field path err) = + quote (field ++ ": " ++ path) + ++ " is not a good relative path: " + ++ show err +ppExplanation (DistPoint mfield path) = + incipit + ++ " points inside the 'dist' " + ++ "directory. This is not reliable because the location of this " + ++ "directory is configurable by the user (or package manager). In " + ++ "addition, the layout of the 'dist' directory is subject to change " + ++ "in future versions of Cabal." + where + -- mfiled Nothing -> the path is inside `ghc-options` + incipit = + maybe + ("'ghc-options' path " ++ quote path) + (\field -> quote (field ++ ": " ++ path)) + mfield +ppExplanation (GlobSyntaxError field expl) = + "In the '" ++ field ++ "' field: " ++ expl +ppExplanation (RecursiveGlobInRoot field glob) = + "In the '" + ++ field + ++ "': glob '" + ++ glob + ++ "' starts at project root directory, this might " + ++ "include `.git/`, ``dist-newstyle/``, or other large directories!" +ppExplanation (InvalidOnWin paths) = + "The " + ++ quotes paths + ++ " invalid on Windows, which " + ++ "would cause portability problems for this package. Windows file " + ++ "names cannot contain any of the characters \":*?<>|\" and there " + ++ "a few reserved names including \"aux\", \"nul\", \"con\", " + ++ "\"prn\", \"com1-9\", \"lpt1-9\" and \"clock$\"." + where + quotes [failed] = "path " ++ quote failed ++ " is" + quotes failed = + "paths " + ++ commaSep (map quote failed) + ++ " are" +ppExplanation (FilePathTooLong path) = + "The following file name is too long to store in a portable POSIX " + ++ "format tar archive. The maximum length is 255 ASCII characters.\n" + ++ "The file in question is:\n " + ++ path +ppExplanation (FilePathNameTooLong path) = + "The following file name is too long to store in a portable POSIX " + ++ "format tar archive. The maximum length for the name part (including " + ++ "extension) is 100 ASCII characters. The maximum length for any " + ++ "individual directory component is 155.\n" + ++ "The file in question is:\n " + ++ path +ppExplanation (FilePathSplitTooLong path) = + "The following file name is too long to store in a portable POSIX " + ++ "format tar archive. While the total length is less than 255 ASCII " + ++ "characters, there are unfortunately further restrictions. It has to " + ++ "be possible to split the file path on a directory separator into " + ++ "two parts such that the first part fits in 155 characters or less " + ++ "and the second part fits in 100 characters or less. Basically you " + ++ "have to make the file name or directory names shorter, or you could " + ++ "split a long directory name into nested subdirectories with shorter " + ++ "names.\nThe file in question is:\n " + ++ path +ppExplanation FilePathEmpty = + "Encountered a file with an empty name, something is very wrong! " + ++ "Files with an empty name cannot be stored in a tar archive or in " + ++ "standard file systems." +ppExplanation CVTestSuite = + "The 'test-suite' section is new in Cabal 1.10. " + ++ "Unfortunately it messes up the parser in older Cabal versions " + ++ "so you must specify at least 'cabal-version: >= 1.8', but note " + ++ "that only Cabal 1.10 and later can actually run such test suites." +ppExplanation CVDefaultLanguage = + "To use the 'default-language' field the package needs to specify " + ++ "at least 'cabal-version: >= 1.10'." +ppExplanation CVDefaultLanguageComponent = + "Packages using 'cabal-version: >= 1.10' and before 'cabal-version: 3.4' " + ++ "must specify the 'default-language' field for each component (e.g. " + ++ "Haskell98 or Haskell2010). If a component uses different languages " + ++ "in different modules then list the other ones in the " + ++ "'other-languages' field." +ppExplanation CVExtraDocFiles = + "To use the 'extra-doc-files' field the package needs to specify " + ++ "'cabal-version: 1.18' or higher." +ppExplanation CVMultiLib = + "To use multiple 'library' sections or a named library section " + ++ "the package needs to specify at least 'cabal-version: 2.0'." +ppExplanation CVReexported = + "To use the 'reexported-module' field the package needs to specify " + ++ "'cabal-version: 1.22' or higher." +ppExplanation CVMixins = + "To use the 'mixins' field the package needs to specify " + ++ "at least 'cabal-version: 2.0'." +ppExplanation CVExtraFrameworkDirs = + "To use the 'extra-framework-dirs' field the package needs to specify" + ++ " 'cabal-version: 1.24' or higher." +ppExplanation CVDefaultExtensions = + "To use the 'default-extensions' field the package needs to specify " + ++ "at least 'cabal-version: >= 1.10'." +ppExplanation CVExtensionsDeprecated = + "For packages using 'cabal-version: >= 1.10' the 'extensions' " + ++ "field is deprecated. The new 'default-extensions' field lists " + ++ "extensions that are used in all modules in the component, while " + ++ "the 'other-extensions' field lists extensions that are used in " + ++ "some modules, e.g. via the {-# LANGUAGE #-} pragma." +ppExplanation CVSources = + "The use of 'asm-sources', 'cmm-sources', 'extra-bundled-libraries' " + ++ " and 'extra-library-flavours' requires the package " + ++ " to specify at least 'cabal-version: 3.0'." +ppExplanation (CVExtraDynamic flavs) = + "The use of 'extra-dynamic-library-flavours' requires the package " + ++ " to specify at least 'cabal-version: 3.0'. The flavours are: " + ++ commaSep (concat flavs) +ppExplanation CVVirtualModules = + "The use of 'virtual-modules' requires the package " + ++ " to specify at least 'cabal-version: 2.2'." +ppExplanation CVSourceRepository = + "The 'source-repository' section is new in Cabal 1.6. " + ++ "Unfortunately it messes up the parser in earlier Cabal versions " + ++ "so you need to specify 'cabal-version: >= 1.6'." +ppExplanation (CVExtensions version extCab12) = + "Unfortunately the language extensions " + ++ commaSep (map (quote . prettyShow) extCab12) + ++ " break the parser in earlier Cabal versions so you need to " + ++ "specify 'cabal-version: >= " + ++ showCabalSpecVersion version + ++ "'. Alternatively if you require compatibility with earlier " + ++ "Cabal versions then you may be able to use an equivalent " + ++ "compiler-specific flag." +ppExplanation CVCustomSetup = + "Packages using 'cabal-version: 1.24' or higher with 'build-type: Custom' " + ++ "must use a 'custom-setup' section with a 'setup-depends' field " + ++ "that specifies the dependencies of the Setup.hs script itself. " + ++ "The 'setup-depends' field uses the same syntax as 'build-depends', " + ++ "so a simple example would be 'setup-depends: base, Cabal'." +ppExplanation CVExpliticDepsCustomSetup = + "From version 1.24 cabal supports specifying explicit dependencies " + ++ "for Custom setup scripts. Consider using 'cabal-version: 1.24' or " + ++ "higher and adding a 'custom-setup' section with a 'setup-depends' " + ++ "field that specifies the dependencies of the Setup.hs script " + ++ "itself. The 'setup-depends' field uses the same syntax as " + ++ "'build-depends', so a simple example would be 'setup-depends: base, " + ++ "Cabal'." +ppExplanation CVAutogenPaths = + "Packages using 'cabal-version: 2.0' and the autogenerated " + ++ "module Paths_* must include it also on the 'autogen-modules' field " + ++ "besides 'exposed-modules' and 'other-modules'. This specifies that " + ++ "the module does not come with the package and is generated on " + ++ "setup. Modules built with a custom Setup.hs script also go here " + ++ "to ensure that commands like sdist don't fail." +ppExplanation CVAutogenPackageInfo = + "Packages using 'cabal-version: 2.0' and the autogenerated " + ++ "module PackageInfo_* must include it in 'autogen-modules' as well as" + ++ " 'exposed-modules' and 'other-modules'. This specifies that " + ++ "the module does not come with the package and is generated on " + ++ "setup. Modules built with a custom Setup.hs script also go here " + ++ "to ensure that commands like sdist don't fail." +ppExplanation (GlobNoMatch field glob) = + "In '" + ++ field + ++ "': the pattern '" + ++ glob + ++ "' does not" + ++ " match any files." +ppExplanation (GlobExactMatch field glob file) = + "In '" + ++ field + ++ "': the pattern '" + ++ glob + ++ "' does not" + ++ " match the file '" + ++ file + ++ "' because the extensions do not" + ++ " exactly match (e.g., foo.en.html does not exactly match *.html)." + ++ " To enable looser suffix-only matching, set 'cabal-version: 2.4' or" + ++ " higher." +ppExplanation (GlobNoDir field glob dir) = + "In '" + ++ field + ++ "': the pattern '" + ++ glob + ++ "' attempts to" + ++ " match files in the directory '" + ++ dir + ++ "', but there is no" + ++ " directory by that name." +ppExplanation (UnknownOS unknownOSs) = + "Unknown operating system name " ++ commaSep (map quote unknownOSs) +ppExplanation (UnknownArch unknownArches) = + "Unknown architecture name " ++ commaSep (map quote unknownArches) +ppExplanation (UnknownCompiler unknownImpls) = + "Unknown compiler name " ++ commaSep (map quote unknownImpls) +ppExplanation BaseNoUpperBounds = + "The dependency 'build-depends: base' does not specify an upper " + ++ "bound on the version number. Each major release of the 'base' " + ++ "package changes the API in various ways and most packages will " + ++ "need some changes to compile with it. The recommended practice " + ++ "is to specify an upper bound on the version of the 'base' " + ++ "package. This ensures your package will continue to build when a " + ++ "new major version of the 'base' package is released. If you are " + ++ "not sure what upper bound to use then use the next major " + ++ "version. For example if you have tested your package with 'base' " + ++ "version 4.5 and 4.6 then use 'build-depends: base >= 4.5 && < 4.7'." +ppExplanation (MissingUpperBounds ct names) = + let separator = "\n - " + in "On " + ++ ppCET ct + ++ ", " + ++ "these packages miss upper bounds:" + ++ separator + ++ List.intercalate separator names + ++ "\n" + ++ "Please add them. There is more information at https://pvp.haskell.org/" +ppExplanation (SuspiciousFlagName invalidFlagNames) = + "Suspicious flag names: " + ++ unwords invalidFlagNames + ++ ". " + ++ "To avoid ambiguity in command line interfaces, a flag shouldn't " + ++ "start with a dash. Also for better compatibility, flag names " + ++ "shouldn't contain non-ascii characters." +ppExplanation (DeclaredUsedFlags declared used) = + "Declared and used flag sets differ: " + ++ s declared + ++ " /= " + ++ s used + ++ ". " + where + s :: Set.Set FlagName -> String + s = commaSep . map unFlagName . Set.toList +ppExplanation (NonASCIICustomField nonAsciiXFields) = + "Non ascii custom fields: " + ++ unwords nonAsciiXFields + ++ ". " + ++ "For better compatibility, custom field names " + ++ "shouldn't contain non-ascii characters." +ppExplanation RebindableClashPaths = + "Packages using RebindableSyntax with OverloadedStrings or" + ++ " OverloadedLists in default-extensions, in conjunction with the" + ++ " autogenerated module Paths_*, are known to cause compile failures" + ++ " with Cabal < 2.2. To use these default-extensions with a Paths_*" + ++ " autogen module, specify at least 'cabal-version: 2.2'." +ppExplanation RebindableClashPackageInfo = + "Packages using RebindableSyntax with OverloadedStrings or" + ++ " OverloadedLists in default-extensions, in conjunction with the" + ++ " autogenerated module PackageInfo_*, are known to cause compile failures" + ++ " with Cabal < 2.2. To use these default-extensions with a PackageInfo_*" + ++ " autogen module, specify at least 'cabal-version: 2.2'." +ppExplanation (WErrorUnneeded fieldName) = + addConditionalExp $ + "'" + ++ fieldName + ++ ": -Werror' makes the package easy to " + ++ "break with future GHC versions because new GHC versions often " + ++ "add new warnings." +ppExplanation (JUnneeded fieldName) = + addConditionalExp $ + "'" + ++ fieldName + ++ ": -j[N]' can make sense for a particular user's setup," + ++ " but it is not appropriate for a distributed package." +ppExplanation (FDeferTypeErrorsUnneeded fieldName) = + addConditionalExp $ + "'" + ++ fieldName + ++ ": -fdefer-type-errors' is fine during development " + ++ "but is not appropriate for a distributed package." +ppExplanation (DynamicUnneeded fieldName) = + addConditionalExp $ + "'" + ++ fieldName + ++ ": -d*' debug flags are not appropriate " + ++ "for a distributed package." +ppExplanation (ProfilingUnneeded fieldName) = + addConditionalExp $ + "'" + ++ fieldName + ++ ": -fprof*' profiling flags are typically not " + ++ "appropriate for a distributed library package. These flags are " + ++ "useful to profile this package, but when profiling other packages " + ++ "that use this one these flags clutter the profile output with " + ++ "excessive detail. If you think other packages really want to see " + ++ "cost centres from this package then use '-fprof-auto-exported' " + ++ "which puts cost centres only on exported functions." +ppExplanation (UpperBoundSetup nm) = + "The dependency 'setup-depends: '" + ++ nm + ++ "' does not specify an " + ++ "upper bound on the version number. Each major release of the " + ++ "'" + ++ nm + ++ "' package changes the API in various ways and most " + ++ "packages will need some changes to compile with it. If you are " + ++ "not sure what upper bound to use then use the next major " + ++ "version." +ppExplanation (DuplicateModule s dupLibsLax) = + "Duplicate modules in " + ++ s + ++ ": " + ++ commaSep (map prettyShow dupLibsLax) +ppExplanation (PotentialDupModule s dupLibsStrict) = + "Potential duplicate modules (subject to conditionals) in " + ++ s + ++ ": " + ++ commaSep (map prettyShow dupLibsStrict) +ppExplanation (BOMStart pdfile) = + pdfile + ++ " starts with an Unicode byte order mark (BOM)." + ++ " This may cause problems with older cabal versions." +ppExplanation (NotPackageName pdfile expectedCabalname) = + "The filename " + ++ quote pdfile + ++ " does not match package name " + ++ "(expected: " + ++ quote expectedCabalname + ++ ")" +ppExplanation NoDesc = + "No cabal file found.\n" + ++ "Please create a package description file .cabal" +ppExplanation (MultiDesc multiple) = + "Multiple cabal files found while checking.\n" + ++ "Please use only one of: " + ++ commaSep multiple +ppExplanation (UnknownFile fieldname file) = + "The '" + ++ fieldname + ++ "' field refers to the file " + ++ quote (getSymbolicPath file) + ++ " which does not exist." +ppExplanation MissingSetupFile = + "The package is missing a Setup.hs or Setup.lhs script." +ppExplanation MissingConfigureScript = + "The 'build-type' is 'Configure' but there is no 'configure' script. " + ++ "You probably need to run 'autoreconf -i' to generate it." +ppExplanation (UnknownDirectory kind dir) = + quote (kind ++ ": " ++ dir) + ++ " specifies a directory which does not exist." +ppExplanation MissingSourceControl = + "When distributing packages, it is encouraged to specify source " + ++ "control information in the .cabal file using one or more " + ++ "'source-repository' sections. See the Cabal user guide for " + ++ "details." +ppExplanation (MissingExpectedDocFiles extraDocFileSupport paths) = + "Please consider including the " + ++ quotes paths + ++ " in the '" + ++ targetField + ++ "' section of the .cabal file " + ++ "if it contains useful information for users of the package." + where + quotes [p] = "file " ++ quote p + quotes ps = "files " ++ commaSep (map quote ps) + targetField = + if extraDocFileSupport + then "extra-doc-files" + else "extra-source-files" +ppExplanation (WrongFieldForExpectedDocFiles extraDocFileSupport field paths) = + "Please consider moving the " + ++ quotes paths + ++ " from the '" + ++ field + ++ "' section of the .cabal file " + ++ "to the section '" + ++ targetField + ++ "'." + where + quotes [p] = "file " ++ quote p + quotes ps = "files " ++ commaSep (map quote ps) + targetField = + if extraDocFileSupport + then "extra-doc-files" + else "extra-source-files" + +-- * Formatting utilities + +commaSep :: [String] -> String +commaSep = List.intercalate ", " + +quote :: String -> String +quote s = "'" ++ s ++ "'" + +addConditionalExp :: String -> String +addConditionalExp expl = + expl + ++ " Alternatively, if you want to use this, make it conditional based " + ++ "on a Cabal configuration flag (with 'manual: True' and 'default: " + ++ "False') and enable that flag during development." diff --git a/Cabal/src/Distribution/Simple/BuildToolDepends.hs b/Cabal/src/Distribution/Simple/BuildToolDepends.hs index 486cd2049d9..01592a0970e 100644 --- a/Cabal/src/Distribution/Simple/BuildToolDepends.hs +++ b/Cabal/src/Distribution/Simple/BuildToolDepends.hs @@ -13,7 +13,34 @@ import qualified Data.Map as Map import Distribution.Package import Distribution.PackageDescription --- | Desugar a "build-tools" entry into proper a executable dependency if +-- | Same as 'desugarBuildTool', but requires atomic informations (package +-- name, executable names) instead of a whole 'PackageDescription'. +desugarBuildToolSimple + :: PackageName + -> [UnqualComponentName] + -> LegacyExeDependency + -> Maybe ExeDependency +desugarBuildToolSimple pname exeNames (LegacyExeDependency name reqVer) + | foundLocal = Just $ ExeDependency pname toolName reqVer + | otherwise = Map.lookup name allowMap + where + toolName = mkUnqualComponentName name + foundLocal = toolName `elem` exeNames + allowlist = + [ "hscolour" + , "haddock" + , "happy" + , "alex" + , "hsc2hs" + , "c2hs" + , "cpphs" + , "greencard" + , "hspec-discover" + ] + allowMap = Map.fromList $ flip map allowlist $ \n -> + (n, ExeDependency (mkPackageName n) (mkUnqualComponentName n) reqVer) + +-- | Desugar a "build-tools" entry into a proper executable dependency if -- possible. -- -- An entry can be so desugared in two cases: @@ -31,26 +58,10 @@ desugarBuildTool -> LegacyExeDependency -> Maybe ExeDependency desugarBuildTool pkg led = - if foundLocal - then Just $ ExeDependency (packageName pkg) toolName reqVer - else Map.lookup name whiteMap - where - LegacyExeDependency name reqVer = led - toolName = mkUnqualComponentName name - foundLocal = toolName `elem` map exeName (executables pkg) - whitelist = - [ "hscolour" - , "haddock" - , "happy" - , "alex" - , "hsc2hs" - , "c2hs" - , "cpphs" - , "greencard" - , "hspec-discover" - ] - whiteMap = Map.fromList $ flip map whitelist $ \n -> - (n, ExeDependency (mkPackageName n) (mkUnqualComponentName n) reqVer) + desugarBuildToolSimple + (packageName pkg) + (map exeName $ executables pkg) + led -- | Get everything from "build-tool-depends", along with entries from -- "build-tools" that we know how to desugar. diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index f35f98f4fcb..1c9188a2a6b 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -2290,7 +2290,7 @@ checkPackageProblems -> IO () checkPackageProblems verbosity dir gpkg pkg = do ioChecks <- checkPackageFiles verbosity pkg dir - let pureChecks = checkPackage gpkg (Just pkg) + let pureChecks = checkPackage gpkg (errors, warnings) = partitionEithers (M.mapMaybe classEW $ pureChecks ++ ioChecks) if null errors diff --git a/cabal-install/src/Distribution/Client/Check.hs b/cabal-install/src/Distribution/Client/Check.hs index ffd2e6c7ec3..bfcea3f74f3 100644 --- a/cabal-install/src/Distribution/Client/Check.hs +++ b/cabal-install/src/Distribution/Client/Check.hs @@ -24,7 +24,6 @@ import Prelude () import Distribution.Client.Utils.Parsec (renderParseError) import Distribution.PackageDescription (GenericPackageDescription) import Distribution.PackageDescription.Check -import Distribution.PackageDescription.Configuration (flattenPackageDescription) import Distribution.PackageDescription.Parsec ( parseGenericPackageDescription , runParseResult @@ -66,22 +65,8 @@ check verbosity = do (ws, ppd) <- readGenericPackageDescriptionCheck verbosity pdfile -- convert parse warnings into PackageChecks let ws' = map (wrapParseWarning pdfile) ws - -- flatten the generic package description into a regular package - -- description - -- TODO: this may give more warnings than it should give; - -- consider two branches of a condition, one saying - -- ghc-options: -Wall - -- and the other - -- ghc-options: -Werror - -- joined into - -- ghc-options: -Wall -Werror - -- checkPackages will yield a warning on the last line, but it - -- would not on each individual branch. - -- However, this is the same way hackage does it, so we will yield - -- the exact same errors as it will. - let pkg_desc = flattenPackageDescription ppd - ioChecks <- checkPackageFiles verbosity pkg_desc "." - let packageChecks = ioChecks ++ checkPackage ppd (Just pkg_desc) ++ ws' + ioChecks <- checkPackageFilesGPD verbosity ppd "." + let packageChecks = ioChecks ++ checkPackage ppd ++ ws' CM.mapM_ (outputGroupCheck verbosity) (groupChecks packageChecks) diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs index db3bff2640b..9307aae8feb 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -491,7 +491,7 @@ exAvSrcPkg ex = -- Furthermore we ignore missing upper bound warnings because -- they are not related to this test suite, and are tested -- with golden tests. - let checks = C.checkPackage (srcpkgDescription package) Nothing + let checks = C.checkPackage (srcpkgDescription package) in filter (\x -> not (isMissingUpperBound x) && not (isUnknownLangExt x)) checks in if null pkgCheckErrors then package diff --git a/cabal-testsuite/PackageTests/AutogenModules/Package/my.cabal b/cabal-testsuite/PackageTests/AutogenModules/Package/my.cabal index 37dfcbf7bce..2ddd13ed619 100644 --- a/cabal-testsuite/PackageTests/AutogenModules/Package/my.cabal +++ b/cabal-testsuite/PackageTests/AutogenModules/Package/my.cabal @@ -14,7 +14,7 @@ description: Library default-language: Haskell2010 - build-depends: base + build-depends: base == 4.* exposed-modules: MyLibrary PackageInfo_AutogenModules @@ -28,7 +28,7 @@ Library Executable Exe default-language: Haskell2010 main-is: Dummy.hs - build-depends: base + build-depends: base == 4.* other-modules: MyExeModule PackageInfo_AutogenModules @@ -41,7 +41,7 @@ Test-Suite Test default-language: Haskell2010 main-is: Dummy.hs type: exitcode-stdio-1.0 - build-depends: base + build-depends: base == 4.* other-modules: MyTestModule PackageInfo_AutogenModules @@ -54,7 +54,7 @@ Benchmark Bench default-language: Haskell2010 main-is: Dummy.hs type: exitcode-stdio-1.0 - build-depends: base + build-depends: base == 4.* other-modules: MyBenchModule PackageInfo_AutogenModules diff --git a/cabal-testsuite/PackageTests/AutogenModules/SrcDist/AutogenModules.cabal b/cabal-testsuite/PackageTests/AutogenModules/SrcDist/AutogenModules.cabal index 8c8f1a98b89..0976dbf493a 100644 --- a/cabal-testsuite/PackageTests/AutogenModules/SrcDist/AutogenModules.cabal +++ b/cabal-testsuite/PackageTests/AutogenModules/SrcDist/AutogenModules.cabal @@ -14,7 +14,7 @@ description: Library default-language: Haskell2010 - build-depends: base + build-depends: base == 4.* exposed-modules: MyLibrary PackageInfo_AutogenModules @@ -30,7 +30,7 @@ Library Executable Exe default-language: Haskell2010 main-is: Dummy.hs - build-depends: base + build-depends: base == 4.* other-modules: MyExeModule PackageInfo_AutogenModules @@ -45,7 +45,7 @@ Test-Suite Test default-language: Haskell2010 main-is: Dummy.hs type: exitcode-stdio-1.0 - build-depends: base + build-depends: base == 4.* other-modules: MyTestModule PackageInfo_AutogenModules @@ -60,7 +60,7 @@ Benchmark Bench default-language: Haskell2010 main-is: Dummy.hs type: exitcode-stdio-1.0 - build-depends: base + build-depends: base == 4.* other-modules: MyBenchModule PackageInfo_AutogenModules diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/cabal.out index 5710d84e88c..bfff695159e 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/cabal.out @@ -1,4 +1,4 @@ # cabal check The package will not build sanely due to these errors: -Error: The package has an impossible version range for a dependency on an internal library: pkg:internal >1.0. This version range does not include the current package, and must be removed as the current package's library will always be used. +Error: The package has an impossible version range for a dependency on an internal library: pkg:internal >1.0 && <2.0. This version range does not include the current package, and must be removed as the current package's library will always be used. Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/pkg.cabal b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/pkg.cabal index 71c35a369a3..ffebdd5ee04 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/pkg.cabal +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/pkg.cabal @@ -10,7 +10,7 @@ license: GPL-3.0-or-later library exposed-modules: Module build-depends: base == 4.*, - internal > 1.0 + internal > 1.0 && < 2.0 default-language: Haskell2010 library internal diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.out new file mode 100644 index 00000000000..37aa169b416 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.out @@ -0,0 +1,2 @@ +# cabal check +No errors or warnings could be found in the package. diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.test.hs b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.test.hs new file mode 100644 index 00000000000..856a1aaad81 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.test.hs @@ -0,0 +1,4 @@ +import Test.Cabal.Prelude + +-- Do not output warning when an -O2 is behind a cabal flag. +main = cabalTest $ cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/pkg.cabal b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/pkg.cabal new file mode 100644 index 00000000000..da87e698285 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/pkg.cabal @@ -0,0 +1,18 @@ +cabal-version: 2.2 +name: pkg +version: 0 +category: example +maintainer: none@example.com +synopsis: synopsys +description: description +license: GPL-3.0-or-later + +flag force-O2 + default: False + manual: True + +library + exposed-modules: Foo + default-language: Haskell2010 + if flag(force-O2) + ghc-options: -O2 diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.out new file mode 100644 index 00000000000..54660ce787e --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.out @@ -0,0 +1,4 @@ +# cabal check +These warnings may cause trouble when distributing the package: +Warning: 'ghc-options: -O2' is rarely needed. Check that it is giving a real benefit and not just imposing longer compile times on your users. + diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.test.hs b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.test.hs new file mode 100644 index 00000000000..e9e0fe10b47 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- Output warning when an -O2 inside a cabal flag, but the flag is not +-- marked as `manual: True`. +main = cabalTest $ cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/pkg.cabal b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/pkg.cabal new file mode 100644 index 00000000000..415422cff12 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/pkg.cabal @@ -0,0 +1,17 @@ +cabal-version: 2.2 +name: pkg +version: 0 +category: example +maintainer: none@example.com +synopsis: synopsys +description: description +license: GPL-3.0-or-later + +flag force-O2 + default: False + +library + exposed-modules: Foo + default-language: Haskell2010 + if flag(force-O2) + ghc-options: -O2 diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.out new file mode 100644 index 00000000000..54660ce787e --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.out @@ -0,0 +1,4 @@ +# cabal check +These warnings may cause trouble when distributing the package: +Warning: 'ghc-options: -O2' is rarely needed. Check that it is giving a real benefit and not just imposing longer compile times on your users. + diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.test.hs b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.test.hs new file mode 100644 index 00000000000..8cfba826bd7 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.test.hs @@ -0,0 +1,4 @@ +import Test.Cabal.Prelude + +-- Output warning when an -O2 outside a cabal flag, along with one inside. +main = cabalTest $ cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/pkg.cabal b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/pkg.cabal new file mode 100644 index 00000000000..cec9eec5fe9 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/pkg.cabal @@ -0,0 +1,19 @@ +cabal-version: 2.2 +name: pkg +version: 0 +category: example +maintainer: none@example.com +synopsis: synopsys +description: description +license: GPL-3.0-or-later + +flag force-O2 + default: False + manual: True + +library + exposed-modules: Foo + default-language: Haskell2010 + ghc-options: -O2 + if flag(force-O2) + ghc-options: -O2 diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.out new file mode 100644 index 00000000000..37aa169b416 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.out @@ -0,0 +1,2 @@ +# cabal check +No errors or warnings could be found in the package. diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.test.hs b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.test.hs new file mode 100644 index 00000000000..a6da4f86777 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- Absolute paths can be used in `extra-lib-dirs`. +main = cabalTest $ + cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/pkg.cabal b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/pkg.cabal new file mode 100644 index 00000000000..087e00b080b --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/pkg.cabal @@ -0,0 +1,13 @@ +cabal-version: 3.0 +name: pkg +synopsis: synopsis +description: description +version: 0 +category: example +maintainer: none@example.com +license: GPL-3.0-or-later + +library + exposed-modules: Module + default-language: Haskell2010 + extra-lib-dirs: /home/ diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/DistPoint/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/DistPoint/cabal.out index 81f9ada5773..477e1108ab3 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/DistPoint/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/DistPoint/cabal.out @@ -1,4 +1,4 @@ # cabal check The following errors will cause portability problems on other environments: -Error: 'ghc-options' path 'dist/file' points inside the 'dist' directory. This is not reliable because the location of this directory is configurable by the user (or package manager). In addition the layout of the 'dist' directory is subject to change in future versions of Cabal. +Error: 'ghc-options' path 'dist/file' points inside the 'dist' directory. This is not reliable because the location of this directory is configurable by the user (or package manager). In addition, the layout of the 'dist' directory is subject to change in future versions of Cabal. Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/RecursiveGlobInRoot/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/RecursiveGlobInRoot/cabal.out index e2506317dc1..e4930d6a4b5 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/RecursiveGlobInRoot/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/RecursiveGlobInRoot/cabal.out @@ -1,5 +1,5 @@ # cabal check These warnings may cause trouble when distributing the package: Warning: In the 'data-files': glob '**/*.dat' starts at project root directory, this might include `.git/`, ``dist-newstyle/``, or other large directories! -Warning: In the 'extra-source-files': glob '**/*.hs' starts at project root directory, this might include `.git/`, ``dist-newstyle/``, or other large directories! Warning: In the 'extra-doc-files': glob '**/*.md' starts at project root directory, this might include `.git/`, ``dist-newstyle/``, or other large directories! +Warning: In the 'extra-source-files': glob '**/*.hs' starts at project root directory, this might include `.git/`, ``dist-newstyle/``, or other large directories! diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/AutogenIncludes/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/AutogenIncludes/cabal.out index b4977e9d6c6..3ae07a9c509 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/AutogenIncludes/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/AutogenIncludes/cabal.out @@ -1,4 +1,4 @@ # cabal check The package will not build sanely due to these errors: -Error: An include in 'autogen-includes' is neither in 'includes' or 'install-includes'. +Error: An include in 'autogen-includes' is neither in 'includes' nor 'install-includes'. Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoDupNames/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoDupNames/cabal.out index be0d14356f6..fd288ec5fdd 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoDupNames/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoDupNames/cabal.out @@ -1 +1,4 @@ # cabal check +The package will not build sanely due to these errors: +Error: Duplicate sections: dup. The name of every library, executable, test suite, and benchmark section in the package must be unique. +Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/LICENSE b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/LICENSE new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out new file mode 100644 index 00000000000..a5ef963c71f --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out @@ -0,0 +1,4 @@ +# cabal check +The following errors will cause portability problems on other environments: +Error: 'ghc-options: -j[N]' can make sense for a particular user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. +Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.test.hs b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.test.hs new file mode 100644 index 00000000000..48efe554e6b --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- `check` should not be confused by an user flag. +main = cabalTest $ + fails $ cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/pkg.cabal b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/pkg.cabal new file mode 100644 index 00000000000..b0f8bc85140 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/pkg.cabal @@ -0,0 +1,25 @@ +name: pkg +version: 0.0.0.1 +synopsis: The Servant +description: Various capabilities +category: prelude +maintainer: smokejumperit+rfc@gmail.com +license: MIT +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 + +flag production + description: Disables failing. + manual: True + default: False + +library + exposed-modules: + RFC.Servant.API + ghc-options: -j + if flag(production) + ghc-options: -feager-blackholing + else + cpp-options: -DDEVELOPMENT + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/Jn/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/Jn/cabal.out index 4024acad24e..b3217c803cf 100644 --- a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/Jn/cabal.out +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/Jn/cabal.out @@ -1,4 +1,4 @@ # cabal check The following errors will cause portability problems on other environments: -Error: 'ghc-shared-options: -j[N]' can make sense for specific user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. +Error: 'ghc-shared-options: -j[N]' can make sense for a particular user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.out new file mode 100644 index 00000000000..37aa169b416 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.out @@ -0,0 +1,2 @@ +# cabal check +No errors or warnings could be found in the package. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.test.hs b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.test.hs new file mode 100644 index 00000000000..be0007ff8f3 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- Do not complain if WError is under a user, off-by-default flag. +main = cabalTest $ + cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/pkg.cabal b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/pkg.cabal new file mode 100644 index 00000000000..9a5e9b708d1 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/pkg.cabal @@ -0,0 +1,20 @@ +cabal-version: 3.0 +name: pkg +synopsis: synopsis +description: description +version: 0 +category: example +maintainer: none@example.com +license: GPL-3.0-or-later + +flag dev + description: Turn on development settings. + manual: True + default: False + +library + exposed-modules: Foo + default-language: Haskell2010 + if flag(dev) + ghc-options: -Werror + diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out new file mode 100644 index 00000000000..37aa169b416 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out @@ -0,0 +1,2 @@ +# cabal check +No errors or warnings could be found in the package. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.test.hs b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.test.hs new file mode 100644 index 00000000000..1a6b28f94fc --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- Unbounded (top) base with internal dependency: no warn, no error. +main = cabalTest $ + cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/pkg.cabal b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/pkg.cabal new file mode 100644 index 00000000000..91943d4987a --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/pkg.cabal @@ -0,0 +1,19 @@ +cabal-version: 3.0 +name: pkg +synopsis: synopsis +description: description +version: 0 +category: example +maintainer: none@example.com +license: GPL-3.0-or-later + +library + exposed-modules: Foo + default-language: Haskell2010 + build-depends: base <= 3.10 + +executable test-exe + main-is: Main.hs + default-language: Haskell2010 + build-depends: base, pkg + diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.out new file mode 100644 index 00000000000..ff21f73f613 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.out @@ -0,0 +1,5 @@ +# cabal check +These warnings may cause trouble when distributing the package: +Warning: On executable 'prova', these packages miss upper bounds: +- acme-box +Please add them. There is more information at https://pvp.haskell.org/ diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.test.hs b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.test.hs new file mode 100644 index 00000000000..62207619ac5 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- Unbounded with internal dependency: do not warn. +main = cabalTest $ + cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/pkg.cabal b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/pkg.cabal new file mode 100644 index 00000000000..06c47e49740 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/pkg.cabal @@ -0,0 +1,22 @@ +cabal-version: 3.0 +name: pkg +version: 2 +maintainer: fffaaa +category: asdasd +synopsis: asdcasdcs +description: cdscsd acs dcs dss +license: GPL-3.0-or-later + +library + exposed-modules: Foo + build-depends: text < 5.0 + default-language: Haskell2010 + +executable prova + main-is: Prova.hs + build-depends: + pkg + , text + , acme-box + default-language: Haskell2010 + diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out new file mode 100644 index 00000000000..e0821ac6ea5 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out @@ -0,0 +1,5 @@ +# cabal check +These warnings may cause trouble when distributing the package: +Warning: On library 'int-lib', these packages miss upper bounds: +- text +Please add them. There is more information at https://pvp.haskell.org/ diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.test.hs b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.test.hs new file mode 100644 index 00000000000..597002165fb --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- Internal libraries missing upper bound are correctly reported. +main = cabalTest $ + cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/pkg.cabal b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/pkg.cabal new file mode 100644 index 00000000000..3d5b861f059 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/pkg.cabal @@ -0,0 +1,20 @@ +cabal-version: 3.0 +name: pkg +synopsis: synopsis +description: description +version: 0 +category: example +maintainer: none@example.com +license: GPL-3.0-or-later + +library + exposed-modules: Foo + build-depends: base <= 3.10, + int-lib + default-language: Haskell2010 + +library int-lib + exposed-modules: Bar + build-depends: text > 1 + default-language: Haskell2010 + diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.out new file mode 100644 index 00000000000..37aa169b416 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.out @@ -0,0 +1,2 @@ +# cabal check +No errors or warnings could be found in the package. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.test.hs b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.test.hs new file mode 100644 index 00000000000..c0819c5841a --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.test.hs @@ -0,0 +1,6 @@ +import Test.Cabal.Prelude + +-- Straddle deps declarations (build-depends: base > 5, base < 6) +-- should not error. +main = cabalTest $ + cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/pkg.cabal b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/pkg.cabal new file mode 100644 index 00000000000..b21ffe61f12 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/pkg.cabal @@ -0,0 +1,15 @@ +cabal-version: 3.0 +name: pkg +synopsis: synopsis +description: description +version: 0 +category: example +maintainer: none@example.com +license: GPL-3.0-or-later + +library + exposed-modules: Foo + default-language: Haskell2010 + build-depends: base > 2, + base <= 3.10 + diff --git a/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/LICENSE b/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/LICENSE new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.out b/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.out new file mode 100644 index 00000000000..37aa169b416 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.out @@ -0,0 +1,2 @@ +# cabal check +No errors or warnings could be found in the package. diff --git a/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.test.hs b/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.test.hs new file mode 100644 index 00000000000..967a72a460c --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- Do not warn on non-existant directory if it is absolute. +main = cabalTest $ + cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/pkg.cabal b/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/pkg.cabal new file mode 100644 index 00000000000..d208bae8cd3 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/pkg.cabal @@ -0,0 +1,17 @@ +Name: pkg +Version: 0.1.0.0 +Synopsis: Low +description: lallalala +License: LGPL-3 +License-File: LICENSE +Maintainer: Maksymilian.Owsianny+AwesomiumRaw@gmail.com +Bug-Reports: https://github.com/MaxOw/awesomium-raw/issues +Category: Graphics, Web +Build-Type: Simple +Cabal-Version: >=1.8 + +Library + Exposed-Modules: Graphics.UI.Awesomium.Raw + Build-Depends: base >= 3 && < 5 + Extra-Lib-Dirs: /usr/lib/awesomium-1.6.5 + diff --git a/cabal-testsuite/PackageTests/Check/PackageFiles/VCSInfo/cabal.out b/cabal-testsuite/PackageTests/Check/PackageFiles/VCSInfo/cabal.out index 0b90abdd9d7..b709524c109 100644 --- a/cabal-testsuite/PackageTests/Check/PackageFiles/VCSInfo/cabal.out +++ b/cabal-testsuite/PackageTests/Check/PackageFiles/VCSInfo/cabal.out @@ -1,3 +1,3 @@ # cabal check These warnings will likely cause trouble when distributing the package: -Warning: When distributing packages it is encouraged to specify source control information in the .cabal file using one or more 'source-repository' sections. See the Cabal user guide for details. +Warning: When distributing packages, it is encouraged to specify source control information in the .cabal file using one or more 'source-repository' sections. See the Cabal user guide for details. diff --git a/changelog.d/pr-8427 b/changelog.d/pr-8427 new file mode 100644 index 00000000000..402765942d6 --- /dev/null +++ b/changelog.d/pr-8427 @@ -0,0 +1,19 @@ +synopsis: Reimplementing `cabal check` +packages: Cabal +prs: #8427 +issues: #7423 + +description: { + +- For `cabal-install` users: `cabal check` do not warn on -O2 or similar + options if under an off-by-default cabal flag. +- For `Cabal` the library users: `checkPackage` signature has been simplified, + you do not need to pass a specific configuration of the package, since + we do not flatten GenericPackageDescription no more. +- For `Cabal` the library users: `checkPackageFileNames` has been removed, + use `checkPackageFiles` instead. +- For `Cabal` the library users: `checkPackageFilesGPD` has been introduced, + a function similar to `checkPackageFiles` that works on + `GenericPackageDescription`. You do not need to use + `flattenPackageDescription` anymore. +} diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index 05f1666279d..5419186f73c 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -1181,6 +1181,142 @@ to Hackage requirements for uploaded packages: if no error is reported, Hackage should accept your package. If errors are present ``cabal check`` exits with ``1`` and Hackage will refuse the package. +A list of all warnings with their constructor: + +- ParseWarning: warnings inherited from parser. +- NoNameField: missing ``name`` field. +- NoVersionField: missing ``version`` field. +- NoTarget: missing target in ``.cabal``. +- UnnamedInternal: unnamed internal library. +- DuplicateSections: duplicate name in target. +- IllegalLibraryName: internal library with same name as package. +- NoModulesExposed: no module exposed in library. +- SignaturesCabal2: ``signatures`` used with ``cabal-version`` < 2.0 +- AutogenNotExposed: ``autogen-module`` neither in ``exposed-modules`` nor ``other-modules``. +- AutogenIncludesNotIncluded: ``autogen-include`` neither in ``include`` nor ``install-includes``. +- NoMainIs: missing ``main-is``. +- NoHsLhsMain: ``main-is`` is not ``.hs`` nor ``.lhs``. +- MainCCabal1_18: C-like source file in ``main-is`` with ``cabal-version`` < 1.18. +- AutogenNoOther: ``autogen-module`` not in ``other-modules``. +- AutogenIncludesNotIncludedExe: ``autogen-include`` not in ``includes``. +- TestsuiteTypeNotKnown: unknown test-suite type. +- TestsuiteNotSupported: unsupported test-suite type. +- BenchmarkTypeNotKnown: unknown benchmark type. +- BenchmarkNotSupported: unsupported benchmark type. +- NoHsLhsMainBench: ``main-is`` for benchmark is neither ``.hs`` nor ``.lhs``. +- InvalidNameWin: invalid package name on Windows. +- ZPrefix: package with ``z-`` prexif (reseved for Cabal. +- NoBuildType: missing ``build-type``. +- NoCustomSetup: ``custom-setup`` section without ``build-type: Custom`` +- UnknownCompilers: unknown compiler in ``tested-with``. +- UnknownLanguages: unknown languages. +- UnknownExtensions: unknown extensions. +- LanguagesAsExtension: languages listed as extensions. +- DeprecatedExtensions: deprecated extensions. +- MissingField: missing cabal field (one of ``category``, ``maintainer``, ``synopsis``, ``description``). +- SynopsisTooLong: ``synopsis`` longer than 80 characters. +- ShortDesc: ``description`` shorter than ``synopsis``. +- InvalidTestWith: invalid ``tested-with`` version range. +- ImpossibleInternalDep: impossible internal library version range dependency. +- ImpossibleInternalExe: impossible internal executable version range dependency. +- MissingInternalExe: missing internal executable. +- NONELicense: ``NONE`` in ``license`` field. +- NoLicense: no ``license`` field. +- AllRightsReservedLicense: all rights reserved license. +- LicenseMessParse: license not to be used with `cabal-version` < 1.4. +- UnrecognisedLicense: unknown license. +- UncommonBSD4: uncommon BSD (BSD4) license. +- UnknownLicenseVersion: unknown license version. +- NoLicenseFile: missing license file. +- UnrecognisedSourceRepo: unrecognised kind of source-repository. +- MissingType: missing ``type`` in ``source-repository``. +- MissingLocation: missing ``location`` in ``source-repository``. +- MissingModule: missing ``module`` in ``source-repository``. +- MissingTag: missing ``tag`` in ``source-repository``. +- SubdirRelPath: ``subdir`` in ``source-repository`` must be relative. +- SubdirGoodRelPath: malformed ``subdir`` in ``source-repository``. +- OptFasm: unnecessary ``-fasm``. +- OptViaC: unnecessary ``-fvia-C``. +- OptHpc: unnecessary ``-fhpc``. +- OptProf: unnecessary ``-prof``. +- OptO: unnecessary ``-o``. +- OptHide: unnecessary ``-hide-package``. +- OptMake: unnecessary ``--make``. +- OptONot: unnecessary disable optimisation flag. +- OptOOne: unnecessary optimisation flag (``-O1``). +- OptOTwo: unnecessary optimisation flag (``-O2``). +- OptSplitSections: unnecessary ``-split-section``. +- OptSplitObjs: unnecessary ``-split-objs``. +- OptWls: unnecessary ``-optl-Wl,-s``. +- OptExts: use ``extension`` field instead of ``-fglasgow-exts``. +- OptRts: unnecessary ``-rtsopts``. +- OptWithRts: unnecessary ``-with-rtsopts``. +- COptONumber: unnecessary ``-O[n]`` in C code. +- COptCPP: unportable ``-cpp-options`` flag. +- OptAlternatives: C-like options in wrong cabal field. +- RelativeOutside: relative path outside of source tree. +- AbsolutePath: absolute path where not allowed. +- BadRelativePath: malformed relative path. +- DistPoint: unreliable path pointing inside ``dist``. +- GlobSyntaxError: glob syntax error. +- RecursiveGlobInRoot: recursive glob including source control folders. +- InvalidOnWin: invalid path on Windows. +- FilePathTooLong: path too long. +- FilePathNameTooLong: path *name* too long (POSIX). +- FilePathSplitTooLong: path non portable (POSIX, split requirements). +- FilePathEmpty: empty path. +- CVTestSuite: ``test-suite`` used with ``cabal-version`` < 1.10. +- CVDefaultLanguage: ``default-language`` used with ``cabal-version`` < 1.10. +- CVDefaultLanguageComponent: missing ``default-language``. +- CVExtraDocFiles: `extra-doc-files` used with ``cabal-version`` < 1.18. +- CVMultiLib: multiple ``library`` sections with ``cabal-version`` < 2.0. +- CVReexported: ``reexported-modules`` with ``cabal-version`` < 1.22. +- CVMixins: ``mixins`` with ``cabal-version`` < 2.0. +- CVExtraFrameworkDirs: ``extra-framework-dirs`` with ``cabal-version`` < 1.24. +- CVDefaultExtensions: ``default-extensions`` with ``cabal-version`` < 1.10. +- CVExtensionsDeprecated: deprecated ``extensions`` field used with ``cabal-version`` ≥ 1.10 +- CVSources: ``asm-sources``, ``cmm-sources``, ``extra-bundled-libraries`` or ``extra-library-flavours`` used with ``cabal-version`` < 3.0. +- CVExtraDynamic: ``extra-dynamic-library-flavours`` used with cabal-version < 3.0. +- CVVirtualModules: ``virtual-modules`` used with cabal-version < 2.2. +- CVSourceRepository: ``source-repository`` used with ``cabal-version`` 1.6. +- CVExtensions: incompatible language extension with ``cabal-version``. +- CVCustomSetup: missing ``setup-depends`` field in ``custom-setup`` with ``cabal-version`` ≥ 1.24. +- CVExpliticDepsCustomSetup: missing dependencies in ``custom-setup`` with ``cabal-version`` ≥ 1.24. +- CVAutogenPaths: missing autogen ``Paths_*`` modules in ``autogen-modules`` (``cabal-version`` ≥ 2.0). +- CVAutogenPackageInfo: missing autogen ``PackageInfo_*`` modules in ``autogen-modules`` *and* ``exposed-modules``/``other-modules`` (``cabal-version`` ≥ 2.0). +- GlobNoMatch: glob pattern not matching any file. +- GlobExactMatch: glob pattern not matching any file becuase of lack of extension matching (`cabal-version` < 2.4). +- GlobNoDir: glob pattern trying to match a missing directory. +- UnknownOS: unknown operating system name in condition. +- UnknownArch: unknown architecture in condition. +- UnknownCompiler: unknown compiler in condition. +- BaseNoUpperBounds: missing upper bounds for important dependencies (``base``, and for ``custom-setup`` ``Cabal`` too). +- MissingUpperBounds: missing upper bound in dependency (excluding test-suites and benchmarks). +- SuspiciousFlagName: troublesome flag name (e.g. starting with a dash). +- DeclaredUsedFlags: unused user flags. +- NonASCIICustomField: non-ASCII characters in custom field. +- RebindableClashPaths: ``Rebindable Syntax`` with ``OverloadedStrings``/``OverloadedStrings`` plus autogenerated ``Paths_*`` modules with ``cabal-version`` < 2.2. +- RebindableClashPackageInfo: ``Rebindable Syntax`` with ``OverloadedStrings``/``OverloadedStrings`` plus autogenerated ``PackageInfo_*`` modules with ``cabal-version`` < 2.2. +- WErrorUnneeded: ``-WError`` not under a user flag. +- JUnneeded: suspicious ``-j[n]`` usage. +- FDeferTypeErrorsUnneeded: suspicious ``-fdefer-type-errors``. +- DynamicUnneeded: suspicious ``-d*`` debug flag for distributed package. +- ProfilingUnneeded: suspicious ``-fprof-*`` flag. +- UpperBoundSetup: missing upper bounds in ``setup-depends``. +- DuplicateModule: duplicate modules in target. +- PotentialDupModule: potential duplicate module in target (subject to conditionals). +- BOMStart: unicode byte order mark (BOM) character at start of file. +- NotPackageName: filename not matching ``name``. +- NoDesc: no ``.cabal`` file found in folder. +- MultiDesc: multiple ``.cabal`` files found in folder. +- UnknownFile: path refers to a file which does not exist. +- MissingSetupFile: missing ``Setup.hs`` or ``Setup.lsh``. +- MissingConfigureScript: missing ``configure`` script with ``build-type: Configure``. +- UnknownDirectory: paths refer to a directory which does not exist. +- MissingSourceControl: missing ``source-repository`` section. +- MissingExpectedDocFiles: missing expected documentation files (changelog). +- WrongFieldForExpectedDocFiles: documentation files listed in ``extra-source-files`` instead of ``extra-doc-files``. + cabal sdist ^^^^^^^^^^^ From c3a92e501cee6959010148241d069256731d20b1 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 8 Nov 2023 12:15:22 +0000 Subject: [PATCH 43/70] ci: Enable windows tests for 9.6.3 There were two failing tests: 1. CCompilerOverride, was attempting to use gcc.exe rather than clang.exe without also overriding the C options which led to incorrect options being passed to gcc.exe. The fix is to override to clang.exe on ghc-9.4 or newer. 2. ForeignLibs exposes a bug in GHC (https://gitlab.haskell.org/ghc/ghc/-/issues/24185) and hence is skipped for GHCs newer than 9.4 where it was first introduced. Towards fixing #8451, we just need to fix the shared library issue now. --- .github/workflows/validate.yml | 2 -- .../CCompilerOverride/custom-cc-clang.bat | 11 ++++++++++ .../CCompilerOverride/setup.test.hs | 21 ++++++++++--------- .../PackageTests/ForeignLibs/setup.test.hs | 3 ++- 4 files changed, 24 insertions(+), 13 deletions(-) create mode 100644 cabal-testsuite/PackageTests/CCompilerOverride/custom-cc-clang.bat diff --git a/.github/workflows/validate.yml b/.github/workflows/validate.yml index 259fcfdca7c..aa6d01a128d 100644 --- a/.github/workflows/validate.yml +++ b/.github/workflows/validate.yml @@ -166,7 +166,6 @@ jobs: # Have to disable *-suite validation: # - the Windows@9.6.1 problem is tracked at https://github.com/haskell/cabal/issues/8858 # - but curently can't run it with GHC 9.6, tracking: https://github.com/haskell/cabal/issues/8883 - if: (runner.os != 'Windows') || (matrix.ghc != '9.6.3') run: sh validate.sh $FLAGS -s lib-suite - name: Validate cli-tests @@ -174,7 +173,6 @@ jobs: - name: Validate cli-suite # Have to disable *-suite validation, see above the comment for lib-suite - if: (runner.os != 'Windows') || (matrix.ghc != '9.6.3') run: sh validate.sh $FLAGS -s cli-suite validate-old-ghcs: diff --git a/cabal-testsuite/PackageTests/CCompilerOverride/custom-cc-clang.bat b/cabal-testsuite/PackageTests/CCompilerOverride/custom-cc-clang.bat new file mode 100644 index 00000000000..72012c9c9d0 --- /dev/null +++ b/cabal-testsuite/PackageTests/CCompilerOverride/custom-cc-clang.bat @@ -0,0 +1,11 @@ +@echo OFF + +where /q clang.exe + +IF %ERRORLEVEL% EQU 0 ( + call clang.exe -DNOERROR6 %* + EXIT /B %ERRORLEVEL% +) + +ECHO "Cannot find C compiler" +EXIT /B 1 diff --git a/cabal-testsuite/PackageTests/CCompilerOverride/setup.test.hs b/cabal-testsuite/PackageTests/CCompilerOverride/setup.test.hs index dbc10efa7a3..5843cb2b7df 100644 --- a/cabal-testsuite/PackageTests/CCompilerOverride/setup.test.hs +++ b/cabal-testsuite/PackageTests/CCompilerOverride/setup.test.hs @@ -6,16 +6,17 @@ import Test.Cabal.Prelude main = setupAndCabalTest $ do skipUnlessGhcVersion ">= 8.8" isWin <- isWindows - ghc94 <- isGhcVersion "== 9.4.*" + ghc94 <- isGhcVersion ">= 9.4.1" env <- getTestEnv let pwd = testCurrentDir env - customCC = pwd ++ "/custom-cc" ++ if isWin then ".bat" else "" + win_suffix = if ghc94 then "-clang.bat" else ".bat" + customCC = + pwd ++ "/custom-cc" ++ if isWin then win_suffix else "" - expectBrokenIf (isWin && ghc94) 8451 $ do - setup "configure" - [ "--ghc-option=-DNOERROR1" - , "--ghc-option=-optc=-DNOERROR2" - , "--ghc-option=-optP=-DNOERROR3" - , "--with-gcc=" ++ customCC - ] - setup "build" ["-v2"] + setup "configure" + [ "--ghc-option=-DNOERROR1" + , "--ghc-option=-optc=-DNOERROR2" + , "--ghc-option=-optP=-DNOERROR3" + , "--with-gcc=" ++ customCC + ] + setup "build" ["-v2"] diff --git a/cabal-testsuite/PackageTests/ForeignLibs/setup.test.hs b/cabal-testsuite/PackageTests/ForeignLibs/setup.test.hs index 2bd17605b72..1dcf918eaed 100644 --- a/cabal-testsuite/PackageTests/ForeignLibs/setup.test.hs +++ b/cabal-testsuite/PackageTests/ForeignLibs/setup.test.hs @@ -17,6 +17,7 @@ import Distribution.Simple.Program.Types import Distribution.System import Distribution.Verbosity import Distribution.Version +import System.Directory import Test.Cabal.Prelude @@ -27,7 +28,7 @@ main = setupAndCabalTest . recordMode DoNotRecord $ do -- Foreign libraries don't work with GHC 7.6 and earlier skipUnlessGhcVersion ">= 7.8" win <- isWindows - ghc94 <- isGhcVersion "== 9.4.*" + ghc94 <- isGhcVersion ">= 9.4.1" expectBrokenIf (win && ghc94) 8451 $ withPackageDb $ do setup_install [] From 8a0a0f0f8be030248600b105a66e92d87fd48d1b Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Mon, 13 Nov 2023 12:57:05 +0000 Subject: [PATCH 44/70] testsuite: Be explicit about runtime test dependencies Issue #8356 reports occasional errors from running the testsuite about multiple package versions available. This stems from the invokation of `runghc` not being explicit about all dependencies of the testsuite. The solution is provide a component in the cabal file which is explicit about which packages the tests can depend on. This component has a build-depends section which lists all the dependencies that the tests require. It would be better if this component was a library component but we can't do this with a Custom setup because of limitations to do with per-component builds. Then we also enable `-hide-all-packages`, so the dependency will not be available if it is not explicitly listed as a dependency. You could also imagine a future where the Setup.hs script found the test files and compiled a single executable which would run all the tests, rather than invoking runghc on each one individually. Fixes #8356 --- cabal-testsuite/README.md | 9 ++++++ cabal-testsuite/Setup.hs | 2 +- cabal-testsuite/cabal-testsuite.cabal | 40 +++++++++++++++++------- cabal-testsuite/src/Test/Cabal/Script.hs | 1 + cabal-testsuite/static/Main.hs | 3 ++ 5 files changed, 42 insertions(+), 13 deletions(-) create mode 100644 cabal-testsuite/static/Main.hs diff --git a/cabal-testsuite/README.md b/cabal-testsuite/README.md index 1fba1d85446..b5036803bce 100644 --- a/cabal-testsuite/README.md +++ b/cabal-testsuite/README.md @@ -96,6 +96,15 @@ Otherwise, here is a walkthrough: ... ``` + The dependencies which your test is allowed to use are listed in the + cabal file under the `test-runtime-deps` executable. At compile-time there is + a custom Setup.hs script which inspects this list and records the versions of + each package in a generated file. These are then used when `cabal-tests` runs + when it invokes `runghc` to run each test. + We ensure they are built and available by listing `test-runtime-deps` in the + build-tool-depends section of the cabal-tests executable. + + 3. Run your tests using `cabal-tests` (no need to rebuild when you add or modify a test; it is automatically picked up). The first time you run a test, assuming everything else is diff --git a/cabal-testsuite/Setup.hs b/cabal-testsuite/Setup.hs index 2b212906a60..d83f9dc60e8 100644 --- a/cabal-testsuite/Setup.hs +++ b/cabal-testsuite/Setup.hs @@ -73,7 +73,7 @@ canonicalizePackageDB x = return x -- non-Backpack. cabalTestsPackages :: LocalBuildInfo -> [(OpenUnitId, ModuleRenaming)] cabalTestsPackages lbi = - case componentNameCLBIs lbi (CExeName (mkUnqualComponentName "cabal-tests")) of + case componentNameCLBIs lbi (CExeName (mkUnqualComponentName "test-runtime-deps")) of [clbi] -> -- [ (unUnitId $ unDefUnitId duid,rn) | (DefiniteUnitId duid, rn) <- componentIncludes clbi ] componentIncludes clbi _ -> error "cabalTestsPackages" diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index 72221b316d5..55aa7921b52 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -90,6 +90,8 @@ executable cabal-tests main-is: cabal-tests.hs hs-source-dirs: main ghc-options: -threaded + -- Make sure these are built before the executable is run + build-tool-depends: cabal-testsuite:test-runtime-deps build-depends: , cabal-testsuite -- constraints inherited via lib:cabal-testsuite component @@ -101,18 +103,6 @@ executable cabal-tests , transformers -- dependencies specific to exe:cabal-tests , clock ^>= 0.7.2 || ^>=0.8 - -- Extra dependencies used by PackageTests. - -- - -- The runner allows the tests to use extra dependencies and the custom Prelude - -- from 'cabal-testsuite'. - -- However, if the tests use a dependency, say 'directory', and there are two - -- packages with the same unit id available in the store, the test fails since - -- it doesn't know which one to pick. - -- By including an extra dependency to directory, we force the test runner to - -- use a specific version directory, fixing the test failure. - -- - -- See issue description and discussion: https://github.com/haskell/cabal/issues/8356 - , directory build-tool-depends: cabal-testsuite:setup default-extensions: TypeOperators @@ -122,6 +112,32 @@ executable setup import: shared main-is: Setup.simple.hs +-- This executable component is used to describe the runtime dependencies of +-- the tests. The Main.hs file and resulting executable are not useful in any way. + +-- Ideally this would be an empty library, but because build-type: Custom, we can't +-- have sublibraries. + +-- If you require an external dependency for a test it must be listed here. +executable test-runtime-deps + build-depends: cabal-testsuite, + base, + directory, + Cabal, + Cabal-syntax, + filepath, + transformers, + bytestring, + time, + process, + exceptions + main-is: static/Main.hs + if !os(windows) + build-depends: unix + else + build-depends: + , Win32 + custom-setup -- we only depend on even stable releases of lib:Cabal -- and due to Custom complexity and ConstraintSetupCabalMaxVersion diff --git a/cabal-testsuite/src/Test/Cabal/Script.hs b/cabal-testsuite/src/Test/Cabal/Script.hs index a7ce082a97b..943ea784c8d 100644 --- a/cabal-testsuite/src/Test/Cabal/Script.hs +++ b/cabal-testsuite/src/Test/Cabal/Script.hs @@ -93,6 +93,7 @@ runnerGhcArgs senv = where ghc_options = M.mempty { ghcOptPackageDBs = runnerPackageDbStack senv , ghcOptPackages = toNubListR (runnerPackages senv) + , ghcOptHideAllPackages = Flag True -- Avoid picking stray module files that look -- like our imports , ghcOptSourcePathClear = Flag True } diff --git a/cabal-testsuite/static/Main.hs b/cabal-testsuite/static/Main.hs new file mode 100644 index 00000000000..de106fe48f9 --- /dev/null +++ b/cabal-testsuite/static/Main.hs @@ -0,0 +1,3 @@ +module Main where + +main = return () From 6df6a48dc1a20f49a979fe15926e4d0a304ef157 Mon Sep 17 00:00:00 2001 From: Samuel Thibault Date: Mon, 13 Nov 2023 19:44:46 +0100 Subject: [PATCH 45/70] hurd: Enable using $ORIGIN in RPATH GNU/Hurd fully supports RPATH and the $ORIGIN development, and we indeed want to use it for relocatable installations shipped in Debian GNU/Hurd. --- Cabal/src/Distribution/Simple/GHC.hs | 2 +- Cabal/src/Distribution/Simple/GHCJS.hs | 2 +- changelog.d/pr-9441 | 3 +++ 3 files changed, 5 insertions(+), 2 deletions(-) create mode 100644 changelog.d/pr-9441 diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index f218d7c117a..3d79a8356ab 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -2022,7 +2022,7 @@ getRPaths lbi clbi | supportRPaths hostOS = do supportRPaths Android = False supportRPaths Ghcjs = False supportRPaths Wasi = False - supportRPaths Hurd = False + supportRPaths Hurd = True supportRPaths Haiku = False supportRPaths (OtherOS _) = False -- Do _not_ add a default case so that we get a warning here when a new OS diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs index 5ed2d9327e9..c13afba220c 100644 --- a/Cabal/src/Distribution/Simple/GHCJS.hs +++ b/Cabal/src/Distribution/Simple/GHCJS.hs @@ -1697,7 +1697,7 @@ getRPaths lbi clbi | supportRPaths hostOS = do supportRPaths Android = False supportRPaths Ghcjs = False supportRPaths Wasi = False - supportRPaths Hurd = False + supportRPaths Hurd = True supportRPaths Haiku = False supportRPaths (OtherOS _) = False -- Do _not_ add a default case so that we get a warning here when a new OS diff --git a/changelog.d/pr-9441 b/changelog.d/pr-9441 new file mode 100644 index 00000000000..c47ea10da13 --- /dev/null +++ b/changelog.d/pr-9441 @@ -0,0 +1,3 @@ +synopsis: Enable using $ORIGIN in RPATH on GNU/Hurd +packages: Cabal +prs: #9441 From 5a21d99f2a778eb842c819a28e855a5620383b1a Mon Sep 17 00:00:00 2001 From: Samuel Thibault Date: Sun, 12 Nov 2023 16:06:14 +0100 Subject: [PATCH 46/70] Fix the platform string for GNU/Hurd Since version 9.4.7-1, ghc fails to build on the GNU/Hurd port of Debian, see https://buildd.debian.org/status/fetch.php?pkg=ghc&arch=hurd-i386&ver=9.4.7-1&stamp=1697717885&raw=0 Error, rule finished running but did not produce file: _build/stage0/lib/i386-gnu-ghc-9.4.6/ghc-boot-th-9.4.7/libHSghc-boot-th-9.4.7.a and indeed, what did get produce was rather _build/stage0/lib/i386-hurd-ghc-9.4.6/ghc-boot-th-9.4.7/libHSghc-boot-th-9.4.7.a (i386-hurd instead of i386-gnu). This is due to confusion between hurd and gnu in various places. Apparently previous versions of ghc were using gnu for the GNU/Hurd port, and thus putting libraries etc. in i386-gnu. So we have to follow the existing practice. --- Cabal/src/Distribution/Simple/GHC/Internal.hs | 1 + changelog.d/pr-9434 | 11 +++++++++++ 2 files changed, 12 insertions(+) create mode 100644 changelog.d/pr-9434 diff --git a/Cabal/src/Distribution/Simple/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs index 4c9bce31f8e..3dbe54238fc 100644 --- a/Cabal/src/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/src/Distribution/Simple/GHC/Internal.hs @@ -785,6 +785,7 @@ ghcOsString :: OS -> String ghcOsString Windows = "mingw32" ghcOsString OSX = "darwin" ghcOsString Solaris = "solaris2" +ghcOsString Hurd = "gnu" ghcOsString other = prettyShow other -- | GHC's rendering of its platform and compiler version string as used in diff --git a/changelog.d/pr-9434 b/changelog.d/pr-9434 new file mode 100644 index 00000000000..a7872ea3fb3 --- /dev/null +++ b/changelog.d/pr-9434 @@ -0,0 +1,11 @@ +synopsis: Fix the platform string for GNU/Hurd +packages: Cabal +prs: #9434 + +description: { + +Depending who you ask, GNU/Hurd will be labelled "gnu" or "hurd". The autotools +use "gnu", so ghc follows this for installed files, even if the ghc source code +uses OSHurd. We thus need to add the translation between the two. + +} From 09a09df29fa02adf286fbb1a0271fa104ab4a014 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Mon, 18 Sep 2023 11:13:37 +1000 Subject: [PATCH 47/70] Fix configuation of ldProgram Standard GNU `ld` ues `--relocatable` while `ld.gold` uses a `-relocatable` flag (with a single `-`). Code will now detect both versions. --- Cabal/src/Distribution/Simple/Program/Builtin.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/Cabal/src/Distribution/Simple/Program/Builtin.hs b/Cabal/src/Distribution/Simple/Program/Builtin.hs index e604dbbe962..e79e676d8cc 100644 --- a/Cabal/src/Distribution/Simple/Program/Builtin.hs +++ b/Cabal/src/Distribution/Simple/Program/Builtin.hs @@ -370,7 +370,19 @@ ldProgram = -- `lld` only accepts `-help`. `catchIO` (\_ -> return "") let k = "Supports relocatable output" - v = if "--relocatable" `isInfixOf` ldHelpOutput then "YES" else "NO" + -- Standard GNU `ld` uses `--relocatable` while `ld.gold` uses + -- `-relocatable` (single `-`). + v + | "-relocatable" `isInfixOf` ldHelpOutput = "YES" + -- ld64 on macOS has this lovely response for "--help" + -- + -- ld64: For information on command line options please use 'man ld'. + -- + -- it does however support -r, if you read the manpage + -- (e.g. https://www.manpagez.com/man/1/ld64/) + | "ld64:" `isPrefixOf` ldHelpOutput = "YES" + | otherwise = "NO" + m = Map.insert k v (programProperties ldProg) return $ ldProg{programProperties = m} } From db332422629dc3261a4929ccbe1807ab568f66dc Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Mon, 18 Sep 2023 11:24:59 +1000 Subject: [PATCH 48/70] Chain configuration of ldProgram `ldProgram` gets configured in two places, a seemingly default and a GHC specific version. The later needs to be updated so that it first calls the default configuration and then the new GHC version. --- Cabal/src/Distribution/Simple/GHC/Internal.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Cabal/src/Distribution/Simple/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs index 3dbe54238fc..322a227adfd 100644 --- a/Cabal/src/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/src/Distribution/Simple/GHC/Internal.hs @@ -114,7 +114,9 @@ configureToolchain _implInfo ghcProg ghcInfo = . addKnownProgram ldProgram { programFindLocation = findProg ldProgramName extraLdPath - , programPostConf = configureLd + , programPostConf = \v cp -> + -- Call any existing configuration first and then add any new configuration + configureLd v =<< programPostConf ldProgram v cp } . addKnownProgram arProgram From e406c64507d8a0bf578d81c95cd3d7862bfa5960 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Wed, 15 Nov 2023 13:09:13 +1100 Subject: [PATCH 49/70] Use linker capability detection to improve linker use The function `comperSupportsGhciLibs` has been renamed to `linkerSupportsGhciLibs` because its about the linker not the compiler. The function `comperSupportsGhciLibs` was using the compiler version as a proxy for whether the linker supports relocatable objects. Now support for relocatable objects is detected by running the linker. --- Cabal/src/Distribution/Simple/Configure.hs | 35 ++++++++++----------- Cabal/src/Distribution/Simple/Program/Db.hs | 7 ++++- changelog.d/pr-9443 | 11 +++++++ 3 files changed, 33 insertions(+), 20 deletions(-) create mode 100644 changelog.d/pr-9443 diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index 1c9188a2a6b..b7aabf65f18 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -82,6 +82,7 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.PreProcess import Distribution.Simple.Program +import Distribution.Simple.Program.Db (lookupProgramByName) import Distribution.Simple.Setup.Common as Setup import Distribution.Simple.Setup.Config as Setup import Distribution.Simple.Utils @@ -767,22 +768,16 @@ configure (pkg_descr0, pbi) cfg = do ) return False - let compilerSupportsGhciLibs :: Bool - compilerSupportsGhciLibs = - case compilerId comp of - CompilerId GHC version - | version > mkVersion [9, 3] && windows -> - False - CompilerId GHC _ -> - True - CompilerId GHCJS _ -> - True - _ -> False - where - windows = case compPlatform of - Platform _ Windows -> True - Platform _ _ -> False - + -- Basically yes/no/unknown. + let linkerSupportsRelocations :: Maybe Bool + linkerSupportsRelocations = + case lookupProgramByName "ld" programDb'' of + Nothing -> Nothing + Just ld -> + case Map.lookup "Supports relocatable output" $ programProperties ld of + Just "YES" -> Just True + Just "NO" -> Just False + _other -> Nothing let ghciLibByDefault = case compilerId comp of CompilerId GHC _ -> @@ -801,10 +796,12 @@ configure (pkg_descr0, pbi) cfg = do withGHCiLib_ <- case fromFlagOrDefault ghciLibByDefault (configGHCiLib cfg) of - True | not compilerSupportsGhciLibs -> do + -- NOTE: If linkerSupportsRelocations is Nothing this may still fail if the + -- linker does not support -r. + True | not (fromMaybe True linkerSupportsRelocations) -> do warn verbosity $ - "--enable-library-for-ghci is no longer supported on Windows with" - ++ " GHC 9.4 and later; ignoring..." + "--enable-library-for-ghci is not supported with the current" + ++ " linker; ignoring..." return False v -> return v diff --git a/Cabal/src/Distribution/Simple/Program/Db.hs b/Cabal/src/Distribution/Simple/Program/Db.hs index 5bef94e4b5f..1407230b93b 100644 --- a/Cabal/src/Distribution/Simple/Program/Db.hs +++ b/Cabal/src/Distribution/Simple/Program/Db.hs @@ -46,6 +46,7 @@ module Distribution.Simple.Program.Db , userSpecifyArgss , userSpecifiedArgs , lookupProgram + , lookupProgramByName , updateProgram , configuredPrograms @@ -299,7 +300,11 @@ userSpecifiedArgs prog = -- | Try to find a configured program lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgram -lookupProgram prog = Map.lookup (programName prog) . configuredProgs +lookupProgram = lookupProgramByName . programName + +-- | Try to find a configured program +lookupProgramByName :: String -> ProgramDb -> Maybe ConfiguredProgram +lookupProgramByName name = Map.lookup name . configuredProgs -- | Update a configured program in the database. updateProgram diff --git a/changelog.d/pr-9443 b/changelog.d/pr-9443 new file mode 100644 index 00000000000..353f1fb8cbd --- /dev/null +++ b/changelog.d/pr-9443 @@ -0,0 +1,11 @@ +synopsis: Use linker capability detection to improve linker use +packages: Cabal +prs: #9443 + +description: { + +- Previously the GHC version number and platform were used as a proxy for whether + the linker can generate relocatable objects. +- Now, the ability of the linker to create relocatable objects is detected. + +} From 2aa76b5f1f1d506fe9458861e141282dad7139f3 Mon Sep 17 00:00:00 2001 From: brandon s allbery kf8nh Date: Wed, 8 Nov 2023 12:51:10 -0500 Subject: [PATCH 50/70] add `merge+no rebase` and a few typos while reviewing --- CONTRIBUTING.md | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index eb2700d377a..c8149330eb5 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -38,20 +38,20 @@ cabal build cabal-tests # etc... Running tests ------------- -**Using Github Actions.** +**Using GitHub Actions.** If you are not in a hurry, the most convenient way to run tests on Cabal is to make a branch on GitHub and then open a pull request; our -continuous integration service on Github Actions builds and +continuous integration service on GitHub Actions builds and tests your code. Title your PR with WIP so we know that it does not need code review. -Some tips for using Github Actions effectively: +Some tips for using GitHub Actions effectively: -* Github Actions builds take a long time. Use them when you are pretty +* GitHub Actions builds take a long time. Use them when you are pretty sure everything is OK; otherwise, try to run relevant tests locally first. -* Watch over your jobs on the [Github Actions website](http://github.org/haskell/cabal/actions). +* Watch over your jobs on the [GitHub Actions website](http://github.org/haskell/cabal/actions). If you know a build of yours is going to fail (because one job has already failed), be nice to others and cancel the rest of the jobs, so that other commits on the build queue can be processed. @@ -75,9 +75,9 @@ failures: a specific operating system? If so, try reproducing the problem on the specific configuration. -4. Is the test failing on a Github Actions per-GHC build. +4. Is the test failing on a GitHub Actions per-GHC build. In this case, if you click on "Branch", you can get access to - the precise binaries that were built by Github Actions that are being + the precise binaries that were built by GitHub Actions that are being tested. If you have an Ubuntu system, you can download the binaries and run them directly. @@ -176,7 +176,7 @@ Other Conventions * Our GHC support window is five years for the Cabal library and three years for cabal-install: that is, the Cabal library must be buildable out-of-the-box with the dependencies that shipped with GHC - for at least five years. The Travis CI checks this, so most + for at least five years. GitHub Actions checks this, so most developers submit a PR to see if their code works on all these versions of GHC. `cabal-install` must also be buildable on all supported GHCs, although it does not have to be buildable @@ -218,7 +218,7 @@ GitHub Ticket Conventions Each major `Cabal`/`cabal-install` release (e.g. 3.4, 3.6, etc.) has a corresponding GitHub Project and milestone. A ticket is included in a release's -project if the release managers are tenatively planning on including a fix for +project if the release managers are tentatively planning on including a fix for the ticket in the release, i.e. if they are actively seeking someone to work on the ticket. @@ -247,6 +247,11 @@ If your pull request consists of several commits, consider using `squash+merge me` instead of `merge me`: the Mergify bot will squash all the commits into one and concatenate the commit messages of the commits before merging. +There is also a `merge+no rebase` label. Use this very sparingly, as not rebasing +severely complicates Git history. It is intended for special circumstances, as when +the PR branch cannot or should not be modified. If you have any questions about it, +please ask us. + Changelog --------- From 71b7a6f8a73d9f4b4e7a08c4b5c0876841394adc Mon Sep 17 00:00:00 2001 From: John Paul Adrian Glaubitz Date: Tue, 14 Nov 2023 08:48:14 +0100 Subject: [PATCH 51/70] Add support for 64-bit SPARC as a separate architecture Previously, sparc64 was defined as an alias for the 32-bit SPARC architecture which was true while SPARC mainland was mostly 32 bits. More recently, 64-bit SPARC has become a port of its own, so it needs to be treated as a separate architecture. --- Cabal-syntax/src/Distribution/System.hs | 8 ++++---- .../tests/UnitTests/Distribution/Utils/Structured.hs | 4 ++-- Cabal/src/Distribution/Simple/PreProcess.hs | 1 + changelog.d/pr-9445 | 3 +++ 4 files changed, 10 insertions(+), 6 deletions(-) create mode 100644 changelog.d/pr-9445 diff --git a/Cabal-syntax/src/Distribution/System.hs b/Cabal-syntax/src/Distribution/System.hs index 041d13a3be7..b15d8e388e7 100644 --- a/Cabal-syntax/src/Distribution/System.hs +++ b/Cabal-syntax/src/Distribution/System.hs @@ -182,13 +182,12 @@ buildOS = classifyOS Permissive System.Info.os -- ------------------------------------------------------------ -- | These are the known Arches: I386, X86_64, PPC, PPC64, Sparc, --- Arm, AArch64, Mips, SH, IA64, S390, S390X, Alpha, Hppa, Rs6000, --- M68k, Vax, RISCV64, LoongArch64, JavaScript and Wasm32. +-- Sparc64, Arm, AArch64, Mips, SH, IA64, S390, S390X, Alpha, Hppa, +-- Rs6000, M68k, Vax, RISCV64, LoongArch64, JavaScript and Wasm32. -- -- The following aliases can also be used: -- * PPC alias: powerpc -- * PPC64 alias : powerpc64, powerpc64le --- * Sparc aliases: sparc64, sun4 -- * Mips aliases: mipsel, mipseb -- * Arm aliases: armeb, armel -- * AArch64 aliases: arm64 @@ -198,6 +197,7 @@ data Arch | PPC | PPC64 | Sparc + | Sparc64 | Arm | AArch64 | Mips @@ -228,6 +228,7 @@ knownArches = , PPC , PPC64 , Sparc + , Sparc64 , Arm , AArch64 , Mips @@ -251,7 +252,6 @@ archAliases Strict _ = [] archAliases Compat _ = [] archAliases _ PPC = ["powerpc"] archAliases _ PPC64 = ["powerpc64", "powerpc64le"] -archAliases _ Sparc = ["sparc64", "sun4"] archAliases _ Mips = ["mipsel", "mipseb"] archAliases _ Arm = ["armeb", "armel"] archAliases _ AArch64 = ["arm64"] diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index 900aedc0ca3..caf3e16d038 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs @@ -27,9 +27,9 @@ tests = testGroup "Distribution.Utils.Structured" -- The difference is in encoding of newtypes #if MIN_VERSION_base(4,7,0) , testCase "GenericPackageDescription" $ - md5Check (Proxy :: Proxy GenericPackageDescription) 0x6ad1e12c6f88291e9b8c131d239eda70 + md5Check (Proxy :: Proxy GenericPackageDescription) 0xb287a6f04e34ef990cdd15bc6cb01c76 , testCase "LocalBuildInfo" $ - md5Check (Proxy :: Proxy LocalBuildInfo) 0xbc7ac84a9bc43345c812af222c3e5ba0 + md5Check (Proxy :: Proxy LocalBuildInfo) 0x26e91a71ebd19d4d6ce37f798ede249a #endif ] diff --git a/Cabal/src/Distribution/Simple/PreProcess.hs b/Cabal/src/Distribution/Simple/PreProcess.hs index 31e228812d6..886ba7e7fd6 100644 --- a/Cabal/src/Distribution/Simple/PreProcess.hs +++ b/Cabal/src/Distribution/Simple/PreProcess.hs @@ -850,6 +850,7 @@ platformDefines lbi = PPC -> ["powerpc"] PPC64 -> ["powerpc64"] Sparc -> ["sparc"] + Sparc64 -> ["sparc64"] Arm -> ["arm"] AArch64 -> ["aarch64"] Mips -> ["mips"] diff --git a/changelog.d/pr-9445 b/changelog.d/pr-9445 new file mode 100644 index 00000000000..37f024ea060 --- /dev/null +++ b/changelog.d/pr-9445 @@ -0,0 +1,3 @@ +synopsis: Add support for 64-bit SPARC as a separate architecture +prs: #9445 +packages: Cabal Cabal-syntax From 30e6ea703d3dbd8713fb398f4905ace95bc4193f Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Fri, 10 Nov 2023 19:26:45 -0800 Subject: [PATCH 52/70] Remove debug-conflict-sets flag from solver package Fixes #8937. The debug-conflict-sets build flag probably hasn't been used for a long time, and it isn't currently tested. This commit removes the flag, converts the ConflictSet type back to a newtype, and removes an unnecessary instance. --- bootstrap/linux-8.10.7.json | 1 - bootstrap/linux-9.0.2.json | 1 - bootstrap/linux-9.2.7.json | 1 - bootstrap/linux-9.4.4.json | 1 - .../cabal-install-solver.cabal | 9 -- .../Solver/Modular/ConflictSet.hs | 99 ++----------------- .../Distribution/Solver/Modular/Validate.hs | 14 +-- 7 files changed, 11 insertions(+), 115 deletions(-) diff --git a/bootstrap/linux-8.10.7.json b/bootstrap/linux-8.10.7.json index 4ef250fd0c2..52852989fe0 100644 --- a/bootstrap/linux-8.10.7.json +++ b/bootstrap/linux-8.10.7.json @@ -337,7 +337,6 @@ "cabal_sha256": null, "component": "lib:cabal-install-solver", "flags": [ - "-debug-conflict-sets", "-debug-expensive-assertions", "-debug-tracetree" ], diff --git a/bootstrap/linux-9.0.2.json b/bootstrap/linux-9.0.2.json index 36613ac64ea..e870c3f507e 100644 --- a/bootstrap/linux-9.0.2.json +++ b/bootstrap/linux-9.0.2.json @@ -337,7 +337,6 @@ "cabal_sha256": null, "component": "lib:cabal-install-solver", "flags": [ - "-debug-conflict-sets", "-debug-expensive-assertions", "-debug-tracetree" ], diff --git a/bootstrap/linux-9.2.7.json b/bootstrap/linux-9.2.7.json index 4cc8973f751..408cd0f322b 100644 --- a/bootstrap/linux-9.2.7.json +++ b/bootstrap/linux-9.2.7.json @@ -300,7 +300,6 @@ "cabal_sha256": null, "component": "lib:cabal-install-solver", "flags": [ - "-debug-conflict-sets", "-debug-expensive-assertions", "-debug-tracetree" ], diff --git a/bootstrap/linux-9.4.4.json b/bootstrap/linux-9.4.4.json index af00acf12af..7d266473342 100644 --- a/bootstrap/linux-9.4.4.json +++ b/bootstrap/linux-9.4.4.json @@ -290,7 +290,6 @@ "cabal_sha256": null, "component": "lib:cabal-install-solver", "flags": [ - "-debug-conflict-sets", "-debug-expensive-assertions", "-debug-tracetree" ], diff --git a/cabal-install-solver/cabal-install-solver.cabal b/cabal-install-solver/cabal-install-solver.cabal index 4157d98283b..b4bfa668702 100644 --- a/cabal-install-solver/cabal-install-solver.cabal +++ b/cabal-install-solver/cabal-install-solver.cabal @@ -27,11 +27,6 @@ flag debug-expensive-assertions default: False manual: True -flag debug-conflict-sets - description: Add additional information to ConflictSets - default: False - manual: True - flag debug-tracetree description: Compile in support for tracetree (used to debug the solver) default: False @@ -119,10 +114,6 @@ library if flag(debug-expensive-assertions) cpp-options: -DDEBUG_EXPENSIVE_ASSERTIONS - if flag(debug-conflict-sets) - cpp-options: -DDEBUG_CONFLICT_SETS - build-depends: base >=4.9 - if flag(debug-tracetree) cpp-options: -DDEBUG_TRACETREE build-depends: tracetree ^>=0.1 diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs b/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs index 190e811f06f..00cf15b466f 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE CPP #-} -#ifdef DEBUG_CONFLICT_SETS -{-# LANGUAGE ImplicitParams #-} -#endif -- | Conflict sets -- -- Intended for double import @@ -13,9 +9,6 @@ module Distribution.Solver.Modular.ConflictSet ( , Conflict(..) , ConflictMap , OrderedVersionRange(..) -#ifdef DEBUG_CONFLICT_SETS - , conflictSetOrigin -#endif , showConflictSet , showCSSortedByFrequency , showCSWithFrequency @@ -44,36 +37,17 @@ import Data.Function (on) import qualified Data.Map.Strict as M import qualified Data.Set as S -#ifdef DEBUG_CONFLICT_SETS -import Data.Tree -import GHC.Stack -#endif - import Distribution.Solver.Modular.Var import Distribution.Solver.Modular.Version import Distribution.Solver.Types.PackagePath -- | The set of variables involved in a solver conflict, each paired with -- details about the conflict. -data ConflictSet = CS { +newtype ConflictSet = CS { -- | The set of variables involved in the conflict - conflictSetToMap :: !(Map (Var QPN) (Set Conflict)) - -#ifdef DEBUG_CONFLICT_SETS - -- | The origin of the conflict set - -- - -- When @DEBUG_CONFLICT_SETS@ is defined @(-f debug-conflict-sets)@, - -- we record the origin of every conflict set. For new conflict sets - -- ('empty', 'fromVars', ..) we just record the 'CallStack'; for operations - -- that construct new conflict sets from existing conflict sets ('union', - -- 'filter', ..) we record the 'CallStack' to the call to the combinator - -- as well as the 'CallStack's of the input conflict sets. - -- - -- Requires @GHC >= 7.10@. - , conflictSetOrigin :: Tree CallStack -#endif + conflictSetToMap :: Map (Var QPN) (Set Conflict) } - deriving (Show) + deriving (Eq, Show) -- | More detailed information about how a conflict set variable caused a -- conflict. This information can be used to determine whether a second value @@ -112,12 +86,6 @@ newtype OrderedVersionRange = OrderedVersionRange VR instance Ord OrderedVersionRange where compare = compare `on` show -instance Eq ConflictSet where - (==) = (==) `on` conflictSetToMap - -instance Ord ConflictSet where - compare = compare `on` conflictSetToMap - showConflictSet :: ConflictSet -> String showConflictSet = intercalate ", " . map showVar . toList @@ -147,40 +115,19 @@ toSet = M.keysSet . conflictSetToMap toList :: ConflictSet -> [Var QPN] toList = M.keys . conflictSetToMap -union :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - ConflictSet -> ConflictSet -> ConflictSet +union :: ConflictSet -> ConflictSet -> ConflictSet union cs cs' = CS { conflictSetToMap = M.unionWith S.union (conflictSetToMap cs) (conflictSetToMap cs') -#ifdef DEBUG_CONFLICT_SETS - , conflictSetOrigin = Node ?loc (map conflictSetOrigin [cs, cs']) -#endif } -unions :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - [ConflictSet] -> ConflictSet +unions :: [ConflictSet] -> ConflictSet unions css = CS { conflictSetToMap = M.unionsWith S.union (map conflictSetToMap css) -#ifdef DEBUG_CONFLICT_SETS - , conflictSetOrigin = Node ?loc (map conflictSetOrigin css) -#endif } -insert :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - Var QPN -> ConflictSet -> ConflictSet +insert :: Var QPN -> ConflictSet -> ConflictSet insert var cs = CS { conflictSetToMap = M.insert var (S.singleton OtherConflict) (conflictSetToMap cs) -#ifdef DEBUG_CONFLICT_SETS - , conflictSetOrigin = Node ?loc [conflictSetOrigin cs] -#endif } delete :: Var QPN -> ConflictSet -> ConflictSet @@ -188,35 +135,17 @@ delete var cs = CS { conflictSetToMap = M.delete var (conflictSetToMap cs) } -empty :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - ConflictSet +empty :: ConflictSet empty = CS { conflictSetToMap = M.empty -#ifdef DEBUG_CONFLICT_SETS - , conflictSetOrigin = Node ?loc [] -#endif } -singleton :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - Var QPN -> ConflictSet +singleton :: Var QPN -> ConflictSet singleton var = singletonWithConflict var OtherConflict -singletonWithConflict :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - Var QPN -> Conflict -> ConflictSet +singletonWithConflict :: Var QPN -> Conflict -> ConflictSet singletonWithConflict var conflict = CS { conflictSetToMap = M.singleton var (S.singleton conflict) -#ifdef DEBUG_CONFLICT_SETS - , conflictSetOrigin = Node ?loc [] -#endif } size :: ConflictSet -> Int @@ -228,17 +157,9 @@ member var = M.member var . conflictSetToMap lookup :: Var QPN -> ConflictSet -> Maybe (Set Conflict) lookup var = M.lookup var . conflictSetToMap -fromList :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - [Var QPN] -> ConflictSet +fromList :: [Var QPN] -> ConflictSet fromList vars = CS { conflictSetToMap = M.fromList [(var, S.singleton OtherConflict) | var <- vars] -#ifdef DEBUG_CONFLICT_SETS - , conflictSetOrigin = Node ?loc [] -#endif } type ConflictMap = Map (Var QPN) Int - diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs index 54911f2c367..cbe6282b6d0 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs @@ -1,9 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE CPP #-} -#ifdef DEBUG_CONFLICT_SETS -{-# LANGUAGE ImplicitParams #-} -#endif module Distribution.Solver.Modular.Validate (validateTree) where -- Validation of the tree. @@ -40,10 +36,6 @@ import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb, pkgConfigPkgIsPresent import Distribution.Types.LibraryName import Distribution.Types.PkgconfigVersionRange -#ifdef DEBUG_CONFLICT_SETS -import GHC.Stack (CallStack) -#endif - -- In practice, most constraints are implication constraints (IF we have made -- a number of choices, THEN we also have to ensure that). We call constraints -- that for which the preconditions are fulfilled ACTIVE. We maintain a set @@ -450,11 +442,7 @@ extendWithPackageChoice (PI qpn i) ppa = -- set in the sense the it contains variables that allow us to backjump -- further. We might apply some heuristics here, such as to change the -- order in which we check the constraints. -merge :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - MergedPkgDep -> PkgDep -> Either (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep +merge :: MergedPkgDep -> PkgDep -> Either (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep merge (MergedDepFixed comp1 vs1 i1) (PkgDep vs2 (PkgComponent p comp2) ci@(Fixed i2)) | i1 == i2 = Right $ MergedDepFixed comp1 vs1 i1 | otherwise = From 893dcdbaeefdafc6552259a6c8d889d4b006ab9b Mon Sep 17 00:00:00 2001 From: David Binder Date: Tue, 21 Nov 2023 18:45:36 +0100 Subject: [PATCH 53/70] Finish improvements to the CI configuration for documentation changes (#9460) * Add bootstrap postjob to CI config Add a new job to the bootstrap.yml GitHub action config. This job succeeds if, and only if, all the other bootstrap jobs succeed. * Do not run bootstrap CI jobs for documentation changes The approach was already introduced in #9355 for the validate jobs. This commit introduces the same change also for the bootstrap jobs. * Also ignore CONTRIBUTING.md and README.md in CI We do not run the entire CI suite for documentation changes. Previously, only changes which were restricted to the 'docs/' subdirectory were considered to be documentation changes. With this commit we also recognize changes to README.md and CONTRIBUTING.md as documentation changes. * Document improved CI for documentation in CONTRIBUTING.md The CONTRIBUTING.md file now mentions that documentation changes do not waste expensive CI resources. * Recognize all README.md in subdirs as documentation Expensive CI jobs should not run on changes which affect only README.md files. --- .github/workflows/bootstrap.skip.yml | 39 ++++++++++++++++++++++++++++ .github/workflows/bootstrap.yml | 28 ++++++++++++++++++++ .github/workflows/validate.skip.yml | 12 ++++++--- .github/workflows/validate.yml | 10 +++++-- CONTRIBUTING.md | 6 +++++ 5 files changed, 90 insertions(+), 5 deletions(-) create mode 100644 .github/workflows/bootstrap.skip.yml diff --git a/.github/workflows/bootstrap.skip.yml b/.github/workflows/bootstrap.skip.yml new file mode 100644 index 00000000000..4a92ddaa0c6 --- /dev/null +++ b/.github/workflows/bootstrap.skip.yml @@ -0,0 +1,39 @@ +name: Bootstrap Skip + +# This Workflow is special and contains a workaround for a known limitation of GitHub CI. +# +# The problem: We don't want to run the "bootstrap" jobs on PRs which contain only changes +# to the docs, since these jobs take a long time to complete without providing any benefit. +# We therefore use path-filtering in the workflow triggers for the bootstrap jobs, namely +# "paths-ignore: doc/**". But the "Bootstrap post job" is a required job, therefore a PR cannot +# be merged unless the "Bootstrap post job" completes succesfully, which it doesn't do if we +# filter it out. +# +# The solution: We use a second job with the same name which always returns the exit code 0. +# The logic implemented for "required" workflows accepts if 1) at least one job with that name +# runs through, AND 2) If multiple jobs of that name exist, then all jobs of that name have to +# finish successfully. +on: + push: + paths: + - 'doc/**' + - '**/README.md' + - 'CONTRIBUTING.md' + branches: + - master + pull_request: + paths: + - 'doc/**' + - '**/README.md' + - 'CONTRIBUTING.md' + release: + types: + - created + +jobs: + bootstrap-post-job: + if: always() + name: Bootstrap post job + runs-on: ubuntu-latest + steps: + - run: exit 0 diff --git a/.github/workflows/bootstrap.yml b/.github/workflows/bootstrap.yml index c1734736e4c..03dafc3f59d 100644 --- a/.github/workflows/bootstrap.yml +++ b/.github/workflows/bootstrap.yml @@ -5,11 +5,22 @@ concurrency: group: ${{ github.ref }}-${{ github.workflow }} cancel-in-progress: true +# Note: This workflow file contains the required job "Bootstrap post job". We are using path filtering +# here to ignore PRs which only change documentation. This can cause a problem, see the workflow file +# "bootstrap.skip.yml" for a description of the problem and the solution provided in that file. on: push: + paths-ignore: + - 'doc/**' + - '**/README.md' + - 'CONTRIBUTING.md' branches: - master pull_request: + paths-ignore: + - 'doc/**' + - '**/README.md' + - 'CONTRIBUTING.md' release: types: - created @@ -66,3 +77,20 @@ jobs: with: name: cabal-${{ matrix.os }}-${{ matrix.ghc }}-bootstrapped path: _build/artifacts/* + + # We use this job as a summary of the workflow + # It will fail if any of the previous jobs does it + # This way we can use it exclusively in branch protection rules + # and abstract away the concrete jobs of the workflow, including their names + bootstrap-post-job: + if: always() + name: Bootstrap post job + runs-on: ubuntu-latest + # IMPORTANT! Any job added to the workflow should be added here too + needs: [bootstrap] + + steps: + - run: | + echo "jobs info: ${{ toJSON(needs) }}" + - if: contains(needs.*.result, 'failure') || contains(needs.*.result, 'cancelled') + run: exit 1 diff --git a/.github/workflows/validate.skip.yml b/.github/workflows/validate.skip.yml index b67d41dd2c4..e5cd47e284a 100644 --- a/.github/workflows/validate.skip.yml +++ b/.github/workflows/validate.skip.yml @@ -5,7 +5,7 @@ name: Validate Skip # The problem: We don't want to run the "validate" jobs on PRs which contain only changes # to the docs, since these jobs take a long time to complete without providing any benefit. # We therefore use path-filtering in the workflow triggers for the validate jobs, namely -# "paths_ignore: doc/**". But the "Validate post job" is a required job, therefore a PR cannot +# "paths-ignore: doc/**". But the "Validate post job" is a required job, therefore a PR cannot # be merged unless the "Validate post job" completes succesfully, which it doesn't do if we # filter it out. # @@ -15,11 +15,17 @@ name: Validate Skip # finish successfully. on: push: - paths: 'doc/**' + paths: + - 'doc/**' + - '**/README.md' + - 'CONTRIBUTING.md' branches: - master pull_request: - paths: 'doc/**' + paths: + - 'doc/**' + - '**/README.md' + - 'CONTRIBUTING.md' release: types: - created diff --git a/.github/workflows/validate.yml b/.github/workflows/validate.yml index aa6d01a128d..78652b10af7 100644 --- a/.github/workflows/validate.yml +++ b/.github/workflows/validate.yml @@ -16,11 +16,17 @@ concurrency: # "validate.skip.yml" for a description of the problem and the solution provided in that file. on: push: - paths-ignore: 'doc/**' + paths-ignore: + - 'doc/**' + - '**/README.md' + - 'CONTRIBUTING.md' branches: - master pull_request: - paths-ignore: 'doc/**' + paths-ignore: + - 'doc/**' + - '**/README.md' + - 'CONTRIBUTING.md' release: types: - created diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index c8149330eb5..cf3357a71d4 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -51,6 +51,12 @@ Some tips for using GitHub Actions effectively: sure everything is OK; otherwise, try to run relevant tests locally first. +* If you are only changing documentation in the `docs/` subdirectory, + or if you change `README.md` or `CONTRIBUTING.md`, then we only run a + small subset of the CI jobs. You can therefore open small PRs with + improvements to the documentation without feeling guilty about wasted + resources! + * Watch over your jobs on the [GitHub Actions website](http://github.org/haskell/cabal/actions). If you know a build of yours is going to fail (because one job has already failed), be nice to others and cancel the rest of the jobs, From f6a46db12c70a1378a003c16ab9e9f96dbb647f0 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 8 Nov 2023 10:32:10 +0000 Subject: [PATCH 54/70] formatting: Add style-commit makefile target This target allows you to format a range of commits, for example: ``` make style-commit COMMIT=HEAD~1 > Last commit is formatted make style-commit COMMIT=abcde > Commits between HEAD and abcde are formatted ``` --- CONTRIBUTING.md | 11 +++++++++-- Makefile | 4 ++++ 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index cf3357a71d4..1f313e3d43c 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -155,8 +155,15 @@ Code Style --------------- We use automated formatting with Fourmolu to enforce a unified style across the code bases. It is checked in the CI process. -After installing Fourmolu 0.12, you can automatically format the code bases with `make style` at the top level of the project. -You can also use `make style-modified` to only format modified files. +After installing Fourmolu 0.12, there are some makefile targets to help formatting +the code base. + + +* `make style` - Format the `Cabal`, `Cabal-syntax` and `cabal-install` directories. +* `make style-modified` - Format files modified in the current tree. +* `make style-commit COMMIT=` - Format files modified between HEAD and the given reference. + + Other Conventions ----------------- diff --git a/Makefile b/Makefile index 56747e4b9f5..9718bfd696c 100644 --- a/Makefile +++ b/Makefile @@ -25,6 +25,10 @@ style-modified: ## Run the code styler on modified files @git ls-files --modified Cabal Cabal-syntax cabal-install \ | grep '.hs$$' | xargs -P $(PROCS) -I {} fourmolu -q -i {} +style-commit: ## Run the code styler on the previous commit + @git diff --name-only HEAD $(COMMIT) Cabal Cabal-syntax cabal-install \ + | grep '.hs$$' | xargs -P $(PROCS) -I {} fourmolu -q -i {} + # source generation: SPDX SPDX_LICENSE_HS:=Cabal-syntax/src/Distribution/SPDX/LicenseId.hs From 1c55df463d4fe3a7af37d4a6fd0a65f83bacf5e2 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Tue, 14 Nov 2023 11:05:04 +0000 Subject: [PATCH 55/70] Fix assertion failure when combining build-tool-depends and --enable-documentation The `setDocumentation` function was modifying the elaborated package after the hash was computed. This led to the assertion failing as the computed hash was different to what was computed in the initial install plan. Therefore in order to fix this we either needed to: 1. Set elabBuildHaddocks = False at the point where the hash is initially computed. 2. Verify that elabBuildHaddocks = True will not lead to unexpected results. The latter has been implemented. The elabBuildHaddocks option is only consulted in `hasValidHaddockTargets`, at which point documentation building the executable component is disabled because elabHaddockExecutables is False. In the added test we ensure this by checking that we didn't build documentation for the executable which is built because of build-tool-depends. Fixes #6006 #8313 --- .../Distribution/Client/ProjectPlanning.hs | 34 +++++-------------- .../PackageTests/HaddockBuildDepends/a.cabal | 10 ++++++ .../HaddockBuildDepends/cabal.out | 27 +++++++++++++++ .../HaddockBuildDepends/cabal.project | 1 + .../HaddockBuildDepends/cabal.test.hs | 22 ++++++++++++ .../HaddockBuildDepends/repo/exe-1/Main.hs | 3 ++ .../HaddockBuildDepends/repo/exe-1/exe.cabal | 12 +++++++ .../HaddockBuildDepends/repo/lib-1/Lib.hs | 1 + .../HaddockBuildDepends/repo/lib-1/lib.cabal | 13 +++++++ .../HaddockBuildDepends/src/MyLib.hs | 4 +++ 10 files changed, 101 insertions(+), 26 deletions(-) create mode 100644 cabal-testsuite/PackageTests/HaddockBuildDepends/a.cabal create mode 100644 cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.out create mode 100644 cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.project create mode 100644 cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/HaddockBuildDepends/repo/exe-1/Main.hs create mode 100644 cabal-testsuite/PackageTests/HaddockBuildDepends/repo/exe-1/exe.cabal create mode 100644 cabal-testsuite/PackageTests/HaddockBuildDepends/repo/lib-1/Lib.hs create mode 100644 cabal-testsuite/PackageTests/HaddockBuildDepends/repo/lib-1/lib.cabal create mode 100644 cabal-testsuite/PackageTests/HaddockBuildDepends/src/MyLib.hs diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 3cb0d8033e8..5cb04eaf56b 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -258,7 +258,7 @@ sanityCheckElaboratedConfiguredPackage -> a -> a sanityCheckElaboratedConfiguredPackage - _sharedConfig + sharedConfig elab@ElaboratedConfiguredPackage{..} = ( case elabPkgOrComp of ElabPackage pkg -> sanityCheckElaboratedPackage elab pkg @@ -273,10 +273,12 @@ sanityCheckElaboratedConfiguredPackage -- 'installedPackageId' we assigned is consistent with -- the 'hashedInstalledPackageId' we would compute from -- the elaborated configured package - -- . assert (isInplaceBuildStyle elabBuildStyle || - -- elabComponentId == hashedInstalledPackageId - -- (packageHashInputs sharedConfig elab)) - + . assert + ( isInplaceBuildStyle elabBuildStyle + || elabComponentId + == hashedInstalledPackageId + (packageHashInputs sharedConfig elab) + ) -- the stanzas explicitly disabled should not be available . assert ( optStanzaSetNull $ @@ -3293,9 +3295,7 @@ pruneInstallPlanPass1 pkgs prune :: ElaboratedConfiguredPackage -> PrunedPackage prune elab = PrunedPackage elab' (pruneOptionalDependencies elab') where - elab' = - setDocumentation $ - addOptionalStanzas elab + elab' = addOptionalStanzas elab graph = Graph.fromDistinctList pkgs' @@ -3444,24 +3444,6 @@ pruneInstallPlanPass1 pkgs <> optionalStanzasWithDepsAvailable availablePkgs elab pkg addOptionalStanzas elab = elab - setDocumentation :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage - setDocumentation elab@ElaboratedConfiguredPackage{elabPkgOrComp = ElabComponent comp} = - elab - { elabBuildHaddocks = - elabBuildHaddocks elab && documentationEnabled (compSolverName comp) elab - } - where - documentationEnabled c = - case c of - CD.ComponentLib -> const True - CD.ComponentSubLib _ -> elabHaddockInternal - CD.ComponentFLib _ -> elabHaddockForeignLibs - CD.ComponentExe _ -> elabHaddockExecutables - CD.ComponentTest _ -> elabHaddockTestSuites - CD.ComponentBench _ -> elabHaddockBenchmarks - CD.ComponentSetup -> const False - setDocumentation elab = elab - -- Calculate package dependencies but cut out those needed only by -- optional stanzas that we've determined we will not enable. -- These pruned deps are not persisted in this pass since they're based on diff --git a/cabal-testsuite/PackageTests/HaddockBuildDepends/a.cabal b/cabal-testsuite/PackageTests/HaddockBuildDepends/a.cabal new file mode 100644 index 00000000000..552ef337ea6 --- /dev/null +++ b/cabal-testsuite/PackageTests/HaddockBuildDepends/a.cabal @@ -0,0 +1,10 @@ +name: a +version: 0.1.0.0 +build-type: Simple +cabal-version: >= 1.10 + +library + exposed-modules: MyLib + build-depends: base, lib + hs-source-dirs: src + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.out b/cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.out new file mode 100644 index 00000000000..bb6754c14a6 --- /dev/null +++ b/cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.out @@ -0,0 +1,27 @@ +# cabal v2-update +Downloading the latest package list from test-local-repo +# cabal build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - exe-1 (exe:exe) (requires build) + - lib-1 (lib) (requires build) + - a-0.1.0.0 (lib) (first run) +Configuring executable 'exe' for exe-1... +Preprocessing executable 'exe' for exe-1... +Building executable 'exe' for exe-1... +Installing executable exe in +Warning: The directory /cabal.dist/home/.cabal/store/ghc-/incoming/new-/cabal.dist/home/.cabal/store/ghc-/-/bin is not in the system search path. +Configuring library for lib-1... +Preprocessing library for lib-1... +Building library for lib-1... +Preprocessing library for lib-1... +Running Haddock on library for lib-1... +Documentation created: dist/doc/html/lib/ +Installing library in +Configuring library for a-0.1.0.0... +Preprocessing library for a-0.1.0.0... +Building library for a-0.1.0.0... +Preprocessing library for a-0.1.0.0... +Running Haddock on library for a-0.1.0.0... +Documentation created: /cabal.dist/work/dist/build//ghc-/a-0.1.0.0/doc/html/a/ diff --git a/cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.project b/cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.test.hs b/cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.test.hs new file mode 100644 index 00000000000..28821c5e858 --- /dev/null +++ b/cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.test.hs @@ -0,0 +1,22 @@ +import Test.Cabal.Prelude + + +main = cabalTest . withRepo "repo" $ do + cabal "build" ["--enable-documentation"] + + env <- getTestEnv + let storeDir = testCabalDir env "store" + + -- Check properties of executable component + libDir <- liftIO $ findDependencyInStore storeDir "exe" + -- Documentation is enabled.. + assertFileDoesContain (libDir "cabal-hash.txt") "documentation: True" + -- But not built + shouldDirectoryNotExist ( libDir "share" "doc" ) + + -- Check properties of library + libDir <- liftIO $ findDependencyInStore storeDir "lib" + -- Documentation is enabled.. + assertFileDoesContain (libDir "cabal-hash.txt") "documentation: True" + -- and has been built + shouldDirectoryExist ( libDir "share" "doc" ) diff --git a/cabal-testsuite/PackageTests/HaddockBuildDepends/repo/exe-1/Main.hs b/cabal-testsuite/PackageTests/HaddockBuildDepends/repo/exe-1/Main.hs new file mode 100644 index 00000000000..de106fe48f9 --- /dev/null +++ b/cabal-testsuite/PackageTests/HaddockBuildDepends/repo/exe-1/Main.hs @@ -0,0 +1,3 @@ +module Main where + +main = return () diff --git a/cabal-testsuite/PackageTests/HaddockBuildDepends/repo/exe-1/exe.cabal b/cabal-testsuite/PackageTests/HaddockBuildDepends/repo/exe-1/exe.cabal new file mode 100644 index 00000000000..a5c1b537d7b --- /dev/null +++ b/cabal-testsuite/PackageTests/HaddockBuildDepends/repo/exe-1/exe.cabal @@ -0,0 +1,12 @@ +name: exe +version: 1 +license: BSD3 +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: 2.0 + +executable exe + build-depends: base + main-is: Main.hs + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/HaddockBuildDepends/repo/lib-1/Lib.hs b/cabal-testsuite/PackageTests/HaddockBuildDepends/repo/lib-1/Lib.hs new file mode 100644 index 00000000000..6d85a26fe10 --- /dev/null +++ b/cabal-testsuite/PackageTests/HaddockBuildDepends/repo/lib-1/Lib.hs @@ -0,0 +1 @@ +module Lib where diff --git a/cabal-testsuite/PackageTests/HaddockBuildDepends/repo/lib-1/lib.cabal b/cabal-testsuite/PackageTests/HaddockBuildDepends/repo/lib-1/lib.cabal new file mode 100644 index 00000000000..526338f344f --- /dev/null +++ b/cabal-testsuite/PackageTests/HaddockBuildDepends/repo/lib-1/lib.cabal @@ -0,0 +1,13 @@ +name: lib +version: 1 +license: BSD3 +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: 2.0 + +library + build-depends: base + build-tool-depends: exe:exe + exposed-modules: Lib + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/HaddockBuildDepends/src/MyLib.hs b/cabal-testsuite/PackageTests/HaddockBuildDepends/src/MyLib.hs new file mode 100644 index 00000000000..bbaef0a6d64 --- /dev/null +++ b/cabal-testsuite/PackageTests/HaddockBuildDepends/src/MyLib.hs @@ -0,0 +1,4 @@ +module MyLib (someFunc) where + +someFunc :: IO () +someFunc = return () From 93c5abf54b9c56c19ad3e0147f84cf992cf01494 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Tue, 14 Nov 2023 11:52:11 +0000 Subject: [PATCH 56/70] testsuite: Improve error message in findDependencyInStore --- cabal-testsuite/src/Test/Cabal/Prelude.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 48016765e91..757a71aefb7 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -1157,5 +1157,7 @@ findDependencyInStore storeDir pkgName = do then filter (not . flip elem "aeiou") pkgName -- simulates the way 'hashedInstalledPackageId' uses to compress package name else pkgName - let libDir = head $ filter (pkgName' `isPrefixOf`) packageDirs + let libDir = case filter (pkgName' `isPrefixOf`) packageDirs of + [] -> error $ "Could not find " <> pkgName' <> " when searching for " <> pkgName' <> " in\n" <> show packageDirs + (dir:_) -> dir pure (storeDir storeDirForGhcVersion libDir) From d24a35aeb2887cdd86eb7f6389230392c5596e73 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 6 Nov 2023 06:21:25 -0500 Subject: [PATCH 57/70] Only move code to Simple/GHC/Build* --- Cabal/Cabal.cabal | 3 + Cabal/src/Distribution/Simple/GHC.hs | 1440 +---------------- Cabal/src/Distribution/Simple/GHC/Build.hs | 262 +++ .../Distribution/Simple/GHC/BuildGeneric.hs | 749 +++++++++ .../Distribution/Simple/GHC/BuildOrRepl.hs | 549 +++++++ 5 files changed, 1576 insertions(+), 1427 deletions(-) create mode 100644 Cabal/src/Distribution/Simple/GHC/Build.hs create mode 100644 Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs create mode 100644 Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index c5dd237a5f8..f4750e48e79 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -331,6 +331,9 @@ library Distribution.Simple.Build.Macros.Z Distribution.Simple.Build.PackageInfoModule.Z Distribution.Simple.Build.PathsModule.Z + Distribution.Simple.GHC.Build + Distribution.Simple.GHC.BuildOrRepl + Distribution.Simple.GHC.BuildGeneric Distribution.Simple.GHC.EnvironmentParser Distribution.Simple.GHC.Internal Distribution.Simple.GHC.ImplInfo diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index 3d79a8356ab..89f64974242 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -81,46 +81,43 @@ module Distribution.Simple.GHC import Distribution.Compat.Prelude import Prelude () -import Control.Monad (forM_, msum) -import Data.Char (isLower) +import Control.Monad (forM_) import qualified Data.Map as Map import Distribution.CabalSpecVersion import Distribution.InstalledPackageInfo (InstalledPackageInfo) import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo -import Distribution.ModuleName (ModuleName) -import qualified Distribution.ModuleName as ModuleName import Distribution.Package import Distribution.PackageDescription as PD -import Distribution.PackageDescription.Utils (cabalBug) import Distribution.Pretty import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler import Distribution.Simple.Errors -import Distribution.Simple.Flag (Flag (..), fromFlag, fromFlagOrDefault, toFlag) +import Distribution.Simple.Flag (Flag (..), toFlag) +import Distribution.Simple.GHC.Build + ( componentGhcOptions + , exeTargetName + , flibBuildName + , flibTargetName + , isDynamic + ) import Distribution.Simple.GHC.EnvironmentParser import Distribution.Simple.GHC.ImplInfo import qualified Distribution.Simple.GHC.Internal as Internal -import qualified Distribution.Simple.Hpc as Hpc import Distribution.Simple.LocalBuildInfo import Distribution.Simple.PackageIndex (InstalledPackageIndex) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.Program -import qualified Distribution.Simple.Program.Ar as Ar import Distribution.Simple.Program.Builtin (runghcProgram) import Distribution.Simple.Program.GHC import qualified Distribution.Simple.Program.HcPkg as HcPkg -import qualified Distribution.Simple.Program.Ld as Ld import qualified Distribution.Simple.Program.Strip as Strip import Distribution.Simple.Setup.Common (extraCompilationArtifacts) -import Distribution.Simple.Setup.Config import Distribution.Simple.Setup.Repl import Distribution.Simple.Utils import Distribution.System import Distribution.Types.ComponentLocalBuildInfo -import Distribution.Types.PackageName.Magic import Distribution.Types.ParStrat import Distribution.Utils.NubList -import Distribution.Utils.Path import Distribution.Verbosity import Distribution.Version import Language.Haskell.Extension @@ -130,17 +127,11 @@ import System.Directory , doesDirectoryExist , doesFileExist , getAppUserDataDirectory - , getCurrentDirectory , getDirectoryContents - , makeRelativeToCurrentDirectory - , removeFile , renameFile ) import System.FilePath - ( isRelative - , replaceExtension - , takeDirectory - , takeExtension + ( takeDirectory , (<.>) , () ) @@ -148,10 +139,9 @@ import qualified System.Info #ifndef mingw32_HOST_OS import System.Posix (createSymbolicLink) #endif /* mingw32_HOST_OS */ -import qualified Data.ByteString.Lazy.Char8 as BS -import Distribution.Compat.Binary (encode) -import Distribution.Compat.ResponseFile (escapeArgs) -import qualified Distribution.InstalledPackageInfo as IPI + +import Distribution.Simple.GHC.BuildGeneric (GBuildMode (..), gbuild) +import Distribution.Simple.GHC.BuildOrRepl (buildOrReplLib) -- ----------------------------------------------------------------------------- -- Configuring @@ -592,508 +582,6 @@ replLib -> IO () replLib = buildOrReplLib . Just -buildOrReplLib - :: Maybe ReplOptions - -> Verbosity - -> Flag ParStrat - -> PackageDescription - -> LocalBuildInfo - -> Library - -> ComponentLocalBuildInfo - -> IO () -buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do - let uid = componentUnitId clbi - libTargetDir = componentBuildDir lbi clbi - whenVanillaLib forceVanilla = - when (forceVanilla || withVanillaLib lbi) - whenProfLib = when (withProfLib lbi) - whenSharedLib forceShared = - when (forceShared || withSharedLib lbi) - whenStaticLib forceStatic = - when (forceStatic || withStaticLib lbi) - whenGHCiLib = when (withGHCiLib lbi) - forRepl = maybe False (const True) mReplFlags - whenReplLib = forM_ mReplFlags - replFlags = fromMaybe mempty mReplFlags - comp = compiler lbi - ghcVersion = compilerVersion comp - implInfo = getImplInfo comp - platform@(Platform hostArch hostOS) = hostPlatform lbi - hasJsSupport = hostArch == JavaScript - has_code = not (componentIsIndefinite clbi) - - relLibTargetDir <- makeRelativeToCurrentDirectory libTargetDir - - (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) - let runGhcProg = runGHC verbosity ghcProg comp platform - - let libBi = libBuildInfo lib - - -- ensure extra lib dirs exist before passing to ghc - cleanedExtraLibDirs <- filterM doesDirectoryExist (extraLibDirs libBi) - cleanedExtraLibDirsStatic <- filterM doesDirectoryExist (extraLibDirsStatic libBi) - - let isGhcDynamic = isDynamic comp - dynamicTooSupported = supportsDynamicToo comp - doingTH = usesTemplateHaskellOrQQ libBi - forceVanillaLib = doingTH && not isGhcDynamic - forceSharedLib = doingTH && isGhcDynamic - -- TH always needs default libs, even when building for profiling - - -- Determine if program coverage should be enabled and if so, what - -- '-hpcdir' should be. - let isCoverageEnabled = libCoverage lbi - -- TODO: Historically HPC files have been put into a directory which - -- has the package name. I'm going to avoid changing this for - -- now, but it would probably be better for this to be the - -- component ID instead... - pkg_name = prettyShow (PD.package pkg_descr) - distPref = fromFlag $ configDistPref $ configFlags lbi - hpcdir way - | forRepl = mempty -- HPC is not supported in ghci - | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name - | otherwise = mempty - - createDirectoryIfMissingVerbose verbosity True libTargetDir - -- TODO: do we need to put hs-boot files into place for mutually recursive - -- modules? - let cLikeSources = - fromNubListR $ - mconcat - [ toNubListR (cSources libBi) - , toNubListR (cxxSources libBi) - , toNubListR (cmmSources libBi) - , toNubListR (asmSources libBi) - , if hasJsSupport - then -- JS files are C-like with GHC's JS backend: they are - -- "compiled" into `.o` files (renamed with a header). - -- This is a difference from GHCJS, for which we only - -- pass the JS files at link time. - toNubListR (jsSources libBi) - else mempty - ] - cLikeObjs = map (`replaceExtension` objExtension) cLikeSources - baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir - vanillaOpts = - baseOpts - `mappend` mempty - { ghcOptMode = toFlag GhcModeMake - , ghcOptNumJobs = numJobs - , ghcOptInputModules = toNubListR $ allLibModules lib clbi - , ghcOptHPCDir = hpcdir Hpc.Vanilla - } - - profOpts = - vanillaOpts - `mappend` mempty - { ghcOptProfilingMode = toFlag True - , ghcOptProfilingAuto = - Internal.profDetailLevelFlag - True - (withProfLibDetail lbi) - , ghcOptHiSuffix = toFlag "p_hi" - , ghcOptObjSuffix = toFlag "p_o" - , ghcOptExtra = hcProfOptions GHC libBi - , ghcOptHPCDir = hpcdir Hpc.Prof - } - - sharedOpts = - vanillaOpts - `mappend` mempty - { ghcOptDynLinkMode = toFlag GhcDynamicOnly - , ghcOptFPic = toFlag True - , ghcOptHiSuffix = toFlag "dyn_hi" - , ghcOptObjSuffix = toFlag "dyn_o" - , ghcOptExtra = hcSharedOptions GHC libBi - , ghcOptHPCDir = hpcdir Hpc.Dyn - } - linkerOpts = - mempty - { ghcOptLinkOptions = - PD.ldOptions libBi - ++ [ "-static" - | withFullyStaticExe lbi - ] - -- Pass extra `ld-options` given - -- through to GHC's linker. - ++ maybe - [] - programOverrideArgs - (lookupProgram ldProgram (withPrograms lbi)) - , ghcOptLinkLibs = - if withFullyStaticExe lbi - then extraLibsStatic libBi - else extraLibs libBi - , ghcOptLinkLibPath = - toNubListR $ - if withFullyStaticExe lbi - then cleanedExtraLibDirsStatic - else cleanedExtraLibDirs - , ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi - , ghcOptLinkFrameworkDirs = - toNubListR $ - PD.extraFrameworkDirs libBi - , ghcOptInputFiles = - toNubListR - [relLibTargetDir x | x <- cLikeObjs] - } - replOpts = - vanillaOpts - { ghcOptExtra = - Internal.filterGhciFlags - (ghcOptExtra vanillaOpts) - <> replOptionsFlags replFlags - , ghcOptNumJobs = mempty - , ghcOptInputModules = replNoLoad replFlags (ghcOptInputModules vanillaOpts) - } - `mappend` linkerOpts - `mappend` mempty - { ghcOptMode = isInteractive - , ghcOptOptimisation = toFlag GhcNoOptimisation - } - - isInteractive = toFlag GhcModeInteractive - - vanillaSharedOpts = - vanillaOpts - `mappend` mempty - { ghcOptDynLinkMode = toFlag GhcStaticAndDynamic - , ghcOptDynHiSuffix = toFlag "dyn_hi" - , ghcOptDynObjSuffix = toFlag "dyn_o" - , ghcOptHPCDir = hpcdir Hpc.Dyn - } - - unless (forRepl || null (allLibModules lib clbi)) $ - do - let vanilla = whenVanillaLib forceVanillaLib (runGhcProg vanillaOpts) - shared = whenSharedLib forceSharedLib (runGhcProg sharedOpts) - useDynToo = - dynamicTooSupported - && (forceVanillaLib || withVanillaLib lbi) - && (forceSharedLib || withSharedLib lbi) - && null (hcSharedOptions GHC libBi) - if not has_code - then vanilla - else - if useDynToo - then do - runGhcProg vanillaSharedOpts - case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of - (Flag dynDir, Flag vanillaDir) -> - -- When the vanilla and shared library builds are done - -- in one pass, only one set of HPC module interfaces - -- are generated. This set should suffice for both - -- static and dynamically linked executables. We copy - -- the modules interfaces so they are available under - -- both ways. - copyDirectoryRecursive verbosity dynDir vanillaDir - _ -> return () - else - if isGhcDynamic - then do shared; vanilla - else do vanilla; shared - whenProfLib (runGhcProg profOpts) - - let - buildExtraSources mkSrcOpts wantDyn = traverse_ $ buildExtraSource mkSrcOpts wantDyn - buildExtraSource mkSrcOpts wantDyn filename = do - let baseSrcOpts = - mkSrcOpts - verbosity - implInfo - lbi - libBi - clbi - relLibTargetDir - filename - vanillaSrcOpts - -- Dynamic GHC requires C sources to be built - -- with -fPIC for REPL to work. See #2207. - | isGhcDynamic && wantDyn = baseSrcOpts{ghcOptFPic = toFlag True} - | otherwise = baseSrcOpts - runGhcProgIfNeeded opts = do - needsRecomp <- checkNeedsRecompilation filename opts - when needsRecomp $ runGhcProg opts - profSrcOpts = - vanillaSrcOpts - `mappend` mempty - { ghcOptProfilingMode = toFlag True - , ghcOptObjSuffix = toFlag "p_o" - } - sharedSrcOpts = - vanillaSrcOpts - `mappend` mempty - { ghcOptFPic = toFlag True - , ghcOptDynLinkMode = toFlag GhcDynamicOnly - , ghcOptObjSuffix = toFlag "dyn_o" - } - odir = fromFlag (ghcOptObjDir vanillaSrcOpts) - - createDirectoryIfMissingVerbose verbosity True odir - runGhcProgIfNeeded vanillaSrcOpts - unless (forRepl || not wantDyn) $ - whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedSrcOpts) - unless forRepl $ - whenProfLib (runGhcProgIfNeeded profSrcOpts) - - -- Build any C++ sources separately. - unless (not has_code || null (cxxSources libBi)) $ do - info verbosity "Building C++ Sources..." - buildExtraSources Internal.componentCxxGhcOptions True (cxxSources libBi) - - -- build any C sources - unless (not has_code || null (cSources libBi)) $ do - info verbosity "Building C Sources..." - buildExtraSources Internal.componentCcGhcOptions True (cSources libBi) - - -- build any JS sources - unless (not has_code || not hasJsSupport || null (jsSources libBi)) $ do - info verbosity "Building JS Sources..." - buildExtraSources Internal.componentJsGhcOptions False (jsSources libBi) - - -- build any ASM sources - unless (not has_code || null (asmSources libBi)) $ do - info verbosity "Building Assembler Sources..." - buildExtraSources Internal.componentAsmGhcOptions True (asmSources libBi) - - -- build any Cmm sources - unless (not has_code || null (cmmSources libBi)) $ do - info verbosity "Building C-- Sources..." - buildExtraSources Internal.componentCmmGhcOptions True (cmmSources libBi) - - -- TODO: problem here is we need the .c files built first, so we can load them - -- with ghci, but .c files can depend on .h files generated by ghc by ffi - -- exports. - whenReplLib $ \rflags -> do - when (null (allLibModules lib clbi)) $ warn verbosity "No exposed modules" - runReplOrWriteFlags verbosity ghcProg comp platform rflags replOpts libBi clbi (pkgName (PD.package pkg_descr)) - - -- link: - when has_code . unless forRepl $ do - info verbosity "Linking..." - let cLikeProfObjs = - map - (`replaceExtension` ("p_" ++ objExtension)) - cLikeSources - cLikeSharedObjs = - map - (`replaceExtension` ("dyn_" ++ objExtension)) - cLikeSources - compiler_id = compilerId (compiler lbi) - vanillaLibFilePath = relLibTargetDir mkLibName uid - profileLibFilePath = relLibTargetDir mkProfLibName uid - sharedLibFilePath = - relLibTargetDir - mkSharedLibName (hostPlatform lbi) compiler_id uid - staticLibFilePath = - relLibTargetDir - mkStaticLibName (hostPlatform lbi) compiler_id uid - ghciLibFilePath = relLibTargetDir Internal.mkGHCiLibName uid - ghciProfLibFilePath = relLibTargetDir Internal.mkGHCiProfLibName uid - libInstallPath = - libdir $ - absoluteComponentInstallDirs - pkg_descr - lbi - uid - NoCopyDest - sharedLibInstallPath = - libInstallPath - mkSharedLibName (hostPlatform lbi) compiler_id uid - - stubObjs <- - catMaybes - <$> sequenceA - [ findFileWithExtension - [objExtension] - [libTargetDir] - (ModuleName.toFilePath x ++ "_stub") - | ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files - , x <- allLibModules lib clbi - ] - stubProfObjs <- - catMaybes - <$> sequenceA - [ findFileWithExtension - ["p_" ++ objExtension] - [libTargetDir] - (ModuleName.toFilePath x ++ "_stub") - | ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files - , x <- allLibModules lib clbi - ] - stubSharedObjs <- - catMaybes - <$> sequenceA - [ findFileWithExtension - ["dyn_" ++ objExtension] - [libTargetDir] - (ModuleName.toFilePath x ++ "_stub") - | ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files - , x <- allLibModules lib clbi - ] - - hObjs <- - Internal.getHaskellObjects - implInfo - lib - lbi - clbi - relLibTargetDir - objExtension - True - hProfObjs <- - if withProfLib lbi - then - Internal.getHaskellObjects - implInfo - lib - lbi - clbi - relLibTargetDir - ("p_" ++ objExtension) - True - else return [] - hSharedObjs <- - if withSharedLib lbi - then - Internal.getHaskellObjects - implInfo - lib - lbi - clbi - relLibTargetDir - ("dyn_" ++ objExtension) - False - else return [] - - unless (null hObjs && null cLikeObjs && null stubObjs) $ do - rpaths <- getRPaths lbi clbi - - let staticObjectFiles = - hObjs - ++ map (relLibTargetDir ) cLikeObjs - ++ stubObjs - profObjectFiles = - hProfObjs - ++ map (relLibTargetDir ) cLikeProfObjs - ++ stubProfObjs - dynamicObjectFiles = - hSharedObjs - ++ map (relLibTargetDir ) cLikeSharedObjs - ++ stubSharedObjs - -- After the relocation lib is created we invoke ghc -shared - -- with the dependencies spelled out as -package arguments - -- and ghc invokes the linker with the proper library paths - ghcSharedLinkArgs = - mempty - { ghcOptShared = toFlag True - , ghcOptDynLinkMode = toFlag GhcDynamicOnly - , ghcOptInputFiles = toNubListR dynamicObjectFiles - , ghcOptOutputFile = toFlag sharedLibFilePath - , ghcOptExtra = hcSharedOptions GHC libBi - , -- For dynamic libs, Mac OS/X needs to know the install location - -- at build time. This only applies to GHC < 7.8 - see the - -- discussion in #1660. - ghcOptDylibName = - if hostOS == OSX - && ghcVersion < mkVersion [7, 8] - then toFlag sharedLibInstallPath - else mempty - , ghcOptHideAllPackages = toFlag True - , ghcOptNoAutoLinkPackages = toFlag True - , ghcOptPackageDBs = withPackageDB lbi - , ghcOptThisUnitId = case clbi of - LibComponentLocalBuildInfo{componentCompatPackageKey = pk} -> - toFlag pk - _ -> mempty - , ghcOptThisComponentId = case clbi of - LibComponentLocalBuildInfo - { componentInstantiatedWith = insts - } -> - if null insts - then mempty - else toFlag (componentComponentId clbi) - _ -> mempty - , ghcOptInstantiatedWith = case clbi of - LibComponentLocalBuildInfo - { componentInstantiatedWith = insts - } -> - insts - _ -> [] - , ghcOptPackages = - toNubListR $ - Internal.mkGhcOptPackages mempty clbi - , ghcOptLinkLibs = extraLibs libBi - , ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs - , ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi - , ghcOptLinkFrameworkDirs = - toNubListR $ PD.extraFrameworkDirs libBi - , ghcOptRPaths = rpaths - } - ghcStaticLinkArgs = - mempty - { ghcOptStaticLib = toFlag True - , ghcOptInputFiles = toNubListR staticObjectFiles - , ghcOptOutputFile = toFlag staticLibFilePath - , ghcOptExtra = hcStaticOptions GHC libBi - , ghcOptHideAllPackages = toFlag True - , ghcOptNoAutoLinkPackages = toFlag True - , ghcOptPackageDBs = withPackageDB lbi - , ghcOptThisUnitId = case clbi of - LibComponentLocalBuildInfo{componentCompatPackageKey = pk} -> - toFlag pk - _ -> mempty - , ghcOptThisComponentId = case clbi of - LibComponentLocalBuildInfo - { componentInstantiatedWith = insts - } -> - if null insts - then mempty - else toFlag (componentComponentId clbi) - _ -> mempty - , ghcOptInstantiatedWith = case clbi of - LibComponentLocalBuildInfo - { componentInstantiatedWith = insts - } -> - insts - _ -> [] - , ghcOptPackages = - toNubListR $ - Internal.mkGhcOptPackages mempty clbi - , ghcOptLinkLibs = extraLibs libBi - , ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs - } - - info verbosity (show (ghcOptPackages ghcSharedLinkArgs)) - - whenVanillaLib False $ do - Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles - whenGHCiLib $ do - (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi) - Ld.combineObjectFiles - verbosity - lbi - ldProg - ghciLibFilePath - staticObjectFiles - - whenProfLib $ do - Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles - whenGHCiLib $ do - (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi) - Ld.combineObjectFiles - verbosity - lbi - ldProg - ghciProfLibFilePath - profObjectFiles - - whenSharedLib False $ - runGhcProg ghcSharedLinkArgs - - whenStaticLib False $ - runGhcProg ghcStaticLinkArgs - -- | Start a REPL without loading any source files. startInterpreter :: Verbosity @@ -1112,47 +600,6 @@ startInterpreter verbosity progdb comp platform packageDBs = do (ghcProg, _) <- requireProgram verbosity ghcProgram progdb runGHC verbosity ghcProg comp platform replOpts -runReplOrWriteFlags - :: Verbosity - -> ConfiguredProgram - -> Compiler - -> Platform - -> ReplOptions - -> GhcOptions - -> BuildInfo - -> ComponentLocalBuildInfo - -> PackageName - -> IO () -runReplOrWriteFlags verbosity ghcProg comp platform rflags replOpts bi clbi pkg_name = - case replOptionsFlagOutput rflags of - NoFlag -> runGHC verbosity ghcProg comp platform replOpts - Flag out_dir -> do - src_dir <- getCurrentDirectory - let uid = componentUnitId clbi - this_unit = prettyShow uid - reexported_modules = [mn | LibComponentLocalBuildInfo{} <- [clbi], IPI.ExposedModule mn (Just{}) <- componentExposedModules clbi] - hidden_modules = otherModules bi - extra_opts = - concat $ - [ ["-this-package-name", prettyShow pkg_name] - , ["-working-dir", src_dir] - ] - ++ [ ["-reexported-module", prettyShow m] | m <- reexported_modules - ] - ++ [ ["-hidden-module", prettyShow m] | m <- hidden_modules - ] - -- Create "paths" subdirectory if it doesn't exist. This is where we write - -- information about how the PATH was augmented. - createDirectoryIfMissing False (out_dir "paths") - -- Write out the PATH information into `paths` subdirectory. - writeFileAtomic (out_dir "paths" this_unit) (encode ghcProg) - -- Write out options for this component into a file ready for loading into - -- the multi-repl - writeFileAtomic (out_dir this_unit) $ - BS.pack $ - escapeArgs $ - extra_opts ++ renderGhcOptions comp platform (replOpts{ghcOptMode = NoFlag}) - -- ----------------------------------------------------------------------------- -- Building an executable or foreign library @@ -1202,842 +649,6 @@ replExe replExe replFlags v njobs pkg lbi = gbuild v njobs pkg lbi . GReplExe replFlags --- | Building an executable, starting the REPL, and building foreign --- libraries are all very similar and implemented in 'gbuild'. The --- 'GBuildMode' distinguishes between the various kinds of operation. -data GBuildMode - = GBuildExe Executable - | GReplExe ReplOptions Executable - | GBuildFLib ForeignLib - | GReplFLib ReplOptions ForeignLib - -gbuildInfo :: GBuildMode -> BuildInfo -gbuildInfo (GBuildExe exe) = buildInfo exe -gbuildInfo (GReplExe _ exe) = buildInfo exe -gbuildInfo (GBuildFLib flib) = foreignLibBuildInfo flib -gbuildInfo (GReplFLib _ flib) = foreignLibBuildInfo flib - -gbuildName :: GBuildMode -> String -gbuildName (GBuildExe exe) = unUnqualComponentName $ exeName exe -gbuildName (GReplExe _ exe) = unUnqualComponentName $ exeName exe -gbuildName (GBuildFLib flib) = unUnqualComponentName $ foreignLibName flib -gbuildName (GReplFLib _ flib) = unUnqualComponentName $ foreignLibName flib - -gbuildTargetName :: LocalBuildInfo -> GBuildMode -> String -gbuildTargetName lbi (GBuildExe exe) = exeTargetName (hostPlatform lbi) exe -gbuildTargetName lbi (GReplExe _ exe) = exeTargetName (hostPlatform lbi) exe -gbuildTargetName lbi (GBuildFLib flib) = flibTargetName lbi flib -gbuildTargetName lbi (GReplFLib _ flib) = flibTargetName lbi flib - -exeTargetName :: Platform -> Executable -> String -exeTargetName platform exe = unUnqualComponentName (exeName exe) `withExt` exeExtension platform - --- | Target name for a foreign library (the actual file name) --- --- We do not use mkLibName and co here because the naming for foreign libraries --- is slightly different (we don't use "_p" or compiler version suffices, and we --- don't want the "lib" prefix on Windows). --- --- TODO: We do use `dllExtension` and co here, but really that's wrong: they --- use the OS used to build cabal to determine which extension to use, rather --- than the target OS (but this is wrong elsewhere in Cabal as well). -flibTargetName :: LocalBuildInfo -> ForeignLib -> String -flibTargetName lbi flib = - case (os, foreignLibType flib) of - (Windows, ForeignLibNativeShared) -> nm <.> "dll" - (Windows, ForeignLibNativeStatic) -> nm <.> "lib" - (Linux, ForeignLibNativeShared) -> "lib" ++ nm <.> versionedExt - (_other, ForeignLibNativeShared) -> - "lib" ++ nm <.> dllExtension (hostPlatform lbi) - (_other, ForeignLibNativeStatic) -> - "lib" ++ nm <.> staticLibExtension (hostPlatform lbi) - (_any, ForeignLibTypeUnknown) -> cabalBug "unknown foreign lib type" - where - nm :: String - nm = unUnqualComponentName $ foreignLibName flib - - os :: OS - os = - let (Platform _ os') = hostPlatform lbi - in os' - - -- If a foreign lib foo has lib-version-info 5:1:2 or - -- lib-version-linux 3.2.1, it should be built as libfoo.so.3.2.1 - -- Libtool's version-info data is translated into library versions in a - -- nontrivial way: so refer to libtool documentation. - versionedExt :: String - versionedExt = - let nums = foreignLibVersion flib os - in foldl (<.>) "so" (map show nums) - --- | Name for the library when building. --- --- If the `lib-version-info` field or the `lib-version-linux` field of --- a foreign library target is set, we need to incorporate that --- version into the SONAME field. --- --- If a foreign library foo has lib-version-info 5:1:2, it should be --- built as libfoo.so.3.2.1. We want it to get soname libfoo.so.3. --- However, GHC does not allow overriding soname by setting linker --- options, as it sets a soname of its own (namely the output --- filename), after the user-supplied linker options. Hence, we have --- to compile the library with the soname as its filename. We rename --- the compiled binary afterwards. --- --- This method allows to adjust the name of the library at build time --- such that the correct soname can be set. -flibBuildName :: LocalBuildInfo -> ForeignLib -> String -flibBuildName lbi flib - -- On linux, if a foreign-library has version data, the first digit is used - -- to produce the SONAME. - | (os, foreignLibType flib) - == (Linux, ForeignLibNativeShared) = - let nums = foreignLibVersion flib os - in "lib" ++ nm <.> foldl (<.>) "so" (map show (take 1 nums)) - | otherwise = flibTargetName lbi flib - where - os :: OS - os = - let (Platform _ os') = hostPlatform lbi - in os' - - nm :: String - nm = unUnqualComponentName $ foreignLibName flib - -gbuildIsRepl :: GBuildMode -> Bool -gbuildIsRepl (GBuildExe _) = False -gbuildIsRepl (GReplExe _ _) = True -gbuildIsRepl (GBuildFLib _) = False -gbuildIsRepl (GReplFLib _ _) = True - -gbuildNeedDynamic :: LocalBuildInfo -> GBuildMode -> Bool -gbuildNeedDynamic lbi bm = - case bm of - GBuildExe _ -> withDynExe lbi - GReplExe _ _ -> withDynExe lbi - GBuildFLib flib -> withDynFLib flib - GReplFLib _ flib -> withDynFLib flib - where - withDynFLib flib = - case foreignLibType flib of - ForeignLibNativeShared -> - ForeignLibStandalone `notElem` foreignLibOptions flib - ForeignLibNativeStatic -> - False - ForeignLibTypeUnknown -> - cabalBug "unknown foreign lib type" - -gbuildModDefFiles :: GBuildMode -> [FilePath] -gbuildModDefFiles (GBuildExe _) = [] -gbuildModDefFiles (GReplExe _ _) = [] -gbuildModDefFiles (GBuildFLib flib) = foreignLibModDefFile flib -gbuildModDefFiles (GReplFLib _ flib) = foreignLibModDefFile flib - --- | "Main" module name when overridden by @ghc-options: -main-is ...@ --- or 'Nothing' if no @-main-is@ flag could be found. --- --- In case of 'Nothing', 'Distribution.ModuleName.main' can be assumed. -exeMainModuleName :: Executable -> Maybe ModuleName -exeMainModuleName Executable{buildInfo = bnfo} = - -- GHC honors the last occurrence of a module name updated via -main-is - -- - -- Moreover, -main-is when parsed left-to-right can update either - -- the "Main" module name, or the "main" function name, or both, - -- see also 'decodeMainIsArg'. - msum $ reverse $ map decodeMainIsArg $ findIsMainArgs ghcopts - where - ghcopts = hcOptions GHC bnfo - - findIsMainArgs [] = [] - findIsMainArgs ("-main-is" : arg : rest) = arg : findIsMainArgs rest - findIsMainArgs (_ : rest) = findIsMainArgs rest - --- | Decode argument to '-main-is' --- --- Returns 'Nothing' if argument set only the function name. --- --- This code has been stolen/refactored from GHC's DynFlags.setMainIs --- function. The logic here is deliberately imperfect as it is --- intended to be bug-compatible with GHC's parser. See discussion in --- https://github.com/haskell/cabal/pull/4539#discussion_r118981753. -decodeMainIsArg :: String -> Maybe ModuleName -decodeMainIsArg arg - | headOf main_fn isLower = - -- The arg looked like "Foo.Bar.baz" - Just (ModuleName.fromString main_mod) - | headOf arg isUpper -- The arg looked like "Foo" or "Foo.Bar" - = - Just (ModuleName.fromString arg) - | otherwise -- The arg looked like "baz" - = - Nothing - where - headOf :: String -> (Char -> Bool) -> Bool - headOf str pred' = any pred' (safeHead str) - - (main_mod, main_fn) = splitLongestPrefix arg (== '.') - - splitLongestPrefix :: String -> (Char -> Bool) -> (String, String) - splitLongestPrefix str pred' - | null r_pre = (str, []) - | otherwise = (reverse (safeTail r_pre), reverse r_suf) - where - -- 'safeTail' drops the char satisfying 'pred' - (r_suf, r_pre) = break pred' (reverse str) - --- | A collection of: --- * C input files --- * C++ input files --- * GHC input files --- * GHC input modules --- --- Used to correctly build and link sources. -data BuildSources = BuildSources - { cSourcesFiles :: [FilePath] - , cxxSourceFiles :: [FilePath] - , jsSourceFiles :: [FilePath] - , asmSourceFiles :: [FilePath] - , cmmSourceFiles :: [FilePath] - , inputSourceFiles :: [FilePath] - , inputSourceModules :: [ModuleName] - } - --- | Locate and return the 'BuildSources' required to build and link. -gbuildSources - :: Verbosity - -> PackageId - -> CabalSpecVersion - -> FilePath - -> GBuildMode - -> IO BuildSources -gbuildSources verbosity pkgId specVer tmpDir bm = - case bm of - GBuildExe exe -> exeSources exe - GReplExe _ exe -> exeSources exe - GBuildFLib flib -> return $ flibSources flib - GReplFLib _ flib -> return $ flibSources flib - where - exeSources :: Executable -> IO BuildSources - exeSources exe@Executable{buildInfo = bnfo, modulePath = modPath} = do - main <- findFileEx verbosity (tmpDir : map getSymbolicPath (hsSourceDirs bnfo)) modPath - let mainModName = fromMaybe ModuleName.main $ exeMainModuleName exe - otherModNames = exeModules exe - - -- Scripts have fakePackageId and are always Haskell but can have any extension. - if isHaskell main || pkgId == fakePackageId - then - if specVer < CabalSpecV2_0 && (mainModName `elem` otherModNames) - then do - -- The cabal manual clearly states that `other-modules` is - -- intended for non-main modules. However, there's at least one - -- important package on Hackage (happy-1.19.5) which - -- violates this. We workaround this here so that we don't - -- invoke GHC with e.g. 'ghc --make Main src/Main.hs' which - -- would result in GHC complaining about duplicate Main - -- modules. - -- - -- Finally, we only enable this workaround for - -- specVersion < 2, as 'cabal-version:>=2.0' cabal files - -- have no excuse anymore to keep doing it wrong... ;-) - warn verbosity $ - "Enabling workaround for Main module '" - ++ prettyShow mainModName - ++ "' listed in 'other-modules' illegally!" - - return - BuildSources - { cSourcesFiles = cSources bnfo - , cxxSourceFiles = cxxSources bnfo - , jsSourceFiles = jsSources bnfo - , asmSourceFiles = asmSources bnfo - , cmmSourceFiles = cmmSources bnfo - , inputSourceFiles = [main] - , inputSourceModules = - filter (/= mainModName) $ - exeModules exe - } - else - return - BuildSources - { cSourcesFiles = cSources bnfo - , cxxSourceFiles = cxxSources bnfo - , jsSourceFiles = jsSources bnfo - , asmSourceFiles = asmSources bnfo - , cmmSourceFiles = cmmSources bnfo - , inputSourceFiles = [main] - , inputSourceModules = exeModules exe - } - else - let (csf, cxxsf) - | isCxx main = (cSources bnfo, main : cxxSources bnfo) - -- if main is not a Haskell source - -- and main is not a C++ source - -- then we assume that it is a C source - | otherwise = (main : cSources bnfo, cxxSources bnfo) - in return - BuildSources - { cSourcesFiles = csf - , cxxSourceFiles = cxxsf - , jsSourceFiles = jsSources bnfo - , asmSourceFiles = asmSources bnfo - , cmmSourceFiles = cmmSources bnfo - , inputSourceFiles = [] - , inputSourceModules = exeModules exe - } - - flibSources :: ForeignLib -> BuildSources - flibSources flib@ForeignLib{foreignLibBuildInfo = bnfo} = - BuildSources - { cSourcesFiles = cSources bnfo - , cxxSourceFiles = cxxSources bnfo - , jsSourceFiles = jsSources bnfo - , asmSourceFiles = asmSources bnfo - , cmmSourceFiles = cmmSources bnfo - , inputSourceFiles = [] - , inputSourceModules = foreignLibModules flib - } - - isCxx :: FilePath -> Bool - isCxx fp = elem (takeExtension fp) [".cpp", ".cxx", ".c++"] - --- | FilePath has a Haskell extension: .hs or .lhs -isHaskell :: FilePath -> Bool -isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"] - -replNoLoad :: Ord a => ReplOptions -> NubListR a -> NubListR a -replNoLoad replFlags l - | replOptionsNoLoad replFlags == Flag True = mempty - | otherwise = l - --- | Generic build function. See comment for 'GBuildMode'. -gbuild - :: Verbosity - -> Flag ParStrat - -> PackageDescription - -> LocalBuildInfo - -> GBuildMode - -> ComponentLocalBuildInfo - -> IO () -gbuild verbosity numJobs pkg_descr lbi bm clbi = do - (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) - let replFlags = case bm of - GReplExe flags _ -> flags - GReplFLib flags _ -> flags - GBuildExe{} -> mempty - GBuildFLib{} -> mempty - comp = compiler lbi - platform = hostPlatform lbi - implInfo = getImplInfo comp - runGhcProg = runGHC verbosity ghcProg comp platform - - let bnfo = gbuildInfo bm - - -- the name that GHC really uses (e.g., with .exe on Windows for executables) - let targetName = gbuildTargetName lbi bm - let targetDir = buildDir lbi (gbuildName bm) - let tmpDir = targetDir (gbuildName bm ++ "-tmp") - createDirectoryIfMissingVerbose verbosity True targetDir - createDirectoryIfMissingVerbose verbosity True tmpDir - - -- TODO: do we need to put hs-boot files into place for mutually recursive - -- modules? FIX: what about exeName.hi-boot? - - -- Determine if program coverage should be enabled and if so, what - -- '-hpcdir' should be. - let isCoverageEnabled = exeCoverage lbi - distPref = fromFlag $ configDistPref $ configFlags lbi - hpcdir way - | gbuildIsRepl bm = mempty -- HPC is not supported in ghci - | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way (gbuildName bm) - | otherwise = mempty - - rpaths <- getRPaths lbi clbi - buildSources <- gbuildSources verbosity (package pkg_descr) (specVersion pkg_descr) tmpDir bm - - -- ensure extra lib dirs exist before passing to ghc - cleanedExtraLibDirs <- filterM doesDirectoryExist (extraLibDirs bnfo) - cleanedExtraLibDirsStatic <- filterM doesDirectoryExist (extraLibDirsStatic bnfo) - - let cSrcs = cSourcesFiles buildSources - cxxSrcs = cxxSourceFiles buildSources - jsSrcs = jsSourceFiles buildSources - asmSrcs = asmSourceFiles buildSources - cmmSrcs = cmmSourceFiles buildSources - inputFiles = inputSourceFiles buildSources - inputModules = inputSourceModules buildSources - isGhcDynamic = isDynamic comp - dynamicTooSupported = supportsDynamicToo comp - cLikeObjs = map (`replaceExtension` objExtension) cSrcs - cxxObjs = map (`replaceExtension` objExtension) cxxSrcs - jsObjs = if hasJsSupport then map (`replaceExtension` objExtension) jsSrcs else [] - asmObjs = map (`replaceExtension` objExtension) asmSrcs - cmmObjs = map (`replaceExtension` objExtension) cmmSrcs - needDynamic = gbuildNeedDynamic lbi bm - needProfiling = withProfExe lbi - Platform hostArch _ = hostPlatform lbi - hasJsSupport = hostArch == JavaScript - - -- build executables - baseOpts = - (componentGhcOptions verbosity lbi bnfo clbi tmpDir) - `mappend` mempty - { ghcOptMode = toFlag GhcModeMake - , ghcOptInputFiles = - toNubListR $ - if package pkg_descr == fakePackageId - then filter isHaskell inputFiles - else inputFiles - , ghcOptInputScripts = - toNubListR $ - if package pkg_descr == fakePackageId - then filter (not . isHaskell) inputFiles - else [] - , ghcOptInputModules = toNubListR inputModules - } - staticOpts = - baseOpts - `mappend` mempty - { ghcOptDynLinkMode = toFlag GhcStaticOnly - , ghcOptHPCDir = hpcdir Hpc.Vanilla - } - profOpts = - baseOpts - `mappend` mempty - { ghcOptProfilingMode = toFlag True - , ghcOptProfilingAuto = - Internal.profDetailLevelFlag - False - (withProfExeDetail lbi) - , ghcOptHiSuffix = toFlag "p_hi" - , ghcOptObjSuffix = toFlag "p_o" - , ghcOptExtra = hcProfOptions GHC bnfo - , ghcOptHPCDir = hpcdir Hpc.Prof - } - dynOpts = - baseOpts - `mappend` mempty - { ghcOptDynLinkMode = toFlag GhcDynamicOnly - , -- TODO: Does it hurt to set -fPIC for executables? - ghcOptFPic = toFlag True - , ghcOptHiSuffix = toFlag "dyn_hi" - , ghcOptObjSuffix = toFlag "dyn_o" - , ghcOptExtra = hcSharedOptions GHC bnfo - , ghcOptHPCDir = hpcdir Hpc.Dyn - } - dynTooOpts = - staticOpts - `mappend` mempty - { ghcOptDynLinkMode = toFlag GhcStaticAndDynamic - , ghcOptDynHiSuffix = toFlag "dyn_hi" - , ghcOptDynObjSuffix = toFlag "dyn_o" - , ghcOptHPCDir = hpcdir Hpc.Dyn - } - linkerOpts = - mempty - { ghcOptLinkOptions = - PD.ldOptions bnfo - ++ [ "-static" - | withFullyStaticExe lbi - ] - -- Pass extra `ld-options` given - -- through to GHC's linker. - ++ maybe - [] - programOverrideArgs - (lookupProgram ldProgram (withPrograms lbi)) - , ghcOptLinkLibs = - if withFullyStaticExe lbi - then extraLibsStatic bnfo - else extraLibs bnfo - , ghcOptLinkLibPath = - toNubListR $ - if withFullyStaticExe lbi - then cleanedExtraLibDirsStatic - else cleanedExtraLibDirs - , ghcOptLinkFrameworks = - toNubListR $ - PD.frameworks bnfo - , ghcOptLinkFrameworkDirs = - toNubListR $ - PD.extraFrameworkDirs bnfo - , ghcOptInputFiles = - toNubListR - [tmpDir x | x <- cLikeObjs ++ cxxObjs ++ jsObjs ++ cmmObjs ++ asmObjs] - } - dynLinkerOpts = - mempty - { ghcOptRPaths = rpaths - , ghcOptInputFiles = - toNubListR - [tmpDir x | x <- cLikeObjs ++ cxxObjs ++ cmmObjs ++ asmObjs] - } - replOpts = - baseOpts - { ghcOptExtra = - Internal.filterGhciFlags - (ghcOptExtra baseOpts) - <> replOptionsFlags replFlags - , ghcOptInputModules = replNoLoad replFlags (ghcOptInputModules baseOpts) - , ghcOptInputFiles = replNoLoad replFlags (ghcOptInputFiles baseOpts) - } - -- For a normal compile we do separate invocations of ghc for - -- compiling as for linking. But for repl we have to do just - -- the one invocation, so that one has to include all the - -- linker stuff too, like -l flags and any .o files from C - -- files etc. - `mappend` linkerOpts - `mappend` mempty - { ghcOptMode = toFlag GhcModeInteractive - , ghcOptOptimisation = toFlag GhcNoOptimisation - } - commonOpts - | needProfiling = profOpts - | needDynamic = dynOpts - | otherwise = staticOpts - compileOpts - | useDynToo = dynTooOpts - | otherwise = commonOpts - withStaticExe = not needProfiling && not needDynamic - - -- For building exe's that use TH with -prof or -dynamic we actually have - -- to build twice, once without -prof/-dynamic and then again with - -- -prof/-dynamic. This is because the code that TH needs to run at - -- compile time needs to be the vanilla ABI so it can be loaded up and run - -- by the compiler. - -- With dynamic-by-default GHC the TH object files loaded at compile-time - -- need to be .dyn_o instead of .o. - doingTH = usesTemplateHaskellOrQQ bnfo - -- Should we use -dynamic-too instead of compiling twice? - useDynToo = - dynamicTooSupported - && isGhcDynamic - && doingTH - && withStaticExe - && null (hcSharedOptions GHC bnfo) - compileTHOpts - | isGhcDynamic = dynOpts - | otherwise = staticOpts - compileForTH - | gbuildIsRepl bm = False - | useDynToo = False - | isGhcDynamic = doingTH && (needProfiling || withStaticExe) - | otherwise = doingTH && (needProfiling || needDynamic) - - -- Build static/dynamic object files for TH, if needed. - when compileForTH $ - runGhcProg - compileTHOpts - { ghcOptNoLink = toFlag True - , ghcOptNumJobs = numJobs - } - - -- Do not try to build anything if there are no input files. - -- This can happen if the cabal file ends up with only cSrcs - -- but no Haskell modules. - unless - ( (null inputFiles && null inputModules) - || gbuildIsRepl bm - ) - $ runGhcProg - compileOpts - { ghcOptNoLink = toFlag True - , ghcOptNumJobs = numJobs - } - - let - buildExtraSources mkSrcOpts wantDyn = traverse_ $ buildExtraSource mkSrcOpts wantDyn - buildExtraSource mkSrcOpts wantDyn filename = do - let baseSrcOpts = - mkSrcOpts - verbosity - implInfo - lbi - bnfo - clbi - tmpDir - filename - vanillaSrcOpts = - if isGhcDynamic && wantDyn - then -- Dynamic GHC requires C/C++ sources to be built - -- with -fPIC for REPL to work. See #2207. - baseSrcOpts{ghcOptFPic = toFlag True} - else baseSrcOpts - profSrcOpts = - vanillaSrcOpts - `mappend` mempty - { ghcOptProfilingMode = toFlag True - } - sharedSrcOpts = - vanillaSrcOpts - `mappend` mempty - { ghcOptFPic = toFlag True - , ghcOptDynLinkMode = toFlag GhcDynamicOnly - } - opts - | needProfiling = profSrcOpts - | needDynamic && wantDyn = sharedSrcOpts - | otherwise = vanillaSrcOpts - -- TODO: Placing all Haskell, C, & C++ objects in a single directory - -- Has the potential for file collisions. In general we would - -- consider this a user error. However, we should strive to - -- add a warning if this occurs. - odir = fromFlag (ghcOptObjDir opts) - - createDirectoryIfMissingVerbose verbosity True odir - needsRecomp <- checkNeedsRecompilation filename opts - when needsRecomp $ - runGhcProg opts - - -- build any C++ sources - unless (null cxxSrcs) $ do - info verbosity "Building C++ Sources..." - buildExtraSources Internal.componentCxxGhcOptions True cxxSrcs - - -- build any C sources - unless (null cSrcs) $ do - info verbosity "Building C Sources..." - buildExtraSources Internal.componentCcGhcOptions True cSrcs - - -- build any JS sources - unless (not hasJsSupport || null jsSrcs) $ do - info verbosity "Building JS Sources..." - buildExtraSources Internal.componentJsGhcOptions False jsSrcs - - -- build any ASM sources - unless (null asmSrcs) $ do - info verbosity "Building Assembler Sources..." - buildExtraSources Internal.componentAsmGhcOptions True asmSrcs - - -- build any Cmm sources - unless (null cmmSrcs) $ do - info verbosity "Building C-- Sources..." - buildExtraSources Internal.componentCmmGhcOptions True cmmSrcs - - -- TODO: problem here is we need the .c files built first, so we can load them - -- with ghci, but .c files can depend on .h files generated by ghc by ffi - -- exports. - case bm of - GReplExe _ _ -> runReplOrWriteFlags verbosity ghcProg comp platform replFlags replOpts bnfo clbi (pkgName (PD.package pkg_descr)) - GReplFLib _ _ -> runReplOrWriteFlags verbosity ghcProg comp platform replFlags replOpts bnfo clbi (pkgName (PD.package pkg_descr)) - GBuildExe _ -> do - let linkOpts = - commonOpts - `mappend` linkerOpts - `mappend` mempty - { ghcOptLinkNoHsMain = toFlag (null inputFiles) - } - `mappend` (if withDynExe lbi then dynLinkerOpts else mempty) - - info verbosity "Linking..." - -- Work around old GHCs not relinking in this - -- situation, see #3294 - let target = targetDir targetName - when (compilerVersion comp < mkVersion [7, 7]) $ do - e <- doesFileExist target - when e (removeFile target) - runGhcProg linkOpts{ghcOptOutputFile = toFlag target} - GBuildFLib flib -> do - let - -- Instruct GHC to link against libHSrts. - rtsLinkOpts :: GhcOptions - rtsLinkOpts - | supportsFLinkRts = - mempty - { ghcOptLinkRts = toFlag True - } - | otherwise = - mempty - { ghcOptLinkLibs = rtsOptLinkLibs - , ghcOptLinkLibPath = toNubListR $ rtsLibPaths rtsInfo - } - where - threaded = hasThreaded (gbuildInfo bm) - supportsFLinkRts = compilerVersion comp >= mkVersion [9, 0] - rtsInfo = extractRtsInfo lbi - rtsOptLinkLibs = - [ if needDynamic - then - if threaded - then dynRtsThreadedLib (rtsDynamicInfo rtsInfo) - else dynRtsVanillaLib (rtsDynamicInfo rtsInfo) - else - if threaded - then statRtsThreadedLib (rtsStaticInfo rtsInfo) - else statRtsVanillaLib (rtsStaticInfo rtsInfo) - ] - - linkOpts :: GhcOptions - linkOpts = case foreignLibType flib of - ForeignLibNativeShared -> - commonOpts - `mappend` linkerOpts - `mappend` dynLinkerOpts - `mappend` rtsLinkOpts - `mappend` mempty - { ghcOptLinkNoHsMain = toFlag True - , ghcOptShared = toFlag True - , ghcOptFPic = toFlag True - , ghcOptLinkModDefFiles = toNubListR $ gbuildModDefFiles bm - } - ForeignLibNativeStatic -> - -- this should be caught by buildFLib - -- (and if we do implement this, we probably don't even want to call - -- ghc here, but rather Ar.createArLibArchive or something) - cabalBug "static libraries not yet implemented" - ForeignLibTypeUnknown -> - cabalBug "unknown foreign lib type" - -- We build under a (potentially) different filename to set a - -- soname on supported platforms. See also the note for - -- @flibBuildName@. - info verbosity "Linking..." - let buildName = flibBuildName lbi flib - runGhcProg linkOpts{ghcOptOutputFile = toFlag (targetDir buildName)} - renameFile (targetDir buildName) (targetDir targetName) - -data DynamicRtsInfo = DynamicRtsInfo - { dynRtsVanillaLib :: FilePath - , dynRtsThreadedLib :: FilePath - , dynRtsDebugLib :: FilePath - , dynRtsEventlogLib :: FilePath - , dynRtsThreadedDebugLib :: FilePath - , dynRtsThreadedEventlogLib :: FilePath - } - -data StaticRtsInfo = StaticRtsInfo - { statRtsVanillaLib :: FilePath - , statRtsThreadedLib :: FilePath - , statRtsDebugLib :: FilePath - , statRtsEventlogLib :: FilePath - , statRtsThreadedDebugLib :: FilePath - , statRtsThreadedEventlogLib :: FilePath - , statRtsProfilingLib :: FilePath - , statRtsThreadedProfilingLib :: FilePath - } - -data RtsInfo = RtsInfo - { rtsDynamicInfo :: DynamicRtsInfo - , rtsStaticInfo :: StaticRtsInfo - , rtsLibPaths :: [FilePath] - } - --- | Extract (and compute) information about the RTS library --- --- TODO: This hardcodes the name as @HSrts-ghc@. I don't know if we can --- find this information somewhere. We can lookup the 'hsLibraries' field of --- 'InstalledPackageInfo' but it will tell us @["HSrts", "Cffi"]@, which --- doesn't really help. -extractRtsInfo :: LocalBuildInfo -> RtsInfo -extractRtsInfo lbi = - case PackageIndex.lookupPackageName - (installedPkgs lbi) - (mkPackageName "rts") of - [(_, [rts])] -> aux rts - _otherwise -> error "No (or multiple) ghc rts package is registered" - where - aux :: InstalledPackageInfo -> RtsInfo - aux rts = - RtsInfo - { rtsDynamicInfo = - DynamicRtsInfo - { dynRtsVanillaLib = withGhcVersion "HSrts" - , dynRtsThreadedLib = withGhcVersion "HSrts_thr" - , dynRtsDebugLib = withGhcVersion "HSrts_debug" - , dynRtsEventlogLib = withGhcVersion "HSrts_l" - , dynRtsThreadedDebugLib = withGhcVersion "HSrts_thr_debug" - , dynRtsThreadedEventlogLib = withGhcVersion "HSrts_thr_l" - } - , rtsStaticInfo = - StaticRtsInfo - { statRtsVanillaLib = "HSrts" - , statRtsThreadedLib = "HSrts_thr" - , statRtsDebugLib = "HSrts_debug" - , statRtsEventlogLib = "HSrts_l" - , statRtsThreadedDebugLib = "HSrts_thr_debug" - , statRtsThreadedEventlogLib = "HSrts_thr_l" - , statRtsProfilingLib = "HSrts_p" - , statRtsThreadedProfilingLib = "HSrts_thr_p" - } - , rtsLibPaths = InstalledPackageInfo.libraryDirs rts - } - withGhcVersion = (++ ("-ghc" ++ prettyShow (compilerVersion (compiler lbi)))) - --- | Returns True if the modification date of the given source file is newer than --- the object file we last compiled for it, or if no object file exists yet. -checkNeedsRecompilation :: FilePath -> GhcOptions -> IO Bool -checkNeedsRecompilation filename opts = filename `moreRecentFile` oname - where - oname = getObjectFileName filename opts - --- | Finds the object file name of the given source file -getObjectFileName :: FilePath -> GhcOptions -> FilePath -getObjectFileName filename opts = oname - where - odir = fromFlag (ghcOptObjDir opts) - oext = fromFlagOrDefault "o" (ghcOptObjSuffix opts) - oname = odir replaceExtension filename oext - --- | Calculate the RPATHs for the component we are building. --- --- Calculates relative RPATHs when 'relocatable' is set. -getRPaths - :: LocalBuildInfo - -> ComponentLocalBuildInfo - -- ^ Component we are building - -> IO (NubListR FilePath) -getRPaths lbi clbi | supportRPaths hostOS = do - libraryPaths <- depLibraryPaths False (relocatable lbi) lbi clbi - let hostPref = case hostOS of - OSX -> "@loader_path" - _ -> "$ORIGIN" - relPath p = if isRelative p then hostPref p else p - rpaths = toNubListR (map relPath libraryPaths) - return rpaths - where - (Platform _ hostOS) = hostPlatform lbi - compid = compilerId . compiler $ lbi - - -- The list of RPath-supported operating systems below reflects the - -- platforms on which Cabal's RPATH handling is tested. It does _NOT_ - -- reflect whether the OS supports RPATH. - - -- E.g. when this comment was written, the *BSD operating systems were - -- untested with regards to Cabal RPATH handling, and were hence set to - -- 'False', while those operating systems themselves do support RPATH. - supportRPaths Linux = True - supportRPaths Windows = False - supportRPaths OSX = True - supportRPaths FreeBSD = - case compid of - CompilerId GHC ver | ver >= mkVersion [7, 10, 2] -> True - _ -> False - supportRPaths OpenBSD = False - supportRPaths NetBSD = False - supportRPaths DragonFly = False - supportRPaths Solaris = False - supportRPaths AIX = False - supportRPaths HPUX = False - supportRPaths IRIX = False - supportRPaths HaLVM = False - supportRPaths IOS = False - supportRPaths Android = False - supportRPaths Ghcjs = False - supportRPaths Wasi = False - supportRPaths Hurd = True - supportRPaths Haiku = False - supportRPaths (OtherOS _) = False --- Do _not_ add a default case so that we get a warning here when a new OS --- is added. - -getRPaths _ _ = return mempty - --- | Determine whether the given 'BuildInfo' is intended to link against the --- threaded RTS. This is used to determine which RTS to link against when --- building a foreign library with a GHC without support for @-flink-rts@. -hasThreaded :: BuildInfo -> Bool -hasThreaded bi = elem "-threaded" ghc - where - PerCompilerFlavor ghc _ = options bi - -- | Extracts a String representing a hash of the ABI of a built -- library. It can fail if the library has not yet been built. libAbiHash @@ -2092,19 +703,6 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do (ghcInvocation ghcProg comp platform ghcArgs) return (takeWhile (not . isSpace) hash) -componentGhcOptions - :: Verbosity - -> LocalBuildInfo - -> BuildInfo - -> ComponentLocalBuildInfo - -> FilePath - -> GhcOptions -componentGhcOptions verbosity lbi = - Internal.componentGhcOptions verbosity implInfo lbi - where - comp = compiler lbi - implInfo = getImplInfo comp - componentCcGhcOptions :: Verbosity -> LocalBuildInfo @@ -2413,15 +1011,3 @@ pkgRoot verbosity lbi = pkgRoot' createDirectoryIfMissing True rootDir return rootDir pkgRoot' (SpecificPackageDB fp) = return (takeDirectory fp) - --- ----------------------------------------------------------------------------- --- Utils - -isDynamic :: Compiler -> Bool -isDynamic = Internal.ghcLookupProperty "GHC Dynamic" - -supportsDynamicToo :: Compiler -> Bool -supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too" - -withExt :: FilePath -> String -> FilePath -withExt fp ext = fp <.> if takeExtension fp /= ('.' : ext) then ext else "" diff --git a/Cabal/src/Distribution/Simple/GHC/Build.hs b/Cabal/src/Distribution/Simple/GHC/Build.hs new file mode 100644 index 00000000000..4afd2a03a2f --- /dev/null +++ b/Cabal/src/Distribution/Simple/GHC/Build.hs @@ -0,0 +1,262 @@ +module Distribution.Simple.GHC.Build + ( getRPaths + , runReplOrWriteFlags + , checkNeedsRecompilation + , replNoLoad + , componentGhcOptions + , supportsDynamicToo + , isDynamic + , flibBuildName + , flibTargetName + , exeTargetName + ) +where + +import Distribution.Compat.Prelude +import Prelude () + +import qualified Data.ByteString.Lazy.Char8 as BS +import Distribution.Compat.Binary (encode) +import Distribution.Compat.ResponseFile (escapeArgs) +import qualified Distribution.InstalledPackageInfo as IPI +import Distribution.Package +import Distribution.PackageDescription as PD +import Distribution.PackageDescription.Utils (cabalBug) +import Distribution.Pretty +import Distribution.Simple.BuildPaths +import Distribution.Simple.Compiler +import Distribution.Simple.Flag (Flag (..), fromFlag, fromFlagOrDefault) +import Distribution.Simple.GHC.ImplInfo +import qualified Distribution.Simple.GHC.Internal as Internal +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.Program +import Distribution.Simple.Program.GHC +import Distribution.Simple.Setup.Repl +import Distribution.Simple.Utils +import Distribution.System +import Distribution.Utils.NubList +import Distribution.Verbosity +import Distribution.Version +import System.Directory + ( createDirectoryIfMissing + , getCurrentDirectory + ) +import System.FilePath + ( isRelative + , replaceExtension + , takeExtension + , (<.>) + , () + ) + +exeTargetName :: Platform -> Executable -> String +exeTargetName platform exe = unUnqualComponentName (exeName exe) `withExt` exeExtension platform + +withExt :: FilePath -> String -> FilePath +withExt fp ext = fp <.> if takeExtension fp /= ('.' : ext) then ext else "" + +-- | Target name for a foreign library (the actual file name) +-- +-- We do not use mkLibName and co here because the naming for foreign libraries +-- is slightly different (we don't use "_p" or compiler version suffices, and we +-- don't want the "lib" prefix on Windows). +-- +-- TODO: We do use `dllExtension` and co here, but really that's wrong: they +-- use the OS used to build cabal to determine which extension to use, rather +-- than the target OS (but this is wrong elsewhere in Cabal as well). +flibTargetName :: LocalBuildInfo -> ForeignLib -> String +flibTargetName lbi flib = + case (os, foreignLibType flib) of + (Windows, ForeignLibNativeShared) -> nm <.> "dll" + (Windows, ForeignLibNativeStatic) -> nm <.> "lib" + (Linux, ForeignLibNativeShared) -> "lib" ++ nm <.> versionedExt + (_other, ForeignLibNativeShared) -> + "lib" ++ nm <.> dllExtension (hostPlatform lbi) + (_other, ForeignLibNativeStatic) -> + "lib" ++ nm <.> staticLibExtension (hostPlatform lbi) + (_any, ForeignLibTypeUnknown) -> cabalBug "unknown foreign lib type" + where + nm :: String + nm = unUnqualComponentName $ foreignLibName flib + + os :: OS + os = + let (Platform _ os') = hostPlatform lbi + in os' + + -- If a foreign lib foo has lib-version-info 5:1:2 or + -- lib-version-linux 3.2.1, it should be built as libfoo.so.3.2.1 + -- Libtool's version-info data is translated into library versions in a + -- nontrivial way: so refer to libtool documentation. + versionedExt :: String + versionedExt = + let nums = foreignLibVersion flib os + in foldl (<.>) "so" (map show nums) + +-- | Name for the library when building. +-- +-- If the `lib-version-info` field or the `lib-version-linux` field of +-- a foreign library target is set, we need to incorporate that +-- version into the SONAME field. +-- +-- If a foreign library foo has lib-version-info 5:1:2, it should be +-- built as libfoo.so.3.2.1. We want it to get soname libfoo.so.3. +-- However, GHC does not allow overriding soname by setting linker +-- options, as it sets a soname of its own (namely the output +-- filename), after the user-supplied linker options. Hence, we have +-- to compile the library with the soname as its filename. We rename +-- the compiled binary afterwards. +-- +-- This method allows to adjust the name of the library at build time +-- such that the correct soname can be set. +flibBuildName :: LocalBuildInfo -> ForeignLib -> String +flibBuildName lbi flib + -- On linux, if a foreign-library has version data, the first digit is used + -- to produce the SONAME. + | (os, foreignLibType flib) + == (Linux, ForeignLibNativeShared) = + let nums = foreignLibVersion flib os + in "lib" ++ nm <.> foldl (<.>) "so" (map show (take 1 nums)) + | otherwise = flibTargetName lbi flib + where + os :: OS + os = + let (Platform _ os') = hostPlatform lbi + in os' + + nm :: String + nm = unUnqualComponentName $ foreignLibName flib + +supportsDynamicToo :: Compiler -> Bool +supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too" + +isDynamic :: Compiler -> Bool +isDynamic = Internal.ghcLookupProperty "GHC Dynamic" + +componentGhcOptions + :: Verbosity + -> LocalBuildInfo + -> BuildInfo + -> ComponentLocalBuildInfo + -> FilePath + -> GhcOptions +componentGhcOptions verbosity lbi = + Internal.componentGhcOptions verbosity implInfo lbi + where + comp = compiler lbi + implInfo = getImplInfo comp + +replNoLoad :: Ord a => ReplOptions -> NubListR a -> NubListR a +replNoLoad replFlags l + | replOptionsNoLoad replFlags == Flag True = mempty + | otherwise = l + +-- | Finds the object file name of the given source file +getObjectFileName :: FilePath -> GhcOptions -> FilePath +getObjectFileName filename opts = oname + where + odir = fromFlag (ghcOptObjDir opts) + oext = fromFlagOrDefault "o" (ghcOptObjSuffix opts) + oname = odir replaceExtension filename oext + +-- | Returns True if the modification date of the given source file is newer than +-- the object file we last compiled for it, or if no object file exists yet. +checkNeedsRecompilation :: FilePath -> GhcOptions -> IO Bool +checkNeedsRecompilation filename opts = filename `moreRecentFile` oname + where + oname = getObjectFileName filename opts + +-- | Calculate the RPATHs for the component we are building. +-- +-- Calculates relative RPATHs when 'relocatable' is set. +getRPaths + :: LocalBuildInfo + -> ComponentLocalBuildInfo + -- ^ Component we are building + -> IO (NubListR FilePath) +getRPaths lbi clbi | supportRPaths hostOS = do + libraryPaths <- depLibraryPaths False (relocatable lbi) lbi clbi + let hostPref = case hostOS of + OSX -> "@loader_path" + _ -> "$ORIGIN" + relPath p = if isRelative p then hostPref p else p + rpaths = toNubListR (map relPath libraryPaths) + return rpaths + where + (Platform _ hostOS) = hostPlatform lbi + compid = compilerId . compiler $ lbi + + -- The list of RPath-supported operating systems below reflects the + -- platforms on which Cabal's RPATH handling is tested. It does _NOT_ + -- reflect whether the OS supports RPATH. + + -- E.g. when this comment was written, the *BSD operating systems were + -- untested with regards to Cabal RPATH handling, and were hence set to + -- 'False', while those operating systems themselves do support RPATH. + supportRPaths Linux = True + supportRPaths Windows = False + supportRPaths OSX = True + supportRPaths FreeBSD = + case compid of + CompilerId GHC ver | ver >= mkVersion [7, 10, 2] -> True + _ -> False + supportRPaths OpenBSD = False + supportRPaths NetBSD = False + supportRPaths DragonFly = False + supportRPaths Solaris = False + supportRPaths AIX = False + supportRPaths HPUX = False + supportRPaths IRIX = False + supportRPaths HaLVM = False + supportRPaths IOS = False + supportRPaths Android = False + supportRPaths Ghcjs = False + supportRPaths Wasi = False + supportRPaths Hurd = True + supportRPaths Haiku = False + supportRPaths (OtherOS _) = False +-- Do _not_ add a default case so that we get a warning here when a new OS +-- is added. + +getRPaths _ _ = return mempty + +runReplOrWriteFlags + :: Verbosity + -> ConfiguredProgram + -> Compiler + -> Platform + -> ReplOptions + -> GhcOptions + -> BuildInfo + -> ComponentLocalBuildInfo + -> PackageName + -> IO () +runReplOrWriteFlags verbosity ghcProg comp platform rflags replOpts bi clbi pkg_name = + case replOptionsFlagOutput rflags of + NoFlag -> runGHC verbosity ghcProg comp platform replOpts + Flag out_dir -> do + src_dir <- getCurrentDirectory + let uid = componentUnitId clbi + this_unit = prettyShow uid + reexported_modules = [mn | LibComponentLocalBuildInfo{} <- [clbi], IPI.ExposedModule mn (Just{}) <- componentExposedModules clbi] + hidden_modules = otherModules bi + extra_opts = + concat $ + [ ["-this-package-name", prettyShow pkg_name] + , ["-working-dir", src_dir] + ] + ++ [ ["-reexported-module", prettyShow m] | m <- reexported_modules + ] + ++ [ ["-hidden-module", prettyShow m] | m <- hidden_modules + ] + -- Create "paths" subdirectory if it doesn't exist. This is where we write + -- information about how the PATH was augmented. + createDirectoryIfMissing False (out_dir "paths") + -- Write out the PATH information into `paths` subdirectory. + writeFileAtomic (out_dir "paths" this_unit) (encode ghcProg) + -- Write out options for this component into a file ready for loading into + -- the multi-repl + writeFileAtomic (out_dir this_unit) $ + BS.pack $ + escapeArgs $ + extra_opts ++ renderGhcOptions comp platform (replOpts{ghcOptMode = NoFlag}) diff --git a/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs b/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs new file mode 100644 index 00000000000..e4c4408b40b --- /dev/null +++ b/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs @@ -0,0 +1,749 @@ +module Distribution.Simple.GHC.BuildGeneric + ( GBuildMode (..) + , gbuild + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Control.Monad (msum) +import Data.Char (isLower) +import Distribution.CabalSpecVersion +import Distribution.InstalledPackageInfo (InstalledPackageInfo) +import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo +import Distribution.ModuleName (ModuleName) +import qualified Distribution.ModuleName as ModuleName +import Distribution.Package +import Distribution.PackageDescription as PD +import Distribution.PackageDescription.Utils (cabalBug) +import Distribution.Pretty +import Distribution.Simple.BuildPaths +import Distribution.Simple.Compiler +import Distribution.Simple.Flag (Flag (..), fromFlag, toFlag) +import Distribution.Simple.GHC.Build + ( checkNeedsRecompilation + , componentGhcOptions + , exeTargetName + , flibBuildName + , flibTargetName + , getRPaths + , isDynamic + , replNoLoad + , runReplOrWriteFlags + , supportsDynamicToo + ) +import Distribution.Simple.GHC.ImplInfo +import qualified Distribution.Simple.GHC.Internal as Internal +import qualified Distribution.Simple.Hpc as Hpc +import Distribution.Simple.LocalBuildInfo +import qualified Distribution.Simple.PackageIndex as PackageIndex +import Distribution.Simple.Program +import Distribution.Simple.Program.GHC +import Distribution.Simple.Setup.Config +import Distribution.Simple.Setup.Repl +import Distribution.Simple.Utils +import Distribution.System +import Distribution.Types.PackageName.Magic +import Distribution.Types.ParStrat +import Distribution.Utils.NubList +import Distribution.Utils.Path +import Distribution.Verbosity +import Distribution.Version +import System.Directory + ( doesDirectoryExist + , doesFileExist + , removeFile + , renameFile + ) +import System.FilePath + ( replaceExtension + , takeExtension + , () + ) + +-- | A collection of: +-- * C input files +-- * C++ input files +-- * GHC input files +-- * GHC input modules +-- +-- Used to correctly build and link sources. +data BuildSources = BuildSources + { cSourcesFiles :: [FilePath] + , cxxSourceFiles :: [FilePath] + , jsSourceFiles :: [FilePath] + , asmSourceFiles :: [FilePath] + , cmmSourceFiles :: [FilePath] + , inputSourceFiles :: [FilePath] + , inputSourceModules :: [ModuleName] + } + +data DynamicRtsInfo = DynamicRtsInfo + { dynRtsVanillaLib :: FilePath + , dynRtsThreadedLib :: FilePath + , dynRtsDebugLib :: FilePath + , dynRtsEventlogLib :: FilePath + , dynRtsThreadedDebugLib :: FilePath + , dynRtsThreadedEventlogLib :: FilePath + } + +data StaticRtsInfo = StaticRtsInfo + { statRtsVanillaLib :: FilePath + , statRtsThreadedLib :: FilePath + , statRtsDebugLib :: FilePath + , statRtsEventlogLib :: FilePath + , statRtsThreadedDebugLib :: FilePath + , statRtsThreadedEventlogLib :: FilePath + , statRtsProfilingLib :: FilePath + , statRtsThreadedProfilingLib :: FilePath + } + +data RtsInfo = RtsInfo + { rtsDynamicInfo :: DynamicRtsInfo + , rtsStaticInfo :: StaticRtsInfo + , rtsLibPaths :: [FilePath] + } + +-- | Building an executable, starting the REPL, and building foreign +-- libraries are all very similar and implemented in 'gbuild'. The +-- 'GBuildMode' distinguishes between the various kinds of operation. +data GBuildMode + = GBuildExe Executable + | GReplExe ReplOptions Executable + | GBuildFLib ForeignLib + | GReplFLib ReplOptions ForeignLib + +gbuildInfo :: GBuildMode -> BuildInfo +gbuildInfo (GBuildExe exe) = buildInfo exe +gbuildInfo (GReplExe _ exe) = buildInfo exe +gbuildInfo (GBuildFLib flib) = foreignLibBuildInfo flib +gbuildInfo (GReplFLib _ flib) = foreignLibBuildInfo flib + +gbuildIsRepl :: GBuildMode -> Bool +gbuildIsRepl (GBuildExe _) = False +gbuildIsRepl (GReplExe _ _) = True +gbuildIsRepl (GBuildFLib _) = False +gbuildIsRepl (GReplFLib _ _) = True + +gbuildModDefFiles :: GBuildMode -> [FilePath] +gbuildModDefFiles (GBuildExe _) = [] +gbuildModDefFiles (GReplExe _ _) = [] +gbuildModDefFiles (GBuildFLib flib) = foreignLibModDefFile flib +gbuildModDefFiles (GReplFLib _ flib) = foreignLibModDefFile flib + +gbuildName :: GBuildMode -> String +gbuildName (GBuildExe exe) = unUnqualComponentName $ exeName exe +gbuildName (GReplExe _ exe) = unUnqualComponentName $ exeName exe +gbuildName (GBuildFLib flib) = unUnqualComponentName $ foreignLibName flib +gbuildName (GReplFLib _ flib) = unUnqualComponentName $ foreignLibName flib + +gbuildTargetName :: LocalBuildInfo -> GBuildMode -> String +gbuildTargetName lbi (GBuildExe exe) = exeTargetName (hostPlatform lbi) exe +gbuildTargetName lbi (GReplExe _ exe) = exeTargetName (hostPlatform lbi) exe +gbuildTargetName lbi (GBuildFLib flib) = flibTargetName lbi flib +gbuildTargetName lbi (GReplFLib _ flib) = flibTargetName lbi flib + +gbuildNeedDynamic :: LocalBuildInfo -> GBuildMode -> Bool +gbuildNeedDynamic lbi bm = + case bm of + GBuildExe _ -> withDynExe lbi + GReplExe _ _ -> withDynExe lbi + GBuildFLib flib -> withDynFLib flib + GReplFLib _ flib -> withDynFLib flib + where + withDynFLib flib = + case foreignLibType flib of + ForeignLibNativeShared -> + ForeignLibStandalone `notElem` foreignLibOptions flib + ForeignLibNativeStatic -> + False + ForeignLibTypeUnknown -> + cabalBug "unknown foreign lib type" + +-- | Locate and return the 'BuildSources' required to build and link. +gbuildSources + :: Verbosity + -> PackageId + -> CabalSpecVersion + -> FilePath + -> GBuildMode + -> IO BuildSources +gbuildSources verbosity pkgId specVer tmpDir bm = + case bm of + GBuildExe exe -> exeSources exe + GReplExe _ exe -> exeSources exe + GBuildFLib flib -> return $ flibSources flib + GReplFLib _ flib -> return $ flibSources flib + where + exeSources :: Executable -> IO BuildSources + exeSources exe@Executable{buildInfo = bnfo, modulePath = modPath} = do + main <- findFileEx verbosity (tmpDir : map getSymbolicPath (hsSourceDirs bnfo)) modPath + let mainModName = fromMaybe ModuleName.main $ exeMainModuleName exe + otherModNames = exeModules exe + + -- Scripts have fakePackageId and are always Haskell but can have any extension. + if isHaskell main || pkgId == fakePackageId + then + if specVer < CabalSpecV2_0 && (mainModName `elem` otherModNames) + then do + -- The cabal manual clearly states that `other-modules` is + -- intended for non-main modules. However, there's at least one + -- important package on Hackage (happy-1.19.5) which + -- violates this. We workaround this here so that we don't + -- invoke GHC with e.g. 'ghc --make Main src/Main.hs' which + -- would result in GHC complaining about duplicate Main + -- modules. + -- + -- Finally, we only enable this workaround for + -- specVersion < 2, as 'cabal-version:>=2.0' cabal files + -- have no excuse anymore to keep doing it wrong... ;-) + warn verbosity $ + "Enabling workaround for Main module '" + ++ prettyShow mainModName + ++ "' listed in 'other-modules' illegally!" + + return + BuildSources + { cSourcesFiles = cSources bnfo + , cxxSourceFiles = cxxSources bnfo + , jsSourceFiles = jsSources bnfo + , asmSourceFiles = asmSources bnfo + , cmmSourceFiles = cmmSources bnfo + , inputSourceFiles = [main] + , inputSourceModules = + filter (/= mainModName) $ + exeModules exe + } + else + return + BuildSources + { cSourcesFiles = cSources bnfo + , cxxSourceFiles = cxxSources bnfo + , jsSourceFiles = jsSources bnfo + , asmSourceFiles = asmSources bnfo + , cmmSourceFiles = cmmSources bnfo + , inputSourceFiles = [main] + , inputSourceModules = exeModules exe + } + else + let (csf, cxxsf) + | isCxx main = (cSources bnfo, main : cxxSources bnfo) + -- if main is not a Haskell source + -- and main is not a C++ source + -- then we assume that it is a C source + | otherwise = (main : cSources bnfo, cxxSources bnfo) + in return + BuildSources + { cSourcesFiles = csf + , cxxSourceFiles = cxxsf + , jsSourceFiles = jsSources bnfo + , asmSourceFiles = asmSources bnfo + , cmmSourceFiles = cmmSources bnfo + , inputSourceFiles = [] + , inputSourceModules = exeModules exe + } + + flibSources :: ForeignLib -> BuildSources + flibSources flib@ForeignLib{foreignLibBuildInfo = bnfo} = + BuildSources + { cSourcesFiles = cSources bnfo + , cxxSourceFiles = cxxSources bnfo + , jsSourceFiles = jsSources bnfo + , asmSourceFiles = asmSources bnfo + , cmmSourceFiles = cmmSources bnfo + , inputSourceFiles = [] + , inputSourceModules = foreignLibModules flib + } + + isCxx :: FilePath -> Bool + isCxx fp = elem (takeExtension fp) [".cpp", ".cxx", ".c++"] + +-- | Extract (and compute) information about the RTS library +-- +-- TODO: This hardcodes the name as @HSrts-ghc@. I don't know if we can +-- find this information somewhere. We can lookup the 'hsLibraries' field of +-- 'InstalledPackageInfo' but it will tell us @["HSrts", "Cffi"]@, which +-- doesn't really help. +extractRtsInfo :: LocalBuildInfo -> RtsInfo +extractRtsInfo lbi = + case PackageIndex.lookupPackageName + (installedPkgs lbi) + (mkPackageName "rts") of + [(_, [rts])] -> aux rts + _otherwise -> error "No (or multiple) ghc rts package is registered" + where + aux :: InstalledPackageInfo -> RtsInfo + aux rts = + RtsInfo + { rtsDynamicInfo = + DynamicRtsInfo + { dynRtsVanillaLib = withGhcVersion "HSrts" + , dynRtsThreadedLib = withGhcVersion "HSrts_thr" + , dynRtsDebugLib = withGhcVersion "HSrts_debug" + , dynRtsEventlogLib = withGhcVersion "HSrts_l" + , dynRtsThreadedDebugLib = withGhcVersion "HSrts_thr_debug" + , dynRtsThreadedEventlogLib = withGhcVersion "HSrts_thr_l" + } + , rtsStaticInfo = + StaticRtsInfo + { statRtsVanillaLib = "HSrts" + , statRtsThreadedLib = "HSrts_thr" + , statRtsDebugLib = "HSrts_debug" + , statRtsEventlogLib = "HSrts_l" + , statRtsThreadedDebugLib = "HSrts_thr_debug" + , statRtsThreadedEventlogLib = "HSrts_thr_l" + , statRtsProfilingLib = "HSrts_p" + , statRtsThreadedProfilingLib = "HSrts_thr_p" + } + , rtsLibPaths = InstalledPackageInfo.libraryDirs rts + } + withGhcVersion = (++ ("-ghc" ++ prettyShow (compilerVersion (compiler lbi)))) + +-- | Determine whether the given 'BuildInfo' is intended to link against the +-- threaded RTS. This is used to determine which RTS to link against when +-- building a foreign library with a GHC without support for @-flink-rts@. +hasThreaded :: BuildInfo -> Bool +hasThreaded bi = elem "-threaded" ghc + where + PerCompilerFlavor ghc _ = options bi + +-- | FilePath has a Haskell extension: .hs or .lhs +isHaskell :: FilePath -> Bool +isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"] + +-- | "Main" module name when overridden by @ghc-options: -main-is ...@ +-- or 'Nothing' if no @-main-is@ flag could be found. +-- +-- In case of 'Nothing', 'Distribution.ModuleName.main' can be assumed. +exeMainModuleName :: Executable -> Maybe ModuleName +exeMainModuleName Executable{buildInfo = bnfo} = + -- GHC honors the last occurrence of a module name updated via -main-is + -- + -- Moreover, -main-is when parsed left-to-right can update either + -- the "Main" module name, or the "main" function name, or both, + -- see also 'decodeMainIsArg'. + msum $ reverse $ map decodeMainIsArg $ findIsMainArgs ghcopts + where + ghcopts = hcOptions GHC bnfo + + findIsMainArgs [] = [] + findIsMainArgs ("-main-is" : arg : rest) = arg : findIsMainArgs rest + findIsMainArgs (_ : rest) = findIsMainArgs rest + +-- | Decode argument to '-main-is' +-- +-- Returns 'Nothing' if argument set only the function name. +-- +-- This code has been stolen/refactored from GHC's DynFlags.setMainIs +-- function. The logic here is deliberately imperfect as it is +-- intended to be bug-compatible with GHC's parser. See discussion in +-- https://github.com/haskell/cabal/pull/4539#discussion_r118981753. +decodeMainIsArg :: String -> Maybe ModuleName +decodeMainIsArg arg + | headOf main_fn isLower = + -- The arg looked like "Foo.Bar.baz" + Just (ModuleName.fromString main_mod) + | headOf arg isUpper -- The arg looked like "Foo" or "Foo.Bar" + = + Just (ModuleName.fromString arg) + | otherwise -- The arg looked like "baz" + = + Nothing + where + headOf :: String -> (Char -> Bool) -> Bool + headOf str pred' = any pred' (safeHead str) + + (main_mod, main_fn) = splitLongestPrefix arg (== '.') + + splitLongestPrefix :: String -> (Char -> Bool) -> (String, String) + splitLongestPrefix str pred' + | null r_pre = (str, []) + | otherwise = (reverse (safeTail r_pre), reverse r_suf) + where + -- 'safeTail' drops the char satisfying 'pred' + (r_suf, r_pre) = break pred' (reverse str) + +-- | Generic build function. See comment for 'GBuildMode'. +gbuild + :: Verbosity + -> Flag ParStrat + -> PackageDescription + -> LocalBuildInfo + -> GBuildMode + -> ComponentLocalBuildInfo + -> IO () +gbuild verbosity numJobs pkg_descr lbi bm clbi = do + (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) + let replFlags = case bm of + GReplExe flags _ -> flags + GReplFLib flags _ -> flags + GBuildExe{} -> mempty + GBuildFLib{} -> mempty + comp = compiler lbi + platform = hostPlatform lbi + implInfo = getImplInfo comp + runGhcProg = runGHC verbosity ghcProg comp platform + + let bnfo = gbuildInfo bm + + -- the name that GHC really uses (e.g., with .exe on Windows for executables) + let targetName = gbuildTargetName lbi bm + let targetDir = buildDir lbi (gbuildName bm) + let tmpDir = targetDir (gbuildName bm ++ "-tmp") + createDirectoryIfMissingVerbose verbosity True targetDir + createDirectoryIfMissingVerbose verbosity True tmpDir + + -- TODO: do we need to put hs-boot files into place for mutually recursive + -- modules? FIX: what about exeName.hi-boot? + + -- Determine if program coverage should be enabled and if so, what + -- '-hpcdir' should be. + let isCoverageEnabled = exeCoverage lbi + distPref = fromFlag $ configDistPref $ configFlags lbi + hpcdir way + | gbuildIsRepl bm = mempty -- HPC is not supported in ghci + | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way (gbuildName bm) + | otherwise = mempty + + rpaths <- getRPaths lbi clbi + buildSources <- gbuildSources verbosity (package pkg_descr) (specVersion pkg_descr) tmpDir bm + + -- ensure extra lib dirs exist before passing to ghc + cleanedExtraLibDirs <- filterM doesDirectoryExist (extraLibDirs bnfo) + cleanedExtraLibDirsStatic <- filterM doesDirectoryExist (extraLibDirsStatic bnfo) + + let cSrcs = cSourcesFiles buildSources + cxxSrcs = cxxSourceFiles buildSources + jsSrcs = jsSourceFiles buildSources + asmSrcs = asmSourceFiles buildSources + cmmSrcs = cmmSourceFiles buildSources + inputFiles = inputSourceFiles buildSources + inputModules = inputSourceModules buildSources + isGhcDynamic = isDynamic comp + dynamicTooSupported = supportsDynamicToo comp + cLikeObjs = map (`replaceExtension` objExtension) cSrcs + cxxObjs = map (`replaceExtension` objExtension) cxxSrcs + jsObjs = if hasJsSupport then map (`replaceExtension` objExtension) jsSrcs else [] + asmObjs = map (`replaceExtension` objExtension) asmSrcs + cmmObjs = map (`replaceExtension` objExtension) cmmSrcs + needDynamic = gbuildNeedDynamic lbi bm + needProfiling = withProfExe lbi + Platform hostArch _ = hostPlatform lbi + hasJsSupport = hostArch == JavaScript + + -- build executables + baseOpts = + (componentGhcOptions verbosity lbi bnfo clbi tmpDir) + `mappend` mempty + { ghcOptMode = toFlag GhcModeMake + , ghcOptInputFiles = + toNubListR $ + if package pkg_descr == fakePackageId + then filter isHaskell inputFiles + else inputFiles + , ghcOptInputScripts = + toNubListR $ + if package pkg_descr == fakePackageId + then filter (not . isHaskell) inputFiles + else [] + , ghcOptInputModules = toNubListR inputModules + } + staticOpts = + baseOpts + `mappend` mempty + { ghcOptDynLinkMode = toFlag GhcStaticOnly + , ghcOptHPCDir = hpcdir Hpc.Vanilla + } + profOpts = + baseOpts + `mappend` mempty + { ghcOptProfilingMode = toFlag True + , ghcOptProfilingAuto = + Internal.profDetailLevelFlag + False + (withProfExeDetail lbi) + , ghcOptHiSuffix = toFlag "p_hi" + , ghcOptObjSuffix = toFlag "p_o" + , ghcOptExtra = hcProfOptions GHC bnfo + , ghcOptHPCDir = hpcdir Hpc.Prof + } + dynOpts = + baseOpts + `mappend` mempty + { ghcOptDynLinkMode = toFlag GhcDynamicOnly + , -- TODO: Does it hurt to set -fPIC for executables? + ghcOptFPic = toFlag True + , ghcOptHiSuffix = toFlag "dyn_hi" + , ghcOptObjSuffix = toFlag "dyn_o" + , ghcOptExtra = hcSharedOptions GHC bnfo + , ghcOptHPCDir = hpcdir Hpc.Dyn + } + dynTooOpts = + staticOpts + `mappend` mempty + { ghcOptDynLinkMode = toFlag GhcStaticAndDynamic + , ghcOptDynHiSuffix = toFlag "dyn_hi" + , ghcOptDynObjSuffix = toFlag "dyn_o" + , ghcOptHPCDir = hpcdir Hpc.Dyn + } + linkerOpts = + mempty + { ghcOptLinkOptions = + PD.ldOptions bnfo + ++ [ "-static" + | withFullyStaticExe lbi + ] + -- Pass extra `ld-options` given + -- through to GHC's linker. + ++ maybe + [] + programOverrideArgs + (lookupProgram ldProgram (withPrograms lbi)) + , ghcOptLinkLibs = + if withFullyStaticExe lbi + then extraLibsStatic bnfo + else extraLibs bnfo + , ghcOptLinkLibPath = + toNubListR $ + if withFullyStaticExe lbi + then cleanedExtraLibDirsStatic + else cleanedExtraLibDirs + , ghcOptLinkFrameworks = + toNubListR $ + PD.frameworks bnfo + , ghcOptLinkFrameworkDirs = + toNubListR $ + PD.extraFrameworkDirs bnfo + , ghcOptInputFiles = + toNubListR + [tmpDir x | x <- cLikeObjs ++ cxxObjs ++ jsObjs ++ cmmObjs ++ asmObjs] + } + dynLinkerOpts = + mempty + { ghcOptRPaths = rpaths + , ghcOptInputFiles = + toNubListR + [tmpDir x | x <- cLikeObjs ++ cxxObjs ++ cmmObjs ++ asmObjs] + } + replOpts = + baseOpts + { ghcOptExtra = + Internal.filterGhciFlags + (ghcOptExtra baseOpts) + <> replOptionsFlags replFlags + , ghcOptInputModules = replNoLoad replFlags (ghcOptInputModules baseOpts) + , ghcOptInputFiles = replNoLoad replFlags (ghcOptInputFiles baseOpts) + } + -- For a normal compile we do separate invocations of ghc for + -- compiling as for linking. But for repl we have to do just + -- the one invocation, so that one has to include all the + -- linker stuff too, like -l flags and any .o files from C + -- files etc. + `mappend` linkerOpts + `mappend` mempty + { ghcOptMode = toFlag GhcModeInteractive + , ghcOptOptimisation = toFlag GhcNoOptimisation + } + commonOpts + | needProfiling = profOpts + | needDynamic = dynOpts + | otherwise = staticOpts + compileOpts + | useDynToo = dynTooOpts + | otherwise = commonOpts + withStaticExe = not needProfiling && not needDynamic + + -- For building exe's that use TH with -prof or -dynamic we actually have + -- to build twice, once without -prof/-dynamic and then again with + -- -prof/-dynamic. This is because the code that TH needs to run at + -- compile time needs to be the vanilla ABI so it can be loaded up and run + -- by the compiler. + -- With dynamic-by-default GHC the TH object files loaded at compile-time + -- need to be .dyn_o instead of .o. + doingTH = usesTemplateHaskellOrQQ bnfo + -- Should we use -dynamic-too instead of compiling twice? + useDynToo = + dynamicTooSupported + && isGhcDynamic + && doingTH + && withStaticExe + && null (hcSharedOptions GHC bnfo) + compileTHOpts + | isGhcDynamic = dynOpts + | otherwise = staticOpts + compileForTH + | gbuildIsRepl bm = False + | useDynToo = False + | isGhcDynamic = doingTH && (needProfiling || withStaticExe) + | otherwise = doingTH && (needProfiling || needDynamic) + + -- Build static/dynamic object files for TH, if needed. + when compileForTH $ + runGhcProg + compileTHOpts + { ghcOptNoLink = toFlag True + , ghcOptNumJobs = numJobs + } + + -- Do not try to build anything if there are no input files. + -- This can happen if the cabal file ends up with only cSrcs + -- but no Haskell modules. + unless + ( (null inputFiles && null inputModules) + || gbuildIsRepl bm + ) + $ runGhcProg + compileOpts + { ghcOptNoLink = toFlag True + , ghcOptNumJobs = numJobs + } + + let + buildExtraSources mkSrcOpts wantDyn = traverse_ $ buildExtraSource mkSrcOpts wantDyn + buildExtraSource mkSrcOpts wantDyn filename = do + let baseSrcOpts = + mkSrcOpts + verbosity + implInfo + lbi + bnfo + clbi + tmpDir + filename + vanillaSrcOpts = + if isGhcDynamic && wantDyn + then -- Dynamic GHC requires C/C++ sources to be built + -- with -fPIC for REPL to work. See #2207. + baseSrcOpts{ghcOptFPic = toFlag True} + else baseSrcOpts + profSrcOpts = + vanillaSrcOpts + `mappend` mempty + { ghcOptProfilingMode = toFlag True + } + sharedSrcOpts = + vanillaSrcOpts + `mappend` mempty + { ghcOptFPic = toFlag True + , ghcOptDynLinkMode = toFlag GhcDynamicOnly + } + opts + | needProfiling = profSrcOpts + | needDynamic && wantDyn = sharedSrcOpts + | otherwise = vanillaSrcOpts + -- TODO: Placing all Haskell, C, & C++ objects in a single directory + -- Has the potential for file collisions. In general we would + -- consider this a user error. However, we should strive to + -- add a warning if this occurs. + odir = fromFlag (ghcOptObjDir opts) + + createDirectoryIfMissingVerbose verbosity True odir + needsRecomp <- checkNeedsRecompilation filename opts + when needsRecomp $ + runGhcProg opts + + -- build any C++ sources + unless (null cxxSrcs) $ do + info verbosity "Building C++ Sources..." + buildExtraSources Internal.componentCxxGhcOptions True cxxSrcs + + -- build any C sources + unless (null cSrcs) $ do + info verbosity "Building C Sources..." + buildExtraSources Internal.componentCcGhcOptions True cSrcs + + -- build any JS sources + unless (not hasJsSupport || null jsSrcs) $ do + info verbosity "Building JS Sources..." + buildExtraSources Internal.componentJsGhcOptions False jsSrcs + + -- build any ASM sources + unless (null asmSrcs) $ do + info verbosity "Building Assembler Sources..." + buildExtraSources Internal.componentAsmGhcOptions True asmSrcs + + -- build any Cmm sources + unless (null cmmSrcs) $ do + info verbosity "Building C-- Sources..." + buildExtraSources Internal.componentCmmGhcOptions True cmmSrcs + + -- TODO: problem here is we need the .c files built first, so we can load them + -- with ghci, but .c files can depend on .h files generated by ghc by ffi + -- exports. + case bm of + GReplExe _ _ -> runReplOrWriteFlags verbosity ghcProg comp platform replFlags replOpts bnfo clbi (pkgName (PD.package pkg_descr)) + GReplFLib _ _ -> runReplOrWriteFlags verbosity ghcProg comp platform replFlags replOpts bnfo clbi (pkgName (PD.package pkg_descr)) + GBuildExe _ -> do + let linkOpts = + commonOpts + `mappend` linkerOpts + `mappend` mempty + { ghcOptLinkNoHsMain = toFlag (null inputFiles) + } + `mappend` (if withDynExe lbi then dynLinkerOpts else mempty) + + info verbosity "Linking..." + -- Work around old GHCs not relinking in this + -- situation, see #3294 + let target = targetDir targetName + when (compilerVersion comp < mkVersion [7, 7]) $ do + e <- doesFileExist target + when e (removeFile target) + runGhcProg linkOpts{ghcOptOutputFile = toFlag target} + GBuildFLib flib -> do + let + -- Instruct GHC to link against libHSrts. + rtsLinkOpts :: GhcOptions + rtsLinkOpts + | supportsFLinkRts = + mempty + { ghcOptLinkRts = toFlag True + } + | otherwise = + mempty + { ghcOptLinkLibs = rtsOptLinkLibs + , ghcOptLinkLibPath = toNubListR $ rtsLibPaths rtsInfo + } + where + threaded = hasThreaded (gbuildInfo bm) + supportsFLinkRts = compilerVersion comp >= mkVersion [9, 0] + rtsInfo = extractRtsInfo lbi + rtsOptLinkLibs = + [ if needDynamic + then + if threaded + then dynRtsThreadedLib (rtsDynamicInfo rtsInfo) + else dynRtsVanillaLib (rtsDynamicInfo rtsInfo) + else + if threaded + then statRtsThreadedLib (rtsStaticInfo rtsInfo) + else statRtsVanillaLib (rtsStaticInfo rtsInfo) + ] + + linkOpts :: GhcOptions + linkOpts = case foreignLibType flib of + ForeignLibNativeShared -> + commonOpts + `mappend` linkerOpts + `mappend` dynLinkerOpts + `mappend` rtsLinkOpts + `mappend` mempty + { ghcOptLinkNoHsMain = toFlag True + , ghcOptShared = toFlag True + , ghcOptFPic = toFlag True + , ghcOptLinkModDefFiles = toNubListR $ gbuildModDefFiles bm + } + ForeignLibNativeStatic -> + -- this should be caught by buildFLib + -- (and if we do implement this, we probably don't even want to call + -- ghc here, but rather Ar.createArLibArchive or something) + cabalBug "static libraries not yet implemented" + ForeignLibTypeUnknown -> + cabalBug "unknown foreign lib type" + -- We build under a (potentially) different filename to set a + -- soname on supported platforms. See also the note for + -- @flibBuildName@. + info verbosity "Linking..." + let buildName = flibBuildName lbi flib + runGhcProg linkOpts{ghcOptOutputFile = toFlag (targetDir buildName)} + renameFile (targetDir buildName) (targetDir targetName) diff --git a/Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs b/Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs new file mode 100644 index 00000000000..9786470a990 --- /dev/null +++ b/Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs @@ -0,0 +1,549 @@ +module Distribution.Simple.GHC.BuildOrRepl (buildOrReplLib) where + +import Distribution.Compat.Prelude +import Prelude () + +import Control.Monad (forM_) +import qualified Distribution.ModuleName as ModuleName +import Distribution.Package +import Distribution.PackageDescription as PD +import Distribution.Pretty +import Distribution.Simple.BuildPaths +import Distribution.Simple.Compiler +import Distribution.Simple.Flag (Flag (..), fromFlag, toFlag) +import Distribution.Simple.GHC.Build + ( checkNeedsRecompilation + , componentGhcOptions + , getRPaths + , isDynamic + , replNoLoad + , runReplOrWriteFlags + , supportsDynamicToo + ) +import Distribution.Simple.GHC.ImplInfo +import qualified Distribution.Simple.GHC.Internal as Internal +import qualified Distribution.Simple.Hpc as Hpc +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.Program +import qualified Distribution.Simple.Program.Ar as Ar +import Distribution.Simple.Program.GHC +import qualified Distribution.Simple.Program.Ld as Ld +import Distribution.Simple.Setup.Config +import Distribution.Simple.Setup.Repl +import Distribution.Simple.Utils +import Distribution.System +import Distribution.Types.ComponentLocalBuildInfo +import Distribution.Types.ParStrat +import Distribution.Utils.NubList +import Distribution.Verbosity +import Distribution.Version +import System.Directory + ( doesDirectoryExist + , makeRelativeToCurrentDirectory + ) +import System.FilePath + ( replaceExtension + , () + ) + +buildOrReplLib + :: Maybe ReplOptions + -> Verbosity + -> Flag ParStrat + -> PackageDescription + -> LocalBuildInfo + -> Library + -> ComponentLocalBuildInfo + -> IO () +buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do + let uid = componentUnitId clbi + libTargetDir = componentBuildDir lbi clbi + whenVanillaLib forceVanilla = + when (forceVanilla || withVanillaLib lbi) + whenProfLib = when (withProfLib lbi) + whenSharedLib forceShared = + when (forceShared || withSharedLib lbi) + whenStaticLib forceStatic = + when (forceStatic || withStaticLib lbi) + whenGHCiLib = when (withGHCiLib lbi) + forRepl = maybe False (const True) mReplFlags + whenReplLib = forM_ mReplFlags + replFlags = fromMaybe mempty mReplFlags + comp = compiler lbi + ghcVersion = compilerVersion comp + implInfo = getImplInfo comp + platform@(Platform hostArch hostOS) = hostPlatform lbi + hasJsSupport = hostArch == JavaScript + has_code = not (componentIsIndefinite clbi) + + relLibTargetDir <- makeRelativeToCurrentDirectory libTargetDir + + (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) + let runGhcProg = runGHC verbosity ghcProg comp platform + + let libBi = libBuildInfo lib + + -- ensure extra lib dirs exist before passing to ghc + cleanedExtraLibDirs <- filterM doesDirectoryExist (extraLibDirs libBi) + cleanedExtraLibDirsStatic <- filterM doesDirectoryExist (extraLibDirsStatic libBi) + + let isGhcDynamic = isDynamic comp + dynamicTooSupported = supportsDynamicToo comp + doingTH = usesTemplateHaskellOrQQ libBi + forceVanillaLib = doingTH && not isGhcDynamic + forceSharedLib = doingTH && isGhcDynamic + -- TH always needs default libs, even when building for profiling + + -- Determine if program coverage should be enabled and if so, what + -- '-hpcdir' should be. + let isCoverageEnabled = libCoverage lbi + -- TODO: Historically HPC files have been put into a directory which + -- has the package name. I'm going to avoid changing this for + -- now, but it would probably be better for this to be the + -- component ID instead... + pkg_name = prettyShow (PD.package pkg_descr) + distPref = fromFlag $ configDistPref $ configFlags lbi + hpcdir way + | forRepl = mempty -- HPC is not supported in ghci + | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name + | otherwise = mempty + + createDirectoryIfMissingVerbose verbosity True libTargetDir + -- TODO: do we need to put hs-boot files into place for mutually recursive + -- modules? + let cLikeSources = + fromNubListR $ + mconcat + [ toNubListR (cSources libBi) + , toNubListR (cxxSources libBi) + , toNubListR (cmmSources libBi) + , toNubListR (asmSources libBi) + , if hasJsSupport + then -- JS files are C-like with GHC's JS backend: they are + -- "compiled" into `.o` files (renamed with a header). + -- This is a difference from GHCJS, for which we only + -- pass the JS files at link time. + toNubListR (jsSources libBi) + else mempty + ] + cLikeObjs = map (`replaceExtension` objExtension) cLikeSources + baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir + vanillaOpts = + baseOpts + `mappend` mempty + { ghcOptMode = toFlag GhcModeMake + , ghcOptNumJobs = numJobs + , ghcOptInputModules = toNubListR $ allLibModules lib clbi + , ghcOptHPCDir = hpcdir Hpc.Vanilla + } + + profOpts = + vanillaOpts + `mappend` mempty + { ghcOptProfilingMode = toFlag True + , ghcOptProfilingAuto = + Internal.profDetailLevelFlag + True + (withProfLibDetail lbi) + , ghcOptHiSuffix = toFlag "p_hi" + , ghcOptObjSuffix = toFlag "p_o" + , ghcOptExtra = hcProfOptions GHC libBi + , ghcOptHPCDir = hpcdir Hpc.Prof + } + + sharedOpts = + vanillaOpts + `mappend` mempty + { ghcOptDynLinkMode = toFlag GhcDynamicOnly + , ghcOptFPic = toFlag True + , ghcOptHiSuffix = toFlag "dyn_hi" + , ghcOptObjSuffix = toFlag "dyn_o" + , ghcOptExtra = hcSharedOptions GHC libBi + , ghcOptHPCDir = hpcdir Hpc.Dyn + } + linkerOpts = + mempty + { ghcOptLinkOptions = + PD.ldOptions libBi + ++ [ "-static" + | withFullyStaticExe lbi + ] + -- Pass extra `ld-options` given + -- through to GHC's linker. + ++ maybe + [] + programOverrideArgs + (lookupProgram ldProgram (withPrograms lbi)) + , ghcOptLinkLibs = + if withFullyStaticExe lbi + then extraLibsStatic libBi + else extraLibs libBi + , ghcOptLinkLibPath = + toNubListR $ + if withFullyStaticExe lbi + then cleanedExtraLibDirsStatic + else cleanedExtraLibDirs + , ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi + , ghcOptLinkFrameworkDirs = + toNubListR $ + PD.extraFrameworkDirs libBi + , ghcOptInputFiles = + toNubListR + [relLibTargetDir x | x <- cLikeObjs] + } + replOpts = + vanillaOpts + { ghcOptExtra = + Internal.filterGhciFlags + (ghcOptExtra vanillaOpts) + <> replOptionsFlags replFlags + , ghcOptNumJobs = mempty + , ghcOptInputModules = replNoLoad replFlags (ghcOptInputModules vanillaOpts) + } + `mappend` linkerOpts + `mappend` mempty + { ghcOptMode = isInteractive + , ghcOptOptimisation = toFlag GhcNoOptimisation + } + + isInteractive = toFlag GhcModeInteractive + + vanillaSharedOpts = + vanillaOpts + `mappend` mempty + { ghcOptDynLinkMode = toFlag GhcStaticAndDynamic + , ghcOptDynHiSuffix = toFlag "dyn_hi" + , ghcOptDynObjSuffix = toFlag "dyn_o" + , ghcOptHPCDir = hpcdir Hpc.Dyn + } + + unless (forRepl || null (allLibModules lib clbi)) $ + do + let vanilla = whenVanillaLib forceVanillaLib (runGhcProg vanillaOpts) + shared = whenSharedLib forceSharedLib (runGhcProg sharedOpts) + useDynToo = + dynamicTooSupported + && (forceVanillaLib || withVanillaLib lbi) + && (forceSharedLib || withSharedLib lbi) + && null (hcSharedOptions GHC libBi) + if not has_code + then vanilla + else + if useDynToo + then do + runGhcProg vanillaSharedOpts + case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of + (Flag dynDir, Flag vanillaDir) -> + -- When the vanilla and shared library builds are done + -- in one pass, only one set of HPC module interfaces + -- are generated. This set should suffice for both + -- static and dynamically linked executables. We copy + -- the modules interfaces so they are available under + -- both ways. + copyDirectoryRecursive verbosity dynDir vanillaDir + _ -> return () + else + if isGhcDynamic + then do shared; vanilla + else do vanilla; shared + whenProfLib (runGhcProg profOpts) + + let + buildExtraSources mkSrcOpts wantDyn = traverse_ $ buildExtraSource mkSrcOpts wantDyn + buildExtraSource mkSrcOpts wantDyn filename = do + let baseSrcOpts = + mkSrcOpts + verbosity + implInfo + lbi + libBi + clbi + relLibTargetDir + filename + vanillaSrcOpts + -- Dynamic GHC requires C sources to be built + -- with -fPIC for REPL to work. See #2207. + | isGhcDynamic && wantDyn = baseSrcOpts{ghcOptFPic = toFlag True} + | otherwise = baseSrcOpts + runGhcProgIfNeeded opts = do + needsRecomp <- checkNeedsRecompilation filename opts + when needsRecomp $ runGhcProg opts + profSrcOpts = + vanillaSrcOpts + `mappend` mempty + { ghcOptProfilingMode = toFlag True + , ghcOptObjSuffix = toFlag "p_o" + } + sharedSrcOpts = + vanillaSrcOpts + `mappend` mempty + { ghcOptFPic = toFlag True + , ghcOptDynLinkMode = toFlag GhcDynamicOnly + , ghcOptObjSuffix = toFlag "dyn_o" + } + odir = fromFlag (ghcOptObjDir vanillaSrcOpts) + + createDirectoryIfMissingVerbose verbosity True odir + runGhcProgIfNeeded vanillaSrcOpts + unless (forRepl || not wantDyn) $ + whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedSrcOpts) + unless forRepl $ + whenProfLib (runGhcProgIfNeeded profSrcOpts) + + -- Build any C++ sources separately. + unless (not has_code || null (cxxSources libBi)) $ do + info verbosity "Building C++ Sources..." + buildExtraSources Internal.componentCxxGhcOptions True (cxxSources libBi) + + -- build any C sources + unless (not has_code || null (cSources libBi)) $ do + info verbosity "Building C Sources..." + buildExtraSources Internal.componentCcGhcOptions True (cSources libBi) + + -- build any JS sources + unless (not has_code || not hasJsSupport || null (jsSources libBi)) $ do + info verbosity "Building JS Sources..." + buildExtraSources Internal.componentJsGhcOptions False (jsSources libBi) + + -- build any ASM sources + unless (not has_code || null (asmSources libBi)) $ do + info verbosity "Building Assembler Sources..." + buildExtraSources Internal.componentAsmGhcOptions True (asmSources libBi) + + -- build any Cmm sources + unless (not has_code || null (cmmSources libBi)) $ do + info verbosity "Building C-- Sources..." + buildExtraSources Internal.componentCmmGhcOptions True (cmmSources libBi) + + -- TODO: problem here is we need the .c files built first, so we can load them + -- with ghci, but .c files can depend on .h files generated by ghc by ffi + -- exports. + whenReplLib $ \rflags -> do + when (null (allLibModules lib clbi)) $ warn verbosity "No exposed modules" + runReplOrWriteFlags verbosity ghcProg comp platform rflags replOpts libBi clbi (pkgName (PD.package pkg_descr)) + + -- link: + when has_code . unless forRepl $ do + info verbosity "Linking..." + let cLikeProfObjs = + map + (`replaceExtension` ("p_" ++ objExtension)) + cLikeSources + cLikeSharedObjs = + map + (`replaceExtension` ("dyn_" ++ objExtension)) + cLikeSources + compiler_id = compilerId (compiler lbi) + vanillaLibFilePath = relLibTargetDir mkLibName uid + profileLibFilePath = relLibTargetDir mkProfLibName uid + sharedLibFilePath = + relLibTargetDir + mkSharedLibName (hostPlatform lbi) compiler_id uid + staticLibFilePath = + relLibTargetDir + mkStaticLibName (hostPlatform lbi) compiler_id uid + ghciLibFilePath = relLibTargetDir Internal.mkGHCiLibName uid + ghciProfLibFilePath = relLibTargetDir Internal.mkGHCiProfLibName uid + libInstallPath = + libdir $ + absoluteComponentInstallDirs + pkg_descr + lbi + uid + NoCopyDest + sharedLibInstallPath = + libInstallPath + mkSharedLibName (hostPlatform lbi) compiler_id uid + + stubObjs <- + catMaybes + <$> sequenceA + [ findFileWithExtension + [objExtension] + [libTargetDir] + (ModuleName.toFilePath x ++ "_stub") + | ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files + , x <- allLibModules lib clbi + ] + stubProfObjs <- + catMaybes + <$> sequenceA + [ findFileWithExtension + ["p_" ++ objExtension] + [libTargetDir] + (ModuleName.toFilePath x ++ "_stub") + | ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files + , x <- allLibModules lib clbi + ] + stubSharedObjs <- + catMaybes + <$> sequenceA + [ findFileWithExtension + ["dyn_" ++ objExtension] + [libTargetDir] + (ModuleName.toFilePath x ++ "_stub") + | ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files + , x <- allLibModules lib clbi + ] + + hObjs <- + Internal.getHaskellObjects + implInfo + lib + lbi + clbi + relLibTargetDir + objExtension + True + hProfObjs <- + if withProfLib lbi + then + Internal.getHaskellObjects + implInfo + lib + lbi + clbi + relLibTargetDir + ("p_" ++ objExtension) + True + else return [] + hSharedObjs <- + if withSharedLib lbi + then + Internal.getHaskellObjects + implInfo + lib + lbi + clbi + relLibTargetDir + ("dyn_" ++ objExtension) + False + else return [] + + unless (null hObjs && null cLikeObjs && null stubObjs) $ do + rpaths <- getRPaths lbi clbi + + let staticObjectFiles = + hObjs + ++ map (relLibTargetDir ) cLikeObjs + ++ stubObjs + profObjectFiles = + hProfObjs + ++ map (relLibTargetDir ) cLikeProfObjs + ++ stubProfObjs + dynamicObjectFiles = + hSharedObjs + ++ map (relLibTargetDir ) cLikeSharedObjs + ++ stubSharedObjs + -- After the relocation lib is created we invoke ghc -shared + -- with the dependencies spelled out as -package arguments + -- and ghc invokes the linker with the proper library paths + ghcSharedLinkArgs = + mempty + { ghcOptShared = toFlag True + , ghcOptDynLinkMode = toFlag GhcDynamicOnly + , ghcOptInputFiles = toNubListR dynamicObjectFiles + , ghcOptOutputFile = toFlag sharedLibFilePath + , ghcOptExtra = hcSharedOptions GHC libBi + , -- For dynamic libs, Mac OS/X needs to know the install location + -- at build time. This only applies to GHC < 7.8 - see the + -- discussion in #1660. + ghcOptDylibName = + if hostOS == OSX + && ghcVersion < mkVersion [7, 8] + then toFlag sharedLibInstallPath + else mempty + , ghcOptHideAllPackages = toFlag True + , ghcOptNoAutoLinkPackages = toFlag True + , ghcOptPackageDBs = withPackageDB lbi + , ghcOptThisUnitId = case clbi of + LibComponentLocalBuildInfo{componentCompatPackageKey = pk} -> + toFlag pk + _ -> mempty + , ghcOptThisComponentId = case clbi of + LibComponentLocalBuildInfo + { componentInstantiatedWith = insts + } -> + if null insts + then mempty + else toFlag (componentComponentId clbi) + _ -> mempty + , ghcOptInstantiatedWith = case clbi of + LibComponentLocalBuildInfo + { componentInstantiatedWith = insts + } -> + insts + _ -> [] + , ghcOptPackages = + toNubListR $ + Internal.mkGhcOptPackages mempty clbi + , ghcOptLinkLibs = extraLibs libBi + , ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs + , ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi + , ghcOptLinkFrameworkDirs = + toNubListR $ PD.extraFrameworkDirs libBi + , ghcOptRPaths = rpaths + } + ghcStaticLinkArgs = + mempty + { ghcOptStaticLib = toFlag True + , ghcOptInputFiles = toNubListR staticObjectFiles + , ghcOptOutputFile = toFlag staticLibFilePath + , ghcOptExtra = hcStaticOptions GHC libBi + , ghcOptHideAllPackages = toFlag True + , ghcOptNoAutoLinkPackages = toFlag True + , ghcOptPackageDBs = withPackageDB lbi + , ghcOptThisUnitId = case clbi of + LibComponentLocalBuildInfo{componentCompatPackageKey = pk} -> + toFlag pk + _ -> mempty + , ghcOptThisComponentId = case clbi of + LibComponentLocalBuildInfo + { componentInstantiatedWith = insts + } -> + if null insts + then mempty + else toFlag (componentComponentId clbi) + _ -> mempty + , ghcOptInstantiatedWith = case clbi of + LibComponentLocalBuildInfo + { componentInstantiatedWith = insts + } -> + insts + _ -> [] + , ghcOptPackages = + toNubListR $ + Internal.mkGhcOptPackages mempty clbi + , ghcOptLinkLibs = extraLibs libBi + , ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs + } + + info verbosity (show (ghcOptPackages ghcSharedLinkArgs)) + + whenVanillaLib False $ do + Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles + whenGHCiLib $ do + (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi) + Ld.combineObjectFiles + verbosity + lbi + ldProg + ghciLibFilePath + staticObjectFiles + + whenProfLib $ do + Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles + whenGHCiLib $ do + (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi) + Ld.combineObjectFiles + verbosity + lbi + ldProg + ghciProfLibFilePath + profObjectFiles + + whenSharedLib False $ + runGhcProg ghcSharedLinkArgs + + whenStaticLib False $ + runGhcProg ghcStaticLinkArgs From 2d5002f2cfaeb76bc7a66210d3aaf1836877264d Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 6 Nov 2023 09:44:20 -0500 Subject: [PATCH 58/70] CPP mingw32_HOST_OS for more imports --- Cabal/src/Distribution/Simple/GHC.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index 89f64974242..92378380325 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -96,7 +96,6 @@ import Distribution.Simple.Flag (Flag (..), toFlag) import Distribution.Simple.GHC.Build ( componentGhcOptions , exeTargetName - , flibBuildName , flibTargetName , isDynamic ) @@ -128,7 +127,6 @@ import System.Directory , doesFileExist , getAppUserDataDirectory , getDirectoryContents - , renameFile ) import System.FilePath ( takeDirectory @@ -137,6 +135,8 @@ import System.FilePath ) import qualified System.Info #ifndef mingw32_HOST_OS +import Distribution.Simple.GHC.Build (flibBuildName) +import System.Directory (renameFile) import System.Posix (createSymbolicLink) #endif /* mingw32_HOST_OS */ From 4416f86d17f0e0558e60684eb3bf701468c2ee71 Mon Sep 17 00:00:00 2001 From: Jens Petersen Date: Fri, 3 Nov 2023 16:30:40 +0800 Subject: [PATCH 59/70] cabal-install-solver: fix pkgconf 1.9 --modversion regression Check that the numbers of *versions* output is equal to the number of pkgconf's fixes #8923 The pkgconf behavior was reverted upstream in 2.0 (this should cover the case too of checking that equal pkgList lines are output also) --- .../src/Distribution/Solver/Types/PkgConfigDb.hs | 7 ++++--- changelog.d/pr-9391 | 4 ++++ 2 files changed, 8 insertions(+), 3 deletions(-) create mode 100644 changelog.d/pr-9391 diff --git a/cabal-install-solver/src/Distribution/Solver/Types/PkgConfigDb.hs b/cabal-install-solver/src/Distribution/Solver/Types/PkgConfigDb.hs index 00bc38c28c3..ee2f22032ca 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/PkgConfigDb.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/PkgConfigDb.hs @@ -67,11 +67,12 @@ readPkgConfigDb verbosity progdb = handle ioErrorHandler $ do -- The output of @pkg-config --list-all@ also includes a description -- for each package, which we do not need. let pkgNames = map (takeWhile (not . isSpace)) pkgList - (pkgVersions, _errs, exitCode) <- + (outs, _errs, exitCode) <- getProgramInvocationOutputAndErrors verbosity (programInvocation pkgConfig ("--modversion" : pkgNames)) - if exitCode == ExitSuccess && length pkgNames == length pkgList - then (return . pkgConfigDbFromList . zip pkgNames) (lines pkgVersions) + let pkgVersions = lines outs + if exitCode == ExitSuccess && length pkgVersions == length pkgNames + then (return . pkgConfigDbFromList . zip pkgNames) pkgVersions else -- if there's a single broken pc file the above fails, so we fall back -- into calling it individually diff --git a/changelog.d/pr-9391 b/changelog.d/pr-9391 new file mode 100644 index 00000000000..517c94ed127 --- /dev/null +++ b/changelog.d/pr-9391 @@ -0,0 +1,4 @@ +synopsis: fix pkgconfig-depends for pkgconf-1.9 +packages: cabal-install-solver +prs: #9391 +issues: #8923 From ce064fb46b84ad4fbcd28c4a3aed9711423170b2 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Fri, 3 Nov 2023 14:56:34 +0000 Subject: [PATCH 60/70] External commands: Add tests for #9402 #9403 #9404 This adds 4 tests which test the new external commands feature: * ExternalCommand - Tests the expected usage of external command invoked via cabal-install * ExternalCommandSetup - Tests that the ./Setup interface does not support external commands (#9403) * ExternalCommandEnv - Tests that environment variables are set and preserved appropiately (#9402) * ExternalCommandHelp - Test that `cabal help ` is interpreted appropiately (#9404) --- .../PackageTests/ExternalCommand/cabal.out | 8 ++++ .../ExternalCommand/cabal.project | 1 + .../ExternalCommand/cabal.test.hs | 37 ++++++++++++++++++ .../ExternalCommand/setup-test/AAAA.hs | 4 ++ .../ExternalCommand/setup-test/CHANGELOG.md | 5 +++ .../ExternalCommand/setup-test/LICENSE | 30 ++++++++++++++ .../setup-test/setup-test.cabal | 25 ++++++++++++ .../PackageTests/ExternalCommandEnv/cabal.out | 8 ++++ .../ExternalCommandEnv/cabal.project | 1 + .../ExternalCommandEnv/cabal.test.hs | 39 +++++++++++++++++++ .../ExternalCommandEnv/setup-test/AAAA.hs | 11 ++++++ .../setup-test/CHANGELOG.md | 5 +++ .../ExternalCommandEnv/setup-test/LICENSE | 30 ++++++++++++++ .../setup-test/setup-test.cabal | 25 ++++++++++++ .../ExternalCommandHelp/cabal.out | 12 ++++++ .../ExternalCommandHelp/cabal.project | 1 + .../ExternalCommandHelp/cabal.test.hs | 37 ++++++++++++++++++ .../ExternalCommandHelp/setup-test/AAAA.hs | 9 +++++ .../setup-test/CHANGELOG.md | 5 +++ .../ExternalCommandHelp/setup-test/LICENSE | 30 ++++++++++++++ .../setup-test/setup-test.cabal | 25 ++++++++++++ .../ExternalCommandSetup/aaaa/LICENSE | 0 .../ExternalCommandSetup/aaaa/Main.hs | 3 ++ .../ExternalCommandSetup/aaaa/aaaa.cabal | 22 +++++++++++ .../ExternalCommandSetup/custom/CHANGELOG.md | 5 +++ .../ExternalCommandSetup/custom/LICENSE | 30 ++++++++++++++ .../ExternalCommandSetup/custom/Setup.hs | 3 ++ .../ExternalCommandSetup/custom/custom.cabal | 29 ++++++++++++++ .../ExternalCommandSetup/setup.cabal.hs | 17 ++++++++ .../ExternalCommandSetup/setup.out | 22 +++++++++++ cabal-testsuite/src/Test/Cabal/Prelude.hs | 12 ++++-- 31 files changed, 488 insertions(+), 3 deletions(-) create mode 100644 cabal-testsuite/PackageTests/ExternalCommand/cabal.out create mode 100644 cabal-testsuite/PackageTests/ExternalCommand/cabal.project create mode 100644 cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommand/setup-test/CHANGELOG.md create mode 100644 cabal-testsuite/PackageTests/ExternalCommand/setup-test/LICENSE create mode 100644 cabal-testsuite/PackageTests/ExternalCommand/setup-test/setup-test.cabal create mode 100644 cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.out create mode 100644 cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.project create mode 100644 cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/AAAA.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/CHANGELOG.md create mode 100644 cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/LICENSE create mode 100644 cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/setup-test.cabal create mode 100644 cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out create mode 100644 cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.project create mode 100644 cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/CHANGELOG.md create mode 100644 cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/LICENSE create mode 100644 cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/setup-test.cabal create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/LICENSE create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/Main.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/aaaa.cabal create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/custom/CHANGELOG.md create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/custom/LICENSE create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/custom/Setup.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/custom/custom.cabal create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out diff --git a/cabal-testsuite/PackageTests/ExternalCommand/cabal.out b/cabal-testsuite/PackageTests/ExternalCommand/cabal.out new file mode 100644 index 00000000000..1c4c24db55c --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommand/cabal.out @@ -0,0 +1,8 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - setup-test-0.1.0.0 (exe:cabal-aaaa) (first run) +Configuring executable 'cabal-aaaa' for setup-test-0.1.0.0... +Preprocessing executable 'cabal-aaaa' for setup-test-0.1.0.0... +Building executable 'cabal-aaaa' for setup-test-0.1.0.0... diff --git a/cabal-testsuite/PackageTests/ExternalCommand/cabal.project b/cabal-testsuite/PackageTests/ExternalCommand/cabal.project new file mode 100644 index 00000000000..1a33bb5a25e --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommand/cabal.project @@ -0,0 +1 @@ +packages: setup-test/ diff --git a/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs new file mode 100644 index 00000000000..850c8bfbcec --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs @@ -0,0 +1,37 @@ +import Test.Cabal.Prelude +import qualified System.Process as Process +import Control.Concurrent (threadDelay) +import System.Directory (removeFile) +import Control.Exception (catch, throwIO) +import System.IO.Error (isDoesNotExistError) +import qualified Data.Time.Clock as Time +import qualified Data.Time.Format as Time +import Data.Maybe +import System.Environment + +main = do + cabalTest $ do + res <- cabalWithStdin "v2-build" ["all"] "" + exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa" + env <- getTestEnv + path <- liftIO $ getEnv "PATH" + let newpath = takeDirectory exe_path ++ ":" ++ path + let new_env = (("PATH", Just newpath) : (testEnvironment env)) + withEnv new_env $ do + res <- cabal_raw_action ["aaaa"] (\h -> () <$ Process.waitForProcess h) + assertOutputContains "aaaa" res + + +cabal_raw_action :: [String] -> (Process.ProcessHandle -> IO ()) -> TestM Result +cabal_raw_action args action = do + configured_prog <- requireProgramM cabalProgram + env <- getTestEnv + r <- liftIO $ runAction (testVerbosity env) + (Just (testCurrentDir env)) + (testEnvironment env) + (programPath configured_prog) + args + Nothing + action + recordLog r + requireSuccess r diff --git a/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs new file mode 100644 index 00000000000..5bee0ebbef1 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs @@ -0,0 +1,4 @@ +module Main where + +main = do + putStrLn "aaaa" diff --git a/cabal-testsuite/PackageTests/ExternalCommand/setup-test/CHANGELOG.md b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/CHANGELOG.md new file mode 100644 index 00000000000..7ae8ff6113d --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for setup-test + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ExternalCommand/setup-test/LICENSE b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/LICENSE new file mode 100644 index 00000000000..cd8ad2ac8ae --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2023, Matthew Pickering + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Matthew Pickering nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-testsuite/PackageTests/ExternalCommand/setup-test/setup-test.cabal b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/setup-test.cabal new file mode 100644 index 00000000000..8deb0577a16 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/setup-test.cabal @@ -0,0 +1,25 @@ +cabal-version: 3.0 +name: setup-test +version: 0.1.0.0 +-- synopsis: +-- description: +license: BSD-3-Clause +license-file: LICENSE +author: Matthew Pickering +maintainer: matthewtpickering@gmail.com +-- copyright: +build-type: Simple +extra-doc-files: CHANGELOG.md +-- extra-source-files: + +common warnings + ghc-options: -Wall + +executable cabal-aaaa + import: warnings + main-is: AAAA.hs + -- other-modules: + -- other-extensions: + build-depends: base + hs-source-dirs: . + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.out b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.out new file mode 100644 index 00000000000..1c4c24db55c --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.out @@ -0,0 +1,8 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - setup-test-0.1.0.0 (exe:cabal-aaaa) (first run) +Configuring executable 'cabal-aaaa' for setup-test-0.1.0.0... +Preprocessing executable 'cabal-aaaa' for setup-test-0.1.0.0... +Building executable 'cabal-aaaa' for setup-test-0.1.0.0... diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.project b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.project new file mode 100644 index 00000000000..1a33bb5a25e --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.project @@ -0,0 +1 @@ +packages: setup-test/ diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs new file mode 100644 index 00000000000..891c9e43d4b --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs @@ -0,0 +1,39 @@ +import Test.Cabal.Prelude +import qualified System.Process as Process +import Control.Concurrent (threadDelay) +import System.Directory (removeFile) +import Control.Exception (catch, throwIO) +import System.IO.Error (isDoesNotExistError) +import qualified Data.Time.Clock as Time +import qualified Data.Time.Format as Time +import Data.Maybe +import System.Environment + +main = do + cabalTest $ expectBroken 9402 $ do + res <- cabalWithStdin "v2-build" ["all"] "" + exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa" + env <- getTestEnv + path <- liftIO $ getEnv "PATH" + let newpath = takeDirectory exe_path ++ ":" ++ path + let new_env = (("OTHER_VAR", Just "is set") : ("PATH", Just newpath) : (testEnvironment env)) + + withEnv new_env $ do + res <- cabal_raw_action ["aaaa"] (\h -> () <$ Process.waitForProcess h) + assertOutputContains "cabal-install" res + assertOutputContains "is set" res + + +cabal_raw_action :: [String] -> (Process.ProcessHandle -> IO ()) -> TestM Result +cabal_raw_action args action = do + configured_prog <- requireProgramM cabalProgram + env <- getTestEnv + r <- liftIO $ runAction (testVerbosity env) + (Just (testCurrentDir env)) + (testEnvironment env) + (programPath configured_prog) + args + Nothing + action + recordLog r + requireSuccess r diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/AAAA.hs b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/AAAA.hs new file mode 100644 index 00000000000..99af61e9c03 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/AAAA.hs @@ -0,0 +1,11 @@ +module Main where + +import System.Environment +import System.Process + +main = do + cabal_proc <- getEnv "CABAL" + other_var <- getEnv "OTHER_VAR" + putStrLn ("OTHER_VAR is set to: " ++ other_var) + callProcess cabal_proc ["--version"] + diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/CHANGELOG.md b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/CHANGELOG.md new file mode 100644 index 00000000000..7ae8ff6113d --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for setup-test + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/LICENSE b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/LICENSE new file mode 100644 index 00000000000..cd8ad2ac8ae --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2023, Matthew Pickering + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Matthew Pickering nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/setup-test.cabal b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/setup-test.cabal new file mode 100644 index 00000000000..a5feea69112 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/setup-test.cabal @@ -0,0 +1,25 @@ +cabal-version: 3.0 +name: setup-test +version: 0.1.0.0 +-- synopsis: +-- description: +license: BSD-3-Clause +license-file: LICENSE +author: Matthew Pickering +maintainer: matthewtpickering@gmail.com +-- copyright: +build-type: Simple +extra-doc-files: CHANGELOG.md +-- extra-source-files: + +common warnings + ghc-options: -Wall + +executable cabal-aaaa + import: warnings + main-is: AAAA.hs + -- other-modules: + -- other-extensions: + build-depends: base, process + hs-source-dirs: . + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out new file mode 100644 index 00000000000..0a3edf696f9 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out @@ -0,0 +1,12 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - setup-test-0.1.0.0 (exe:cabal-aaaa) (first run) + - setup-test-0.1.0.0 (exe:setup) (first run) +Configuring executable 'cabal-aaaa' for setup-test-0.1.0.0... +Preprocessing executable 'cabal-aaaa' for setup-test-0.1.0.0... +Building executable 'cabal-aaaa' for setup-test-0.1.0.0... +Configuring executable 'setup' for setup-test-0.1.0.0... +Preprocessing executable 'setup' for setup-test-0.1.0.0... +Building executable 'setup' for setup-test-0.1.0.0... diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.project b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.project new file mode 100644 index 00000000000..1a33bb5a25e --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.project @@ -0,0 +1 @@ +packages: setup-test/ diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs new file mode 100644 index 00000000000..a3a8acfa5c7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs @@ -0,0 +1,37 @@ +import Test.Cabal.Prelude +import qualified System.Process as Process +import Control.Concurrent (threadDelay) +import System.Directory (removeFile) +import Control.Exception (catch, throwIO) +import System.IO.Error (isDoesNotExistError) +import qualified Data.Time.Clock as Time +import qualified Data.Time.Format as Time +import Data.Maybe +import System.Environment + +main = do + cabalTest $ expectBroken 9404 $ do + res <- cabalWithStdin "v2-build" ["all"] "" + exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa" + env <- getTestEnv + path <- liftIO $ getEnv "PATH" + let newpath = takeDirectory exe_path ++ ":" ++ path + let new_env = (("PATH", Just newpath) : (testEnvironment env)) + withEnv new_env $ do + res <- cabal_raw_action ["help", "aaaa"] (\h -> () <$ Process.waitForProcess h) + assertOutputContains "I am helping with the aaaa command" res + + +cabal_raw_action :: [String] -> (Process.ProcessHandle -> IO ()) -> TestM Result +cabal_raw_action args action = do + configured_prog <- requireProgramM cabalProgram + env <- getTestEnv + r <- liftIO $ runAction (testVerbosity env) + (Just (testCurrentDir env)) + (testEnvironment env) + (programPath configured_prog) + args + Nothing + action + recordLog r + requireSuccess r diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs new file mode 100644 index 00000000000..10fe05988d8 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs @@ -0,0 +1,9 @@ +module Main where + +import System.Environment + +main = do + args <- getArgs + case args of + ["--help"] -> putStrLn "I am helping with the aaaa command" + _ -> putStrLn "aaaa" diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/CHANGELOG.md b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/CHANGELOG.md new file mode 100644 index 00000000000..7ae8ff6113d --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for setup-test + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/LICENSE b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/LICENSE new file mode 100644 index 00000000000..cd8ad2ac8ae --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2023, Matthew Pickering + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Matthew Pickering nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/setup-test.cabal b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/setup-test.cabal new file mode 100644 index 00000000000..8deb0577a16 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/setup-test.cabal @@ -0,0 +1,25 @@ +cabal-version: 3.0 +name: setup-test +version: 0.1.0.0 +-- synopsis: +-- description: +license: BSD-3-Clause +license-file: LICENSE +author: Matthew Pickering +maintainer: matthewtpickering@gmail.com +-- copyright: +build-type: Simple +extra-doc-files: CHANGELOG.md +-- extra-source-files: + +common warnings + ghc-options: -Wall + +executable cabal-aaaa + import: warnings + main-is: AAAA.hs + -- other-modules: + -- other-extensions: + build-depends: base + hs-source-dirs: . + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/LICENSE b/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/LICENSE new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/Main.hs b/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/Main.hs new file mode 100644 index 00000000000..b3fcf560699 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/Main.hs @@ -0,0 +1,3 @@ +module Main where + +main = putStrLn "aaaa" diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/aaaa.cabal b/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/aaaa.cabal new file mode 100644 index 00000000000..cafeabd5855 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/aaaa.cabal @@ -0,0 +1,22 @@ +cabal-version: 3.0 +name: aaaa +version: 0.1.0.0 +license: BSD-3-Clause +license-file: LICENSE +author: Matthew Pickering +maintainer: matthewtpickering@gmail.com +build-type: Simple +extra-doc-files: CHANGELOG.md +-- extra-source-files: + +common warnings + ghc-options: -Wall + +executable cabal-aaaa + import: warnings + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base + hs-source-dirs: . + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/CHANGELOG.md b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/CHANGELOG.md new file mode 100644 index 00000000000..063fef7c698 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for custom + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/LICENSE b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/LICENSE new file mode 100644 index 00000000000..cd8ad2ac8ae --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2023, Matthew Pickering + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Matthew Pickering nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/Setup.hs b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/Setup.hs new file mode 100644 index 00000000000..e8efd11bddb --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/Setup.hs @@ -0,0 +1,3 @@ +module Main where +import Distribution.Simple +main = defaultMain diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/custom.cabal b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/custom.cabal new file mode 100644 index 00000000000..0dbc609439b --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/custom.cabal @@ -0,0 +1,29 @@ +cabal-version: 3.0 +name: custom +version: 0.1.0.0 +-- synopsis: +-- description: +license: BSD-3-Clause +license-file: LICENSE +author: Matthew Pickering +maintainer: matthewtpickering@gmail.com +-- copyright: +build-type: Custom +extra-doc-files: CHANGELOG.md +-- extra-source-files: + +common warnings + ghc-options: -Wall + +custom-setup + build-depends: base, Cabal + +library + import: warnings + exposed-modules: MyLib + -- other-modules: + -- other-extensions: + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 + diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs new file mode 100644 index 00000000000..7de624d4530 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs @@ -0,0 +1,17 @@ +import Test.Cabal.Prelude +import System.Environment + +main = setupTest $ expectBroken 9403 $ do + withPackageDb $ do + withDirectory "aaaa" $ setup_install [] + r <- runInstalledExe' "cabal-aaaa" [] + env <- getTestEnv + path <- liftIO $ getEnv "PATH" + let exe_path = testPrefixDir env "bin" + let newpath = exe_path ++ ":" ++ path + let new_env = (("PATH", Just newpath) : (testEnvironment env)) + withEnv new_env $ do + res <- withDirectory "custom" $ setup' "aaaa" [] + assertOutputContains "did you mean" res + + diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out new file mode 100644 index 00000000000..e234d5e2a48 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out @@ -0,0 +1,22 @@ +# Setup configure +Configuring aaaa-0.1.0.0... +# Setup build +Preprocessing executable 'aaaa' for aaaa-0.1.0.0... +Building executable 'aaaa' for aaaa-0.1.0.0... +# Setup copy +Installing executable aaaa in +Warning: The directory /setup.dist/usr/bin is not in the system search path. +# Setup register +Package contains no library to register: aaaa-0.1.0.0... +# aaaa +aaaa +# Setup configure +Warning: custom.cabal:19:3: Unknown field: "build-depends" +Configuring custom-0.1.0.0... +# Setup build +Preprocessing library for custom-0.1.0.0... +Building library for custom-0.1.0.0... +# Setup copy +Installing library in +# Setup register +Registering library for custom-0.1.0.0... diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 757a71aefb7..2977a9270cc 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -358,15 +358,21 @@ runPlanExe pkg_name cname args = void $ runPlanExe' pkg_name cname args runPlanExe' :: String {- package name -} -> String {- component name -} -> [String] -> TestM Result runPlanExe' pkg_name cname args = do + exePath <- planExePath pkg_name cname + defaultRecordMode RecordAll $ do + recordHeader [pkg_name, cname] + runM exePath args Nothing + +planExePath :: String {- package name -} -> String {- component name -} + -> TestM FilePath +planExePath pkg_name cname = do Just plan <- testPlan `fmap` getTestEnv let distDirOrBinFile = planDistDir plan (mkPackageName pkg_name) (CExeName (mkUnqualComponentName cname)) exePath = case distDirOrBinFile of DistDir dist_dir -> dist_dir "build" cname cname BinFile bin_file -> bin_file - defaultRecordMode RecordAll $ do - recordHeader [pkg_name, cname] - runM exePath args Nothing + return exePath ------------------------------------------------------------------------ -- * Running ghc-pkg From 245e68a7c0c566839bd63f5d220027e8456adc84 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Mon, 6 Nov 2023 11:01:34 +0000 Subject: [PATCH 61/70] Finish off the external commands feature * Remove 'CommandDelegate' in favour of abstracting the fallback in 'commandsRun', there is a new variant 'commdandRunWithFallback' which takes a continuation - This restores the modularity between the `Cabal` library and `cabal-install` as now `Cabal` doesn't need to know anything about the external command interface. - Fixes #9403 * Set the $CABAL environment variable to the current executable path - This allows external commands to be implemented by calling $CABAL, which is strongly preferred to linking against the Cabal library as there is no easy way to guantee your tool and `cabal-install` link against the same `Cabal` library. - Fixes #9402 * Pass the name of the argument - This allows external commands to be implemented as symlinks to an executable, and multiple commands can be interpreted by the same executable. - Fixes #9405 * `cabal help ` is interpreted as `cabal- --help` for external commands. - This allows the `help` command to also work for external commands and hence they are better integrated into cabal-install. - Fixes #9404 The tests are updated to test all these additions. These features bring the external command interface up to par with the cargo external command interface. --- Cabal/src/Distribution/Make.hs | 2 - Cabal/src/Distribution/Simple.hs | 2 - Cabal/src/Distribution/Simple/Command.hs | 102 +++++++++--------- cabal-install/src/Distribution/Client/Main.hs | 33 +++++- .../src/Distribution/Client/SavedFlags.hs | 1 - .../ExternalCommand/cabal.test.hs | 20 +++- .../ExternalCommand/setup-test/AAAA.hs | 5 +- .../ExternalCommandEnv/cabal.test.hs | 9 +- .../ExternalCommandHelp/cabal.out | 4 - .../ExternalCommandHelp/cabal.test.hs | 8 +- .../ExternalCommandHelp/setup-test/AAAA.hs | 2 +- .../ExternalCommandSetup/setup.cabal.hs | 11 +- .../ExternalCommandSetup/setup.out | 19 +--- cabal-testsuite/src/Test/Cabal/Prelude.hs | 16 ++- doc/external-commands.rst | 18 +++- 15 files changed, 144 insertions(+), 108 deletions(-) diff --git a/Cabal/src/Distribution/Make.hs b/Cabal/src/Distribution/Make.hs index aaa63a94bdb..82334d550f0 100644 --- a/Cabal/src/Distribution/Make.hs +++ b/Cabal/src/Distribution/Make.hs @@ -91,7 +91,6 @@ defaultMainHelper :: [String] -> IO () defaultMainHelper args = do command <- commandsRun (globalCommand commands) commands args case command of - CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs @@ -100,7 +99,6 @@ defaultMainHelper args = do _ | fromFlag (globalVersion flags) -> printVersion | fromFlag (globalNumericVersion flags) -> printNumericVersion - CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs diff --git a/Cabal/src/Distribution/Simple.hs b/Cabal/src/Distribution/Simple.hs index 0649a085260..c52a02c0f96 100644 --- a/Cabal/src/Distribution/Simple.hs +++ b/Cabal/src/Distribution/Simple.hs @@ -170,7 +170,6 @@ defaultMainHelper hooks args = topHandler $ do args' <- expandResponse args command <- commandsRun (globalCommand commands) commands args' case command of - CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs @@ -179,7 +178,6 @@ defaultMainHelper hooks args = topHandler $ do _ | fromFlag (globalVersion flags) -> printVersion | fromFlag (globalNumericVersion flags) -> printNumericVersion - CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs diff --git a/Cabal/src/Distribution/Simple/Command.hs b/Cabal/src/Distribution/Simple/Command.hs index dc2be1a698b..2da6486cba6 100644 --- a/Cabal/src/Distribution/Simple/Command.hs +++ b/Cabal/src/Distribution/Simple/Command.hs @@ -47,6 +47,8 @@ module Distribution.Simple.Command -- ** Running commands , commandsRun + , commandsRunWithFallback + , defaultCommandFallback -- * Option Fields , OptionField (..) @@ -85,15 +87,12 @@ module Distribution.Simple.Command import Distribution.Compat.Prelude hiding (get) import Prelude () -import Control.Exception (try) import qualified Data.Array as Array import qualified Data.List as List import Distribution.Compat.Lens (ALens', (#~), (^#)) import qualified Distribution.GetOpt as GetOpt import Distribution.ReadE import Distribution.Simple.Utils -import System.Directory (findExecutable) -import System.Process (callProcess) data CommandUI flags = CommandUI { commandName :: String @@ -599,13 +598,11 @@ data CommandParse flags | CommandList [String] | CommandErrors [String] | CommandReadyToGo flags - | CommandDelegate instance Functor CommandParse where fmap _ (CommandHelp help) = CommandHelp help fmap _ (CommandList opts) = CommandList opts fmap _ (CommandErrors errs) = CommandErrors errs fmap f (CommandReadyToGo flags) = CommandReadyToGo (f flags) - fmap _ CommandDelegate = CommandDelegate data CommandType = NormalCommand | HiddenCommand data Command action @@ -632,27 +629,62 @@ commandAddAction command action = let flags = mkflags (commandDefaultFlags command) in action flags args +-- Print suggested command if edit distance is < 5 +badCommand :: [Command action] -> String -> CommandParse a +badCommand commands' cname = + case eDists of + [] -> CommandErrors [unErr] + (s : _) -> + CommandErrors + [ unErr + , "Maybe you meant `" ++ s ++ "`?\n" + ] + where + eDists = + map fst . List.sortBy (comparing snd) $ + [ (cname', dist) + | -- Note that this is not commandNames, so close suggestions will show + -- hidden commands + (Command cname' _ _ _) <- commands' + , let dist = editDistance cname' cname + , dist < 5 + ] + unErr = "unrecognised command: " ++ cname ++ " (try --help)" + commandsRun :: CommandUI a -> [Command action] -> [String] -> IO (CommandParse (a, CommandParse action)) commandsRun globalCommand commands args = + commandsRunWithFallback globalCommand commands defaultCommandFallback args + +defaultCommandFallback + :: [Command action] + -> String + -> [String] + -> IO (CommandParse action) +defaultCommandFallback commands' name _cmdArgs = pure $ badCommand commands' name + +commandsRunWithFallback + :: CommandUI a + -> [Command action] + -> ([Command action] -> String -> [String] -> IO (CommandParse action)) + -> [String] + -> IO (CommandParse (a, CommandParse action)) +commandsRunWithFallback globalCommand commands defaultCommand args = case commandParseArgs globalCommand True args of - CommandDelegate -> pure CommandDelegate CommandHelp help -> pure $ CommandHelp help CommandList opts -> pure $ CommandList (opts ++ commandNames) CommandErrors errs -> pure $ CommandErrors errs CommandReadyToGo (mkflags, args') -> case args' of - ("help" : cmdArgs) -> pure $ handleHelpCommand cmdArgs + ("help" : cmdArgs) -> handleHelpCommand flags cmdArgs (name : cmdArgs) -> case lookupCommand name of [Command _ _ action _] -> pure $ CommandReadyToGo (flags, action cmdArgs) _ -> do - mCommand <- findExecutable $ "cabal-" <> name - case mCommand of - Just exec -> callExternal flags exec cmdArgs - Nothing -> pure $ CommandReadyToGo (flags, badCommand name) + final_cmd <- defaultCommand commands' name cmdArgs + return $ CommandReadyToGo (flags, final_cmd) [] -> pure $ CommandReadyToGo (flags, noCommand) where flags = mkflags (commandDefaultFlags globalCommand) @@ -661,55 +693,29 @@ commandsRun globalCommand commands args = [ cmd | cmd@(Command cname' _ _ _) <- commands', cname' == cname ] - callExternal :: a -> String -> [String] -> IO (CommandParse (a, CommandParse action)) - callExternal flags exec cmdArgs = do - result <- try $ callProcess exec cmdArgs - case result of - Left ex -> pure $ CommandErrors ["Error executing external command: " ++ show (ex :: SomeException)] - Right _ -> pure $ CommandReadyToGo (flags, CommandDelegate) - noCommand = CommandErrors ["no command given (try --help)\n"] - -- Print suggested command if edit distance is < 5 - badCommand :: String -> CommandParse a - badCommand cname = - case eDists of - [] -> CommandErrors [unErr] - (s : _) -> - CommandErrors - [ unErr - , "Maybe you meant `" ++ s ++ "`?\n" - ] - where - eDists = - map fst . List.sortBy (comparing snd) $ - [ (cname', dist) - | (Command cname' _ _ _) <- commands' - , let dist = editDistance cname' cname - , dist < 5 - ] - unErr = "unrecognised command: " ++ cname ++ " (try --help)" - commands' = commands ++ [commandAddAction helpCommandUI undefined] commandNames = [name | (Command name _ _ NormalCommand) <- commands'] -- A bit of a hack: support "prog help" as a synonym of "prog --help" -- furthermore, support "prog help command" as "prog command --help" - handleHelpCommand cmdArgs = + handleHelpCommand flags cmdArgs = case commandParseArgs helpCommandUI True cmdArgs of - CommandDelegate -> CommandDelegate - CommandHelp help -> CommandHelp help - CommandList list -> CommandList (list ++ commandNames) - CommandErrors _ -> CommandHelp globalHelp - CommandReadyToGo (_, []) -> CommandHelp globalHelp + CommandHelp help -> pure $ CommandHelp help + CommandList list -> pure $ CommandList (list ++ commandNames) + CommandErrors _ -> pure $ CommandHelp globalHelp + CommandReadyToGo (_, []) -> pure $ CommandHelp globalHelp CommandReadyToGo (_, (name : cmdArgs')) -> case lookupCommand name of [Command _ _ action _] -> case action ("--help" : cmdArgs') of - CommandHelp help -> CommandHelp help - CommandList _ -> CommandList [] - _ -> CommandHelp globalHelp - _ -> badCommand name + CommandHelp help -> pure $ CommandHelp help + CommandList _ -> pure $ CommandList [] + _ -> pure $ CommandHelp globalHelp + _ -> do + fall_back <- defaultCommand commands' name ("--help" : cmdArgs') + return $ CommandReadyToGo (flags, fall_back) where globalHelp = commandHelp globalCommand diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 9114102f2bf..dc196a66864 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -205,7 +205,8 @@ import Distribution.Simple.Command , commandAddAction , commandFromSpec , commandShowOptions - , commandsRun + , commandsRunWithFallback + , defaultCommandFallback , hiddenCommand ) import Distribution.Simple.Compiler (PackageDBStack) @@ -221,6 +222,8 @@ import Distribution.Simple.PackageDescription (readGenericPackageDescription) import Distribution.Simple.Program ( configureAllKnownPrograms , defaultProgramDb + , defaultProgramSearchPath + , findProgramOnSearchPath , getProgramInvocationOutput , simpleProgramInvocation ) @@ -261,7 +264,7 @@ import System.Directory , getCurrentDirectory , withCurrentDirectory ) -import System.Environment (getProgName) +import System.Environment (getEnvironment, getExecutablePath, getProgName) import System.FilePath ( dropExtension , splitExtension @@ -276,6 +279,7 @@ import System.IO , stderr , stdout ) +import System.Process (createProcess, env, proc) -- | Entry point -- @@ -334,9 +338,8 @@ warnIfAssertionsAreEnabled = mainWorker :: [String] -> IO () mainWorker args = do topHandler $ do - command <- commandsRun (globalCommand commands) commands args + command <- commandsRunWithFallback (globalCommand commands) commands delegateToExternal args case command of - CommandDelegate -> pure () CommandHelp help -> printGlobalHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs @@ -347,7 +350,6 @@ mainWorker args = do printVersion | fromFlagOrDefault False (globalNumericVersion globalFlags) -> printNumericVersion - CommandDelegate -> pure () CommandHelp help -> printCommandHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> do @@ -366,6 +368,27 @@ mainWorker args = do warnIfAssertionsAreEnabled action globalFlags where + delegateToExternal + :: [Command Action] + -> String + -> [String] + -> IO (CommandParse Action) + delegateToExternal commands' name cmdArgs = do + mCommand <- findProgramOnSearchPath normal defaultProgramSearchPath ("cabal-" <> name) + case mCommand of + Just (exec, _) -> return (CommandReadyToGo $ \_ -> callExternal exec name cmdArgs) + Nothing -> defaultCommandFallback commands' name cmdArgs + + callExternal :: String -> String -> [String] -> IO () + callExternal exec name cmdArgs = do + cur_env <- getEnvironment + cabal_exe <- getExecutablePath + let new_env = ("CABAL", cabal_exe) : cur_env + result <- try $ createProcess ((proc exec (name : cmdArgs)){env = Just new_env}) + case result of + Left ex -> printErrors ["Error executing external command: " ++ show (ex :: SomeException)] + Right _ -> return () + printCommandHelp help = do pname <- getProgName putStr (help pname) diff --git a/cabal-install/src/Distribution/Client/SavedFlags.hs b/cabal-install/src/Distribution/Client/SavedFlags.hs index 5fa417a8578..1a598a58fd7 100644 --- a/cabal-install/src/Distribution/Client/SavedFlags.hs +++ b/cabal-install/src/Distribution/Client/SavedFlags.hs @@ -51,7 +51,6 @@ readCommandFlags :: FilePath -> CommandUI flags -> IO flags readCommandFlags path command = do savedArgs <- fmap (fromMaybe []) (readSavedArgs path) case (commandParseArgs command True savedArgs) of - CommandDelegate -> error "CommandDelegate Flags evaluated, this should never occur" CommandHelp _ -> throwIO (SavedArgsErrorHelp savedArgs) CommandList _ -> throwIO (SavedArgsErrorList savedArgs) CommandErrors errs -> throwIO (SavedArgsErrorOther savedArgs errs) diff --git a/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs index 850c8bfbcec..d9535b60507 100644 --- a/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs @@ -8,19 +8,29 @@ import qualified Data.Time.Clock as Time import qualified Data.Time.Format as Time import Data.Maybe import System.Environment +import System.FilePath main = do cabalTest $ do res <- cabalWithStdin "v2-build" ["all"] "" exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa" - env <- getTestEnv - path <- liftIO $ getEnv "PATH" - let newpath = takeDirectory exe_path ++ ":" ++ path - let new_env = (("PATH", Just newpath) : (testEnvironment env)) - withEnv new_env $ do + addToPath (takeDirectory exe_path) $ do + -- Test that the thing works at all res <- cabal_raw_action ["aaaa"] (\h -> () <$ Process.waitForProcess h) assertOutputContains "aaaa" res + -- Test that the extra arguments are passed on + res <- cabal_raw_action ["aaaa", "--foobaz"] (\h -> () <$ Process.waitForProcess h) + assertOutputContains "--foobaz" res + + -- Test what happens with "global" flags + res <- cabal_raw_action ["aaaa", "--version"] (\h -> () <$ Process.waitForProcess h) + assertOutputContains "--version" res + + -- Test what happens with "global" flags + res <- cabal_raw_action ["aaaa", "--config-file", "abc"] (\h -> () <$ Process.waitForProcess h) + assertOutputContains "--config-file" res + cabal_raw_action :: [String] -> (Process.ProcessHandle -> IO ()) -> TestM Result cabal_raw_action args action = do diff --git a/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs index 5bee0ebbef1..c2d121c9a39 100644 --- a/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs +++ b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs @@ -1,4 +1,5 @@ module Main where -main = do - putStrLn "aaaa" +import System.Environment + +main = getArgs >>= print diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs index 891c9e43d4b..4344076398a 100644 --- a/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs @@ -10,15 +10,12 @@ import Data.Maybe import System.Environment main = do - cabalTest $ expectBroken 9402 $ do + cabalTest $ do res <- cabalWithStdin "v2-build" ["all"] "" exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa" env <- getTestEnv - path <- liftIO $ getEnv "PATH" - let newpath = takeDirectory exe_path ++ ":" ++ path - let new_env = (("OTHER_VAR", Just "is set") : ("PATH", Just newpath) : (testEnvironment env)) - - withEnv new_env $ do + let new_env = (("OTHER_VAR", Just "is set") : (testEnvironment env)) + withEnv new_env $ addToPath (takeDirectory exe_path) $ do res <- cabal_raw_action ["aaaa"] (\h -> () <$ Process.waitForProcess h) assertOutputContains "cabal-install" res assertOutputContains "is set" res diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out index 0a3edf696f9..1c4c24db55c 100644 --- a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out @@ -3,10 +3,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - setup-test-0.1.0.0 (exe:cabal-aaaa) (first run) - - setup-test-0.1.0.0 (exe:setup) (first run) Configuring executable 'cabal-aaaa' for setup-test-0.1.0.0... Preprocessing executable 'cabal-aaaa' for setup-test-0.1.0.0... Building executable 'cabal-aaaa' for setup-test-0.1.0.0... -Configuring executable 'setup' for setup-test-0.1.0.0... -Preprocessing executable 'setup' for setup-test-0.1.0.0... -Building executable 'setup' for setup-test-0.1.0.0... diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs index a3a8acfa5c7..96e69bbbd6e 100644 --- a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs @@ -10,14 +10,10 @@ import Data.Maybe import System.Environment main = do - cabalTest $ expectBroken 9404 $ do + cabalTest $ do res <- cabalWithStdin "v2-build" ["all"] "" exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa" - env <- getTestEnv - path <- liftIO $ getEnv "PATH" - let newpath = takeDirectory exe_path ++ ":" ++ path - let new_env = (("PATH", Just newpath) : (testEnvironment env)) - withEnv new_env $ do + addToPath (takeDirectory exe_path) $ do res <- cabal_raw_action ["help", "aaaa"] (\h -> () <$ Process.waitForProcess h) assertOutputContains "I am helping with the aaaa command" res diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs index 10fe05988d8..dd139b905da 100644 --- a/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs @@ -5,5 +5,5 @@ import System.Environment main = do args <- getArgs case args of - ["--help"] -> putStrLn "I am helping with the aaaa command" + ["aaaa" , "--help"] -> putStrLn "I am helping with the aaaa command" _ -> putStrLn "aaaa" diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs index 7de624d4530..d6bea04003f 100644 --- a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs @@ -1,17 +1,14 @@ import Test.Cabal.Prelude import System.Environment -main = setupTest $ expectBroken 9403 $ do +main = setupTest $ do withPackageDb $ do withDirectory "aaaa" $ setup_install [] r <- runInstalledExe' "cabal-aaaa" [] env <- getTestEnv - path <- liftIO $ getEnv "PATH" let exe_path = testPrefixDir env "bin" - let newpath = exe_path ++ ":" ++ path - let new_env = (("PATH", Just newpath) : (testEnvironment env)) - withEnv new_env $ do - res <- withDirectory "custom" $ setup' "aaaa" [] - assertOutputContains "did you mean" res + addToPath exe_path $ do + res <- fails $ withDirectory "custom" $ setup' "aaaa" [] + assertOutputContains "unrecognised command" res diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out index e234d5e2a48..6600ad3ca2f 100644 --- a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out @@ -1,22 +1,13 @@ # Setup configure Configuring aaaa-0.1.0.0... # Setup build -Preprocessing executable 'aaaa' for aaaa-0.1.0.0... -Building executable 'aaaa' for aaaa-0.1.0.0... +Preprocessing executable 'cabal-aaaa' for aaaa-0.1.0.0... +Building executable 'cabal-aaaa' for aaaa-0.1.0.0... # Setup copy -Installing executable aaaa in +Installing executable cabal-aaaa in Warning: The directory /setup.dist/usr/bin is not in the system search path. # Setup register Package contains no library to register: aaaa-0.1.0.0... -# aaaa +# cabal-aaaa aaaa -# Setup configure -Warning: custom.cabal:19:3: Unknown field: "build-depends" -Configuring custom-0.1.0.0... -# Setup build -Preprocessing library for custom-0.1.0.0... -Building library for custom-0.1.0.0... -# Setup copy -Installing library in -# Setup register -Registering library for custom-0.1.0.0... +# Setup aaaa diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 2977a9270cc..c95a55988f8 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -60,16 +60,16 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe (mapMaybe, fromMaybe) import System.Exit (ExitCode (..)) -import System.FilePath ((), takeExtensions, takeDrive, takeDirectory, normalise, splitPath, joinPath, splitFileName, (<.>), dropTrailingPathSeparator) +import System.FilePath import Control.Concurrent (threadDelay) import qualified Data.Char as Char -import System.Directory (canonicalizePath, copyFile, copyFile, doesDirectoryExist, doesFileExist, createDirectoryIfMissing, getDirectoryContents, listDirectory) +import System.Directory import Control.Retry (exponentialBackoff, limitRetriesByCumulativeDelay) import Network.Wait (waitTcpVerbose) +import System.Environment #ifndef mingw32_HOST_OS import Control.Monad.Catch ( bracket_ ) -import System.Directory ( removeFile ) import System.Posix.Files ( createSymbolicLink ) import System.Posix.Resource #endif @@ -113,6 +113,16 @@ withDirectory f = withReaderT withEnv :: [(String, Maybe String)] -> TestM a -> TestM a withEnv e = withReaderT (\env -> env { testEnvironment = testEnvironment env ++ e }) +-- | Prepend a directory to the PATH +addToPath :: FilePath -> TestM a -> TestM a +addToPath exe_dir action = do + env <- getTestEnv + path <- liftIO $ getEnv "PATH" + let newpath = exe_dir ++ [searchPathSeparator] ++ path + let new_env = (("PATH", Just newpath) : (testEnvironment env)) + withEnv new_env action + + -- HACK please don't use me withEnvFilter :: (String -> Bool) -> TestM a -> TestM a withEnvFilter p = withReaderT (\env -> env { testEnvironment = filter (p . fst) (testEnvironment env) }) diff --git a/doc/external-commands.rst b/doc/external-commands.rst index 047d8f4dca0..e72495aa160 100644 --- a/doc/external-commands.rst +++ b/doc/external-commands.rst @@ -1,8 +1,22 @@ External Commands ================= -Cabal provides a system for external commands, akin to the ones used by tools like ``git`` or ``cargo``. +``cabal-install`` provides a system for external commands, akin to the ones used by tools like ``git`` or ``cargo``. -If you execute ``cabal my-custom-command``, Cabal will search the path for an executable named ``cabal-my-custom-command`` and execute it, passing any remaining arguments to this external command. An error will be thrown in case the custom command is not found. +If you execute ``cabal ``, ``cabal-install`` will search the path for an executable named ``cabal-`` and execute it. The name of the command is passed as the first argument and +the remaining arguments are passed afterwards. An error will be thrown in case the custom command is not found. + +The ``$CABAL`` environment variable is set to the path of the ``cabal-install`` executable +which invoked the subcommand. + +It is strongly recommended that you implement your custom commands by calling the +CLI via the ``$CABAL`` variable rather than linking against the ``Cabal`` library. +There is no guarantee that the subcommand will link against the same version of the +``Cabal`` library as ``cabal-install`` so it would lead to unexpected results and +incompatibilities. + +``cabal-install`` can also display the help message of the external command. +When ``cabal help `` is invoked, then ``cabal- --help`` will be called so +your external command can display a help message. For ideas or existing external commands, visit `this Discourse thread `_. From 2e2ac78fbc51277c7abbd06a2472da7dd4ee8e47 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Sat, 18 Nov 2023 20:39:35 +0100 Subject: [PATCH 62/70] Use Base16 hash for script path. Issue #9334 shows that `%` characters on Windows result in invalid paths, also `/` characters on Linux create invalid paths. This changes from using base64 to using base16 with the same length we use for unit-ids. --- cabal-install/cabal-install.cabal | 1 - cabal-install/src/Distribution/Client/HashValue.hs | 5 ----- .../src/Distribution/Client/ScriptUtils.hs | 14 ++++++-------- cabal-testsuite/cabal-testsuite.cabal | 3 ++- cabal-testsuite/src/Test/Cabal/Prelude.hs | 5 ++--- changelog.d/base16-script-cache | 9 +++++++++ 6 files changed, 19 insertions(+), 18 deletions(-) create mode 100644 changelog.d/base16-script-cache diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 0a5e55bc3f1..aee621a99f8 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -209,7 +209,6 @@ library async >= 2.0 && < 2.3, array >= 0.4 && < 0.6, base16-bytestring >= 0.1.1 && < 1.1.0.0, - base64-bytestring >= 1.0 && < 1.3, binary >= 0.7.3 && < 0.9, bytestring >= 0.10.6.0 && < 0.13, containers >= 0.5.6.2 && < 0.8, diff --git a/cabal-install/src/Distribution/Client/HashValue.hs b/cabal-install/src/Distribution/Client/HashValue.hs index c245750bb9f..e19956b7ed3 100644 --- a/cabal-install/src/Distribution/Client/HashValue.hs +++ b/cabal-install/src/Distribution/Client/HashValue.hs @@ -7,7 +7,6 @@ module Distribution.Client.HashValue , hashValue , truncateHash , showHashValue - , showHashValueBase64 , readFileHashValue , hashFromTUF ) where @@ -19,7 +18,6 @@ import qualified Hackage.Security.Client as Sec import qualified Crypto.Hash.SHA256 as SHA256 import qualified Data.ByteString.Base16 as Base16 -import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS @@ -57,9 +55,6 @@ hashValue = HashValue . SHA256.hashlazy showHashValue :: HashValue -> String showHashValue (HashValue digest) = BS.unpack (Base16.encode digest) -showHashValueBase64 :: HashValue -> String -showHashValueBase64 (HashValue digest) = BS.unpack (Base64.encode digest) - -- | Hash the content of a file. Uses SHA256. readFileHashValue :: FilePath -> IO HashValue readFileHashValue tarball = diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index eacf9cd5afe..e66117414a8 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -37,7 +37,8 @@ import Distribution.Client.DistDirLayout ) import Distribution.Client.HashValue ( hashValue - , showHashValueBase64 + , showHashValue + , truncateHash ) import Distribution.Client.HttpUtils ( HttpTransport @@ -218,18 +219,15 @@ import qualified Text.Parsec as P -- repl to deal with the fact that the repl is relative to the working directory and not -- the project root. --- | Get the hash of a script's absolute path) +-- | Get the hash of a script's absolute path. -- -- Two hashes will be the same as long as the absolute paths -- are the same. getScriptHash :: FilePath -> IO String getScriptHash script = - -- Base64 is shorter than Base16, which helps avoid long path issues on windows - -- but it can contain /'s which aren't valid in file paths so replace them with - -- %'s. 26 chars / 130 bits is enough to practically avoid collisions. - map (\c -> if c == '/' then '%' else c) - . take 26 - . showHashValueBase64 + -- Truncation here tries to help with long path issues on Windows. + showHashValue + . truncateHash 26 . hashValue . fromString <$> canonicalizePath script diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index 55aa7921b52..2fbac27d893 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -60,7 +60,7 @@ library , aeson ^>= 1.4.2.0 || ^>=1.5.0.0 || ^>= 2.0.0.0 || ^>= 2.1.0.0 || ^>= 2.2.1.0 , async ^>= 2.2.1 , attoparsec ^>= 0.13.2.2 || ^>=0.14.1 - , base64-bytestring ^>= 1.0.0.0 || ^>= 1.1.0.0 || ^>= 1.2.0.0 + , base16-bytestring ^>= 0.1.1.5 || ^>= 1.0 , bytestring ^>= 0.10.0.2 || ^>= 0.11.0.0 || ^>= 0.12.0.0 , containers ^>= 0.5.0.0 || ^>= 0.6.0.1 , cryptohash-sha256 ^>= 0.11.101.0 @@ -120,6 +120,7 @@ executable setup -- If you require an external dependency for a test it must be listed here. executable test-runtime-deps + default-language: Haskell2010 build-depends: cabal-testsuite, base, directory, diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index c95a55988f8..f8df47ec874 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -53,7 +53,7 @@ import Control.Monad (unless, when, void, forM_, liftM2, liftM4) import Control.Monad.Trans.Reader (withReaderT, runReaderT) import Control.Monad.IO.Class (MonadIO (..)) import qualified Crypto.Hash.SHA256 as SHA256 -import qualified Data.ByteString.Base64 as Base64 +import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as C import Data.List (isInfixOf, stripPrefix, isPrefixOf, intercalate) import Data.List.NonEmpty (NonEmpty (..)) @@ -856,8 +856,7 @@ getScriptCacheDirectory :: FilePath -> TestM FilePath getScriptCacheDirectory script = do cabalDir <- testCabalDir `fmap` getTestEnv hashinput <- liftIO $ canonicalizePath script - let hash = map (\c -> if c == '/' then '%' else c) . take 26 - . C.unpack . Base64.encode . SHA256.hash . C.pack $ hashinput + let hash = C.unpack . Base16.encode . C.take 26 . SHA256.hash . C.pack $ hashinput return $ cabalDir "script-builds" hash ------------------------------------------------------------------------ diff --git a/changelog.d/base16-script-cache b/changelog.d/base16-script-cache new file mode 100644 index 00000000000..b395f946a09 --- /dev/null +++ b/changelog.d/base16-script-cache @@ -0,0 +1,9 @@ +synopsis: Script cache dir is the base16 hash of the canonical path of the script. +prs: #9459 +packages: cabal-install + +description: { + +Script cache dir is the base16 hash of the canonical path of the script. + +} From ac463a03e49e288526bd873b9e0e5a36aea52183 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Wed, 22 Nov 2023 12:58:16 +0800 Subject: [PATCH 63/70] Migrate to haskell-actions/setup As of 2023-09-09, haskell/action/setup is no longer maintained. The comment # latest is mandatory for cabal-testsuite, see https://github.com/haskell/cabal/issues/8133 is removed; as the validate job was already fixing a version of cabal-install. --- .github/workflows/validate.yml | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/.github/workflows/validate.yml b/.github/workflows/validate.yml index 78652b10af7..4dbc94def32 100644 --- a/.github/workflows/validate.yml +++ b/.github/workflows/validate.yml @@ -79,7 +79,7 @@ jobs: key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }} restore-keys: ${{ runner.os }}-${{ matrix.ghc }}- - - uses: haskell/actions/setup@v2 + - uses: haskell-actions/setup@v2 id: setup-haskell with: ghc-version: ${{ matrix.ghc }} @@ -219,11 +219,12 @@ jobs: apt-get update apt-get install -y ghc-${{ matrix.extra-ghc }}-dyn - - uses: haskell/actions/setup@v2 + - uses: haskell-actions/setup@v2 id: setup-haskell with: ghc-version: ${{ matrix.ghc }} - cabal-version: latest # latest is mandatory for cabal-testsuite, see https://github.com/haskell/cabal/issues/8133 + # Make sure this bindist works in this old environment + cabal-version: 3.10.1.0 # As we are reusing the cached build dir from the previous step # the generated artifacts are available here, @@ -272,7 +273,7 @@ jobs: sudo chown -R $USER /usr/local/.ghcup sudo chmod -R 777 /usr/local/.ghcup fi - - uses: haskell/actions/setup@v2 + - uses: haskell-actions/setup@v2 id: setup-haskell with: ghc-version: ${{ matrix.ghc }} From a4f0349ee2de03a256fba9f5b3b79f023c245724 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Thu, 16 Nov 2023 11:17:09 +0000 Subject: [PATCH 64/70] testsuite: Introduce Cabal-tests library for common testsuite functions I noticed that Distribution.Utils.TempTestDir was only used in the testsuite but defined in the Cabal library. Rather than expose this in the public interface of the `Cabal` library, it is cleaner to refactor it into a separate library (`Cabal-tests`) which can be used by any testsuite component. Also, in future it gives a clearer place to put utility functions which need to be shared across the testsuite but not exposed in Cabal. Cabal-tests can also freely add dependencies (such as exceptions) which we might want to avoid adding to the Cabal library. Fixes #9453 --- Cabal-tests/Cabal-tests.cabal | 7 +++++++ .../lib/Test}/Utils/TempTestDir.hs | 2 +- Cabal/Cabal.cabal | 1 - cabal-install/cabal-install.cabal | 2 ++ .../UnitTests/Distribution/Client/FetchUtils.hs | 2 +- .../tests/UnitTests/Distribution/Client/Get.hs | 2 +- .../tests/UnitTests/Distribution/Client/VCS.hs | 2 +- cabal-testsuite/cabal-testsuite.cabal | 1 + cabal-testsuite/src/Test/Cabal/Monad.hs | 2 +- cabal-testsuite/src/Test/Cabal/Prelude.hs | 2 +- changelog.d/issue-9453 | 12 ++++++++++++ 11 files changed, 28 insertions(+), 7 deletions(-) rename {Cabal/src/Distribution => Cabal-tests/lib/Test}/Utils/TempTestDir.hs (98%) create mode 100644 changelog.d/issue-9453 diff --git a/Cabal-tests/Cabal-tests.cabal b/Cabal-tests/Cabal-tests.cabal index f6a8c2c1481..c2e3047da04 100644 --- a/Cabal-tests/Cabal-tests.cabal +++ b/Cabal-tests/Cabal-tests.cabal @@ -18,6 +18,12 @@ source-repository head location: https://github.com/haskell/cabal/ subdir: Cabal-tests +-- Common utilities which can be used by all tests. +library + hs-source-dirs: lib + exposed-modules: Test.Utils.TempTestDir + build-depends: base, directory, Cabal + -- Small, fast running tests. test-suite unit-tests type: exitcode-stdio-1.0 @@ -58,6 +64,7 @@ test-suite unit-tests , Cabal-described , Cabal-syntax , Cabal-QuickCheck + , Cabal-tests , containers , deepseq , Diff >=0.4 && <0.6 diff --git a/Cabal/src/Distribution/Utils/TempTestDir.hs b/Cabal-tests/lib/Test/Utils/TempTestDir.hs similarity index 98% rename from Cabal/src/Distribution/Utils/TempTestDir.hs rename to Cabal-tests/lib/Test/Utils/TempTestDir.hs index f4a2edf05f1..79e8635889f 100644 --- a/Cabal/src/Distribution/Utils/TempTestDir.hs +++ b/Cabal-tests/lib/Test/Utils/TempTestDir.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} -module Distribution.Utils.TempTestDir +module Test.Utils.TempTestDir ( withTestDir , removeDirectoryRecursiveHack ) where diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index f4750e48e79..49426b34169 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -153,7 +153,6 @@ library Distribution.Utils.Json Distribution.Utils.NubList Distribution.Utils.Progress - Distribution.Utils.TempTestDir Distribution.Verbosity Distribution.Verbosity.Internal diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index aee621a99f8..fe4985e5a29 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -324,6 +324,7 @@ test-suite unit-tests cabal-install, Cabal-tree-diff, Cabal-QuickCheck, + Cabal-tests, containers, directory, filepath, @@ -409,6 +410,7 @@ test-suite long-tests build-depends: Cabal-QuickCheck, Cabal-described, + Cabal-tests, cabal-install, containers, directory, diff --git a/cabal-install/tests/UnitTests/Distribution/Client/FetchUtils.hs b/cabal-install/tests/UnitTests/Distribution/Client/FetchUtils.hs index 4131f01a70c..c14682c2bcb 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/FetchUtils.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/FetchUtils.hs @@ -16,12 +16,12 @@ import Distribution.Client.Types.Repo (Repo (..), emptyRemoteRepo) import Distribution.Client.Types.RepoName (RepoName (..)) import Distribution.Types.PackageId (PackageIdentifier (..)) import Distribution.Types.PackageName (mkPackageName) -import Distribution.Utils.TempTestDir (withTestDir) import qualified Distribution.Verbosity as Verbosity import Distribution.Version (mkVersion) import Network.URI (URI, uriPath) import Test.Tasty import Test.Tasty.HUnit +import Test.Utils.TempTestDir (withTestDir) tests :: [TestTree] tests = diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Get.hs b/cabal-install/tests/UnitTests/Distribution/Client/Get.hs index fadca21d0cb..55ce4180f8f 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Get.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Get.hs @@ -20,9 +20,9 @@ import System.Exit import System.FilePath import System.IO.Error -import Distribution.Utils.TempTestDir (withTestDir) import Test.Tasty import Test.Tasty.HUnit +import Test.Utils.TempTestDir (withTestDir) import UnitTests.Options (RunNetworkTests (..)) tests :: [TestTree] diff --git a/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs b/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs index f75441e12c9..64c517c10e9 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs @@ -16,8 +16,8 @@ import Distribution.Client.Types.SourceRepo (SourceRepoProxy, SourceRepositoryPa import Distribution.Client.VCS import Distribution.Simple.Program import Distribution.System (OS (Windows), buildOS) -import Distribution.Utils.TempTestDir (removeDirectoryRecursiveHack, withTestDir) import Distribution.Verbosity as Verbosity +import Test.Utils.TempTestDir (removeDirectoryRecursiveHack, withTestDir) import Data.List (mapAccumL) import qualified Data.Map as Map diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index 2fbac27d893..680a77e86f2 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -30,6 +30,7 @@ common shared -- this needs to match the in-tree lib:Cabal version , Cabal ^>= 3.11.0.0 , Cabal-syntax ^>= 3.11.0.0 + , Cabal-tests ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns diff --git a/cabal-testsuite/src/Test/Cabal/Monad.hs b/cabal-testsuite/src/Test/Cabal/Monad.hs index 8ed40dc416f..a7d426fc437 100644 --- a/cabal-testsuite/src/Test/Cabal/Monad.hs +++ b/cabal-testsuite/src/Test/Cabal/Monad.hs @@ -72,7 +72,7 @@ import Distribution.Simple.Configure import qualified Distribution.Simple.Utils as U (cabalVersion) import Distribution.Text -import Distribution.Utils.TempTestDir (removeDirectoryRecursiveHack) +import Test.Utils.TempTestDir (removeDirectoryRecursiveHack) import Distribution.Verbosity import Distribution.Version diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index f8df47ec874..e89481f13d3 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -39,7 +39,7 @@ import Distribution.Parsec (eitherParsec) import Distribution.Types.UnqualComponentName import Distribution.Types.LocalBuildInfo import Distribution.PackageDescription -import Distribution.Utils.TempTestDir (withTestDir) +import Test.Utils.TempTestDir (withTestDir) import Distribution.Verbosity (normal) import Distribution.Compat.Stack diff --git a/changelog.d/issue-9453 b/changelog.d/issue-9453 new file mode 100644 index 00000000000..16e7a48fa86 --- /dev/null +++ b/changelog.d/issue-9453 @@ -0,0 +1,12 @@ +synopsis: Remove Distribution.Utils.TempTestDir module from Cabal library +packages: Cabal +prs: #9454 +issues: #9453 + +description: { + +This library was only used by internal tests, and now lives in the `Cabal-tests` library +which is shared across test components. + +} + From 357ae589db02b26a4e76b7b011f3c357554ba3f2 Mon Sep 17 00:00:00 2001 From: Artem Pelenitsyn Date: Sun, 15 Oct 2023 18:27:42 +0000 Subject: [PATCH 65/70] GHC 9.8 compat: pacify -Wx-partial --- cabal-install/src/Distribution/Client/Dependency.hs | 6 ++++-- .../Client/Init/NonInteractive/Command.hs | 12 +++++++++--- .../Client/Init/NonInteractive/Heuristics.hs | 6 +++--- cabal-install/src/Distribution/Client/InstallPlan.hs | 10 +++++----- cabal-install/src/Distribution/Client/Upload.hs | 10 ++++++---- cabal-install/tests/IntegrationTests2.hs | 8 ++++---- .../UnitTests/Distribution/Client/InstallPlan.hs | 3 +-- .../tests/UnitTests/Distribution/Client/Targets.hs | 5 ++++- cabal-testsuite/src/Test/Cabal/Prelude.hs | 2 +- 9 files changed, 37 insertions(+), 25 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs index 544ad59a341..37e0cbdf1ee 100644 --- a/cabal-install/src/Distribution/Client/Dependency.hs +++ b/cabal-install/src/Distribution/Client/Dependency.hs @@ -67,7 +67,6 @@ module Distribution.Client.Dependency ) where import Distribution.Client.Compat.Prelude -import qualified Prelude as Unsafe (head) import Distribution.Client.Dependency.Types ( PackagesPreferenceDefault (..) @@ -950,8 +949,11 @@ planPackagesProblems platform cinfo pkgs = , let packageProblems = configuredPackageProblems platform cinfo pkg , not (null packageProblems) ] - ++ [ DuplicatePackageSolverId (Graph.nodeKey (Unsafe.head dups)) dups + ++ [ DuplicatePackageSolverId (Graph.nodeKey aDup) dups | dups <- duplicatesBy (comparing Graph.nodeKey) pkgs + , aDup <- case dups of + [] -> [] + (ad : _) -> [ad] ] data PackageProblem diff --git a/cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs b/cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs index 8c37cad96f2..7eee9f82f7a 100644 --- a/cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs +++ b/cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs @@ -40,7 +40,7 @@ import Distribution.Client.Init.Types import Distribution.Client.Compat.Prelude hiding (getLine, head, last, putStr, putStrLn) import Prelude () -import Data.List (head, last) +import Data.List (last) import qualified Data.List.NonEmpty as NEL import Distribution.CabalSpecVersion (CabalSpecVersion (..)) @@ -340,12 +340,18 @@ packageTypeHeuristics flags = getPackageType flags $ guessPackageType flags -- to a default value. mainFileHeuristics :: Interactive m => InitFlags -> m HsFilePath mainFileHeuristics flags = do - appDir <- head <$> appDirsHeuristics flags + appDirs <- appDirsHeuristics flags + let appDir = case appDirs of + [] -> error "impossible: appDirsHeuristics returned empty list of dirs" + (appDir' : _) -> appDir' getMainFile flags . guessMainFile $ appDir testMainHeuristics :: Interactive m => InitFlags -> m HsFilePath testMainHeuristics flags = do - testDir <- head <$> testDirsHeuristics flags + testDirs' <- testDirsHeuristics flags + let testDir = case testDirs' of + [] -> error "impossible: testDirsHeuristics returned empty list of dirs" + (testDir' : _) -> testDir' guessMainFile testDir initializeTestSuiteHeuristics :: Interactive m => InitFlags -> m Bool diff --git a/cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs b/cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs index 0fe0129d2c3..138f9684553 100644 --- a/cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs +++ b/cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs @@ -54,9 +54,9 @@ guessMainFile pkgDir = do then do files <- filter isMain <$> listFilesRecursive pkgDir return $ - if null files - then defaultMainIs - else toHsFilePath $ L.head files + case files of + [] -> defaultMainIs + (f : _) -> toHsFilePath f else return defaultMainIs -- | Juggling characters around to guess the desired cabal version based on diff --git a/cabal-install/src/Distribution/Client/InstallPlan.hs b/cabal-install/src/Distribution/Client/InstallPlan.hs index 1a8042d6bad..46212baaccc 100644 --- a/cabal-install/src/Distribution/Client/InstallPlan.hs +++ b/cabal-install/src/Distribution/Client/InstallPlan.hs @@ -72,9 +72,9 @@ module Distribution.Client.InstallPlan , reverseDependencyClosure ) where -import Distribution.Client.Compat.Prelude hiding (lookup, tail, toList) +import Distribution.Client.Compat.Prelude hiding (lookup, toList) import Distribution.Compat.Stack (WithCallStack) -import Prelude (tail) +import Prelude () import Distribution.Client.Types hiding (BuildOutcomes) import qualified Distribution.PackageDescription as PD @@ -757,13 +757,13 @@ failed -> ([srcpkg], Processing) failed plan (Processing processingSet completedSet failedSet) pkgid = assert (pkgid `Set.member` processingSet) $ - assert (all (`Set.notMember` processingSet) (tail newlyFailedIds)) $ - assert (all (`Set.notMember` completedSet) (tail newlyFailedIds)) $ + assert (all (`Set.notMember` processingSet) (drop 1 newlyFailedIds)) $ + assert (all (`Set.notMember` completedSet) (drop 1 newlyFailedIds)) $ -- but note that some newlyFailed may already be in the failed set -- since one package can depend on two packages that both fail and -- so would be in the rev-dep closure for both. assert (processingInvariant plan processing') $ - ( map asConfiguredPackage (tail newlyFailed) + ( map asConfiguredPackage (drop 1 newlyFailed) , processing' ) where diff --git a/cabal-install/src/Distribution/Client/Upload.hs b/cabal-install/src/Distribution/Client/Upload.hs index c7abe8b91e4..6e96fa0eafd 100644 --- a/cabal-install/src/Distribution/Client/Upload.hs +++ b/cabal-install/src/Distribution/Client/Upload.hs @@ -1,7 +1,7 @@ module Distribution.Client.Upload (upload, uploadDoc, report) where import Distribution.Client.Compat.Prelude -import qualified Prelude as Unsafe (head, read, tail) +import qualified Prelude as Unsafe (read) import Distribution.Client.HttpUtils ( HttpTransport (..) @@ -155,11 +155,13 @@ uploadDoc verbosity repoCtxt mToken mUsername mPassword isCandidate path = do break (== '-') (reverse (takeFileName path)) - pkgid = reverse $ Unsafe.tail reversePkgid + pkgid = reverse $ drop 1 reversePkgid when ( reverse reverseSuffix /= "docs.tar.gz" - || null reversePkgid - || Unsafe.head reversePkgid /= '-' + || ( case reversePkgid of + [] -> True + (c : _) -> c /= '-' + ) ) $ dieWithException verbosity ExpectedMatchingFileName diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index bf6e25c5b87..55ea3747b9f 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -80,7 +80,6 @@ import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.Options import Data.Tagged (Tagged(..)) -import qualified Data.List as L import qualified Data.ByteString as BS import Distribution.Client.GlobalFlags (GlobalFlags, globalNix) @@ -2180,9 +2179,10 @@ testConfigOptionComments = do where -- | Find lines containing a target string. findLineWith :: Bool -> String -> String -> String - findLineWith isComment target text - | not . null $ findLinesWith isComment target text = removeCommentValue . L.head $ findLinesWith isComment target text - | otherwise = text + findLineWith isComment target text = + case findLinesWith isComment target text of + [] -> text + (l : _) -> removeCommentValue l findLinesWith :: Bool -> String -> String -> [String] findLinesWith isComment target | isComment = filter (isInfixOf (" " ++ target ++ ":")) . lines diff --git a/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs b/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs index b708ea80302..39c719f2e1f 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs @@ -5,7 +5,6 @@ module UnitTests.Distribution.Client.InstallPlan (tests) where import Distribution.Client.Compat.Prelude -import qualified Prelude as Unsafe (tail) import Distribution.Client.InstallPlan (GenericInstallPlan, IsUnit) import qualified Distribution.Client.InstallPlan as InstallPlan @@ -285,7 +284,7 @@ arbitraryAcyclicGraph genNRanks genNPerRank edgeChance = do nranks <- genNRanks rankSizes <- replicateM nranks genNPerRank let rankStarts = scanl (+) 0 rankSizes - rankRanges = drop 1 (zip rankStarts (Unsafe.tail rankStarts)) + rankRanges = drop 1 (zip rankStarts (drop 1 rankStarts)) totalRange = sum rankSizes rankEdges <- traverse (uncurry genRank) rankRanges return $ buildG (0, totalRange - 1) (concat rankEdges) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs b/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs index 060dbdffe4f..ac6d96cc159 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs @@ -43,7 +43,10 @@ tests = "readUserConstraints" (uncurry readUserConstraintsTest) [ -- First example only. - (head exampleStrs, take 1 exampleUcs) + + ( case exampleStrs of (e : _) -> e; _ -> error "empty examples" + , take 1 exampleUcs + ) , -- All examples separated by commas. (intercalate ", " exampleStrs, exampleUcs) ] diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index e89481f13d3..2c54deaa2a2 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -1163,7 +1163,7 @@ findDependencyInStore :: FilePath -- ^store dir -> String -- ^package name prefix -> IO FilePath -- ^package dir findDependencyInStore storeDir pkgName = do - storeDirForGhcVersion <- head <$> listDirectory storeDir + (storeDirForGhcVersion : _) <- listDirectory storeDir packageDirs <- listDirectory (storeDir storeDirForGhcVersion) -- Ideally, we should call 'hashedInstalledPackageId' from 'Distribution.Client.PackageHash'. -- But 'PackageHashInputs', especially 'PackageHashConfigInputs', is too hard to construct. From 487b0ef8dc0239d5718e01e60908b6a718ee95d8 Mon Sep 17 00:00:00 2001 From: Artem Pelenitsyn Date: Mon, 16 Oct 2023 19:14:27 +0000 Subject: [PATCH 66/70] GHC 9.8 compat: update hashes of data structures as computed by Structured It seems, GHC 9.8 changed something in the code generation for data types. Structured class is supposed to catch such cases. --- .../UnitTests/Distribution/Utils/Structured.hs | 7 ++++++- .../Distribution/Client/FileMonitor.hs | 18 ++++++++++++++++-- 2 files changed, 22 insertions(+), 3 deletions(-) diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index caf3e16d038..efe8151b705 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs @@ -25,7 +25,12 @@ tests = testGroup "Distribution.Utils.Structured" , testCase "SPDX.License" $ md5Check (Proxy :: Proxy License) 0xd3d4a09f517f9f75bc3d16370d5a853a -- The difference is in encoding of newtypes -#if MIN_VERSION_base(4,7,0) +#if MIN_VERSION_base(4,19,0) + , testCase "GenericPackageDescription" $ + md5Check (Proxy :: Proxy GenericPackageDescription) 0xf5fdb32b43aca790192f44d9ecaa9689 + , testCase "LocalBuildInfo" $ + md5Check (Proxy :: Proxy LocalBuildInfo) 0x205fbe2649bc5e488bce50c07a71cadb +#elif MIN_VERSION_base(4,7,0) , testCase "GenericPackageDescription" $ md5Check (Proxy :: Proxy GenericPackageDescription) 0xb287a6f04e34ef990cdd15bc6cb01c76 , testCase "LocalBuildInfo" $ diff --git a/cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs b/cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs index 39f508040c3..0663360df42 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module UnitTests.Distribution.Client.FileMonitor (tests) where import Distribution.Parsec (simpleParsec) @@ -31,8 +33,8 @@ tests mtimeChange = [ testGroup "Structured hashes" [ testCase "MonitorStateFile" $ structureHash (Proxy :: Proxy MonitorStateFile) @?= Fingerprint 0xe4108804c34962f6 0x06e94f8fc9e48e13 - , testCase "MonitorStateGlob" $ structureHash (Proxy :: Proxy MonitorStateGlob) @?= Fingerprint 0xfd8f6be0e8258fe7 0xdb5fac737139bca6 - , testCase "MonitorStateFileSet" $ structureHash (Proxy :: Proxy MonitorStateFileSet) @?= Fingerprint 0xb745f4ea498389a5 0x70db6adb5078aa27 + , testCase "MonitorStateGlob" $ structureHash (Proxy :: Proxy MonitorStateGlob) @?= Fingerprint fingerprintStateGlob1 fingerprintStateGlob2 + , testCase "MonitorStateFileSet" $ structureHash (Proxy :: Proxy MonitorStateFileSet) @?= Fingerprint fingerprintStateFileSet1 fingerprintStateFileSet2 ] , testCase "sanity check mtimes" $ testFileMTimeSanity mtimeChange , testCase "sanity check dirs" $ testDirChangeSanity mtimeChange @@ -85,6 +87,18 @@ tests mtimeChange = knownBrokenInWindows msg = case buildOS of Windows -> expectFailBecause msg _ -> id + fingerprintStateGlob1, fingerprintStateGlob2, fingerprintStateFileSet1, fingerprintStateFileSet2 :: Word64 +#if MIN_VERSION_base(4,19,0) + fingerprintStateGlob1 = 0xae70229aabb1ba1f + fingerprintStateGlob2 = 0xb53ed324c96f0d0d + fingerprintStateFileSet1 = 0x8e509e16f973e036 + fingerprintStateFileSet2 = 0xa23f21d8dc8a2dee +#else + fingerprintStateGlob1 = 0xfd8f6be0e8258fe7 + fingerprintStateGlob2 = 0xdb5fac737139bca6 + fingerprintStateFileSet1 = 0xb745f4ea498389a5 + fingerprintStateFileSet2 = 0x70db6adb5078aa27 +#endif -- Check the file system behaves the way we expect it to From ebe39494101831c6dc78519251d1b33c99570107 Mon Sep 17 00:00:00 2001 From: Artem Pelenitsyn Date: Thu, 12 Oct 2023 21:25:59 -0400 Subject: [PATCH 67/70] GHC 9.8 compat: bump base, update Unknown GHC And bump Cabal's "supported version" of GHC --- Cabal/src/Distribution/Simple/GHC.hs | 6 +++--- cabal-dev-scripts/cabal-dev-scripts.cabal | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index 92378380325..65aa733684f 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -161,14 +161,14 @@ configure verbosity hcPath hcPkgPath conf0 = do (userMaybeSpecifyPath "ghc" hcPath conf0) let implInfo = ghcVersionImplInfo ghcVersion - -- Cabal currently supports ghc >= 7.0.1 && < 9.8 + -- Cabal currently supports ghc >= 7.0.1 && < 9.10 -- ... and the following odd development version - unless (ghcVersion < mkVersion [9, 8]) $ + unless (ghcVersion < mkVersion [9, 10]) $ warn verbosity $ "Unknown/unsupported 'ghc' version detected " ++ "(Cabal " ++ prettyShow cabalVersion - ++ " supports 'ghc' version < 9.8): " + ++ " supports 'ghc' version < 9.10): " ++ programPath ghcProg ++ " is version " ++ prettyShow ghcVersion diff --git a/cabal-dev-scripts/cabal-dev-scripts.cabal b/cabal-dev-scripts/cabal-dev-scripts.cabal index 24e160eaa92..345d052d62e 100644 --- a/cabal-dev-scripts/cabal-dev-scripts.cabal +++ b/cabal-dev-scripts/cabal-dev-scripts.cabal @@ -18,7 +18,7 @@ executable gen-spdx ghc-options: -Wall build-depends: , aeson ^>=1.4.1.0 || ^>=1.5.2.0 || ^>=2.1.1.0 - , base >=4.10 && <4.19 + , base >=4.10 && <4.20 , bytestring , containers , Diff ^>=0.4 @@ -35,7 +35,7 @@ executable gen-spdx-exc ghc-options: -Wall build-depends: , aeson ^>=1.4.1.0 || ^>=1.5.2.0 || ^>=2.1.1.0 - , base >=4.10 && <4.19 + , base >=4.10 && <4.20 , bytestring , containers , Diff ^>=0.4 From 2b37781f08c4edfe54dd0443afb046e344e17606 Mon Sep 17 00:00:00 2001 From: Artem Pelenitsyn Date: Fri, 10 Nov 2023 03:38:07 +0000 Subject: [PATCH 68/70] CI: GHC 9.8 --- .github/workflows/validate.yml | 9 ++------- cabal.project | 2 ++ cabal.project.latest-ghc | 12 ++++++++++++ cabal.project.validate | 2 ++ 4 files changed, 18 insertions(+), 7 deletions(-) create mode 100644 cabal.project.latest-ghc diff --git a/.github/workflows/validate.yml b/.github/workflows/validate.yml index 4dbc94def32..5a30dfed233 100644 --- a/.github/workflows/validate.yml +++ b/.github/workflows/validate.yml @@ -49,7 +49,7 @@ jobs: strategy: matrix: os: ["ubuntu-latest", "macos-latest", "windows-latest"] - ghc: ["9.6.3", "9.4.7", "9.2.8", "9.0.2", "8.10.7", "8.8.4", "8.6.5", "8.4.4"] + ghc: ["9.8.1", "9.6.3", "9.4.8", "9.2.8", "9.0.2", "8.10.7", "8.8.4", "8.6.5", "8.4.4"] exclude: # corrupts GHA cache or the fabric of reality itself, see https://github.com/haskell/cabal/issues/8356 - os: "windows-latest" @@ -83,7 +83,7 @@ jobs: id: setup-haskell with: ghc-version: ${{ matrix.ghc }} - cabal-version: '3.10.1.0' + cabal-version: latest # latest is mandatory for cabal-testsuite, see https://github.com/haskell/cabal/issues/8133 - name: Work around git problem https://bugs.launchpad.net/ubuntu/+source/git/+bug/1993586 (cabal PR #8546) run: | @@ -117,11 +117,6 @@ jobs: fi echo "FLAGS=$FLAGS" >> $GITHUB_ENV - - name: Allow newer dependencies when built with latest GHC - if: ${{ matrix.ghc }} == '9.6.3' - run: | - echo "allow-newer: rere:base, rere:transformers" >> cabal.project.validate - - name: Validate print-config run: sh validate.sh $FLAGS -s print-config diff --git a/cabal.project b/cabal.project index d0b2fbabc1f..d506fe9b117 100644 --- a/cabal.project +++ b/cabal.project @@ -1,3 +1,5 @@ +import: cabal.project.latest-ghc + packages: Cabal/ packages: cabal-testsuite/ packages: Cabal-syntax/ diff --git a/cabal.project.latest-ghc b/cabal.project.latest-ghc new file mode 100644 index 00000000000..5132415b48c --- /dev/null +++ b/cabal.project.latest-ghc @@ -0,0 +1,12 @@ +-- Usually, the latest GHC requires a few allow-newer's +-- for some time after the release. This project file is meant to host these. +-- The file is supposed to be included in the main project files used for +-- Cabal development: +-- - cabal.project (day-to-day development), +-- - cabal.project.validate (Cabal CI), +-- Commented out below are the usual suspects. Feel free to add more. + +-- NOTE: don't forget to update the compiler version in the conditional +-- when upgrading to a newer GHC +if impl(ghc >= 9.8.1) + -- allow-newer: windns:* diff --git a/cabal.project.validate b/cabal.project.validate index 66e823f62b1..d3583c31b0e 100644 --- a/cabal.project.validate +++ b/cabal.project.validate @@ -1,3 +1,5 @@ +import: cabal.project.latest-ghc + packages: Cabal-syntax/ packages: Cabal/ packages: cabal-testsuite/ From a57001c6ee4c8333d92c5925d63564d2e37e3567 Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Sat, 2 Dec 2023 22:16:39 +0000 Subject: [PATCH 69/70] merge master --- doc/cabal-project-description-file.rst | 1 + 1 file changed, 1 insertion(+) diff --git a/doc/cabal-project-description-file.rst b/doc/cabal-project-description-file.rst index 1bf238063c7..6055c3f7bd7 100644 --- a/doc/cabal-project-description-file.rst +++ b/doc/cabal-project-description-file.rst @@ -220,6 +220,7 @@ Hackage. tag: e76fdc753e660dfa615af6c8b6a2ad9ddf6afe70 post-checkout-command: autoreconf -i + Since version 3.4, cabal-install creates tarballs for each package coming from a ``source-repository-package`` stanza (effectively applying cabal sdists to such packages). It gathers the names of the packages from the From 395b473da6072fc20fa597850f0f9475a72340a4 Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Wed, 1 Nov 2023 21:25:27 +0000 Subject: [PATCH 70/70] Hackage should be capitalized --- doc/cabal-project-description-file.rst | 1 - 1 file changed, 1 deletion(-) diff --git a/doc/cabal-project-description-file.rst b/doc/cabal-project-description-file.rst index 6055c3f7bd7..1bf238063c7 100644 --- a/doc/cabal-project-description-file.rst +++ b/doc/cabal-project-description-file.rst @@ -220,7 +220,6 @@ Hackage. tag: e76fdc753e660dfa615af6c8b6a2ad9ddf6afe70 post-checkout-command: autoreconf -i - Since version 3.4, cabal-install creates tarballs for each package coming from a ``source-repository-package`` stanza (effectively applying cabal sdists to such packages). It gathers the names of the packages from the