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!*) --- 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/format.yml b/.github/workflows/format.yml index ba5f85c9b82..84e639e7d1c 100644 --- a/.github/workflows/format.yml +++ b/.github/workflows/format.yml @@ -10,8 +10,9 @@ jobs: runs-on: ubuntu-latest steps: - uses: actions/checkout@v4 - - uses: haskell-actions/run-fourmolu@v8 + - uses: haskell-actions/run-fourmolu@v9 with: + version: "0.12.0.0" pattern: | Cabal/**/*.hs Cabal-syntax/**/*.hs diff --git a/.github/workflows/lint.yml b/.github/workflows/lint.yml index fa12e98b878..1bae4d3d71b 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 + fail-on: suggestion diff --git a/.github/workflows/validate.skip.yml b/.github/workflows/validate.skip.yml new file mode 100644 index 00000000000..e5cd47e284a --- /dev/null +++ b/.github/workflows/validate.skip.yml @@ -0,0 +1,39 @@ +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/**' + - '**/README.md' + - 'CONTRIBUTING.md' + branches: + - master + pull_request: + paths: + - 'doc/**' + - '**/README.md' + - 'CONTRIBUTING.md' + 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 b1fc53a2352..78652b10af7 100644 --- a/.github/workflows/validate.yml +++ b/.github/workflows/validate.yml @@ -11,11 +11,22 @@ 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/**' + - '**/README.md' + - 'CONTRIBUTING.md' branches: - master pull_request: + paths-ignore: + - 'doc/**' + - '**/README.md' + - 'CONTRIBUTING.md' release: types: - created @@ -23,10 +34,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 +49,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 +118,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 +172,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.1') run: sh validate.sh $FLAGS -s lib-suite - name: Validate cli-tests @@ -169,7 +179,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.1') run: sh validate.sh $FLAGS -s cli-suite validate-old-ghcs: diff --git a/.gitignore b/.gitignore index e9ec3b6322f..4ade63478ab 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 @@ -83,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/.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 diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index eb2700d377a..cf3357a71d4 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -38,20 +38,26 @@ 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). +* 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, so that other commits on the build queue can be processed. @@ -75,9 +81,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 +182,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 +224,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 +253,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 --------- diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index 7f5b85809aa..c7d63533e52 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -1,6 +1,8 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE StandaloneDeriving #-} -- | Cabal-like file AST types: 'Field', 'Section' etc -- @@ -36,6 +38,9 @@ import Distribution.Compat.Prelude import Distribution.Pretty (showTokenStr) import Distribution.Utils.Generic (fromUTF8BS) import Prelude () +#if MIN_VERSION_base(4,18,0) +import qualified Data.Foldable1 as F1 +#endif ------------------------------------------------------------------------------- -- Cabal file @@ -47,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 @@ -69,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 @@ -87,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 @@ -105,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) @@ -141,3 +158,30 @@ fieldLinesToString = intercalate "\n" . map toStr where toStr (FieldLine _ bs) = fromUTF8BS bs + +------------------------------------------------------------------------------- +-- Foldable1 +------------------------------------------------------------------------------- + +#if MIN_VERSION_base(4,18,0) + +-- | @since 3.12.0.0 +instance F1.Foldable1 Field where + foldMap1 f (Field x ys) = + F1.fold1 (F1.foldMap1 f x :| map (F1.foldMap1 f) ys) + foldMap1 f (Section x ys zs) = + F1.fold1 (F1.foldMap1 f x :| map (F1.foldMap1 f) ys ++ map (F1.foldMap1 f) zs) + +-- | @since 3.12.0.0 +instance F1.Foldable1 FieldLine where + foldMap1 = (. fieldLineAnn) + +-- | @since 3.12.0.0 +instance F1.Foldable1 SectionArg where + foldMap1 = (. sectionArgAnn) + +-- | @since 3.12.0.0 +instance F1.Foldable1 Name where + foldMap1 = (. nameAnn) + +#endif 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-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/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-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-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/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/ChangeLog.md b/Cabal/ChangeLog.md index fd928c4de23..34d046cc098 100644 --- a/Cabal/ChangeLog.md +++ b/Cabal/ChangeLog.md @@ -1,3 +1,6 @@ +# 3.10.2.1 [Hécate](mailto:hecate+github@glitchbra.in) October 2023 +* See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.10.2.1.md + # 3.10.2.0 [Hécate](mailto:hecate+github@glitchbra.in) August 2023 * See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.10.2.0.md diff --git a/Cabal/src/Distribution/Compat/ResponseFile.hs b/Cabal/src/Distribution/Compat/ResponseFile.hs index c03207fed55..189a423bd08 100644 --- a/Cabal/src/Distribution/Compat/ResponseFile.hs +++ b/Cabal/src/Distribution/Compat/ResponseFile.hs @@ -65,6 +65,12 @@ escape cs c #endif +-- | The arg file / response file parser. +-- +-- This is not a well-documented capability, and is a bit eccentric +-- (try @cabal \@foo \@bar@ to see what that does), but is crucial +-- for allowing complex arguments to cabal and cabal-install when +-- using command prompts with strongly-limited argument length. expandResponse :: [String] -> IO [String] expandResponse = go recursionLimit "." where diff --git a/Cabal/src/Distribution/Lex.hs b/Cabal/src/Distribution/Lex.hs index 4ca1f512ce5..aec37667832 100644 --- a/Cabal/src/Distribution/Lex.hs +++ b/Cabal/src/Distribution/Lex.hs @@ -16,6 +16,14 @@ import Distribution.Compat.DList import Distribution.Compat.Prelude import Prelude () +-- | A simple parser supporting quoted strings. +-- +-- Please be aware that this will only split strings when seeing whitespace +-- outside of quotation marks, i.e, @"foo\"bar baz\"qux quux"@ will be +-- converted to @["foobar bazqux", "quux"]@. +-- +-- This behavior can be useful when parsing text like +-- @"ghc-options: -Wl,\"some option with spaces\""@, for instance. tokenizeQuotedWords :: String -> [String] tokenizeQuotedWords = filter (not . null) . go False mempty where 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/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.hs b/Cabal/src/Distribution/Simple.hs index d6f50d0af90..0649a085260 100644 --- a/Cabal/src/Distribution/Simple.hs +++ b/Cabal/src/Distribution/Simple.hs @@ -155,10 +155,22 @@ defaultMainWithHooksNoReadArgs :: UserHooks -> GenericPackageDescription -> [Str defaultMainWithHooksNoReadArgs hooks pkg_descr = defaultMainHelper hooks{readDesc = return (Just pkg_descr)} +-- | The central command chooser of the Simple build system, +-- with other defaultMain functions acting as exposed callers, +-- and with 'topHandler' operating as an exceptions handler. +-- +-- This uses 'expandResponse' to read response files, preprocessing +-- response files given by "@" prefixes. +-- +-- Given hooks and args, this runs 'commandsRun' onto the args, +-- getting 'CommandParse' data back, which is then pattern-matched into +-- IO actions for execution, with arguments applied by the parser. 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 @@ -167,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/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/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/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index f35f98f4fcb..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 @@ -2290,7 +2287,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/src/Distribution/Simple/Flag.hs b/Cabal/src/Distribution/Simple/Flag.hs index aa35c904c4f..095fe7b9dde 100644 --- a/Cabal/src/Distribution/Simple/Flag.hs +++ b/Cabal/src/Distribution/Simple/Flag.hs @@ -46,18 +46,21 @@ import Prelude () -- -- 1. list flags eg -- --- > --ghc-option=foo --ghc-option=bar +-- > --ghc-option=foo --ghc-option=bar -- --- gives us all the values ["foo", "bar"] +-- gives us all the values ["foo", "bar"] -- -- 2. singular value flags, eg: -- --- > --enable-foo --disable-foo +-- > --enable-foo --disable-foo -- --- gives us Just False --- So this Flag type is for the latter singular kind of flag. +-- gives us Just False +-- +-- So, this 'Flag' type is for the latter singular kind of flag. -- Its monoid instance gives us the behaviour where it starts out as -- 'NoFlag' and later flags override earlier ones. +-- +-- Isomorphic to 'Maybe' a. data Flag a = Flag a | NoFlag deriving (Eq, Generic, Show, Read, Typeable, Foldable, Traversable) instance Binary a => Binary (Flag a) @@ -96,36 +99,46 @@ instance Enum a => Enum (Flag a) where enumFromThenTo (Flag a) (Flag b) (Flag c) = toFlag `map` enumFromThenTo a b c enumFromThenTo _ _ _ = [] +-- | Wraps a value in 'Flag'. toFlag :: a -> Flag a toFlag = Flag +-- | Extracts a value from a 'Flag', and throws an exception on 'NoFlag'. fromFlag :: WithCallStack (Flag a -> a) fromFlag (Flag x) = x fromFlag NoFlag = error "fromFlag NoFlag. Use fromFlagOrDefault" +-- | Extracts a value from a 'Flag', and returns the default value on 'NoFlag'. fromFlagOrDefault :: a -> Flag a -> a fromFlagOrDefault _ (Flag x) = x fromFlagOrDefault def NoFlag = def +-- | Converts a 'Flag' value to a 'Maybe' value. flagToMaybe :: Flag a -> Maybe a flagToMaybe (Flag x) = Just x flagToMaybe NoFlag = Nothing --- | @since 3.4.0.0 +-- | Pushes a function through a 'Flag' value, and returns a default +-- if the 'Flag' value is 'NoFlag'. +-- +-- @since 3.4.0.0 flagElim :: b -> (a -> b) -> Flag a -> b flagElim n _ NoFlag = n flagElim _ f (Flag x) = f x +-- | Converts a 'Flag' value to a list. flagToList :: Flag a -> [a] flagToList (Flag x) = [x] flagToList NoFlag = [] +-- | Returns 'True' only if every 'Flag' 'Bool' value is Flag True, else 'False'. allFlags :: [Flag Bool] -> Flag Bool allFlags flags = if all (\f -> fromFlagOrDefault False f) flags then Flag True else NoFlag +-- | Converts a 'Maybe' value to a 'Flag' value. maybeToFlag :: Maybe a -> Flag a maybeToFlag Nothing = NoFlag maybeToFlag (Just x) = Flag x diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index 3c380a41a86..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 @@ -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/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs index 4c9bce31f8e..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 @@ -785,6 +787,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/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs index 58194f5ffa3..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 @@ -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 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/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} } 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/Cabal/src/Distribution/Utils/IOData.hs b/Cabal/src/Distribution/Utils/IOData.hs index 074576ceaf9..73e86493d1f 100644 --- a/Cabal/src/Distribution/Utils/IOData.hs +++ b/Cabal/src/Distribution/Utils/IOData.hs @@ -28,6 +28,7 @@ data IOData | -- | Raw binary which gets read/written in binary mode. IODataBinary LBS.ByteString +-- | Applies a function polymorphic over 'IODataMode' to an 'IOData' value. withIOData :: IOData -> (forall mode. IODataMode mode -> mode -> r) -> r withIOData (IODataText str) k = k IODataModeText str withIOData (IODataBinary lbs) k = k IODataModeBinary lbs @@ -53,7 +54,10 @@ class NFData mode => KnownIODataMode mode where toIOData :: mode -> IOData iodataMode :: IODataMode mode --- | @since 3.2 +-- | Phantom-typed GADT representation of the mode of 'IOData', containing no +-- other data. +-- +-- @since 3.2 data IODataMode mode where IODataModeText :: IODataMode String IODataModeBinary :: IODataMode LBS.ByteString 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-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..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 @@ -105,7 +100,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 @@ -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 @@ -138,10 +129,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-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 = diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index d47f5494c2c..0a5e55bc3f1 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 @@ -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 @@ -229,7 +231,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 +334,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-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/src/Distribution/Client/CmdClean.hs b/cabal-install/src/Distribution/Client/CmdClean.hs index 0554d632aed..ef481300ef7 100644 --- a/cabal-install/src/Distribution/Client/CmdClean.hs +++ b/cabal-install/src/Distribution/Client/CmdClean.hs @@ -16,19 +16,29 @@ import Distribution.Client.Errors import Distribution.Client.ProjectConfig ( findProjectRoot ) +import Distribution.Client.ProjectFlags + ( ProjectFlags (..) + , defaultProjectFlags + , projectFlagsOptions + , removeIgnoreProjectOption + ) import Distribution.Client.Setup ( GlobalFlags ) -import Distribution.ReadE (succeedReadE) +import Distribution.Compat.Lens + ( _1 + , _2 + ) import Distribution.Simple.Command ( CommandUI (..) + , OptionField + , ShowOrParseArgs + , liftOptionL , option - , reqArg ) import Distribution.Simple.Setup ( Flag (..) , falseArg - , flagToList , flagToMaybe , fromFlagOrDefault , optionDistPref @@ -68,8 +78,6 @@ data CleanFlags = CleanFlags { cleanSaveConfig :: Flag Bool , cleanVerbosity :: Flag Verbosity , cleanDistDir :: Flag FilePath - , cleanProjectDir :: Flag FilePath - , cleanProjectFile :: Flag FilePath } deriving (Eq) @@ -79,11 +87,9 @@ defaultCleanFlags = { cleanSaveConfig = toFlag False , cleanVerbosity = toFlag normal , cleanDistDir = NoFlag - , cleanProjectDir = mempty - , cleanProjectFile = mempty } -cleanCommand :: CommandUI CleanFlags +cleanCommand :: CommandUI (ProjectFlags, CleanFlags) cleanCommand = CommandUI { commandName = "v2-clean" @@ -96,46 +102,39 @@ cleanCommand = ++ "(.hi, .o, preprocessed sources, etc.) and also empties out the " ++ "local caches (by default).\n\n" , commandNotes = Nothing - , commandDefaultFlags = defaultCleanFlags + , commandDefaultFlags = (defaultProjectFlags, defaultCleanFlags) , commandOptions = \showOrParseArgs -> - [ optionVerbosity - cleanVerbosity - (\v flags -> flags{cleanVerbosity = v}) - , optionDistPref - cleanDistDir - (\dd flags -> flags{cleanDistDir = dd}) - showOrParseArgs - , option - [] - ["project-dir"] - "Set the path of the project directory" - cleanProjectDir - (\path flags -> flags{cleanProjectDir = path}) - (reqArg "DIR" (succeedReadE Flag) flagToList) - , option - [] - ["project-file"] - "Set the path of the cabal.project file (relative to the project directory when relative)" - cleanProjectFile - (\pf flags -> flags{cleanProjectFile = pf}) - (reqArg "FILE" (succeedReadE Flag) flagToList) - , option - ['s'] - ["save-config"] - "Save configuration, only remove build artifacts" - cleanSaveConfig - (\sc flags -> flags{cleanSaveConfig = sc}) - falseArg - ] + map + (liftOptionL _1) + (removeIgnoreProjectOption (projectFlagsOptions showOrParseArgs)) + ++ map (liftOptionL _2) (cleanOptions showOrParseArgs) } -cleanAction :: CleanFlags -> [String] -> GlobalFlags -> IO () -cleanAction CleanFlags{..} extraArgs _ = do +cleanOptions :: ShowOrParseArgs -> [OptionField CleanFlags] +cleanOptions showOrParseArgs = + [ optionVerbosity + cleanVerbosity + (\v flags -> flags{cleanVerbosity = v}) + , optionDistPref + cleanDistDir + (\dd flags -> flags{cleanDistDir = dd}) + showOrParseArgs + , option + ['s'] + ["save-config"] + "Save configuration, only remove build artifacts" + cleanSaveConfig + (\sc flags -> flags{cleanSaveConfig = sc}) + falseArg + ] + +cleanAction :: (ProjectFlags, CleanFlags) -> [String] -> GlobalFlags -> IO () +cleanAction (ProjectFlags{..}, CleanFlags{..}) extraArgs _ = do let verbosity = fromFlagOrDefault normal cleanVerbosity saveConfig = fromFlagOrDefault False cleanSaveConfig mdistDirectory = flagToMaybe cleanDistDir - mprojectDir = flagToMaybe cleanProjectDir - mprojectFile = flagToMaybe cleanProjectFile + mprojectDir = flagToMaybe flagProjectDir + mprojectFile = flagToMaybe flagProjectFile -- TODO interpret extraArgs as targets and clean those targets only (issue #7506) -- diff --git a/cabal-install/src/Distribution/Client/CmdErrorMessages.hs b/cabal-install/src/Distribution/Client/CmdErrorMessages.hs index e8b5a415db6..8345d9ed59a 100644 --- a/cabal-install/src/Distribution/Client/CmdErrorMessages.hs +++ b/cabal-install/src/Distribution/Client/CmdErrorMessages.hs @@ -37,7 +37,7 @@ import Distribution.Package , packageName ) import Distribution.Simple.Utils - ( die' + ( dieWithException ) import Distribution.Solver.Types.OptionalStanza ( OptionalStanza (..) @@ -51,6 +51,7 @@ import Distribution.Types.LibraryName ) import qualified Data.List.NonEmpty as NE +import Distribution.Client.Errors ----------------------- -- Singular or plural @@ -227,7 +228,7 @@ renderComponentKind Plural ckind = case ckind of -- | Default implementation of 'reportTargetProblems' simply renders one problem per line. reportTargetProblems :: Verbosity -> String -> [TargetProblem'] -> IO a reportTargetProblems verbosity verb = - die' verbosity . unlines . map (renderTargetProblem verb absurd) + dieWithException verbosity . CmdErrorMessages . map (renderTargetProblem verb absurd) -- | Default implementation of 'renderTargetProblem'. renderTargetProblem diff --git a/cabal-install/src/Distribution/Client/CmdFreeze.hs b/cabal-install/src/Distribution/Client/CmdFreeze.hs index db8ef81fca2..85c7eb137e2 100644 --- a/cabal-install/src/Distribution/Client/CmdFreeze.hs +++ b/cabal-install/src/Distribution/Client/CmdFreeze.hs @@ -54,7 +54,7 @@ import Distribution.PackageDescription ) import Distribution.Simple.Flag (Flag (..), fromFlagOrDefault) import Distribution.Simple.Utils - ( die' + ( dieWithException , notice , wrapText ) @@ -70,6 +70,7 @@ import Distribution.Version import qualified Data.Map as Map +import Distribution.Client.Errors import Distribution.Simple.Command ( CommandUI (..) , usageAlternatives @@ -125,9 +126,8 @@ freezeCommand = freezeAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO () freezeAction flags@NixStyleFlags{..} extraArgs globalFlags = do unless (null extraArgs) $ - die' verbosity $ - "'freeze' doesn't take any extra arguments: " - ++ unwords extraArgs + dieWithException verbosity $ + FreezeAction extraArgs ProjectBaseContext { distDirLayout diff --git a/cabal-install/src/Distribution/Client/CmdHaddock.hs b/cabal-install/src/Distribution/Client/CmdHaddock.hs index fea0cb4411d..b67bda4bcec 100644 --- a/cabal-install/src/Distribution/Client/CmdHaddock.hs +++ b/cabal-install/src/Distribution/Client/CmdHaddock.hs @@ -60,7 +60,7 @@ import Distribution.Simple.Setup , trueArg ) import Distribution.Simple.Utils - ( die' + ( dieWithException , notice , wrapText ) @@ -68,6 +68,7 @@ import Distribution.Verbosity ( normal ) +import Distribution.Client.Errors import qualified System.Exit (exitSuccess) newtype ClientHaddockFlags = ClientHaddockFlags {openInBrowser :: Flag Bool} @@ -167,9 +168,7 @@ haddockAction relFlags targetStrings globalFlags = do buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do when (buildSettingOnlyDeps (buildSettings baseCtx)) $ - die' - verbosity - "The haddock command does not support '--only-dependencies'." + dieWithException verbosity HaddockCommandDoesn'tSupport -- When we interpret the targets on the command line, interpret them as -- haddock targets diff --git a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs index d63e890a3ee..cac23c9b51b 100644 --- a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs +++ b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs @@ -84,7 +84,7 @@ import Distribution.Simple.Setup import Distribution.Simple.Utils ( copyDirectoryRecursive , createDirectoryIfMissingVerbose - , die' + , dieWithException , warn ) import Distribution.Types.InstalledPackageInfo (InstalledPackageInfo (..)) @@ -97,6 +97,7 @@ import Distribution.Verbosity as Verbosity ( normal ) +import Distribution.Client.Errors import System.Directory (doesDirectoryExist, doesFileExist) import System.FilePath (normalise, takeDirectory, (<.>), ()) @@ -384,7 +385,7 @@ haddockProjectAction flags _extraArgs globalFlags = do reportTargetProblems :: Show x => [x] -> IO a reportTargetProblems = - die' verbosity . unlines . map show + dieWithException verbosity . CmdHaddockReportTargetProblems . map show -- TODO: this is just a sketch selectPackageTargets diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 46ce2cd6e5a..cb032d2b712 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -162,7 +162,7 @@ import Distribution.Simple.Setup ) import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose - , die' + , dieWithException , notice , ordNub , safeHead @@ -220,6 +220,7 @@ import Data.Ord ( Down (..) ) import qualified Data.Set as S +import Distribution.Client.Errors import Distribution.Utils.NubList ( fromNubList ) @@ -424,17 +425,13 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt let xs = searchByName packageIndex (unPackageName name) let emptyIf True _ = [] emptyIf False zs = zs - die' verbosity $ - concat $ - [ "Unknown package \"" - , unPackageName name - , "\". " - ] - ++ emptyIf + str2 = + emptyIf (null xs) [ "Did you mean any of the following?\n" , unlines (("- " ++) . unPackageName . fst <$> xs) ] + dieWithException verbosity $ WithoutProject (unPackageName name) str2 let (uris, packageSpecifiers) = partitionEithers $ map woPackageSpecifiers tss @@ -541,7 +538,7 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt let es = filter (\e -> not $ getPackageName e `S.member` nameIntersection) envSpecs nge = map snd . filter (\e -> not $ fst e `S.member` nameIntersection) $ nonGlobalEnvEntries in pure (es, nge) - else die' verbosity $ "Packages requested to install already exist in environment file at " ++ envFile ++ ". Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: " ++ intercalate ", " (map prettyShow $ S.toList nameIntersection) + else dieWithException verbosity $ PackagesAlreadyExistInEnvfile envFile (map prettyShow $ S.toList nameIntersection) -- we construct an installed index of files in the cleaned target environment (absent overwrites) so that we can solve with regards to packages installed locally but not in the upstream repo let installedPacks = PI.allPackagesByName installedIndex @@ -617,20 +614,16 @@ addLocalConfigToTargets config targetStrings = -- | Verify that invalid config options were not passed to the install command. -- --- If an invalid configuration is found the command will @die'@. +-- If an invalid configuration is found the command will @dieWithException@. verifyPreconditionsOrDie :: Verbosity -> ConfigFlags -> IO () verifyPreconditionsOrDie verbosity configFlags = do -- We never try to build tests/benchmarks for remote packages. -- So we set them as disabled by default and error if they are explicitly -- enabled. when (configTests configFlags == Flag True) $ - die' verbosity $ - "--enable-tests was specified, but tests can't " - ++ "be enabled in a remote package" + dieWithException verbosity ConfigTests when (configBenchmarks configFlags == Flag True) $ - die' verbosity $ - "--enable-benchmarks was specified, but benchmarks can't " - ++ "be enabled in a remote package" + dieWithException verbosity ConfigBenchmarks getClientInstallFlags :: Verbosity -> GlobalFlags -> ClientInstallFlags -> IO ClientInstallFlags getClientInstallFlags verbosity globalFlags existingClientInstallFlags = do @@ -733,13 +726,7 @@ partitionToKnownTargetsAndHackagePackages verbosity pkgDb elaboratedPlan targetS case searchByName (packageIndex pkgDb) (unPackageName hn) of [] -> return () xs -> - die' verbosity . concat $ - [ "Unknown package \"" - , unPackageName hn - , "\". " - , "Did you mean any of the following?\n" - , unlines (("- " ++) . unPackageName . fst <$> xs) - ] + dieWithException verbosity $ UnknownPackage (unPackageName hn) (("- " ++) . unPackageName . fst <$> xs) _ -> return () when (not . null $ errs') $ reportBuildTargetProblems verbosity errs' @@ -1058,7 +1045,7 @@ installUnitExes InstallMethodSymlink -> "Symlinking" InstallMethodCopy -> "Copying" <> " '" <> prettyShow exe <> "' failed." - unless success $ die' verbosity errorMessage + unless success $ dieWithException verbosity $ InstallUnitExes errorMessage -- | Install a specific exe. installBuiltExe @@ -1265,4 +1252,4 @@ reportBuildTargetProblems verbosity problems = reportTargetProblems verbosity "b reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a reportCannotPruneDependencies verbosity = - die' verbosity . renderCannotPruneDependencies + dieWithException verbosity . SelectComponentTargetError . renderCannotPruneDependencies diff --git a/cabal-install/src/Distribution/Client/CmdSdist.hs b/cabal-install/src/Distribution/Client/CmdSdist.hs index 38839c8292a..c77c1eae910 100644 --- a/cabal-install/src/Distribution/Client/CmdSdist.hs +++ b/cabal-install/src/Distribution/Client/CmdSdist.hs @@ -63,6 +63,7 @@ import Distribution.Solver.Types.SourcePackage ( SourcePackage (..) ) +import Distribution.Client.Errors import Distribution.Client.SrcDist ( packageDirToSdist ) @@ -106,8 +107,7 @@ import Distribution.Simple.SrcDist ( listPackageSourcesWithDie ) import Distribution.Simple.Utils - ( die' - , dieWithException + ( dieWithException , notice , withOutputMarker , wrapText @@ -258,12 +258,12 @@ sdistAction (pf@ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do | otherwise -> distSdistFile distDirLayout (packageId pkg) case reifyTargetSelectors localPkgs targetSelectors of - Left errs -> die' verbosity . unlines . fmap renderTargetProblem $ errs + Left errs -> dieWithException verbosity $ SdistActionException . fmap renderTargetProblem $ errs Right pkgs | length pkgs > 1 , not listSources , Just "-" <- mOutputPath' -> - die' verbosity "Can't write multiple tarballs to standard output!" + dieWithException verbosity Can'tWriteMultipleTarballs | otherwise -> traverse_ (\pkg -> packageToSdist verbosity (distProjectRootDirectory distDirLayout) format (outputPath pkg) pkg) pkgs where @@ -306,7 +306,7 @@ data OutputFormat packageToSdist :: Verbosity -> FilePath -> OutputFormat -> FilePath -> UnresolvedSourcePackage -> IO () packageToSdist verbosity projectRootDir format outputFile pkg = do - let death = die' verbosity ("The impossible happened: a local package isn't local" <> (show pkg)) + let death = dieWithException verbosity $ ImpossibleHappened (show pkg) dir0 <- case srcpkgSource pkg of LocalUnpackedPackage path -> pure (Right path) RemoteSourceRepoPackage _ (Just tgz) -> pure (Left tgz) @@ -335,7 +335,7 @@ packageToSdist verbosity projectRootDir format outputFile pkg = do case format of TarGzArchive -> do writeLBS =<< BSL.readFile tgz - _ -> die' verbosity ("cannot convert tarball package to " ++ show format) + _ -> dieWithException verbosity $ CannotConvertTarballPackage (show format) Right dir -> case format of SourceList nulSep -> do let gpd :: GenericPackageDescription 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/Configure.hs b/cabal-install/src/Distribution/Client/Configure.hs index 56b882d6d2a..b01681d9727 100644 --- a/cabal-install/src/Distribution/Client/Configure.hs +++ b/cabal-install/src/Distribution/Client/Configure.hs @@ -107,7 +107,7 @@ import Distribution.Simple.Setup import Distribution.Simple.Utils as Utils ( debug , defaultPackageDesc - , die' + , dieWithException , notice , warn ) @@ -128,6 +128,7 @@ import Distribution.Version , thisVersion ) +import Distribution.Client.Errors import System.FilePath (()) -- | Choose the Cabal version such that the setup scripts compiled against this @@ -223,9 +224,7 @@ configure pkg extraArgs _ -> - die' verbosity $ - "internal error: configure install plan should have exactly " - ++ "one local ready package." + dieWithException verbosity ConfigureInstallInternalError where setupScriptOptions :: InstalledPackageIndex diff --git a/cabal-install/src/Distribution/Client/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs index 9214ae56fb6..ada3eca5268 100644 --- a/cabal-install/src/Distribution/Client/Errors.hs +++ b/cabal-install/src/Distribution/Client/Errors.hs @@ -1,6 +1,9 @@ {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} ----------------------------------------------------------------------------- @@ -18,12 +21,20 @@ module Distribution.Client.Errors , exceptionMessageCabalInstall ) where +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 import Distribution.Pretty import Distribution.Simple (VersionRange) import Distribution.Simple.Utils +import Network.URI import Text.Regex.Posix.ByteString (WrapError) data CabalInstallException @@ -120,6 +131,59 @@ data CabalInstallException | FreezeFileExistsErr FilePath | FinalizePDFailed | ProjectTargetSelector String String + | PhaseRunSolverErr String + | HaddockCommandDoesn'tSupport + | CannotParseURIFragment String String + | MakeDownload URI ByteString ByteString + | FailedToDownloadURI URI String + | RemoteRepoCheckHttps String String + | TransportCheckHttps URI String + | NoPostYet + | WGetServerError FilePath String + | Couldn'tEstablishHttpConnection + | StatusParseFail URI String + | TryUpgradeToHttps [String] + | UnknownHttpTransportSpecified String [String] + | CmdHaddockReportTargetProblems [String] + | FailedExtractingScriptBlock String + | FreezeAction [String] + | TryFindPackageDescErr String + | DieIfNotHaddockFailureException String + | ConfigureInstallInternalError + | CmdErrorMessages [String] + | ReportTargetSelectorProblems [String] + | UnrecognisedTarget [(String, [String], String)] + | NoSuchTargetSelectorErr [(String, [(Maybe (String, String), String, String, [String])])] + | TargetSelectorAmbiguousErr [(String, [(String, String)])] + | TargetSelectorNoCurrentPackageErr String + | TargetSelectorNoTargetsInCwdTrue + | TargetSelectorNoTargetsInCwdFalse + | TargetSelectorNoTargetsInProjectErr + | TargetSelectorNoScriptErr String + | MatchingInternalErrorErr String String String [(String, [String])] + | ReportPlanningFailure String + | Can'tDownloadPackagesOffline [String] + | SomePackagesFailedToInstall [(String, String)] + | PackageDotCabalFileNotFound FilePath + | PkgConfParsedFailed String + | BrokenException String + | WithoutProject String [String] + | PackagesAlreadyExistInEnvfile FilePath [String] + | ConfigTests + | ConfigBenchmarks + | UnknownPackage String [String] + | InstallUnitExes String + | SelectComponentTargetError String + | SdistActionException [String] + | Can'tWriteMultipleTarballs + | ImpossibleHappened String + | CannotConvertTarballPackage String + | Win32SelfUpgradeNotNeeded + | FreezeException String + | PkgSpecifierException [String] + | CorruptedIndexCache String + | UnusableIndexState RemoteRepo Timestamp Timestamp + | MissingPackageList RemoteRepo deriving (Show, Typeable) exceptionCodeCabalInstall :: CabalInstallException -> Int @@ -217,6 +281,60 @@ exceptionCodeCabalInstall e = case e of FreezeFileExistsErr{} -> 7104 FinalizePDFailed{} -> 7105 ProjectTargetSelector{} -> 7106 + PhaseRunSolverErr{} -> 7107 + HaddockCommandDoesn'tSupport{} -> 7108 + CannotParseURIFragment{} -> 7109 + MakeDownload{} -> 7110 + FailedToDownloadURI{} -> 7111 + RemoteRepoCheckHttps{} -> 7112 + TransportCheckHttps{} -> 7113 + NoPostYet{} -> 7114 + WGetServerError{} -> 7115 + Couldn'tEstablishHttpConnection{} -> 7116 + StatusParseFail{} -> 7117 + TryUpgradeToHttps{} -> 7118 + UnknownHttpTransportSpecified{} -> 7119 + CmdHaddockReportTargetProblems{} -> 7120 + FailedExtractingScriptBlock{} -> 7121 + FreezeAction{} -> 7122 + TryFindPackageDescErr{} -> 7124 + DieIfNotHaddockFailureException{} -> 7125 + ConfigureInstallInternalError{} -> 7126 + CmdErrorMessages{} -> 7127 + ReportTargetSelectorProblems{} -> 7128 + UnrecognisedTarget{} -> 7129 + NoSuchTargetSelectorErr{} -> 7131 + TargetSelectorAmbiguousErr{} -> 7132 + TargetSelectorNoCurrentPackageErr{} -> 7133 + TargetSelectorNoTargetsInCwdTrue{} -> 7134 + TargetSelectorNoTargetsInCwdFalse{} -> 7135 + TargetSelectorNoTargetsInProjectErr{} -> 7136 + TargetSelectorNoScriptErr{} -> 7137 + MatchingInternalErrorErr{} -> 7130 + ReportPlanningFailure{} -> 7138 + Can'tDownloadPackagesOffline{} -> 7139 + SomePackagesFailedToInstall{} -> 7140 + PackageDotCabalFileNotFound{} -> 7141 + PkgConfParsedFailed{} -> 7142 + BrokenException{} -> 7143 + WithoutProject{} -> 7144 + PackagesAlreadyExistInEnvfile{} -> 7145 + ConfigTests{} -> 7146 + ConfigBenchmarks{} -> 7147 + UnknownPackage{} -> 7148 + InstallUnitExes{} -> 7149 + SelectComponentTargetError{} -> 7150 + SdistActionException{} -> 7151 + Can'tWriteMultipleTarballs{} -> 7152 + ImpossibleHappened{} -> 7153 + CannotConvertTarballPackage{} -> 7154 + Win32SelfUpgradeNotNeeded{} -> 7155 + FreezeException{} -> 7156 + PkgSpecifierException{} -> 7157 + CorruptedIndexCache{} -> 7158 + UnusableIndexState{} -> 7159 + MissingPackageList{} -> 7160 + exceptionMessageCabalInstall :: CabalInstallException -> String exceptionMessageCabalInstall e = case e of UnpackGet -> @@ -235,7 +353,7 @@ exceptionMessageCabalInstall e = case e of CouldNotFindExecutable -> "run: Could not find executable in LocalBuildInfo" FoundMultipleMatchingExes -> "run: Found multiple matching exes in LocalBuildInfo" NoRemoteRepositories -> "Cannot upload. No remote repositories are configured." - NotATarDotGzFile path -> "Not a tar.gz file: " ++ path + NotATarDotGzFile paths -> "Not a tar.gz file: " ++ paths ExpectedMatchingFileName -> "Expected a file name matching the pattern -docs.tar.gz" NoTargetProvided -> "One target is required, none provided" OneTargetRequired -> "One target is required, given multiple" @@ -277,7 +395,7 @@ exceptionMessageCabalInstall e = case e of ++ msg ++ "The package index or index cache is probably " ++ "corrupt. Running cabal update might fix it." - ReadIndexCache path -> show (path) + ReadIndexCache paths -> show (paths) ConfigStateFileException err -> err UploadAction -> "the 'upload' command expects at least one .tar.gz archive." UploadActionDocumentation -> @@ -292,7 +410,7 @@ exceptionMessageCabalInstall e = case e of InitAction -> "'init' only takes a single, optional, extra " ++ "argument for the project root directory" - UserConfigAction path -> path ++ " already exists." + UserConfigAction paths -> paths ++ " already exists." SpecifySubcommand -> "Please specify a subcommand (see 'help user-config')" UnknownUserConfigSubcommand extraArgs -> "Unknown 'user-config' subcommand: " ++ unwords extraArgs ManpageAction extraArgs -> "'man' doesn't take any extra arguments: " ++ unwords extraArgs @@ -453,6 +571,284 @@ exceptionMessageCabalInstall e = case e of ++ "a freeze file via 'cabal freeze'." FinalizePDFailed -> "finalizePD failed" ProjectTargetSelector input err -> "Invalid package ID: " ++ input ++ "\n" ++ err + PhaseRunSolverErr msg -> msg + HaddockCommandDoesn'tSupport -> "The haddock command does not support '--only-dependencies'." + CannotParseURIFragment uriFrag err -> "Cannot parse URI fragment " ++ uriFrag ++ " " ++ err + MakeDownload uri expected actual -> + unwords + [ "Failed to download" + , show uri + , ": SHA256 don't match; expected:" + , BS8.unpack (Base16.encode expected) + , "actual:" + , BS8.unpack (Base16.encode actual) + ] + FailedToDownloadURI uri errCode -> + "failed to download " + ++ show uri + ++ " : HTTP code " + ++ errCode + RemoteRepoCheckHttps unRepoName requiresHttpsErrorMessage -> + "The remote repository '" + ++ unRepoName + ++ "' specifies a URL that " + ++ requiresHttpsErrorMessage + TransportCheckHttps uri requiresHttpsErrorMessage -> + "The URL " + ++ show uri + ++ " " + ++ requiresHttpsErrorMessage + NoPostYet -> "Posting (for report upload) is not implemented yet" + WGetServerError programPath resp -> + "'" + ++ programPath + ++ "' exited with an error:\n" + ++ resp + Couldn'tEstablishHttpConnection -> + "Couldn't establish HTTP connection. " + ++ "Possible cause: HTTP proxy server is down." + StatusParseFail uri r -> + "Failed to download " + ++ show uri + ++ " : " + ++ "No Status Code could be parsed from response: " + ++ r + TryUpgradeToHttps str -> + "The builtin HTTP implementation does not support HTTPS, but using " + ++ "HTTPS for authenticated uploads is recommended. " + ++ "The transport implementations with HTTPS support are " + ++ intercalate ", " str + ++ "but they require the corresponding external program to be " + ++ "available. You can either make one available or use plain HTTP by " + ++ "using the global flag --http-transport=plain-http (or putting the " + ++ "equivalent in the config file). With plain HTTP, your password " + ++ "is sent using HTTP digest authentication so it cannot be easily " + ++ "intercepted, but it is not as secure as using HTTPS." + UnknownHttpTransportSpecified name str -> + "Unknown HTTP transport specified: " + ++ name + ++ ". The supported transports are " + ++ intercalate + ", " + str + CmdHaddockReportTargetProblems str -> unlines str + FailedExtractingScriptBlock eStr -> "Failed extracting script block: " ++ eStr + FreezeAction extraArgs -> + "'freeze' doesn't take any extra arguments: " + ++ unwords extraArgs + TryFindPackageDescErr err -> err + DieIfNotHaddockFailureException errorStr -> errorStr + ConfigureInstallInternalError -> + "internal error: configure install plan should have exactly " + ++ "one local ready package." + CmdErrorMessages err -> unlines err + ReportTargetSelectorProblems targets -> + unlines + [ "Unrecognised target syntax for '" ++ name ++ "'." + | name <- targets + ] + UnrecognisedTarget targets -> + unlines + [ "Unrecognised target '" + ++ target + ++ "'.\n" + ++ "Expected a " + ++ intercalate " or " expected + ++ ", rather than '" + ++ got + ++ "'." + | (target, expected, got) <- targets + ] + NoSuchTargetSelectorErr targets -> + unlines + [ "Unknown target '" + ++ target + ++ "'.\n" + ++ unlines + [ ( case inside of + Just (kind, "") -> + "The " ++ kind ++ " has no " + Just (kind, thing) -> + "The " ++ kind ++ " " ++ thing ++ " has no " + Nothing -> "There is no " + ) + ++ intercalate + " or " + [ mungeThing thing ++ " '" ++ got ++ "'" + | (thing, got, _alts) <- nosuch' + ] + ++ "." + ++ if null alternatives + then "" + else + "\nPerhaps you meant " + ++ intercalate + ";\nor " + [ "the " ++ thing ++ " '" ++ intercalate "' or '" alts ++ "'?" + | (thing, alts) <- alternatives + ] + | (inside, nosuch') <- groupByContainer nosuch + , let alternatives = + [ (thing, alts) + | (thing, _got, alts@(_ : _)) <- nosuch' + ] + ] + | (target, nosuch) <- targets + , let groupByContainer = + map + ( \g@((inside, _, _, _) : _) -> + ( inside + , [ (thing, got, alts) + | (_, thing, got, alts) <- g + ] + ) + ) + . groupBy ((==) `on` (\(x, _, _, _) -> x)) + . sortBy (compare `on` (\(x, _, _, _) -> x)) + ] + where + mungeThing "file" = "file target" + mungeThing thing = thing + TargetSelectorAmbiguousErr targets -> + unlines + [ "Ambiguous target '" + ++ target + ++ "'. It could be:\n " + ++ unlines + [ " " + ++ ut + ++ " (" + ++ bt + ++ ")" + | (ut, bt) <- amb + ] + | (target, amb) <- targets + ] + TargetSelectorNoCurrentPackageErr target -> + "The target '" + ++ target + ++ "' refers to the " + ++ "components in the package in the current directory, but there " + ++ "is no package in the current directory (or at least not listed " + ++ "as part of the project)." + TargetSelectorNoTargetsInCwdTrue -> + "No targets given and there is no package in the current " + ++ "directory. Use the target 'all' for all packages in the " + ++ "project or specify packages or components by name or location. " + ++ "See 'cabal build --help' for more details on target options." + TargetSelectorNoTargetsInCwdFalse -> + "No targets given and there is no package in the current " + ++ "directory. Specify packages or components by name or location. " + ++ "See 'cabal build --help' for more details on target options." + TargetSelectorNoTargetsInProjectErr -> + "There is no .cabal package file or cabal.project file. " + ++ "To build packages locally you need at minimum a .cabal " + ++ "file. You can use 'cabal init' to create one.\n" + ++ "\n" + ++ "For non-trivial projects you will also want a cabal.project " + ++ "file in the root directory of your project. This file lists the " + ++ "packages in your project and all other build configuration. " + ++ "See the Cabal user guide for full details." + TargetSelectorNoScriptErr target -> + "The script '" + ++ target + ++ "' does not exist, " + ++ "and only script targets may contain whitespace characters or end " + ++ "with ':'" + MatchingInternalErrorErr t s sKind renderingsAndMatches -> + "Internal error in target matching: could not make an " + ++ "unambiguous fully qualified target selector for '" + ++ t + ++ "'.\n" + ++ "We made the target '" + ++ s + ++ "' (" + ++ sKind + ++ ") that was expected to " + ++ "be unambiguous but matches the following targets:\n" + ++ unlines + [ "'" + ++ rendering + ++ "', matching:" + ++ concatMap + ("\n - " ++) + matches + | (rendering, matches) <- renderingsAndMatches + ] + ++ "\nNote: Cabal expects to be able to make a single fully " + ++ "qualified name for a target or provide a more specific error. " + ++ "Our failure to do so is a bug in cabal. " + ++ "Tracking issue: https://github.com/haskell/cabal/issues/8684" + ++ "\n\nHint: this may be caused by trying to build a package that " + ++ "exists in the project directory but is missing from " + ++ "the 'packages' stanza in your cabal project file." + ReportPlanningFailure message -> message + Can'tDownloadPackagesOffline notFetched -> + "Can't download packages in offline mode. " + ++ "Must download the following packages to proceed:\n" + ++ intercalate ", " notFetched + ++ "\nTry using 'cabal fetch'." + SomePackagesFailedToInstall failed -> + unlines $ + "Some packages failed to install:" + : [ pkgid ++ reason + | (pkgid, reason) <- failed + ] + PackageDotCabalFileNotFound descFilePath -> "Package .cabal file not found: " ++ show descFilePath + PkgConfParsedFailed perror -> + "Couldn't parse the output of 'setup register --gen-pkg-config':" + ++ show perror + BrokenException errorStr -> errorStr + WithoutProject str1 str2 -> + concat $ + [ "Unknown package \"" + , str1 + , "\". " + ] + ++ str2 + PackagesAlreadyExistInEnvfile envFile name -> + "Packages requested to install already exist in environment file at " + ++ envFile + ++ ". Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: " + ++ intercalate ", " name + ConfigTests -> + "--enable-tests was specified, but tests can't " + ++ "be enabled in a remote package" + ConfigBenchmarks -> + "--enable-benchmarks was specified, but benchmarks can't " + ++ "be enabled in a remote package" + UnknownPackage hn name -> + concat $ + [ "Unknown package \"" + , hn + , "\". " + , "Did you mean any of the following?\n" + , unlines name + ] + InstallUnitExes errorMessage -> errorMessage + SelectComponentTargetError render -> render + SdistActionException errs -> unlines errs + Can'tWriteMultipleTarballs -> "Can't write multiple tarballs to standard output!" + ImpossibleHappened pkg -> "The impossible happened: a local package isn't local" <> pkg + CannotConvertTarballPackage format -> "cannot convert tarball package to " ++ format + Win32SelfUpgradeNotNeeded -> "win32selfupgrade not needed except on win32" + 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/Freeze.hs b/cabal-install/src/Distribution/Client/Freeze.hs index 2402d5dd9e4..9bc4e3234b5 100644 --- a/cabal-install/src/Distribution/Client/Freeze.hs +++ b/cabal-install/src/Distribution/Client/Freeze.hs @@ -76,7 +76,6 @@ import Distribution.Simple.Setup ) import Distribution.Simple.Utils ( debug - , die' , dieWithException , notice , toUTF8LBS @@ -215,7 +214,7 @@ planPackages notice verbosity "Resolving dependencies..." installPlan <- - foldProgress logMsg (die' verbosity) return $ + foldProgress logMsg (dieWithException verbosity . FreezeException) return $ resolveDependencies platform (compilerInfo comp) diff --git a/cabal-install/src/Distribution/Client/Get.hs b/cabal-install/src/Distribution/Client/Get.hs index c0ed0083474..99ebe749161 100644 --- a/cabal-install/src/Distribution/Client/Get.hs +++ b/cabal-install/src/Distribution/Client/Get.hs @@ -45,8 +45,7 @@ import Distribution.Simple.Setup , fromFlagOrDefault ) import Distribution.Simple.Utils - ( die' - , dieWithException + ( dieWithException , info , notice , warn @@ -124,7 +123,7 @@ get verbosity repoCtxt _ getFlags userTargets = do userTargets pkgs <- - either (die' verbosity . unlines . map show) return $ + either (dieWithException verbosity . PkgSpecifierException . map show) return $ resolveWithoutDependencies (resolverParams sourcePkgDb pkgSpecifiers) diff --git a/cabal-install/src/Distribution/Client/HttpUtils.hs b/cabal-install/src/Distribution/Client/HttpUtils.hs index 5b470a8f80f..39251039a36 100644 --- a/cabal-install/src/Distribution/Client/HttpUtils.hs +++ b/cabal-install/src/Distribution/Client/HttpUtils.hs @@ -60,7 +60,7 @@ import Distribution.Simple.Utils ( IOData (..) , copyFileVerbose , debug - , die' + , dieWithException , info , notice , warn @@ -127,6 +127,7 @@ import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy.Char8 as LBS8 import qualified Data.Char as Char +import Distribution.Client.Errors import qualified Distribution.Compat.CharParsing as P ------------------------------------------------------------------------------ @@ -180,8 +181,7 @@ downloadURI transport verbosity uri path = do Right expected -> return (NeedsDownload (Just expected)) -- we failed to parse uriFragment Left err -> - die' verbosity $ - "Cannot parse URI fragment " ++ uriFrag ++ " " ++ err + dieWithException verbosity $ CannotParseURIFragment uriFrag err else -- if there are no uri fragment, use ETag do etagPathExists <- doesFileExist etagPath @@ -216,15 +216,8 @@ downloadURI transport verbosity uri path = do contents <- LBS.readFile tmpFile let actual = SHA256.hashlazy contents unless (actual == expected) $ - die' verbosity $ - unwords - [ "Failed to download" - , show uri - , ": SHA256 don't match; expected:" - , BS8.unpack (Base16.encode expected) - , "actual:" - , BS8.unpack (Base16.encode actual) - ] + dieWithException verbosity $ + MakeDownload uri expected actual (200, Just newEtag) -> writeFile etagPath newEtag _ -> return () @@ -237,11 +230,7 @@ downloadURI transport verbosity uri path = do notice verbosity "Skipping download: local and remote files match." return FileAlreadyInCache errCode -> - die' verbosity $ - "failed to download " - ++ show uri - ++ " : HTTP code " - ++ show errCode + dieWithException verbosity $ FailedToDownloadURI uri (show errCode) etagPath = path <.> "etag" uriFrag = uriFragment uri @@ -267,22 +256,14 @@ remoteRepoCheckHttps :: Verbosity -> HttpTransport -> RemoteRepo -> IO () remoteRepoCheckHttps verbosity transport repo | uriScheme (remoteRepoURI repo) == "https:" , not (transportSupportsHttps transport) = - die' verbosity $ - "The remote repository '" - ++ unRepoName (remoteRepoName repo) - ++ "' specifies a URL that " - ++ requiresHttpsErrorMessage + dieWithException verbosity $ RemoteRepoCheckHttps (unRepoName (remoteRepoName repo)) requiresHttpsErrorMessage | otherwise = return () transportCheckHttps :: Verbosity -> HttpTransport -> URI -> IO () transportCheckHttps verbosity transport uri | uriScheme uri == "https:" , not (transportSupportsHttps transport) = - die' verbosity $ - "The URL " - ++ show uri - ++ " " - ++ requiresHttpsErrorMessage + dieWithException verbosity $ TransportCheckHttps uri requiresHttpsErrorMessage | otherwise = return () requiresHttpsErrorMessage :: String @@ -303,17 +284,7 @@ remoteRepoTryUpgradeToHttps verbosity transport repo , uriScheme (remoteRepoURI repo) == "http:" , not (transportSupportsHttps transport) , not (transportManuallySelected transport) = - die' verbosity $ - "The builtin HTTP implementation does not support HTTPS, but using " - ++ "HTTPS for authenticated uploads is recommended. " - ++ "The transport implementations with HTTPS support are " - ++ intercalate ", " [name | (name, _, True, _) <- supportedTransports] - ++ "but they require the corresponding external program to be " - ++ "available. You can either make one available or use plain HTTP by " - ++ "using the global flag --http-transport=plain-http (or putting the " - ++ "equivalent in the config file). With plain HTTP, your password " - ++ "is sent using HTTP digest authentication so it cannot be easily " - ++ "intercepted, but it is not as secure as using HTTPS." + dieWithException verbosity $ TryUpgradeToHttps [name | (name, _, True, _) <- supportedTransports] | remoteRepoShouldTryHttps repo , uriScheme (remoteRepoURI repo) == "http:" , transportSupportsHttps transport = @@ -395,7 +366,7 @@ noPostYet -> String -> Maybe Auth -> IO (Int, String) -noPostYet verbosity _ _ _ = die' verbosity "Posting (for report upload) is not implemented yet" +noPostYet verbosity _ _ _ = dieWithException verbosity NoPostYet supportedTransports :: [ ( String @@ -447,13 +418,7 @@ configureTransport verbosity extraPath (Just name) = let transport = fromMaybe (error "configureTransport: failed to make transport") $ mkTrans progdb return transport{transportManuallySelected = True} Nothing -> - die' verbosity $ - "Unknown HTTP transport specified: " - ++ name - ++ ". The supported transports are " - ++ intercalate - ", " - [name' | (name', _, _, _) <- supportedTransports] + dieWithException verbosity $ UnknownHttpTransportSpecified name [name' | (name', _, _, _) <- supportedTransports] configureTransport verbosity extraPath Nothing = do -- the user hasn't selected a transport, so we'll pick the first one we -- can configure successfully, provided that it supports tls @@ -767,12 +732,7 @@ wgetTransport prog = -- wget returns exit code 8 for server "errors" like "304 not modified" if exitCode == ExitSuccess || exitCode == ExitFailure 8 then return resp - else - die' verbosity $ - "'" - ++ programPath prog - ++ "' exited with an error:\n" - ++ resp + else dieWithException verbosity $ WGetServerError (programPath prog) resp -- With the --server-response flag, wget produces output with the full -- http server response with all headers, we want to find a line like @@ -1081,9 +1041,7 @@ plainHttpTransport = p <- fixupEmptyProxy <$> fetchProxy True Exception.handleJust (guard . isDoesNotExistError) - ( const . die' verbosity $ - "Couldn't establish HTTP connection. " - ++ "Possible cause: HTTP proxy server is down." + ( const . dieWithException verbosity $ Couldn'tEstablishHttpConnection ) $ browse $ do @@ -1121,12 +1079,7 @@ userAgent = statusParseFail :: Verbosity -> URI -> String -> IO a statusParseFail verbosity uri r = - die' verbosity $ - "Failed to download " - ++ show uri - ++ " : " - ++ "No Status Code could be parsed from response: " - ++ r + dieWithException verbosity $ StatusParseFail uri r ------------------------------------------------------------------------------ -- Multipart stuff partially taken from cgi package. diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index c1d6a7068ef..2dc7d37e29c 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -95,7 +95,6 @@ import Distribution.Simple.Program ) import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose - , die' , dieWithException , fromUTF8LBS , info @@ -213,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 @@ -319,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 @@ -382,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 @@ -440,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 @@ -469,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 " @@ -480,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 " @@ -853,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 @@ -943,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 @@ -960,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 @@ -1088,11 +1095,11 @@ 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 --- 'die's if it fails again). +-- 'dieWithException's if it fails again). readIndexCache :: Verbosity -> Index -> IO Cache readIndexCache verbosity index = do cacheOrFail <- readIndexCache' index @@ -1108,9 +1115,14 @@ readIndexCache verbosity index = do updatePackageIndexCacheFile verbosity index - either (die' verbosity) (return . hashConsCache) =<< readIndexCache' index + 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 @@ -1126,16 +1138,17 @@ readNoIndexCache verbosity index = do updatePackageIndexCacheFile verbosity index - either (die' verbosity) return =<< readNoIndexCache' index + either (dieWithException verbosity . CorruptedIndexCache) return =<< readNoIndexCache' index -- 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) @@ -1160,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) @@ -1260,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 @@ -1312,7 +1337,7 @@ preferredVersionKey = "pref-ver:" read00IndexCache :: BSS.ByteString -> Cache read00IndexCache bs = Cache - { cacheHeadTs = nullTimestamp + { cacheHeadTs = NoTimestamp , cacheEntries = mapMaybe read00IndexCacheEntry $ BSS.lines bs } @@ -1330,7 +1355,7 @@ read00IndexCacheEntry = \line -> ( CachePackageId (PackageIdentifier pkgname pkgver) blockno - nullTimestamp + NoTimestamp ) _ -> Nothing [key, typecodestr, blocknostr] | key == BSS.pack buildTreeRefKey -> @@ -1340,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/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs index 578faf5a16e..e1f855cdafe 100644 --- a/cabal-install/src/Distribution/Client/Install.hs +++ b/cabal-install/src/Distribution/Client/Install.hs @@ -225,7 +225,7 @@ import Distribution.Simple.Utils import Distribution.Simple.Utils as Utils ( debug , debugNoWrap - , die' + , dieWithException , info , notice , warn @@ -266,6 +266,7 @@ import Distribution.Version ) import qualified Data.ByteString as BS +import Distribution.Client.Errors -- TODO: @@ -342,7 +343,7 @@ install case planResult of Left message -> do reportPlanningFailure verbosity args installContext message - die'' message + die'' $ ReportPlanningFailure message Right installPlan -> processInstallPlan verbosity args installContext installPlan where @@ -362,7 +363,7 @@ install , benchmarkFlags ) - die'' = die' verbosity + die'' = dieWithException verbosity logMsg message rest = debugNoWrap verbosity message >> rest @@ -794,9 +795,7 @@ checkPrintPlan -- particular, if we can see that packages are likely to be broken, we even -- bail out (unless installation has been forced with --force-reinstalls). when containsReinstalls $ do - if breaksPkgs - then do - (if dryRun || overrideReinstall then warn else die') verbosity $ + let errorStr = unlines $ "The following packages are likely to be broken by the reinstalls:" : map (prettyShow . mungedId) newBrokenPkgs @@ -809,6 +808,12 @@ checkPrintPlan ++ "the plan contains dangerous reinstalls." ] else ["Use --force-reinstalls if you want to install anyway."] + if breaksPkgs + then do + ( if dryRun || overrideReinstall + then warn verbosity errorStr + else dieWithException verbosity $ BrokenException errorStr + ) else unless dryRun $ warn @@ -828,11 +833,8 @@ checkPrintPlan . filterM (fmap isNothing . checkFetched . srcpkgSource) $ pkgs unless (null notFetched) $ - die' verbosity $ - "Can't download packages in offline mode. " - ++ "Must download the following packages to proceed:\n" - ++ intercalate ", " (map prettyShow notFetched) - ++ "\nTry using 'cabal fetch'." + dieWithException verbosity $ + Can'tDownloadPackagesOffline (map prettyShow notFetched) where nothingToInstall = null (fst (InstallPlan.ready installPlan)) @@ -1346,11 +1348,9 @@ printBuildFailures verbosity buildOutcomes = ] of [] -> return () failed -> - die' verbosity . unlines $ - "Some packages failed to install:" - : [ prettyShow pkgid ++ printFailureReason reason - | (pkgid, reason) <- failed - ] + dieWithException verbosity $ + SomePackagesFailedToInstall $ + map (\(pkgid, reason) -> (prettyShow pkgid, printFailureReason reason)) failed where printFailureReason reason = case reason of GracefulFailure msg -> msg @@ -1760,8 +1760,8 @@ installLocalTarballPackage extractTarGzFile tmpDirPath relUnpackedPath tarballPath exists <- doesFileExist descFilePath unless exists $ - die' verbosity $ - "Package .cabal file not found: " ++ show descFilePath + dieWithException verbosity $ + PackageDotCabalFileNotFound descFilePath maybeRenameDistDir absUnpackedPath installPkg (Just absUnpackedPath) where @@ -2042,9 +2042,7 @@ installUnpackedPackage pkgConfParseFailed :: String -> IO a pkgConfParseFailed perror = - die' verbosity $ - "Couldn't parse the output of 'setup register --gen-pkg-config':" - ++ show perror + dieWithException verbosity $ PkgConfParsedFailed perror maybeLogPath :: IO (Maybe FilePath) maybeLogPath = diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 1a46893c9b8..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 @@ -267,6 +278,21 @@ import System.IO ) -- | Entry point +-- +-- This does three things. +-- +-- One, it initializes the program, providing support for termination +-- signals, preparing console linebuffering, and relaxing encoding errors. +-- +-- Two, it processes (via an IO action) response +-- files, calling 'expandResponse' in Cabal/Distribution.Compat.ResponseFile +-- +-- Note that here, it splits the arguments on a strict match to +-- "--", and won't parse response files after the split. +-- +-- Three, it calls the 'mainWorker', which calls the argument parser, +-- producing 'CommandParse' data, which mainWorker pattern-matches +-- into IO actions for execution. main :: [String] -> IO () main args = do installTerminationHandler @@ -279,6 +305,10 @@ main args = do -- when writing to stderr and stdout. relaxEncodingErrors stdout relaxEncodingErrors stderr + + -- Response files support. + -- See 'expandResponse' documentation in Cabal/Distribution.Compat.ResponseFile + -- for more information. let (args0, args1) = break (== "--") args mainWorker =<< (++ args1) <$> expandResponse args0 @@ -296,10 +326,17 @@ warnIfAssertionsAreEnabled = assertionsEnabledMsg = "Warning: this is a debug build of cabal-install with assertions enabled." +-- | Core worker, similar to 'defaultMainHelper' in Cabal/Distribution.Simple +-- +-- With an exception-handler @topHandler@, mainWorker calls commandsRun +-- to parse arguments, then pattern-matches the CommandParse data +-- 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 @@ -310,6 +347,7 @@ mainWorker args = do printVersion | fromFlagOrDefault False (globalNumericVersion globalFlags) -> printNumericVersion + CommandDelegate -> pure () CommandHelp help -> printCommandHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> do @@ -368,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 @@ -1320,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/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 diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index 450ac9d7a37..18ea8cf826c 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -170,6 +170,11 @@ import Distribution.Types.UnqualComponentName import Distribution.Solver.Types.OptionalStanza +import Control.Exception (assert) +import qualified Data.List.NonEmpty as NE +import qualified Data.Map as Map +import qualified Data.Set as Set +import Distribution.Client.Errors import Distribution.Package import Distribution.Simple.Command (commandShowOptions) import Distribution.Simple.Compiler @@ -193,7 +198,7 @@ import qualified Distribution.Simple.Setup as Setup import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose , debugNoWrap - , die' + , dieWithException , notice , noticeNoWrap , ordNub @@ -214,13 +219,9 @@ import Distribution.Verbosity import Distribution.Version ( mkVersion ) - -import Control.Exception (assert) -import qualified Data.List.NonEmpty as NE -import qualified Data.Map as Map -import qualified Data.Set as Set #ifdef MIN_VERSION_unix import System.Posix.Signals (sigKILL, sigSEGV) + #endif -- | Tracks what command is being executed, because we need to hide this somewhere @@ -1219,10 +1220,10 @@ dieOnBuildFailures verbosity currentCommand plan buildOutcomes ] dieIfNotHaddockFailure :: Verbosity -> String -> IO () - dieIfNotHaddockFailure - | currentCommand == HaddockCommand = die' - | all isHaddockFailure failuresClassification = warn - | otherwise = die' + dieIfNotHaddockFailure verb str + | currentCommand == HaddockCommand = dieWithException verb $ DieIfNotHaddockFailureException str + | all isHaddockFailure failuresClassification = warn verb str + | otherwise = dieWithException verb $ DieIfNotHaddockFailureException str where isHaddockFailure (_, ShowBuildSummaryOnly (HaddocksFailed _)) = True diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 1b92a8aa54b..3cb0d8033e8 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -190,6 +190,7 @@ import Data.List (deleteBy, groupBy) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as Set +import Distribution.Client.Errors import System.FilePath import Text.PrettyPrint (colon, comma, fsep, hang, punctuate, quotes, text, vcat, ($$)) import qualified Text.PrettyPrint as Disp @@ -748,7 +749,7 @@ rebuildInstallPlan case planOrError of Left msg -> do reportPlanningFailure projectConfig compiler platform localPackages - die' verbosity msg + dieWithException verbosity $ PhaseRunSolverErr msg Right plan -> return (plan, pkgConfigDB, tis, ar) where corePackageDbs :: [PackageDB] @@ -4283,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 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/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index f25ab462b53..eacf9cd5afe 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -129,7 +129,7 @@ import Distribution.Simple.Setup import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose , createTempDirectory - , die' + , dieWithException , handleDoesNotExist , readUTF8File , warn @@ -192,6 +192,7 @@ import Control.Exception import qualified Data.ByteString.Char8 as BS import Data.ByteString.Lazy () import qualified Data.Set as S +import Distribution.Client.Errors import System.Directory ( canonicalizePath , doesFileExist @@ -488,7 +489,7 @@ readScriptBlock verbosity = parseString parseScriptBlock verbosity "script block readExecutableBlockFromScript :: Verbosity -> BS.ByteString -> IO Executable readExecutableBlockFromScript verbosity str = do str' <- case extractScriptBlock "cabal" str of - Left e -> die' verbosity $ "Failed extracting script block: " ++ e + Left e -> dieWithException verbosity $ FailedExtractingScriptBlock e Right x -> return x when (BS.all isSpace str') $ warn verbosity "Empty script block" readScriptBlock verbosity str' 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-install/src/Distribution/Client/TargetSelector.hs b/cabal-install/src/Distribution/Client/TargetSelector.hs index 342a8f09d2e..d29413642de 100644 --- a/cabal-install/src/Distribution/Client/TargetSelector.hs +++ b/cabal-install/src/Distribution/Client/TargetSelector.hs @@ -97,27 +97,21 @@ import Distribution.Solver.Types.SourcePackage ) import Distribution.Types.ForeignLib -import Distribution.Client.Utils - ( makeRelativeCanonical - ) -import Distribution.Simple.Utils - ( die' - , lowercase - , ordNub - ) - import Control.Arrow ((&&&)) import Control.Monad hiding ( mfilter ) import Data.List - ( groupBy - , stripPrefix + ( stripPrefix ) import qualified Data.List.NonEmpty as NE import qualified Data.Map.Lazy as Map.Lazy import qualified Data.Map.Strict as Map import qualified Data.Set as Set +import Distribution.Client.Errors +import Distribution.Client.Utils + ( makeRelativeCanonical + ) import Distribution.Deprecated.ParseUtils ( readPToMaybe ) @@ -126,6 +120,11 @@ import Distribution.Deprecated.ReadP , (<++) ) import qualified Distribution.Deprecated.ReadP as Parse +import Distribution.Simple.Utils + ( dieWithException + , lowercase + , ordNub + ) import Distribution.Utils.Path import qualified System.Directory as IO ( canonicalizePath @@ -151,7 +150,6 @@ import Text.EditDistance ( defaultEditCosts , restrictedDamerauLevenshteinDistance ) - import qualified Prelude (foldr1) -- ------------------------------------------------------------ @@ -791,190 +789,78 @@ reportTargetSelectorProblems :: Verbosity -> [TargetSelectorProblem] -> IO a reportTargetSelectorProblems verbosity problems = do case [str | TargetSelectorUnrecognised str <- problems] of [] -> return () - targets -> - die' verbosity $ - unlines - [ "Unrecognised target syntax for '" ++ name ++ "'." - | name <- targets - ] + targets -> dieWithException verbosity $ ReportTargetSelectorProblems targets case [(t, m, ms) | MatchingInternalError t m ms <- problems] of [] -> return () ((target, originalMatch, renderingsAndMatches) : _) -> - die' verbosity $ - "Internal error in target matching: could not make an " - ++ "unambiguous fully qualified target selector for '" - ++ showTargetString target - ++ "'.\n" - ++ "We made the target '" - ++ showTargetSelector originalMatch - ++ "' (" - ++ showTargetSelectorKind originalMatch - ++ ") that was expected to " - ++ "be unambiguous but matches the following targets:\n" - ++ unlines - [ "'" - ++ showTargetString rendering - ++ "', matching:" - ++ concatMap - ("\n - " ++) - [ showTargetSelector match - ++ " (" - ++ showTargetSelectorKind match - ++ ")" - | match <- matches - ] - | (rendering, matches) <- renderingsAndMatches - ] - ++ "\nNote: Cabal expects to be able to make a single fully " - ++ "qualified name for a target or provide a more specific error. " - ++ "Our failure to do so is a bug in cabal. " - ++ "Tracking issue: https://github.com/haskell/cabal/issues/8684" - ++ "\n\nHint: this may be caused by trying to build a package that " - ++ "exists in the project directory but is missing from " - ++ "the 'packages' stanza in your cabal project file." + dieWithException verbosity + $ MatchingInternalErrorErr + (showTargetString target) + (showTargetSelector originalMatch) + (showTargetSelectorKind originalMatch) + $ map + ( \(rendering, matches) -> + ( showTargetString rendering + , (map (\match -> showTargetSelector match ++ " (" ++ showTargetSelectorKind match ++ ")") matches) + ) + ) + renderingsAndMatches case [(t, e, g) | TargetSelectorExpected t e g <- problems] of [] -> return () targets -> - die' verbosity $ - unlines - [ "Unrecognised target '" - ++ showTargetString target - ++ "'.\n" - ++ "Expected a " - ++ intercalate " or " expected - ++ ", rather than '" - ++ got - ++ "'." - | (target, expected, got) <- targets - ] + dieWithException verbosity $ + UnrecognisedTarget $ + map (\(target, expected, got) -> (showTargetString target, expected, got)) targets case [(t, e) | TargetSelectorNoSuch t e <- problems] of [] -> return () targets -> - die' verbosity $ - unlines - [ "Unknown target '" - ++ showTargetString target - ++ "'.\n" - ++ unlines - [ ( case inside of - Just (kind, "") -> - "The " ++ kind ++ " has no " - Just (kind, thing) -> - "The " ++ kind ++ " " ++ thing ++ " has no " - Nothing -> "There is no " - ) - ++ intercalate - " or " - [ mungeThing thing ++ " '" ++ got ++ "'" - | (thing, got, _alts) <- nosuch' - ] - ++ "." - ++ if null alternatives - then "" - else - "\nPerhaps you meant " - ++ intercalate - ";\nor " - [ "the " ++ thing ++ " '" ++ intercalate "' or '" alts ++ "'?" - | (thing, alts) <- alternatives - ] - | (inside, nosuch') <- groupByContainer nosuch - , let alternatives = - [ (thing, alts) - | (thing, _got, alts@(_ : _)) <- nosuch' - ] - ] - | (target, nosuch) <- targets - , let groupByContainer = - map - ( \g@((inside, _, _, _) : _) -> - ( inside - , [ (thing, got, alts) - | (_, thing, got, alts) <- g - ] - ) - ) - . groupBy ((==) `on` (\(x, _, _, _) -> x)) - . sortBy (compare `on` (\(x, _, _, _) -> x)) - ] - where - mungeThing "file" = "file target" - mungeThing thing = thing + dieWithException verbosity $ + NoSuchTargetSelectorErr $ + map (\(target, nosuch) -> (showTargetString target, nosuch)) targets case [(t, ts) | TargetSelectorAmbiguous t ts <- problems] of [] -> return () targets -> - die' verbosity $ - unlines - [ "Ambiguous target '" - ++ showTargetString target - ++ "'. It could be:\n " - ++ unlines - [ " " - ++ showTargetString ut - ++ " (" - ++ showTargetSelectorKind bt - ++ ")" - | (ut, bt) <- amb - ] - | (target, amb) <- targets - ] + dieWithException verbosity $ + TargetSelectorAmbiguousErr $ + map + ( \(target, amb) -> + ( showTargetString target + , (map (\(ut, bt) -> (showTargetString ut, showTargetSelectorKind bt)) amb) + ) + ) + targets case [t | TargetSelectorNoCurrentPackage t <- problems] of [] -> return () target : _ -> - die' verbosity $ - "The target '" - ++ showTargetString target - ++ "' refers to the " - ++ "components in the package in the current directory, but there " - ++ "is no package in the current directory (or at least not listed " - ++ "as part of the project)." + dieWithException verbosity $ TargetSelectorNoCurrentPackageErr (showTargetString target) + -- TODO: report a different error if there is a .cabal file but it's -- not a member of the project case [() | TargetSelectorNoTargetsInCwd True <- problems] of [] -> return () _ : _ -> - die' verbosity $ - "No targets given and there is no package in the current " - ++ "directory. Use the target 'all' for all packages in the " - ++ "project or specify packages or components by name or location. " - ++ "See 'cabal build --help' for more details on target options." + dieWithException verbosity TargetSelectorNoTargetsInCwdTrue case [() | TargetSelectorNoTargetsInCwd False <- problems] of [] -> return () _ : _ -> - die' verbosity $ - "No targets given and there is no package in the current " - ++ "directory. Specify packages or components by name or location. " - ++ "See 'cabal build --help' for more details on target options." + dieWithException verbosity TargetSelectorNoTargetsInCwdFalse case [() | TargetSelectorNoTargetsInProject <- problems] of [] -> return () _ : _ -> - die' verbosity $ - "There is no .cabal package file or cabal.project file. " - ++ "To build packages locally you need at minimum a .cabal " - ++ "file. You can use 'cabal init' to create one.\n" - ++ "\n" - ++ "For non-trivial projects you will also want a cabal.project " - ++ "file in the root directory of your project. This file lists the " - ++ "packages in your project and all other build configuration. " - ++ "See the Cabal user guide for full details." + dieWithException verbosity TargetSelectorNoTargetsInProjectErr case [t | TargetSelectorNoScript t <- problems] of [] -> return () target : _ -> - die' verbosity $ - "The script '" - ++ showTargetString target - ++ "' does not exist, " - ++ "and only script targets may contain whitespace characters or end " - ++ "with ':'" + dieWithException verbosity $ TargetSelectorNoScriptErr (showTargetString target) fail "reportTargetSelectorProblems: internal error" diff --git a/cabal-install/src/Distribution/Client/Utils.hs b/cabal-install/src/Distribution/Client/Utils.hs index 6a744fca3be..59158ffd2a5 100644 --- a/cabal-install/src/Distribution/Client/Utils.hs +++ b/cabal-install/src/Distribution/Client/Utils.hs @@ -68,7 +68,7 @@ import Data.List import Distribution.Compat.Environment import Distribution.Compat.Time (getModTime) import Distribution.Simple.Setup (Flag (..)) -import Distribution.Simple.Utils (die', findPackageDesc, noticeNoWrap) +import Distribution.Simple.Utils (dieWithException, findPackageDesc, noticeNoWrap) import Distribution.System (OS (..), Platform (..)) import Distribution.Version import System.Directory @@ -109,6 +109,7 @@ import qualified System.Directory as Dir import qualified System.IO.Error as IOError #endif import qualified Data.Set as Set +import Distribution.Client.Errors -- | Generic merging utility. For sorted input lists this is a full outer join. mergeBy :: forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b] @@ -394,7 +395,7 @@ tryFindPackageDesc verbosity depPath err = do errOrCabalFile <- findPackageDesc depPath case errOrCabalFile of Right file -> return file - Left _ -> die' verbosity err + Left _ -> dieWithException verbosity $ TryFindPackageDescErr err findOpenProgramLocation :: Platform -> IO (Either String FilePath) findOpenProgramLocation (Platform _ os) = 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 diff --git a/cabal-install/src/Distribution/Client/Win32SelfUpgrade.hs b/cabal-install/src/Distribution/Client/Win32SelfUpgrade.hs index 516cbdb63b3..3e7ceefac63 100644 --- a/cabal-install/src/Distribution/Client/Win32SelfUpgrade.hs +++ b/cabal-install/src/Distribution/Client/Win32SelfUpgrade.hs @@ -218,7 +218,8 @@ setEvent handle = #else -import Distribution.Simple.Utils (die') +import Distribution.Simple.Utils (dieWithException) +import Distribution.Client.Errors possibleSelfUpgrade :: Verbosity -> [FilePath] @@ -226,7 +227,7 @@ possibleSelfUpgrade :: Verbosity possibleSelfUpgrade _ _ action = action deleteOldExeFile :: Verbosity -> Int -> FilePath -> IO () -deleteOldExeFile verbosity _ _ = die' verbosity "win32selfupgrade not needed except on win32" +deleteOldExeFile verbosity _ _ = dieWithException verbosity Win32SelfUpgradeNotNeeded #endif {- FOURMOLU_ENABLE -} 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-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/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 diff --git a/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.out b/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.out index 34cd406b7e1..a1636d8cbff 100644 --- a/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.out +++ b/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.out @@ -12,7 +12,8 @@ Building executable 'my-exe' for pkg-1.0... local pkg-1.0 # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] next goal: pkg (user goal) [__0] rejecting: pkg-2.0 (constraint from user target requires ==1.0) [__0] rejecting: pkg-1.0 (constraint from command line flag requires ==2.0) diff --git a/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.out b/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.out index 2f2efe78a01..482ff118031 100644 --- a/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.out +++ b/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.out @@ -2,7 +2,8 @@ Downloading the latest package list from test-local-repo # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] trying: pkg-1.0 (user goal) [__1] next goal: setup-dep (user goal) [__1] rejecting: setup-dep-2.0 (conflict: pkg => setup-dep>=1 && <2) 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/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/cabal-testsuite/PackageTests/CustomSegfault/cabal.out b/cabal-testsuite/PackageTests/CustomSegfault/cabal.out index 14a01a7e1ea..80f27e69b58 100644 --- a/cabal-testsuite/PackageTests/CustomSegfault/cabal.out +++ b/cabal-testsuite/PackageTests/CustomSegfault/cabal.out @@ -3,4 +3,5 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - plain-0.1.0.0 (lib:plain) (first run) -Error: cabal: Failed to build plain-0.1.0.0-inplace. The failure occurred during the configure step. The build process segfaulted (i.e. SIGSEGV). +Error: [Cabal-7125] +Failed to build plain-0.1.0.0-inplace. The failure occurred during the configure step. The build process segfaulted (i.e. SIGSEGV). diff --git a/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.out b/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.out index 76b53a86051..74d7f6adf31 100644 --- a/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.out +++ b/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.out @@ -3,4 +3,5 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - custom-setup-without-cabal-1.0 (lib:custom-setup-without-cabal) (first run) -Error: cabal: Failed to build custom-setup-without-cabal-1.0-inplace. The failure occurred during the configure step. +Error: [Cabal-7125] +Failed to build custom-setup-without-cabal-1.0-inplace. The failure occurred during the configure step. diff --git a/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.out b/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.out index 047919ab3c0..0e26184375c 100644 --- a/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.out +++ b/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.out @@ -3,4 +3,5 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - custom-setup-without-cabal-defaultMain-1.0 (lib:custom-setup-without-cabal-defaultMain) (first run) -Error: cabal: Failed to build custom-setup-without-cabal-defaultMain-1.0-inplace. The failure occurred during the configure step. +Error: [Cabal-7125] +Failed to build custom-setup-without-cabal-defaultMain-1.0-inplace. The failure occurred during the configure step. diff --git a/cabal-testsuite/PackageTests/ExtraProgPath/setup.out b/cabal-testsuite/PackageTests/ExtraProgPath/setup.out index b0edde0184f..ea86cfd0f9d 100644 --- a/cabal-testsuite/PackageTests/ExtraProgPath/setup.out +++ b/cabal-testsuite/PackageTests/ExtraProgPath/setup.out @@ -4,7 +4,8 @@ Warning: cannot determine version of /./pkg-config : Warning: cannot determine version of /./pkg-config : "" Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] next goal: CheckExtraProgPath (user goal) [__0] rejecting: CheckExtraProgPath-0.1 (conflict: pkg-config package zlib-any, not found in the pkg-config database) [__0] fail (backjumping, conflict set: CheckExtraProgPath) 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 [] 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/LinkerOptions/NonignoredConfigs/cabal.out b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out index 242bb523282..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,6 +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... @@ -18,9 +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 9da924366f4..899bb03b430 100644 --- a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs +++ b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs @@ -70,7 +70,14 @@ 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"] + 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) diff --git a/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.out b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.out index 9ad696f6e06..f2253c67190 100644 --- a/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.out +++ b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.out @@ -2,7 +2,8 @@ Downloading the latest package list from test-local-repo # cabal v2-repl Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] trying: pkg-a-0 (user goal) [__1] next goal: pkg-a:setup.Cabal (dependency of pkg-a) [__1] rejecting: pkg-a:setup.Cabal-/installed-, pkg-a:setup.Cabal-3.8.0.0 (constraint from --enable-multi-repl requires >=3.11) diff --git a/cabal-testsuite/PackageTests/MultipleLibraries/Failing/cabal.out b/cabal-testsuite/PackageTests/MultipleLibraries/Failing/cabal.out index 70a8f67c60c..5dee45c63bd 100644 --- a/cabal-testsuite/PackageTests/MultipleLibraries/Failing/cabal.out +++ b/cabal-testsuite/PackageTests/MultipleLibraries/Failing/cabal.out @@ -1,6 +1,7 @@ # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] trying: d-0.1.0.0 (user goal) [__1] next goal: p (user goal) [__1] rejecting: p-0.1.0.0 (requires library 'privatelib' from d, but the component is private) diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.out index ea267330ab0..7f851dca6a8 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.out @@ -22,18 +22,21 @@ Configuring executable 'foo-exe' for bar-1.0... Preprocessing executable 'foo-exe' for bar-1.0... Building executable 'foo-exe' for bar-1.0... # cabal v2-run -Error: cabal: No targets given and there is no package in the current directory. Specify packages or components by name or location. See 'cabal build --help' for more details on target options. +Error: [Cabal-7135] +No targets given and there is no package in the current directory. Specify packages or components by name or location. See 'cabal build --help' for more details on target options. # cabal v2-run Error: [Cabal-7070] The run command is for running a single executable at once. The target 'bar' refers to the package bar-1.0 which includes - executables: bar-exe and foo-exe # cabal v2-run -Error: cabal: Ambiguous target 'foo-exe'. It could be: +Error: [Cabal-7132] +Ambiguous target 'foo-exe'. It could be: bar:foo-exe (component) foo:foo-exe (component) # cabal v2-run -Error: cabal: Unknown target 'foo:bar-exe'. +Error: [Cabal-7131] +Unknown target 'foo:bar-exe'. The package foo has no component 'bar-exe'. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.out index a86629db957..be36f8398e0 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.out @@ -1,2 +1,3 @@ # cabal v2-run -Error: cabal: Failed extracting script block: `{- cabal:` start marker not found +Error: [Cabal-7121] +Failed extracting script block: `{- cabal:` start marker not found diff --git a/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.out b/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.out index 4d477d75ead..93f0fd7f938 100644 --- a/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.out @@ -6,7 +6,8 @@ In order, the following will be built: Configuring executable 'q' for q-0.1.0.0... Preprocessing executable 'q' for q-0.1.0.0... Building executable 'q' for q-0.1.0.0... -Error: cabal: Failed to build q-0.1.0.0-inplace-q. +Error: [Cabal-7125] +Failed to build q-0.1.0.0-inplace-q. # cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 diff --git a/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.out b/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.out index d7eab819ced..bb8adff32b7 100644 --- a/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.out @@ -1,6 +1,7 @@ # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] trying: p-1.0 (user goal) [__1] next goal: q (user goal) [__1] rejecting: q-1.0 (requires library from p, but the component is not buildable in the current environment) diff --git a/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out b/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out index 85f6c8b8d46..b1bcf12d3fa 100644 --- a/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out +++ b/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out @@ -6,11 +6,13 @@ In order, the following will be built: Configuring library for example-1.0... Preprocessing library for example-1.0... Building library for example-1.0... -Error: cabal: Failed to build example-1.0-inplace. +Error: [Cabal-7125] +Failed to build example-1.0-inplace. # cabal v2-haddock Build profile: -w ghc- -O1 In order, the following will be built: - example-1.0 (lib) (first run) Preprocessing library for example-1.0... Running Haddock on library for example-1.0... -Error: cabal: Failed to build documentation for example-1.0-inplace. +Error: [Cabal-7125] +Failed to build documentation for example-1.0-inplace. diff --git a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.out b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.out index ba0ecc3744a..83628c9a8e2 100644 --- a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.out +++ b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.out @@ -1,2 +1,3 @@ # cabal v2-sdist -Error: cabal: It is not possible to package only the test suites from a package for distribution. Only entire packages may be packaged for distribution. +Error: [Cabal-7151] +It is not possible to package only the test suites from a package for distribution. Only entire packages may be packaged for distribution. diff --git a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.out b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.out index 9efe2ff9aa7..e8bc3312c87 100644 --- a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.out +++ b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.out @@ -1,2 +1,3 @@ # cabal v2-sdist -Error: cabal: Can't write multiple tarballs to standard output! +Error: [Cabal-7152] +Can't write multiple tarballs to standard output! diff --git a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.out b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.out index 0be39008046..386eaff9b13 100644 --- a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.out +++ b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.out @@ -1,2 +1,3 @@ # cabal v2-sdist -Error: cabal: The package base cannot be packaged for distribution, because it is not local to this project. +Error: [Cabal-7151] +The package base cannot be packaged for distribution, because it is not local to this project. diff --git a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.out b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.out index 84893e64795..6c1e881f806 100644 --- a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.out +++ b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.out @@ -1,2 +1,3 @@ # cabal v2-sdist -Error: cabal: The component test suite 'a-tests' cannot be packaged for distribution on its own. Only entire packages may be packaged for distribution. +Error: [Cabal-7151] +The component test suite 'a-tests' cannot be packaged for distribution on its own. Only entire packages may be packaged for distribution. 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/cabal-testsuite/PackageTests/OfflineFlag/offlineFlag.out b/cabal-testsuite/PackageTests/OfflineFlag/offlineFlag.out index 63fafdab661..a7b18a253a6 100644 --- a/cabal-testsuite/PackageTests/OfflineFlag/offlineFlag.out +++ b/cabal-testsuite/PackageTests/OfflineFlag/offlineFlag.out @@ -6,7 +6,8 @@ Build profile: -w ghc- -O1 In order, the following will be built: - remote-0.1.0.0 (lib) (requires build) - current-0.1.0.0 (exe:current) (first run) -Error: cabal: --offline was specified, hence refusing to download the package: remote version 0.1.0.0. +Error: [Cabal-7125] +--offline was specified, hence refusing to download the package: remote version 0.1.0.0. # cabal v2-build Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-base.out b/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-base.out index 933a6476350..506ac48f14e 100644 --- a/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-base.out +++ b/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-base.out @@ -9,7 +9,8 @@ Installing library in Registering library for p-1.0... # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] trying: q-1.0 (user goal) [__1] unknown package: base (dependency of q) [__1] fail (backjumping, conflict set: base, q) diff --git a/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-p.out b/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-p.out index 93d0d0c3f8c..2235fc32f50 100644 --- a/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-p.out +++ b/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-p.out @@ -9,7 +9,8 @@ Installing library in Registering library for p-1.0... # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] trying: q-1.0 (user goal) [__1] unknown package: p (dependency of q) [__1] fail (backjumping, conflict set: p, q) 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/PackageTests/Regression/T6961/DepInternal/cabal.out b/cabal-testsuite/PackageTests/Regression/T6961/DepInternal/cabal.out index 9e4c288b45e..cda3c265371 100644 --- a/cabal-testsuite/PackageTests/Regression/T6961/DepInternal/cabal.out +++ b/cabal-testsuite/PackageTests/Regression/T6961/DepInternal/cabal.out @@ -1,6 +1,7 @@ # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] trying: pkg-bar-0 (user goal) [__1] next goal: pkg-foo (user goal) [__1] rejecting: pkg-foo-0 (library 'internal-lib' is private, but it is required by pkg-bar) diff --git a/cabal-testsuite/PackageTests/Regression/T7234/Fail/cabal.out b/cabal-testsuite/PackageTests/Regression/T7234/Fail/cabal.out index 4ae907f41f3..5c8ed7ba2c5 100644 --- a/cabal-testsuite/PackageTests/Regression/T7234/Fail/cabal.out +++ b/cabal-testsuite/PackageTests/Regression/T7234/Fail/cabal.out @@ -1,6 +1,7 @@ # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] next goal: issue7234 (user goal) [__0] rejecting: issue7234-0 (conflict: requires unknown extension HopefullyThisExtensionWontOccur) [__0] fail (backjumping, conflict set: issue7234) diff --git a/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags-negative.out b/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags-negative.out index 667ffe5ae2f..ba1bbef88db 100644 --- a/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags-negative.out +++ b/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags-negative.out @@ -6,4 +6,5 @@ In order, the following will be built: - cabal-repl-options-0.1 (interactive) (lib) (first run) Configuring library for cabal-repl-options-0.1... Preprocessing library for cabal-repl-options-0.1... -Error: cabal: repl failed for cabal-repl-options-0.1-inplace. +Error: [Cabal-7125] +repl failed for cabal-repl-options-0.1-inplace. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/CompileFail/compile-fail.out b/cabal-testsuite/PackageTests/ShowBuildInfo/CompileFail/compile-fail.out index 5017f4b5c09..b0cae576cd6 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/CompileFail/compile-fail.out +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/CompileFail/compile-fail.out @@ -10,7 +10,8 @@ Building library for CompileFail-0.1.0.0... Configuring test suite 'CompileFail-test' for CompileFail-0.1.0.0... Preprocessing test suite 'CompileFail-test' for CompileFail-0.1.0.0... Building test suite 'CompileFail-test' for CompileFail-0.1.0.0... -Error: cabal: Failed to build CompileFail-0.1.0.0-inplace-CompileFail-test. +Error: [Cabal-7125] +Failed to build CompileFail-0.1.0.0-inplace-CompileFail-test. # cabal build Build profile: -w ghc- -O1 In order, the following will be built: @@ -19,5 +20,6 @@ In order, the following will be built: Configuring library 'failing' for CompileFail-0.1.0.0... Preprocessing library 'failing' for CompileFail-0.1.0.0... Building library 'failing' for CompileFail-0.1.0.0... -Error: cabal: Failed to build CompileFail-0.1.0.0 because it depends on CompileFail-0.1.0.0 which itself failed to build. +Error: [Cabal-7125] +Failed to build CompileFail-0.1.0.0 because it depends on CompileFail-0.1.0.0 which itself failed to build. Failed to build CompileFail-0.1.0.0-inplace-failing. diff --git a/cabal-testsuite/README.md b/cabal-testsuite/README.md index e206530d0fb..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 @@ -226,8 +235,8 @@ technical innovations to make this work: to these scripts. * The startup latency of `runghc` can be quite high, which adds up - when you have many tests. To solve this, in `Test.Cabal.Server` - we have an implementation an GHCi server, for which we can reuse + when you have many tests. To solve this, our `Test.Cabal.Server` + GHCi server implementation can reuse a GHCi instance as we are running test scripts. It took some technical ingenuity to implement this, but the result is that running scripts is essentially free. 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 125ba5ecd55..55aa7921b52 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) @@ -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 @@ -110,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/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/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 () 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 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. + +} 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/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/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 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. + +} 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 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. + +} 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 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/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-commands.rst b/doc/cabal-commands.rst index 88803232bf6..5419186f73c 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 @@ -1148,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 ^^^^^^^^^^^ 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 95% rename from doc/cabal-package.rst rename to doc/cabal-package-description-file.rst index 9b0e970dbd7..ae07f3ff3bc 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: @@ -184,7 +186,7 @@ Example: A package containing a library and executable programs executable program2 -- A different main.hs because of hs-source-dirs. main-is: main.hs - -- No bound on internal libraries. + -- No bound on a library provided by the same package. build-depends: TestPackage hs-source-dirs: prog2 other-modules: Utils @@ -806,7 +808,7 @@ Library Starting with Cabal 2.0, sub-library components can be defined by setting the ``name`` field to a name different from the current package's name; see - section on :ref:`Internal Libraries ` for more information. By + section on :ref:`Sublibraries ` for more information. By default, these sub-libraries are private and internal. Since Cabal 3.0, these sub-libraries can also be exposed and used by other packages. See the :pkg-field:`library:visibility` field and :ref:`Multiple Public Libraries @@ -852,7 +854,7 @@ The library section should contain the following fields: :since: 3.0 :default: - ``private`` for internal libraries. Cannot be set for main + ``private`` for sublibraries. Cannot be set for main (unnamed) library, which is always public. Can be ``public`` or ``private``. @@ -861,7 +863,7 @@ The library section should contain the following fields: allowed. If set to ``private``, depending on this library is allowed only from the same package. - See section on :ref:`Internal Libraries ` for examples and more + See section on :ref:`Sublibraries ` for examples and more information. .. pkg-field:: reexported-modules: exportlist @@ -888,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 @@ -903,13 +905,13 @@ section on `build information`_). .. _sublibs: -**Internal Libraries** +**Sublibraries** -Cabal 2.0 and later support "internal libraries", which are extra named +Cabal 2.0 and later support "sublibraries", which are extra named libraries (as opposed to the usual unnamed library section). For example, suppose that your test suite needs access to some internal modules in your library, which you do not otherwise want to export. You -could put these modules in an internal library, which the main library +could put these modules in a sublibrary, which the main library and the test suite :pkg-field:`build-depends` upon. Then your Cabal file might look something like this: @@ -942,11 +944,11 @@ look something like this: build-depends: foo-internal, base default-language: Haskell2010 -Internal libraries are also useful for packages that define multiple +Sublibraries are also useful for packages that define multiple executables, but do not define a publicly accessible library. Internal libraries are only visible internally in the package (so they can only be added to the :pkg-field:`build-depends` of same-package libraries, -executables, test suites, etc.) Internal libraries locally shadow any +executables, test suites, etc.) Sublibraries locally shadow any packages which have the same name; consequently, don't name an internal library with the same name as an external dependency if you need to be able to refer to the external dependency in a @@ -1003,7 +1005,7 @@ a real-world use case: .. note:: For packages using ``cabal-version: 3.4`` or higher, the syntax to - specify an internal library in a ``build-depends:`` section is + specify a sublibrary in a ``build-depends:`` section is ``package-name:internal-library-name``. .. _publicsublibs: @@ -1477,8 +1479,29 @@ 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 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 + 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)``. + + 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: :: @@ -2209,7 +2232,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 @@ -2222,7 +2245,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 @@ -2921,16 +2944,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: @@ -3303,123 +3316,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:`Internal Libraries ` 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:`Internal Libraries ` 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/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 90f819a529c..baac75e06f9 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 @@ -448,8 +448,17 @@ The following settings control the behavior of the dependency solver: :: - constraints: bar == 2.1, - bar +foo -baz + constraints: + bar == 2.1 + , bar +foo -baz + + This is equivalent to writing constraints and :cfg-field:`flags` separately: + + :: + + constraints: bar == 2.1 + package bar + flags: +foo -baz Valid constraints take the same form as for the :option:`runhaskell Setup.hs configure --constraint` @@ -754,8 +763,6 @@ feature was added. local packages support the same named flags. If a flag is not supported by a package, it is ignored. - See also the solver configuration field :cfg-field:`constraints`. - The command line variant of this flag is ``--flags``. There is also a shortened form ``-ffoo -f-bar``. @@ -763,7 +770,8 @@ feature was added. ``hans`` is a flag for a transitive dependency that is not in the local package; in this case, the flag will be silently ignored. If ``haskell-tor`` is the package you want this flag to apply to, try - ``--constraint="haskell-tor +hans"`` instead. + ``--constraint="haskell-tor +hans"`` instead. Flags can be specified as + package :cfg-field:`constraints`. .. cfg-field:: with-compiler: PATH -w PATH or -wPATH, --with-compiler=PATH 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/conf.py b/doc/conf.py index 51ab333f80e..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 = { @@ -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 --------------------------------------------- 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 ------------------------ 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/file-format-changelog.rst b/doc/file-format-changelog.rst index 4aba3ce6dcd..c3d9aa2dfc8 100644 --- a/doc/file-format-changelog.rst +++ b/doc/file-format-changelog.rst @@ -72,8 +72,8 @@ relative to the respective preceding *published* version. * Dependencies to sublibraries must be specified explicitly, even for current package. - For example: ``build-depends: mypackage:internal-lib`` - This way you can have an internal library with the same + For example: ``build-depends: mypackage:my-sublib`` + This way you can have a sublibrary with the same name as some external dependency. * Remove ``-any`` and ``-none`` syntax for version ranges @@ -218,7 +218,7 @@ relative to the respective preceding *published* version. * Add support for new :pkg-section:`foreign-library` stanza. -* Add support for :ref:`internal library stanzas `. +* Add support for :ref:`sublibrary stanzas `. * New CPP Macro ``CURRENT_PACKAGE_VERSION``. diff --git a/doc/getting-started.rst b/doc/getting-started.rst index 416a5dd77ae..39a095a7453 100644 --- a/doc/getting-started.rst +++ b/doc/getting-started.rst @@ -1,90 +1,104 @@ -Getting Started with Haskell and Cabal -====================================== +Getting Started +=============== -Installing the Haskell toolchain --------------------------------- - -To install the Haskell toolchain follow the `ghcup instructions -`__. +Installing Cabal +---------------- +The easiest and recommended way to install the ``cabal`` command-line tool +on Linux, macOS, FreeBSD or Windows is through `ghcup `__. +It installs the “Haskell toolchain”, which includes Cabal, +the Haskell compiler `GHC `__ +and optionally other useful Haskell tools. Creating a new application -------------------------- -Let's start by creating a simple Haskell application from scratch where we'll -learn about a Haskell package's directory structure, how to run the executable, -and how to add external dependencies. +We create a minimal Haskell application to get a quick overview +of the ``cabal`` command-line tool: +1. How to initialize a Haskell package. +2. How files are organized inside a package. +3. How to compile Haskell files and run a resulting executable. +4. How to manage external dependencies. -Initializing the application -^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Initializing an application +^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Start by initialising our ``myfirstapp`` project, these instructions work in -unix shells and PowerShell (if you're on Windows). +To initialize a new Haskell application, run .. code-block:: console - $ cabal init myfirstapp -n - -.. note:: ``myfirstapp`` stands for the directory (or path) where the project - will reside in, if omitted, ``cabal init`` will do its proceedings - in the directory it's called in. + $ cabal init myapp --non-interactive -.. note:: ``-n`` stands for ``--non-interactive``, which means that cabal will try to guess - how to set up the project for you and use the default settings, which will serve us - well for the purpose of this tutorial. - When setting up your projects in the future, you will likely want to omit ``-n`` - and do just ``cabal init``, so that cabal will interactively ask you - for the details on how the project should be set up - (while still offering reasonable defaults on every step). - Also, you can run ``cabal init --help`` to get more info on how ``cabal init`` can be used. - -This will generate the following files: +in a terminal. This generates the following files in a new ``myapp`` directory: .. code-block:: console $ tree . - └── myfirstapp + └── myapp ├── app │   └── Main.hs ├── CHANGELOG.md - └── myfirstapp.cabal + └── myapp.cabal -``app/Main.hs`` is where your package's code lives. +The ``myapp.cabal`` file is a package description file, commonly referred to as a “Cabal file”: -``myfirstapp.cabal`` is Cabal's metadata file which describes your package, -how it is built and its dependencies. We'll be updating this file in a -little bit when we add an external dependency to our package. +.. code-block:: cabal + cabal-version: 3.0 + name: myapp + version: 0.1.0.0 + -- ... -Running the application -^^^^^^^^^^^^^^^^^^^^^^^ + executable myapp + import: warnings + main-is: Main.hs + build-depends: base ^>=4.19.0.0 + hs-source-dirs: app + default-language: Haskell2010 -When we ran ``cabal init myfirstapp -n`` above, it generated a package with a single -executable named same as the package (in this case ``myfirstapp``) that prints -``"Hello, Haskell!"`` to the terminal. To run the executable enter the project's -directory and run it, by inputting the following commands: +It contains metadata (package name and version, author name, license, etc.) and sections +to define package components. Components can be used to split large codebases into smaller, +more managable building blocks. +A component can be of one of several types (executable, library, etc.) and describes, +among other things, the location of source files and its dependencies. +The ``myapp.cabal`` file above defines a single component named ``myapp`` of the executable type. +Inside the ``executable`` section, the ``build-depends`` field lists the dependencies of this component. -.. code-block:: console - cd myfirstapp - cabal run myfirstapp +The ``app/Main.hs`` file is where your executable's code lives: + +.. code-block:: haskell -You should see the following output in the terminal: + module Main where + + main :: IO () + main = putStrLn "Hello, Haskell!" + + +To run the executable, switch into the application directory with ``cd myapp`` and run .. code-block:: console - $ cabal run myfirstapp + $ cabal run myapp ... Hello, Haskell! -Notice that we didn't need to run a `build` command before we ran ``cabal run``. -This is because ``cabal run`` automatically determines if the code needs to be (re)built -before running the executable. -If you just want to build a target without running it, you can do so with ``cabal build``: +This command automatically determines if the executable needs to be (re)built +before running the executable. With only one executable component in the package, +``cabal run`` (without a component name) is smart enough to infer it, so the name can be omitted. + +If you just want to build the executable without running it, run: + +.. code-block:: console -``cabal build myfirstapp`` + $ cabal build + Resolving dependencies... + ... + Building executable 'myapp' for myapp-0.1.0.0.. + [1 of 1] Compiling Main ( app/Main.hs, /home/.../myapp/dist-newstyle/build/.../myapp-tmp/Main.o ) + Linking /home/.../myapp/dist-newstyle/build/.../myapp Adding dependencies @@ -103,16 +117,16 @@ terminal with some embellishment. need to update the package index, you can do this by running ``cabal update``. -In our ``myfirstapp.cabal`` file we'll update the ``build-depends`` attribute of -the ``executable myfirstapp`` section to include ``haskell-say``: +In our ``myapp.cabal`` file, we will update the ``build-depends`` field of +the executable section to include ``haskell-say``: .. code-block:: cabal - executable myfirstapp + executable myapp import: warnings main-is: Main.hs build-depends: - base ^>=4.14.3.0, + base ^>=4.19.0.0, haskell-say ^>=1.0.0.0 hs-source-dirs: app default-language: Haskell2010 @@ -132,8 +146,7 @@ Next we'll update ``app/Main.hs`` to use the ``HaskellSay`` library: import HaskellSay (haskellSay) main :: IO () - main = - haskellSay "Hello, Haskell! You're using a function from another package!" + main = haskellSay "Hello, Haskell!" ``import HaskellSay (haskellSay)`` brings the ``haskellSay`` function from the module named ``HaskellSay`` into scope. The ``HaskellSay`` module is defined in @@ -143,11 +156,10 @@ Now you can build and re-run your code to see the new output: .. code-block:: console - $ cabal run + $ cabal run myapp ________________________________________________________ / \ - | Hello, Haskell! You're using a function from another | - | package! | + | Hello, Haskell! | \____ _____________________________________________/ \ / \ / @@ -166,42 +178,47 @@ Now you can build and re-run your code to see the new output: / / / / \ \ /____/ /____/ \____\ -Run a single-file Haskell script --------------------------------- +Running a single-file Haskell script +------------------------------------ -Cabal also enables us to run single-file Haskell scripts -without creating a project directory or ``.cabal`` file. -The cabal directives are placed in the file within a comment. +Cabal also supports running single-file Haskell scripts like +the following file named ``myscript``: .. code-block:: haskell - + #!/usr/bin/env cabal {- cabal: - build-depends: base, split + build-depends: + base ^>=4.19.0.0, + haskell-say ^>=1.0.0.0 -} - import Data.List.Split (chunksOf) + import HaskellSay (haskellSay) main :: IO () - main = getLine >>= print . chunksOf 3 + main = haskellSay "Hello, Haskell!" -This can be run using ``cabal run myscript``. -On Unix-like systems this can be run directly with execute permission. +The necessary sections of a ``.cabal`` file are placed +directly into the script as a comment. + +Use the familiar ``cabal run`` command to execute this script: .. code-block:: console $ cabal run myscript - $ chmod +x myscript - $ ./myscript - -Project metadata can also be included: +On Unix-like systems, a Haskell script starting with ``#!/usr/bin/env cabal``, like the one above, +can be run directly after setting the execute permission (+x): -.. code-block:: haskell +.. code-block:: console - {- project: - with-compiler: ghc-8.10.7 - -} + $ chmod +x myscript + $ ./myscript + ________________________________________________________ + / \ + | Hello, Haskell! | + \____ ____________________________________________/ + \ ... / See more in the documentation for :ref:`cabal run`. @@ -211,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/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 b97dd245346..69109a67685 100644 --- a/doc/index.rst +++ b/doc/index.rst @@ -1,20 +1,41 @@ - 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-use-backpack + 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 + +.. 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 ================ diff --git a/doc/requirements.in b/doc/requirements.in index 0a8bc49fecc..d8de16ca602 100644 --- a/doc/requirements.in +++ b/doc/requirements.in @@ -6,5 +6,5 @@ sphinxnotes-strike Pygments >= 2.7.4 # CVE-2023-37920 certifi >= 2023.07.22 -# CVE-2023-43804 -urllib3 >= 2.0.6 +# CVE-2023-45803 +urllib3 >= 2.0.7 diff --git a/doc/requirements.txt b/doc/requirements.txt index 290dcd024d4..55019a68dc9 100644 --- a/doc/requirements.txt +++ b/doc/requirements.txt @@ -69,7 +69,7 @@ sphinxcontrib-serializinghtml==1.1.5 # via sphinx sphinxnotes-strike==1.2 # via -r requirements.in -urllib3==2.0.6 +urllib3==2.0.7 # via # -r requirements.in # requests diff --git a/doc/setup-commands.rst b/doc/setup-commands.rst index 0d326e73830..20bdafabfae 100644 --- a/doc/setup-commands.rst +++ b/doc/setup-commands.rst @@ -144,9 +144,9 @@ This has the following effects: the set of databases via :option:`--package-db` (and related flags): these dependencies are assumed to be up-to-date. A dependency can be explicitly specified using :option:`--dependency` simply by giving the name - of the internal library; e.g., the dependency for an internal library + of the sublibrary; e.g., the dependency for a sublibrary named ``foo`` is given as - ``--dependency=pkg-internal=pkg-1.0-internal-abcd``. + ``--dependency=Lib:foo=foo-0.1-abc``. - Only the dependencies needed for the requested component are required. Similarly, when :option:`--exact-configuration` is specified, @@ -612,8 +612,8 @@ Miscellaneous options built; this identifier is passed on to GHC and serves as the basis for linker symbols and the ``id`` field in a ``ghc-pkg`` registration. When a package has multiple components, the actual - component identifiers are derived off of this identifier. E.g., an - internal library ``foo`` from package ``p-0.1-abcd`` will get the + component identifiers are derived off of this identifier. E.g., a + sublibrary ``foo`` from package ``p-0.1-abcd`` will get the identifier ``p-0.1-abcd-foo``. .. option:: --cid=CID @@ -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. diff --git a/release-notes/Cabal-3.10.2.1.md b/release-notes/Cabal-3.10.2.1.md new file mode 100644 index 00000000000..bfa8fa750b5 --- /dev/null +++ b/release-notes/Cabal-3.10.2.1.md @@ -0,0 +1,9 @@ +Cabal and Cabal-syntax 3.10.2.1 changelog and release notes +--- + +## Release 3.10.2.1 is strictly a bug-fix release, with the fixes listed below + +- Relax extension .c requirement for c-sources [#9285](https://github.com/haskell/cabal/pull/9285) + +We will be tightening the behaviour of Cabal in the future, when users list files ending with extensions other than `.c` in the `c-sources` field of their cabal file. These files were never processed properly. +This PR displays more warnings and prepares the transition.