diff options
| author | solpeth <> | 2020-06-30 21:39:00 (GMT) |
|---|---|---|
| committer | hdiff <hdiff@hdiff.luite.com> | 2020-06-30 21:39:00 (GMT) |
| commit | 408014f3f923370194e604e0b5416490800aa46b (patch) | |
| tree | 2756a2c975602c8dab380644bb47fcf62173e57a | |
| parent | 6842df796135e3dd90d6e067900b83df824f7323 (diff) | |
version 0.6.50.6.5
255 files changed, 4088 insertions, 2264 deletions
diff --git a/HACKING.rst b/HACKING.rst new file mode 100644 index 0000000..986854e --- /dev/null +++ b/HACKING.rst @@ -0,0 +1,168 @@ +CONTRIBUTING TO HACKPORT +======================== + +Introduction +------------ + +First of all, welcome to ``HackPort`` development! + +Hacking on ``HackPort`` should be more-or-less straightforward, but +there are some peculiarities that may cause headaches for new +contributors. This document aims to cover some common pitfalls for new +contributors to ``HackPort``. + +Setting up your development repository +-------------------------------------- + +On GitHub, fork the ``gentoo-haskell/hackport`` repository. If you will be +working on the ``cabal`` submodule, you should also fork the +``gentoo-haskell/cabal`` repository. + +The ``HackPort`` source repository contains two git submodules: ``cabal`` +and ``hackage-security``. Ensure that these submodules are populated by +cloning the ``HackPort`` repository with the ``--recurse-submodules`` +option: + +``git clone --recurse-submodules https://github.com/<your-name>/hackport.git`` + +If you have already cloned the ``HackPort`` source repository without +``--recurse-submodules``, run +``git submodule init && git submodule update`` to populate the submodule +directories. For more information visit +https://git-scm.com/book/en/v2/Git-Tools-Submodules. + +Bumping the cabal submodule +--------------------------- + +The ``cabal`` submodule follows the upstream Cabal source repository, +and adds a handful of local patches designed to allow ``HackPort`` to +use it correctly. Enter the ``cabal/`` directory and run ``git log`` to +see for yourself: the most recent commits will be a dozen or so patches +written by ``HackPort`` contributors over the years to ensure +compatibility between ``HackPort`` and Cabal. Underneath those commits will +be those of Cabal upstream. + +Our patches need to be carried over whenever we bump the ``cabal`` +submodule to a newer upstream commit. Let’s run through one way of +carrying out this process. + +1. Add the upstream Cabal source repository as a remote repository in + our cabal submodule, i.e. + + ``cd cabal && git remote add upstream https://github.com/haskell/cabal`` + + Note that this only needs to be done once. + +2. Checkout a new branch within your ``cabal`` submodule, i.e. + ``git checkout -b <name>`` + +3. Fetch the latest changes from Cabal upstream (or just the changes you + need), e.g. \ ``git fetch upstream master``. + +4. Rebase onto the latest changes or a given commit, e.g. + + ``git rebase 6e9d6bdc79ecab601d6602d445e9cdcbecfd2591`` + + What I usually like to do is browse the upstream Cabal repository on + GitHub to find a stable point in its commit history, and for that + I’ll find a commit that is tagged as ‘Cabal-v<version>’. **A WORD OF + CAUTION:** generally Cabal upstream creates tags in branches + *outside* of ‘master’, which can cause rebasing headaches in the + future. If you find yourself looking at a specific commit referenced + by a git tag for a given Cabal version, check the commit description + for a comment such as ‘(cherry picked from commit 853414b)’. Commit + ‘854514b’ in this example is *generally* a commit in the ‘master’ + branch, which is what we want. Rebase onto *that* commit, not the + commit tagged as ‘Cabal-v<version>’. In this example, do + + ``git rebase 854514b`` and **not** ``git rebase Cabal-v<version>`` + + If you *really* want to rebase onto a specific tag in a specific + branch other than master, you may find that when rebasing to a newer + upstream Cabal commit in the future you will need to rebase by doing + + ``git rebase --onto <new parent> <old parent>`` + + ``<new parent>`` being the new commit to rebase onto and + ``<old parent>`` being the commit that we were previously based on. + +5. Work through the ensuing conflicts. You are likely to come across + some conflicts between our patches and the changes pulled from Cabal + upstream. This is normal. Work through the conflicts (about a dozen + or so) by carrying over our changes into the newer Cabal files that + we’ve just rebased onto. Usually, it’s a simple matter of ensuring + that a particular language extension is enabled in a certain file, + such as adding + + ``{-# LANGUAGE NoMonoLocalBinds #-}`` + + to the top of a Cabal source file. + +6. Try to compile hackport on top of the updated ``cabal`` submodule: + + ``cabal v2-build`` + + This may be the tricky part. There may have been breaking changes + between upstream Cabal versions, which can cause breakages within + ``HackPort``. + + If files in the ``cabal`` submodule fail to compile, it’s usually + related to a language extension that needs to be enabled such as + ``NoMonoLocalBinds``. + + If files in the ``HackPort`` repository fail to compile, it’s usually to + do with functions which have been changed or removed in Cabal + upstream, now reflected in our updated ``cabal`` submodule. You’ll + need to study the Cabal library documentation for the relevant + changes, which can be done on Hackage in your web browser. + +7. Hopefully, everything now compiles and ``HackPort`` functions + correctly at run time. Assuming it is decided that these changes + should be pushed into gentoo-haskell’s ``HackPort`` repository (and + assuming that you have commit access) ensure that you push both the + ``cabal`` submodule and the ``HackPort`` repository at large. You *can* + do this in one step by using + + ``git push --recurse-submodules=on-demand`` + + but you can also do it manually. + + Otherwise, open a pull request for both ``gentoo-haskell/cabal`` and + ``gentoo-haskell/hackport``. + +Releasing a new version of HackPort +----------------------------------- + +First, create a tag of your new ``HackPort`` version: + +``git tag "v<version>" -s`` + +The ``-s`` option signs the tag with your GnuPG key, if you wish to do +this. + +Next, run the ‘mk_release_tarball.bash’ script. ``cabal sdist`` does not +build the submodules, which is why we need to use this script instead. + +Assuming everything builds correctly and you are a designated +``HackPort`` maintainer on Hackage, you can publish the ``HackPort`` +source distribution: + +``cabal upload --publish <tarball>`` + +Bump the ``HackPort`` ebuild in ``::haskell`` to the newest version +reflected on Hackage. + +Further help and information +---------------------------- + +There will usually be a ``HackPort`` developer hanging about in +``#gentoo-haskell`` on FreeNode. Join the channel and ask away! + +TODO +---- + +- Include section explaining how to determine and add the list of bundled + libraries for a given GHC version to ``HackPort``. + + + @@ -2,7 +2,6 @@ module Main (main) where -import Control.Applicative import Control.Monad import Data.Maybe import Data.List @@ -200,14 +200,10 @@ mangle_iuse = drop_prefix . map f -- | Remove "with" or "use" prefixes from flag names. drop_prefix :: String -> String -drop_prefix = \x -> - case splitAt 5 x of - ("with_", b) -> b - ("with-", b) -> b - _ -> case splitAt 4 x of - ("use_", b) -> b - ("use-", b) -> b - _ -> x +drop_prefix x + | take 5 x `elem` ["with_","with-"] = drop 5 x + | take 4 x `elem` ["use_","use-"] = drop 4 x + | otherwise = x -- used to be FlagAssignment in Cabal but now it's an opaque type type CabalFlags = [(Cabal.FlagName, Bool)] diff --git a/Merge/Dependencies.hs b/Merge/Dependencies.hs index 9eb015f..44771e8 100644 --- a/Merge/Dependencies.hs +++ b/Merge/Dependencies.hs @@ -11,7 +11,7 @@ module Merge.Dependencies ) where import Data.Maybe ( isJust, isNothing ) -import Data.Monoid ( Monoid, mempty, mappend) +import Data.Monoid ( Monoid, mempty ) import qualified Data.List as L import qualified Data.Set as S diff --git a/Portage/EBuild.hs b/Portage/EBuild.hs index 5e8a7be..82787ef 100644 --- a/Portage/EBuild.hs +++ b/Portage/EBuild.hs @@ -11,11 +11,11 @@ import Portage.EBuild.CabalFeature import Portage.EBuild.Render import qualified Portage.Dependency.Normalize as PN -import Data.String.Utils import qualified Data.Time.Clock as TC import qualified Data.Time.Format as TC import qualified Data.Function as F import qualified Data.List as L +import qualified Data.List.Split as LS import Data.Version(Version(..)) import qualified Paths_hackport(version) @@ -140,6 +140,7 @@ showEBuild now ebuild = toHttps = replace "http://github.com/" "https://github.com/" this_year :: String this_year = TC.formatTime TC.defaultTimeLocale "%Y" now + replace old new = L.intercalate new . LS.splitOn old -- "+a" -> "a" -- "b" -> "b" diff --git a/Portage/GHCCore.hs b/Portage/GHCCore.hs index e026705..1b03a3e 100644 --- a/Portage/GHCCore.hs +++ b/Portage/GHCCore.hs @@ -31,10 +31,10 @@ import Data.List ( nub ) import Debug.Trace -- ghcs tried in specified order. --- It means that first ghc in this list is a minmum default. +-- It means that first ghc in this list is a minimum default. ghcs :: [(DC.CompilerInfo, InstalledPackageIndex)] ghcs = modern_ghcs - where modern_ghcs = [ghc741, ghc742, ghc762, ghc782, ghc7101, ghc7102, ghc801, ghc802, ghc821, ghc843, ghc863, ghc865, ghc881] + where modern_ghcs = [ghc741, ghc742, ghc762, ghc782, ghc7101, ghc7102, ghc801, ghc802, ghc821, ghc843, ghc863, ghc865, ghc881, ghc883, ghc8101] cabalFromGHC :: [Int] -> Maybe Cabal.Version cabalFromGHC ver = lookup ver table @@ -51,6 +51,8 @@ cabalFromGHC ver = lookup ver table , ([8,6,3], Cabal.mkVersion [2,4,0,1]) , ([8,6,5], Cabal.mkVersion [2,4,0,1]) , ([8,8,1], Cabal.mkVersion [3,0,0,0]) + , ([8,8,3], Cabal.mkVersion [3,0,1,0]) + , ([8,10,1], Cabal.mkVersion [3,2,0,0]) ] platform :: Platform @@ -120,6 +122,12 @@ ghc :: [Int] -> DC.CompilerInfo ghc nrs = DC.unknownCompilerInfo c_id DC.NoAbiTag where c_id = CompilerId GHC (mkVersion nrs) +ghc8101 :: (DC.CompilerInfo, InstalledPackageIndex) +ghc8101 = (ghc [8,10,1], mkIndex ghc8101_pkgs) + +ghc883 :: (DC.CompilerInfo, InstalledPackageIndex) +ghc883 = (ghc [8,8,3], mkIndex ghc883_pkgs) + ghc881 :: (DC.CompilerInfo, InstalledPackageIndex) ghc881 = (ghc [8,8,1], mkIndex ghc881_pkgs) @@ -165,6 +173,73 @@ ghc741 = (ghc [7,4,1], mkIndex ghc741_pkgs) -- example: https://downloads.haskell.org/~ghc/8.6.5/docs/html/users_guide/8.6.5-notes.html -- * our binary tarballs (package.conf.d.initial subdir) -- * ancient: http://haskell.org/haskellwiki/Libraries_released_with_GHC +ghc8101_pkgs :: [Cabal.PackageIdentifier] +ghc8101_pkgs = + [ p "array" [0,5,4,0] + , p "base" [4,14,0,0] + , p "binary" [0,8,8,0] -- used by libghc + , p "bytestring" [0,10,10,0] +-- , p "Cabal" [3,2,0,0] package is upgradeable + , p "containers" [0,6,2,1] + , p "deepseq" [1,4,4,0] -- used by time + , p "directory" [1,3,6,0] + , p "filepath" [1,4,2,1] +-- , p "exceptions [0,10,4] -- used by haskeline, package is upgradeable + , p "ghc-boot" [8,10,1] + , p "ghc-boot-th" [8,10,1] + , p "ghc-compact" [0,1,0,0] + , p "ghc-prim" [0,6,1,0] + , p "ghc-heap" [8,10,1] + , p "ghci" [8,10,1] +-- , p "haskeline" [0,8,0,0] package is upgradeable + , p "hpc" [0,6,1,0] -- used by libghc + , p "integer-gmp" [1,0,3,0] + -- , p "mtl" [2,2,2] package is upgradeable(?) + -- , p "parsec" [3,1,14,0] package is upgradeable(?) + , p "pretty" [1,1,3,6] + , p "process" [1,6,8,2] + -- , p "stm" [2,5,0,0] package is upgradeable(?) + , p "template-haskell" [2,16,0,0] -- used by libghc + -- , p "terminfo" [0,4,1,4] + -- , p "text" [1,2,3,2] dependency of Cabal library + , p "time" [1,9,3,0] -- used by unix, directory, hpc, ghc. unsafe to upgrade + , p "transformers" [0,5,6,2] -- used by libghc + , p "unix" [2,7,2,2] +-- , p "xhtml" [3000,2,2,1] + ] + +ghc883_pkgs :: [Cabal.PackageIdentifier] +ghc883_pkgs = + [ p "array" [0,5,4,0] + , p "base" [4,13,0,0] + , p "binary" [0,8,7,0] -- used by libghc + , p "bytestring" [0,10,10,0] +-- , p "Cabal" [3,0,1,0] package is upgradeable + , p "containers" [0,6,2,1] + , p "deepseq" [1,4,4,0] -- used by time + , p "directory" [1,3,6,0] + , p "filepath" [1,4,2,1] + , p "ghc-boot" [8,8,3] + , p "ghc-boot-th" [8,8,3] + , p "ghc-compact" [0,1,0,0] + , p "ghc-prim" [0,5,3,0] + , p "ghci" [8,8,3] +-- , p "haskeline" [0,7,5,0] package is upgradeable + , p "hpc" [0,6,0,3] -- used by libghc + , p "integer-gmp" [1,0,2,0] + -- , p "mtl" [2,2,2] package is upgradeable(?) + -- , p "parsec" [3,1,14,0] package is upgradeable(?) + , p "pretty" [1,1,3,6] + , p "process" [1,6,8,0] + -- , p "stm" [2,5,0,0] package is upgradeable(?) + , p "template-haskell" [2,15,0,0] -- used by libghc + -- , p "terminfo" [0,4,1,4] + -- , p "text" [1,2,4,0] dependency of Cabal library + , p "time" [1,9,3,0] -- used by unix, directory, hpc, ghc. unsafe to upgrade + , p "transformers" [0,5,6,2] -- used by libghc + , p "unix" [2,7,2,2] +-- , p "xhtml" [3000,2,2,1] + ] ghc881_pkgs :: [Cabal.PackageIdentifier] ghc881_pkgs = diff --git a/Portage/Metadata.hs b/Portage/Metadata.hs index 5bccf6a..3a333a7 100644 --- a/Portage/Metadata.hs +++ b/Portage/Metadata.hs @@ -6,11 +6,9 @@ module Portage.Metadata import qualified Data.ByteString as B -import Control.Applicative - import Text.XML.Light -data Metadata = Metadata +newtype Metadata = Metadata { metadata_emails :: [String] -- , metadataMaintainers :: [String], -- , metadataUseFlags :: [(String,String)] diff --git a/Portage/PackageId.hs b/Portage/PackageId.hs index 9496ee5..18289c5 100644 --- a/Portage/PackageId.hs +++ b/Portage/PackageId.hs @@ -61,7 +61,7 @@ instance Parsec PackageName where parsec = do category <- parsec _ <- P.char '/' - name <- parsec + name <- parseCabalPackageName return $ PackageName category name instance Pretty PackageId where diff --git a/Portage/Version.hs b/Portage/Version.hs index 076d324..c85fb6c 100644 --- a/Portage/Version.hs +++ b/Portage/Version.hs @@ -28,15 +28,16 @@ import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp import Text.PrettyPrint ((<>)) import qualified Data.Char as Char (isAlpha, isDigit) +import qualified Data.List.NonEmpty as NonEmpty #if MIN_VERSION_base(4,11,0) import Prelude hiding ((<>)) #endif -data Version = Version { versionNumber :: [Int] -- [1,42,3] ~= 1.42.3 - , versionChar :: (Maybe Char) -- optional letter +data Version = Version { versionNumber :: [Int] -- [1,42,3] ~= 1.42.3 + , versionChar :: (Maybe Char) -- optional letter , versionSuffix :: [Suffix] - , versionRevision :: Int -- revision, 0 means none + , versionRevision :: Int -- revision, 0 means none } deriving (Eq, Ord, Show, Read) @@ -52,11 +53,11 @@ instance Pretty Version where instance Parsec Version where parsec = do - ver <- P.sepBy1 digits (P.char '.') + ver <- P.sepByNonEmpty digits (P.char '.') c <- P.optional $ P.satisfy Char.isAlpha suf <- P.many parsec rev <- P.option 0 $ P.string "-r" *> digits - return $ Version ver c suf rev + return $ Version (NonEmpty.toList ver) c suf rev -- foo-9999* is treated as live ebuild -- Cabal-1.17.9999* as well @@ -24,7 +24,6 @@ import qualified Data.Map as Map import Data.Map as Map (Map) import qualified Data.Traversable as T -import Control.Applicative import Control.Monad -- cabal diff --git a/cabal/.dockerignore b/cabal/.dockerignore new file mode 100644 index 0000000..47c984d --- /dev/null +++ b/cabal/.dockerignore @@ -0,0 +1,32 @@ +# Note: some cabal-testsuite tests need .git, so we cannot ignore that. + +cabal.project.local +.ghc.environment.* + +**/.hpc +**/*.hi +**/*.o +**/*.p_hi +**/*.prof +**/*.tix + +**/*.sw* + +**/Setup +**/*.dist + +Cabal/dist/ +Cabal/.python-sphinx-virtualenv/ +Cabal/tests/Setup +Cabal/Setup +Cabal/source-file-list + +cabal-install/dist/ +cabal-install/Setup +cabal-install/source-file-list + +.github/ +dist-newstyle/ +dist-newstyle-*/ + +Cabal/.python-sphinx-virtualenv diff --git a/cabal/.mailmap b/cabal/.mailmap index 27a2a38..671fdf1 100644 --- a/cabal/.mailmap +++ b/cabal/.mailmap @@ -20,6 +20,7 @@ Andres Löh <andres.loeh@gmail.com> <andres@well Andres Löh <andres.loeh@gmail.com> <ksgithub@andres-loeh.de> Andres Löh <andres.loeh@gmail.com> <mail@andres-loeh.de> Andy Craze <accraze@gmail.com> +Arian van Putten <arian.vanputten@gmail.com> <aeroboy94@gmail.com> Audrey Tang <audreyt@audreyt.org> audreyt <audreyt@audreyt.org> Austin Seipp <aseipp@pobox.com> Austin Seipp <aseipp@pobox.com> <aseipp@well-typed.com> @@ -57,6 +58,7 @@ Duncan Coutts <duncan@community.haskell.org> unknown <unkn Edward Z. Yang <ezyang@cs.stanford.edu> <ezyang@fb.com> Edward Z. Yang <ezyang@cs.stanford.edu> <ezyang@mit.edu> Einar Karttunen <ekarttun@cs.helsinki.fi> +Emily Pillmore <emilypi@cohomolo.gy> <emily@kadena.io> Federico Mastellone <fmaste@users.noreply.github.com> Felix Yan <felixonmars@archlinux.org> Felix Yan <felixonmars@gmail.com> Francesco Gazzetta <fgaz@fgaz.me> <fgaz@users.noreply.github.com> @@ -117,6 +119,7 @@ Li-yao Xia <lysxia@gmail.com> Malcolm Wallace <Malcolm.Wallace@me.com> Malcolm.Wallace <Malcolm.Wallace@cs.york.ac.uk> Mark Weber <marco-oweber@gmx.de> marco-oweber <marco-oweber@gmx.de> Martin Sjögren <msjogren@gmail.com> md9ms <md9ms@mdstud.chalmers.se> +Matt Renaud <matt@m-renaud.com> <mrenaud@google.com> Mikhail Glushenkov <mikhail.glushenkov@gmail.com> <c05mgv@cs.umu.se> Mikhail Glushenkov <mikhail.glushenkov@gmail.com> <mikhail@scrive.com> Mikhail Glushenkov <mikhail.glushenkov@gmail.com> <the.dead.shall.rise@gmail.com> @@ -156,8 +159,8 @@ Thomas Tuegel <ttuegel@gmail.com> Thomas Tuegel <ttuegel@gmail.com> <ttuegel@mailbox.org> Thomas Tuegel <ttuegel@gmail.com> <ttuegel@secure.mailbox.org> Veronika Romashkina <vrom911@gmail.com> +Zejun Wu <zejun.wu@gmail.com> <watashi@watashi.ws> capsjac <capsjac@gmail.com> # Goes by that name online ghthrowaway7 <41365123+ghthrowaway7@users.noreply.github.com> # Goes by that name online quasicomputational <quasicomputational@gmail.com> # Goes by that name online vedksah <31156362+vedksah@users.noreply.github.com> # Goes by that name online -! diff --git a/cabal/.travis.yml b/cabal/.travis.yml index 1fbec4b..c6f4732 100644 --- a/cabal/.travis.yml +++ b/cabal/.travis.yml @@ -2,25 +2,16 @@ # We specify language: c, so it doesn't default to e.g. ruby language: c -dist: trusty +dist: xenial # This sets the default config for each job to use full VMs. # The VMs have 2 cores and 8 gigs of ram. Larger VMs are also available. sudo: true # We whitelist branches, as we don't really need to build dev-branches. +# Except if those branches are in a fork. # Remember to add release branches, both here and to appveyor.yml. -branches: - only: - - master - - "3.0" - - "2.4" - - "2.2" - - "2.0" - - "1.24" - - "1.22" - - "1.20" - - "1.18" +if: branch IN (master, 3.0, 2.4, 2.2, 2.0, 1.24, 1.22, 1.20, 1.18) OR repo != haskell/cabal # The following enables several GHC versions to be tested; often it's enough to # test only against the last release in a major GHC version. Feel free to omit @@ -59,7 +50,7 @@ matrix: - env: GHCVER=8.4.4 SCRIPT=script USE_GOLD=YES DEPLOY_DOCS=YES os: linux sudo: required - - env: GHCVER=8.6.4 SCRIPT=script USE_GOLD=YES + - env: GHCVER=8.6.5 SCRIPT=script USE_GOLD=YES os: linux sudo: required #- env: GHCVER=8.8.1 SCRIPT=script USE_GOLD=YES @@ -96,22 +87,32 @@ matrix: - env: GHCVER=8.0.2 SCRIPT=bootstrap os: osx - # It's been long known that CI with - # Stack does not work so it's disabled until further notice - # to reduce latency and avoid wasting CI slots for no reason. - # - #- env: GHCVER=via-stack SCRIPT=stack STACK_CONFIG=stack.yaml - # os: linux - # - # See https://github.com/haskell/cabal/pull/4667#issuecomment-321036564 - # for why failures are allowed. - # allow_failures: - # - env: GHCVER=via-stack SCRIPT=stack STACK_CONFIG=stack.yaml + # It's been long known that CI with + # Stack does not work so it's disabled until further notice + # to reduce latency and avoid wasting CI slots for no reason. + # + #- env: GHCVER=via-stack SCRIPT=stack STACK_CONFIG=stack.yaml + # os: linux + # + # See https://github.com/haskell/cabal/pull/4667#issuecomment-321036564 + # for why failures are allowed. + # + # OSX jobs timeout often, so they can fail + allow_failures: + # - env: GHCVER=via-stack SCRIPT=stack STACK_CONFIG=stack.yaml + - env: GHCVER=7.10.3 SCRIPT=script + os: osx + - env: GHCVER=8.0.2 SCRIPT=script + os: osx # TODO add PARSEC_BUNDLED=YES when it's so # It seems pointless to run head if we're going to ignore the results. #- GHCVER=head + # Marks the build result as soon as all the non-"allow_failures" jobs finish, based on their results + # while the remaining `allow_failures` jobs continue to run. + fast_finish: true + # Note: the distinction between `before_install` and `install` is not important. before_install: - export PATH=/opt/ghc/$GHCVER/bin:$PATH @@ -171,6 +172,6 @@ after_success: notifications: irc: + if: repo = haskell/cabal channels: - "chat.freenode.net##haskell-cabal" - slack: haskell-cabal:sCq6GLfy9N8MJrInosg871n4 diff --git a/cabal/AUTHORS b/cabal/AUTHORS index b7cd9ea..a02c318 100644 --- a/cabal/AUTHORS +++ b/cabal/AUTHORS @@ -16,6 +16,7 @@ Alexander Vershilov <alexander.vershilov@gmail.com> Alexei Pastuchov <alexei.pastuchov@telecolumbus.de> Alexis Williams <alexis@typedr.at> Alistair Bailey <alistair@abayley.org> +Alp Mestanogullari <alpmestan@gmail.com> Alson Kemp <alson@alsonkemp.com> Amir Mohammad Saied <amirsaied@gmail.com> Anders Kaseorg <andersk@mit.edu> @@ -29,7 +30,7 @@ Angus Lepper <angus.lepper@gmail.com> Antoine Latter <aslatter@gmail.com> Anton Dessiatov <anton.dessiatov@gmail.com> Antonio Nikishaev <a@lelf.me> -Arian van Putten <aeroboy94@gmail.com> +Arian van Putten <arian.vanputten@gmail.com> Arun Tejasvi Chaganty <arunchaganty@gmail.com> Atze Dijkstra <atze@cs.uu.nl> Audrey Tang <audreyt@audreyt.org> @@ -66,6 +67,7 @@ Clint Adams <clint@debian.org> Colin Wahl <colin.t.wahl@gmail.com> Conal Elliott <conal@conal.net> Curtis Gagliardi <curtis@curtis.io> +Dale Wijnand <344610+dwijnand@users.noreply.github.com> Dan Burton <danburton.email@gmail.com> Daniel Buckmaster <dan.buckmaster@gmail.com> Daniel Díaz Carrete <daniel@bogusemailserver.com> @@ -75,6 +77,7 @@ Daniel Velkov <norcobg@gmail.com> Daniel Wagner <daniel@wagner-home.com> Danny Navarro <j@dannynavarro.net> Dave Laing <dave.laing.80@gmail.com> +David Eichmann <EichmannD@gmail.com> David Feuer <David.Feuer@gmail.com> David Fox <dsf@seereason.com> David Himmelstrup <lemmih@gmail.com> @@ -97,6 +100,7 @@ Echo Nolan <echo@echonolan.net> Edsko de Vries <edsko@well-typed.com> Edward Z. Yang <ezyang@cs.stanford.edu> Einar Karttunen <ekarttun@cs.helsinki.fi> +Emily Pillmore <emilypi@cohomolo.gy> Eric Kow <eric.kow@gmail.com> Eric Seidel <gridaphobe@gmail.com> Erik Hesselink <hesselink@gmail.com> @@ -106,6 +110,7 @@ Esa Ilari Vuokko <ei@vuokko.info> Eugene Sukhodolin <eugene@sukhodolin.com> Eyal Lotem <eyal.lotem@gmail.com> Fabián Orccón <fabian.orccon@pucp.pe> +Fangyi Zhou <fangyi.zhou15@imperial.ac.uk> Federico Mastellone <fmaste@users.noreply.github.com> Felix Yan <felixonmars@archlinux.org> Florian Hartwig <florian.j.hartwig@gmail.com> @@ -125,6 +130,7 @@ Gleb Popov <6yearold@gmail.com> Gregory Collins <greg@gregorycollins.net> Gwern Branwen <gwern0@gmail.com> Haisheng.Wu <freizl@gmail.com> +Harrison Houghton <haro@constant.gripe> Harry Garrood <harry@garrood.me> Heather <heather@live.ru> Henk-Jan van Tuyl <hjgtuyl@chello.nl> @@ -145,6 +151,7 @@ JP Moresmau <jp@moresmau.fr> Jacco Krijnen <jaccokrijnen@gmail.com> Jack Henahan <jhenahan@uvm.edu> Jake Wheat <jakewheatmail@gmail.com> +James Earl Douglas <james@earldouglas.com> Jan Path <jan@jpath.de> Jason Dagit <dagitj@gmail.com> Jean-Philippe Bernardy <jeanphilippe.bernardy@gmail.com> @@ -168,6 +175,7 @@ Jookia <166291@gmail.com> Josef Svenningsson <josef.svenningsson@gmail.com> Josh Hoyt <josh.hoyt@galois.com> Josh Kalderimis <josh.kalderimis@gmail.com> +Josh Meredith <joshmeredith2008@gmail.com> Judah Jacobson <judah.jacobson@gmail.com> Jürgen Nicklisch-Franken <jnf@arcor.de> Karel Gardas <karel.gardas@centrum.cz> @@ -200,6 +208,7 @@ Martin Vlk <martin@vlkk.cz> Masahiro Yamauchi <sgt.yamauchi@gmail.com> Mathieu Boespflug <mboes@tweag.net> Matt Renaud <matt@m-renaud.com> +Matthew Pickering <matthewtpickering@gmail.com> Matthew William Cox <matt@mattcox.ca> Matthias Fischmann <mf@zerobuzz.net> Matthias Kilian <kili@outback.escape.de> @@ -253,6 +262,7 @@ Peter Trško <peter.trsko@gmail.com> Phil Ruffwind <rf@rufflewind.com> Philipp Schumann <philipp.schumann@gmail.com> Philipp Schuster <pschuster@uni-koblenz.de> +Piyush P Kurur <ppk@cse.iitk.ac.in> Pranit Bauva <pranit.bauva@gmail.com> Prayag Verma <prayag.verma@gmail.com> Randy Polen <randen@users.noreply.github.com> @@ -274,6 +284,8 @@ Ryan Newton <rrnewton@gmail.com> Ryan Scott <ryan.gl.scott@gmail.com> Ryan Trinkle <ryan.trinkle@gmail.com> RyanGlScott <ryan.gl.scott@gmail.com> +Sam Boosalis <SamBoosalis@gmail.com> +Sam Halliday <sam.halliday@gmail.com> Samuel Bronson <naesten@gmail.com> Samuel Gélineau <gelisam+github@gmail.com> Sergei Trofimovich <slyfox@community.haskell.org> @@ -305,21 +317,27 @@ Tim Chevalier <chevalier@alum.wellesley.edu> Tim Humphries <tim.humphries@ambiata.com> Tim McGilchrist <timmcgil@gmail.com> Tomas Vestelind <tomas.vestelind@gmail.com> +Toon Nolten <toonn@toonn.io> Toshio Ito <debug.ito@gmail.com> Travis Cardwell <travis.cardwell@extellisys.com> Travis Whitaker <pi.boy.travis@gmail.com> +Tseen She <ts33n.sh3@gmail.com> Tuncer Ayaz <tuncer.ayaz@gmail.com> Vaibhav Sagar <vaibhavsagar@gmail.com> +Vanessa McHale <vanessa.mchale@iohk.io> Veronika Romashkina <vrom911@gmail.com> Vincent Hanquez <vincent@snarc.org> Vladislav Zavialov <vlad.z.4096@gmail.com> Vo Minh Thu <noteed@gmail.com> +Wasif Hasan Baig <pr.wasif@gmail.com> Wojciech Danilo <wojtek.danilo@gmail.com> Yitzchak Gale <gale@sefer.org> Yuras Shumovich <shumovichy@gmail.com> Yuriy Syrovetskiy <cblp@cblp.su> -Zejun Wu <watashi@watashi.ws> +Zejun Wu <zejun.wu@gmail.com> capsjac <capsjac@gmail.com> +codetriage-readme-bot <schneemanbuys@gmail.com> +fendor <power.walross@gmail.com> ghthrowaway7 <41365123+ghthrowaway7@users.noreply.github.com> quasicomputational <quasicomputational@gmail.com> vedksah <31156362+vedksah@users.noreply.github.com> diff --git a/cabal/CONTRIBUTING.md b/cabal/CONTRIBUTING.md index 4cb1c86..8b311fc 100644 --- a/cabal/CONTRIBUTING.md +++ b/cabal/CONTRIBUTING.md @@ -78,8 +78,6 @@ Some tips for using Travis effectively: already failed), be nice to others and cancel the rest of the jobs, so that other commits on the build queue can be processed. -* If you want realtime notification when builds of your PRs finish, we have a [Slack team](https://haskell-cabal.slack.com/). To get issued an invite, fill in your email at [this sign up page](https://haskell-cabal.herokuapp.com). - **How to debug a failing CI test.** One of the annoying things about running tests on CI is when they fail, there is often no easy way to further troubleshoot the broken diff --git a/cabal/Cabal/Cabal.cabal b/cabal/Cabal/Cabal.cabal index b538a22..2b2365f 100644 --- a/cabal/Cabal/Cabal.cabal +++ b/cabal/Cabal/Cabal.cabal @@ -35,6 +35,8 @@ extra-source-files: -- BEGIN gen-extra-source-files tests/ParserTests/errors/MiniAgda.cabal tests/ParserTests/errors/MiniAgda.errors + tests/ParserTests/errors/big-version.cabal + tests/ParserTests/errors/big-version.errors tests/ParserTests/errors/common1.cabal tests/ParserTests/errors/common1.errors tests/ParserTests/errors/common2.cabal @@ -108,8 +110,13 @@ extra-source-files: tests/ParserTests/regressions/Octree-0.5.cabal tests/ParserTests/regressions/Octree-0.5.expr tests/ParserTests/regressions/Octree-0.5.format + tests/ParserTests/regressions/assoc-cpp-options.cabal + tests/ParserTests/regressions/assoc-cpp-options.check tests/ParserTests/regressions/bad-glob-syntax.cabal tests/ParserTests/regressions/bad-glob-syntax.check + tests/ParserTests/regressions/big-version.cabal + tests/ParserTests/regressions/big-version.expr + tests/ParserTests/regressions/big-version.format tests/ParserTests/regressions/cc-options-with-optimization.cabal tests/ParserTests/regressions/cc-options-with-optimization.check tests/ParserTests/regressions/common-conditional.cabal @@ -159,6 +166,9 @@ extra-source-files: tests/ParserTests/regressions/issue-5055.cabal tests/ParserTests/regressions/issue-5055.expr tests/ParserTests/regressions/issue-5055.format + tests/ParserTests/regressions/issue-5846.cabal + tests/ParserTests/regressions/issue-5846.expr + tests/ParserTests/regressions/issue-5846.format tests/ParserTests/regressions/issue-774.cabal tests/ParserTests/regressions/issue-774.check tests/ParserTests/regressions/issue-774.expr @@ -288,6 +298,10 @@ library -- already depends on `fail` and `semigroups` transitively build-depends: fail == 4.9.*, semigroups >= 0.18.3 && < 0.20 + if !impl(ghc >= 7.8) + -- semigroups depends on tagged. + build-depends: tagged >=0.8.6 && <0.9 + exposed-modules: Distribution.Backpack Distribution.Backpack.Configure @@ -307,6 +321,7 @@ library Distribution.Compat.Directory Distribution.Compat.Environment Distribution.Compat.Exception + Distribution.Compat.FilePath Distribution.Compat.Graph Distribution.Compat.Internal.TempFile Distribution.Compat.Newtype @@ -404,6 +419,7 @@ library Distribution.Types.BuildInfo Distribution.Types.BuildType Distribution.Types.ComponentInclude + Distribution.Types.ConfVar Distribution.Types.Dependency Distribution.Types.ExeDependency Distribution.Types.LegacyExeDependency @@ -417,6 +433,7 @@ library Distribution.Types.ExecutableScope Distribution.Types.Library Distribution.Types.LibraryVisibility + Distribution.Types.Flag Distribution.Types.ForeignLib Distribution.Types.ForeignLibType Distribution.Types.ForeignLibOption @@ -525,8 +542,10 @@ library Distribution.Backpack.Id Distribution.Utils.UnionFind Distribution.Utils.Base62 + Distribution.Compat.Async Distribution.Compat.CopyFile Distribution.Compat.GetShortPathName + Distribution.Compat.MD5 Distribution.Compat.MonadFail Distribution.Compat.Prelude Distribution.Compat.SnocList @@ -583,9 +602,10 @@ test-suite unit-tests Test.Laws Test.QuickCheck.Utils UnitTests.Distribution.Compat.CreatePipe - UnitTests.Distribution.Compat.Time UnitTests.Distribution.Compat.Graph + UnitTests.Distribution.Compat.Time UnitTests.Distribution.Simple.Glob + UnitTests.Distribution.Simple.Program.GHC UnitTests.Distribution.Simple.Program.Internal UnitTests.Distribution.Simple.Utils UnitTests.Distribution.SPDX @@ -606,14 +626,15 @@ test-suite unit-tests directory, filepath, integer-logarithms >= 1.0.2 && <1.1, - tasty >= 1.1.0.3 && < 1.2, + tasty >= 1.2.3 && < 1.3, tasty-hunit, tasty-quickcheck, tagged, temporary, text, pretty, - QuickCheck >= 2.11.3 && < 2.12, + Diff >=0.4 && <0.5, + QuickCheck >= 2.13.2 && < 2.14, Cabal ghc-options: -Wall default-language: Haskell2010 @@ -624,15 +645,15 @@ test-suite parser-tests main-is: ParserTests.hs build-depends: base, - base-compat >=0.10.4 && <0.11, + base-compat >=0.11.0 && <0.12, bytestring, directory, filepath, - tasty >= 1.1.0.3 && < 1.2, + tasty >= 1.2.3 && < 1.3, tasty-hunit, tasty-quickcheck, tasty-golden >=2.3.1.1 && <2.4, - Diff >=0.3.4 && <0.4, + Diff >=0.4 && <0.5, Cabal ghc-options: -Wall default-language: Haskell2010 @@ -642,7 +663,7 @@ test-suite parser-tests if impl(ghc >= 7.8) build-depends: - tree-diff >= 0.0.2 && <0.1 + tree-diff >= 0.1 && <0.2 other-modules: Instances.TreeDiff Instances.TreeDiff.Language @@ -658,9 +679,9 @@ test-suite check-tests bytestring, directory, filepath, - tasty >= 1.1.0.3 && < 1.2, + tasty >= 1.2.3 && < 1.3, tasty-golden >=2.3.1.1 && <2.4, - Diff >=0.3.4 && <0.4, + Diff >=0.4 && <0.5, Cabal ghc-options: -Wall default-language: Haskell2010 @@ -702,15 +723,15 @@ test-suite hackage-tests filepath build-depends: - base-compat >=0.10.4 && <0.11, + base-compat >=0.11.0 && <0.12, base-orphans >=0.6 && <0.9, - optparse-applicative >=0.13.2.0 && <0.15, + optparse-applicative >=0.13.2.0 && <0.16, stm >=2.4.5.0 && <2.6, tar >=0.5.0.3 && <0.6 if impl(ghc >= 7.8) build-depends: - tree-diff >= 0.0.2 && <0.1 + tree-diff >= 0.1 && <0.2 other-modules: Instances.TreeDiff Instances.TreeDiff.Language @@ -732,7 +753,7 @@ test-suite rpmvercmp bytestring build-depends: - tasty >= 1.1.0.3 && < 1.2, + tasty >= 1.2.3 && < 1.3, tasty-hunit, tasty-quickcheck, QuickCheck diff --git a/cabal/Cabal/ChangeLog.md b/cabal/Cabal/ChangeLog.md index 81cb7f3..5e8d823 100644 --- a/cabal/Cabal/ChangeLog.md +++ b/cabal/Cabal/ChangeLog.md @@ -1,7 +1,17 @@ # 3.1.0.0 (current development version) - -# 3.0.0.0 TBD + * `cabal check` verifies `cpp-options` more pedantically, allowing only + options starting with `-D` and `-U`. * TODO + + ---- + +# 3.0.0.0 [Mikhail Glushenkov](mailto:mikhail.glushenkov@gmail.com) August 2019 + * The 3.0 migration guide gives advice on adapting Custom setup + scripts to backwards-incompatible changes in this release: + https://github.com/haskell/cabal/wiki/3.0-migration-guide. + * Due to [#5119](https://github.com/haskell/cabal/issues/5119), the + `cabal check` warning for bounds on internal libraries has been + disabled. * Introduce set notation for `^>=` and `==` operators ([#5906](https://github.com/haskell/cabal/pull/5906)). * 'check' reports warnings for various ghc-\*-options fields separately @@ -34,6 +44,8 @@ add default implementation in terms of `coerce` / `unsafeCoerce`. * Implement support for response file arguments to defaultMain* and cabal-install. * Uniformly provide 'Semigroup' instances for `base < 4.9` via `semigroups` package + * Implement `{cmm,asm}-{sources,options} buildinfo fields for + separate compilation of C-- and ASM source files (#6033). * Setting `debug-info` now implies `library-stripping: False` and `executable-stripping: False) ([#2702](https://github.com/haskell/cabal/issues/2702)) * `Setup.hs copy` and `install` now work in the presence of @@ -65,7 +77,6 @@ ([#5503](https://github.com/haskell/cabal/issues/5503)). # 2.4.0.0 [Mikhail Glushenkov](mailto:mikhail.glushenkov@gmail.com) September 2018 - * Due to [#5119](https://github.com/haskell/cabal/issues/5119), the `cabal check` warning for bounds on internal libraries has been disabled. @@ -220,7 +231,7 @@ types (#4701). * Support for building with Win32 version 2.6 (#4835). * Change `compilerExtensions` and `ghcOptExtensionMap` to contain - `Maybe Flag`s, since a supported extention can lack a flag (#4443). + `Maybe Flag`s, since a supported extension can lack a flag (#4443). * Pretty-printing of `.cabal` files is slightly different due to parser changes. For an example, see https://mail.haskell.org/pipermail/cabal-devel/2017-December/010414.html. @@ -466,7 +477,7 @@ * Support GHC 7.10. * Experimental support for emitting DWARF debug info. * Preliminary support for relocatable packages. - * Allow cabal to be used inside cabal exec enviroments. + * Allow cabal to be used inside cabal exec environments. * hpc: support multiple "ways" (e.g. profiling and vanilla). * Support GHCJS. * Improved command line documentation. @@ -802,7 +813,7 @@ * It is no longer necessary to run `configure` before `clean` or `sdist` * Added support for ghc's `-split-objs` * Initial support for JHC - * Ignore extension fields in `.cabal` files (fields begining with "`x-`") + * Ignore extension fields in `.cabal` files (fields beginning with "`x-`") * Some changes to command hooks API to improve consistency * Hugs support improvements * Added GeneralisedNewtypeDeriving language extension diff --git a/cabal/Cabal/Distribution/Backpack.hs b/cabal/Cabal/Distribution/Backpack.hs index d354bd2..bf02a5e 100644 --- a/cabal/Cabal/Distribution/Backpack.hs +++ b/cabal/Cabal/Distribution/Backpack.hs @@ -54,7 +54,6 @@ import Distribution.Types.UnitId import Distribution.Utils.Base62 import qualified Data.Map as Map -import Data.Set (Set) import qualified Data.Set as Set ----------------------------------------------------------------------- diff --git a/cabal/Cabal/Distribution/Backpack/ComponentsGraph.hs b/cabal/Cabal/Distribution/Backpack/ComponentsGraph.hs index 8a19180..aab90dd 100644 --- a/cabal/Cabal/Distribution/Backpack/ComponentsGraph.hs +++ b/cabal/Cabal/Distribution/Backpack/ComponentsGraph.hs @@ -19,6 +19,7 @@ import Distribution.Types.ComponentRequestedSpec import Distribution.Types.UnqualComponentName import Distribution.Compat.Graph (Graph, Node(..)) import qualified Distribution.Compat.Graph as Graph +import Distribution.Utils.Generic import Distribution.Pretty (pretty) import Text.PrettyPrint @@ -94,4 +95,4 @@ componentCycleMsg cnames = text $ "Components in the package depend on each other in a cyclic way:\n " ++ intercalate " depends on " [ "'" ++ showComponentName cname ++ "'" - | cname <- cnames ++ [head cnames] ] + | cname <- cnames ++ maybeToList (safeHead cnames) ] diff --git a/cabal/Cabal/Distribution/Backpack/ModSubst.hs b/cabal/Cabal/Distribution/Backpack/ModSubst.hs index 4f04ad3..7a9a01e 100644 --- a/cabal/Cabal/Distribution/Backpack/ModSubst.hs +++ b/cabal/Cabal/Distribution/Backpack/ModSubst.hs @@ -13,12 +13,10 @@ module Distribution.Backpack.ModSubst ( import Prelude () import Distribution.Compat.Prelude hiding (mod) -import Distribution.ModuleName - import Distribution.Backpack +import Distribution.ModuleName import qualified Data.Map as Map -import Data.Set (Set) import qualified Data.Set as Set -- | Applying module substitutions to semantic objects. diff --git a/cabal/Cabal/Distribution/Backpack/ModuleShape.hs b/cabal/Cabal/Distribution/Backpack/ModuleShape.hs index df98ceb..e2f7158 100644 --- a/cabal/Cabal/Distribution/Backpack/ModuleShape.hs +++ b/cabal/Cabal/Distribution/Backpack/ModuleShape.hs @@ -17,7 +17,6 @@ import Distribution.Backpack.ModSubst import Distribution.Backpack import qualified Data.Map as Map -import Data.Set (Set) import qualified Data.Set as Set ----------------------------------------------------------------------- diff --git a/cabal/Cabal/Distribution/Backpack/PreModuleShape.hs b/cabal/Cabal/Distribution/Backpack/PreModuleShape.hs index 177e637..f07cd61 100644 --- a/cabal/Cabal/Distribution/Backpack/PreModuleShape.hs +++ b/cabal/Cabal/Distribution/Backpack/PreModuleShape.hs @@ -11,7 +11,6 @@ module Distribution.Backpack.PreModuleShape ( import Prelude () import Distribution.Compat.Prelude -import Data.Set (Set) import qualified Data.Set as Set import qualified Data.Map as Map diff --git a/cabal/Cabal/Distribution/CabalSpecVersion.hs b/cabal/Cabal/Distribution/CabalSpecVersion.hs index f53d999..b1f8c2f 100644 --- a/cabal/Cabal/Distribution/CabalSpecVersion.hs +++ b/cabal/Cabal/Distribution/CabalSpecVersion.hs @@ -26,12 +26,14 @@ data CabalSpecVersion | CabalSpecV2_2 | CabalSpecV2_4 | CabalSpecV3_0 + | CabalSpecV3_2 deriving (Eq, Ord, Show, Read, Enum, Bounded, Typeable, Data, Generic) -- | Show cabal spec version, but not the way in the .cabal files -- -- @since 3.0.0.0 showCabalSpecVersion :: CabalSpecVersion -> String +showCabalSpecVersion CabalSpecV3_2 = "3.2" showCabalSpecVersion CabalSpecV3_0 = "3.0" showCabalSpecVersion CabalSpecV2_4 = "2.4" showCabalSpecVersion CabalSpecV2_2 = "2.2" @@ -49,10 +51,11 @@ showCabalSpecVersion CabalSpecV1_2 = "1.2" showCabalSpecVersion CabalSpecV1_0 = "1.0" cabalSpecLatest :: CabalSpecVersion -cabalSpecLatest = CabalSpecV3_0 +cabalSpecLatest = CabalSpecV3_2 cabalSpecFromVersionDigits :: [Int] -> CabalSpecVersion cabalSpecFromVersionDigits v + | v >= [3,1] = CabalSpecV3_2 | v >= [2,5] = CabalSpecV3_0 | v >= [2,3] = CabalSpecV2_4 | v >= [2,1] = CabalSpecV2_2 diff --git a/cabal/Cabal/Distribution/Compat/Async.hs b/cabal/Cabal/Distribution/Compat/Async.hs new file mode 100644 index 0000000..a0b36ca --- /dev/null +++ b/cabal/Cabal/Distribution/Compat/Async.hs @@ -0,0 +1,146 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +-- | 'Async', yet using 'MVar's. +-- +-- Adopted from @async@ library +-- Copyright (c) 2012, Simon Marlow +-- Licensed under BSD-3-Clause +-- +module Distribution.Compat.Async ( + AsyncM, + withAsync, waitCatch, + wait, asyncThreadId, + cancel, uninterruptibleCancel, AsyncCancelled (..), + -- * Cabal extras + withAsyncNF, + ) where + +import Control.Concurrent (ThreadId, forkIO) +import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, readMVar) +import Control.DeepSeq (NFData, force) +import Control.Exception + (BlockedIndefinitelyOnMVar (..), Exception (..), SomeException (..), catch, evaluate, mask, throwIO, throwTo, try, uninterruptibleMask_) +import Control.Monad (void) +import Data.Typeable (Typeable) +import GHC.Exts (inline) + +#if MIN_VERSION_base(4,7,0) +import Control.Exception (asyncExceptionFromException, asyncExceptionToException) +#endif + +-- | Async, but based on 'MVar', as we don't depend on @stm@. +data AsyncM a = Async + { asyncThreadId :: {-# UNPACK #-} !ThreadId + -- ^ Returns the 'ThreadId' of the thread running + -- the given 'Async'. + , _asyncMVar :: MVar (Either SomeException a) + } + +-- | Spawn an asynchronous action in a separate thread, and pass its +-- @Async@ handle to the supplied function. When the function returns +-- or throws an exception, 'uninterruptibleCancel' is called on the @Async@. +-- +-- > withAsync action inner = mask $ \restore -> do +-- > a <- async (restore action) +-- > restore (inner a) `finally` uninterruptibleCancel a +-- +-- This is a useful variant of 'async' that ensures an @Async@ is +-- never left running unintentionally. +-- +-- Note: a reference to the child thread is kept alive until the call +-- to `withAsync` returns, so nesting many `withAsync` calls requires +-- linear memory. +-- +withAsync :: IO a -> (AsyncM a -> IO b) -> IO b +withAsync = inline withAsyncUsing forkIO + +withAsyncNF :: NFData a => IO a -> (AsyncM a -> IO b) -> IO b +withAsyncNF m = inline withAsyncUsing forkIO (m >>= evaluateNF) where + evaluateNF = evaluate . force + +withAsyncUsing :: (IO () -> IO ThreadId) -> IO a -> (AsyncM a -> IO b) -> IO b +-- The bracket version works, but is slow. We can do better by +-- hand-coding it: +withAsyncUsing doFork = \action inner -> do + var <- newEmptyMVar + mask $ \restore -> do + t <- doFork $ try (restore action) >>= putMVar var + let a = Async t var + r <- restore (inner a) `catchAll` \e -> do + uninterruptibleCancel a + throwIO e + uninterruptibleCancel a + return r + +-- | Wait for an asynchronous action to complete, and return its +-- value. If the asynchronous action threw an exception, then the +-- exception is re-thrown by 'wait'. +-- +-- > wait = atomically . waitSTM +-- +{-# INLINE wait #-} +wait :: AsyncM a -> IO a +wait a = do + res <- waitCatch a + case res of + Left (SomeException e) -> throwIO e + Right x -> return x + +-- | Wait for an asynchronous action to complete, and return either +-- @Left e@ if the action raised an exception @e@, or @Right a@ if it +-- returned a value @a@. +-- +-- > waitCatch = atomically . waitCatchSTM +-- +{-# INLINE waitCatch #-} +waitCatch :: AsyncM a -> IO (Either SomeException a) +waitCatch (Async _ var) = tryAgain (readMVar var) + where + -- See: https://github.com/simonmar/async/issues/14 + tryAgain f = f `catch` \BlockedIndefinitelyOnMVar -> f + +catchAll :: IO a -> (SomeException -> IO a) -> IO a +catchAll = catch + +-- | Cancel an asynchronous action by throwing the @AsyncCancelled@ +-- exception to it, and waiting for the `Async` thread to quit. +-- Has no effect if the 'Async' has already completed. +-- +-- > cancel a = throwTo (asyncThreadId a) AsyncCancelled <* waitCatch a +-- +-- Note that 'cancel' will not terminate until the thread the 'Async' +-- refers to has terminated. This means that 'cancel' will block for +-- as long said thread blocks when receiving an asynchronous exception. +-- +-- For example, it could block if: +-- +-- * It's executing a foreign call, and thus cannot receive the asynchronous +-- exception; +-- * It's executing some cleanup handler after having received the exception, +-- and the handler is blocking. +{-# INLINE cancel #-} +cancel :: AsyncM a -> IO () +cancel a@(Async t _) = do + throwTo t AsyncCancelled + void (waitCatch a) + +-- | The exception thrown by `cancel` to terminate a thread. +data AsyncCancelled = AsyncCancelled + deriving (Show, Eq + , Typeable + ) + +instance Exception AsyncCancelled where +#if MIN_VERSION_base(4,7,0) + -- wraps in SomeAsyncException + -- See https://github.com/ghc/ghc/commit/756a970eacbb6a19230ee3ba57e24999e4157b09 + fromException = asyncExceptionFromException + toException = asyncExceptionToException +#endif + +-- | Cancel an asynchronous action +-- +-- This is a variant of `cancel`, but it is not interruptible. +{-# INLINE uninterruptibleCancel #-} +uninterruptibleCancel :: AsyncM a -> IO () +uninterruptibleCancel = uninterruptibleMask_ . cancel diff --git a/cabal/Cabal/Distribution/Compat/DList.hs b/cabal/Cabal/Distribution/Compat/DList.hs index 76e8303..55a1b8c 100644 --- a/cabal/Cabal/Distribution/Compat/DList.hs +++ b/cabal/Cabal/Distribution/Compat/DList.hs @@ -19,7 +19,7 @@ module Distribution.Compat.DList ( ) where import Prelude () -import Distribution.Compat.Prelude +import Distribution.Compat.Prelude hiding (toList) -- | Difference list. newtype DList a = DList ([a] -> [a]) diff --git a/cabal/Cabal/Distribution/Compat/FilePath.hs b/cabal/Cabal/Distribution/Compat/FilePath.hs new file mode 100644 index 0000000..8c5b11a --- /dev/null +++ b/cabal/Cabal/Distribution/Compat/FilePath.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE CPP #-} + +{-# OPTIONS_GHC -fno-warn-unused-imports #-} + +module Distribution.Compat.FilePath +( isExtensionOf +, stripExtension +) where + +import Data.List ( isSuffixOf, stripPrefix ) +import System.FilePath + +#if !MIN_VERSION_filepath(1,4,2) +isExtensionOf :: String -> FilePath -> Bool +isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions +isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions +#endif + +#if !MIN_VERSION_filepath(1,4,1) +stripExtension :: String -> FilePath -> Maybe FilePath +stripExtension [] path = Just path +stripExtension ext@(x:_) path = stripSuffix dotExt path + where + dotExt = if isExtSeparator x then ext else '.':ext + stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] + stripSuffix xs ys = fmap reverse $ stripPrefix (reverse xs) (reverse ys) +#endif diff --git a/cabal/Cabal/Distribution/Compat/Graph.hs b/cabal/Cabal/Distribution/Compat/Graph.hs index e26eae8..dce3c6c 100644 --- a/cabal/Cabal/Distribution/Compat/Graph.hs +++ b/cabal/Cabal/Distribution/Compat/Graph.hs @@ -85,7 +85,7 @@ module Distribution.Compat.Graph ( import Prelude () import qualified Distribution.Compat.Prelude as Prelude -import Distribution.Compat.Prelude hiding (lookup, null, empty) +import Distribution.Compat.Prelude hiding (lookup, null, empty, toList) import Data.Graph (SCC(..)) import qualified Data.Graph as G diff --git a/cabal/Cabal/Distribution/Compat/Lens.hs b/cabal/Cabal/Distribution/Compat/Lens.hs index e353d9f..748c23d 100644 --- a/cabal/Cabal/Distribution/Compat/Lens.hs +++ b/cabal/Cabal/Distribution/Compat/Lens.hs @@ -51,7 +51,6 @@ import Prelude() import Distribution.Compat.Prelude import Control.Applicative (Const (..)) -import Data.Functor.Identity (Identity (..)) import Control.Monad.State.Class (MonadState (..), gets, modify) import qualified Distribution.Compat.DList as DList @@ -72,7 +71,7 @@ type Traversal' s a = Traversal s s a a type Getting r s a = LensLike (Const r) s s a a -type AGetter s a = LensLike (Const a) s s a a -- this doens't exist in 'lens' +type AGetter s a = LensLike (Const a) s s a a -- this doesn't exist in 'lens' type ASetter s t a b = LensLike Identity s t a b type ALens s t a b = LensLike (Pretext a b) s t a b diff --git a/cabal/Cabal/Distribution/Compat/MD5.hs b/cabal/Cabal/Distribution/Compat/MD5.hs new file mode 100644 index 0000000..6189aa9 --- /dev/null +++ b/cabal/Cabal/Distribution/Compat/MD5.hs @@ -0,0 +1,50 @@ +module Distribution.Compat.MD5 ( + MD5, + showMD5, + md5, + -- * Binary + binaryPutMD5, + binaryGetMD5, + ) where + +import Data.Binary (Get, Put) +import Data.Binary.Get (getWord64le) +import Data.Binary.Put (putWord64le) +import Foreign.Ptr (castPtr) +import GHC.Fingerprint (Fingerprint (..), fingerprintData) +import Numeric (showHex) +import System.IO.Unsafe (unsafeDupablePerformIO) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BS + +type MD5 = Fingerprint + +-- | Show 'MD5' in human readable form +-- +-- >>> showMD5 (Fingerprint 123 456) +-- "000000000000007b00000000000001c8" +-- +-- >>> showMD5 $ md5 $ BS.pack [0..127] +-- "37eff01866ba3f538421b30b7cbefcac" +-- +showMD5 :: MD5 -> String +showMD5 (Fingerprint a b) = pad a' ++ pad b' where + a' = showHex a "" + b' = showHex b "" + pad s = replicate (16 - length s) '0' ++ s + +md5 :: BS.ByteString -> MD5 +md5 bs = unsafeDupablePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> + fingerprintData (castPtr ptr) len + +binaryPutMD5 :: MD5 -> Put +binaryPutMD5 (Fingerprint a b) = do + putWord64le a + putWord64le b + +binaryGetMD5 :: Get MD5 +binaryGetMD5 = do + a <- getWord64le + b <- getWord64le + return (Fingerprint a b) diff --git a/cabal/Cabal/Distribution/Compat/Parsing.hs b/cabal/Cabal/Distribution/Compat/Parsing.hs index afc995f..cc4abd2 100644 --- a/cabal/Cabal/Distribution/Compat/Parsing.hs +++ b/cabal/Cabal/Distribution/Compat/Parsing.hs @@ -25,13 +25,10 @@ module Distribution.Compat.Parsing , some -- from Control.Applicative, parsec many1 , many -- from Control.Applicative , sepBy - , sepBy1 , sepByNonEmpty - , sepEndBy1 - -- , sepEndByNonEmpty + , sepEndByNonEmpty , sepEndBy - , endBy1 - -- , endByNonEmpty + , endByNonEmpty , endBy , count , chainl @@ -58,6 +55,7 @@ import Control.Monad.Trans.Reader (ReaderT (..)) import Control.Monad.Trans.Identity (IdentityT (..)) import Data.Foldable (asum) +import qualified Data.List.NonEmpty as NE import qualified Text.Parsec as Parsec -- | @choice ps@ tries to apply the parsers in the list @ps@ in order, @@ -96,36 +94,20 @@ between bra ket p = bra *> p <* ket -- -- > commaSep p = p `sepBy` (symbol ",") sepBy :: Alternative m => m a -> m sep -> m [a] -sepBy p sep = sepBy1 p sep <|> pure [] +sepBy p sep = toList <$> sepByNonEmpty p sep <|> pure [] {-# INLINE sepBy #-} --- | @sepBy1 p sep@ parses /one/ or more occurrences of @p@, separated --- by @sep@. Returns a list of values returned by @p@. -sepBy1 :: Alternative m => m a -> m sep -> m [a] -sepBy1 p sep = (:) <$> p <*> many (sep *> p) --- toList <$> sepByNonEmpty p sep -{-# INLINE sepBy1 #-} - -- | @sepByNonEmpty p sep@ parses /one/ or more occurrences of @p@, separated -- by @sep@. Returns a non-empty list of values returned by @p@. sepByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a) sepByNonEmpty p sep = (:|) <$> p <*> many (sep *> p) {-# INLINE sepByNonEmpty #-} --- | @sepEndBy1 p sep@ parses /one/ or more occurrences of @p@, --- separated and optionally ended by @sep@. Returns a list of values --- returned by @p@. -sepEndBy1 :: Alternative m => m a -> m sep -> m [a] -sepEndBy1 p sep = (:) <$> p <*> ((sep *> sepEndBy p sep) <|> pure []) --- toList <$> sepEndByNonEmpty p sep - -{- -- | @sepEndByNonEmpty p sep@ parses /one/ or more occurrences of @p@, -- separated and optionally ended by @sep@. Returns a non-empty list of values -- returned by @p@. sepEndByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a) sepEndByNonEmpty p sep = (:|) <$> p <*> ((sep *> sepEndBy p sep) <|> pure []) --} -- | @sepEndBy p sep@ parses /zero/ or more occurrences of @p@, -- separated and optionally ended by @sep@, ie. haskell style @@ -133,22 +115,14 @@ sepEndByNonEmpty p sep = (:|) <$> p <*> ((sep *> sepEndBy p sep) <|> pure []) -- -- > haskellStatements = haskellStatement `sepEndBy` semi sepEndBy :: Alternative m => m a -> m sep -> m [a] -sepEndBy p sep = sepEndBy1 p sep <|> pure [] +sepEndBy p sep = toList <$> sepEndByNonEmpty p sep <|> pure [] {-# INLINE sepEndBy #-} --- | @endBy1 p sep@ parses /one/ or more occurrences of @p@, separated --- and ended by @sep@. Returns a list of values returned by @p@. -endBy1 :: Alternative m => m a -> m sep -> m [a] -endBy1 p sep = some (p <* sep) -{-# INLINE endBy1 #-} - -{- -- | @endByNonEmpty p sep@ parses /one/ or more occurrences of @p@, separated -- and ended by @sep@. Returns a non-empty list of values returned by @p@. endByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a) -endByNonEmpty p sep = some1 (p <* sep) +endByNonEmpty p sep = NE.some1 (p <* sep) {-# INLINE endByNonEmpty #-} --} -- | @endBy p sep@ parses /zero/ or more occurrences of @p@, separated -- and ended by @sep@. Returns a list of values returned by @p@. diff --git a/cabal/Cabal/Distribution/Compat/Prelude.hs b/cabal/Cabal/Distribution/Compat/Prelude.hs index c3bc040..e71ec19 100644 --- a/cabal/Cabal/Distribution/Compat/Prelude.hs +++ b/cabal/Cabal/Distribution/Compat/Prelude.hs @@ -45,6 +45,9 @@ module Distribution.Compat.Prelude ( -- * Some types IO, NoCallStackIO, Map, + Set, + Identity (..), + Proxy (..), -- * Data.Maybe catMaybes, mapMaybe, @@ -61,6 +64,7 @@ module Distribution.Compat.Prelude ( -- * Data.List.NonEmpty NonEmpty((:|)), foldl1, foldr1, + head, tail, last, init, -- * Data.Foldable Foldable, foldMap, foldr, @@ -68,6 +72,7 @@ module Distribution.Compat.Prelude ( find, foldl', traverse_, for_, any, all, + toList, -- * Data.Traversable Traversable, traverse, sequenceA, @@ -100,7 +105,7 @@ module Distribution.Compat.Prelude ( ) where -- We also could hide few partial function import Prelude as BasePrelude hiding - ( IO, mapM, mapM_, sequence, null, length, foldr, any, all + ( IO, mapM, mapM_, sequence, null, length, foldr, any, all, head, tail, last, init -- partial functions , read , foldr1, foldl1 @@ -120,8 +125,9 @@ import Prelude as BasePrelude hiding #if !MINVER_base_48 import Control.Applicative (Applicative (..), (<$), (<$>)) import Distribution.Compat.Semigroup (Monoid (..)) +import Data.Foldable (toList) #else -import Data.Foldable (length, null) +import Data.Foldable (length, null, Foldable(toList)) #endif import Data.Foldable (Foldable (foldMap, foldr), find, foldl', for_, traverse_, any, all) @@ -138,7 +144,10 @@ import GHC.Generics (Generic, Rep(..), V1, U1(U1), K1(unK1), M1(unM1), (:*:)((:*:)), (:+:)(L1,R1)) +import Data.Functor.Identity (Identity (..)) import Data.Map (Map) +import Data.Proxy (Proxy (..)) +import Data.Set (Set) import Control.Arrow (first) import Control.Monad hiding (mapM) @@ -146,7 +155,7 @@ import Data.Char import Data.List (intercalate, intersperse, isPrefixOf, isSuffixOf, nub, nubBy, sort, sortBy, unfoldr) -import Data.List.NonEmpty (NonEmpty((:|))) +import Data.List.NonEmpty (NonEmpty((:|)), head, tail, init, last) import Data.Maybe import Data.String (IsString (..)) import Data.Int diff --git a/cabal/Cabal/Distribution/FieldGrammar/Class.hs b/cabal/Cabal/Distribution/FieldGrammar/Class.hs index 872b402..f08566a 100644 --- a/cabal/Cabal/Distribution/FieldGrammar/Class.hs +++ b/cabal/Cabal/Distribution/FieldGrammar/Class.hs @@ -10,8 +10,6 @@ import Distribution.Compat.Lens import Distribution.Compat.Prelude import Prelude () -import Data.Functor.Identity (Identity (..)) - import Distribution.CabalSpecVersion (CabalSpecVersion) import Distribution.Compat.Newtype (Newtype) import Distribution.Fields.Field diff --git a/cabal/Cabal/Distribution/FieldGrammar/Parsec.hs b/cabal/Cabal/Distribution/FieldGrammar/Parsec.hs index 7b712e3..1c81985 100644 --- a/cabal/Cabal/Distribution/FieldGrammar/Parsec.hs +++ b/cabal/Cabal/Distribution/FieldGrammar/Parsec.hs @@ -47,7 +47,7 @@ -- is obviously invalid specification. -- -- We can parse 'Fields' like we parse @aeson@ objects, yet we use --- slighly higher-level API, so we can process unspecified fields, +-- slightly higher-level API, so we can process unspecified fields, -- to report unknown fields and save custom @x-fields@. -- module Distribution.FieldGrammar.Parsec ( @@ -66,17 +66,17 @@ module Distribution.FieldGrammar.Parsec ( import Data.List (dropWhileEnd) import Data.Ord (comparing) -import Data.Set (Set) import Distribution.Compat.Newtype import Distribution.Compat.Prelude import Distribution.Simple.Utils (fromUTF8BS) import Prelude () -import qualified Data.ByteString as BS -import qualified Data.Map.Strict as Map -import qualified Data.Set as Set -import qualified Text.Parsec as P -import qualified Text.Parsec.Error as P +import qualified Data.ByteString as BS +import qualified Data.List.NonEmpty as NE +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import qualified Text.Parsec as P +import qualified Text.Parsec.Error as P import Distribution.CabalSpecVersion import Distribution.FieldGrammar.Class @@ -156,12 +156,12 @@ instance FieldGrammar ParsecFieldGrammar where uniqueFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser where parser v fields = case Map.lookup fn fields of - Nothing -> parseFatalFailure zeroPos $ show fn ++ " field missing" - Just [] -> parseFatalFailure zeroPos $ show fn ++ " field missing" - Just [x] -> parseOne v x - Just xs -> do + Nothing -> parseFatalFailure zeroPos $ show fn ++ " field missing" + Just [] -> parseFatalFailure zeroPos $ show fn ++ " field missing" + Just [x] -> parseOne v x + Just xs@(_:y:ys) -> do warnMultipleSingularFields fn xs - last <$> traverse (parseOne v) xs + NE.last <$> traverse (parseOne v) (y:|ys) parseOne v (MkNamelessField pos fls) = unpack' _pack <$> runFieldParser pos parsec v fls @@ -169,24 +169,24 @@ instance FieldGrammar ParsecFieldGrammar where booleanFieldDef fn _extract def = ParsecFG (Set.singleton fn) Set.empty parser where parser v fields = case Map.lookup fn fields of - Nothing -> pure def - Just [] -> pure def - Just [x] -> parseOne v x - Just xs -> do + Nothing -> pure def + Just [] -> pure def + Just [x] -> parseOne v x + Just xs@(_:y:ys) -> do warnMultipleSingularFields fn xs - last <$> traverse (parseOne v) xs + NE.last <$> traverse (parseOne v) (y:|ys) parseOne v (MkNamelessField pos fls) = runFieldParser pos parsec v fls optionalFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser where parser v fields = case Map.lookup fn fields of - Nothing -> pure Nothing - Just [] -> pure Nothing - Just [x] -> parseOne v x - Just xs -> do + Nothing -> pure Nothing + Just [] -> pure Nothing + Just [x] -> parseOne v x + Just xs@(_:y:ys) -> do warnMultipleSingularFields fn xs - last <$> traverse (parseOne v) xs + NE.last <$> traverse (parseOne v) (y:|ys) parseOne v (MkNamelessField pos fls) | null fls = pure Nothing @@ -195,12 +195,12 @@ instance FieldGrammar ParsecFieldGrammar where optionalFieldDefAla fn _pack _extract def = ParsecFG (Set.singleton fn) Set.empty parser where parser v fields = case Map.lookup fn fields of - Nothing -> pure def - Just [] -> pure def - Just [x] -> parseOne v x - Just xs -> do + Nothing -> pure def + Just [] -> pure def + Just [x] -> parseOne v x + Just xs@(_:y:ys) -> do warnMultipleSingularFields fn xs - last <$> traverse (parseOne v) xs + NE.last <$> traverse (parseOne v) (y:|ys) parseOne v (MkNamelessField pos fls) | null fls = pure def @@ -208,12 +208,12 @@ instance FieldGrammar ParsecFieldGrammar where freeTextField fn _ = ParsecFG (Set.singleton fn) Set.empty parser where parser v fields = case Map.lookup fn fields of - Nothing -> pure Nothing - Just [] -> pure Nothing - Just [x] -> parseOne v x - Just xs -> do + Nothing -> pure Nothing + Just [] -> pure Nothing + Just [x] -> parseOne v x + Just xs@(_:y:ys) -> do warnMultipleSingularFields fn xs - last <$> traverse (parseOne v) xs + NE.last <$> traverse (parseOne v) (y:|ys) parseOne v (MkNamelessField pos fls) | null fls = pure Nothing @@ -222,12 +222,12 @@ instance FieldGrammar ParsecFieldGrammar where freeTextFieldDef fn _ = ParsecFG (Set.singleton fn) Set.empty parser where parser v fields = case Map.lookup fn fields of - Nothing -> pure "" - Just [] -> pure "" - Just [x] -> parseOne v x - Just xs -> do + Nothing -> pure "" + Just [] -> pure "" + Just [x] -> parseOne v x + Just xs@(_:y:ys) -> do warnMultipleSingularFields fn xs - last <$> traverse (parseOne v) xs + NE.last <$> traverse (parseOne v) (y:|ys) parseOne v (MkNamelessField pos fls) | null fls = pure "" diff --git a/cabal/Cabal/Distribution/Fields/ConfVar.hs b/cabal/Cabal/Distribution/Fields/ConfVar.hs index 52f1053..7344d50 100644 --- a/cabal/Cabal/Distribution/Fields/ConfVar.hs +++ b/cabal/Cabal/Distribution/Fields/ConfVar.hs @@ -9,7 +9,7 @@ import Distribution.Parsec.FieldLineStream (fieldLineStreamFromBS) import Distribution.Fields.Field (SectionArg (..)) import Distribution.Fields.ParseResult import Distribution.Types.Condition -import Distribution.Types.GenericPackageDescription (ConfVar (..)) +import Distribution.Types.ConfVar (ConfVar (..)) import Distribution.Version (anyVersion, earlierVersion, intersectVersionRanges, laterVersion, majorBoundVersion, mkVersion, noVersion, orEarlierVersion, orLaterVersion, thisVersion, unionVersionRanges, diff --git a/cabal/Cabal/Distribution/Fields/Field.hs b/cabal/Cabal/Distribution/Fields/Field.hs index 5e49d17..c2b97ff 100644 --- a/cabal/Cabal/Distribution/Fields/Field.hs +++ b/cabal/Cabal/Distribution/Fields/Field.hs @@ -47,7 +47,7 @@ fieldName (Section n _ _) = n fieldAnn :: Field ann -> ann fieldAnn = nameAnn . fieldName --- | All transitive descendands of 'Field', including itself. +-- | All transitive descendants of 'Field', including itself. -- -- /Note:/ the resulting list is never empty. -- diff --git a/cabal/Cabal/Distribution/Fields/Lexer.hs b/cabal/Cabal/Distribution/Fields/Lexer.hs index 8a6d504..9116ce3 100644 --- a/cabal/Cabal/Distribution/Fields/Lexer.hs +++ b/cabal/Cabal/Distribution/Fields/Lexer.hs @@ -60,11 +60,11 @@ import qualified Data.Text.Encoding.Error as T #endif #if __GLASGOW_HASKELL__ >= 503 import Data.Array -import Data.Array.Base (unsafeAt) #else import Array #endif #if __GLASGOW_HASKELL__ >= 503 +import Data.Array.Base (unsafeAt) import GHC.Exts #else import GlaExts diff --git a/cabal/Cabal/Distribution/Fields/LexerMonad.hs b/cabal/Cabal/Distribution/Fields/LexerMonad.hs index 3d1fd64..3c11fac 100644 --- a/cabal/Cabal/Distribution/Fields/LexerMonad.hs +++ b/cabal/Cabal/Distribution/Fields/LexerMonad.hs @@ -32,6 +32,7 @@ module Distribution.Fields.LexerMonad ( ) where import qualified Data.ByteString as B +import qualified Data.List.NonEmpty as NE import Distribution.Compat.Prelude import Distribution.Parsec.Position (Position (..), showPos) import Distribution.Parsec.Warning (PWarnType (..), PWarning (..)) @@ -76,15 +77,15 @@ toPWarnings :: [LexWarning] -> [PWarning] toPWarnings = map (uncurry toWarning) . Map.toList - . Map.fromListWith (++) - . map (\(LexWarning t p) -> (t, [p])) + . Map.fromListWith (<>) + . map (\(LexWarning t p) -> (t, pure p)) where toWarning LexWarningBOM poss = - PWarning PWTLexBOM (head poss) "Byte-order mark found at the beginning of the file" + PWarning PWTLexBOM (NE.head poss) "Byte-order mark found at the beginning of the file" toWarning LexWarningNBSP poss = - PWarning PWTLexNBSP (head poss) $ "Non breaking spaces at " ++ intercalate ", " (map showPos poss) + PWarning PWTLexNBSP (NE.head poss) $ "Non breaking spaces at " ++ intercalate ", " (NE.toList $ fmap showPos poss) toWarning LexWarningTab poss = - PWarning PWTLexTab (head poss) $ "Tabs used as indentation at " ++ intercalate ", " (map showPos poss) + PWarning PWTLexTab (NE.head poss) $ "Tabs used as indentation at " ++ intercalate ", " (NE.toList $ fmap showPos poss) data LexState = LexState { curPos :: {-# UNPACK #-} !Position, -- ^ position at current input location diff --git a/cabal/Cabal/Distribution/Fields/Pretty.hs b/cabal/Cabal/Distribution/Fields/Pretty.hs index 9c673a4..4b03826 100644 --- a/cabal/Cabal/Distribution/Fields/Pretty.hs +++ b/cabal/Cabal/Distribution/Fields/Pretty.hs @@ -20,7 +20,6 @@ module Distribution.Fields.Pretty ( prettySectionArgs, ) where -import Data.Functor.Identity (Identity (..)) import Distribution.Compat.Prelude import Distribution.Pretty (showToken) import Prelude () diff --git a/cabal/Cabal/Distribution/InstalledPackageInfo.hs b/cabal/Cabal/Distribution/InstalledPackageInfo.hs index a92af01..18126c5 100644 --- a/cabal/Cabal/Distribution/InstalledPackageInfo.hs +++ b/cabal/Cabal/Distribution/InstalledPackageInfo.hs @@ -43,7 +43,6 @@ module Distribution.InstalledPackageInfo ( import Distribution.Compat.Prelude import Prelude () -import Data.Set (Set) import Distribution.Backpack import Distribution.CabalSpecVersion (cabalSpecLatest) import Distribution.FieldGrammar diff --git a/cabal/Cabal/Distribution/ModuleName.hs b/cabal/Cabal/Distribution/ModuleName.hs index e004fd1..99f7416 100644 --- a/cabal/Cabal/Distribution/ModuleName.hs +++ b/cabal/Cabal/Distribution/ModuleName.hs @@ -50,7 +50,7 @@ instance Pretty ModuleName where Disp.hcat (intersperse (Disp.char '.') (map Disp.text $ stlToStrings ms)) instance Parsec ModuleName where - parsec = fromComponents <$> P.sepBy1 component (P.char '.') + parsec = fromComponents <$> toList <$> P.sepByNonEmpty component (P.char '.') where component = do c <- P.satisfy isUpper diff --git a/cabal/Cabal/Distribution/PackageDescription.hs b/cabal/Cabal/Distribution/PackageDescription.hs index 8c0d6d4..1eb3ef4 100644 --- a/cabal/Cabal/Distribution/PackageDescription.hs +++ b/cabal/Cabal/Distribution/PackageDescription.hs @@ -140,3 +140,5 @@ import Distribution.Types.ComponentName import Distribution.Types.LibraryName import Distribution.Types.HookedBuildInfo import Distribution.Types.SourceRepo +import Distribution.Types.Flag +import Distribution.Types.ConfVar diff --git a/cabal/Cabal/Distribution/PackageDescription/Check.hs b/cabal/Cabal/Distribution/PackageDescription/Check.hs index 734e52c..2b5f6c5 100644 --- a/cabal/Cabal/Distribution/PackageDescription/Check.hs +++ b/cabal/Cabal/Distribution/PackageDescription/Check.hs @@ -57,7 +57,7 @@ import Distribution.Types.CondTree import Distribution.Types.ExeDependency import Distribution.Types.LibraryName import Distribution.Types.UnqualComponentName -import Distribution.Utils.Generic (isAscii) +import Distribution.Utils.Generic (isAscii, safeInit) import Distribution.Verbosity import Distribution.Version import Language.Haskell.Extension @@ -1026,13 +1026,18 @@ checkCLikeOptions label prefix accessor pkg = 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] +checkCPPOptions pkg = catMaybes + [ checkAlternatives "cpp-options" "include-dirs" + [ (flag, dir) | flag@('-':'I':dir) <- all_cppOptions ] + ] + ++ + [ PackageBuildWarning $ "'cpp-options': " ++ opt ++ " is not portable C-preprocessor flag" + | 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 ] + where + all_cppOptions = [ opts | bi <- allBuildInfo pkg, opts <- cppOptions bi ] checkAlternatives :: String -> String -> [(String, String)] -> Maybe PackageCheck @@ -1587,8 +1592,8 @@ checkPackageVersions pkg = boundedAbove :: VersionRange -> Bool boundedAbove vr = case asVersionIntervals vr of - [] -> True -- this is the inconsistent version range. - intervals -> case last intervals of + [] -> True -- this is the inconsistent version range. + (x:xs) -> case last (x:|xs) of (_, UpperBound _ _) -> True (_, NoUpperBound ) -> False @@ -2141,7 +2146,7 @@ checkTarPath path Right (_:_) -> Just noSplit where -- drop the '/' between the name and prefix: - remainder = init h : rest + remainder = safeInit h : rest where nameMax, prefixMax :: Int diff --git a/cabal/Cabal/Distribution/PackageDescription/Configuration.hs b/cabal/Cabal/Distribution/PackageDescription/Configuration.hs index 49f79c7..ee53b77 100644 --- a/cabal/Cabal/Distribution/PackageDescription/Configuration.hs +++ b/cabal/Cabal/Distribution/PackageDescription/Configuration.hs @@ -66,7 +66,6 @@ import Distribution.Types.DependencyMap import qualified Data.Map.Strict as Map.Strict import qualified Data.Map.Lazy as Map -import Data.Set ( Set ) import qualified Data.Set as Set import Data.Tree ( Tree(Node) ) diff --git a/cabal/Cabal/Distribution/PackageDescription/FieldGrammar.hs b/cabal/Cabal/Distribution/PackageDescription/FieldGrammar.hs index 285a01b..5a7fc41 100644 --- a/cabal/Cabal/Distribution/PackageDescription/FieldGrammar.hs +++ b/cabal/Cabal/Distribution/PackageDescription/FieldGrammar.hs @@ -390,7 +390,9 @@ buildInfoFieldGrammar = BuildInfo -- I.e. we don't want trigger unknown field warning <*> monoidalFieldAla "cpp-options" (alaList' NoCommaFSep Token') L.cppOptions <*> monoidalFieldAla "asm-options" (alaList' NoCommaFSep Token') L.asmOptions + ^^^ availableSince CabalSpecV3_0 [] <*> monoidalFieldAla "cmm-options" (alaList' NoCommaFSep Token') L.cmmOptions + ^^^ availableSince CabalSpecV3_0 [] <*> monoidalFieldAla "cc-options" (alaList' NoCommaFSep Token') L.ccOptions <*> monoidalFieldAla "cxx-options" (alaList' NoCommaFSep Token') L.cxxOptions ^^^ availableSince CabalSpecV2_2 [] @@ -399,7 +401,9 @@ buildInfoFieldGrammar = BuildInfo <*> monoidalFieldAla "frameworks" (alaList' FSep Token) L.frameworks <*> monoidalFieldAla "extra-framework-dirs" (alaList' FSep FilePathNT) L.extraFrameworkDirs <*> monoidalFieldAla "asm-sources" (alaList' VCat FilePathNT) L.asmSources + ^^^ availableSince CabalSpecV3_0 [] <*> monoidalFieldAla "cmm-sources" (alaList' VCat FilePathNT) L.cmmSources + ^^^ availableSince CabalSpecV3_0 [] <*> monoidalFieldAla "c-sources" (alaList' VCat FilePathNT) L.cSources <*> monoidalFieldAla "cxx-sources" (alaList' VCat FilePathNT) L.cxxSources ^^^ availableSince CabalSpecV2_2 [] diff --git a/cabal/Cabal/Distribution/PackageDescription/PrettyPrint.hs b/cabal/Cabal/Distribution/PackageDescription/PrettyPrint.hs index f7cf2f6..aed448b 100644 --- a/cabal/Cabal/Distribution/PackageDescription/PrettyPrint.hs +++ b/cabal/Cabal/Distribution/PackageDescription/PrettyPrint.hs @@ -126,17 +126,10 @@ ppCondTree2 v grammar = go thenDoc = go thenTree ppIf (CondBranch c thenTree (Just elseTree)) = - case (False, False) of - -- case (isEmpty thenDoc, isEmpty elseDoc) of - (True, True) -> mempty - (False, True) -> [ ppIfCondition c thenDoc ] - (True, False) -> [ ppIfCondition (cNot c) elseDoc ] - (False, False) -> [ ppIfCondition c thenDoc - , PrettySection () "else" [] elseDoc - ] - where - thenDoc = go thenTree - elseDoc = go elseTree + -- See #6193 + [ ppIfCondition c (go thenTree) + , PrettySection () "else" [] (go elseTree) + ] ppCondLibrary :: CabalSpecVersion -> Maybe (CondTree ConfVar [Dependency] Library) -> [PrettyField ()] ppCondLibrary _ Nothing = mempty diff --git a/cabal/Cabal/Distribution/PackageDescription/Quirks.hs b/cabal/Cabal/Distribution/PackageDescription/Quirks.hs index 37d75e8..d154d96 100644 --- a/cabal/Cabal/Distribution/PackageDescription/Quirks.hs +++ b/cabal/Cabal/Distribution/PackageDescription/Quirks.hs @@ -1,19 +1,17 @@ -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} -- | -- -- @since 2.2.0.0 module Distribution.PackageDescription.Quirks (patchQuirks) where -import Prelude () -import Distribution.Compat.Prelude -import GHC.Fingerprint (Fingerprint (..), fingerprintData) -import Foreign.Ptr (castPtr) -import System.IO.Unsafe (unsafeDupablePerformIO) +import Distribution.Compat.MD5 +import Distribution.Compat.Prelude +import GHC.Fingerprint (Fingerprint (..)) +import Prelude () import qualified Data.ByteString as BS -import qualified Data.ByteString.Unsafe as BS -import qualified Data.Map as Map +import qualified Data.Map as Map -- | Patch legacy @.cabal@ file contents to allow parsec parser to accept -- all of Hackage. @@ -30,13 +28,7 @@ patchQuirks bs = case Map.lookup (BS.take 256 bs, md5 bs) patches of where output = f bs -md5 :: BS.ByteString -> Fingerprint -md5 bs = unsafeDupablePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> - fingerprintData (castPtr ptr) len - -- | 'patches' contains first 256 bytes, pre- and post-fingerprints and a patch function. --- --- patches :: Map.Map (BS.ByteString, Fingerprint) (Fingerprint, BS.ByteString -> BS.ByteString) patches = Map.fromList -- http://hackage.haskell.org/package/unicode-transforms-0.3.3 @@ -241,6 +233,24 @@ patches = Map.fromList (Fingerprint 12694656661460787751 1902242956706735615) (Fingerprint 15433152131513403849 2284712791516353264) (bsReplace "1.2.03.0" "1.2.3.0") + -- 9 digits limit + , mk "Name: SGplus\nVersion: 1.1\nSynopsis: (updated) Small geometry library for dealing with vectors and collision detection\nLicense: BSD3\nLicense-file: LICENSE\nAuthor: Neil Brown\nMaintainer: " + (Fingerprint 17735649550442248029 11493772714725351354) + (Fingerprint 9565458801063261772 15955773698774721052) + (bsReplace "1000000000" "100000000") + , mk "-- Initial control-dotdotdot.cabal generated by cabal init. For further \n-- documentation, see http://haskell.org/cabal/users-guide/\n\nname: control-dotdotdot\nversion: 0.1.0.1\nsynopsis: Haskell operator\n " + (Fingerprint 1514257173776509942 7756050823377346485) + (Fingerprint 14082092642045505999 18415918653404121035) + (bsReplace "9223372036854775807" "5") + , mk "name: data-foldapp\r\nversion: 0.1.1.0\r\nsynopsis: Fold function applications. Framework for variadic functions.\r\ndescription: Fold function applications. Framework for variadic functions.\r\nhomepage: ht" + (Fingerprint 4511234156311243251 11701153011544112556) + (Fingerprint 11820542702491924189 4902231447612406724) + (bsReplace "9223372036854775807" "999" . bsReplace "9223372036854775807" "999") + , mk "-- Initial data-list-zigzag.cabal generated by cabal init. For further \r\n-- documentation, see http://haskell.org/cabal/users-guide/\r\n\r\nname: data-list-zigzag\r\nversion: 0.1.1.1\r\nsynopsis: A list but with a balanced en" + (Fingerprint 12475837388692175691 18053834261188158945) + (Fingerprint 16279938253437334942 15753349540193002309) + (bsReplace "9223372036854775807" "999") + ] where mk a b c d = ((a, b), (c, d)) diff --git a/cabal/Cabal/Distribution/Parsec.hs b/cabal/Cabal/Distribution/Parsec.hs index 3b23a31..cd461a0 100644 --- a/cabal/Cabal/Distribution/Parsec.hs +++ b/cabal/Cabal/Distribution/Parsec.hs @@ -42,7 +42,6 @@ module Distribution.Parsec ( ) where import Data.Char (digitToInt, intToDigit) -import Data.Functor.Identity (Identity (..)) import Data.List (transpose) import Distribution.CabalSpecVersion import Distribution.Compat.Prelude @@ -260,8 +259,8 @@ parsecLeadingCommaList :: CabalParsing m => m a -> m [a] parsecLeadingCommaList p = do c <- P.optional comma case c of - Nothing -> P.sepEndBy1 lp comma <|> pure [] - Just _ -> P.sepBy1 lp comma + Nothing -> toList <$> P.sepEndByNonEmpty lp comma <|> pure [] + Just _ -> toList <$> P.sepByNonEmpty lp comma where lp = p <* P.spaces comma = P.char ',' *> P.spaces P.<?> "comma" @@ -269,7 +268,7 @@ parsecLeadingCommaList p = do parsecOptCommaList :: CabalParsing m => m a -> m [a] parsecOptCommaList p = P.sepBy (p <* P.spaces) (P.optional comma) where - comma = P.char ',' *> P.spaces + comma = P.char ',' *> P.spaces -- | Like 'parsecOptCommaList' but -- @@ -290,7 +289,7 @@ parsecLeadingOptCommaList p = do c <- P.optional comma case c of Nothing -> sepEndBy1Start <|> pure [] - Just _ -> P.sepBy1 lp comma + Just _ -> toList <$> P.sepByNonEmpty lp comma where lp = p <* P.spaces comma = P.char ',' *> P.spaces P.<?> "comma" @@ -311,7 +310,7 @@ parsecMaybeQuoted :: CabalParsing m => m a -> m a parsecMaybeQuoted p = parsecQuoted p <|> p parsecUnqualComponentName :: CabalParsing m => m String -parsecUnqualComponentName = intercalate "-" <$> P.sepBy1 component (P.char '-') +parsecUnqualComponentName = intercalate "-" <$> toList <$> P.sepByNonEmpty component (P.char '-') where component :: CabalParsing m => m String component = do diff --git a/cabal/Cabal/Distribution/Parsec/Newtypes.hs b/cabal/Cabal/Distribution/Parsec/Newtypes.hs index f48ef8d..971cfc4 100644 --- a/cabal/Cabal/Distribution/Parsec/Newtypes.hs +++ b/cabal/Cabal/Distribution/Parsec/Newtypes.hs @@ -33,7 +33,6 @@ import Distribution.Compat.Newtype import Distribution.Compat.Prelude import Prelude () -import Data.Functor.Identity (Identity (..)) import Distribution.CabalSpecVersion import Distribution.Compiler (CompilerFlavor) import Distribution.License (License) @@ -61,13 +60,10 @@ data FSep = FSep -- | Paragraph fill list without commas. Displayed with 'fsep'. data NoCommaFSep = NoCommaFSep --- | Proxy, internal to this module. -data P sep = P - class Sep sep where - prettySep :: P sep -> [Doc] -> Doc + prettySep :: Proxy sep -> [Doc] -> Doc - parseSep :: CabalParsing m => P sep -> m a -> m [a] + parseSep :: CabalParsing m => Proxy sep -> m a -> m [a] instance Sep CommaVCat where prettySep _ = vcat . punctuate comma @@ -116,10 +112,10 @@ alaList' _ _ = List instance Newtype [a] (List sep wrapper a) instance (Newtype a b, Sep sep, Parsec b) => Parsec (List sep b a) where - parsec = pack . map (unpack :: b -> a) <$> parseSep (P :: P sep) parsec + parsec = pack . map (unpack :: b -> a) <$> parseSep (Proxy :: Proxy sep) parsec instance (Newtype a b, Sep sep, Pretty b) => Pretty (List sep b a) where - pretty = prettySep (P :: P sep) . map (pretty . (pack :: a -> b)) . unpack + pretty = prettySep (Proxy :: Proxy sep) . map (pretty . (pack :: a -> b)) . unpack -- | Haskell string or @[^ ,]+@ newtype Token = Token { getToken :: String } diff --git a/cabal/Cabal/Distribution/Pretty.hs b/cabal/Cabal/Distribution/Pretty.hs index d7c2c25..ddf51c1 100644 --- a/cabal/Cabal/Distribution/Pretty.hs +++ b/cabal/Cabal/Distribution/Pretty.hs @@ -12,7 +12,6 @@ module Distribution.Pretty ( Separator, ) where -import Data.Functor.Identity (Identity (..)) import Distribution.CabalSpecVersion import Distribution.Compat.Prelude import Prelude () diff --git a/cabal/Cabal/Distribution/SPDX/LicenseListVersion.hs b/cabal/Cabal/Distribution/SPDX/LicenseListVersion.hs index 2f32c15..9e6a880 100644 --- a/cabal/Cabal/Distribution/SPDX/LicenseListVersion.hs +++ b/cabal/Cabal/Distribution/SPDX/LicenseListVersion.hs @@ -13,6 +13,7 @@ data LicenseListVersion deriving (Eq, Ord, Show, Enum, Bounded) cabalSpecVersionToSPDXListVersion :: CabalSpecVersion -> LicenseListVersion +cabalSpecVersionToSPDXListVersion CabalSpecV3_2 = LicenseListVersion_3_6 cabalSpecVersionToSPDXListVersion CabalSpecV3_0 = LicenseListVersion_3_6 cabalSpecVersionToSPDXListVersion CabalSpecV2_4 = LicenseListVersion_3_2 cabalSpecVersionToSPDXListVersion _ = LicenseListVersion_3_0 diff --git a/cabal/Cabal/Distribution/Simple.hs b/cabal/Cabal/Distribution/Simple.hs index e632acc..d6e221f 100644 --- a/cabal/Cabal/Distribution/Simple.hs +++ b/cabal/Cabal/Distribution/Simple.hs @@ -524,9 +524,9 @@ sanityCheckHookedBuildInfo verbosity ++ "but the package does not have a library." sanityCheckHookedBuildInfo verbosity pkg_descr (_, hookExes) - | not (null nonExistant) + | exe1 : _ <- nonExistant = die' verbosity $ "The buildinfo contains info for an executable called '" - ++ prettyShow (head nonExistant) ++ "' but the package does not have a " + ++ prettyShow exe1 ++ "' but the package does not have a " ++ "executable with that name." where pkgExeNames = nub (map exeName (executables pkg_descr)) diff --git a/cabal/Cabal/Distribution/Simple/Build.hs b/cabal/Cabal/Distribution/Simple/Build.hs index 331c367..e6916b8 100644 --- a/cabal/Cabal/Distribution/Simple/Build.hs +++ b/cabal/Cabal/Distribution/Simple/Build.hs @@ -30,6 +30,7 @@ module Distribution.Simple.Build ( import Prelude () import Distribution.Compat.Prelude +import Distribution.Utils.Generic import Distribution.Types.ComponentLocalBuildInfo import Distribution.Types.ComponentRequestedSpec @@ -154,7 +155,9 @@ repl pkg_descr lbi flags suffixes args = do target <- readTargetInfos verbosity pkg_descr lbi args >>= \r -> case r of -- This seems DEEPLY questionable. - [] -> return (head (allTargetsInBuildOrder' pkg_descr lbi)) + [] -> case allTargetsInBuildOrder' pkg_descr lbi of + (target:_) -> return target + [] -> die' verbosity $ "Failed to determine target." [target] -> return target _ -> die' verbosity $ "The 'repl' command does not support multiple targets at once." let componentsToBuild = neededTargetsInBuildOrder' pkg_descr lbi [nodeKey target] @@ -180,7 +183,7 @@ repl pkg_descr lbi flags suffixes args = do componentInitialBuildSteps distPref pkg_descr lbi clbi verbosity buildComponent verbosity NoFlag pkg_descr lbi' suffixes comp clbi distPref - | subtarget <- init componentsToBuild ] + | subtarget <- safeInit componentsToBuild ] -- REPL for target components let clbi = targetCLBI target @@ -216,7 +219,13 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes setupMessage' verbosity "Building" (packageId pkg_descr) (componentLocalName clbi) (maybeComponentInstantiatedWith clbi) let libbi = libBuildInfo lib - lib' = lib { libBuildInfo = addExtraCxxSources (addExtraCSources libbi extras) extras } + lib' = lib { libBuildInfo = flip addExtraAsmSources extras + $ flip addExtraCmmSources extras + $ flip addExtraCxxSources extras + $ flip addExtraCSources extras + $ libbi + } + buildLib verbosity numJobs pkg_descr lbi lib' clbi let oneComponentRequested (OneComponentRequestedSpec _) = True @@ -356,6 +365,24 @@ addExtraCxxSources bi extras = bi { cxxSources = new } exs = Set.fromList extras +-- | Add extra C-- sources generated by preprocessing to build +-- information. +addExtraCmmSources :: BuildInfo -> [FilePath] -> BuildInfo +addExtraCmmSources bi extras = bi { cmmSources = new } + where new = Set.toList $ old `Set.union` exs + old = Set.fromList $ cmmSources bi + exs = Set.fromList extras + + +-- | Add extra ASM sources generated by preprocessing to build +-- information. +addExtraAsmSources :: BuildInfo -> [FilePath] -> BuildInfo +addExtraAsmSources bi extras = bi { asmSources = new } + where new = Set.toList $ old `Set.union` exs + old = Set.fromList $ asmSources bi + exs = Set.fromList extras + + replComponent :: [String] -> Verbosity -> PackageDescription diff --git a/cabal/Cabal/Distribution/Simple/Compiler.hs b/cabal/Cabal/Distribution/Simple/Compiler.hs index 0241418..e65c764 100644 --- a/cabal/Cabal/Distribution/Simple/Compiler.hs +++ b/cabal/Cabal/Distribution/Simple/Compiler.hs @@ -73,6 +73,7 @@ module Distribution.Simple.Compiler ( import Prelude () import Distribution.Compat.Prelude +import Distribution.Utils.Generic(safeLast) import Distribution.Pretty import Distribution.Compiler @@ -197,8 +198,9 @@ type PackageDBStack = [PackageDB] -- the top of the stack. -- registrationPackageDB :: PackageDBStack -> PackageDB -registrationPackageDB [] = error "internal error: empty package db set" -registrationPackageDB dbs = last dbs +registrationPackageDB dbs = case safeLast dbs of + Nothing -> error "internal error: empty package db set" + Just p -> p -- | Make package paths absolute diff --git a/cabal/Cabal/Distribution/Simple/Configure.hs b/cabal/Cabal/Distribution/Simple/Configure.hs index fd10f5f..c498278 100644 --- a/cabal/Cabal/Distribution/Simple/Configure.hs +++ b/cabal/Cabal/Distribution/Simple/Configure.hs @@ -55,7 +55,7 @@ module Distribution.Simple.Configure , platformDefines, ) where -import Prelude () +import qualified Prelude (tail) import Distribution.Compat.Prelude import Distribution.Compiler @@ -103,6 +103,7 @@ import Distribution.Backpack.DescribeUnitId import Distribution.Backpack.PreExistingComponent import Distribution.Backpack.ConfiguredComponent (newPackageDepsBehaviour) import Distribution.Backpack.Id +import Distribution.Utils.Generic import Distribution.Utils.LogProgress import qualified Distribution.Simple.GHC as GHC @@ -113,6 +114,7 @@ import qualified Distribution.Simple.HaskellSuite as HaskellSuite import Control.Exception ( ErrorCall, Exception, evaluate, throw, throwIO, try ) import Control.Monad ( forM, forM_ ) +import Data.List.NonEmpty ( nonEmpty ) import Distribution.Compat.Binary ( decodeOrFailIO, encode ) import Distribution.Compat.Directory ( listDirectory ) import Data.ByteString.Lazy ( ByteString ) @@ -1314,18 +1316,21 @@ selectDependency pkgid internalIndex installedIndex requiredDepsMap -- It's an external package, normal situation do_external_external = - case PackageIndex.lookupDependency installedIndex dep_pkgname vr of - [] -> Left (DependencyNotExists dep_pkgname) - pkgs -> Right $ head $ snd $ last pkgs + case pickLastIPI $ PackageIndex.lookupDependency installedIndex dep_pkgname vr of + Nothing -> Left (DependencyNotExists dep_pkgname) + Just pkg -> Right pkg -- It's an internal library, being looked up externally do_external_internal :: LibraryName -> Either FailedDependency InstalledPackageInfo do_external_internal ln = - case PackageIndex.lookupInternalDependency installedIndex + case pickLastIPI $ PackageIndex.lookupInternalDependency installedIndex (packageName pkgid) vr ln of - [] -> Left (DependencyMissingInternal dep_pkgname (packageName pkgid)) - pkgs -> Right $ head $ snd $ last pkgs + Nothing -> Left (DependencyMissingInternal dep_pkgname (packageName pkgid)) + Just pkg -> Right pkg + + pickLastIPI :: [(Version, [InstalledPackageInfo])] -> Maybe InstalledPackageInfo + pickLastIPI pkgs = safeHead . snd . last =<< nonEmpty pkgs reportSelectedDependencies :: Verbosity -> [ResolvedDependency] -> IO () @@ -1774,7 +1779,7 @@ checkForeignDeps pkg lbi verbosity = findOffendingHdr = ifBuildsWith allHeaders ccArgs (return Nothing) - (go . tail . inits $ allHeaders) + (go . Prelude.tail . inits $ allHeaders) -- inits always contains at least [] where go [] = return Nothing -- cannot happen go (hdrs:hdrsInits) = @@ -1783,8 +1788,9 @@ checkForeignDeps pkg lbi verbosity = -- If that works, try compiling too (ifBuildsWith hdrs ccArgs (go hdrsInits) - (return . Just . Right . last $ hdrs)) - (return . Just . Left . last $ hdrs) + (return . fmap Right . safeLast $ hdrs)) + (return . fmap Left . safeLast $ hdrs) + cppArgs = "-E":commonCppArgs -- preprocess only ccArgs = "-c":commonCcArgs -- don't try to link @@ -2005,7 +2011,7 @@ checkRelocatable verbosity pkg lbi -- database to which the package is installed are relative to the -- prefix of the package depsPrefixRelative = do - pkgr <- GHC.pkgRoot verbosity lbi (last (withPackageDB lbi)) + pkgr <- GHC.pkgRoot verbosity lbi (registrationPackageDB (withPackageDB lbi)) traverse_ (doCheck pkgr) ipkgs where doCheck pkgr ipkg diff --git a/cabal/Cabal/Distribution/Simple/GHC.hs b/cabal/Cabal/Distribution/Simple/GHC.hs index 6d9f15e..fab5f4c 100644 --- a/cabal/Cabal/Distribution/Simple/GHC.hs +++ b/cabal/Cabal/Distribution/Simple/GHC.hs @@ -545,8 +545,12 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do createDirectoryIfMissingVerbose verbosity True libTargetDir -- TODO: do we need to put hs-boot files into place for mutually recursive -- modules? - let cLikeFiles = fromNubListR $ - toNubListR (cSources libBi) <> toNubListR (cxxSources libBi) + let cLikeFiles = fromNubListR $ mconcat + [ toNubListR (cSources libBi) + , toNubListR (cxxSources libBi) + , toNubListR (cmmSources libBi) + , toNubListR (asmSources libBi) + ] cObjs = map (`replaceExtension` objExtension) cLikeFiles baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir vanillaOpts = baseOpts `mappend` mempty { @@ -671,7 +675,6 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do ifReplLib (runGhcProg replOpts) -- build any C sources - -- TODO: Add support for S and CMM files. unless (not has_code || null (cSources libBi)) $ do info verbosity "Building C Sources..." sequence_ @@ -702,6 +705,68 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do unless forRepl $ whenProfLib (runGhcProgIfNeeded profCcOpts) | filename <- cSources libBi] + -- build any ASM sources + unless (not has_code || null (asmSources libBi)) $ do + info verbosity "Building Assembler Sources..." + sequence_ + [ do let baseAsmOpts = Internal.componentAsmGhcOptions verbosity implInfo + lbi libBi clbi libTargetDir filename + vanillaAsmOpts = if isGhcDynamic + -- Dynamic GHC requires objects to be built + -- with -fPIC for REPL to work. See #2207. + then baseAsmOpts { ghcOptFPic = toFlag True } + else baseAsmOpts + profAsmOpts = vanillaAsmOpts `mappend` mempty { + ghcOptProfilingMode = toFlag True, + ghcOptObjSuffix = toFlag "p_o" + } + sharedAsmOpts = vanillaAsmOpts `mappend` mempty { + ghcOptFPic = toFlag True, + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptObjSuffix = toFlag "dyn_o" + } + odir = fromFlag (ghcOptObjDir vanillaAsmOpts) + createDirectoryIfMissingVerbose verbosity True odir + let runGhcProgIfNeeded asmOpts = do + needsRecomp <- checkNeedsRecompilation filename asmOpts + when needsRecomp $ runGhcProg asmOpts + runGhcProgIfNeeded vanillaAsmOpts + unless forRepl $ + whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedAsmOpts) + unless forRepl $ whenProfLib (runGhcProgIfNeeded profAsmOpts) + | filename <- asmSources libBi] + + -- build any Cmm sources + unless (not has_code || null (cmmSources libBi)) $ do + info verbosity "Building C-- Sources..." + sequence_ + [ do let baseCmmOpts = Internal.componentCmmGhcOptions verbosity implInfo + lbi libBi clbi libTargetDir filename + vanillaCmmOpts = if isGhcDynamic + -- Dynamic GHC requires C sources to be built + -- with -fPIC for REPL to work. See #2207. + then baseCmmOpts { ghcOptFPic = toFlag True } + else baseCmmOpts + profCmmOpts = vanillaCmmOpts `mappend` mempty { + ghcOptProfilingMode = toFlag True, + ghcOptObjSuffix = toFlag "p_o" + } + sharedCmmOpts = vanillaCmmOpts `mappend` mempty { + ghcOptFPic = toFlag True, + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptObjSuffix = toFlag "dyn_o" + } + odir = fromFlag (ghcOptObjDir vanillaCmmOpts) + createDirectoryIfMissingVerbose verbosity True odir + let runGhcProgIfNeeded cmmOpts = do + needsRecomp <- checkNeedsRecompilation filename cmmOpts + when needsRecomp $ runGhcProg cmmOpts + runGhcProgIfNeeded vanillaCmmOpts + unless forRepl $ + whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedCmmOpts) + unless forRepl $ whenProfLib (runGhcProgIfNeeded profCmmOpts) + | filename <- cmmSources libBi] + -- TODO: problem here is we need the .c files built first, so we can load them -- with ghci, but .c files can depend on .h files generated by ghc by ffi -- exports. @@ -1051,7 +1116,7 @@ gbuildModDefFiles (GReplFLib _ flib) = foreignLibModDefFile flib -- In case of 'Nothing', 'Distribution.ModuleName.main' can be assumed. exeMainModuleName :: Executable -> Maybe ModuleName exeMainModuleName Executable{buildInfo = bnfo} = - -- GHC honors the last occurence of a module name updated via -main-is + -- GHC honors the last occurrence of a module name updated via -main-is -- -- Moreover, -main-is when parsed left-to-right can update either -- the "Main" module name, or the "main" function name, or both, @@ -1074,24 +1139,26 @@ exeMainModuleName Executable{buildInfo = bnfo} = -- https://github.com/haskell/cabal/pull/4539#discussion_r118981753. decodeMainIsArg :: String -> Maybe ModuleName decodeMainIsArg arg - | not (null main_fn) && isLower (head main_fn) + | headOf main_fn isLower -- The arg looked like "Foo.Bar.baz" = Just (ModuleName.fromString main_mod) - | isUpper (head arg) -- The arg looked like "Foo" or "Foo.Bar" + | headOf arg isUpper -- The arg looked like "Foo" or "Foo.Bar" = Just (ModuleName.fromString arg) | otherwise -- The arg looked like "baz" = Nothing where + headOf :: String -> (Char -> Bool) -> Bool + headOf str pred' = any pred' (safeHead str) + (main_mod, main_fn) = splitLongestPrefix arg (== '.') splitLongestPrefix :: String -> (Char -> Bool) -> (String,String) splitLongestPrefix str pred' | null r_pre = (str, []) - | otherwise = (reverse (tail r_pre), reverse r_suf) - -- 'tail' drops the char satisfying 'pred' + | otherwise = (reverse (safeTail r_pre), reverse r_suf) + -- 'safeTail' drops the char satisfying 'pred' where (r_suf, r_pre) = break pred' (reverse str) - -- | A collection of: -- * C input files -- * C++ input files @@ -1463,7 +1530,7 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do } ForeignLibNativeStatic -> -- this should be caught by buildFLib - -- (and if we do implement tihs, we probably don't even want to call + -- (and if we do implement this, we probably don't even want to call -- ghc here, but rather Ar.createArLibArchive or something) cabalBug "static libraries not yet implemented" ForeignLibTypeUnknown -> @@ -1940,6 +2007,8 @@ installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do hasLib = not $ null (allLibModules lib clbi) && null (cSources (libBuildInfo lib)) && null (cxxSources (libBuildInfo lib)) + && null (cmmSources (libBuildInfo lib)) + && null (asmSources (libBuildInfo lib)) has_code = not (componentIsIndefinite clbi) whenHasCode = when has_code whenVanilla = when (hasLib && withVanillaLib lbi) diff --git a/cabal/Cabal/Distribution/Simple/GHC/Internal.hs b/cabal/Cabal/Distribution/Simple/GHC/Internal.hs index 4be5811..aa1b791 100644 --- a/cabal/Cabal/Distribution/Simple/GHC/Internal.hs +++ b/cabal/Cabal/Distribution/Simple/GHC/Internal.hs @@ -19,7 +19,9 @@ module Distribution.Simple.GHC.Internal ( targetPlatform, getGhcInfo, componentCcGhcOptions, + componentCmmGhcOptions, componentCxxGhcOptions, + componentAsmGhcOptions, componentGhcOptions, mkGHCiLibName, mkGHCiProfLibName, @@ -335,6 +337,42 @@ componentCxxGhcOptions verbosity _implInfo lbi bi clbi odir filename = } +componentAsmGhcOptions :: Verbosity -> GhcImplInfo -> LocalBuildInfo + -> BuildInfo -> ComponentLocalBuildInfo + -> FilePath -> FilePath + -> GhcOptions +componentAsmGhcOptions verbosity _implInfo lbi bi clbi odir filename = + mempty { + -- Respect -v0, but don't crank up verbosity on GHC if + -- Cabal verbosity is requested. For that, use --ghc-option=-v instead! + ghcOptVerbosity = toFlag (min verbosity normal), + ghcOptMode = toFlag GhcModeCompile, + ghcOptInputFiles = toNubListR [filename], + + ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi + ,autogenPackageModulesDir lbi + ,odir] + -- includes relative to the package + ++ PD.includeDirs bi + -- potential includes generated by `configure' + -- in the build directory + ++ [buildDir lbi </> dir | dir <- PD.includeDirs bi], + ghcOptHideAllPackages= toFlag True, + ghcOptPackageDBs = withPackageDB lbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptAsmOptions = (case withOptimization lbi of + NoOptimisation -> [] + _ -> ["-O2"]) ++ + (case withDebugInfo lbi of + NoDebugInfo -> [] + MinimalDebugInfo -> ["-g1"] + NormalDebugInfo -> ["-g"] + MaximalDebugInfo -> ["-g3"]) ++ + PD.asmOptions bi, + ghcOptObjDir = toFlag odir + } + + componentGhcOptions :: Verbosity -> GhcImplInfo -> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo -> FilePath -> GhcOptions @@ -396,15 +434,50 @@ componentGhcOptions verbosity implInfo lbi bi clbi odir = ghcOptExtensionMap = Map.fromList . compilerExtensions $ (compiler lbi) } where - toGhcOptimisation NoOptimisation = mempty --TODO perhaps override? - toGhcOptimisation NormalOptimisation = toFlag GhcNormalOptimisation - toGhcOptimisation MaximumOptimisation = toFlag GhcMaximumOptimisation - exe_paths = [ componentBuildDir lbi (targetCLBI exe_tgt) | uid <- componentExeDeps clbi -- TODO: Ugh, localPkgDescr , Just exe_tgt <- [unitIdTarget' (localPkgDescr lbi) lbi uid] ] +toGhcOptimisation :: OptimisationLevel -> Flag GhcOptimisation +toGhcOptimisation NoOptimisation = mempty --TODO perhaps override? +toGhcOptimisation NormalOptimisation = toFlag GhcNormalOptimisation +toGhcOptimisation MaximumOptimisation = toFlag GhcMaximumOptimisation + + +componentCmmGhcOptions :: Verbosity -> GhcImplInfo -> LocalBuildInfo + -> BuildInfo -> ComponentLocalBuildInfo + -> FilePath -> FilePath + -> GhcOptions +componentCmmGhcOptions verbosity _implInfo lbi bi clbi odir filename = + mempty { + -- Respect -v0, but don't crank up verbosity on GHC if + -- Cabal verbosity is requested. For that, use --ghc-option=-v instead! + ghcOptVerbosity = toFlag (min verbosity normal), + ghcOptMode = toFlag GhcModeCompile, + ghcOptInputFiles = toNubListR [filename], + + ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi + ,autogenPackageModulesDir lbi + ,odir] + -- includes relative to the package + ++ PD.includeDirs bi + -- potential includes generated by `configure' + -- in the build directory + ++ [buildDir lbi </> dir | dir <- PD.includeDirs bi], + ghcOptCppOptions = cppOptions bi, + ghcOptCppIncludes = toNubListR $ + [autogenComponentModulesDir lbi clbi </> cppHeaderName], + ghcOptHideAllPackages= toFlag True, + ghcOptPackageDBs = withPackageDB lbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptOptimisation = toGhcOptimisation (withOptimization lbi), + ghcOptDebugInfo = toFlag (withDebugInfo lbi), + ghcOptExtra = cmmOptions bi, + ghcOptObjDir = toFlag odir + } + + -- | Strip out flags that are not supported in ghci filterGhciFlags :: [String] -> [String] filterGhciFlags = filter supported diff --git a/cabal/Cabal/Distribution/Simple/GHCJS.hs b/cabal/Cabal/Distribution/Simple/GHCJS.hs index 46896c3..d73aaae 100644 --- a/cabal/Cabal/Distribution/Simple/GHCJS.hs +++ b/cabal/Cabal/Distribution/Simple/GHCJS.hs @@ -903,7 +903,7 @@ gbuildModDefFiles (GReplFLib _ flib) = foreignLibModDefFile flib -- In case of 'Nothing', 'Distribution.ModuleName.main' can be assumed. exeMainModuleName :: Executable -> Maybe ModuleName exeMainModuleName Executable{buildInfo = bnfo} = - -- GHC honors the last occurence of a module name updated via -main-is + -- GHC honors the last occurrence of a module name updated via -main-is -- -- Moreover, -main-is when parsed left-to-right can update either -- the "Main" module name, or the "main" function name, or both, @@ -926,21 +926,24 @@ exeMainModuleName Executable{buildInfo = bnfo} = -- https://github.com/haskell/cabal/pull/4539#discussion_r118981753. decodeMainIsArg :: String -> Maybe ModuleName decodeMainIsArg arg - | not (null main_fn) && isLower (head main_fn) + | headOf main_fn isLower -- The arg looked like "Foo.Bar.baz" = Just (ModuleName.fromString main_mod) - | isUpper (head arg) -- The arg looked like "Foo" or "Foo.Bar" + | headOf arg isUpper -- The arg looked like "Foo" or "Foo.Bar" = Just (ModuleName.fromString arg) | otherwise -- The arg looked like "baz" = Nothing where + headOf :: String -> (Char -> Bool) -> Bool + headOf str pred' = any pred' (safeHead str) + (main_mod, main_fn) = splitLongestPrefix arg (== '.') splitLongestPrefix :: String -> (Char -> Bool) -> (String,String) splitLongestPrefix str pred' | null r_pre = (str, []) - | otherwise = (reverse (tail r_pre), reverse r_suf) - -- 'tail' drops the char satisfying 'pred' + | otherwise = (reverse (safeTail r_pre), reverse r_suf) + -- 'safeTail' drops the char satisfying 'pred' where (r_suf, r_pre) = break pred' (reverse str) @@ -1308,7 +1311,7 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do } ForeignLibNativeStatic -> -- this should be caught by buildFLib - -- (and if we do implement tihs, we probably don't even want to call + -- (and if we do implement this, we probably don't even want to call -- ghc here, but rather Ar.createArLibArchive or something) cabalBug "static libraries not yet implemented" ForeignLibTypeUnknown -> diff --git a/cabal/Cabal/Distribution/Simple/Glob.hs b/cabal/Cabal/Distribution/Simple/Glob.hs index e2d8b4c..46a22b5 100644 --- a/cabal/Cabal/Distribution/Simple/Glob.hs +++ b/cabal/Cabal/Distribution/Simple/Glob.hs @@ -37,6 +37,8 @@ import Distribution.Version import System.Directory (getDirectoryContents, doesDirectoryExist, doesFileExist) import System.FilePath (joinPath, splitExtensions, splitDirectories, takeFileName, (</>), (<.>)) +import qualified Data.List.NonEmpty as NE + -- Note throughout that we use splitDirectories, not splitPath. On -- Posix, this makes no difference, but, because Windows accepts both -- slash and backslash as its path separators, if we left in the @@ -151,7 +153,7 @@ fileGlobMatchesSegments pat (seg : segs) = case pat of fileGlobMatchesSegments pat' segs GlobFinal final -> case final of FinalMatch Recursive multidot ext -> do - let (candidateBase, candidateExts) = splitExtensions (last $ seg:segs) + let (candidateBase, candidateExts) = splitExtensions (NE.last $ seg:|segs) guard (not (null candidateBase)) checkExt multidot ext candidateExts FinalMatch NonRecursive multidot ext -> do diff --git a/cabal/Cabal/Distribution/Simple/HaskellSuite.hs b/cabal/Cabal/Distribution/Simple/HaskellSuite.hs index 35831ea..3f4010f 100644 --- a/cabal/Cabal/Distribution/Simple/HaskellSuite.hs +++ b/cabal/Cabal/Distribution/Simple/HaskellSuite.hs @@ -26,6 +26,7 @@ import Distribution.PackageDescription import Distribution.Simple.LocalBuildInfo import Distribution.System (Platform) import Distribution.Compat.Exception +import Distribution.Utils.Generic import Language.Haskell.Extension import Distribution.Simple.Program.Builtin @@ -92,15 +93,15 @@ hstoolVersion :: Verbosity -> FilePath -> IO (Maybe Version) hstoolVersion = findProgramVersion "--hspkg-version" id numericVersion :: Verbosity -> FilePath -> IO (Maybe Version) -numericVersion = findProgramVersion "--compiler-version" (last . words) +numericVersion = findProgramVersion "--compiler-version" (fromMaybe "" . safeLast . words) getCompilerVersion :: Verbosity -> ConfiguredProgram -> IO (String, Version) getCompilerVersion verbosity prog = do output <- rawSystemStdout verbosity (programPath prog) ["--compiler-version"] let parts = words output - name = concat $ init parts -- there shouldn't be any spaces in the name anyway - versionStr = last parts + name = concat $ safeInit parts -- there shouldn't be any spaces in the name anyway + versionStr = fromMaybe "" $ safeLast parts version <- maybe (die' verbosity "haskell-suite: couldn't determine compiler version") return $ simpleParsec versionStr @@ -217,7 +218,7 @@ registerPackage verbosity progdb packageDbs installedPkgInfo = do runProgramInvocation verbosity $ (programInvocation hspkg - ["update", packageDbOpt $ last packageDbs]) + ["update", packageDbOpt $ registrationPackageDB packageDbs]) { progInvokeInput = Just $ showInstalledPackageInfo installedPkgInfo } initPackageDB :: Verbosity -> ProgramDb -> FilePath -> IO () diff --git a/cabal/Cabal/Distribution/Simple/PackageIndex.hs b/cabal/Cabal/Distribution/Simple/PackageIndex.hs index 2c9b26e..9d711da 100644 --- a/cabal/Cabal/Distribution/Simple/PackageIndex.hs +++ b/cabal/Cabal/Distribution/Simple/PackageIndex.hs @@ -112,6 +112,7 @@ import Data.Array ((!)) import qualified Data.Array as Array import qualified Data.Graph as Graph import Data.List as List ( groupBy, deleteBy, deleteFirstsBy ) +import qualified Data.List.NonEmpty as NE import qualified Data.Tree as Tree import Control.Monad import Distribution.Compat.Stack @@ -210,20 +211,20 @@ mkPackageIndex pids pnames = assert (invariant index) index -- ones. -- fromList :: [IPI.InstalledPackageInfo] -> InstalledPackageIndex -fromList pkgs = mkPackageIndex pids pnames +fromList pkgs = mkPackageIndex pids ((fmap . fmap) toList pnames) where pids = Map.fromList [ (installedUnitId pkg, pkg) | pkg <- pkgs ] pnames = Map.fromList - [ (liftM2 (,) packageName IPI.sourceLibName (head pkgsN), pvers) - | pkgsN <- groupBy (equating (liftM2 (,) packageName IPI.sourceLibName)) + [ (liftM2 (,) packageName IPI.sourceLibName (NE.head pkgsN), pvers) + | pkgsN <- NE.groupBy (equating (liftM2 (,) packageName IPI.sourceLibName)) . sortBy (comparing (liftM3 (,,) packageName IPI.sourceLibName packageVersion)) $ pkgs , let pvers = Map.fromList - [ (packageVersion (head pkgsNV), - nubBy (equating installedUnitId) (reverse pkgsNV)) - | pkgsNV <- groupBy (equating packageVersion) pkgsN + [ (packageVersion (NE.head pkgsNV), + NE.nubBy (equating installedUnitId) (NE.reverse pkgsNV)) + | pkgsNV <- NE.groupBy (equating packageVersion) pkgsN ] ] diff --git a/cabal/Cabal/Distribution/Simple/PreProcess.hs b/cabal/Cabal/Distribution/Simple/PreProcess.hs index 06922a0..e9dc66b 100644 --- a/cabal/Cabal/Distribution/Simple/PreProcess.hs +++ b/cabal/Cabal/Distribution/Simple/PreProcess.hs @@ -269,7 +269,7 @@ preprocessFile searchLoc buildLoc forSDist baseFile verbosity builtinSuffixes ha let (srcStem, ext) = splitExtension psrcRelFile psrcFile = psrcLoc </> psrcRelFile pp = fromMaybe (error "Distribution.Simple.PreProcess: Just expected") - (lookup (tailNotNull ext) handlers) + (lookup (safeTail ext) handlers) -- Preprocessing files for 'sdist' is different from preprocessing -- for 'build'. When preprocessing for sdist we preprocess to -- avoid that the user has to have the preprocessors available. @@ -296,8 +296,6 @@ preprocessFile searchLoc buildLoc forSDist baseFile verbosity builtinSuffixes ha where dirName = takeDirectory - tailNotNull [] = [] - tailNotNull x = tail x -- FIXME: This is a somewhat nasty hack. GHC requires that hs-boot files -- be in the same place as the hs files, so if we put the hs file in dist/ @@ -727,8 +725,9 @@ preprocessExtras verbosity comp lbi = case comp of pp $ buildDir lbi </> nm' </> nm' ++ "-tmp" TestSuiteLibV09 _ _ -> pp $ buildDir lbi </> stubName test </> stubName test ++ "-tmp" - TestSuiteUnsupported tt -> die' verbosity $ "No support for preprocessing test " - ++ "suite type " ++ prettyShow tt + TestSuiteUnsupported tt -> + die' verbosity $ "No support for preprocessing test suite type " ++ + prettyShow tt CBench bm -> do let nm' = unUnqualComponentName $ benchmarkName bm case benchmarkInterface bm of diff --git a/cabal/Cabal/Distribution/Simple/PreProcess/Unlit.hs b/cabal/Cabal/Distribution/Simple/PreProcess/Unlit.hs index 556353d..bcd2649 100644 --- a/cabal/Cabal/Distribution/Simple/PreProcess/Unlit.hs +++ b/cabal/Cabal/Distribution/Simple/PreProcess/Unlit.hs @@ -17,6 +17,7 @@ module Distribution.Simple.PreProcess.Unlit (unlit,plain) where import Prelude () import Distribution.Compat.Prelude +import Distribution.Utils.Generic (safeTail, safeLast, safeInit) import Data.List (mapAccumL) @@ -33,12 +34,10 @@ plain _ hs = hs classify :: String -> Classified classify ('>':s) = BirdTrack s classify ('#':s) = case tokens s of - (line:file:_) | all isDigit line - && length file >= 2 - && head file == '"' - && last file == '"' + (line:file@('"':_:_):_) | all isDigit line + && safeLast file == Just '"' -- this shouldn't fail as we tested for 'all isDigit' - -> Line (fromMaybe (error $ "panic! read @Int " ++ show line) $ readMaybe line) (tail (init file)) -- TODO:eradicateNoParse + -> Line (fromMaybe (error $ "panic! read @Int " ++ show line) $ readMaybe line) (safeTail (safeInit file)) -- TODO:eradicateNoParse _ -> CPP s where tokens = unfoldr $ \str -> case lex str of (t@(_:_), str'):_ -> Just (t, str') diff --git a/cabal/Cabal/Distribution/Simple/Program.hs b/cabal/Cabal/Distribution/Simple/Program.hs index f142883..00168e4 100644 --- a/cabal/Cabal/Distribution/Simple/Program.hs +++ b/cabal/Cabal/Distribution/Simple/Program.hs @@ -90,6 +90,7 @@ module Distribution.Simple.Program ( , reconfigurePrograms , requireProgram , requireProgramVersion + , needProgram , runDbProgram , getDbProgramOutput diff --git a/cabal/Cabal/Distribution/Simple/Program/Db.hs b/cabal/Cabal/Distribution/Simple/Program/Db.hs index 520601b..b8fc828 100644 --- a/cabal/Cabal/Distribution/Simple/Program/Db.hs +++ b/cabal/Cabal/Distribution/Simple/Program/Db.hs @@ -57,6 +57,7 @@ module Distribution.Simple.Program.Db ( reconfigurePrograms, requireProgram, requireProgramVersion, + needProgram, ) where @@ -413,6 +414,22 @@ reconfigurePrograms verbosity paths argss progdb = do requireProgram :: Verbosity -> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb) requireProgram verbosity prog progdb = do + mres <- needProgram verbosity prog progdb + case mres of + Nothing -> die' verbosity notFound + Just res -> return res + where + notFound = "The program '" ++ programName prog ++ "' is required but it could not be found." + +-- | Check that a program is configured and available to be run. +-- +-- It returns 'Nothing' if the program couldn't be configured, +-- or is not found. +-- +-- @since 3.2.0.0 +needProgram :: Verbosity -> Program -> ProgramDb + -> IO (Maybe (ConfiguredProgram, ProgramDb)) +needProgram verbosity prog progdb = do -- If it's not already been configured, try to configure it now progdb' <- case lookupProgram prog progdb of @@ -420,12 +437,8 @@ requireProgram verbosity prog progdb = do Just _ -> return progdb case lookupProgram prog progdb' of - Nothing -> die' verbosity notFound - Just configuredProg -> return (configuredProg, progdb') - - where notFound = "The program '" ++ programName prog - ++ "' is required but it could not be found." - + Nothing -> return Nothing + Just configuredProg -> return (Just (configuredProg, progdb')) -- | Check that a program is configured and available to be run. -- diff --git a/cabal/Cabal/Distribution/Simple/Program/GHC.hs b/cabal/Cabal/Distribution/Simple/Program/GHC.hs index eda8216..8e50947 100644 --- a/cabal/Cabal/Distribution/Simple/Program/GHC.hs +++ b/cabal/Cabal/Distribution/Simple/Program/GHC.hs @@ -45,7 +45,6 @@ import Language.Haskell.Extension import Data.List (stripPrefix) import qualified Data.Map as Map import Data.Monoid (All(..), Any(..), Endo(..)) -import Data.Set (Set) import qualified Data.Set as Set normaliseGhcArgs :: Maybe Version -> PackageDescription -> [String] -> [String] @@ -56,7 +55,7 @@ normaliseGhcArgs (Just ghcVersion) PackageDescription{..} ghcArgs supportedGHCVersions :: VersionRange supportedGHCVersions = intersectVersionRanges (orLaterVersion (mkVersion [8,0])) - (earlierVersion (mkVersion [8,7])) + (earlierVersion (mkVersion [8,9])) from :: Monoid m => [Int] -> m -> m from version flags @@ -219,6 +218,7 @@ normaliseGhcArgs (Just ghcVersion) PackageDescription{..} ghcArgs , from [8,4] [ "-ddebug-output" ] , from [8,4] $ to [8,6] [ "-fno-max-valid-substitutions" ] , from [8,6] [ "-dhex-word-literals" ] + , from [8,8] [ "-fshow-docs-of-hole-fits", "-fno-show-docs-of-hole-fits" ] ] isOptIntFlag :: String -> Any @@ -413,6 +413,9 @@ data GhcOptions = GhcOptions { -- | Options to pass through to the C++ compiler. ghcOptCxxOptions :: [String], + -- | Options to pass through to the Assembler. + ghcOptAsmOptions :: [String], + -- | Options to pass through to CPP; the @ghc -optP@ flag. ghcOptCppOptions :: [String], @@ -665,6 +668,7 @@ renderGhcOptions comp _platform@(Platform _arch os) opts | inc <- flags ghcOptCppIncludes ] , [ "-optc" ++ opt | opt <- ghcOptCcOptions opts] , [ "-optc" ++ opt | opt <- ghcOptCxxOptions opts] + , [ "-opta" ++ opt | opt <- ghcOptAsmOptions opts] ----------------- -- Linker stuff @@ -746,8 +750,10 @@ renderGhcOptions comp _platform@(Platform _arch os) opts --------------- -- Inputs - , [ prettyShow modu | modu <- flags ghcOptInputModules ] + -- Specify the input file(s) first, so that in ghci the `main-is` module is + -- in scope instead of the first module defined in `other-modules`. , flags ghcOptInputFiles + , [ prettyShow modu | modu <- flags ghcOptInputModules ] , concat [ [ "-o", out] | out <- flag ghcOptOutputFile ] , concat [ [ "-dyno", out] | out <- flag ghcOptOutputDynFile ] diff --git a/cabal/Cabal/Distribution/Simple/Program/HcPkg.hs b/cabal/Cabal/Distribution/Simple/Program/HcPkg.hs index c278f63..fa60101 100644 --- a/cabal/Cabal/Distribution/Simple/Program/HcPkg.hs +++ b/cabal/Cabal/Distribution/Simple/Program/HcPkg.hs @@ -162,7 +162,7 @@ register hpi verbosity packagedbs pkgInfo registerOptions -- | registerMultiInstance registerOptions , recacheMultiInstance hpi - = do let pkgdb = last packagedbs + = do let pkgdb = registrationPackageDB packagedbs writeRegistrationFileDirectly verbosity hpi pkgdb pkgInfo recache hpi verbosity pkgdb @@ -386,9 +386,7 @@ registerInvocation hpi verbosity packagedbs pkgInfo registerOptions = | otherwise = "register" args file = [cmdname, file] - ++ (if noPkgDbStack hpi - then [packageDbOpts hpi (last packagedbs)] - else packageDbStackOpts hpi packagedbs) + ++ packageDbStackOpts hpi packagedbs ++ [ "--enable-multi-instance" | registerMultiInstance registerOptions ] ++ [ "--force-files" @@ -423,9 +421,7 @@ describeInvocation :: HcPkgInfo -> Verbosity -> PackageDBStack -> PackageId describeInvocation hpi verbosity packagedbs pkgid = programInvocation (hcPkgProgram hpi) $ ["describe", prettyShow pkgid] - ++ (if noPkgDbStack hpi - then [packageDbOpts hpi (last packagedbs)] - else packageDbStackOpts hpi packagedbs) + ++ packageDbStackOpts hpi packagedbs ++ verbosityOpts hpi verbosity hideInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId @@ -460,19 +456,21 @@ listInvocation hpi _verbosity packagedb = packageDbStackOpts :: HcPkgInfo -> PackageDBStack -> [String] -packageDbStackOpts hpi dbstack = case dbstack of - (GlobalPackageDB:UserPackageDB:dbs) -> "--global" - : "--user" - : map specific dbs - (GlobalPackageDB:dbs) -> "--global" - : ("--no-user-" ++ packageDbFlag hpi) - : map specific dbs - _ -> ierror - where - specific (SpecificPackageDB db) = "--" ++ packageDbFlag hpi ++ "=" ++ db - specific _ = ierror - ierror :: a - ierror = error ("internal error: unexpected package db stack: " ++ show dbstack) +packageDbStackOpts hpi dbstack + | noPkgDbStack hpi = [packageDbOpts hpi (registrationPackageDB dbstack)] + | otherwise = case dbstack of + (GlobalPackageDB:UserPackageDB:dbs) -> "--global" + : "--user" + : map specific dbs + (GlobalPackageDB:dbs) -> "--global" + : ("--no-user-" ++ packageDbFlag hpi) + : map specific dbs + _ -> ierror + where + specific (SpecificPackageDB db) = "--" ++ packageDbFlag hpi ++ "=" ++ db + specific _ = ierror + ierror :: a + ierror = error ("internal error: unexpected package db stack: " ++ show dbstack) packageDbFlag :: HcPkgInfo -> String packageDbFlag hpi diff --git a/cabal/Cabal/Distribution/Simple/Program/Internal.hs b/cabal/Cabal/Distribution/Simple/Program/Internal.hs index 1b71ae6..c842a98 100644 --- a/cabal/Cabal/Distribution/Simple/Program/Internal.hs +++ b/cabal/Cabal/Distribution/Simple/Program/Internal.hs @@ -13,6 +13,7 @@ module Distribution.Simple.Program.Internal ( import Prelude () import Distribution.Compat.Prelude +import Distribution.Utils.Generic(safeTail) -- | Extract the version number from the output of 'strip --version'. -- @@ -29,7 +30,7 @@ stripExtractVersion str = filterPar' :: Int -> [String] -> [String] filterPar' _ [] = [] filterPar' n (x:xs) - | n >= 0 && "(" `isPrefixOf` x = filterPar' (n+1) ((tail x):xs) + | n >= 0 && "(" `isPrefixOf` x = filterPar' (n+1) ((safeTail x):xs) | n > 0 && ")" `isSuffixOf` x = filterPar' (n-1) xs | n > 0 = filterPar' n xs | otherwise = x:filterPar' n xs diff --git a/cabal/Cabal/Distribution/Simple/Program/Run.hs b/cabal/Cabal/Distribution/Simple/Program/Run.hs index 6b1d7d0..2525601 100644 --- a/cabal/Cabal/Distribution/Simple/Program/Run.hs +++ b/cabal/Cabal/Distribution/Simple/Program/Run.hs @@ -34,6 +34,7 @@ import Distribution.Simple.Program.Types import Distribution.Simple.Utils import Distribution.Verbosity import Distribution.Compat.Environment +import Distribution.Utils.Generic import qualified Data.Map as Map import System.FilePath @@ -243,13 +244,14 @@ multiStageProgramInvocation simple (initial, middle, final) args = chunkSize = maxCommandLineSize - fixedArgSize in case splitChunks chunkSize args of - [] -> [ simple ] + [] -> [ simple ] - [c] -> [ simple `appendArgs` c ] + [c] -> [ simple `appendArgs` c ] - (c:cs) -> [ initial `appendArgs` c ] - ++ [ middle `appendArgs` c'| c' <- init cs ] - ++ [ final `appendArgs` c'| let c' = last cs ] + (c:c2:cs) | (xs, x) <- unsnocNE (c2:|cs) -> + [ initial `appendArgs` c ] + ++ [ middle `appendArgs` c'| c' <- xs ] + ++ [ final `appendArgs` x ] where appendArgs :: ProgramInvocation -> [String] -> ProgramInvocation diff --git a/cabal/Cabal/Distribution/Simple/Setup.hs b/cabal/Cabal/Distribution/Simple/Setup.hs index 42d1b41..8320c39 100644 --- a/cabal/Cabal/Distribution/Simple/Setup.hs +++ b/cabal/Cabal/Distribution/Simple/Setup.hs @@ -58,7 +58,8 @@ module Distribution.Simple.Setup ( defaultBenchmarkFlags, benchmarkCommand, CopyDest(..), configureArgs, configureOptions, configureCCompiler, configureLinker, - buildOptions, haddockOptions, installDirsOptions, testOptions', + buildOptions, haddockOptions, installDirsOptions, + testOptions', benchmarkOptions', programDbOptions, programDbPaths', programFlagsDescription, replOptions, @@ -2027,30 +2028,33 @@ benchmarkCommand = CommandUI , "BENCHCOMPONENTS [FLAGS]" ] , commandDefaultFlags = defaultBenchmarkFlags - , commandOptions = \showOrParseArgs -> - [ optionVerbosity benchmarkVerbosity - (\v flags -> flags { benchmarkVerbosity = v }) - , optionDistPref - benchmarkDistPref (\d flags -> flags { benchmarkDistPref = d }) - showOrParseArgs - , option [] ["benchmark-options"] - ("give extra options to benchmark executables " - ++ "(name templates can use $pkgid, $compiler, " - ++ "$os, $arch, $benchmark)") - benchmarkOptions (\v flags -> flags { benchmarkOptions = v }) - (reqArg' "TEMPLATES" (map toPathTemplate . splitArgs) - (const [])) - , option [] ["benchmark-option"] - ("give extra option to benchmark executables " - ++ "(no need to quote options containing spaces, " - ++ "name template can use $pkgid, $compiler, " - ++ "$os, $arch, $benchmark)") - benchmarkOptions (\v flags -> flags { benchmarkOptions = v }) - (reqArg' "TEMPLATE" (\x -> [toPathTemplate x]) - (map fromPathTemplate)) - ] + , commandOptions = benchmarkOptions' } +benchmarkOptions' :: ShowOrParseArgs -> [OptionField BenchmarkFlags] +benchmarkOptions' showOrParseArgs = + [ optionVerbosity benchmarkVerbosity + (\v flags -> flags { benchmarkVerbosity = v }) + , optionDistPref + benchmarkDistPref (\d flags -> flags { benchmarkDistPref = d }) + showOrParseArgs + , option [] ["benchmark-options"] + ("give extra options to benchmark executables " + ++ "(name templates can use $pkgid, $compiler, " + ++ "$os, $arch, $benchmark)") + benchmarkOptions (\v flags -> flags { benchmarkOptions = v }) + (reqArg' "TEMPLATES" (map toPathTemplate . splitArgs) + (const [])) + , option [] ["benchmark-option"] + ("give extra option to benchmark executables " + ++ "(no need to quote options containing spaces, " + ++ "name template can use $pkgid, $compiler, " + ++ "$os, $arch, $benchmark)") + benchmarkOptions (\v flags -> flags { benchmarkOptions = v }) + (reqArg' "TEMPLATE" (\x -> [toPathTemplate x]) + (map fromPathTemplate)) + ] + emptyBenchmarkFlags :: BenchmarkFlags emptyBenchmarkFlags = mempty diff --git a/cabal/Cabal/Distribution/Simple/SrcDist.hs b/cabal/Cabal/Distribution/Simple/SrcDist.hs index 8e0cae0..6bc637d 100644 --- a/cabal/Cabal/Distribution/Simple/SrcDist.hs +++ b/cabal/Cabal/Distribution/Simple/SrcDist.hs @@ -459,7 +459,8 @@ allSourcesBuildInfo verbosity bi pps modules = do in findFileWithExtension fileExts (hsSourceDirs bi) file | module_ <- modules ++ otherModules bi ] - return $ sources ++ catMaybes bootFiles ++ cSources bi ++ cxxSources bi ++ jsSources bi + return $ sources ++ catMaybes bootFiles ++ cSources bi ++ cxxSources bi ++ + cmmSources bi ++ asmSources bi ++ jsSources bi where nonEmpty x _ [] = x diff --git a/cabal/Cabal/Distribution/Simple/UHC.hs b/cabal/Cabal/Distribution/Simple/UHC.hs index 90e36ea..8ac068e 100644 --- a/cabal/Cabal/Distribution/Simple/UHC.hs +++ b/cabal/Cabal/Distribution/Simple/UHC.hs @@ -24,7 +24,6 @@ module Distribution.Simple.UHC ( import Prelude () import Distribution.Compat.Prelude -import Data.Foldable (toList) import Distribution.InstalledPackageInfo import Distribution.Package hiding (installedUnitId) @@ -278,7 +277,7 @@ registerPackage -> InstalledPackageInfo -> IO () registerPackage verbosity comp progdb packageDbs installedPkgInfo = do - dbdir <- case last packageDbs of + dbdir <- case registrationPackageDB packageDbs of GlobalPackageDB -> getGlobalPackageDir verbosity progdb UserPackageDB -> getUserPackageDir SpecificPackageDB dir -> return dir diff --git a/cabal/Cabal/Distribution/Simple/Utils.hs b/cabal/Cabal/Distribution/Simple/Utils.hs index 650b803..a0b83bb 100644 --- a/cabal/Cabal/Distribution/Simple/Utils.hs +++ b/cabal/Cabal/Distribution/Simple/Utils.hs @@ -151,6 +151,7 @@ module Distribution.Simple.Utils ( ordNub, ordNubBy, ordNubRight, + safeHead, safeTail, unintersperse, wrapText, @@ -168,6 +169,7 @@ module Distribution.Simple.Utils ( import Prelude () import Distribution.Compat.Prelude +import Control.Exception (SomeException) import Distribution.Utils.Generic import Distribution.Utils.IOData (IOData(..), IODataMode(..)) @@ -175,9 +177,11 @@ import qualified Distribution.Utils.IOData as IOData import Distribution.ModuleName as ModuleName import Distribution.System import Distribution.Version +import Distribution.Compat.Async import Distribution.Compat.CopyFile import Distribution.Compat.Internal.TempFile import Distribution.Compat.Exception +import Distribution.Compat.FilePath as FilePath import Distribution.Compat.Stack import Distribution.Verbosity import Distribution.Types.PackageId @@ -199,8 +203,6 @@ import qualified Paths_Cabal (version) import Distribution.Pretty import Distribution.Parsec -import Control.Concurrent.MVar - ( newEmptyMVar, putMVar, takeMVar ) import Data.Typeable ( cast ) import qualified Data.ByteString.Lazy as BS @@ -213,7 +215,7 @@ import System.Environment ( getProgName ) import System.Exit ( exitWith, ExitCode(..) ) -import System.FilePath +import System.FilePath as FilePath ( normalise, (</>), (<.>) , getSearchPath, joinPath, takeDirectory, splitExtension , splitDirectories, searchPathSeparator ) @@ -226,8 +228,7 @@ import System.IO.Unsafe import qualified Control.Exception as Exception import Data.Time.Clock.POSIX (getPOSIXTime, POSIXTime) -import Control.Exception (IOException, evaluate, throwIO) -import Control.Concurrent (forkIO) +import Control.Exception (IOException, evaluate, throwIO, fromException) import Numeric (showFFloat) import qualified System.Process as Process ( CreateProcess(..), StdStream(..), proc) @@ -828,53 +829,48 @@ rawSystemStdInOut verbosity path args mcwd menv input outputMode = withFrozenCal -- fork off a couple threads to pull on the stderr and stdout -- so if the process writes to stderr we do not block. - err <- hGetContents errh - - out <- IOData.hGetContents outh outputMode - - mv <- newEmptyMVar - let force str = do - mberr <- Exception.try (evaluate (rnf str) >> return ()) - putMVar mv (mberr :: Either IOError ()) - _ <- forkIO $ force out - _ <- forkIO $ force err - - -- push all the input, if any - case input of - Nothing -> return () - Just inputData -> do - -- input mode depends on what the caller wants - IOData.hPutContents inh inputData - --TODO: this probably fails if the process refuses to consume - -- or if it closes stdin (eg if it exits) - - -- wait for both to finish, in either order - mberr1 <- takeMVar mv - mberr2 <- takeMVar mv - - -- wait for the program to terminate - exitcode <- waitForProcess pid - unless (exitcode == ExitSuccess) $ - debug verbosity $ path ++ " returned " ++ show exitcode - ++ if null err then "" else - " with error message:\n" ++ err - ++ case input of - Nothing -> "" - Just d | IOData.null d -> "" - Just (IODataText inp) -> "\nstdin input:\n" ++ inp - Just (IODataBinary inp) -> "\nstdin input (binary):\n" ++ show inp - - -- Check if we we hit an exception while consuming the output - -- (e.g. a text decoding error) - reportOutputIOError mberr1 - reportOutputIOError mberr2 - - return (out, err, exitcode) + withAsyncNF (hGetContents errh) $ \errA -> withAsyncNF (IOData.hGetContents outh outputMode) $ \outA -> do + -- push all the input, if any + case input of + Nothing -> return () + Just inputData -> do + -- input mode depends on what the caller wants + -- todo: ignoreSigPipe + IOData.hPutContents inh inputData + --TODO: this probably fails if the process refuses to consume + -- or if it closes stdin (eg if it exits) + + -- wait for both to finish + mberr1 <- waitCatch outA + mberr2 <- waitCatch errA + + -- wait for the program to terminate + exitcode <- waitForProcess pid + + -- get the stderr, so it can be added to error message + err <- reportOutputIOError mberr2 + + unless (exitcode == ExitSuccess) $ + debug verbosity $ path ++ " returned " ++ show exitcode + ++ if null err then "" else + " with error message:\n" ++ err + ++ case input of + Nothing -> "" + Just d | IOData.null d -> "" + Just (IODataText inp) -> "\nstdin input:\n" ++ inp + Just (IODataBinary inp) -> "\nstdin input (binary):\n" ++ show inp + + -- Check if we we hit an exception while consuming the output + -- (e.g. a text decoding error) + out <- reportOutputIOError mberr1 + + return (out, err, exitcode) where - reportOutputIOError :: Either IOError () -> NoCallStackIO () - reportOutputIOError = - either (\e -> throwIO (ioeSetFileName e ("output of " ++ path))) - return + reportOutputIOError :: Either SomeException a -> NoCallStackIO a + reportOutputIOError (Right x) = return x + reportOutputIOError (Left exc) = case fromException exc of + Just ioe -> throwIO (ioeSetFileName ioe ("output of " ++ path)) + Nothing -> throwIO exc -- | Look for a program and try to find it's version number. It can accept -- either an absolute path or the name of a program binary, in which case we @@ -1412,11 +1408,25 @@ shortRelativePath from to = -- unchanged. dropExeExtension :: FilePath -> FilePath dropExeExtension filepath = - case splitExtension filepath of - (filepath', extension) | extension `elem` exeExtensions -> filepath' - | otherwise -> filepath - --- | List of possible executable file extensions on the current platform. + -- System.FilePath's extension handling functions are horribly + -- inconsistent, consider: + -- + -- isExtensionOf "" "foo" == False but + -- isExtensionOf "" "foo." == True. + -- + -- On the other hand stripExtension doesn't remove the empty extension: + -- + -- stripExtension "" "foo." == Just "foo." + -- + -- Since by "" in exeExtensions we mean 'no extension' anyways we can + -- just always ignore it here. + let exts = [ ext | ext <- exeExtensions, ext /= "" ] in + fromMaybe filepath $ do + ext <- find (`FilePath.isExtensionOf` filepath) exts + ext `FilePath.stripExtension` filepath + +-- | List of possible executable file extensions on the current build +-- platform. exeExtensions :: [String] exeExtensions = case buildOS of -- Possible improvement: on Windows, read the list of extensions from the diff --git a/cabal/Cabal/Distribution/Types/BuildInfo.hs b/cabal/Cabal/Distribution/Types/BuildInfo.hs index ee99a74..fd95aa5 100644 --- a/cabal/Cabal/Distribution/Types/BuildInfo.hs +++ b/cabal/Cabal/Distribution/Types/BuildInfo.hs @@ -84,7 +84,7 @@ data BuildInfo = BuildInfo { -- and copied and registered together with this library. The -- logic on how this library is built will have to be encoded in a -- custom Setup for now. Oherwise cabal would need to lear how to - -- call arbitary library builders. + -- call arbitrary library builders. extraLibFlavours :: [String], -- ^ Hidden Flag. This set of strings, will be appended to all libraries when -- copying. E.g. [libHS<name>_<flavour> | flavour <- extraLibFlavours]. This -- should only be needed in very specific cases, e.g. the `rts` package, where diff --git a/cabal/Cabal/Distribution/Types/ConfVar.hs b/cabal/Cabal/Distribution/Types/ConfVar.hs new file mode 100644 index 0000000..c28cee7 --- /dev/null +++ b/cabal/Cabal/Distribution/Types/ConfVar.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Types.ConfVar ( + ConfVar(..), + ) where + +import Prelude () +import Distribution.Compat.Prelude + +import Distribution.Types.Flag +import Distribution.Types.VersionRange +import Distribution.Compiler +import Distribution.System + +-- | A @ConfVar@ represents the variable type used. +data ConfVar = OS OS + | Arch Arch + | Flag FlagName + | Impl CompilerFlavor VersionRange + deriving (Eq, Show, Typeable, Data, Generic) + +instance Binary ConfVar + +instance NFData ConfVar where rnf = genericRnf diff --git a/cabal/Cabal/Distribution/Types/Dependency.hs b/cabal/Cabal/Distribution/Types/Dependency.hs index b8c78c6..9c0c618 100644 --- a/cabal/Cabal/Distribution/Types/Dependency.hs +++ b/cabal/Cabal/Distribution/Types/Dependency.hs @@ -29,7 +29,6 @@ import Distribution.Types.LibraryName import Distribution.Types.UnqualComponentName import Text.PrettyPrint ((<+>)) -import Data.Set (Set) import qualified Data.Set as Set -- | Describes a dependency on a source package (API) @@ -89,6 +88,9 @@ instance Parsec Dependency where $ (char ':' *> spaces *>) $ versionGuardMultilibs $ pure <$> parseLib name <|> parseMultipleLibs name + + spaces -- https://github.com/haskell/cabal/issues/5846 + ver <- parsec <|> pure anyVersion return $ Dependency name ver $ Set.fromList libs where makeLib pn ln | unPackageName pn == ln = LMainLibName diff --git a/cabal/Cabal/Distribution/Types/DependencyMap.hs b/cabal/Cabal/Distribution/Types/DependencyMap.hs index 0bc0e06..4c01818 100644 --- a/cabal/Cabal/Distribution/Types/DependencyMap.hs +++ b/cabal/Cabal/Distribution/Types/DependencyMap.hs @@ -13,7 +13,6 @@ import Distribution.Types.PackageName import Distribution.Types.LibraryName import Distribution.Version -import Data.Set (Set) import qualified Data.Map.Lazy as Map -- | A map of dependencies. Newtyped since the default monoid instance is not diff --git a/cabal/Cabal/Distribution/Types/ExeDependency.hs b/cabal/Cabal/Distribution/Types/ExeDependency.hs index 24aae25..5ebc7df 100644 --- a/cabal/Cabal/Distribution/Types/ExeDependency.hs +++ b/cabal/Cabal/Distribution/Types/ExeDependency.hs @@ -33,9 +33,31 @@ instance Pretty ExeDependency where pretty (ExeDependency name exe ver) = (pretty name <<>> text ":" <<>> pretty exe) <+> pretty ver +-- | +-- +-- Examples +-- +-- >>> simpleParsec "happy:happy" :: Maybe ExeDependency +-- Just (ExeDependency (PackageName "happy") (UnqualComponentName "happy") AnyVersion) +-- +-- >>> simpleParsec "happy:happy >= 1.19.12" :: Maybe ExeDependency +-- Just (ExeDependency (PackageName "happy") (UnqualComponentName "happy") (OrLaterVersion (mkVersion [1,19,12]))) +-- +-- >>> simpleParsec "happy:happy>=1.19.12" :: Maybe ExeDependency +-- Just (ExeDependency (PackageName "happy") (UnqualComponentName "happy") (OrLaterVersion (mkVersion [1,19,12]))) +-- +-- >>> simpleParsec "happy : happy >= 1.19.12" :: Maybe ExeDependency +-- Nothing +-- +-- >>> simpleParsec "happy: happy >= 1.19.12" :: Maybe ExeDependency +-- Nothing +-- +-- >>> simpleParsec "happy :happy >= 1.19.12" :: Maybe ExeDependency +-- Nothing +-- instance Parsec ExeDependency where parsec = do - name <- lexemeParsec + name <- parsec _ <- P.char ':' exe <- lexemeParsec ver <- parsec <|> pure anyVersion diff --git a/cabal/Cabal/Distribution/Types/Flag.hs b/cabal/Cabal/Distribution/Types/Flag.hs new file mode 100644 index 0000000..b3f1f22 --- /dev/null +++ b/cabal/Cabal/Distribution/Types/Flag.hs @@ -0,0 +1,245 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Distribution.Types.Flag ( + Flag(..), + emptyFlag, + FlagName, + mkFlagName, + unFlagName, + FlagAssignment, + mkFlagAssignment, + unFlagAssignment, + lookupFlagAssignment, + insertFlagAssignment, + diffFlagAssignment, + findDuplicateFlagAssignments, + nullFlagAssignment, + showFlagValue, + dispFlagAssignment, + parsecFlagAssignment, + ) where + +import Prelude () +import Distribution.Compat.Prelude +import Distribution.Utils.ShortText +import Distribution.Utils.Generic (lowercase) + +import Distribution.Parsec +import Distribution.Pretty + +import qualified Data.Map as Map +import qualified Text.PrettyPrint as Disp +import qualified Distribution.Compat.CharParsing as P + +-- ----------------------------------------------------------------------------- +-- The Flag' type + +-- | A flag can represent a feature to be included, or a way of linking +-- a target against its dependencies, or in fact whatever you can think of. +data Flag = MkFlag + { flagName :: FlagName + , flagDescription :: String + , flagDefault :: Bool + , flagManual :: Bool + } + deriving (Show, Eq, Typeable, Data, Generic) + +instance Binary Flag + +instance NFData Flag where rnf = genericRnf + +-- | A 'Flag' initialized with default parameters. +emptyFlag :: FlagName -> Flag +emptyFlag name = MkFlag + { flagName = name + , flagDescription = "" + , flagDefault = True + , flagManual = False + } + +-- | A 'FlagName' is the name of a user-defined configuration flag +-- +-- Use 'mkFlagName' and 'unFlagName' to convert from/to a 'String'. +-- +-- This type is opaque since @Cabal-2.0@ +-- +-- @since 2.0.0.2 +newtype FlagName = FlagName ShortText + deriving (Eq, Generic, Ord, Show, Read, Typeable, Data, NFData) + +-- | Construct a 'FlagName' from a 'String' +-- +-- 'mkFlagName' is the inverse to 'unFlagName' +-- +-- Note: No validations are performed to ensure that the resulting +-- 'FlagName' is valid +-- +-- @since 2.0.0.2 +mkFlagName :: String -> FlagName +mkFlagName = FlagName . toShortText + +-- | 'mkFlagName' +-- +-- @since 2.0.0.2 +instance IsString FlagName where + fromString = mkFlagName + +-- | Convert 'FlagName' to 'String' +-- +-- @since 2.0.0.2 +unFlagName :: FlagName -> String +unFlagName (FlagName s) = fromShortText s + +instance Binary FlagName + +instance Pretty FlagName where + pretty = Disp.text . unFlagName + +instance Parsec FlagName where + -- Note: we don't check that FlagName doesn't have leading dash, + -- cabal check will do that. + parsec = mkFlagName . lowercase <$> parsec' + where + parsec' = (:) <$> lead <*> rest + lead = P.satisfy (\c -> isAlphaNum c || c == '_') + rest = P.munch (\c -> isAlphaNum c || c == '_' || c == '-') + +-- | A 'FlagAssignment' is a total or partial mapping of 'FlagName's to +-- 'Bool' flag values. It represents the flags chosen by the user or +-- discovered during configuration. For example @--flags=foo --flags=-bar@ +-- becomes @[("foo", True), ("bar", False)]@ +-- +newtype FlagAssignment + = FlagAssignment { getFlagAssignment :: Map.Map FlagName (Int, Bool) } + deriving (Binary, Generic, NFData) + +instance Eq FlagAssignment where + (==) (FlagAssignment m1) (FlagAssignment m2) + = fmap snd m1 == fmap snd m2 + +instance Ord FlagAssignment where + compare (FlagAssignment m1) (FlagAssignment m2) + = fmap snd m1 `compare` fmap snd m2 + +-- | Combines pairs of values contained in the 'FlagAssignment' Map. +-- +-- The last flag specified takes precedence, and we record the number +-- of times we have seen the flag. +-- +combineFlagValues :: (Int, Bool) -> (Int, Bool) -> (Int, Bool) +combineFlagValues (c1, _) (c2, b2) = (c1 + c2, b2) + +-- The 'Semigroup' instance currently is right-biased. +-- +-- If duplicate flags are specified, we want the last flag specified to +-- take precedence and we want to know how many times the flag has been +-- specified so that we have the option of warning the user about +-- supplying duplicate flags. +instance Semigroup FlagAssignment where + (<>) (FlagAssignment m1) (FlagAssignment m2) + = FlagAssignment (Map.unionWith combineFlagValues m1 m2) + +instance Monoid FlagAssignment where + mempty = FlagAssignment Map.empty + mappend = (<>) + +-- | Construct a 'FlagAssignment' from a list of flag/value pairs. +-- +-- If duplicate flags occur in the input list, the later entries +-- in the list will take precedence. +-- +-- @since 2.2.0 +mkFlagAssignment :: [(FlagName, Bool)] -> FlagAssignment +mkFlagAssignment = + FlagAssignment . + Map.fromListWith (flip combineFlagValues) . fmap (fmap (\b -> (1, b))) + +-- | Deconstruct a 'FlagAssignment' into a list of flag/value pairs. +-- +-- @ 'null' ('findDuplicateFlagAssignments' fa) ==> ('mkFlagAssignment' . 'unFlagAssignment') fa == fa @ +-- +-- @since 2.2.0 +unFlagAssignment :: FlagAssignment -> [(FlagName, Bool)] +unFlagAssignment = fmap (fmap snd) . Map.toList . getFlagAssignment + +-- | Test whether 'FlagAssignment' is empty. +-- +-- @since 2.2.0 +nullFlagAssignment :: FlagAssignment -> Bool +nullFlagAssignment = Map.null . getFlagAssignment + +-- | Lookup the value for a flag +-- +-- Returns 'Nothing' if the flag isn't contained in the 'FlagAssignment'. +-- +-- @since 2.2.0 +lookupFlagAssignment :: FlagName -> FlagAssignment -> Maybe Bool +lookupFlagAssignment fn = fmap snd . Map.lookup fn . getFlagAssignment + +-- | Insert or update the boolean value of a flag. +-- +-- If the flag is already present in the 'FlagAssigment', the +-- value will be updated and the fact that multiple values have +-- been provided for that flag will be recorded so that a +-- warning can be generated later on. +-- +-- @since 2.2.0 +insertFlagAssignment :: FlagName -> Bool -> FlagAssignment -> FlagAssignment +-- TODO: this currently just shadows prior values for an existing +-- flag; rather than enforcing uniqueness at construction, it's +-- verified later on via `D.C.Dependency.configuredPackageProblems` +insertFlagAssignment flag val = + FlagAssignment . + Map.insertWith (flip combineFlagValues) flag (1, val) . getFlagAssignment + +-- | Remove all flag-assignments from the first 'FlagAssignment' that +-- are contained in the second 'FlagAssignment' +-- +-- NB/TODO: This currently only removes flag assignments which also +-- match the value assignment! We should review the code which uses +-- this operation to figure out if this it's not enough to only +-- compare the flagnames without the values. +-- +-- @since 2.2.0 +diffFlagAssignment :: FlagAssignment -> FlagAssignment -> FlagAssignment +diffFlagAssignment fa1 fa2 = FlagAssignment + (Map.difference (getFlagAssignment fa1) (getFlagAssignment fa2)) + +-- | Find the 'FlagName's that have been listed more than once. +-- +-- @since 2.2.0 +findDuplicateFlagAssignments :: FlagAssignment -> [FlagName] +findDuplicateFlagAssignments = + Map.keys . Map.filter ((> 1) . fst) . getFlagAssignment + +-- | @since 2.2.0 +instance Read FlagAssignment where + readsPrec p s = [ (FlagAssignment x, rest) | (x,rest) <- readsPrec p s ] + +-- | @since 2.2.0 +instance Show FlagAssignment where + showsPrec p (FlagAssignment xs) = showsPrec p xs + +-- | String representation of a flag-value pair. +showFlagValue :: (FlagName, Bool) -> String +showFlagValue (f, True) = '+' : unFlagName f +showFlagValue (f, False) = '-' : unFlagName f + +-- | Pretty-prints a flag assignment. +dispFlagAssignment :: FlagAssignment -> Disp.Doc +dispFlagAssignment = Disp.hsep . map (Disp.text . showFlagValue) . unFlagAssignment + +-- | Parses a flag assignment. +parsecFlagAssignment :: CabalParsing m => m FlagAssignment +parsecFlagAssignment = mkFlagAssignment <$> + P.sepBy (onFlag <|> offFlag) P.skipSpaces1 + where + onFlag = do + _ <- P.optional (P.char '+') + f <- parsec + return (f, True) + offFlag = do + _ <- P.char '-' + f <- parsec + return (f, False) diff --git a/cabal/Cabal/Distribution/Types/GenericPackageDescription.hs b/cabal/Cabal/Distribution/Types/GenericPackageDescription.hs index 8906ae4..4768680 100644 --- a/cabal/Cabal/Distribution/Types/GenericPackageDescription.hs +++ b/cabal/Cabal/Distribution/Types/GenericPackageDescription.hs @@ -6,32 +6,10 @@ module Distribution.Types.GenericPackageDescription ( GenericPackageDescription(..), emptyGenericPackageDescription, - Flag(..), - emptyFlag, - FlagName, - mkFlagName, - unFlagName, - FlagAssignment, - mkFlagAssignment, - unFlagAssignment, - lookupFlagAssignment, - insertFlagAssignment, - diffFlagAssignment, - findDuplicateFlagAssignments, - nullFlagAssignment, - showFlagValue, - dispFlagAssignment, - parsecFlagAssignment, - ConfVar(..), ) where import Prelude () import Distribution.Compat.Prelude -import Distribution.Utils.ShortText -import Distribution.Utils.Generic (lowercase) -import qualified Text.PrettyPrint as Disp -import qualified Data.Map as Map -import qualified Distribution.Compat.CharParsing as P -- lens import Distribution.Compat.Lens as L @@ -39,21 +17,17 @@ import qualified Distribution.Types.BuildInfo.Lens as L import Distribution.Types.PackageDescription +import Distribution.Types.Benchmark +import Distribution.Types.CondTree +import Distribution.Types.ConfVar import Distribution.Types.Dependency -import Distribution.Types.Library -import Distribution.Types.ForeignLib import Distribution.Types.Executable +import Distribution.Types.Flag +import Distribution.Types.ForeignLib +import Distribution.Types.Library import Distribution.Types.TestSuite -import Distribution.Types.Benchmark import Distribution.Types.UnqualComponentName -import Distribution.Types.CondTree - import Distribution.Package -import Distribution.Version -import Distribution.Compiler -import Distribution.System -import Distribution.Parsec -import Distribution.Pretty -- --------------------------------------------------------------------------- -- The 'GenericPackageDescription' type @@ -101,229 +75,4 @@ instance L.HasBuildInfos GenericPackageDescription where <*> (traverse . L._2 . traverse . L.buildInfo) f x5 <*> (traverse . L._2 . traverse . L.buildInfo) f x6 --- ----------------------------------------------------------------------------- --- The Flag' type - --- | A flag can represent a feature to be included, or a way of linking --- a target against its dependencies, or in fact whatever you can think of. -data Flag = MkFlag - { flagName :: FlagName - , flagDescription :: String - , flagDefault :: Bool - , flagManual :: Bool - } - deriving (Show, Eq, Typeable, Data, Generic) - -instance Binary Flag - -instance NFData Flag where rnf = genericRnf - --- | A 'Flag' initialized with default parameters. -emptyFlag :: FlagName -> Flag -emptyFlag name = MkFlag - { flagName = name - , flagDescription = "" - , flagDefault = True - , flagManual = False - } - --- | A 'FlagName' is the name of a user-defined configuration flag --- --- Use 'mkFlagName' and 'unFlagName' to convert from/to a 'String'. --- --- This type is opaque since @Cabal-2.0@ --- --- @since 2.0.0.2 -newtype FlagName = FlagName ShortText - deriving (Eq, Generic, Ord, Show, Read, Typeable, Data, NFData) - --- | Construct a 'FlagName' from a 'String' --- --- 'mkFlagName' is the inverse to 'unFlagName' --- --- Note: No validations are performed to ensure that the resulting --- 'FlagName' is valid --- --- @since 2.0.0.2 -mkFlagName :: String -> FlagName -mkFlagName = FlagName . toShortText - --- | 'mkFlagName' --- --- @since 2.0.0.2 -instance IsString FlagName where - fromString = mkFlagName - --- | Convert 'FlagName' to 'String' --- --- @since 2.0.0.2 -unFlagName :: FlagName -> String -unFlagName (FlagName s) = fromShortText s - -instance Binary FlagName - -instance Pretty FlagName where - pretty = Disp.text . unFlagName - -instance Parsec FlagName where - -- Note: we don't check that FlagName doesn't have leading dash, - -- cabal check will do that. - parsec = mkFlagName . lowercase <$> parsec' - where - parsec' = (:) <$> lead <*> rest - lead = P.satisfy (\c -> isAlphaNum c || c == '_') - rest = P.munch (\c -> isAlphaNum c || c == '_' || c == '-') - --- | A 'FlagAssignment' is a total or partial mapping of 'FlagName's to --- 'Bool' flag values. It represents the flags chosen by the user or --- discovered during configuration. For example @--flags=foo --flags=-bar@ --- becomes @[("foo", True), ("bar", False)]@ --- -newtype FlagAssignment - = FlagAssignment { getFlagAssignment :: Map.Map FlagName (Int, Bool) } - deriving (Binary, Generic, NFData) - -instance Eq FlagAssignment where - (==) (FlagAssignment m1) (FlagAssignment m2) - = fmap snd m1 == fmap snd m2 - -instance Ord FlagAssignment where - compare (FlagAssignment m1) (FlagAssignment m2) - = fmap snd m1 `compare` fmap snd m2 - --- | Combines pairs of values contained in the 'FlagAssignment' Map. --- --- The last flag specified takes precedence, and we record the number --- of times we have seen the flag. --- -combineFlagValues :: (Int, Bool) -> (Int, Bool) -> (Int, Bool) -combineFlagValues (c1, _) (c2, b2) = (c1 + c2, b2) - --- The 'Semigroup' instance currently is right-biased. --- --- If duplicate flags are specified, we want the last flag specified to --- take precedence and we want to know how many times the flag has been --- specified so that we have the option of warning the user about --- supplying duplicate flags. -instance Semigroup FlagAssignment where - (<>) (FlagAssignment m1) (FlagAssignment m2) - = FlagAssignment (Map.unionWith combineFlagValues m1 m2) - -instance Monoid FlagAssignment where - mempty = FlagAssignment Map.empty - mappend = (<>) - --- | Construct a 'FlagAssignment' from a list of flag/value pairs. --- --- If duplicate flags occur in the input list, the later entries --- in the list will take precedence. --- --- @since 2.2.0 -mkFlagAssignment :: [(FlagName, Bool)] -> FlagAssignment -mkFlagAssignment = - FlagAssignment . - Map.fromListWith (flip combineFlagValues) . fmap (fmap (\b -> (1, b))) - --- | Deconstruct a 'FlagAssignment' into a list of flag/value pairs. --- --- @ 'null' ('findDuplicateFlagAssignments' fa) ==> ('mkFlagAssignment' . 'unFlagAssignment') fa == fa @ --- --- @since 2.2.0 -unFlagAssignment :: FlagAssignment -> [(FlagName, Bool)] -unFlagAssignment = fmap (fmap snd) . Map.toList . getFlagAssignment - --- | Test whether 'FlagAssignment' is empty. --- --- @since 2.2.0 -nullFlagAssignment :: FlagAssignment -> Bool -nullFlagAssignment = Map.null . getFlagAssignment - --- | Lookup the value for a flag --- --- Returns 'Nothing' if the flag isn't contained in the 'FlagAssignment'. --- --- @since 2.2.0 -lookupFlagAssignment :: FlagName -> FlagAssignment -> Maybe Bool -lookupFlagAssignment fn = fmap snd . Map.lookup fn . getFlagAssignment - --- | Insert or update the boolean value of a flag. --- --- If the flag is already present in the 'FlagAssigment', the --- value will be updated and the fact that multiple values have --- been provided for that flag will be recorded so that a --- warning can be generated later on. --- --- @since 2.2.0 -insertFlagAssignment :: FlagName -> Bool -> FlagAssignment -> FlagAssignment --- TODO: this currently just shadows prior values for an existing --- flag; rather than enforcing uniqueness at construction, it's --- verified later on via `D.C.Dependency.configuredPackageProblems` -insertFlagAssignment flag val = - FlagAssignment . - Map.insertWith (flip combineFlagValues) flag (1, val) . getFlagAssignment - --- | Remove all flag-assignments from the first 'FlagAssignment' that --- are contained in the second 'FlagAssignment' --- --- NB/TODO: This currently only removes flag assignments which also --- match the value assignment! We should review the code which uses --- this operation to figure out if this it's not enough to only --- compare the flagnames without the values. --- --- @since 2.2.0 -diffFlagAssignment :: FlagAssignment -> FlagAssignment -> FlagAssignment -diffFlagAssignment fa1 fa2 = FlagAssignment - (Map.difference (getFlagAssignment fa1) (getFlagAssignment fa2)) - --- | Find the 'FlagName's that have been listed more than once. --- --- @since 2.2.0 -findDuplicateFlagAssignments :: FlagAssignment -> [FlagName] -findDuplicateFlagAssignments = - Map.keys . Map.filter ((> 1) . fst) . getFlagAssignment - --- | @since 2.2.0 -instance Read FlagAssignment where - readsPrec p s = [ (FlagAssignment x, rest) | (x,rest) <- readsPrec p s ] - --- | @since 2.2.0 -instance Show FlagAssignment where - showsPrec p (FlagAssignment xs) = showsPrec p xs - --- | String representation of a flag-value pair. -showFlagValue :: (FlagName, Bool) -> String -showFlagValue (f, True) = '+' : unFlagName f -showFlagValue (f, False) = '-' : unFlagName f - --- | Pretty-prints a flag assignment. -dispFlagAssignment :: FlagAssignment -> Disp.Doc -dispFlagAssignment = Disp.hsep . map (Disp.text . showFlagValue) . unFlagAssignment - --- | Parses a flag assignment. -parsecFlagAssignment :: CabalParsing m => m FlagAssignment -parsecFlagAssignment = mkFlagAssignment <$> - P.sepBy (onFlag <|> offFlag) P.skipSpaces1 - where - onFlag = do - _ <- P.optional (P.char '+') - f <- parsec - return (f, True) - offFlag = do - _ <- P.char '-' - f <- parsec - return (f, False) --- {-# DEPRECATED parseFlagAssignment "Use parsecFlagAssignment. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} - --- ----------------------------------------------------------------------------- --- The 'CondVar' type - --- | A @ConfVar@ represents the variable type used. -data ConfVar = OS OS - | Arch Arch - | Flag FlagName - | Impl CompilerFlavor VersionRange - deriving (Eq, Show, Typeable, Data, Generic) - -instance Binary ConfVar -instance NFData ConfVar where rnf = genericRnf diff --git a/cabal/Cabal/Distribution/Types/GenericPackageDescription/Lens.hs b/cabal/Cabal/Distribution/Types/GenericPackageDescription/Lens.hs index 92d5fca..e9699d3 100644 --- a/cabal/Cabal/Distribution/Types/GenericPackageDescription/Lens.hs +++ b/cabal/Cabal/Distribution/Types/GenericPackageDescription/Lens.hs @@ -21,9 +21,9 @@ import Distribution.Types.Executable (Executable) import Distribution.Types.PackageDescription (PackageDescription) import Distribution.Types.Benchmark (Benchmark) import Distribution.Types.ForeignLib (ForeignLib) -import Distribution.Types.GenericPackageDescription - ( GenericPackageDescription(GenericPackageDescription) - , Flag(MkFlag), FlagName, ConfVar (..)) +import Distribution.Types.GenericPackageDescription (GenericPackageDescription(GenericPackageDescription) ) +import Distribution.Types.Flag (Flag(MkFlag), FlagName) +import Distribution.Types.ConfVar (ConfVar (..)) import Distribution.Types.Library (Library) import Distribution.Types.TestSuite (TestSuite) import Distribution.Types.UnqualComponentName (UnqualComponentName) diff --git a/cabal/Cabal/Distribution/Types/LegacyExeDependency.hs b/cabal/Cabal/Distribution/Types/LegacyExeDependency.hs index 99fd4f1..75f920a 100644 --- a/cabal/Cabal/Distribution/Types/LegacyExeDependency.hs +++ b/cabal/Cabal/Distribution/Types/LegacyExeDependency.hs @@ -40,7 +40,7 @@ instance Parsec LegacyExeDependency where verRange <- parsecMaybeQuoted parsec <|> pure anyVersion pure $ LegacyExeDependency name verRange where - nameP = intercalate "-" <$> P.sepBy1 component (P.char '-') + nameP = intercalate "-" <$> toList <$> P.sepByNonEmpty component (P.char '-') component = do cs <- P.munch1 (\c -> isAlphaNum c || c == '+' || c == '_') if all isDigit cs then fail "invalid component" else return cs diff --git a/cabal/Cabal/Distribution/Types/LocalBuildInfo.hs b/cabal/Cabal/Distribution/Types/LocalBuildInfo.hs index 31ad96e..c11649e 100644 --- a/cabal/Cabal/Distribution/Types/LocalBuildInfo.hs +++ b/cabal/Cabal/Distribution/Types/LocalBuildInfo.hs @@ -129,7 +129,7 @@ data LocalBuildInfo = LocalBuildInfo { -- In principle, this is supposed to contain the -- resolved package description, that does not contain -- any conditionals. However, it MAY NOT contain - -- the description wtih a 'HookedBuildInfo' applied + -- the description with a 'HookedBuildInfo' applied -- to it; see 'HookedBuildInfo' for the whole sordid saga. -- As much as possible, Cabal library should avoid using -- this parameter. diff --git a/cabal/Cabal/Distribution/Types/MungedPackageName.hs b/cabal/Cabal/Distribution/Types/MungedPackageName.hs index 1efa01e..e85f00d 100644 --- a/cabal/Cabal/Distribution/Types/MungedPackageName.hs +++ b/cabal/Cabal/Distribution/Types/MungedPackageName.hs @@ -68,7 +68,7 @@ instance NFData MungedPackageName where rnf = genericRnf -- >>> prettyShow $ MungedPackageName "servant" LMainLibName -- "servant" -- --- >>> prettyShow $ MungedPackageName "servant" (LSubLibName "lackey") +-- >>> prettyShow $ MungedPackageName "servant" (LSubLibName "lackey") -- "z-servant-z-lackey" -- instance Pretty MungedPackageName where @@ -77,7 +77,7 @@ instance Pretty MungedPackageName where -- indefinite package for us. pretty = Disp.text . encodeCompatPackageName' --- | +-- | -- -- >>> simpleParsec "servant" :: Maybe MungedPackageName -- Just (MungedPackageName (PackageName "servant") LMainLibName) @@ -137,7 +137,7 @@ zdashcode s = go s (Nothing :: Maybe Int) [] parseZDashCode :: CabalParsing m => m [String] parseZDashCode = do - ns <- P.sepBy1 (some (P.satisfy (/= '-'))) (P.char '-') + ns <- toList <$> P.sepByNonEmpty (some (P.satisfy (/= '-'))) (P.char '-') return (go ns) where go ns = case break (=="z") ns of diff --git a/cabal/Cabal/Distribution/Types/PackageId.hs b/cabal/Cabal/Distribution/Types/PackageId.hs index ddf160d..b627fb5 100644 --- a/cabal/Cabal/Distribution/Types/PackageId.hs +++ b/cabal/Cabal/Distribution/Types/PackageId.hs @@ -13,6 +13,7 @@ import Distribution.Pretty import Distribution.Types.PackageName import Distribution.Version (Version, nullVersion) +import qualified Data.List.NonEmpty as NE import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -58,10 +59,10 @@ instance Pretty PackageIdentifier where -- instance Parsec PackageIdentifier where parsec = do - xs' <- P.sepBy1 component (P.char '-') - (v, xs) <- case simpleParsec (last xs') of - Nothing -> return (nullVersion, xs') -- all components are version - Just v -> return (v, init xs') + xs' <- P.sepByNonEmpty component (P.char '-') + (v, xs) <- case simpleParsec (NE.last xs') of + Nothing -> return (nullVersion, toList xs') -- all components are version + Just v -> return (v, NE.init xs') if not (null xs) && all (\c -> all (/= '.') c && not (all isDigit c)) xs then return $ PackageIdentifier (mkPackageName (intercalate "-" xs)) v else fail "all digits or a dot in a portion of package name" diff --git a/cabal/Cabal/Distribution/Types/PkgconfigVersionRange.hs b/cabal/Cabal/Distribution/Types/PkgconfigVersionRange.hs index 6b1bc94..60e88e4 100644 --- a/cabal/Cabal/Distribution/Types/PkgconfigVersionRange.hs +++ b/cabal/Cabal/Distribution/Types/PkgconfigVersionRange.hs @@ -61,7 +61,7 @@ instance Parsec PkgconfigVersionRange where -- note: the wildcard is used in some places, e.g -- http://hackage.haskell.org/package/bindings-libzip-0.10.1/bindings-libzip.cabal -- - -- however, in the presense of alphanumerics etc. lax version parser, + -- however, in the presence of alphanumerics etc. lax version parser, -- wildcard is ill-specified parsec = do diff --git a/cabal/Cabal/Distribution/Types/Version.hs b/cabal/Cabal/Distribution/Types/Version.hs index 0a0cd3e..b4d4da3 100644 --- a/cabal/Cabal/Distribution/Types/Version.hs +++ b/cabal/Cabal/Distribution/Types/Version.hs @@ -92,7 +92,7 @@ instance Pretty Version where (map Disp.int $ versionNumbers ver)) instance Parsec Version where - parsec = mkVersion <$> P.sepBy1 versionDigitParser (P.char '.') <* tags + parsec = mkVersion <$> toList <$> P.sepByNonEmpty versionDigitParser (P.char '.') <* tags where tags = do ts <- many $ P.char '-' *> some (P.satisfy isAlphaNum) @@ -109,7 +109,13 @@ versionDigitParser = (some d >>= toNumber) P.<?> "version digit (integral withou toNumber :: CabalParsing m => [Int] -> m Int toNumber [0] = return 0 toNumber (0:_) = P.unexpected "Version digit with leading zero" - toNumber xs = return $ foldl' (\a b -> a * 10 + b) 0 xs + toNumber xs + -- 10^9 = 1000000000 + -- 2^30 = 1073741824 + -- + -- GHC Int is at least 32 bits, so 2^31-1 is the 'maxBound'. + | length xs > 9 = P.unexpected "At most 9 numbers are allowed per version number part" + | otherwise = return $ foldl' (\a b -> a * 10 + b) 0 xs d :: P.CharParsing m => m Int d = f <$> P.satisfyRange '0' '9' diff --git a/cabal/Cabal/Distribution/Types/VersionInterval.hs b/cabal/Cabal/Distribution/Types/VersionInterval.hs index 3304258..ebb2178 100644 --- a/cabal/Cabal/Distribution/Types/VersionInterval.hs +++ b/cabal/Cabal/Distribution/Types/VersionInterval.hs @@ -118,9 +118,9 @@ invariant (VersionIntervals intervals) = all validInterval intervals doesNotTouch' ((_,u), (l',_)) = doesNotTouch u l' adjacentIntervals :: [(VersionInterval, VersionInterval)] - adjacentIntervals - | null intervals = [] - | otherwise = zip intervals (tail intervals) + adjacentIntervals = case intervals of + [] -> [] + (_:tl) -> zip intervals tl checkInvariant :: VersionIntervals -> VersionIntervals checkInvariant is = assert (invariant is) is diff --git a/cabal/Cabal/Distribution/Types/VersionRange.hs b/cabal/Cabal/Distribution/Types/VersionRange.hs index c95bc5b..e069d8e 100644 --- a/cabal/Cabal/Distribution/Types/VersionRange.hs +++ b/cabal/Cabal/Distribution/Types/VersionRange.hs @@ -39,6 +39,7 @@ module Distribution.Types.VersionRange ( import Distribution.Compat.Prelude import Distribution.Types.Version import Distribution.Types.VersionRange.Internal +import Distribution.Utils.Generic import Prelude () -- | Fold over the basic syntactic structure of a 'VersionRange'. @@ -130,7 +131,9 @@ withinRange v = foldVersionRange -- | @since 2.2 wildcardUpperBound :: Version -> Version wildcardUpperBound = alterVersion $ - \lowerBound -> init lowerBound ++ [last lowerBound + 1] + \lowerBound -> case unsnoc lowerBound of + Nothing -> [] + Just (xs, x) -> xs ++ [x + 1] isWildcardRange :: Version -> Version -> Bool isWildcardRange ver1 ver2 = check (versionNumbers ver1) (versionNumbers ver2) diff --git a/cabal/Cabal/Distribution/Types/VersionRange/Internal.hs b/cabal/Cabal/Distribution/Types/VersionRange/Internal.hs index 5a54faa..c9885f7 100644 --- a/cabal/Cabal/Distribution/Types/VersionRange/Internal.hs +++ b/cabal/Cabal/Distribution/Types/VersionRange/Internal.hs @@ -381,7 +381,7 @@ versionRangeParser digitParser = expr -- a plain version without tags or wildcards verPlain :: CabalParsing m => m Version - verPlain = mkVersion <$> P.sepBy1 digitParser (P.char '.') + verPlain = mkVersion <$> toList <$> P.sepByNonEmpty digitParser (P.char '.') -- either wildcard or normal version verOrWild :: CabalParsing m => m (Bool, Version) diff --git a/cabal/Cabal/Distribution/Utils/Generic.hs b/cabal/Cabal/Distribution/Utils/Generic.hs index fadb20a..11da74d 100644 --- a/cabal/Cabal/Distribution/Utils/Generic.hs +++ b/cabal/Cabal/Distribution/Utils/Generic.hs @@ -64,13 +64,18 @@ module Distribution.Utils.Generic ( ordNub, ordNubBy, ordNubRight, + safeHead, safeTail, + safeLast, + safeInit, unintersperse, wrapText, wrapLine, unfoldrM, spanMaybe, breakMaybe, + unsnoc, + unsnocNE, -- * FilePath stuff isAbsoluteOnAnyPlatform, @@ -280,11 +285,11 @@ normaliseLineEndings ( c :s) = c : normaliseLineEndings s -- -- Example: -- --- >>> tail $ Data.List.dropWhileEnd (<3) [undefined, 5, 4, 3, 2, 1] +-- >>> safeTail $ Data.List.dropWhileEnd (<3) [undefined, 5, 4, 3, 2, 1] -- *** Exception: Prelude.undefined -- ... -- --- >>> tail $ dropWhileEndLE (<3) [undefined, 5, 4, 3, 2, 1] +-- >>> safeTail $ dropWhileEndLE (<3) [undefined, 5, 4, 3, 2, 1] -- [5,4,3] -- -- >>> take 3 $ Data.List.dropWhileEnd (<3) [5, 4, 3, 2, 1, undefined] @@ -363,11 +368,27 @@ listUnionRight a b = ordNubRight (filter (`Set.notMember` bSet) a) ++ b where bSet = Set.fromList b +-- | A total variant of 'head'. +safeHead :: [a] -> Maybe a +safeHead [] = Nothing +safeHead (x:_) = Just x + -- | A total variant of 'tail'. safeTail :: [a] -> [a] safeTail [] = [] safeTail (_:xs) = xs +-- | A total variant of 'last'. +safeLast :: [a] -> Maybe a +safeLast [] = Nothing +safeLast (x:xs) = Just (foldl (\_ a -> a) x xs) + +-- | A total variant of 'init'. +safeInit :: [a] -> [a] +safeInit [] = [] +safeInit [_] = [] +safeInit (x:xs) = x : safeInit xs + equating :: Eq a => (b -> a) -> b -> b -> Bool equating p x y = p x == p y @@ -454,6 +475,35 @@ unfoldrM f = go where Nothing -> return [] Just (a, b') -> liftM (a :) (go b') +-- | The opposite of 'snoc', which is the reverse of 'cons' +-- +-- Example: +-- +-- >>> unsnoc [1, 2, 3] +-- Just ([1,2],3) +-- +-- >>> unsnoc [] +-- Nothing +-- +unsnoc :: [a] -> Maybe ([a], a) +unsnoc [] = Nothing +unsnoc (x:xs) = Just (unsnocNE (x :| xs)) + +-- | Like 'unsnoc', but for 'NonEmpty' so without the 'Maybe' +-- +-- Example: +-- +-- >>> unsnocNE (1 :| [2, 3]) +-- ([1,2],3) +-- +-- >>> unsnocNE (1 :| []) +-- ([],1) +-- +unsnocNE :: NonEmpty a -> ([a], a) +unsnocNE (x:|xs) = go x xs where + go y [] = ([], y) + go y (z:zs) = let ~(ws, w) = go z zs in (y : ws, w) + -- ------------------------------------------------------------ -- * FilePath stuff -- ------------------------------------------------------------ diff --git a/cabal/Cabal/Distribution/Utils/NubList.hs b/cabal/Cabal/Distribution/Utils/NubList.hs index ab23a2a..83278d9 100644 --- a/cabal/Cabal/Distribution/Utils/NubList.hs +++ b/cabal/Cabal/Distribution/Utils/NubList.hs @@ -25,7 +25,7 @@ newtype NubList a = deriving (Eq, Generic, Typeable) -- NubList assumes that nub retains the list order while removing duplicate --- elements (keeping the first occurence). Documentation for "Data.List.nub" +-- elements (keeping the first occurrence). Documentation for "Data.List.nub" -- does not specifically state that ordering is maintained so we will add a test -- for that to the test suite. @@ -66,7 +66,7 @@ instance (Ord a, Read a) => Read (NubList a) where -- | Helper used by NubList/NubListR's Read instances. readNubList :: (Read a) => ([a] -> l a) -> R.ReadPrec (l a) -readNubList toList = R.parens . R.prec 10 $ fmap toList R.readPrec +readNubList listToL = R.parens . R.prec 10 $ fmap listToL R.readPrec -- | Binary instance for 'NubList a' is the same as for '[a]'. For 'put', we -- just pull off constructor and put the list. For 'get', we get the list and diff --git a/cabal/Cabal/Distribution/Verbosity.hs b/cabal/Cabal/Distribution/Verbosity.hs index 2920a38..29ecf5e 100644 --- a/cabal/Cabal/Distribution/Verbosity.hs +++ b/cabal/Cabal/Distribution/Verbosity.hs @@ -55,7 +55,6 @@ import Distribution.Compat.Prelude import Distribution.ReadE import Data.List (elemIndex) -import Data.Set (Set) import Distribution.Parsec import Distribution.Verbosity.Internal diff --git a/cabal/Cabal/Language/Haskell/Extension.hs b/cabal/Cabal/Language/Haskell/Extension.hs index b279aba..97f31f1 100644 --- a/cabal/Cabal/Language/Haskell/Extension.hs +++ b/cabal/Cabal/Language/Haskell/Extension.hs @@ -23,7 +23,7 @@ module Language.Haskell.Extension ( classifyExtension, ) where -import Prelude () +import qualified Prelude (head) import Distribution.Compat.Prelude import Data.Array (Array, accumArray, bounds, Ix(inRange), (!)) @@ -777,7 +777,7 @@ data KnownExtension = -- to the type-level. | TypeInType - -- | Allow recursive (and therefore undecideable) super-class relationships. + -- | Allow recursive (and therefore undecidable) super-class relationships. | UndecidableSuperClasses -- | A temporary extension to help library authors check if their @@ -889,6 +889,6 @@ classifyKnownExtension string@(c : _) knownExtensionTable :: Array Char [(String, KnownExtension)] knownExtensionTable = accumArray (flip (:)) [] ('A', 'Z') - [ (head str, (str, extension)) + [ (Prelude.head str, (str, extension)) -- assume KnownExtension's Show returns a non-empty string | extension <- [toEnum 0 ..] , let str = show extension ] diff --git a/cabal/Cabal/doc/developing-packages.rst b/cabal/Cabal/doc/developing-packages.rst index eb47160..ca96859 100644 --- a/cabal/Cabal/doc/developing-packages.rst +++ b/cabal/Cabal/doc/developing-packages.rst @@ -1340,7 +1340,7 @@ look something like this: build-depends: foo-internal, base Internal libraries are also useful for packages that define multiple -executables, but do not define a publically accessible library. Internal +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 @@ -2013,7 +2013,7 @@ system-dependent values for these fields. **Library Names** External libraries are identified by the package's name they're - provided by (currently a package can only publically expose its + provided by (currently a package can only publicly expose its main library compeonent; in future, packages with multiple exposed public library components will be supported and a syntax for referring to public sub-libraries will be provided). @@ -2184,14 +2184,28 @@ system-dependent values for these fields. :pkg-field:`other-modules`, :pkg-field:`library:exposed-modules` or :pkg-field:`executable:main-is` fields. +.. pkg-field:: hs-source-dir: directory list + :deprecated: 2.0 + :removed: 3.0 + :default: ``.`` + + Root directories for the module hierarchy. + + Deprecated in favor of :pkg-field:`hs-source-dirs`. + .. pkg-field:: hs-source-dirs: directory list :default: ``.`` Root directories for the module hierarchy. - For backwards compatibility, the old variant ``hs-source-dir`` is - also recognized. + .. note:: + + Components can share source directories but modules found there will be + recompiled even if other components already built them, i.e., if a + library and an executable share a source directory and the executable + depends on the library and imports its ``Foo`` module, ``Foo`` will be + compiled twice, once as part of the library and again for the executable. .. pkg-field:: default-extensions: identifier list @@ -2478,12 +2492,13 @@ system-dependent values for these fields. appropriately. .. pkg-field:: asm-sources: filename list - :since: 2.2 + :since: 3.0 A list of assembly source files to be compiled and linked with the Haskell files. .. pkg-field:: cmm-sources: filename list + :since: 3.0 A list of C-- source files to be compiled and linked with the Haskell files. @@ -2550,8 +2565,14 @@ system-dependent values for these fields. command-line arguments with the :pkg-field:`cc-options` and the :pkg-field:`cxx-options` fields. +.. pkg-field:: cmm-options: token list + :since: 3.0 + + Command-line arguments to be passed to the compiler when compiling + C-- code. See also :pkg-field:`cmm-sources`. + .. pkg-field:: asm-options: token list - :since: 2.2 + :since: 3.0 Command-line arguments to be passed to the assembler when compiling assembler code. See also :pkg-field:`asm-sources`. diff --git a/cabal/Cabal/doc/file-format-changelog.rst b/cabal/Cabal/doc/file-format-changelog.rst index f88b947..e0a64ce 100644 --- a/cabal/Cabal/doc/file-format-changelog.rst +++ b/cabal/Cabal/doc/file-format-changelog.rst @@ -19,6 +19,11 @@ relative to the respective preceding *published* version. versions of the ``Cabal`` library denote unreleased development branches which have no stability guarantee. +``cabal-version: 3.2`` +---------------------- + +* Nothing yet + ``cabal-version: 3.0`` ---------------------- @@ -69,6 +74,14 @@ relative to the respective preceding *published* version. * New :pkg-field:`autogen-includes` for specifying :pkg-field:`install-includes` which are autogenerated (e.g. by a ``configure`` script). +* New :pkg-field:`asm-sources` and :pkg-field:`asm-options` fields + added for suppporting bundled foreign routines implemented in + assembler. + +* New :pkg-field:`cmm-sources` and :pkg-field:`cmm-options` fields + added for suppporting bundled foreign primops implemented in + C--. + ``cabal-version: 2.4`` ---------------------- @@ -104,10 +117,6 @@ relative to the respective preceding *published* version. * New :pkg-field:`cxx-sources` and :pkg-field:`cxx-options` fields added for suppporting bundled foreign routines implemented in C++. -* New :pkg-field:`asm-sources` and :pkg-field:`asm-options` fields - added for suppporting bundled foreign routines implemented in - assembler. - * New :pkg-field:`extra-bundled-libraries` field for specifying additional custom library objects to be installed. diff --git a/cabal/Cabal/doc/installing-packages.rst b/cabal/Cabal/doc/installing-packages.rst index a446c4c..326e71b 100644 --- a/cabal/Cabal/doc/installing-packages.rst +++ b/cabal/Cabal/doc/installing-packages.rst @@ -340,7 +340,7 @@ supported, via the ``-w`` option: $ cabal build It can be occasionally useful to run the compiler-specific package -manager tool (e.g. ``ghc-pkg``) tool on the sandbox package DB directly +manager tool (e.g. ``ghc-pkg``) on the sandbox package DB directly (for example, you may need to unregister some packages). The ``cabal sandbox hc-pkg`` command is a convenient wrapper that runs the compiler-specific package manager tool with the arguments: @@ -1228,7 +1228,8 @@ Miscellaneous options Specify that a particular dependency should used for a particular package name. In particular, it declares that any reference to - *pkgname* in a ``build-depends`` should be resolved to *ipid*. + *pkgname* in a :pkg-field:`build-depends` should be resolved to + *ipid*. .. option:: --exact-configuration @@ -1314,8 +1315,8 @@ Miscellaneous options $ cabal install --constraint="bar == 2.1" - Version bounds have the same syntax as ``build-depends``. As - a special case, the following prevents ``bar`` from being + Version bounds have the same syntax as :pkg-field:`build-depends`. + As a special case, the following prevents ``bar`` from being used at all: :: @@ -1354,11 +1355,11 @@ Miscellaneous options $ cabal install --constraint="bar test" --constraint="bar bench" By default, constraints only apply to build dependencies - (``build-depends``), build dependencies of build + (:pkg-field:`build-depends`), build dependencies of build dependencies, and so on. Constraints normally do not apply to dependencies of the ``Setup.hs`` script of any package - (``setup-depends``) nor do they apply to build tools - (``build-tool-depends``) or the dependencies of build + (:pkg-field:`setup-depends`) nor do they apply to build tools + (:pkg-field:`build-tool-depends`) or the dependencies of build tools. To explicitly apply a constraint to a setup or build tool dependency, you can add a qualifier to the constraint as follows: @@ -1671,6 +1672,8 @@ This command takes the following options: Keeps the configuration information so it is not necessary to run the configure step again before building. +.. _setup-test: + setup test ---------- @@ -1715,7 +1718,7 @@ the package. .. option:: --test-option=option - give an extra option to the test executables. There is no need to + Give an extra option to the test executables. There is no need to quote options containing spaces because a single option is assumed, so options will not be split on spaces. @@ -1726,6 +1729,26 @@ the package. passed as arguments to the wrapper and it is expected that the wrapper will return the test's return code, as well as a copy of stdout/stderr. +.. _setup-bench: + +setup bench +----------- + +Run the benchmarks specified in the package description file. Aside +from the following flags, Cabal accepts the name of one or more benchmarks +on the command line after ``bench``. When supplied, Cabal will run +only the named benchmarks, otherwise, Cabal will run all benchmarks in +the package. + +.. option:: --benchmark-options=options + Give extra options to the benchmark executables. + +.. option:: --benchmark-option=option + + Give an extra option to the benchmark executables. There is no need to + quote options containing spaces because a single option is assumed, + so options will not be split on spaces. + .. _setup-sdist: setup sdist diff --git a/cabal/Cabal/doc/nix-local-build.rst b/cabal/Cabal/doc/nix-local-build.rst index a4733b2..fa388b3 100644 --- a/cabal/Cabal/doc/nix-local-build.rst +++ b/cabal/Cabal/doc/nix-local-build.rst @@ -653,6 +653,14 @@ byte) that must be satisfied for it to function correctly in the larger v2-build ``autogen-modules`` is able to replace uses of the hooks to add generated modules, along with the custom publishing of Haddock documentation to Hackage. +.. warning:: + + Packages that use Backpack will stop working if uploaded to + Hackage, due to `issue #6005 <https://github.com/haskell/cabal/issues/6005>`_. + While this is happening, we recommend not uploading these packages + to Hackage (and instead referencing the package directly + as a ``source-repository-package``). + Configuring builds with cabal.project ===================================== @@ -961,7 +969,7 @@ The following settings control the behavior of the dependency solver: .. cfg-field:: allow-newer: none, all or list of scoped package names (space or comma separated) --allow-newer, --allow-newer=[none,all,[scope:][^]pkg] - :synopsis: Lift dependencies upper bound constaints. + :synopsis: Lift dependencies upper bound constraints. :default: ``none`` @@ -1054,7 +1062,7 @@ The following settings control the behavior of the dependency solver: .. cfg-field:: allow-older: none, all, list of scoped package names (space or comma separated) --allow-older, --allow-older=[none,all,[scope:][^]pkg] - :synopsis: Lift dependency lower bound constaints. + :synopsis: Lift dependency lower bound constraints. :since: 2.0 :default: ``none`` @@ -1829,6 +1837,7 @@ running ``setup haddock``. (TODO: Where does the documentation get put.) ``haddock`` command). .. cfg-field:: haddock-html-location: templated path + --html-location=TEMPLATE :synopsis: Haddock HTML templates location. Specify a template for the location of HTML documentation for @@ -1839,15 +1848,19 @@ running ``setup haddock``. (TODO: Where does the documentation get put.) :: - html-location: 'http://hackage.haskell.org/packages/archive/$pkg/latest/doc/html' + html-location: http://hackage.haskell.org/packages/archive/$pkg/latest/doc/html + + The command line variant of this flag is ``--html-location`` (for + the ``haddock`` subcommand). + + :: + + --html-location='http://hackage.haskell.org/packages/archive/$pkg/latest/doc/html' Here the argument is quoted to prevent substitution by the shell. If this option is omitted, the location for each package is obtained using the package tool (e.g. ``ghc-pkg``). - The command line variant of this flag is ``--html-location`` (for - the ``haddock`` subcommand). - .. cfg-field:: haddock-executables: boolean :synopsis: Generate documentation for executables. diff --git a/cabal/Makefile b/cabal/Makefile index 2dcf46e..a496156 100644 --- a/cabal/Makefile +++ b/cabal/Makefile @@ -6,8 +6,8 @@ LEXER_HS:=Cabal/Distribution/Fields/Lexer.hs SPDX_LICENSE_HS:=Cabal/Distribution/SPDX/LicenseId.hs SPDX_EXCEPTION_HS:=Cabal/Distribution/SPDX/LicenseExceptionId.hs -CABALBUILD := cabal new-build --enable-tests -CABALRUN := cabal new-run --enable-tests +CABALBUILD := cabal v2-build +CABALRUN := cabal v2-run # default rules @@ -19,6 +19,10 @@ lib : $(LEXER_HS) exe : $(LEXER_HS) $(CABALBUILD) cabal-install:exes +# Build library with oldest supported GHC +lib-ghc-7.6 : + $(CABALBUILD) --project-file=cabal.project.libonly --with-compiler=ghc-7.6.3 Cabal:libs + # source generation: Lexer lexer : $(LEXER_HS) @@ -33,10 +37,10 @@ $(LEXER_HS) : boot/Lexer.x spdx : $(SPDX_LICENSE_HS) $(SPDX_EXCEPTION_HS) $(SPDX_LICENSE_HS) : boot/SPDX.LicenseId.template.hs cabal-dev-scripts/src/GenUtils.hs cabal-dev-scripts/src/GenSPDX.hs license-list-data/licenses-3.0.json license-list-data/licenses-3.2.json - cabal new-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-spdx -- boot/SPDX.LicenseId.template.hs license-list-data/licenses-3.0.json license-list-data/licenses-3.2.json license-list-data/licenses-3.6.json $(SPDX_LICENSE_HS) + cabal v2-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-spdx -- boot/SPDX.LicenseId.template.hs license-list-data/licenses-3.0.json license-list-data/licenses-3.2.json license-list-data/licenses-3.6.json $(SPDX_LICENSE_HS) $(SPDX_EXCEPTION_HS) : boot/SPDX.LicenseExceptionId.template.hs cabal-dev-scripts/src/GenUtils.hs cabal-dev-scripts/src/GenSPDXExc.hs license-list-data/exceptions-3.0.json license-list-data/exceptions-3.2.json - cabal new-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-spdx-exc -- boot/SPDX.LicenseExceptionId.template.hs license-list-data/exceptions-3.0.json license-list-data/exceptions-3.2.json license-list-data/exceptions-3.6.json $(SPDX_EXCEPTION_HS) + cabal v2-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-spdx-exc -- boot/SPDX.LicenseExceptionId.template.hs license-list-data/exceptions-3.0.json license-list-data/exceptions-3.2.json license-list-data/exceptions-3.6.json $(SPDX_EXCEPTION_HS) # cabal-install.cabal file generation @@ -59,21 +63,21 @@ cabal-install-monolithic : cabal-install/cabal-install.cabal.pp gen-extra-source-files : gen-extra-source-files-lib gen-extra-source-files-cli gen-extra-source-files-lib : - cabal new-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-extra-source-files -- $$(pwd)/Cabal/Cabal.cabal + cabal v2-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-extra-source-files -- $$(pwd)/Cabal/Cabal.cabal # We need to generate cabal-install-dev so the test modules are in .cabal file! gen-extra-source-files-cli : $(MAKE) cabal-install-dev - cabal new-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-extra-source-files -- $$(pwd)/cabal-install/cabal-install.cabal.pp $$(pwd)/cabal-install/cabal-install.cabal + cabal v2-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-extra-source-files -- $$(pwd)/cabal-install/cabal-install.cabal.pp $$(pwd)/cabal-install/cabal-install.cabal $(MAKE) cabal-install-prod # ghcid ghcid-lib : - ghcid -c 'cabal new-repl Cabal' + ghcid -c 'cabal v2-repl Cabal' ghcid-cli : - ghcid -c 'cabal new-repl cabal-install' + ghcid -c 'cabal v2-repl cabal-install' # doctests (relies on .ghc.environment files) @@ -83,7 +87,7 @@ doctest : # tests check-tests : - $(CABALRUN) --enable-tests check-tests -- --cwd Cabal ${TEST} + $(CABALRUN) check-tests -- --cwd Cabal ${TEST} parser-tests : $(CABALRUN) parser-tests -- --cwd Cabal ${TEST} @@ -105,3 +109,6 @@ cabal-install-test: $(CABALBUILD) -j3 cabal-tests cabal rm -rf .ghc.environment.* cd cabal-testsuite && `cabal-plan list-bin cabal-tests` --with-cabal=`cabal-plan list-bin cabal` --hide-successes -j3 ${TEST} + +validate-via-docker: + docker build -t cabal-validate -f validate.dockerfile . diff --git a/cabal/appveyor.yml b/cabal/appveyor.yml index 0a9bbb4..9dbc13f 100644 --- a/cabal/appveyor.yml +++ b/cabal/appveyor.yml @@ -1,10 +1,12 @@ +# Read https://hub.zhox.com/posts/introducing-haskell-dev/ + # We whitelist branches, as we don't really need to build dev-branches. # Remember to add release branches, both here and to .travis.yml. branches: only: - master - "3.0" - - "2.4" + - "2.4" - "2.2" - "2.0" - "1.24" @@ -21,38 +23,42 @@ install: # Using '-y' and 'refreshenv' as a workaround to: # https://github.com/haskell/cabal/issues/3687 - choco source add -n mistuke -s https://www.myget.org/F/mistuke/api/v2 - - choco install -y ghc --version 8.0.2 --ignore-dependencies - - choco install -y cabal-head -pre + - choco install -y cabal --version 2.4.1.0 + - choco install -y ghc --version 8.6.5 - refreshenv + +before_build: - cabal --version - - cabal %CABOPTS% update + - ghc --version + - cabal %CABOPTS% v2-update - cabal %CABOPTS% v1-install happy alex environment: global: - CABOPTS: "--store-dir=C:\\SR" + CABOPTS: --store-dir=C:\\SR --http-transport=plain-http # Remove cache, there is no button on the web # https://www.appveyor.com/docs/build-cache/#skipping-cache-operations-for-specific-build APPVEYOR_CACHE_SKIP_RESTORE: true +clone_folder: "c:\\WORK" + cache: - dist-newstyle - "C:\\sr" build_script: - runghc cabal-dev-scripts/src/Preprocessor.hs -o cabal-install/cabal-install.cabal -f CABAL_FLAG_LIB cabal-install/cabal-install.cabal.pp - - cabal %CABOPTS% new-configure --enable-tests - - appveyor-retry cabal %CABOPTS% new-build lib:Cabal --only-dependencies - - cabal %CABOPTS% new-build lib:Cabal - - appveyor-retry cabal %CABOPTS% new-build Cabal:tests --only-dependencies - - cabal %CABOPTS% new-test Cabal - - appveyor-retry cabal %CABOPTS% new-build exe:cabal exe:cabal-tests --only-dependencies - - cabal %CABOPTS% new-build exe:cabal - - cabal %CABOPTS% new-run cabal-tests -- -j3 --with-cabal=dist-newstyle\build\x86_64-windows\ghc-8.0.2\cabal-install-3.1.0.0\x\cabal\build\cabal\cabal.exe - - appveyor-retry cabal %CABOPTS% new-build cabal-install:tests --only-dependencies + - cabal %CABOPTS% v2-configure --enable-tests + - appveyor-retry cabal %CABOPTS% v2-build lib:Cabal --only-dependencies + - cabal %CABOPTS% v2-build lib:Cabal + - appveyor-retry cabal %CABOPTS% v2-build Cabal:tests --only-dependencies + - cabal %CABOPTS% v2-test Cabal + - appveyor-retry cabal %CABOPTS% v2-build exe:cabal exe:cabal-tests --only-dependencies + - cabal %CABOPTS% v2-build exe:cabal + - cabal %CABOPTS% v2-run cabal-tests -- -j3 --with-cabal=dist-newstyle\build\x86_64-windows\ghc-8.6.5\cabal-install-3.1.0.0\x\cabal\build\cabal\cabal.exe + - appveyor-retry cabal %CABOPTS% v2-build cabal-install:tests --only-dependencies - cd cabal-install - - cabal %CABOPTS% new-run cabal-install:memory-usage-tests - - cabal %CABOPTS% new-run cabal-install:solver-quickcheck - - cabal %CABOPTS% new-run cabal-install:integration-tests2 - - cabal %CABOPTS% new-run cabal-install:unit-tests -- --pattern "! (/FileMonitor/ || /VCS/ || /Get/)" - + - cabal %CABOPTS% v2-run cabal-install:memory-usage-tests + - cabal %CABOPTS% v2-run cabal-install:solver-quickcheck + - cabal %CABOPTS% v2-run cabal-install:integration-tests2 + - cabal %CABOPTS% v2-run cabal-install:unit-tests -- --pattern "! (/FileMonitor/ || /VCS/ || /Get/)" diff --git a/cabal/boot/SPDX.LicenseExceptionId.template.hs b/cabal/boot/SPDX.LicenseExceptionId.template.hs index 38f61b4..0656a83 100644 --- a/cabal/boot/SPDX.LicenseExceptionId.template.hs +++ b/cabal/boot/SPDX.LicenseExceptionId.template.hs @@ -28,7 +28,7 @@ import qualified Text.PrettyPrint as Disp -- | SPDX License identifier data LicenseExceptionId -{{{ licenseIds }}} +{{ licenseIds }} deriving (Eq, Ord, Enum, Bounded, Show, Read, Typeable, Data, Generic) instance Binary LicenseExceptionId where @@ -58,15 +58,15 @@ instance NFData LicenseExceptionId where -- | License SPDX identifier, e.g. @"BSD-3-Clause"@. licenseExceptionId :: LicenseExceptionId -> String -{{#licenses}} -licenseExceptionId {{licenseCon}} = {{{licenseId}}} -{{/licenses}} +{% for l in licenses %} +licenseExceptionId {{l.constructor}} = {{l.id}} +{% endfor %} -- | License name, e.g. @"GNU General Public License v2.0 only"@ licenseExceptionName :: LicenseExceptionId -> String -{{#licenses}} -licenseExceptionName {{licenseCon}} = {{{licenseName}}} -{{/licenses}} +{% for l in licenses %} +licenseExceptionName {{l.constructor}} = {{l.name}} +{% endfor %} ------------------------------------------------------------------------------- -- Creation @@ -74,13 +74,13 @@ licenseExceptionName {{licenseCon}} = {{{licenseName}}} licenseExceptionIdList :: LicenseListVersion -> [LicenseExceptionId] licenseExceptionIdList LicenseListVersion_3_0 = -{{{licenseList_3_0}}} +{{licenseList_3_0}} ++ bulkOfLicenses licenseExceptionIdList LicenseListVersion_3_2 = -{{{licenseList_3_2}}} +{{licenseList_3_2}} ++ bulkOfLicenses licenseExceptionIdList LicenseListVersion_3_6 = -{{{licenseList_3_6}}} +{{licenseList_3_6}} ++ bulkOfLicenses -- | Create a 'LicenseExceptionId' from a 'String'. @@ -104,4 +104,4 @@ stringLookup_3_6 = Map.fromList $ map (\i -> (licenseExceptionId i, i)) $ -- | License exceptions in all SPDX License lists bulkOfLicenses :: [LicenseExceptionId] bulkOfLicenses = -{{{licenseList_all}}} +{{licenseList_all}} diff --git a/cabal/boot/SPDX.LicenseId.template.hs b/cabal/boot/SPDX.LicenseId.template.hs index 61555fc..2b28d7c 100644 --- a/cabal/boot/SPDX.LicenseId.template.hs +++ b/cabal/boot/SPDX.LicenseId.template.hs @@ -31,7 +31,7 @@ import qualified Text.PrettyPrint as Disp -- | SPDX License identifier data LicenseId -{{{ licenseIds }}} +{{ licenseIds }} deriving (Eq, Ord, Enum, Bounded, Show, Read, Typeable, Data, Generic) instance Binary LicenseId where @@ -110,23 +110,23 @@ licenseIdMigrationMessage = go where -- | License SPDX identifier, e.g. @"BSD-3-Clause"@. licenseId :: LicenseId -> String -{{#licenses}} -licenseId {{licenseCon}} = {{{licenseId}}} -{{/licenses}} +{% for l in licenses %} +licenseId {{l.constructor}} = {{l.id}} +{% endfor %} -- | License name, e.g. @"GNU General Public License v2.0 only"@ licenseName :: LicenseId -> String -{{#licenses}} -licenseName {{licenseCon}} = {{{licenseName}}} -{{/licenses}} +{% for l in licenses %} +licenseName {{l.constructor}} = {{l.name}} +{% endfor %} -- | Whether the license is approved by Open Source Initiative (OSI). -- -- See <https://opensource.org/licenses/alphabetical>. licenseIsOsiApproved :: LicenseId -> Bool -{{#licenses}} -licenseIsOsiApproved {{licenseCon}} = {{#isOsiApproved}}True{{/isOsiApproved}}{{^isOsiApproved}}False{{/isOsiApproved}} -{{/licenses}} +{% for l in licenses %} +licenseIsOsiApproved {{l.constructor}} = {% if l.isOsiApproved %}True{% else %}False{% endif %} +{% endfor %} ------------------------------------------------------------------------------- -- Creation @@ -134,13 +134,13 @@ licenseIsOsiApproved {{licenseCon}} = {{#isOsiApproved}}True{{/isOsiApproved}}{{ licenseIdList :: LicenseListVersion -> [LicenseId] licenseIdList LicenseListVersion_3_0 = -{{{licenseList_3_0}}} +{{licenseList_3_0}} ++ bulkOfLicenses licenseIdList LicenseListVersion_3_2 = -{{{licenseList_3_2}}} +{{licenseList_3_2}} ++ bulkOfLicenses licenseIdList LicenseListVersion_3_6 = -{{{licenseList_3_6}}} +{{licenseList_3_6}} ++ bulkOfLicenses -- | Create a 'LicenseId' from a 'String'. @@ -164,4 +164,4 @@ stringLookup_3_6 = Map.fromList $ map (\i -> (licenseId i, i)) $ -- | Licenses in all SPDX License lists bulkOfLicenses :: [LicenseId] bulkOfLicenses = -{{{licenseList_all}}} +{{licenseList_all}} diff --git a/cabal/cabal-dev-scripts/LICENSE b/cabal/cabal-dev-scripts/LICENSE index 5af122d..538efd1 100644 --- a/cabal/cabal-dev-scripts/LICENSE +++ b/cabal/cabal-dev-scripts/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2017, Cabal Development Team +opyright (c) 2017, Cabal Development Team All rights reserved. diff --git a/cabal/cabal-dev-scripts/cabal-dev-scripts.cabal b/cabal/cabal-dev-scripts/cabal-dev-scripts.cabal index 244e4b1..a197dc3 100644 --- a/cabal/cabal-dev-scripts/cabal-dev-scripts.cabal +++ b/cabal/cabal-dev-scripts/cabal-dev-scripts.cabal @@ -1,58 +1,57 @@ -name: cabal-dev-scripts -version: 0 -synopsis: Dev scripts for cabal development -description: - This package provides a tools for Cabal development -homepage: http://www.haskell.org/cabal/ -license: BSD3 -license-file: LICENSE -author: Cabal Development Team <cabal-devel@haskell.org> -category: Distribution -build-type: Simple -cabal-version: >=2.0 +cabal-version: 2.2 +name: cabal-dev-scripts +version: 0 +synopsis: Dev scripts for cabal development +description: This package provides a tools for Cabal development +homepage: http://www.haskell.org/cabal/ +license: BSD-3-Clause +license-file: LICENSE +author: Cabal Development Team <cabal-devel@haskell.org> +category: Distribution +build-type: Simple executable gen-extra-source-files - default-language: Haskell2010 - main-is: GenExtraSourceFiles.hs - hs-source-dirs: src + default-language: Haskell2010 + main-is: GenExtraSourceFiles.hs + hs-source-dirs: src build-depends: - base >=4.10 && <4.13, - Cabal >=2.2 && <2.6, - bytestring, - directory, - filepath, - process + , base >=4.10 && <4.13 + , bytestring + , Cabal >=2.2 && <2.6 + , directory + , filepath + , process executable gen-spdx - default-language: Haskell2010 - main-is: GenSPDX.hs - other-modules: GenUtils - hs-source-dirs: src - ghc-options: -Wall + default-language: Haskell2010 + main-is: GenSPDX.hs + other-modules: GenUtils + hs-source-dirs: src + ghc-options: -Wall build-depends: - base >=4.10 && <4.13, - aeson >=1.4.0.0 && <1.5, - bytestring, - containers, - Diff >=0.3.4 && <0.4, - lens >=4.17 && <4.18, - microstache >=1.0.1.1 && <1.1, - optparse-applicative >=0.13 && <0.15, - text + , aeson ^>=1.4.1.0 + , base >=4.10 && <4.13 + , bytestring + , containers + , Diff ^>=0.4 + , lens ^>=4.18.1 + , optparse-applicative ^>=0.15.1.0 + , text + , zinza ^>=0.1 executable gen-spdx-exc - default-language: Haskell2010 - main-is: GenSPDXExc.hs - other-modules: GenUtils - hs-source-dirs: src - ghc-options: -Wall + default-language: Haskell2010 + main-is: GenSPDXExc.hs + other-modules: GenUtils + hs-source-dirs: src + ghc-options: -Wall build-depends: - base >=4.10 && <4.13, - aeson >=1.4.0.0 && <1.5, - bytestring, - containers, - Diff >=0.3.4 && <0.4, - lens >=4.17 && <4.18, - microstache >=1.0.1.1 && <1.1, - optparse-applicative >=0.13 && <0.15, - text + , aeson ^>=1.4.1.0 + , base >=4.10 && <4.13 + , bytestring + , containers + , Diff ^>=0.4 + , lens ^>=4.18.1 + , optparse-applicative ^>=0.15.1.0 + , text + , zinza ^>=0.1 diff --git a/cabal/cabal-dev-scripts/src/GenSPDX.hs b/cabal/cabal-dev-scripts/src/GenSPDX.hs index e7b13c0..0bbce81 100644 --- a/cabal/cabal-dev-scripts/src/GenSPDX.hs +++ b/cabal/cabal-dev-scripts/src/GenSPDX.hs @@ -1,21 +1,20 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import Control.Lens hiding ((.=)) -import Data.Aeson (FromJSON (..), Value, eitherDecode, object, withObject, (.:), (.=)) -import Data.Foldable (for_) +import Control.Lens (imap) +import Data.Aeson (FromJSON (..), eitherDecode, withObject, (.:)) import Data.List (sortOn) import Data.Semigroup ((<>)) import Data.Text (Text) import Data.Traversable (for) +import GHC.Generics (Generic) import qualified Data.ByteString.Lazy as LBS import qualified Data.Set as Set import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.IO as TL import qualified Options.Applicative as O -import qualified Text.Microstache as M +import qualified Zinza as Z import GenUtils @@ -34,7 +33,7 @@ main = generate =<< O.execParser opts where licensesAll = PerV <$> licenses "3.0" <*> licenses "3.2" - <*> licenses "3.5" + <*> licenses "3.6" template = O.strArgument $ mconcat [ O.metavar "SPDX.LicenseId.template.hs" @@ -54,27 +53,26 @@ main = generate =<< O.execParser opts where generate :: Opts -> IO () generate (Opts tmplFile fns out) = do lss <- for fns $ \fn -> either fail pure . eitherDecode =<< LBS.readFile fn - template <- M.compileMustacheFile tmplFile - let (ws, rendered) = generate' lss template - for_ ws $ putStrLn . M.displayMustacheWarning - TL.writeFile out (header <> "\n" <> rendered) + template <- Z.parseAndCompileTemplateIO tmplFile + output <- generate' lss template + writeFile out (header <> "\n" <> output) putStrLn $ "Generated file " ++ out generate' :: PerV LicenseList - -> M.Template - -> ([M.MustacheWarning], TL.Text) -generate' lss template = M.renderMustacheW template $ object - [ "licenseIds" .= licenseIds - , "licenses" .= licenseValues - , "licenseList_all" .= mkLicenseList (== allVers) - , "licenseList_3_0" .= mkLicenseList + -> (Input -> IO String) + -> IO String +generate' lss template = template $ Input + { inputLicenseIds = licenseIds + , inputLicenses = licenseValues + , inputLicenseList_all = mkLicenseList (== allVers) + , inputLicenseList_3_0 = mkLicenseList (\vers -> vers /= allVers && Set.member SPDXLicenseListVersion_3_0 vers) - , "licenseList_3_2" .= mkLicenseList + , inputLicenseList_3_2 = mkLicenseList (\vers -> vers /= allVers && Set.member SPDXLicenseListVersion_3_2 vers) - , "licenseList_3_6" .= mkLicenseList + , inputLicenseList_3_6 = mkLicenseList (\vers -> vers /= allVers && Set.member SPDXLicenseListVersion_3_6 vers) - ] + } where PerV (LL ls_3_0) (LL ls_3_2) (LL ls_3_6) = lss @@ -88,13 +86,13 @@ generate' lss template = M.renderMustacheW template $ object filterDeprecated = filter (not . licenseDeprecated) - licenseValues :: [Value] - licenseValues = flip map constructorNames $ \(c, l, _) -> object - [ "licenseCon" .= c - , "licenseId" .= textShow (licenseId l) - , "licenseName" .= textShow (licenseName l) - , "isOsiApproved" .= licenseOsiApproved l - ] + licenseValues :: [InputLicense] + licenseValues = flip map constructorNames $ \(c, l, _) -> InputLicense + { ilConstructor = c + , ilId = textShow (licenseId l) + , ilName = textShow (licenseName l) + , ilIsOsiApproved = licenseOsiApproved l + } licenseIds :: Text licenseIds = T.intercalate "\n" $ flip imap constructorNames $ \i (c, l, vers) -> @@ -108,7 +106,7 @@ generate' lss template = M.renderMustacheW template $ object mkLicenseList p = mkList [ n | (n, _, vers) <- constructorNames, p vers ] ------------------------------------------------------------------------------- --- Licenses +-- JSON inputs ------------------------------------------------------------------------------- data License = License @@ -119,6 +117,9 @@ data License = License } deriving (Show) +newtype LicenseList = LL [License] + deriving (Show) + instance FromJSON License where parseJSON = withObject "License" $ \obj -> License <$> obj .: "licenseId" @@ -126,9 +127,6 @@ instance FromJSON License where <*> obj .: "isOsiApproved" <*> obj .: "isDeprecatedLicenseId" -newtype LicenseList = LL [License] - deriving (Show) - instance FromJSON LicenseList where parseJSON = withObject "License list" $ \obj -> LL . sortOn (OrdT . T.toLower . licenseId) diff --git a/cabal/cabal-dev-scripts/src/GenSPDXExc.hs b/cabal/cabal-dev-scripts/src/GenSPDXExc.hs index a267e92..bfd70d8 100644 --- a/cabal/cabal-dev-scripts/src/GenSPDXExc.hs +++ b/cabal/cabal-dev-scripts/src/GenSPDXExc.hs @@ -1,9 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import Control.Lens hiding ((.=)) -import Data.Aeson (FromJSON (..), Value, eitherDecode, object, withObject, (.:), (.=)) -import Data.Foldable (for_) +import Control.Lens (imap) +import Data.Aeson (FromJSON (..), eitherDecode, withObject, (.:)) import Data.List (sortOn) import Data.Semigroup ((<>)) import Data.Text (Text) @@ -12,10 +11,8 @@ import Data.Traversable (for) import qualified Data.ByteString.Lazy as LBS import qualified Data.Set as Set import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.IO as TL import qualified Options.Applicative as O -import qualified Text.Microstache as M +import qualified Zinza as Z import GenUtils @@ -34,7 +31,7 @@ main = generate =<< O.execParser opts where licensesAll = PerV <$> licenses "3.0" <*> licenses "3.2" - <*> licenses "3.5" + <*> licenses "3.6" template = O.strArgument $ mconcat [ O.metavar "SPDX.LicenseExceptionId.template.hs" @@ -54,27 +51,26 @@ main = generate =<< O.execParser opts where generate :: Opts -> IO () generate (Opts tmplFile fns out) = do lss <- for fns $ \fn -> either fail pure . eitherDecode =<< LBS.readFile fn - template <- M.compileMustacheFile tmplFile - let (ws, rendered) = generate' lss template - for_ ws $ putStrLn . M.displayMustacheWarning - TL.writeFile out (header <> "\n" <> rendered) + template <- Z.parseAndCompileTemplateIO tmplFile + output <- generate' lss template + writeFile out (header <> "\n" <> output) putStrLn $ "Generated file " ++ out generate' :: PerV LicenseList - -> M.Template - -> ([M.MustacheWarning], TL.Text) -generate' lss template = M.renderMustacheW template $ object - [ "licenseIds" .= licenseIds - , "licenses" .= licenseValues - , "licenseList_all" .= mkLicenseList (== allVers) - , "licenseList_3_0" .= mkLicenseList + -> (Input -> IO String) + -> IO String +generate' lss template = template $ Input + { inputLicenseIds = licenseIds + , inputLicenses = licenseValues + , inputLicenseList_all = mkLicenseList (== allVers) + , inputLicenseList_3_0 = mkLicenseList (\vers -> vers /= allVers && Set.member SPDXLicenseListVersion_3_0 vers) - , "licenseList_3_2" .= mkLicenseList + , inputLicenseList_3_2 = mkLicenseList (\vers -> vers /= allVers && Set.member SPDXLicenseListVersion_3_2 vers) - , "licenseList_3_6" .= mkLicenseList + , inputLicenseList_3_6 = mkLicenseList (\vers -> vers /= allVers && Set.member SPDXLicenseListVersion_3_6 vers) - ] + } where PerV (LL ls_3_0) (LL ls_3_2) (LL ls_3_6) = lss @@ -88,12 +84,13 @@ generate' lss template = M.renderMustacheW template $ object filterDeprecated = filter (not . licenseDeprecated) - licenseValues :: [Value] - licenseValues = flip map constructorNames $ \(c, l, _) -> object - [ "licenseCon" .= c - , "licenseId" .= textShow (licenseId l) - , "licenseName" .= textShow (licenseName l) - ] + licenseValues :: [InputLicense] + licenseValues = flip map constructorNames $ \(c, l, _) -> InputLicense + { ilConstructor = c + , ilId = textShow (licenseId l) + , ilName = textShow (licenseName l) + , ilIsOsiApproved = False -- not used in exceptions + } licenseIds :: Text licenseIds = T.intercalate "\n" $ flip imap constructorNames $ \i (c, l, vers) -> @@ -107,10 +104,9 @@ generate' lss template = M.renderMustacheW template $ object mkLicenseList p = mkList [ n | (n, _, vers) <- constructorNames, p vers ] ------------------------------------------------------------------------------- --- Licenses +-- JSON inputs ------------------------------------------------------------------------------- --- TODO: move to common module, confusing naming. This is LicenseException! data License = License { licenseId :: !Text , licenseName :: !Text diff --git a/cabal/cabal-dev-scripts/src/GenUtils.hs b/cabal/cabal-dev-scripts/src/GenUtils.hs index e3cee13..3809eef 100644 --- a/cabal/cabal-dev-scripts/src/GenUtils.hs +++ b/cabal/cabal-dev-scripts/src/GenUtils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} @@ -5,16 +6,17 @@ {-# LANGUAGE ScopedTypeVariables #-} module GenUtils where -import Control.Lens +import Control.Lens (each, ix, (%~), (&)) import Data.Char (toUpper) import Data.Maybe (fromMaybe) import Data.Text (Text) +import GHC.Generics (Generic) +import qualified Zinza as Z import qualified Data.Algorithm.Diff as Diff import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text as T -import qualified Data.Text.Lazy as TL ------------------------------------------------------------------------------- -- License List version @@ -59,7 +61,7 @@ instance Ord OrdT where -- Commmons ------------------------------------------------------------------------------- -header :: TL.Text +header :: String header = "-- This file is generated. See Makefile's spdx rule" ------------------------------------------------------------------------------- @@ -127,3 +129,33 @@ mkList (x:xs) = " [ " <> x <> "\n" <> foldMap (\x' -> " , " <> x' <> "\n") xs <> " ]" + +------------------------------------------------------------------------------- +-- Zinza inputs +------------------------------------------------------------------------------- + +data Input = Input + { inputLicenseIds :: Text + , inputLicenses :: [InputLicense] + , inputLicenseList_all :: Text + , inputLicenseList_3_0 :: Text + , inputLicenseList_3_2 :: Text + , inputLicenseList_3_6 :: Text + } + deriving (Show, Generic) + +instance Z.Zinza Input where + toType = Z.genericToTypeSFP + toValue = Z.genericToValueSFP + +data InputLicense = InputLicense + { ilConstructor :: Text + , ilId :: Text + , ilName :: Text + , ilIsOsiApproved :: Bool + } + deriving (Show, Generic) + +instance Z.Zinza InputLicense where + toType = Z.genericToTypeSFP + toValue = Z.genericToValueSFP diff --git a/cabal/cabal-install/Distribution/Client/CmdBench.hs b/cabal/cabal-install/Distribution/Client/CmdBench.hs index bb38b91..e7f7394 100644 --- a/cabal/cabal-install/Distribution/Client/CmdBench.hs +++ b/cabal/cabal-install/Distribution/Client/CmdBench.hs @@ -20,7 +20,7 @@ import Distribution.Client.Setup ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup - ( HaddockFlags, TestFlags, fromFlagOrDefault ) + ( HaddockFlags, TestFlags, BenchmarkFlags, fromFlagOrDefault ) import Distribution.Simple.Command ( CommandUI(..), usageAlternatives ) import Distribution.Deprecated.Text @@ -33,7 +33,9 @@ import Distribution.Simple.Utils import Control.Monad (when) -benchCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +benchCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags + ) benchCommand = Client.installCommand { commandName = "v2-bench", commandSynopsis = "Run benchmarks", @@ -73,9 +75,11 @@ benchCommand = Client.installCommand { -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -benchAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +benchAction :: ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags ) -> [String] -> GlobalFlags -> IO () -benchAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) +benchAction ( configFlags, configExFlags, installFlags + , haddockFlags, testFlags, benchmarkFlags ) targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand @@ -119,7 +123,7 @@ benchAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) globalFlags configFlags configExFlags installFlags mempty -- ClientInstallFlags, not needed here - haddockFlags testFlags + haddockFlags testFlags benchmarkFlags -- | This defines what a 'TargetSelector' means for the @bench@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, diff --git a/cabal/cabal-install/Distribution/Client/CmdBuild.hs b/cabal/cabal-install/Distribution/Client/CmdBuild.hs index d4123b4..00b2d8b 100644 --- a/cabal/cabal-install/Distribution/Client/CmdBuild.hs +++ b/cabal/cabal-install/Distribution/Client/CmdBuild.hs @@ -20,7 +20,7 @@ import Distribution.Client.Setup , liftOptions, yesNoOpt ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup - ( HaddockFlags, TestFlags + ( HaddockFlags, TestFlags, BenchmarkFlags , Flag(..), toFlag, fromFlag, fromFlagOrDefault ) import Distribution.Simple.Command ( CommandUI(..), usageAlternatives, option ) @@ -35,7 +35,8 @@ import qualified Data.Map as Map buildCommand :: CommandUI (BuildFlags, ( ConfigFlags, ConfigExFlags - , InstallFlags, HaddockFlags, TestFlags)) + , InstallFlags, HaddockFlags + , TestFlags, BenchmarkFlags )) buildCommand = CommandUI { commandName = "v2-build", commandSynopsis = "Compile targets within the project.", @@ -103,11 +104,13 @@ defaultBuildFlags = BuildFlags -- buildAction :: ( BuildFlags - , (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags)) + , ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags )) -> [String] -> GlobalFlags -> IO () buildAction ( buildFlags - , (configFlags, configExFlags, installFlags, haddockFlags, testFlags)) + , ( configFlags, configExFlags, installFlags + , haddockFlags, testFlags, benchmarkFlags )) targetStrings globalFlags = do -- TODO: This flags defaults business is ugly let onlyConfigure = fromFlag (buildOnlyConfigure defaultBuildFlags @@ -159,7 +162,7 @@ buildAction globalFlags configFlags configExFlags installFlags mempty -- ClientInstallFlags, not needed here - haddockFlags testFlags + haddockFlags testFlags benchmarkFlags -- | This defines what a 'TargetSelector' means for the @bench@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, diff --git a/cabal/cabal-install/Distribution/Client/CmdConfigure.hs b/cabal/cabal-install/Distribution/Client/CmdConfigure.hs index ff76847..5d50a26 100644 --- a/cabal/cabal-install/Distribution/Client/CmdConfigure.hs +++ b/cabal/cabal-install/Distribution/Client/CmdConfigure.hs @@ -16,7 +16,7 @@ import Distribution.Client.ProjectConfig import Distribution.Client.Setup ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) import Distribution.Simple.Setup - ( HaddockFlags, TestFlags, fromFlagOrDefault ) + ( HaddockFlags, TestFlags, BenchmarkFlags, fromFlagOrDefault ) import Distribution.Verbosity ( normal ) @@ -26,8 +26,9 @@ import Distribution.Simple.Utils ( wrapText, notice ) import qualified Distribution.Client.Setup as Client -configureCommand :: CommandUI (ConfigFlags, ConfigExFlags - ,InstallFlags, HaddockFlags, TestFlags) +configureCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags + ) configureCommand = Client.installCommand { commandName = "v2-configure", commandSynopsis = "Add extra project configuration", @@ -78,9 +79,11 @@ configureCommand = Client.installCommand { -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -configureAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +configureAction :: ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags ) -> [String] -> GlobalFlags -> IO () -configureAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) +configureAction ( configFlags, configExFlags, installFlags + , haddockFlags, testFlags, benchmarkFlags ) _extraArgs globalFlags = do --TODO: deal with _extraArgs, since flags with wrong syntax end up there @@ -123,5 +126,5 @@ configureAction (configFlags, configExFlags, installFlags, haddockFlags, testFla globalFlags configFlags configExFlags installFlags mempty -- ClientInstallFlags, not needed here - haddockFlags testFlags + haddockFlags testFlags benchmarkFlags diff --git a/cabal/cabal-install/Distribution/Client/CmdExec.hs b/cabal/cabal-install/Distribution/Client/CmdExec.hs index e576e10..7627d7d 100644 --- a/cabal/cabal-install/Distribution/Client/CmdExec.hs +++ b/cabal/cabal-install/Distribution/Client/CmdExec.hs @@ -76,6 +76,7 @@ import Distribution.Simple.GHC import Distribution.Simple.Setup ( HaddockFlags , TestFlags + , BenchmarkFlags , fromFlagOrDefault ) import Distribution.Simple.Utils @@ -92,11 +93,12 @@ import Distribution.Verbosity import Prelude () import Distribution.Client.Compat.Prelude -import Data.Set (Set) import qualified Data.Set as S import qualified Data.Map as M -execCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +execCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags + ) execCommand = CommandUI { commandName = "v2-exec" , commandSynopsis = "Give a command access to the store." @@ -121,9 +123,11 @@ execCommand = CommandUI , commandDefaultFlags = commandDefaultFlags Client.installCommand } -execAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +execAction :: ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags ) -> [String] -> GlobalFlags -> IO () -execAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) +execAction ( configFlags, configExFlags, installFlags + , haddockFlags, testFlags, benchmarkFlags ) extraArgs globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand @@ -197,7 +201,7 @@ execAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) globalFlags configFlags configExFlags installFlags mempty -- ClientInstallFlags, not needed here - haddockFlags testFlags + haddockFlags testFlags benchmarkFlags withOverrides env args program = program { programOverrideEnv = programOverrideEnv program ++ env , programDefaultArgs = programDefaultArgs program ++ args} diff --git a/cabal/cabal-install/Distribution/Client/CmdFreeze.hs b/cabal/cabal-install/Distribution/Client/CmdFreeze.hs index e4b5e22..fcdd371 100644 --- a/cabal/cabal-install/Distribution/Client/CmdFreeze.hs +++ b/cabal/cabal-install/Distribution/Client/CmdFreeze.hs @@ -33,7 +33,7 @@ import Distribution.PackageDescription import Distribution.Client.Setup ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) import Distribution.Simple.Setup - ( HaddockFlags, TestFlags, fromFlagOrDefault ) + ( HaddockFlags, TestFlags, BenchmarkFlags, fromFlagOrDefault ) import Distribution.Simple.Utils ( die', notice, wrapText ) import Distribution.Verbosity @@ -49,7 +49,9 @@ import Distribution.Simple.Command import qualified Distribution.Client.Setup as Client -freezeCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +freezeCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags + ) freezeCommand = Client.installCommand { commandName = "v2-freeze", commandSynopsis = "Freeze dependencies.", @@ -99,9 +101,11 @@ freezeCommand = Client.installCommand { -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -freezeAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +freezeAction :: ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags ) -> [String] -> GlobalFlags -> IO () -freezeAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) +freezeAction ( configFlags, configExFlags, installFlags + , haddockFlags, testFlags, benchmarkFlags ) extraArgs globalFlags = do unless (null extraArgs) $ @@ -132,7 +136,7 @@ freezeAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) globalFlags configFlags configExFlags installFlags mempty -- ClientInstallFlags, not needed here - haddockFlags testFlags + haddockFlags testFlags benchmarkFlags diff --git a/cabal/cabal-install/Distribution/Client/CmdHaddock.hs b/cabal/cabal-install/Distribution/Client/CmdHaddock.hs index 0ed1aca..d82d70c 100644 --- a/cabal/cabal-install/Distribution/Client/CmdHaddock.hs +++ b/cabal/cabal-install/Distribution/Client/CmdHaddock.hs @@ -20,7 +20,7 @@ import Distribution.Client.Setup ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup - ( HaddockFlags(..), TestFlags, fromFlagOrDefault ) + ( HaddockFlags(..), TestFlags, BenchmarkFlags(..), fromFlagOrDefault ) import Distribution.Simple.Command ( CommandUI(..), usageAlternatives ) import Distribution.Verbosity @@ -31,8 +31,9 @@ import Distribution.Simple.Utils import Control.Monad (when) -haddockCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags - ,HaddockFlags, TestFlags) +haddockCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags + ) haddockCommand = Client.installCommand { commandName = "v2-haddock", commandSynopsis = "Build Haddock documentation", @@ -69,9 +70,11 @@ haddockCommand = Client.installCommand { -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -haddockAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +haddockAction :: ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags ) -> [String] -> GlobalFlags -> IO () -haddockAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) +haddockAction ( configFlags, configExFlags, installFlags + , haddockFlags, testFlags, benchmarkFlags ) targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig HaddockCommand @@ -113,7 +116,7 @@ haddockAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags globalFlags configFlags configExFlags installFlags mempty -- ClientInstallFlags, not needed here - haddockFlags testFlags + haddockFlags testFlags benchmarkFlags -- | This defines what a 'TargetSelector' means for the @haddock@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, diff --git a/cabal/cabal-install/Distribution/Client/CmdInstall.hs b/cabal/cabal-install/Distribution/Client/CmdInstall.hs index fabfdff..ff6e29f 100644 --- a/cabal/cabal-install/Distribution/Client/CmdInstall.hs +++ b/cabal/cabal-install/Distribution/Client/CmdInstall.hs @@ -32,7 +32,7 @@ import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.Setup ( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags(..) , configureExOptions, haddockOptions, installOptions, testOptions - , configureOptions, liftOptions ) + , benchmarkOptions, configureOptions, liftOptions ) import Distribution.Solver.Types.ConstraintSource ( ConstraintSource(..) ) import Distribution.Client.Types @@ -87,7 +87,8 @@ import Distribution.Client.RebuildMonad import Distribution.Client.InstallSymlink ( OverwritePolicy(..), symlinkBinary ) import Distribution.Simple.Setup - ( Flag(..), HaddockFlags, TestFlags, fromFlagOrDefault, flagToMaybe ) + ( Flag(..), HaddockFlags, TestFlags, BenchmarkFlags + , fromFlagOrDefault, flagToMaybe ) import Distribution.Solver.Types.SourcePackage ( SourcePackage(..) ) import Distribution.Simple.Command @@ -107,7 +108,7 @@ import Distribution.System import Distribution.Types.UnitId ( UnitId ) import Distribution.Types.UnqualComponentName - ( UnqualComponentName, unUnqualComponentName, mkUnqualComponentName ) + ( UnqualComponentName, unUnqualComponentName ) import Distribution.Verbosity ( Verbosity, normal, lessVerbose ) import Distribution.Simple.Utils @@ -115,7 +116,7 @@ import Distribution.Simple.Utils , withTempDirectory, createDirectoryIfMissingVerbose , ordNub ) import Distribution.Utils.Generic - ( writeFileAtomic ) + ( safeHead, writeFileAtomic ) import Distribution.Deprecated.Text ( simpleParse ) import Distribution.Pretty @@ -142,7 +143,8 @@ import System.FilePath installCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags - , HaddockFlags, TestFlags, ClientInstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags + , ClientInstallFlags ) installCommand = CommandUI { commandName = "v2-install" @@ -194,17 +196,19 @@ installCommand = CommandUI . optionName) $ haddockOptions showOrParseArgs) ++ liftOptions get5 set5 (testOptions showOrParseArgs) - ++ liftOptions get6 set6 (clientInstallOptions showOrParseArgs) - , commandDefaultFlags = ( mempty, mempty, mempty, mempty, mempty + ++ liftOptions get6 set6 (benchmarkOptions showOrParseArgs) + ++ liftOptions get7 set7 (clientInstallOptions showOrParseArgs) + , commandDefaultFlags = ( mempty, mempty, mempty, mempty, mempty, mempty , defaultClientInstallFlags ) } where - get1 (a,_,_,_,_,_) = a; set1 a (_,b,c,d,e,f) = (a,b,c,d,e,f) - get2 (_,b,_,_,_,_) = b; set2 b (a,_,c,d,e,f) = (a,b,c,d,e,f) - get3 (_,_,c,_,_,_) = c; set3 c (a,b,_,d,e,f) = (a,b,c,d,e,f) - get4 (_,_,_,d,_,_) = d; set4 d (a,b,c,_,e,f) = (a,b,c,d,e,f) - get5 (_,_,_,_,e,_) = e; set5 e (a,b,c,d,_,f) = (a,b,c,d,e,f) - get6 (_,_,_,_,_,f) = f; set6 f (a,b,c,d,e,_) = (a,b,c,d,e,f) + get1 (a,_,_,_,_,_,_) = a; set1 a (_,b,c,d,e,f,g) = (a,b,c,d,e,f,g) + get2 (_,b,_,_,_,_,_) = b; set2 b (a,_,c,d,e,f,g) = (a,b,c,d,e,f,g) + get3 (_,_,c,_,_,_,_) = c; set3 c (a,b,_,d,e,f,g) = (a,b,c,d,e,f,g) + get4 (_,_,_,d,_,_,_) = d; set4 d (a,b,c,_,e,f,g) = (a,b,c,d,e,f,g) + get5 (_,_,_,_,e,_,_) = e; set5 e (a,b,c,d,_,f,g) = (a,b,c,d,e,f,g) + get6 (_,_,_,_,_,f,_) = f; set6 f (a,b,c,d,e,_,g) = (a,b,c,d,e,f,g) + get7 (_,_,_,_,_,_,g) = g; set7 g (a,b,c,d,e,f,_) = (a,b,c,d,e,f,g) -- | The @install@ command actually serves four different needs. It installs: @@ -225,11 +229,13 @@ installCommand = CommandUI -- "Distribution.Client.ProjectOrchestration" -- installAction - :: ( ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags + :: ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags , ClientInstallFlags) -> [String] -> GlobalFlags -> IO () -installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags +installAction ( configFlags, configExFlags, installFlags + , haddockFlags, testFlags, benchmarkFlags , clientInstallFlags' ) targetStrings globalFlags = do -- We never try to build tests/benchmarks for remote packages. @@ -452,10 +458,14 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags home <- getHomeDirectory let ProjectConfig { + projectConfigBuildOnly = ProjectConfigBuildOnly { + projectConfigLogsDir + }, projectConfigShared = ProjectConfigShared { projectConfigHcFlavor, projectConfigHcPath, - projectConfigHcPkg + projectConfigHcPkg, + projectConfigStoreDir }, projectConfigLocalPackages = PackageConfig { packageConfigProgramPaths, @@ -468,7 +478,8 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags hcPath = flagToMaybe projectConfigHcPath hcPkg = flagToMaybe projectConfigHcPkg - progDb = + -- ProgramDb with directly user specified paths + preProgDb = userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) . userSpecifyArgss (Map.toList (getMapMappend packageConfigProgramArgs)) . modifyProgramSearchPath @@ -476,9 +487,10 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags | dir <- fromNubList packageConfigProgramPathExtra ]) $ defaultProgramDb + -- progDb is a program database with compiler tools configured properly (compiler@Compiler { compilerId = - compilerId@(CompilerId compilerFlavor compilerVersion) }, platform, progDb') <- - configCompilerEx hcFlavor hcPath hcPkg progDb verbosity + compilerId@(CompilerId compilerFlavor compilerVersion) }, platform, progDb) <- + configCompilerEx hcFlavor hcPath hcPkg preProgDb verbosity let globalEnv name = @@ -521,13 +533,13 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags cabalDir <- getCabalDir mstoreDir <- - sequenceA $ makeAbsolute <$> flagToMaybe (globalStoreDir globalFlags) + sequenceA $ makeAbsolute <$> flagToMaybe projectConfigStoreDir let - mlogsDir = flagToMaybe (globalLogsDir globalFlags) + mlogsDir = flagToMaybe projectConfigLogsDir cabalLayout = mkCabalDirLayout cabalDir mstoreDir mlogsDir packageDbs = storePackageDBStack (cabalStoreDirLayout cabalLayout) compilerId - installedIndex <- getInstalledPackages verbosity compiler packageDbs progDb' + installedIndex <- getInstalledPackages verbosity compiler packageDbs progDb let (envSpecs, envEntries') = environmentFileToSpecifiers installedIndex envEntries @@ -590,14 +602,14 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags then installLibraries verbosity buildCtx compiler packageDbs progDb envFile envEntries' else installExes verbosity - baseCtx buildCtx platform compiler clientInstallFlags + baseCtx buildCtx platform compiler configFlags clientInstallFlags where configFlags' = disableTestsBenchsByDefault configFlags verbosity = fromFlagOrDefault normal (configVerbosity configFlags') cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags' configExFlags installFlags clientInstallFlags' - haddockFlags testFlags + haddockFlags testFlags benchmarkFlags globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) -- | Install any built exe by symlinking/copying it @@ -608,12 +620,16 @@ installExes -> ProjectBuildContext -> Platform -> Compiler + -> ConfigFlags -> ClientInstallFlags -> IO () installExes verbosity baseCtx buildCtx platform compiler - clientInstallFlags = do + configFlags clientInstallFlags = do let storeDirLayout = cabalStoreDirLayout $ cabalDirLayout baseCtx + prefix = fromFlagOrDefault "" (fmap InstallDirs.fromPathTemplate (configProgPrefix configFlags)) + suffix = fromFlagOrDefault "" (fmap InstallDirs.fromPathTemplate (configProgSuffix configFlags)) + mkUnitBinDir :: UnitId -> FilePath mkUnitBinDir = InstallDirs.bindir . @@ -621,6 +637,9 @@ installExes verbosity baseCtx buildCtx platform compiler mkExeName :: UnqualComponentName -> FilePath mkExeName exe = unUnqualComponentName exe <.> exeExtension platform + + mkFinalExeName :: UnqualComponentName -> FilePath + mkFinalExeName exe = prefix <> unUnqualComponentName exe <> suffix <.> exeExtension platform installdirUnknown = "installdir is not defined. Set it in your cabal config file " ++ "or use --installdir=<path>" @@ -633,7 +652,7 @@ installExes verbosity baseCtx buildCtx platform compiler doInstall = installUnitExes verbosity overwritePolicy - mkUnitBinDir mkExeName + mkUnitBinDir mkExeName mkFinalExeName installdir installMethod in traverse_ doInstall $ Map.toList $ targetsMap buildCtx where @@ -660,7 +679,8 @@ installLibraries verbosity buildCtx compiler if supportsPkgEnvFiles $ getImplInfo compiler then do let - getLatest = fmap (head . snd) . take 1 . sortBy (comparing (Down . fst)) + getLatest :: PackageName -> [InstalledPackageInfo] + getLatest = (=<<) (maybeToList . safeHead . snd) . take 1 . sortBy (comparing (Down . fst)) . PI.lookupPackageName installedIndex globalLatest = concat (getLatest <$> globalPackages) @@ -736,13 +756,16 @@ installUnitExes -- ^ store directory -> (UnqualComponentName -> FilePath) -- ^ A function to get an -- ^ exe's filename + -> (UnqualComponentName -> FilePath) -- ^ A function to get an + -- ^ exe's final possibly + -- ^ different to the name in the store. -> FilePath -> InstallMethod -> ( UnitId , [(ComponentTarget, [TargetSelector])] ) -> IO () installUnitExes verbosity overwritePolicy - mkSourceBinDir mkExeName + mkSourceBinDir mkExeName mkFinalExeName installdir installMethod (unit, components) = traverse_ installAndWarn exes @@ -754,6 +777,7 @@ installUnitExes verbosity overwritePolicy success <- installBuiltExe verbosity overwritePolicy (mkSourceBinDir unit) (mkExeName exe) + (mkFinalExeName exe) installdir installMethod let errorMessage = case overwritePolicy of NeverOverwrite -> @@ -773,21 +797,22 @@ installBuiltExe :: Verbosity -> OverwritePolicy -> FilePath -- ^ The directory where the built exe is located -> FilePath -- ^ The exe's filename + -> FilePath -- ^ The exe's filename in the public install directory -> FilePath -- ^ the directory where it should be installed -> InstallMethod -> IO Bool -- ^ Whether the installation was successful installBuiltExe verbosity overwritePolicy - sourceDir exeName + sourceDir exeName finalExeName installdir InstallMethodSymlink = do notice verbosity $ "Symlinking '" <> exeName <> "'" symlinkBinary overwritePolicy installdir sourceDir - (mkUnqualComponentName exeName) + finalExeName exeName installBuiltExe verbosity overwritePolicy - sourceDir exeName + sourceDir exeName finalExeName installdir InstallMethodCopy = do notice verbosity $ "Copying '" <> exeName <> "'" exists <- doesPathExist destination @@ -797,7 +822,7 @@ installBuiltExe verbosity overwritePolicy (False, _ ) -> copy where source = sourceDir </> exeName - destination = installdir </> exeName + destination = installdir </> finalExeName remove = do isDir <- doesDirectoryExist destination if isDir diff --git a/cabal/cabal-install/Distribution/Client/CmdLegacy.hs b/cabal/cabal-install/Distribution/Client/CmdLegacy.hs index c4b48c8..e1efe27 100644 --- a/cabal/cabal-install/Distribution/Client/CmdLegacy.hs +++ b/cabal/cabal-install/Distribution/Client/CmdLegacy.hs @@ -68,6 +68,9 @@ instance (HasVerbosity a) => HasVerbosity (a, b, c, d) where instance (HasVerbosity a) => HasVerbosity (a, b, c, d, e) where verbosity (a, _, _, _, _) = verbosity a +instance (HasVerbosity a) => HasVerbosity (a, b, c, d, e, f) where + verbosity (a, _, _, _, _, _) = verbosity a + instance HasVerbosity Setup.BuildFlags where verbosity = verbosity . Setup.buildVerbosity @@ -108,22 +111,22 @@ legacyNote cmd = wrapText $ "The v1-" ++ cmd ++ " command is a part of the legacy v1 style of cabal usage.\n\n" ++ "It is a legacy feature and will be removed in a future release of cabal-install." ++ - " Please file a bug if you cannot replicate a working v1- use case with the new-style" ++ + " Please file a bug if you cannot replicate a working v1- use case with the nix-style" ++ " commands.\n\n" ++ - "For more information, see: https://wiki.haskell.org/Cabal/NewBuild\n" + "For more information, see: https://cabal.readthedocs.io/en/latest/nix-local-build-overview.html" toLegacyCmd :: CommandSpec (globals -> IO action) -> [CommandSpec (globals -> IO action)] toLegacyCmd mkSpec = [toLegacy mkSpec] - where - toLegacy (CommandSpec origUi@CommandUI{..} action type') = CommandSpec legUi action type' - where - legUi = origUi - { commandName = "v1-" ++ commandName - , commandNotes = Just $ \pname -> case commandNotes of - Just notes -> notes pname ++ "\n" ++ legacyNote commandName - Nothing -> legacyNote commandName - } + where + toLegacy (CommandSpec origUi@CommandUI{..} action type') = CommandSpec legUi action type' + where + legUi = origUi + { commandName = "v1-" ++ commandName + , commandNotes = Just $ \pname -> case commandNotes of + Just notes -> notes pname ++ "\n" ++ legacyNote commandName + Nothing -> legacyNote commandName + } legacyCmd :: (HasVerbosity flags) => CommandUI flags -> (flags -> [String] -> globals -> IO action) -> [CommandSpec (globals -> IO action)] legacyCmd ui action = toLegacyCmd (regularCmd ui action) diff --git a/cabal/cabal-install/Distribution/Client/CmdRepl.hs b/cabal/cabal-install/Distribution/Client/CmdRepl.hs index 3eaaab2..a3586aa 100644 --- a/cabal/cabal-install/Distribution/Client/CmdRepl.hs +++ b/cabal/cabal-install/Distribution/Client/CmdRepl.hs @@ -45,7 +45,8 @@ import qualified Distribution.Client.Setup as Client import Distribution.Client.Types ( PackageLocation(..), PackageSpecifier(..), UnresolvedSourcePackage ) import Distribution.Simple.Setup - ( HaddockFlags, TestFlags, fromFlagOrDefault, replOptions + ( HaddockFlags, TestFlags, BenchmarkFlags + , fromFlagOrDefault, replOptions , Flag(..), toFlag, trueArg, falseArg ) import Distribution.Simple.Command ( CommandUI(..), liftOption, usageAlternatives, option @@ -90,6 +91,8 @@ import Distribution.Types.VersionRange ( anyVersion ) import Distribution.Deprecated.Text ( display ) +import Distribution.Utils.Generic + ( safeHead ) import Distribution.Verbosity ( Verbosity, normal, lessVerbose ) import Distribution.Simple.Utils @@ -143,7 +146,10 @@ envOptions _ = ("couldn't parse dependency: " ++) (parsecCommaList parsec) -replCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags, ReplFlags, EnvFlags) +replCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags + , ReplFlags, EnvFlags + ) replCommand = Client.installCommand { commandName = "v2-repl", commandSynopsis = "Open an interactive session for the given component.", @@ -181,27 +187,31 @@ replCommand = Client.installCommand { ++ "to the default component (or no component if there is no project present)\n" ++ cmdCommonHelpTextNewBuildBeta, - commandDefaultFlags = (configFlags,configExFlags,installFlags,haddockFlags,testFlags,[],defaultEnvFlags), + commandDefaultFlags = ( configFlags, configExFlags, installFlags + , haddockFlags, testFlags, benchmarkFlags + , [], defaultEnvFlags + ), commandOptions = \showOrParseArgs -> map liftOriginal (commandOptions Client.installCommand showOrParseArgs) ++ map liftReplOpts (replOptions showOrParseArgs) ++ map liftEnvOpts (envOptions showOrParseArgs) } where - (configFlags,configExFlags,installFlags,haddockFlags,testFlags) = commandDefaultFlags Client.installCommand + (configFlags,configExFlags,installFlags,haddockFlags,testFlags,benchmarkFlags) + = commandDefaultFlags Client.installCommand liftOriginal = liftOption projectOriginal updateOriginal liftReplOpts = liftOption projectReplOpts updateReplOpts liftEnvOpts = liftOption projectEnvOpts updateEnvOpts - projectOriginal (a,b,c,d,e,_,_) = (a,b,c,d,e) - updateOriginal (a,b,c,d,e) (_,_,_,_,_,f,g) = (a,b,c,d,e,f,g) + projectOriginal (a,b,c,d,e,f,_,_) = (a,b,c,d,e,f) + updateOriginal (a,b,c,d,e,f) (_,_,_,_,_,_,g,h) = (a,b,c,d,e,f,g,h) - projectReplOpts (_,_,_,_,_,f,_) = f - updateReplOpts f (a,b,c,d,e,_,g) = (a,b,c,d,e,f,g) + projectReplOpts (_,_,_,_,_,_,g,_) = g + updateReplOpts g (a,b,c,d,e,f,_,h) = (a,b,c,d,e,f,g,h) - projectEnvOpts (_,_,_,_,_,_,g) = g - updateEnvOpts g (a,b,c,d,e,f,_) = (a,b,c,d,e,f,g) + projectEnvOpts (_,_,_,_,_,_,_,h) = h + updateEnvOpts h (a,b,c,d,e,f,g,_) = (a,b,c,d,e,f,g,h) -- | The @repl@ command is very much like @build@. It brings the install plan -- up to date, selects that part of the plan needed by the given or implicit @@ -214,9 +224,13 @@ replCommand = Client.installCommand { -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -replAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags, ReplFlags, EnvFlags) +replAction :: ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags + , ReplFlags, EnvFlags ) -> [String] -> GlobalFlags -> IO () -replAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags, replFlags, envFlags) +replAction ( configFlags, configExFlags, installFlags + , haddockFlags, testFlags, benchmarkFlags + , replFlags, envFlags ) targetStrings globalFlags = do let ignoreProject = fromFlagOrDefault False (envIgnoreProject envFlags) @@ -244,7 +258,7 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags, r targets <- validatedTargets elaboratedPlan targetSelectors let - (unitId, _) = head $ Map.toList targets + Just (unitId, _) = safeHead $ Map.toList targets originalDeps = installedUnitId <$> InstallPlan.directDeps elaboratedPlan unitId oci = OriginalComponentInfo unitId originalDeps Just pkgId = packageId <$> InstallPlan.lookup elaboratedPlan unitId @@ -322,7 +336,7 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags, r globalFlags configFlags configExFlags installFlags mempty -- ClientInstallFlags, not needed here - haddockFlags testFlags + haddockFlags testFlags benchmarkFlags globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) validatedTargets elaboratedPlan targetSelectors = do diff --git a/cabal/cabal-install/Distribution/Client/CmdRun.hs b/cabal/cabal-install/Distribution/Client/CmdRun.hs index f02fbbf..8a2ca97 100644 --- a/cabal/cabal-install/Distribution/Client/CmdRun.hs +++ b/cabal/cabal-install/Distribution/Client/CmdRun.hs @@ -18,7 +18,7 @@ module Distribution.Client.CmdRun ( ) where import Prelude () -import Distribution.Client.Compat.Prelude +import Distribution.Client.Compat.Prelude hiding (toList) import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages @@ -29,7 +29,7 @@ import Distribution.Client.GlobalFlags ( defaultGlobalFlags ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup - ( HaddockFlags, TestFlags, fromFlagOrDefault ) + ( HaddockFlags, TestFlags, BenchmarkFlags, fromFlagOrDefault ) import Distribution.Simple.Command ( CommandUI(..), usageAlternatives ) import Distribution.Types.ComponentName @@ -107,7 +107,9 @@ import System.FilePath ( (</>), isValid, isPathSeparator, takeExtension ) -runCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +runCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags + ) runCommand = Client.installCommand { commandName = "v2-run", commandSynopsis = "Run an executable.", @@ -153,9 +155,11 @@ runCommand = Client.installCommand { -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -runAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +runAction :: ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags ) -> [String] -> GlobalFlags -> IO () -runAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) +runAction ( configFlags, configExFlags, installFlags + , haddockFlags, testFlags, benchmarkFlags ) targetStrings globalFlags = do globalTmp <- getTemporaryDirectory tempDir <- createTempDirectory globalTmp "cabal-repl." @@ -299,7 +303,7 @@ runAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) globalFlags configFlags configExFlags installFlags mempty -- ClientInstallFlags, not needed here - haddockFlags testFlags + haddockFlags testFlags benchmarkFlags globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) -- | Used by the main CLI parser as heuristic to decide whether @cabal@ was diff --git a/cabal/cabal-install/Distribution/Client/CmdTest.hs b/cabal/cabal-install/Distribution/Client/CmdTest.hs index 490b6e2..254aace 100644 --- a/cabal/cabal-install/Distribution/Client/CmdTest.hs +++ b/cabal/cabal-install/Distribution/Client/CmdTest.hs @@ -20,7 +20,7 @@ import Distribution.Client.Setup ( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup - ( HaddockFlags, TestFlags(..), fromFlagOrDefault ) + ( HaddockFlags, TestFlags(..), BenchmarkFlags(..), fromFlagOrDefault ) import Distribution.Simple.Command ( CommandUI(..), usageAlternatives ) import Distribution.Simple.Flag @@ -36,7 +36,9 @@ import Control.Monad (when) import qualified System.Exit (exitSuccess) -testCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +testCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags + ) testCommand = Client.installCommand { commandName = "v2-test" , commandSynopsis = "Run test-suites" @@ -84,9 +86,11 @@ testCommand = Client.installCommand -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -testAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +testAction :: ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags ) -> [String] -> GlobalFlags -> IO () -testAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) +testAction ( configFlags, configExFlags, installFlags + , haddockFlags, testFlags, benchmarkFlags ) targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand @@ -131,7 +135,7 @@ testAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) globalFlags configFlags configExFlags installFlags mempty -- ClientInstallFlags, not needed here - haddockFlags testFlags + haddockFlags testFlags benchmarkFlags -- | This defines what a 'TargetSelector' means for the @test@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, diff --git a/cabal/cabal-install/Distribution/Client/CmdUpdate.hs b/cabal/cabal-install/Distribution/Client/CmdUpdate.hs index ffe49ac..296bcad 100644 --- a/cabal/cabal-install/Distribution/Client/CmdUpdate.hs +++ b/cabal/cabal-install/Distribution/Client/CmdUpdate.hs @@ -36,7 +36,7 @@ import Distribution.Client.Setup , UpdateFlags, defaultUpdateFlags , RepoContext(..) ) import Distribution.Simple.Setup - ( HaddockFlags, TestFlags, fromFlagOrDefault ) + ( HaddockFlags, TestFlags, BenchmarkFlags, fromFlagOrDefault ) import Distribution.Simple.Utils ( die', notice, wrapText, writeFileAtomic, noticeNoWrap ) import Distribution.Verbosity @@ -64,7 +64,9 @@ import qualified Distribution.Client.Setup as Client import qualified Hackage.Security.Client as Sec updateCommand :: CommandUI ( ConfigFlags, ConfigExFlags - , InstallFlags, HaddockFlags, TestFlags ) + , InstallFlags, HaddockFlags + , TestFlags, BenchmarkFlags + ) updateCommand = Client.installCommand { commandName = "v2-update", commandSynopsis = "Updates list of known packages.", @@ -114,9 +116,11 @@ instance Text UpdateRequest where name <- ReadP.manyTill (ReadP.satisfy (\c -> c /= ',')) ReadP.eof return (UpdateRequest name IndexStateHead) -updateAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +updateAction :: ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags ) -> [String] -> GlobalFlags -> IO () -updateAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) +updateAction ( configFlags, configExFlags, installFlags + , haddockFlags, testFlags, benchmarkFlags ) extraArgs globalFlags = do projectConfig <- withProjectOrGlobalConfig verbosity globalConfigFlag (projectConfig <$> establishProjectBaseContext verbosity cliConfig OtherCommand) @@ -174,7 +178,7 @@ updateAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) globalFlags configFlags configExFlags installFlags mempty -- ClientInstallFlags, not needed here - haddockFlags testFlags + haddockFlags testFlags benchmarkFlags globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) updateRepo :: Verbosity -> UpdateFlags -> RepoContext -> (Repo, IndexState) diff --git a/cabal/cabal-install/Distribution/Client/Compat/FileLock.hsc b/cabal/cabal-install/Distribution/Client/Compat/FileLock.hsc deleted file mode 100644 index eafaee8..0000000 --- a/cabal/cabal-install/Distribution/Client/Compat/FileLock.hsc +++ /dev/null @@ -1,201 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE InterruptibleFFI #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE DeriveDataTypeable #-} - --- | This compat module can be removed once base-4.10 (ghc-8.2) is the minimum --- required version. Though note that the locking functionality is not in --- public modules in base-4.10, just in the "GHC.IO.Handle.Lock" module. -module Distribution.Client.Compat.FileLock ( - FileLockingNotSupported(..) - , LockMode(..) - , hLock - , hTryLock - ) where - -#if MIN_VERSION_base(4,10,0) - -import GHC.IO.Handle.Lock - -#else - --- The remainder of this file is a modified copy --- of GHC.IO.Handle.Lock from ghc-8.2.x --- --- The modifications were just to the imports and the CPP, since we do not have --- access to the HAVE_FLOCK from the ./configure script. We approximate the --- lack of HAVE_FLOCK with defined(solaris2_HOST_OS) instead since that is the --- only known major Unix platform lacking flock(). - -import Control.Exception (Exception) -import Data.Typeable - -#if defined(solaris2_HOST_OS) - -import Control.Exception (throwIO) -import System.IO (Handle) - -#else - -import Data.Bits -import Data.Function -import Control.Concurrent.MVar - -import Foreign.C.Error -import Foreign.C.Types - -import GHC.IO.Handle.Types -import GHC.IO.FD -import GHC.IO.Exception - -#if defined(mingw32_HOST_OS) - -#if defined(i386_HOST_ARCH) -## define WINDOWS_CCONV stdcall -#elif defined(x86_64_HOST_ARCH) -## define WINDOWS_CCONV ccall -#else -# error Unknown mingw32 arch -#endif - -#include <windows.h> - -import Foreign.Marshal.Alloc -import Foreign.Marshal.Utils -import Foreign.Ptr -import GHC.Windows - -#else /* !defined(mingw32_HOST_OS), so assume unix with flock() */ - -#include <sys/file.h> - -#endif /* !defined(mingw32_HOST_OS) */ - -#endif /* !defined(solaris2_HOST_OS) */ - - --- | Exception thrown by 'hLock' on non-Windows platforms that don't support --- 'flock'. -data FileLockingNotSupported = FileLockingNotSupported - deriving (Typeable, Show) - -instance Exception FileLockingNotSupported - - --- | Indicates a mode in which a file should be locked. -data LockMode = SharedLock | ExclusiveLock - --- | If a 'Handle' references a file descriptor, attempt to lock contents of the --- underlying file in appropriate mode. If the file is already locked in --- incompatible mode, this function blocks until the lock is established. The --- lock is automatically released upon closing a 'Handle'. --- --- Things to be aware of: --- --- 1) This function may block inside a C call. If it does, in order to be able --- to interrupt it with asynchronous exceptions and/or for other threads to --- continue working, you MUST use threaded version of the runtime system. --- --- 2) The implementation uses 'LockFileEx' on Windows and 'flock' otherwise, --- hence all of their caveats also apply here. --- --- 3) On non-Windows plaftorms that don't support 'flock' (e.g. Solaris) this --- function throws 'FileLockingNotImplemented'. We deliberately choose to not --- provide fcntl based locking instead because of its broken semantics. --- --- @since 4.10.0.0 -hLock :: Handle -> LockMode -> IO () -hLock h mode = lockImpl h "hLock" mode True >> return () - --- | Non-blocking version of 'hLock'. --- --- @since 4.10.0.0 -hTryLock :: Handle -> LockMode -> IO Bool -hTryLock h mode = lockImpl h "hTryLock" mode False - ----------------------------------------- - -#if defined(solaris2_HOST_OS) - --- | No-op implementation. -lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool -lockImpl _ _ _ _ = throwIO FileLockingNotSupported - -#else /* !defined(solaris2_HOST_OS) */ - -#if defined(mingw32_HOST_OS) - -lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool -lockImpl h ctx mode block = do - FD{fdFD = fd} <- handleToFd h - wh <- throwErrnoIf (== iNVALID_HANDLE_VALUE) ctx $ c_get_osfhandle fd - allocaBytes sizeof_OVERLAPPED $ \ovrlpd -> do - fillBytes ovrlpd (fromIntegral sizeof_OVERLAPPED) 0 - let flags = cmode .|. (if block then 0 else #{const LOCKFILE_FAIL_IMMEDIATELY}) - -- We want to lock the whole file without looking up its size to be - -- consistent with what flock does. According to documentation of LockFileEx - -- "locking a region that goes beyond the current end-of-file position is - -- not an error", however e.g. Windows 10 doesn't accept maximum possible - -- value (a pair of MAXDWORDs) for mysterious reasons. Work around that by - -- trying 2^32-1. - fix $ \retry -> c_LockFileEx wh flags 0 0xffffffff 0x0 ovrlpd >>= \case - True -> return True - False -> getLastError >>= \err -> if - | not block && err == #{const ERROR_LOCK_VIOLATION} -> return False - | err == #{const ERROR_OPERATION_ABORTED} -> retry - | otherwise -> failWith ctx err - where - sizeof_OVERLAPPED = #{size OVERLAPPED} - - cmode = case mode of - SharedLock -> 0 - ExclusiveLock -> #{const LOCKFILE_EXCLUSIVE_LOCK} - --- https://msdn.microsoft.com/en-us/library/aa297958.aspx -foreign import ccall unsafe "_get_osfhandle" - c_get_osfhandle :: CInt -> IO HANDLE - --- https://msdn.microsoft.com/en-us/library/windows/desktop/aa365203.aspx -foreign import WINDOWS_CCONV interruptible "LockFileEx" - c_LockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> DWORD -> Ptr () -> IO BOOL - -#else /* !defined(mingw32_HOST_OS), so assume unix with flock() */ - -lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool -lockImpl h ctx mode block = do - FD{fdFD = fd} <- handleToFd h - let flags = cmode .|. (if block then 0 else #{const LOCK_NB}) - fix $ \retry -> c_flock fd flags >>= \case - 0 -> return True - _ -> getErrno >>= \errno -> if - | not block && errno == eWOULDBLOCK -> return False - | errno == eINTR -> retry - | otherwise -> ioException $ errnoToIOError ctx errno (Just h) Nothing - where - cmode = case mode of - SharedLock -> #{const LOCK_SH} - ExclusiveLock -> #{const LOCK_EX} - -foreign import ccall interruptible "flock" - c_flock :: CInt -> CInt -> IO CInt - -#endif /* !defined(mingw32_HOST_OS) */ - --- | Turn an existing Handle into a file descriptor. This function throws an --- IOError if the Handle does not reference a file descriptor. -handleToFd :: Handle -> IO FD -handleToFd h = case h of - FileHandle _ mv -> do - Handle__{haDevice = dev} <- readMVar mv - case cast dev of - Just fd -> return fd - Nothing -> throwErr "not a file descriptor" - DuplexHandle{} -> throwErr "not a file handle" - where - throwErr msg = ioException $ IOError (Just h) - InappropriateType "handleToFd" msg Nothing Nothing - -#endif /* defined(solaris2_HOST_OS) */ - -#endif /* MIN_VERSION_base */ diff --git a/cabal/cabal-install/Distribution/Client/Config.hs b/cabal/cabal-install/Distribution/Client/Config.hs index 02940f2..a43ccd6 100644 --- a/cabal/cabal-install/Distribution/Client/Config.hs +++ b/cabal/cabal-install/Distribution/Client/Config.hs @@ -81,6 +81,7 @@ import Distribution.Simple.Setup ( ConfigFlags(..), configureOptions, defaultConfigFlags , HaddockFlags(..), haddockOptions, defaultHaddockFlags , TestFlags(..), defaultTestFlags + , BenchmarkFlags(..), defaultBenchmarkFlags , installDirsOptions, optionDistPref , programDbPaths', programDbOptions , Flag(..), toFlag, flagToMaybe, fromFlagOrDefault ) @@ -171,7 +172,8 @@ data SavedConfig = SavedConfig { savedUploadFlags :: UploadFlags, savedReportFlags :: ReportFlags, savedHaddockFlags :: HaddockFlags, - savedTestFlags :: TestFlags + savedTestFlags :: TestFlags, + savedBenchmarkFlags :: BenchmarkFlags } deriving Generic instance Monoid SavedConfig where @@ -191,7 +193,8 @@ instance Semigroup SavedConfig where savedUploadFlags = combinedSavedUploadFlags, savedReportFlags = combinedSavedReportFlags, savedHaddockFlags = combinedSavedHaddockFlags, - savedTestFlags = combinedSavedTestFlags + savedTestFlags = combinedSavedTestFlags, + savedBenchmarkFlags = combinedSavedBenchmarkFlags } where -- This is ugly, but necessary. If we're mappending two config files, we @@ -227,7 +230,8 @@ instance Semigroup SavedConfig where in case b' of [] -> a' _ -> b' - lastNonMempty' :: (Eq a, Monoid a) => (SavedConfig -> flags) -> (flags -> a) -> a + lastNonMempty' + :: (Eq a, Monoid a) => (SavedConfig -> flags) -> (flags -> a) -> a lastNonMempty' field subfield = let a' = subfield . field $ a b' = subfield . field $ b @@ -416,7 +420,8 @@ instance Semigroup SavedConfig where configFlagError = combine configFlagError, configRelocatable = combine configRelocatable, configUseResponseFiles = combine configUseResponseFiles, - configAllowDependingOnPrivateLibs = combine configAllowDependingOnPrivateLibs + configAllowDependingOnPrivateLibs = + combine configAllowDependingOnPrivateLibs } where combine = combine' savedConfigureFlags @@ -431,8 +436,10 @@ instance Semigroup SavedConfig where -- TODO: NubListify configPreferences = lastNonEmpty configPreferences, configSolver = combine configSolver, - configAllowNewer = combineMonoid savedConfigureExFlags configAllowNewer, - configAllowOlder = combineMonoid savedConfigureExFlags configAllowOlder, + configAllowNewer = + combineMonoid savedConfigureExFlags configAllowNewer, + configAllowOlder = + combineMonoid savedConfigureExFlags configAllowOlder, configWriteGhcEnvironmentFilesPolicy = combine configWriteGhcEnvironmentFilesPolicy } @@ -511,6 +518,15 @@ instance Semigroup SavedConfig where combine = combine' savedTestFlags lastNonEmpty = lastNonEmpty' savedTestFlags + combinedSavedBenchmarkFlags = BenchmarkFlags { + benchmarkDistPref = combine benchmarkDistPref, + benchmarkVerbosity = combine benchmarkVerbosity, + benchmarkOptions = lastNonEmpty benchmarkOptions + } + where + combine = combine' savedBenchmarkFlags + lastNonEmpty = lastNonEmpty' savedBenchmarkFlags + -- -- * Default config @@ -726,7 +742,8 @@ loadRawConfig verbosity configFileFlag = do minp <- readConfigFile mempty configFile case minp of Nothing -> do - notice verbosity $ "Config file path source is " ++ sourceMsg source ++ "." + notice verbosity $ + "Config file path source is " ++ sourceMsg source ++ "." notice verbosity $ "Config file " ++ configFile ++ " not found." createDefaultConfigFile verbosity [] configFile Just (ParseOk ws conf) -> do @@ -766,7 +783,8 @@ getConfigFilePathAndSource configFileFlag = getSource ((source,action): xs) = action >>= maybe (getSource xs) (return . (,) source) -readConfigFile :: SavedConfig -> FilePath -> IO (Maybe (ParseResult SavedConfig)) +readConfigFile + :: SavedConfig -> FilePath -> IO (Maybe (ParseResult SavedConfig)) readConfigFile initial file = handleNotExists $ fmap (Just . parseConfig (ConstraintSourceMainConfig file) initial) (readFile file) @@ -790,7 +808,8 @@ writeConfigFile :: FilePath -> SavedConfig -> SavedConfig -> IO () writeConfigFile file comments vals = do let tmpFile = file <.> "tmp" createDirectoryIfMissing True (takeDirectory file) - writeFile tmpFile $ explanation ++ showConfigWithComments comments vals ++ "\n" + writeFile tmpFile $ + explanation ++ showConfigWithComments comments vals ++ "\n" renameFile tmpFile file where explanation = unlines @@ -824,7 +843,7 @@ commentSavedConfig = do globalRemoteRepos = toNubList [defaultRemoteRepo] }, savedInitFlags = mempty { - IT.interactive = toFlag True, + IT.interactive = toFlag False, IT.cabalVersion = toFlag (mkVersion [1,10]), IT.language = toFlag Haskell2010, IT.license = toFlag BSD3, @@ -845,7 +864,8 @@ commentSavedConfig = do savedUploadFlags = commandDefaultFlags uploadCommand, savedReportFlags = commandDefaultFlags reportCommand, savedHaddockFlags = defaultHaddockFlags, - savedTestFlags = defaultTestFlags + savedTestFlags = defaultTestFlags, + savedBenchmarkFlags = defaultBenchmarkFlags } conf1 <- extendToEffectiveConfig conf0 let globalFlagsConf1 = savedGlobalFlags conf1 @@ -903,7 +923,8 @@ configFieldDescriptions src = | str == "1" -> ParseOk [] (Flag NormalOptimisation) | str == "2" -> ParseOk [] (Flag MaximumOptimisation) | lstr == "false" -> ParseOk [caseWarning] (Flag NoOptimisation) - | lstr == "true" -> ParseOk [caseWarning] (Flag NormalOptimisation) + | lstr == "true" -> ParseOk [caseWarning] + (Flag NormalOptimisation) | otherwise -> ParseFailed (NoParse name line) where lstr = lowercase str @@ -939,16 +960,20 @@ configFieldDescriptions src = ++ toSavedConfig liftConfigExFlag (configureExOptions ParseArgs src) [] - [let pkgs = (Just . AllowOlder . RelaxDepsSome) `fmap` parseOptCommaList Text.parse - parseAllowOlder = ((Just . AllowOlder . toRelaxDeps) `fmap` Text.parse) Parse.<++ pkgs in - simpleField "allow-older" - (showRelaxDeps . fmap unAllowOlder) parseAllowOlder - configAllowOlder (\v flags -> flags { configAllowOlder = v }) - ,let pkgs = (Just . AllowNewer . RelaxDepsSome) `fmap` parseOptCommaList Text.parse - parseAllowNewer = ((Just . AllowNewer . toRelaxDeps) `fmap` Text.parse) Parse.<++ pkgs in - simpleField "allow-newer" - (showRelaxDeps . fmap unAllowNewer) parseAllowNewer - configAllowNewer (\v flags -> flags { configAllowNewer = v }) + [let pkgs = (Just . AllowOlder . RelaxDepsSome) + `fmap` parseOptCommaList Text.parse + parseAllowOlder = ((Just . AllowOlder . toRelaxDeps) + `fmap` Text.parse) Parse.<++ pkgs + in simpleField "allow-older" + (showRelaxDeps . fmap unAllowOlder) parseAllowOlder + configAllowOlder (\v flags -> flags { configAllowOlder = v }) + ,let pkgs = (Just . AllowNewer . RelaxDepsSome) + `fmap` parseOptCommaList Text.parse + parseAllowNewer = ((Just . AllowNewer . toRelaxDeps) + `fmap` Text.parse) Parse.<++ pkgs + in simpleField "allow-newer" + (showRelaxDeps . fmap unAllowNewer) parseAllowNewer + configAllowNewer (\v flags -> flags { configAllowNewer = v }) ] ++ toSavedConfig liftInstallFlag @@ -1033,8 +1058,10 @@ deprecatedFieldDescriptions = (fromFlagOrDefault [] . uploadPasswordCmd) (\d cfg -> cfg { uploadPasswordCmd = Flag d }) ] - ++ map (modifyFieldName ("user-"++) . liftUserInstallDirs) installDirsFields - ++ map (modifyFieldName ("global-"++) . liftGlobalInstallDirs) installDirsFields + ++ map (modifyFieldName ("user-"++) . liftUserInstallDirs) + installDirsFields + ++ map (modifyFieldName ("global-"++) . liftGlobalInstallDirs) + installDirsFields where optional = Parse.option mempty . fmap toFlag modifyFieldName :: (String -> String) -> FieldDescr a -> FieldDescr a @@ -1047,8 +1074,9 @@ liftUserInstallDirs = liftField liftGlobalInstallDirs :: FieldDescr (InstallDirs (Flag PathTemplate)) -> FieldDescr SavedConfig -liftGlobalInstallDirs = liftField - savedGlobalInstallDirs (\flags conf -> conf { savedGlobalInstallDirs = flags }) +liftGlobalInstallDirs = + liftField savedGlobalInstallDirs + (\flags conf -> conf { savedGlobalInstallDirs = flags }) liftGlobalFlag :: FieldDescr GlobalFlags -> FieldDescr SavedConfig liftGlobalFlag = liftField @@ -1067,8 +1095,9 @@ liftInstallFlag = liftField savedInstallFlags (\flags conf -> conf { savedInstallFlags = flags }) liftClientInstallFlag :: FieldDescr ClientInstallFlags -> FieldDescr SavedConfig -liftClientInstallFlag = liftField - savedClientInstallFlags (\flags conf -> conf { savedClientInstallFlags = flags }) +liftClientInstallFlag = + liftField savedClientInstallFlags + (\flags conf -> conf { savedClientInstallFlags = flags }) liftUploadFlag :: FieldDescr UploadFlags -> FieldDescr SavedConfig liftUploadFlag = liftField @@ -1125,25 +1154,32 @@ parseConfig src initial = \str -> do isKnownSection (ParseUtils.Section _ "program-default-options" _ _) = True isKnownSection _ = False - -- attempt to split fields that can represent lists of paths into actual lists - -- on failure, leave the field untouched + -- Attempt to split fields that can represent lists of paths into + -- actual lists on failure, leave the field untouched. splitMultiPath :: [String] -> [String] splitMultiPath [s] = case runP 0 "" (parseOptCommaList parseTokenQ) s of ParseOk _ res -> res _ -> [s] splitMultiPath xs = xs - -- This is a fixup, pending a full config parser rewrite, to ensure that - -- config fields which can be comma seperated lists actually parse as comma seperated lists + -- This is a fixup, pending a full config parser rewrite, to + -- ensure that config fields which can be comma-separated lists + -- actually parse as comma-separated lists. fixConfigMultilines conf = conf { savedConfigureFlags = let scf = savedConfigureFlags conf in scf { - configProgramPathExtra = toNubList $ splitMultiPath (fromNubList $ configProgramPathExtra scf) - , configExtraLibDirs = splitMultiPath (configExtraLibDirs scf) - , configExtraFrameworkDirs = splitMultiPath (configExtraFrameworkDirs scf) - , configExtraIncludeDirs = splitMultiPath (configExtraIncludeDirs scf) - , configConfigureArgs = splitMultiPath (configConfigureArgs scf) + configProgramPathExtra = + toNubList $ splitMultiPath + (fromNubList $ configProgramPathExtra scf) + , configExtraLibDirs = splitMultiPath + (configExtraLibDirs scf) + , configExtraFrameworkDirs = splitMultiPath + (configExtraFrameworkDirs scf) + , configExtraIncludeDirs = splitMultiPath + (configExtraIncludeDirs scf) + , configConfigureArgs = splitMultiPath + (configConfigureArgs scf) } } @@ -1222,8 +1258,9 @@ showConfigWithComments comment vals = Disp.render $ [] -> Disp.text "" (x:xs) -> foldl' (\ r r' -> r $+$ Disp.text "" $+$ r') x xs $+$ Disp.text "" - $+$ ppFields (skipSomeFields (configFieldDescriptions ConstraintSourceUnknown)) - mcomment vals + $+$ ppFields + (skipSomeFields (configFieldDescriptions ConstraintSourceUnknown)) + mcomment vals $+$ Disp.text "" $+$ ppSection "haddock" "" haddockFlagsFields (fmap savedHaddockFlags mcomment) (savedHaddockFlags vals) @@ -1265,19 +1302,19 @@ ppRemoteRepoSection def vals = ppSection "repository" (remoteRepoName vals) remoteRepoFields :: [FieldDescr RemoteRepo] remoteRepoFields = - [ simpleField "url" - (text . show) (parseTokenQ >>= parseURI') - remoteRepoURI (\x repo -> repo { remoteRepoURI = x }) - , simpleField "secure" - showSecure (Just `fmap` Text.parse) - remoteRepoSecure (\x repo -> repo { remoteRepoSecure = x }) - , listField "root-keys" - text parseTokenQ - remoteRepoRootKeys (\x repo -> repo { remoteRepoRootKeys = x }) - , simpleField "key-threshold" - showThreshold Text.parse - remoteRepoKeyThreshold (\x repo -> repo { remoteRepoKeyThreshold = x }) - ] + [ simpleField "url" + (text . show) (parseTokenQ >>= parseURI') + remoteRepoURI (\x repo -> repo { remoteRepoURI = x }) + , simpleField "secure" + showSecure (Just `fmap` Text.parse) + remoteRepoSecure (\x repo -> repo { remoteRepoSecure = x }) + , listField "root-keys" + text parseTokenQ + remoteRepoRootKeys (\x repo -> repo { remoteRepoRootKeys = x }) + , simpleField "key-threshold" + showThreshold Text.parse + remoteRepoKeyThreshold (\x repo -> repo { remoteRepoKeyThreshold = x }) + ] where parseURI' uriString = case parseURI uriString of @@ -1314,12 +1351,13 @@ initFlagsFields = [ field , name `notElem` exclusions ] where exclusions = - ["author", "email", "quiet", "no-comments", "minimal", "overwrite", - "package-dir", "packagedir", "package-name", "version", "homepage", - "synopsis", "category", "extra-source-file", "lib", "exe", "libandexe", - "simple", "main-is", "expose-module", "exposed-modules", "extension", - "dependency", "build-tool", "with-compiler", - "verbose"] + [ "author", "email", "quiet", "no-comments", "minimal", "overwrite" + , "package-dir", "packagedir", "package-name", "version", "homepage" + , "synopsis", "category", "extra-source-file", "lib", "exe", "libandexe" + , "simple", "main-is", "expose-module", "exposed-modules", "extension" + , "dependency", "build-tool", "with-compiler" + , "verbose" + ] -- | Fields for the 'program-locations' section. withProgramsFields :: [FieldDescr [(String, FilePath)]] @@ -1336,16 +1374,17 @@ withProgramOptionsFields = parseExtraLines :: Verbosity -> [String] -> IO SavedConfig parseExtraLines verbosity extraLines = - case parseConfig (ConstraintSourceMainConfig "additional lines") - mempty (unlines extraLines) of - ParseFailed err -> - let (line, msg) = locatedErrorMsg err - in die' verbosity $ - "Error parsing additional config lines\n" - ++ maybe "" (\n -> ':' : show n) line ++ ":\n" ++ msg - ParseOk [] r -> return r - ParseOk ws _ -> die' verbosity $ - unlines (map (showPWarning "Error parsing additional config lines") ws) + case parseConfig (ConstraintSourceMainConfig "additional lines") + mempty (unlines extraLines) of + ParseFailed err -> + let (line, msg) = locatedErrorMsg err + in die' verbosity $ + "Error parsing additional config lines\n" + ++ maybe "" (\n -> ':' : show n) line ++ ":\n" ++ msg + ParseOk [] r -> return r + ParseOk ws _ -> + die' verbosity $ + unlines (map (showPWarning "Error parsing additional config lines") ws) -- | Get the differences (as a pseudo code diff) between the user's -- '~/.cabal/config' and the one that cabal would generate if it didn't exist. @@ -1354,10 +1393,11 @@ userConfigDiff verbosity globalFlags extraLines = do userConfig <- loadRawConfig normal (globalConfigFile globalFlags) extraConfig <- parseExtraLines verbosity extraLines testConfig <- initialSavedConfig - return $ reverse . foldl' createDiff [] . M.toList - $ M.unionWith combine - (M.fromList . map justFst $ filterShow testConfig) - (M.fromList . map justSnd $ filterShow (userConfig `mappend` extraConfig)) + return $ + reverse . foldl' createDiff [] . M.toList + $ M.unionWith combine + (M.fromList . map justFst $ filterShow testConfig) + (M.fromList . map justSnd $ filterShow (userConfig `mappend` extraConfig)) where justFst (a, b) = (a, (Just b, Nothing)) justSnd (a, b) = (a, (Nothing, Just b)) @@ -1406,4 +1446,5 @@ userConfigUpdate verbosity globalFlags extraLines = do notice verbosity $ "Renaming " ++ cabalFile ++ " to " ++ backup ++ "." renameFile cabalFile backup notice verbosity $ "Writing merged config to " ++ cabalFile ++ "." - writeConfigFile cabalFile commentConf (newConfig `mappend` userConfig `mappend` extraConfig) + writeConfigFile cabalFile commentConf + (newConfig `mappend` userConfig `mappend` extraConfig) diff --git a/cabal/cabal-install/Distribution/Client/Configure.hs b/cabal/cabal-install/Distribution/Client/Configure.hs index abafce7..6a0ff89 100644 --- a/cabal/cabal-install/Distribution/Client/Configure.hs +++ b/cabal/cabal-install/Distribution/Client/Configure.hs @@ -24,6 +24,7 @@ module Distribution.Client.Configure ( import Prelude () import Distribution.Client.Compat.Prelude +import Distribution.Utils.Generic (safeHead) import Distribution.Client.Dependency import qualified Distribution.Client.InstallPlan as InstallPlan @@ -85,6 +86,8 @@ import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity as Verbosity ( Verbosity ) +import Data.Foldable + ( forM_ ) import System.FilePath ( (</>) ) -- | Choose the Cabal version such that the setup scripts compiled against this @@ -272,12 +275,12 @@ checkConfigExFlags :: Package pkg -> ConfigExFlags -> IO () checkConfigExFlags verbosity installedPkgIndex sourcePkgIndex flags = do - unless (null unknownConstraints) $ warn verbosity $ - "Constraint refers to an unknown package: " - ++ showConstraint (head unknownConstraints) - unless (null unknownPreferences) $ warn verbosity $ - "Preference refers to an unknown package: " - ++ display (head unknownPreferences) + forM_ (safeHead unknownConstraints) $ \h -> + warn verbosity $ "Constraint refers to an unknown package: " + ++ showConstraint h + forM_ (safeHead unknownPreferences) $ \h -> + warn verbosity $ "Preference refers to an unknown package: " + ++ display h where unknownConstraints = filter (unknown . userConstraintPackageName . fst) $ configExConstraints flags diff --git a/cabal/cabal-install/Distribution/Client/FetchUtils.hs b/cabal/cabal-install/Distribution/Client/FetchUtils.hs index ae2e271..992eb0f 100644 --- a/cabal/cabal-install/Distribution/Client/FetchUtils.hs +++ b/cabal/cabal-install/Distribution/Client/FetchUtils.hs @@ -162,7 +162,7 @@ fetchPackage verbosity repoCtxt loc = case loc of -- | Fetch a repo package if we don't have it already. -- fetchRepoTarball :: Verbosity -> RepoContext -> Repo -> PackageId -> IO FilePath -fetchRepoTarball verbosity repoCtxt repo pkgid = do +fetchRepoTarball verbosity' repoCtxt repo pkgid = do fetched <- doesFileExist (packageFile repo pkgid) if fetched then do info verbosity $ display pkgid ++ " has already been downloaded." @@ -171,9 +171,10 @@ fetchRepoTarball verbosity repoCtxt repo pkgid = do res <- downloadRepoPackage progressMessage verbosity ProgressDownloaded (display pkgid) return res - - where + -- whether we download or not is non-deterministic + verbosity = verboseUnmarkOutput verbosity' + downloadRepoPackage = case repo of RepoLocal{..} -> return (packageFile repo pkgid) diff --git a/cabal/cabal-install/Distribution/Client/GenBounds.hs b/cabal/cabal-install/Distribution/Client/GenBounds.hs index 553ee08..454a9cf 100644 --- a/cabal/cabal-install/Distribution/Client/GenBounds.hs +++ b/cabal/cabal-install/Distribution/Client/GenBounds.hs @@ -17,6 +17,7 @@ module Distribution.Client.GenBounds ( import Prelude () import Distribution.Client.Compat.Prelude +import Distribution.Utils.Generic (safeLast) import Distribution.Client.Init ( incVersion ) @@ -59,9 +60,9 @@ import System.Directory -- | Does this version range have an upper bound? hasUpperBound :: VersionRange -> Bool hasUpperBound vr = - case asVersionIntervals vr of - [] -> False - is -> if snd (last is) == NoUpperBound then False else True + case safeLast (asVersionIntervals vr) of + Nothing -> False + Just l -> if snd l == NoUpperBound then False else True -- | Given a version, return an API-compatible (according to PVP) version range. -- diff --git a/cabal/cabal-install/Distribution/Client/Get.hs b/cabal/cabal-install/Distribution/Client/Get.hs index 006eb57..c70d0e7 100644 --- a/cabal/cabal-install/Distribution/Client/Get.hs +++ b/cabal/cabal-install/Distribution/Client/Get.hs @@ -24,6 +24,7 @@ module Distribution.Client.Get ( import Prelude () import Distribution.Client.Compat.Prelude hiding (get) +import Data.Ord (comparing) import Distribution.Compat.Directory ( listDirectory ) import Distribution.Package @@ -38,6 +39,8 @@ import Distribution.Deprecated.Text (display) import qualified Distribution.PackageDescription as PD import Distribution.Simple.Program ( programName ) +import Distribution.Types.SourceRepo (RepoKind (..)) +import Distribution.Client.SourceRepo (SourceRepositoryPackage (..), SourceRepoProxy, srpToProxy) import Distribution.Client.Setup ( GlobalFlags(..), GetFlags(..), RepoContext(..) ) @@ -114,7 +117,7 @@ get verbosity repoCtxt globalFlags getFlags userTargets = do . map (\pkg -> (packageId pkg, packageSourceRepos pkg)) where kind = fromFlag . getSourceRepository $ getFlags - packageSourceRepos :: SourcePackage loc -> [SourceRepo] + packageSourceRepos :: SourcePackage loc -> [PD.SourceRepo] packageSourceRepos = PD.sourceRepos . PD.packageDescription . packageDescription @@ -197,11 +200,11 @@ unpackPackage verbosity prefix pkgid descOverride pkgPath = do data ClonePackageException = ClonePackageNoSourceRepos PackageId | ClonePackageNoSourceReposOfKind PackageId (Maybe RepoKind) - | ClonePackageNoRepoType PackageId SourceRepo - | ClonePackageUnsupportedRepoType PackageId SourceRepo RepoType - | ClonePackageNoRepoLocation PackageId SourceRepo + | ClonePackageNoRepoType PackageId PD.SourceRepo + | ClonePackageUnsupportedRepoType PackageId SourceRepoProxy RepoType + | ClonePackageNoRepoLocation PackageId PD.SourceRepo | ClonePackageDestinationExists PackageId FilePath Bool - | ClonePackageFailedWithExitCode PackageId SourceRepo String ExitCode + | ClonePackageFailedWithExitCode PackageId SourceRepoProxy String ExitCode deriving (Show, Eq) instance Exception ClonePackageException where @@ -237,7 +240,7 @@ instance Exception ClonePackageException where displayException (ClonePackageFailedWithExitCode pkgid repo vcsprogname exitcode) = "Failed to fetch the source repository for package " ++ display pkgid - ++ maybe "" (", repository location " ++) (PD.repoLocation repo) ++ " (" + ++ ", repository location " ++ srpLocation repo ++ " (" ++ vcsprogname ++ " failed with " ++ show exitcode ++ ")." @@ -248,7 +251,7 @@ instance Exception ClonePackageException where clonePackagesFromSourceRepo :: Verbosity -> FilePath -- ^ destination dir prefix -> Maybe RepoKind -- ^ preferred 'RepoKind' - -> [(PackageId, [SourceRepo])] + -> [(PackageId, [PD.SourceRepo])] -- ^ the packages and their -- available 'SourceRepo's -> IO () @@ -268,14 +271,14 @@ clonePackagesFromSourceRepo verbosity destDirPrefix [ cloneSourceRepo verbosity vcs' repo destDir `catch` \exitcode -> throwIO (ClonePackageFailedWithExitCode - pkgid repo (programName (vcsProgram vcs)) exitcode) + pkgid (srpToProxy repo) (programName (vcsProgram vcs)) exitcode) | (pkgid, repo, vcs, destDir) <- pkgrepos' , let Just vcs' = Map.lookup (vcsRepoType vcs) vcss ] where - preCloneChecks :: (PackageId, [SourceRepo]) - -> IO (PackageId, SourceRepo, VCS Program, FilePath) + preCloneChecks :: (PackageId, [PD.SourceRepo]) + -> IO (PackageId, SourceRepositoryPackage Maybe, VCS Program, FilePath) preCloneChecks (pkgid, repos) = do repo <- case selectPackageSourceRepo preferredRepoKind repos of Just repo -> return repo @@ -283,13 +286,13 @@ clonePackagesFromSourceRepo verbosity destDirPrefix Nothing -> throwIO (ClonePackageNoSourceReposOfKind pkgid preferredRepoKind) - vcs <- case validateSourceRepo repo of - Right (_, _, _, vcs) -> return vcs + (repo', vcs) <- case validatePDSourceRepo repo of + Right (repo', _, _, vcs) -> return (repo', vcs) Left SourceRepoRepoTypeUnspecified -> throwIO (ClonePackageNoRepoType pkgid repo) - Left (SourceRepoRepoTypeUnsupported repoType) -> - throwIO (ClonePackageUnsupportedRepoType pkgid repo repoType) + Left (SourceRepoRepoTypeUnsupported repo' repoType) -> + throwIO (ClonePackageUnsupportedRepoType pkgid repo' repoType) Left SourceRepoLocationUnspecified -> throwIO (ClonePackageNoRepoLocation pkgid repo) @@ -300,5 +303,37 @@ clonePackagesFromSourceRepo verbosity destDirPrefix when (destDirExists || destFileExists) $ throwIO (ClonePackageDestinationExists pkgid destDir destDirExists) - return (pkgid, repo, vcs, destDir) + return (pkgid, repo', vcs, destDir) +------------------------------------------------------------------------------- +-- Selecting +------------------------------------------------------------------------------- + +-- | Pick the 'SourceRepo' to use to get the package sources from. +-- +-- Note that this does /not/ depend on what 'VCS' drivers we are able to +-- successfully configure. It is based only on the 'SourceRepo's declared +-- in the package, and optionally on a preferred 'RepoKind'. +-- +selectPackageSourceRepo :: Maybe RepoKind + -> [PD.SourceRepo] + -> Maybe PD.SourceRepo +selectPackageSourceRepo preferredRepoKind = + listToMaybe + -- Sort repositories by kind, from This to Head to Unknown. Repositories + -- with equivalent kinds are selected based on the order they appear in + -- the Cabal description file. + . sortBy (comparing thisFirst) + -- If the user has specified the repo kind, filter out the repositories + -- they're not interested in. + . filter (\repo -> maybe True (PD.repoKind repo ==) preferredRepoKind) + where + thisFirst :: PD.SourceRepo -> Int + thisFirst r = case PD.repoKind r of + RepoThis -> 0 + RepoHead -> case PD.repoTag r of + -- If the type is 'head' but the author specified a tag, they + -- probably meant to create a 'this' repository but screwed up. + Just _ -> 0 + Nothing -> 1 + RepoKindUnknown _ -> 2 diff --git a/cabal/cabal-install/Distribution/Client/HttpUtils.hs b/cabal/cabal-install/Distribution/Client/HttpUtils.hs index 1fd8ae8..eed05ac 100644 --- a/cabal/cabal-install/Distribution/Client/HttpUtils.hs +++ b/cabal/cabal-install/Distribution/Client/HttpUtils.hs @@ -15,7 +15,8 @@ module Distribution.Client.HttpUtils ( ) where import Prelude () -import Distribution.Client.Compat.Prelude +import Distribution.Client.Compat.Prelude hiding (Proxy (..)) +import Distribution.Utils.Generic import Network.HTTP ( Request (..), Response (..), RequestMethod (..) @@ -38,7 +39,7 @@ import qualified Paths_cabal_install (version) import Distribution.Verbosity (Verbosity) import Distribution.Pretty (prettyShow) import Distribution.Simple.Utils - ( die', info, warn, debug, notice, writeFileAtomic + ( die', info, warn, debug, notice , copyFileVerbose, withTempFile ) import Distribution.Client.Utils ( withTempFileName ) @@ -305,8 +306,8 @@ configureTransport verbosity extraPath Nothing = do [ (name, transport) | (name, _, _, mkTrans) <- supportedTransports , transport <- maybeToList (mkTrans progdb) ] - -- there's always one because the plain one is last and never fails - let (name, transport) = head availableTransports + let (name, transport) = + fromMaybe ("plain-http", plainHttpTransport) (safeHead availableTransports) debug verbosity $ "Selected http transport implementation: " ++ name return transport { transportManuallySelected = False } diff --git a/cabal/cabal-install/Distribution/Client/Init.hs b/cabal/cabal-install/Distribution/Client/Init.hs index 980028c..9b19670 100644 --- a/cabal/cabal-install/Distribution/Client/Init.hs +++ b/cabal/cabal-install/Distribution/Client/Init.hs @@ -37,7 +37,8 @@ import Data.Time ( getCurrentTime, utcToLocalTime, toGregorian, localDay, getCurrentTimeZone ) import Data.List - ( groupBy, (\\) ) + ( (\\) ) +import qualified Data.List.NonEmpty as NE import Data.Function ( on ) import qualified Data.Map as M @@ -636,25 +637,25 @@ chooseDep flags (m, Just ps) -- do it. grps -> do message flags ("\nWarning: multiple packages found providing " ++ display m - ++ ": " ++ intercalate ", " (map (display . P.pkgName . head) grps)) + ++ ": " ++ intercalate ", " (fmap (display . P.pkgName . NE.head) grps)) message flags "You will need to pick one and manually add it to the Build-depends: field." return Nothing where - pkgGroups = groupBy ((==) `on` P.pkgName) (map P.packageId ps) + pkgGroups = NE.groupBy ((==) `on` P.pkgName) (map P.packageId ps) desugar = maybe True (< mkVersion [2]) $ flagToMaybe (cabalVersion flags) -- Given a list of available versions of the same package, pick a dependency. - toDep :: [P.PackageIdentifier] -> IO P.Dependency + toDep :: NonEmpty P.PackageIdentifier -> IO P.Dependency -- If only one version, easy. We change e.g. 0.4.2 into 0.4.* - toDep [pid] = return $ P.Dependency (P.pkgName pid) (pvpize desugar . P.pkgVersion $ pid) (Set.singleton LMainLibName) --TODO sublibraries + toDep (pid:|[]) = return $ P.Dependency (P.pkgName pid) (pvpize desugar . P.pkgVersion $ pid) (Set.singleton LMainLibName) --TODO sublibraries -- Otherwise, choose the latest version and issue a warning. toDep pids = do - message flags ("\nWarning: multiple versions of " ++ display (P.pkgName . head $ pids) ++ " provide " ++ display m ++ ", choosing the latest.") - return $ P.Dependency (P.pkgName . head $ pids) - (pvpize desugar . maximum . map P.pkgVersion $ pids) + message flags ("\nWarning: multiple versions of " ++ display (P.pkgName . NE.head $ pids) ++ " provide " ++ display m ++ ", choosing the latest.") + return $ P.Dependency (P.pkgName . NE.head $ pids) + (pvpize desugar . maximum . fmap P.pkgVersion $ pids) (Set.singleton LMainLibName) --TODO take into account sublibraries -- | Given a version, return an API-compatible (according to PVP) version range. @@ -696,8 +697,8 @@ eligibleForTestSuite flags = maybePrompt :: InitFlags -> IO t -> IO (Maybe t) maybePrompt flags p = case interactive flags of - Flag False -> return Nothing - _ -> Just `fmap` p + Flag True -> Just `fmap` p + _ -> return Nothing -- | Create a prompt with optional default value that returns a -- String. diff --git a/cabal/cabal-install/Distribution/Client/Init/Heuristics.hs b/cabal/cabal-install/Distribution/Client/Init/Heuristics.hs index 6babd2e..e890d24 100644 --- a/cabal/cabal-install/Distribution/Client/Init/Heuristics.hs +++ b/cabal/cabal-install/Distribution/Client/Init/Heuristics.hs @@ -22,6 +22,7 @@ module Distribution.Client.Init.Heuristics ( import Prelude () import Distribution.Client.Compat.Prelude +import Distribution.Utils.Generic (safeHead, safeTail, safeLast) import Distribution.Parsec (simpleParsec) import Distribution.Simple.Setup (Flag(..), flagToMaybe) @@ -86,7 +87,7 @@ guessMainFileCandidates flags = do -- | Guess the package name based on the given root directory. guessPackageName :: FilePath -> IO P.PackageName -guessPackageName = liftM (P.mkPackageName . repair . last . splitDirectories) +guessPackageName = liftM (P.mkPackageName . repair . fromMaybe "" . safeLast . splitDirectories) . tryCanonicalizePath where -- Treat each span of non-alphanumeric characters as a hyphen. Each @@ -132,7 +133,7 @@ scanForModulesIn projectRoot srcRoot = scan srcRoot [] (files, dirs) <- liftM partitionEithers (mapM (tagIsDir dir) entries) let modules = catMaybes [ guessModuleName hierarchy file | file <- files - , isUpper (head file) ] + , maybe False isUpper (safeHead file) ] modules' <- mapM (findImportsAndExts projectRoot) modules recMods <- mapM (scanRecursive dir hierarchy) dirs return $ concat (modules' : recMods) @@ -151,8 +152,8 @@ scanForModulesIn projectRoot srcRoot = scan srcRoot [] $ intercalate "." . reverse $ (unqualModName : hierarchy) ext = case takeExtension entry of '.':e -> e; e -> e scanRecursive parent hierarchy entry - | isUpper (head entry) = scan (parent </> entry) (entry : hierarchy) - | isLower (head entry) && not (ignoreDir entry) = + | maybe False isUpper (safeHead entry) = scan (parent </> entry) (entry : hierarchy) + | maybe False isLower (safeHead entry) && not (ignoreDir entry) = scanForModulesIn projectRoot $ foldl (</>) srcRoot (reverse (entry : hierarchy)) | otherwise = return [] ignoreDir ('.':_) = True @@ -345,7 +346,7 @@ maybeReadFile f = do -- |Get list of categories used in Hackage. NOTE: Very slow, needs to be cached knownCategories :: SourcePackageDb -> [String] knownCategories (SourcePackageDb sourcePkgIndex _) = nubSet - [ cat | pkg <- map head (allPackagesByName sourcePkgIndex) + [ cat | pkg <- maybeToList . safeHead =<< (allPackagesByName sourcePkgIndex) , let catList = (PD.category . PD.packageDescription . packageDescription) pkg , cat <- splitString ',' catList ] @@ -358,7 +359,7 @@ nameAndMail str | otherwise = (Flag $ trim nameOrEmail, Flag mail) where (nameOrEmail,erest) = break (== '<') str - (mail,_) = break (== '>') (tail erest) + (mail,_) = break (== '>') (safeTail erest) trim :: String -> String trim = removeLeadingSpace . reverse . removeLeadingSpace . reverse diff --git a/cabal/cabal-install/Distribution/Client/Install.hs b/cabal/cabal-install/Distribution/Client/Install.hs index 3e5dff8..7a26cdc 100644 --- a/cabal/cabal-install/Distribution/Client/Install.hs +++ b/cabal/cabal-install/Distribution/Client/Install.hs @@ -31,6 +31,7 @@ module Distribution.Client.Install ( import Prelude () import Distribution.Client.Compat.Prelude +import Distribution.Utils.Generic(safeLast) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map @@ -125,7 +126,7 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex) import Distribution.Simple.Setup ( haddockCommand, HaddockFlags(..) , buildCommand, BuildFlags(..), emptyBuildFlags - , TestFlags + , TestFlags, BenchmarkFlags , toFlag, fromFlag, fromFlagOrDefault, flagToMaybe, defaultDistPref ) import qualified Distribution.Simple.Setup as Cabal ( Flag(..) @@ -148,7 +149,7 @@ import Distribution.Types.Dependency ( thisPackageVersion ) import Distribution.Types.GivenComponent ( GivenComponent(..) ) -import Distribution.Pretty ( prettyShow ) +import Distribution.Pretty ( prettyShow ) import Distribution.Types.PackageVersionConstraint ( PackageVersionConstraint(..) ) import Distribution.Types.MungedPackageId @@ -206,11 +207,12 @@ install -> InstallFlags -> HaddockFlags -> TestFlags + -> BenchmarkFlags -> [UserTarget] -> IO () install verbosity packageDBs repos comp platform progdb useSandbox mSandboxPkgInfo - globalFlags configFlags configExFlags installFlags haddockFlags testFlags - userTargets0 = do + globalFlags configFlags configExFlags installFlags + haddockFlags testFlags benchmarkFlags userTargets0 = do unless (installRootCmd installFlags == Cabal.NoFlag) $ warn verbosity $ "--root-cmd is no longer supported, " @@ -238,7 +240,7 @@ install verbosity packageDBs repos comp platform progdb useSandbox mSandboxPkgIn args :: InstallArgs args = (packageDBs, repos, comp, platform, progdb, useSandbox, mSandboxPkgInfo, globalFlags, configFlags, configExFlags, - installFlags, haddockFlags, testFlags) + installFlags, haddockFlags, testFlags, benchmarkFlags) die'' message = die' verbosity (message ++ if isUseSandbox useSandbox then installFailedInSandbox else []) @@ -272,14 +274,15 @@ type InstallArgs = ( PackageDBStack , ConfigExFlags , InstallFlags , HaddockFlags - , TestFlags ) + , TestFlags + , BenchmarkFlags ) -- | Make an install context given install arguments. makeInstallContext :: Verbosity -> InstallArgs -> Maybe [UserTarget] -> IO InstallContext makeInstallContext verbosity (packageDBs, repoCtxt, comp, _, progdb,_,_, - globalFlags, _, configExFlags, installFlags, _, _) mUserTargets = do + globalFlags, _, configExFlags, installFlags, _, _, _) mUserTargets = do let idxState = flagToMaybe (installIndexState installFlags) @@ -318,7 +321,7 @@ makeInstallPlan :: Verbosity -> InstallArgs -> InstallContext makeInstallPlan verbosity (_, _, comp, platform, _, _, mSandboxPkgInfo, _, configFlags, configExFlags, installFlags, - _, _) + _, _, _) (installedPkgIndex, sourcePkgDb, pkgConfigDb, _, pkgSpecifiers, _) = do @@ -334,7 +337,7 @@ processInstallPlan :: Verbosity -> InstallArgs -> InstallContext -> SolverInstallPlan -> IO () processInstallPlan verbosity - args@(_,_, _, _, _, _, _, _, configFlags, _, installFlags, _, _) + args@(_,_, _, _, _, _, _, _, configFlags, _, installFlags, _, _, _) (installedPkgIndex, sourcePkgDb, _, userTargets, pkgSpecifiers, _) installPlan0 = do @@ -699,11 +702,11 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of Nothing -> "" where mLatestVersion :: Maybe Version - mLatestVersion = case SourcePackageIndex.lookupPackageName - (packageIndex sourcePkgDb) - (packageName pkg) of - [] -> Nothing - x -> Just $ packageVersion $ last x + mLatestVersion = fmap packageVersion $ + safeLast $ + SourcePackageIndex.lookupPackageName + (packageIndex sourcePkgDb) + (packageName pkg) toFlagAssignment :: [Flag] -> FlagAssignment toFlagAssignment = mkFlagAssignment . map (\ f -> (flagName f, flagDefault f)) @@ -755,7 +758,7 @@ reportPlanningFailure :: Verbosity -> InstallArgs -> InstallContext -> String -> IO () reportPlanningFailure verbosity (_, _, comp, platform, _, _, _ - ,_, configFlags, _, installFlags, _, _) + ,_, configFlags, _, installFlags, _, _, _) (_, sourcePkgDb, _, _, pkgSpecifiers, _) message = do @@ -835,7 +838,7 @@ postInstallActions :: Verbosity -> IO () postInstallActions verbosity (packageDBs, _, comp, platform, progdb, useSandbox, mSandboxPkgInfo - ,globalFlags, configFlags, _, installFlags, _, _) + ,globalFlags, configFlags, _, installFlags, _, _, _) targets installPlan buildOutcomes = do updateSandboxTimestampsFile verbosity useSandbox mSandboxPkgInfo @@ -1089,7 +1092,8 @@ performInstallations :: Verbosity -> IO BuildOutcomes performInstallations verbosity (packageDBs, repoCtxt, comp, platform, progdb, useSandbox, _, - globalFlags, configFlags, configExFlags, installFlags, haddockFlags, testFlags) + globalFlags, configFlags, configExFlags, installFlags, + haddockFlags, testFlags, _) installedPkgIndex installPlan = do -- With 'install -j' it can be a bit hard to tell whether a sandbox is used. diff --git a/cabal/cabal-install/Distribution/Client/InstallPlan.hs b/cabal/cabal-install/Distribution/Client/InstallPlan.hs index 408daf1..1af2e98 100644 --- a/cabal/cabal-install/Distribution/Client/InstallPlan.hs +++ b/cabal/cabal-install/Distribution/Client/InstallPlan.hs @@ -96,7 +96,7 @@ import Distribution.Utils.LogProgress import Data.List ( foldl', intercalate ) -import qualified Data.Foldable as Foldable (all) +import qualified Data.Foldable as Foldable (all, toList) import Data.Maybe ( fromMaybe, mapMaybe ) import qualified Distribution.Compat.Graph as Graph @@ -278,7 +278,7 @@ showPlanGraph :: (Package ipkg, Package srcpkg, IsUnit ipkg, IsUnit srcpkg) => Graph (GenericPlanPackage ipkg srcpkg) -> String showPlanGraph graph = renderStyle defaultStyle $ - vcat (map dispPlanPackage (Graph.toList graph)) + vcat (map dispPlanPackage (Foldable.toList graph)) where dispPlanPackage p = hang (hsep [ text (showPlanPackageTag p) , disp (packageId p) @@ -309,7 +309,7 @@ toGraph = planGraph toList :: GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg] -toList = Graph.toList . planGraph +toList = Foldable.toList . planGraph toMap :: GenericInstallPlan ipkg srcpkg -> Map UnitId (GenericPlanPackage ipkg srcpkg) @@ -929,7 +929,7 @@ problems graph = --TODO: consider re-enabling this one, see SolverInstallPlan -} ++ [ PackageStateInvalid pkg pkg' - | pkg <- Graph.toList graph + | pkg <- Foldable.toList graph , Just pkg' <- map (flip Graph.lookup graph) (nodeNeighbors pkg) , not (stateDependencyRelation pkg pkg') ] diff --git a/cabal/cabal-install/Distribution/Client/InstallSymlink.hs b/cabal/cabal-install/Distribution/Client/InstallSymlink.hs index bff924f..2769341 100644 --- a/cabal/cabal-install/Distribution/Client/InstallSymlink.hs +++ b/cabal/cabal-install/Distribution/Client/InstallSymlink.hs @@ -48,7 +48,7 @@ symlinkBinaries :: Platform -> Compiler symlinkBinaries _ _ _ _ _ _ _ = return [] symlinkBinary :: OverwritePolicy - -> FilePath -> FilePath -> UnqualComponentName -> String + -> FilePath -> FilePath -> FilePath -> String -> IO Bool symlinkBinary _ _ _ _ _ = fail "Symlinking feature not available on Windows" @@ -154,7 +154,7 @@ symlinkBinaries platform comp overwritePolicy ok <- symlinkBinary overwritePolicy publicBinDir privateBinDir - publicExeName privateExeName + (display publicExeName) privateExeName if ok then return Nothing else return (Just (pkgid, publicExeName, @@ -220,7 +220,7 @@ symlinkBinary :: -- @/home/user/bin@ -> FilePath -- ^ The canonical path of the private bin dir eg -- @/home/user/.cabal/bin@ - -> UnqualComponentName -- ^ The name of the executable to go in the public bin + -> FilePath -- ^ The name of the executable to go in the public bin -- dir, eg @foo@ -> String -- ^ The name of the executable to in the private bin -- dir, eg @foo-1.0@ @@ -229,7 +229,7 @@ symlinkBinary :: -- not own. Other errors like permission errors just -- propagate as exceptions. symlinkBinary overwritePolicy publicBindir privateBindir publicName privateName = do - ok <- targetOkToOverwrite (publicBindir </> publicName') + ok <- targetOkToOverwrite (publicBindir </> publicName) (privateBindir </> privateName) case ok of NotExists -> mkLink >> return True @@ -239,11 +239,10 @@ symlinkBinary overwritePolicy publicBindir privateBindir publicName privateName NeverOverwrite -> return False AlwaysOverwrite -> rmLink >> mkLink >> return True where - publicName' = display publicName relativeBindir = makeRelative publicBindir privateBindir mkLink = createSymbolicLink (relativeBindir </> privateName) - (publicBindir </> publicName') - rmLink = removeLink (publicBindir </> publicName') + (publicBindir </> publicName) + rmLink = removeLink (publicBindir </> publicName) -- | Check a file path of a symlink that we would like to create to see if it -- is OK. For it to be OK to overwrite it must either not already exist yet or diff --git a/cabal/cabal-install/Distribution/Client/Outdated.hs b/cabal/cabal-install/Distribution/Client/Outdated.hs index 9095c70..7450ed7 100644 --- a/cabal/cabal-install/Distribution/Client/Outdated.hs +++ b/cabal/cabal-install/Distribution/Client/Outdated.hs @@ -26,6 +26,7 @@ import Distribution.Client.Types import Distribution.Solver.Types.PackageConstraint import Distribution.Solver.Types.PackageIndex import Distribution.Client.Sandbox.PackageEnvironment +import Distribution.Utils.Generic import Distribution.Package (PackageName, packageVersion) import Distribution.PackageDescription (allBuildDepends) @@ -204,7 +205,8 @@ listOutdated deps pkgIndex (ListOutdatedSettings ignorePred minorPred) = relaxMinor :: VersionRange -> VersionRange relaxMinor vr = let vis = asVersionIntervals vr - (LowerBound v0 _,upper) = last vis - in case upper of - NoUpperBound -> vr - UpperBound _v1 _ -> majorBoundVersion v0 + in maybe vr relax (safeLast vis) + where relax (LowerBound v0 _, upper) = + case upper of + NoUpperBound -> vr + UpperBound _v1 _ -> majorBoundVersion v0 diff --git a/cabal/cabal-install/Distribution/Client/PackageHash.hs b/cabal/cabal-install/Distribution/Client/PackageHash.hs index 279833b..944a3c3 100644 --- a/cabal/cabal-install/Distribution/Client/PackageHash.hs +++ b/cabal/cabal-install/Distribution/Client/PackageHash.hs @@ -60,7 +60,6 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.Map as Map import qualified Data.Set as Set -import Data.Set (Set) import Data.Function (on) import Control.Exception (evaluate) diff --git a/cabal/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal/cabal-install/Distribution/Client/ProjectBuilding.hs index 52fc8c3..f5c9776 100644 --- a/cabal/cabal-install/Distribution/Client/ProjectBuilding.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectBuilding.hs @@ -273,7 +273,7 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} shared = -- -- The packages are visited in dependency order, starting with packages with no -- dependencies. The result for each package is accumulated into a 'Map' and --- returned as the final result. In addition, when visting a package, the +-- returned as the final result. In addition, when visiting a package, the -- visiting function is passed the results for all the immediate package -- dependencies. This can be used to propagate information from dependencies. -- @@ -984,6 +984,12 @@ buildAndInstallUnpackedPackage verbosity let prefix = normalise $ dropDrive (InstallDirs.prefix (elabInstallDirs pkg)) entryDir = tmpDirNormalised </> prefix + + -- if there weren't anything to build, it might be that directory is not created + -- the @setup Cabal.copyCommand@ above might do nothing. + -- https://github.com/haskell/cabal/issues/4130 + createDirectoryIfMissingVerbose verbosity True entryDir + LBS.writeFile (entryDir </> "cabal-hash.txt") (renderPackageHashInputs (packageHashInputs pkgshared pkg)) diff --git a/cabal/cabal-install/Distribution/Client/ProjectConfig.hs b/cabal/cabal-install/Distribution/Client/ProjectConfig.hs index 23e3cd9..f0a8fcc 100644 --- a/cabal/cabal-install/Distribution/Client/ProjectConfig.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectConfig.hs @@ -100,7 +100,9 @@ import Distribution.Fields ( runParseResult, PError, PWarning, showPWarning) import Distribution.Pretty () import Distribution.Types.SourceRepo - ( SourceRepo(..), RepoType(..), ) + ( RepoType(..) ) +import Distribution.Client.SourceRepo + ( SourceRepoList, SourceRepositoryPackage (..), srpFanOut ) import Distribution.Simple.Compiler ( Compiler, compilerInfo ) import Distribution.Simple.Program @@ -139,7 +141,7 @@ import Data.Either import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Map as Map -import Data.Set (Set) +import qualified Data.List.NonEmpty as NE import qualified Data.Set as Set import qualified Data.Hashable as Hashable import Numeric (showHex) @@ -647,7 +649,7 @@ data ProjectPackageLocation = | ProjectPackageLocalDirectory FilePath FilePath -- dir and .cabal file | ProjectPackageLocalTarball FilePath | ProjectPackageRemoteTarball URI - | ProjectPackageRemoteRepo SourceRepo + | ProjectPackageRemoteRepo SourceRepoList | ProjectPackageNamed PackageVersionConstraint deriving Show @@ -1108,7 +1110,7 @@ syncAndReadSourcePackagesRemoteRepos :: Verbosity -> DistDirLayout -> ProjectConfigShared - -> [SourceRepo] + -> [SourceRepoList] -> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)] syncAndReadSourcePackagesRemoteRepos verbosity DistDirLayout{distDownloadSrcDirectory} @@ -1123,7 +1125,7 @@ syncAndReadSourcePackagesRemoteRepos verbosity -- All 'SourceRepo's grouped by referring to the "same" remote repo -- instance. So same location but can differ in commit/tag/branch/subdir. let reposByLocation :: Map (RepoType, String) - [(SourceRepo, RepoType)] + [(SourceRepoList, RepoType)] reposByLocation = Map.fromListWith (++) [ ((rtype, rloc), [(repo, vcsRepoType vcs)]) | (repo, rloc, rtype, vcs) <- repos' ] @@ -1143,7 +1145,7 @@ syncAndReadSourcePackagesRemoteRepos verbosity pathStem = distDownloadSrcDirectory </> localFileNameForRemoteRepo primaryRepo monitor :: FileMonitor - [SourceRepo] + [SourceRepoList] [PackageSpecifier (SourcePackage UnresolvedPkgLoc)] monitor = newFileMonitor (pathStem <.> "cache") ] @@ -1151,7 +1153,7 @@ syncAndReadSourcePackagesRemoteRepos verbosity syncRepoGroupAndReadSourcePackages :: VCS ConfiguredProgram -> FilePath - -> [SourceRepo] + -> [SourceRepoList] -> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)] syncRepoGroupAndReadSourcePackages vcs pathStem repoGroup = do liftIO $ createDirectoryIfMissingVerbose verbosity False @@ -1168,24 +1170,33 @@ syncAndReadSourcePackagesRemoteRepos verbosity sequence [ readPackageFromSourceRepo repoWithSubdir repoPath | (_, reposWithSubdir, repoPath) <- repoGroupWithPaths - , repoWithSubdir <- reposWithSubdir ] + , repoWithSubdir <- NE.toList reposWithSubdir ] where -- So to do both things above, we pair them up here. + repoGroupWithPaths + :: [(SourceRepositoryPackage Proxy, NonEmpty (SourceRepositoryPackage Maybe), FilePath)] repoGroupWithPaths = zipWith (\(x, y) z -> (x,y,z)) - (Map.toList - (Map.fromListWith (++) - [ (repo { repoSubdir = Nothing }, [repo]) - | repo <- repoGroup ])) + (mapGroup + [ (repo { srpSubdir = Proxy }, repo) + | repo <- foldMap (NE.toList . srpFanOut) repoGroup + ]) repoPaths + mapGroup :: Ord k => [(k, v)] -> [(k, NonEmpty v)] + mapGroup = Map.toList . Map.fromListWith (<>) . map (\(k, v) -> (k, pure v)) + -- The repos in a group are given distinct names by simple enumeration -- foo, foo-2, foo-3 etc + repoPaths :: [FilePath] repoPaths = pathStem : [ pathStem ++ "-" ++ show (i :: Int) | i <- [2..] ] + readPackageFromSourceRepo + :: SourceRepositoryPackage Maybe -> FilePath + -> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc)) readPackageFromSourceRepo repo repoPath = do - let packageDir = maybe repoPath (repoPath </>) (repoSubdir repo) + let packageDir = maybe repoPath (repoPath </>) (srpSubdir repo) entries <- liftIO $ getDirectoryContents packageDir --TODO: wrap exceptions case filter (\e -> takeExtension e == ".cabal") entries of @@ -1201,10 +1212,10 @@ syncAndReadSourcePackagesRemoteRepos verbosity location = RemoteSourceRepoPackage repo packageDir - reportSourceRepoProblems :: [(SourceRepo, SourceRepoProblem)] -> Rebuild a + reportSourceRepoProblems :: [(SourceRepoList, SourceRepoProblem)] -> Rebuild a reportSourceRepoProblems = liftIO . die' verbosity . renderSourceRepoProblems - renderSourceRepoProblems :: [(SourceRepo, SourceRepoProblem)] -> String + renderSourceRepoProblems :: [(SourceRepoList, SourceRepoProblem)] -> String renderSourceRepoProblems = unlines . map show -- "TODO: the repo problems" @@ -1357,10 +1368,9 @@ localFileNameForRemoteTarball uri = -- This is deterministic based on the source repo identity details, and -- intended to produce non-clashing file names for different repos. -- -localFileNameForRemoteRepo :: SourceRepo -> FilePath -localFileNameForRemoteRepo SourceRepo{repoType, repoLocation, repoModule} = - maybe "" ((++ "-") . mangleName) repoLocation - ++ showHex locationHash "" +localFileNameForRemoteRepo :: SourceRepoList -> FilePath +localFileNameForRemoteRepo SourceRepositoryPackage {srpType, srpLocation} = + mangleName srpLocation ++ "-" ++ showHex locationHash "" where mangleName = truncateString 10 . dropExtension . takeFileName . dropTrailingPathSeparator @@ -1368,7 +1378,7 @@ localFileNameForRemoteRepo SourceRepo{repoType, repoLocation, repoModule} = -- just the parts that make up the "identity" of the repo locationHash :: Word locationHash = - fromIntegral (Hashable.hash (show repoType, repoLocation, repoModule)) + fromIntegral (Hashable.hash (show srpType, srpLocation)) -- | Truncate a string, with a visual indication that it is truncated. diff --git a/cabal/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs b/cabal/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs index 1904d51..c71cae1 100644 --- a/cabal/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs @@ -29,6 +29,7 @@ import Distribution.Client.ProjectConfig.Types import Distribution.Client.Types ( RemoteRepo(..), emptyRemoteRepo , AllowNewer(..), AllowOlder(..) ) +import Distribution.Client.SourceRepo (sourceRepositoryPackageGrammar, SourceRepoList) import Distribution.Client.Config ( SavedConfig(..), remoteRepoFields ) @@ -41,9 +42,7 @@ import Distribution.Solver.Types.ConstraintSource import Distribution.Package import Distribution.PackageDescription - ( SourceRepo(..), RepoKind(..) - , dispFlagAssignment ) -import Distribution.PackageDescription.FieldGrammar (sourceRepoFieldGrammar) + ( dispFlagAssignment ) import Distribution.Simple.Compiler ( OptimisationLevel(..), DebugInfoLevel(..) ) import Distribution.Simple.InstallDirs ( CopyDest (NoCopyDest) ) @@ -52,6 +51,7 @@ import Distribution.Simple.Setup , ConfigFlags(..), configureOptions , HaddockFlags(..), haddockOptions, defaultHaddockFlags , TestFlags(..), testOptions', defaultTestFlags + , BenchmarkFlags(..), benchmarkOptions', defaultBenchmarkFlags , programDbPaths', splitArgs ) import Distribution.Client.Setup @@ -89,6 +89,7 @@ import Distribution.Types.PackageVersionConstraint ( PackageVersionConstraint ) import qualified Data.Map as Map + ------------------------------------------------------------------ -- Representing the project config file in terms of legacy types -- @@ -105,7 +106,7 @@ import qualified Data.Map as Map data LegacyProjectConfig = LegacyProjectConfig { legacyPackages :: [String], legacyPackagesOptional :: [String], - legacyPackagesRepo :: [SourceRepo], + legacyPackagesRepo :: [SourceRepoList], legacyPackagesNamed :: [PackageVersionConstraint], legacySharedConfig :: LegacySharedConfig, @@ -125,7 +126,8 @@ data LegacyPackageConfig = LegacyPackageConfig { legacyConfigureFlags :: ConfigFlags, legacyInstallPkgFlags :: InstallFlags, legacyHaddockFlags :: HaddockFlags, - legacyTestFlags :: TestFlags + legacyTestFlags :: TestFlags, + legacyBenchmarkFlags :: BenchmarkFlags } deriving Generic instance Monoid LegacyPackageConfig where @@ -167,15 +169,16 @@ commandLineFlagsToProjectConfig :: GlobalFlags -> InstallFlags -> ClientInstallFlags -> HaddockFlags -> TestFlags + -> BenchmarkFlags -> ProjectConfig commandLineFlagsToProjectConfig globalFlags configFlags configExFlags installFlags clientInstallFlags - haddockFlags testFlags = + haddockFlags testFlags benchmarkFlags = mempty { projectConfigBuildOnly = convertLegacyBuildOnlyFlags globalFlags configFlags installFlags clientInstallFlags - haddockFlags testFlags, + haddockFlags testFlags benchmarkFlags, projectConfigShared = convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags, @@ -184,7 +187,8 @@ commandLineFlagsToProjectConfig globalFlags configFlags configExFlags } where (localConfig, allConfig) = splitConfig (convertLegacyPerPackageFlags - configFlags installFlags haddockFlags testFlags) + configFlags installFlags + haddockFlags testFlags benchmarkFlags) -- split the package config (from command line arguments) into -- those applied to all packages and those to local only. -- @@ -230,7 +234,8 @@ convertLegacyGlobalConfig savedUploadFlags = _, savedReportFlags = _, savedHaddockFlags = haddockFlags, - savedTestFlags = testFlags + savedTestFlags = testFlags, + savedBenchmarkFlags = benchmarkFlags } = mempty { projectConfigBuildOnly = configBuildOnly, @@ -245,16 +250,18 @@ convertLegacyGlobalConfig clientInstallFlags' = defaultClientInstallFlags <> clientInstallFlags haddockFlags' = defaultHaddockFlags <> haddockFlags testFlags' = defaultTestFlags <> testFlags + benchmarkFlags' = defaultBenchmarkFlags <> benchmarkFlags configAllPackages = convertLegacyPerPackageFlags - configFlags installFlags' haddockFlags' testFlags' + configFlags installFlags' + haddockFlags' testFlags' benchmarkFlags' configShared = convertLegacyAllPackageFlags globalFlags configFlags configExFlags' installFlags' configBuildOnly = convertLegacyBuildOnlyFlags globalFlags configFlags installFlags' clientInstallFlags' - haddockFlags' testFlags' + haddockFlags' testFlags' benchmarkFlags' -- | Convert the project config from the legacy types to the 'ProjectConfig' @@ -273,7 +280,7 @@ convertLegacyProjectConfig clientInstallFlags, legacyAllConfig, legacyLocalConfig = LegacyPackageConfig configFlags installPerPkgFlags - haddockFlags testFlags, + haddockFlags testFlags benchmarkFlags, legacySpecificConfig } = @@ -291,23 +298,25 @@ convertLegacyProjectConfig projectConfigSpecificPackage = fmap perPackage legacySpecificConfig } where - configAllPackages = convertLegacyPerPackageFlags g i h t - where LegacyPackageConfig g i h t = legacyAllConfig + configAllPackages = convertLegacyPerPackageFlags g i h t b + where LegacyPackageConfig g i h t b = legacyAllConfig configLocalPackages = convertLegacyPerPackageFlags configFlags installPerPkgFlags haddockFlags - testFlags + testFlags benchmarkFlags configPackagesShared= convertLegacyAllPackageFlags globalFlags (configFlags <> configShFlags) configExFlags installSharedFlags configBuildOnly = convertLegacyBuildOnlyFlags globalFlags configShFlags installSharedFlags clientInstallFlags - haddockFlags testFlags + haddockFlags testFlags benchmarkFlags perPackage (LegacyPackageConfig perPkgConfigFlags perPkgInstallFlags - perPkgHaddockFlags perPkgTestFlags) = + perPkgHaddockFlags perPkgTestFlags + perPkgBenchmarkFlags) = convertLegacyPerPackageFlags - perPkgConfigFlags perPkgInstallFlags perPkgHaddockFlags perPkgTestFlags + perPkgConfigFlags perPkgInstallFlags perPkgHaddockFlags + perPkgTestFlags perPkgBenchmarkFlags -- | Helper used by other conversion functions that returns the @@ -377,8 +386,9 @@ convertLegacyAllPackageFlags globalFlags configFlags -- 'PackageConfig' subset of the 'ProjectConfig'. -- convertLegacyPerPackageFlags :: ConfigFlags -> InstallFlags -> HaddockFlags - -> TestFlags -> PackageConfig -convertLegacyPerPackageFlags configFlags installFlags haddockFlags testFlags = + -> TestFlags -> BenchmarkFlags -> PackageConfig +convertLegacyPerPackageFlags configFlags installFlags + haddockFlags testFlags benchmarkFlags = PackageConfig{..} where ConfigFlags { @@ -453,6 +463,9 @@ convertLegacyPerPackageFlags configFlags installFlags haddockFlags testFlags = testOptions = packageConfigTestTestOptions } = testFlags + BenchmarkFlags { + benchmarkOptions = packageConfigBenchmarkOptions + } = benchmarkFlags -- | Helper used by other conversion functions that returns the @@ -461,10 +474,11 @@ convertLegacyPerPackageFlags configFlags installFlags haddockFlags testFlags = convertLegacyBuildOnlyFlags :: GlobalFlags -> ConfigFlags -> InstallFlags -> ClientInstallFlags -> HaddockFlags -> TestFlags + -> BenchmarkFlags -> ProjectConfigBuildOnly convertLegacyBuildOnlyFlags globalFlags configFlags installFlags clientInstallFlags - haddockFlags _ = + haddockFlags _ _ = ProjectConfigBuildOnly{..} where projectConfigClientInstallFlags = clientInstallFlags @@ -629,7 +643,8 @@ convertToLegacyAllPackageConfig legacyConfigureFlags = configFlags, legacyInstallPkgFlags= mempty, legacyHaddockFlags = haddockFlags, - legacyTestFlags = mempty + legacyTestFlags = mempty, + legacyBenchmarkFlags = mempty } where configFlags = ConfigFlags { @@ -700,7 +715,8 @@ convertToLegacyPerPackageConfig PackageConfig {..} = legacyConfigureFlags = configFlags, legacyInstallPkgFlags = installFlags, legacyHaddockFlags = haddockFlags, - legacyTestFlags = testFlags + legacyTestFlags = testFlags, + legacyBenchmarkFlags = benchmarkFlags } where configFlags = ConfigFlags { @@ -801,6 +817,11 @@ convertToLegacyPerPackageConfig PackageConfig {..} = testOptions = packageConfigTestTestOptions } + benchmarkFlags = BenchmarkFlags { + benchmarkDistPref = mempty, + benchmarkVerbosity = mempty, + benchmarkOptions = packageConfigBenchmarkOptions + } ------------------------------------------------ -- Parsing and showing the project config file @@ -1098,6 +1119,20 @@ legacyPackageConfigFieldDescrs = , "fail-when-no-test-suites", "test-wrapper" ] . commandOptionsToFields ) (testOptions' ParseArgs) + ++ + ( liftFields + legacyBenchmarkFlags + (\flags conf -> conf { legacyBenchmarkFlags = flags }) + . addFields + [ newLineListField "benchmark-options" + (showTokenQ . fromPathTemplate) (fmap toPathTemplate parseTokenQ) + benchmarkOptions + (\v conf -> conf { benchmarkOptions = v }) + ] + . filterFields + [] + . commandOptionsToFields + ) (benchmarkOptions' ParseArgs) where @@ -1194,7 +1229,7 @@ legacyPackageConfigSectionDescrs = packageRepoSectionDescr :: FGSectionDescr LegacyProjectConfig packageRepoSectionDescr = FGSectionDescr { fgSectionName = "source-repository-package" - , fgSectionGrammar = sourceRepoFieldGrammar (RepoKindUnknown "unused") + , fgSectionGrammar = sourceRepositoryPackageGrammar , fgSectionGet = map (\x->("", x)) . legacyPackagesRepo , fgSectionSet = \lineno unused pkgrepo projconf -> do @@ -1386,7 +1421,7 @@ remoteRepoSectionDescr = -- -- | Parser combinator for simple fields which uses the field type's --- 'Monoid' instance for combining multiple occurences of the field. +-- 'Monoid' instance for combining multiple occurrences of the field. monoidField :: Monoid a => String -> (a -> Doc) -> ReadP a a -> (b -> a) -> (a -> b -> b) -> FieldDescr b monoidField name showF readF get' set = diff --git a/cabal/cabal-install/Distribution/Client/ProjectConfig/Types.hs b/cabal/cabal-install/Distribution/Client/ProjectConfig/Types.hs index 7472102..7ac007c 100644 --- a/cabal/cabal-install/Distribution/Client/ProjectConfig/Types.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectConfig/Types.hs @@ -29,6 +29,7 @@ import Distribution.Client.Targets ( UserConstraint ) import Distribution.Client.BuildReports.Types ( ReportLevel(..) ) +import Distribution.Client.SourceRepo (SourceRepoList) import Distribution.Client.IndexUtils.Timestamp ( IndexState ) @@ -48,7 +49,7 @@ import Distribution.Version import Distribution.System ( Platform ) import Distribution.PackageDescription - ( FlagAssignment, SourceRepo(..) ) + ( FlagAssignment ) import Distribution.Simple.Compiler ( Compiler, CompilerFlavor , OptimisationLevel(..), ProfDetailLevel, DebugInfoLevel(..) ) @@ -107,7 +108,7 @@ data ProjectConfig projectPackagesOptional :: [String], -- | Packages in this project from remote source repositories. - projectPackagesRepo :: [SourceRepo], + projectPackagesRepo :: [SourceRepoList], -- | Packages in this project from hackage repositories. projectPackagesNamed :: [PackageVersionConstraint], @@ -293,7 +294,9 @@ data PackageConfig packageConfigTestKeepTix :: Flag Bool, packageConfigTestWrapper :: Flag FilePath, packageConfigTestFailWhenNoTestSuites :: Flag Bool, - packageConfigTestTestOptions :: [PathTemplate] + packageConfigTestTestOptions :: [PathTemplate], + -- Benchmark options + packageConfigBenchmarkOptions :: [PathTemplate] } deriving (Eq, Show, Generic) diff --git a/cabal/cabal-install/Distribution/Client/ProjectOrchestration.hs b/cabal/cabal-install/Distribution/Client/ProjectOrchestration.hs index 5c35118..ff29954 100644 --- a/cabal/cabal-install/Distribution/Client/ProjectOrchestration.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectOrchestration.hs @@ -159,6 +159,7 @@ import Distribution.Simple.Compiler , OptimisationLevel(..)) import qualified Data.Monoid as Mon +import qualified Data.List.NonEmpty as NE import qualified Data.Set as Set import qualified Data.Map as Map import Data.Either @@ -512,6 +513,7 @@ resolveTargets :: forall err. resolveTargets selectPackageTargets selectComponentTarget liftProblem installPlan mPkgDb = fmap mkTargetsMap + . either (Left . toList) Right . checkErrors . map (\ts -> (,) ts <$> checkTarget ts) where @@ -609,12 +611,12 @@ resolveTargets selectPackageTargets selectComponentTarget liftProblem -> [AvailableTarget k] -> Either err [k] selectComponentTargets subtarget = - either (Left . head) Right + either (Left . NE.head) Right . checkErrors . map (selectComponentTarget subtarget) - checkErrors :: [Either e a] -> Either [e] [a] - checkErrors = (\(es, xs) -> if null es then Right xs else Left es) + checkErrors :: [Either e a] -> Either (NonEmpty e) [a] + checkErrors = (\(es, xs) -> case es of { [] -> Right xs; (e:es') -> Left (e:|es') }) . partitionEithers diff --git a/cabal/cabal-install/Distribution/Client/ProjectPlanOutput.hs b/cabal/cabal-install/Distribution/Client/ProjectPlanOutput.hs index ce866b0..aa94a51 100644 --- a/cabal/cabal-install/Distribution/Client/ProjectPlanOutput.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectPlanOutput.hs @@ -20,6 +20,7 @@ import Distribution.Client.ProjectBuilding.Types import Distribution.Client.DistDirLayout import Distribution.Client.Types (Repo(..), RemoteRepo(..), PackageLocation(..), confInstId) import Distribution.Client.PackageHash (showHashValue, hashValue) +import Distribution.Client.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..)) import qualified Distribution.Client.InstallPlan as InstallPlan import qualified Distribution.Client.Utils.Json as J @@ -52,7 +53,6 @@ import Prelude () import Distribution.Client.Compat.Prelude import qualified Data.Map as Map -import Data.Set (Set) import qualified Data.Set as Set import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Builder as BB @@ -212,15 +212,14 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig = , "uri" J..= J.String (show (remoteRepoURI repoRemote)) ] - sourceRepoToJ :: PD.SourceRepo -> J.Value - sourceRepoToJ PD.SourceRepo{..} = + sourceRepoToJ :: SourceRepoMaybe -> J.Value + sourceRepoToJ SourceRepositoryPackage{..} = J.object $ filter ((/= J.Null) . snd) $ - [ "type" J..= fmap jdisplay repoType - , "location" J..= fmap J.String repoLocation - , "module" J..= fmap J.String repoModule - , "branch" J..= fmap J.String repoBranch - , "tag" J..= fmap J.String repoTag - , "subdir" J..= fmap J.String repoSubdir + [ "type" J..= jdisplay srpType + , "location" J..= J.String srpLocation + , "branch" J..= fmap J.String srpBranch + , "tag" J..= fmap J.String srpTag + , "subdir" J..= fmap J.String srpSubdir ] dist_dir = distBuildDirectory distDirLayout diff --git a/cabal/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal/cabal-install/Distribution/Client/ProjectPlanning.hs index a0a6b18..13b6fc7 100644 --- a/cabal/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -160,7 +160,6 @@ import Distribution.Compat.Graph(IsNode(..)) import Text.PrettyPrint hiding ((<>)) import qualified Text.PrettyPrint as Disp import qualified Data.Map as Map -import Data.Set (Set) import qualified Data.Set as Set import Control.Monad import qualified Data.Traversable as T @@ -650,7 +649,12 @@ rebuildInstallPlan verbosity projectConfigAllPackages projectConfigLocalPackages (getMapMappend projectConfigSpecificPackage) - let instantiatedPlan = instantiateInstallPlan elaboratedPlan + let instantiatedPlan + = instantiateInstallPlan + cabalStoreDirLayout + defaultInstallDirs + elaboratedShared + elaboratedPlan liftIO $ debugNoWrap verbosity (InstallPlan.showInstallPlan instantiatedPlan) return (instantiatedPlan, elaboratedShared) where @@ -1077,6 +1081,7 @@ planPackages verbosity comp platform solver SolverSettings{..} -- respective major Cabal version bundled with the respective GHC -- release). -- + -- GHC 8.8 needs Cabal >= 3.0 -- GHC 8.6 needs Cabal >= 2.4 -- GHC 8.4 needs Cabal >= 2.2 -- GHC 8.2 needs Cabal >= 2.0 @@ -1089,11 +1094,8 @@ planPackages verbosity comp platform solver SolverSettings{..} -- TODO: long-term, this compatibility matrix should be -- stored as a field inside 'Distribution.Compiler.Compiler' setupMinCabalVersionConstraint - | isGHC, compVer >= mkVersion [8,6,1] = mkVersion [2,4] - -- GHC 8.6alpha2 (GHC 8.6.0.20180714) still shipped with a - -- devel snapshot of Cabal-2.3.0.0; the rule below can be - -- dropped at some point - | isGHC, compVer >= mkVersion [8,6] = mkVersion [2,3] + | isGHC, compVer >= mkVersion [8,8] = mkVersion [3,0] + | isGHC, compVer >= mkVersion [8,6] = mkVersion [2,4] | isGHC, compVer >= mkVersion [8,4] = mkVersion [2,2] | isGHC, compVer >= mkVersion [8,2] = mkVersion [2,0] | isGHC, compVer >= mkVersion [8,0] = mkVersion [1,24] @@ -1481,7 +1483,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB -- 5. Construct the final ElaboratedConfiguredPackage let - elab = elab1 { + elab2 = elab1 { elabModuleShape = lc_shape lc, elabUnitId = abstractUnitId (lc_uid lc), elabComponentId = lc_cid lc, @@ -1491,8 +1493,14 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB compOrderLibDependencies = ordNub (map (abstractUnitId . ci_id) (lc_includes lc ++ lc_sig_includes lc)) - }, - elabInstallDirs = install_dirs cid + } + } + elab = elab2 { + elabInstallDirs = computeInstallDirs + storeDirLayout + defaultInstallDirs + elaboratedSharedConfig + elab2 } -- 6. Construct the updated local maps @@ -1548,31 +1556,6 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB | PkgconfigDependency pn _ <- PD.pkgconfigDepends (Cabal.componentBuildInfo comp) ] - install_dirs cid - | shouldBuildInplaceOnly spkg - -- use the ordinary default install dirs - = (InstallDirs.absoluteInstallDirs - pkgid - (newSimpleUnitId cid) - (compilerInfo compiler) - InstallDirs.NoCopyDest - platform - defaultInstallDirs) { - - -- absoluteInstallDirs sets these as 'undefined' but we have - -- to use them as "Setup.hs configure" args - InstallDirs.libsubdir = "", - InstallDirs.libexecsubdir = "", - InstallDirs.datasubdir = "" - } - - | otherwise - -- use special simplified install dirs - = storePackageInstallDirs - storeDirLayout - (compilerId compiler) - cid - inplace_bin_dir elab = binDirectoryFor distDirLayout @@ -1634,14 +1617,20 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB elab where elab0@ElaboratedConfiguredPackage{..} = elaborateSolverToCommon pkg - elab = elab0 { + elab1 = elab0 { elabUnitId = newSimpleUnitId pkgInstalledId, elabComponentId = pkgInstalledId, elabLinkedInstantiatedWith = Map.empty, - elabInstallDirs = install_dirs, elabPkgOrComp = ElabPackage $ ElaboratedPackage {..}, elabModuleShape = modShape } + elab = elab1 { + elabInstallDirs = + computeInstallDirs storeDirLayout + defaultInstallDirs + elaboratedSharedConfig + elab1 + } modShape = case find (matchElabPkg (== (CLibName LMainLibName))) comps of Nothing -> emptyModuleShape @@ -1704,31 +1693,6 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB -- pkgStanzasEnabled is a superset of elabStanzasRequested pkgStanzasEnabled = Map.keysSet (Map.filter (id :: Bool -> Bool) elabStanzasRequested) - install_dirs - | shouldBuildInplaceOnly pkg - -- use the ordinary default install dirs - = (InstallDirs.absoluteInstallDirs - pkgid - (newSimpleUnitId pkgInstalledId) - (compilerInfo compiler) - InstallDirs.NoCopyDest - platform - defaultInstallDirs) { - - -- absoluteInstallDirs sets these as 'undefined' but we have to - -- use them as "Setup.hs configure" args - InstallDirs.libsubdir = "", - InstallDirs.libexecsubdir = "", - InstallDirs.datasubdir = "" - } - - | otherwise - -- use special simplified install dirs - = storePackageInstallDirs - storeDirLayout - (compilerId compiler) - pkgInstalledId - elaborateSolverToCommon :: SolverPackage UnresolvedPkgLoc -> ElaboratedConfiguredPackage elaborateSolverToCommon @@ -1887,6 +1851,8 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB elabTestFailWhenNoTestSuites = perPkgOptionFlag pkgid False packageConfigTestFailWhenNoTestSuites elabTestTestOptions = perPkgOptionList pkgid packageConfigTestTestOptions + elabBenchmarkOptions = perPkgOptionList pkgid packageConfigBenchmarkOptions + perPkgOptionFlag :: PackageId -> a -> (PackageConfig -> Flag a) -> a perPkgOptionMaybe :: PackageId -> (PackageConfig -> Flag a) -> Maybe a perPkgOptionList :: PackageId -> (PackageConfig -> [a]) -> [a] @@ -2153,8 +2119,8 @@ getComponentId (InstallPlan.PreExisting dipkg) = IPI.installedComponentId dipkg getComponentId (InstallPlan.Configured elab) = elabComponentId elab getComponentId (InstallPlan.Installed elab) = elabComponentId elab -instantiateInstallPlan :: ElaboratedInstallPlan -> ElaboratedInstallPlan -instantiateInstallPlan plan = +instantiateInstallPlan :: StoreDirLayout -> InstallDirs.InstallDirTemplates -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> ElaboratedInstallPlan +instantiateInstallPlan storeDirLayout defaultInstallDirs elaboratedShared plan = InstallPlan.new (IndependentGoals False) (Graph.fromDistinctList (Map.elems ready_map)) where @@ -2182,12 +2148,12 @@ instantiateInstallPlan plan = instantiateComponent uid cid insts | Just planpkg <- Map.lookup cid cmap = case planpkg of - InstallPlan.Configured (elab@ElaboratedConfiguredPackage + InstallPlan.Configured (elab0@ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp }) -> do deps <- mapM (substUnitId insts) (compLinkedLibDependencies comp) let getDep (Module dep_uid _) = [dep_uid] - return $ InstallPlan.Configured elab { + elab1 = elab0 { elabUnitId = uid, elabComponentId = cid, elabInstantiatedWith = insts, @@ -2198,7 +2164,14 @@ instantiateInstallPlan plan = ordNub (map unDefUnitId (deps ++ concatMap getDep (Map.elems insts))) } - } + } + elab = elab1 { + elabInstallDirs = computeInstallDirs storeDirLayout + defaultInstallDirs + elaboratedShared + elab1 + } + return $ InstallPlan.Configured elab _ -> return planpkg | otherwise = error ("instantiateComponent: " ++ display cid) @@ -3256,6 +3229,38 @@ storePackageInstallDirs' StoreDirLayout{ storePackageDirectory sysconfdir = prefix </> "etc" + +computeInstallDirs :: StoreDirLayout + -> InstallDirs.InstallDirTemplates + -> ElaboratedSharedConfig + -> ElaboratedConfiguredPackage + -> InstallDirs.InstallDirs FilePath +computeInstallDirs storeDirLayout defaultInstallDirs elaboratedShared elab + | elabBuildStyle elab == BuildInplaceOnly + -- use the ordinary default install dirs + = (InstallDirs.absoluteInstallDirs + (elabPkgSourceId elab) + (elabUnitId elab) + (compilerInfo (pkgConfigCompiler elaboratedShared)) + InstallDirs.NoCopyDest + (pkgConfigPlatform elaboratedShared) + defaultInstallDirs) { + + -- absoluteInstallDirs sets these as 'undefined' but we have + -- to use them as "Setup.hs configure" args + InstallDirs.libsubdir = "", + InstallDirs.libexecsubdir = "", + InstallDirs.datasubdir = "" + } + + | otherwise + -- use special simplified install dirs + = storePackageInstallDirs' + storeDirLayout + (compilerId (pkgConfigCompiler elaboratedShared)) + (elabUnitId elab) + + --TODO: [code cleanup] perhaps reorder this code -- based on the ElaboratedInstallPlan + ElaboratedSharedConfig, -- make the various Setup.hs {configure,build,copy} flags @@ -3459,10 +3464,10 @@ setupHsBenchFlags :: ElaboratedConfiguredPackage -> Verbosity -> FilePath -> Cabal.BenchmarkFlags -setupHsBenchFlags _ _ verbosity builddir = Cabal.BenchmarkFlags +setupHsBenchFlags (ElaboratedConfiguredPackage{..}) _ verbosity builddir = Cabal.BenchmarkFlags { benchmarkDistPref = toFlag builddir , benchmarkVerbosity = toFlag verbosity - , benchmarkOptions = mempty + , benchmarkOptions = elabBenchmarkOptions } setupHsBenchArgs :: ElaboratedConfiguredPackage -> [String] diff --git a/cabal/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal/cabal-install/Distribution/Client/ProjectPlanning/Types.hs index af2ed74..db0c402 100644 --- a/cabal/cabal-install/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectPlanning/Types.hs @@ -297,6 +297,8 @@ data ElaboratedConfiguredPackage elabTestFailWhenNoTestSuites :: Bool, elabTestTestOptions :: [PathTemplate], + elabBenchmarkOptions :: [PathTemplate], + -- Setup.hs related things: -- | One of four modes for how we build and interact with the Setup.hs diff --git a/cabal/cabal-install/Distribution/Client/Sandbox.hs b/cabal/cabal-install/Distribution/Client/Sandbox.hs index 07cd9de..66b415d 100644 --- a/cabal/cabal-install/Distribution/Client/Sandbox.hs +++ b/cabal/cabal-install/Distribution/Client/Sandbox.hs @@ -44,6 +44,7 @@ module Distribution.Client.Sandbox ( import Prelude () import Distribution.Client.Compat.Prelude +import Distribution.Utils.Generic(safeLast) import Distribution.Client.Setup ( SandboxFlags(..), ConfigFlags(..), ConfigExFlags(..), InstallFlags(..) @@ -91,7 +92,7 @@ import qualified Distribution.Simple.LocalBuildInfo as LocalBuildInfo import Distribution.Simple.PreProcess ( knownSuffixHandlers ) import Distribution.Simple.Program ( ProgramDb ) import Distribution.Simple.Setup ( Flag(..), HaddockFlags(..) - , emptyTestFlags + , emptyTestFlags, emptyBenchmarkFlags , fromFlagOrDefault, flagToMaybe ) import Distribution.Simple.SrcDist ( prepareTree ) import Distribution.Simple.Utils ( die', debug, notice, info, warn @@ -216,10 +217,10 @@ tryGetIndexFilePath verbosity config = tryGetIndexFilePath' verbosity (savedGlob tryGetIndexFilePath' :: Verbosity -> GlobalFlags -> IO FilePath tryGetIndexFilePath' verbosity globalFlags = do let paths = fromNubList $ globalLocalRepos globalFlags - case paths of - [] -> die' verbosity $ "Distribution.Client.Sandbox.tryGetIndexFilePath: " ++ + case safeLast paths of + Nothing -> die' verbosity $ "Distribution.Client.Sandbox.tryGetIndexFilePath: " ++ "no local repos found. " ++ checkConfiguration - _ -> return $ (last paths) </> Index.defaultIndexFileName + Just lp -> return $ lp </> Index.defaultIndexFileName where checkConfiguration = "Please check your configuration ('" ++ userPackageEnvironmentFile ++ "')." @@ -685,7 +686,7 @@ reinstallAddSourceDeps verbosity configFlags' configExFlags ,comp, platform, progdb ,UseSandbox sandboxDir, Just sandboxPkgInfo ,globalFlags, configFlags, configExFlags, installFlags - ,haddockFlags, emptyTestFlags) + ,haddockFlags, emptyTestFlags, emptyBenchmarkFlags) -- This can actually be replaced by a call to 'install', but we use a -- lower-level API because of layer separation reasons. Additionally, we diff --git a/cabal/cabal-install/Distribution/Client/Security/HTTP.hs b/cabal/cabal-install/Distribution/Client/Security/HTTP.hs index f9c8bb9..3002657 100644 --- a/cabal/cabal-install/Distribution/Client/Security/HTTP.hs +++ b/cabal/cabal-install/Distribution/Client/Security/HTTP.hs @@ -35,7 +35,6 @@ import Hackage.Security.Client import Hackage.Security.Client.Repository.HttpLib import Hackage.Security.Util.Checked import Hackage.Security.Util.Pretty -import qualified Hackage.Security.Util.Lens as Lens {------------------------------------------------------------------------------- 'HttpLib' implementation @@ -142,7 +141,14 @@ mkReqHeaders reqHeaders mRange = concat [ finalize (name, strs) = [HTTP.Header name (intercalate ", " (reverse strs))] insert :: Eq a => a -> [b] -> [(a, [b])] -> [(a, [b])] - insert x y = Lens.modify (Lens.lookupM x) (++ y) + insert x y = modifyAssocList x (++ y) + + -- modify the first maching element + modifyAssocList :: Eq a => a -> (b -> b) -> [(a, b)] -> [(a, b)] + modifyAssocList a f = go where + go [] = [] + go (p@(a', b) : xs) | a == a' = (a', f b) : xs + | otherwise = p : go xs {------------------------------------------------------------------------------- Custom exceptions diff --git a/cabal/cabal-install/Distribution/Client/Setup.hs b/cabal/cabal-install/Distribution/Client/Setup.hs index eb5330d..b6de0f2 100644 --- a/cabal/cabal-install/Distribution/Client/Setup.hs +++ b/cabal/cabal-install/Distribution/Client/Setup.hs @@ -23,7 +23,7 @@ module Distribution.Client.Setup , configureExCommand, ConfigExFlags(..), defaultConfigExFlags , buildCommand, BuildFlags(..), BuildExFlags(..), SkipAddSourceDepsCheck(..) , filterTestFlags - , replCommand, testCommand, benchmarkCommand, testOptions + , replCommand, testCommand, benchmarkCommand, testOptions, benchmarkOptions , configureExOptions, reconfigureCommand , installCommand, InstallFlags(..), installOptions, defaultInstallFlags , filterHaddockArgs, filterHaddockFlags, haddockOptions @@ -101,7 +101,7 @@ import Distribution.Simple.Configure import qualified Distribution.Simple.Setup as Cabal import Distribution.Simple.Setup ( ConfigFlags(..), BuildFlags(..), ReplFlags - , TestFlags, BenchmarkFlags(..) + , TestFlags, BenchmarkFlags , SDistFlags(..), HaddockFlags(..) , CleanFlags(..), DoctestFlags(..) , CopyFlags(..), RegisterFlags(..) @@ -1367,13 +1367,15 @@ updateCommand = CommandUI { -- * Other commands -- ------------------------------------------------------------ -upgradeCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +upgradeCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags + ) upgradeCommand = configureCommand { commandName = "upgrade", commandSynopsis = "(command disabled, use install instead)", commandDescription = Nothing, commandUsage = usageFlagsOrPackages "upgrade", - commandDefaultFlags = (mempty, mempty, mempty, mempty, mempty), + commandDefaultFlags = (mempty, mempty, mempty, mempty, mempty, mempty), commandOptions = commandOptions installCommand } @@ -1830,7 +1832,9 @@ defaultSolver = AlwaysModular allSolvers :: String allSolvers = intercalate ", " (map display ([minBound .. maxBound] :: [PreSolver])) -installCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +installCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags + ) installCommand = CommandUI { commandName = "install", commandSynopsis = "Install packages.", @@ -1883,7 +1887,7 @@ installCommand = CommandUI { ++ " " ++ (map (const ' ') pname) ++ " " ++ " Change installation destination\n", - commandDefaultFlags = (mempty, mempty, mempty, mempty, mempty), + commandDefaultFlags = (mempty, mempty, mempty, mempty, mempty, mempty), commandOptions = \showOrParseArgs -> liftOptions get1 set1 -- Note: [Hidden Flags] @@ -1902,13 +1906,15 @@ installCommand = CommandUI { installOptions showOrParseArgs) ++ liftOptions get4 set4 (haddockOptions showOrParseArgs) ++ liftOptions get5 set5 (testOptions showOrParseArgs) + ++ liftOptions get6 set6 (benchmarkOptions showOrParseArgs) } where - get1 (a,_,_,_,_) = a; set1 a (_,b,c,d,e) = (a,b,c,d,e) - get2 (_,b,_,_,_) = b; set2 b (a,_,c,d,e) = (a,b,c,d,e) - get3 (_,_,c,_,_) = c; set3 c (a,b,_,d,e) = (a,b,c,d,e) - get4 (_,_,_,d,_) = d; set4 d (a,b,c,_,e) = (a,b,c,d,e) - get5 (_,_,_,_,e) = e; set5 e (a,b,c,d,_) = (a,b,c,d,e) + get1 (a,_,_,_,_,_) = a; set1 a (_,b,c,d,e,f) = (a,b,c,d,e,f) + get2 (_,b,_,_,_,_) = b; set2 b (a,_,c,d,e,f) = (a,b,c,d,e,f) + get3 (_,_,c,_,_,_) = c; set3 c (a,b,_,d,e,f) = (a,b,c,d,e,f) + get4 (_,_,_,d,_,_) = d; set4 d (a,b,c,_,e,f) = (a,b,c,d,e,f) + get5 (_,_,_,_,e,_) = e; set5 e (a,b,c,d,_,f) = (a,b,c,d,e,f) + get6 (_,_,_,_,_,f) = f; set6 f (a,b,c,d,e,_) = (a,b,c,d,e,f) haddockCommand :: CommandUI HaddockFlags haddockCommand = Cabal.haddockCommand @@ -1968,6 +1974,19 @@ testOptions showOrParseArgs prefixTest name | "test-" `isPrefixOf` name = name | otherwise = "test-" ++ name +benchmarkOptions :: ShowOrParseArgs -> [OptionField BenchmarkFlags] +benchmarkOptions showOrParseArgs + = [ opt { optionName = prefixBenchmark name, + optionDescr = [ fmapOptFlags (\(_, lflags) -> ([], map prefixBenchmark lflags)) descr + | descr <- optionDescr opt] } + | opt <- commandOptions Cabal.benchmarkCommand showOrParseArgs + , let name = optionName opt + , name `elem` ["benchmark-options", "benchmark-option"] + ] + where + prefixBenchmark name | "benchmark-" `isPrefixOf` name = name + | otherwise = "benchmark-" ++ name + fmapOptFlags :: (OptFlags -> OptFlags) -> OptDescr a -> OptDescr a fmapOptFlags modify (ReqArg d f p r w) = ReqArg d (modify f) p r w fmapOptFlags modify (OptArg d f p r i w) = OptArg d (modify f) p r i w @@ -2230,17 +2249,17 @@ defaultInitFlags = emptyInitFlags { IT.initVerbosity = toFlag normal } initCommand :: CommandUI IT.InitFlags initCommand = CommandUI { commandName = "init", - commandSynopsis = "Create a new .cabal package file (interactively).", + commandSynopsis = "Create a new .cabal package file.", commandDescription = Just $ \_ -> wrapText $ - "Cabalise a project by creating a .cabal, Setup.hs, and " - ++ "optionally a LICENSE file.\n" + "Create a .cabal, Setup.hs, and optionally a LICENSE file.\n" ++ "\n" - ++ "Calling init with no arguments (recommended) uses an " - ++ "interactive mode, which will try to guess as much as " - ++ "possible and prompt you for the rest. Command-line " - ++ "arguments are provided for scripting purposes. " - ++ "If you don't want interactive mode, be sure to pass " - ++ "the -n flag.\n", + ++ "Calling init with no arguments creates an executable, " + ++ "guessing as many options as possible. The interactive " + ++ "mode can be invoked by the -i/--interactive flag, which " + ++ "will try to guess as much as possible and prompt you for " + ++ "the rest. You can change init to always be interactive by " + ++ "setting the interactive flag in your configuration file. " + ++ "Command-line arguments are provided for scripting purposes.\n", commandNotes = Nothing, commandUsage = \pname -> "Usage: " ++ pname ++ " init [FLAGS]\n", diff --git a/cabal/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal/cabal-install/Distribution/Client/SetupWrapper.hs index d422a2f..79dccc6 100644 --- a/cabal/cabal-install/Distribution/Client/SetupWrapper.hs +++ b/cabal/cabal-install/Distribution/Client/SetupWrapper.hs @@ -81,6 +81,8 @@ import Distribution.Client.JobControl ( Lock, criticalSection ) import Distribution.Simple.Setup ( Flag(..) ) +import Distribution.Utils.Generic + ( safeHead ) import Distribution.Simple.Utils ( die', debug, info, infoNoWrap , cabalVersion, tryFindPackageDesc, comparing @@ -726,7 +728,8 @@ getExternalSetupMethod verbosity options pkg bt = do ++ "' requires Cabal library version " ++ display (useCabalVersion options) ++ " but no suitable version is installed." - pkgs -> let ipkginfo = head . snd . bestVersion fst $ pkgs + pkgs -> let ipkginfo = fromMaybe err $ safeHead . snd . bestVersion fst $ pkgs + err = error "Distribution.Client.installedCabalVersion: empty version list" in return (packageVersion ipkginfo ,Just . IPI.installedComponentId $ ipkginfo, options'') diff --git a/cabal/cabal-install/Distribution/Client/SolverInstallPlan.hs b/cabal/cabal-install/Distribution/Client/SolverInstallPlan.hs index 6a009fa..3eaf620 100644 --- a/cabal/cabal-install/Distribution/Client/SolverInstallPlan.hs +++ b/cabal/cabal-install/Distribution/Client/SolverInstallPlan.hs @@ -73,6 +73,7 @@ import Data.Maybe ( fromMaybe, mapMaybe ) import Distribution.Compat.Binary (Binary(..)) import Distribution.Compat.Graph (Graph, IsNode(..)) +import qualified Data.Foldable as Foldable import qualified Data.Graph as OldGraph import qualified Distribution.Compat.Graph as Graph import qualified Data.Map as Map @@ -144,7 +145,7 @@ new indepGoals index = probs -> Left probs toList :: SolverInstallPlan -> [SolverPlanPackage] -toList = Graph.toList . planIndex +toList = Foldable.toList . planIndex toMap :: SolverInstallPlan -> Map SolverId SolverPlanPackage toMap = Graph.toMap . planIndex @@ -239,7 +240,7 @@ problems indepGoals index = dependencyInconsistencies indepGoals index ] ++ [ PackageStateInvalid pkg pkg' - | pkg <- Graph.toList index + | pkg <- Foldable.toList index , Just pkg' <- map (flip Graph.lookup index) (nodeNeighbors pkg) , not (stateDependencyRelation pkg pkg') ] @@ -316,7 +317,7 @@ libraryRoots index = setupRoots :: SolverPlanIndex -> [[SolverId]] setupRoots = filter (not . null) . map (CD.setupDeps . resolverPackageLibDeps) - . Graph.toList + . Foldable.toList -- | Given a package index where we assume we want to use all the packages -- (use 'dependencyClosure' if you need to get such a index subset) find out @@ -345,7 +346,7 @@ dependencyInconsistencies' index = inverseIndex = Map.fromListWith (Map.unionWith (\(a,b) (_,b') -> (a,b++b'))) [ (packageName dep, Map.fromList [(sid,(dep,[packageId pkg]))]) | -- For each package @pkg@ - pkg <- Graph.toList index + pkg <- Foldable.toList index -- Find out which @sid@ @pkg@ depends on , sid <- CD.nonSetupDeps (resolverPackageLibDeps pkg) -- And look up those @sid@ (i.e., @sid@ is the ID of @dep@) diff --git a/cabal/cabal-install/Distribution/Client/SourceRepo.hs b/cabal/cabal-install/Distribution/Client/SourceRepo.hs new file mode 100644 index 0000000..ac8e91b --- /dev/null +++ b/cabal/cabal-install/Distribution/Client/SourceRepo.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +module Distribution.Client.SourceRepo where + +import Distribution.Client.Compat.Prelude +import Prelude () +import Distribution.Compat.Lens (Lens, Lens') + +import Distribution.Types.SourceRepo + ( RepoType(..)) +import Distribution.FieldGrammar (FieldGrammar, ParsecFieldGrammar', PrettyFieldGrammar', uniqueField, uniqueFieldAla, optionalFieldAla, monoidalFieldAla) +import Distribution.Parsec.Newtypes (Token (..), FilePathNT (..), alaList', NoCommaFSep (..)) + +-- | @source-repository-package@ definition +-- +data SourceRepositoryPackage f = SourceRepositoryPackage + { srpType :: !RepoType + , srpLocation :: !String + , srpTag :: !(Maybe String) + , srpBranch :: !(Maybe String) + , srpSubdir :: !(f FilePath) + } + deriving (Generic) + +deriving instance (Eq (f FilePath)) => Eq (SourceRepositoryPackage f) +deriving instance (Ord (f FilePath)) => Ord (SourceRepositoryPackage f) +deriving instance (Show (f FilePath)) => Show (SourceRepositoryPackage f) +deriving instance (Binary (f FilePath)) => Binary (SourceRepositoryPackage f) + +-- | Read from @cabal.project@ +type SourceRepoList = SourceRepositoryPackage [] + +-- | Distilled from 'Distribution.Types.SourceRepo.SourceRepo' +type SourceRepoMaybe = SourceRepositoryPackage Maybe + +-- | 'SourceRepositoryPackage' without subdir. Used in clone errors. Cloning doesn't care about subdirectory. +type SourceRepoProxy = SourceRepositoryPackage Proxy + +srpHoist :: (forall x. f x -> g x) -> SourceRepositoryPackage f -> SourceRepositoryPackage g +srpHoist nt s = s { srpSubdir = nt (srpSubdir s) } + +srpToProxy :: SourceRepositoryPackage f -> SourceRepositoryPackage Proxy +srpToProxy s = s { srpSubdir = Proxy } + +-- | Split single @source-repository-package@ declaration with multiple subdirs, +-- into multiple ones with at most single subdir. +srpFanOut :: SourceRepositoryPackage [] -> NonEmpty (SourceRepositoryPackage Maybe) +srpFanOut s@SourceRepositoryPackage { srpSubdir = [] } = + s { srpSubdir = Nothing } :| [] +srpFanOut s@SourceRepositoryPackage { srpSubdir = d:ds } = f d :| map f ds where + f subdir = s { srpSubdir = Just subdir } + +------------------------------------------------------------------------------- +-- Lens +------------------------------------------------------------------------------- + +srpTypeLens :: Lens' (SourceRepositoryPackage f) RepoType +srpTypeLens f s = fmap (\x -> s { srpType = x }) (f (srpType s)) +{-# INLINE srpTypeLens #-} + +srpLocationLens :: Lens' (SourceRepositoryPackage f) String +srpLocationLens f s = fmap (\x -> s { srpLocation = x }) (f (srpLocation s)) +{-# INLINE srpLocationLens #-} + +srpTagLens :: Lens' (SourceRepositoryPackage f) (Maybe String) +srpTagLens f s = fmap (\x -> s { srpTag = x }) (f (srpTag s)) +{-# INLINE srpTagLens #-} + +srpBranchLens :: Lens' (SourceRepositoryPackage f) (Maybe String) +srpBranchLens f s = fmap (\x -> s { srpBranch = x }) (f (srpBranch s)) +{-# INLINE srpBranchLens #-} + +srpSubdirLens :: Lens (SourceRepositoryPackage f) (SourceRepositoryPackage g) (f FilePath) (g FilePath) +srpSubdirLens f s = fmap (\x -> s { srpSubdir = x }) (f (srpSubdir s)) +{-# INLINE srpSubdirLens #-} + +------------------------------------------------------------------------------- +-- Parser & PPrinter +------------------------------------------------------------------------------- + +sourceRepositoryPackageGrammar + :: (FieldGrammar g, Applicative (g SourceRepoList)) + => g SourceRepoList SourceRepoList +sourceRepositoryPackageGrammar = SourceRepositoryPackage + <$> uniqueField "type" srpTypeLens + <*> uniqueFieldAla "location" Token srpLocationLens + <*> optionalFieldAla "tag" Token srpTagLens + <*> optionalFieldAla "branch" Token srpBranchLens + <*> monoidalFieldAla "subdir" (alaList' NoCommaFSep FilePathNT) srpSubdirLens -- note: NoCommaFSep is somewhat important for roundtrip, as "." is there... +{-# SPECIALIZE sourceRepositoryPackageGrammar :: ParsecFieldGrammar' SourceRepoList #-} +{-# SPECIALIZE sourceRepositoryPackageGrammar :: PrettyFieldGrammar' SourceRepoList #-} diff --git a/cabal/cabal-install/Distribution/Client/SourceRepoParse.hs b/cabal/cabal-install/Distribution/Client/SourceRepoParse.hs deleted file mode 100644 index dcdb3ef..0000000 --- a/cabal/cabal-install/Distribution/Client/SourceRepoParse.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Distribution.Client.SourceRepoParse where - -import Distribution.Client.Compat.Prelude -import Prelude () - -import Distribution.Deprecated.ParseUtils (FieldDescr (..), syntaxError) -import Distribution.FieldGrammar.FieldDescrs (fieldDescrsToList) -import Distribution.PackageDescription.FieldGrammar (sourceRepoFieldGrammar) -import Distribution.Parsec (explicitEitherParsec) -import Distribution.Simple.Utils (fromUTF8BS) -import Distribution.Types.SourceRepo (RepoKind (..), SourceRepo) - -sourceRepoFieldDescrs :: [FieldDescr SourceRepo] -sourceRepoFieldDescrs = - map toDescr . fieldDescrsToList $ sourceRepoFieldGrammar (RepoKindUnknown "unused") - where - toDescr (name, pretty, parse) = FieldDescr - { fieldName = fromUTF8BS name - , fieldGet = pretty - , fieldSet = \lineNo str x -> - either (syntaxError lineNo) return - $ explicitEitherParsec (parse x) str - } diff --git a/cabal/cabal-install/Distribution/Client/Store.hs b/cabal/cabal-install/Distribution/Client/Store.hs index 9f7db55..b92b14e 100644 --- a/cabal/cabal-install/Distribution/Client/Store.hs +++ b/cabal/cabal-install/Distribution/Client/Store.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards, NamedFieldPuns #-} +{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns #-} -- | Management for the installed package store. @@ -23,7 +23,6 @@ module Distribution.Client.Store ( import Prelude () import Distribution.Client.Compat.Prelude -import Distribution.Client.Compat.FileLock import Distribution.Client.DistDirLayout import Distribution.Client.RebuildMonad @@ -36,14 +35,21 @@ import Distribution.Simple.Utils import Distribution.Verbosity import Distribution.Deprecated.Text -import Data.Set (Set) import qualified Data.Set as Set import Control.Exception import Control.Monad (forM_) import System.FilePath import System.Directory -import System.IO +#ifdef MIN_VERSION_lukko +import Lukko +#else +import System.IO (openFile, IOMode(ReadWriteMode), hClose) +import GHC.IO.Handle.Lock (hLock, hTryLock, LockMode(ExclusiveLock)) +#if MIN_VERSION_base(4,11,0) +import GHC.IO.Handle.Lock (hUnlock) +#endif +#endif -- $concurrency -- @@ -236,6 +242,26 @@ withIncomingUnitIdLock verbosity StoreDirLayout{storeIncomingLock} compid unitid action = bracket takeLock releaseLock (\_hnd -> action) where +#ifdef MIN_VERSION_lukko + takeLock + | fileLockingSupported = do + fd <- fdOpen (storeIncomingLock compid unitid) + gotLock <- fdTryLock fd ExclusiveLock + unless gotLock $ do + info verbosity $ "Waiting for file lock on store entry " + ++ display compid </> display unitid + fdLock fd ExclusiveLock + return fd + + -- if there's no locking, do nothing. Be careful on AIX. + | otherwise = return undefined -- :( + + releaseLock fd + | fileLockingSupported = do + fdUnlock fd + fdClose fd + | otherwise = return () +#else takeLock = do h <- openFile (storeIncomingLock compid unitid) ReadWriteMode -- First try non-blocking, but if we would have to wait then @@ -247,5 +273,5 @@ withIncomingUnitIdLock verbosity StoreDirLayout{storeIncomingLock} hLock h ExclusiveLock return h - releaseLock = hClose - + releaseLock h = hUnlock h >> hClose h +#endif diff --git a/cabal/cabal-install/Distribution/Client/Types.hs b/cabal/cabal-install/Distribution/Client/Types.hs index 8ae60f5..ecaa147 100644 --- a/cabal/cabal-install/Distribution/Client/Types.hs +++ b/cabal/cabal-install/Distribution/Client/Types.hs @@ -48,8 +48,8 @@ import Distribution.Types.ComponentName ( ComponentName(..) ) import Distribution.Types.LibraryName ( LibraryName(..) ) -import Distribution.Types.SourceRepo - ( SourceRepo ) +import Distribution.Client.SourceRepo + ( SourceRepoMaybe ) import Distribution.Solver.Types.PackageIndex ( PackageIndex ) @@ -287,7 +287,7 @@ data PackageLocation local = | RepoTarballPackage Repo PackageId local -- | A package available from a version control system source repository - | RemoteSourceRepoPackage SourceRepo local + | RemoteSourceRepoPackage SourceRepoMaybe local deriving (Show, Functor, Eq, Ord, Generic, Typeable) instance Binary local => Binary (PackageLocation local) diff --git a/cabal/cabal-install/Distribution/Client/VCS.hs b/cabal/cabal-install/Distribution/Client/VCS.hs index 89f4c94..9d897d7 100644 --- a/cabal/cabal-install/Distribution/Client/VCS.hs +++ b/cabal/cabal-install/Distribution/Client/VCS.hs @@ -1,20 +1,16 @@ -{-# LANGUAGE NamedFieldPuns, RecordWildCards #-} +{-# LANGUAGE NamedFieldPuns, RecordWildCards, RankNTypes #-} module Distribution.Client.VCS ( -- * VCS driver type VCS, vcsRepoType, vcsProgram, -- ** Type re-exports - SourceRepo, RepoType, - RepoKind, Program, ConfiguredProgram, - -- * Selecting amongst source repos - selectPackageSourceRepo, - -- * Validating 'SourceRepo's and configuring VCS drivers + validatePDSourceRepo, validateSourceRepo, validateSourceRepos, SourceRepoProblem(..), @@ -38,7 +34,8 @@ import Prelude () import Distribution.Client.Compat.Prelude import Distribution.Types.SourceRepo - ( SourceRepo(..), RepoType(..), RepoKind(..) ) + ( RepoType(..) ) +import Distribution.Client.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..), srpToProxy) import Distribution.Client.RebuildMonad ( Rebuild, monitorFiles, MonitorFilePath, monitorDirectoryExistence ) import Distribution.Verbosity as Verbosity @@ -51,6 +48,7 @@ import Distribution.Simple.Program , emptyProgramDb, requireProgram ) import Distribution.Version ( mkVersion ) +import qualified Distribution.PackageDescription as PD import Control.Monad ( mapM_ ) @@ -58,8 +56,6 @@ import Control.Monad.Trans ( liftIO ) import qualified Data.Char as Char import qualified Data.Map as Map -import Data.Ord - ( comparing ) import Data.Either ( partitionEithers ) import System.FilePath @@ -80,9 +76,9 @@ data VCS program = VCS { -- | The program invocation(s) to get\/clone a repository into a fresh -- local directory. - vcsCloneRepo :: Verbosity + vcsCloneRepo :: forall f. Verbosity -> ConfiguredProgram - -> SourceRepo + -> SourceRepositoryPackage f -> FilePath -- Source URI -> FilePath -- Destination directory -> [ProgramInvocation], @@ -90,9 +86,9 @@ data VCS program = VCS { -- | The program invocation(s) to synchronise a whole set of /related/ -- repositories with corresponding local directories. Also returns the -- files that the command depends on, for change monitoring. - vcsSyncRepos :: Verbosity + vcsSyncRepos :: forall f. Verbosity -> ConfiguredProgram - -> [(SourceRepo, FilePath)] + -> [(SourceRepositoryPackage f, FilePath)] -> IO [MonitorFilePath] } @@ -101,37 +97,8 @@ data VCS program = VCS { -- * Selecting repos and drivers -- ------------------------------------------------------------ --- | Pick the 'SourceRepo' to use to get the package sources from. --- --- Note that this does /not/ depend on what 'VCS' drivers we are able to --- successfully configure. It is based only on the 'SourceRepo's declared --- in the package, and optionally on a preferred 'RepoKind'. --- -selectPackageSourceRepo :: Maybe RepoKind - -> [SourceRepo] - -> Maybe SourceRepo -selectPackageSourceRepo preferredRepoKind = - listToMaybe - -- Sort repositories by kind, from This to Head to Unknown. Repositories - -- with equivalent kinds are selected based on the order they appear in - -- the Cabal description file. - . sortBy (comparing thisFirst) - -- If the user has specified the repo kind, filter out the repositories - -- they're not interested in. - . filter (\repo -> maybe True (repoKind repo ==) preferredRepoKind) - where - thisFirst :: SourceRepo -> Int - thisFirst r = case repoKind r of - RepoThis -> 0 - RepoHead -> case repoTag r of - -- If the type is 'head' but the author specified a tag, they - -- probably meant to create a 'this' repository but screwed up. - Just _ -> 0 - Nothing -> 1 - RepoKindUnknown _ -> 2 - data SourceRepoProblem = SourceRepoRepoTypeUnspecified - | SourceRepoRepoTypeUnsupported RepoType + | SourceRepoRepoTypeUnsupported (SourceRepositoryPackage Proxy) RepoType | SourceRepoLocationUnspecified deriving Show @@ -140,25 +107,42 @@ data SourceRepoProblem = SourceRepoRepoTypeUnspecified -- -- | It also returns the 'VCS' driver we should use to work with it. -- -validateSourceRepo :: SourceRepo - -> Either SourceRepoProblem - (SourceRepo, String, RepoType, VCS Program) +validateSourceRepo + :: SourceRepositoryPackage f + -> Either SourceRepoProblem (SourceRepositoryPackage f, String, RepoType, VCS Program) validateSourceRepo = \repo -> do - rtype <- repoType repo ?! SourceRepoRepoTypeUnspecified - vcs <- Map.lookup rtype knownVCSs ?! SourceRepoRepoTypeUnsupported rtype - uri <- repoLocation repo ?! SourceRepoLocationUnspecified + let rtype = srpType repo + vcs <- Map.lookup rtype knownVCSs ?! SourceRepoRepoTypeUnsupported (srpToProxy repo) rtype + let uri = srpLocation repo return (repo, uri, rtype, vcs) where a ?! e = maybe (Left e) Right a +validatePDSourceRepo + :: PD.SourceRepo + -> Either SourceRepoProblem (SourceRepoMaybe, String, RepoType, VCS Program) +validatePDSourceRepo repo = do + rtype <- PD.repoType repo ?! SourceRepoRepoTypeUnspecified + uri <- PD.repoLocation repo ?! SourceRepoLocationUnspecified + validateSourceRepo SourceRepositoryPackage + { srpType = rtype + , srpLocation = uri + , srpTag = PD.repoTag repo + , srpBranch = PD.repoBranch repo + , srpSubdir = PD.repoSubdir repo + } + where + a ?! e = maybe (Left e) Right a + + -- | As 'validateSourceRepo' but for a bunch of 'SourceRepo's, and return -- things in a convenient form to pass to 'configureVCSs', or to report -- problems. -- -validateSourceRepos :: [SourceRepo] - -> Either [(SourceRepo, SourceRepoProblem)] - [(SourceRepo, String, RepoType, VCS Program)] +validateSourceRepos :: [SourceRepositoryPackage f] + -> Either [(SourceRepositoryPackage f, SourceRepoProblem)] + [(SourceRepositoryPackage f, String, RepoType, VCS Program)] validateSourceRepos rs = case partitionEithers (map validateSourceRepo' rs) of (problems@(_:_), _) -> Left problems @@ -193,17 +177,15 @@ configureVCSs verbosity = traverse (configureVCS verbosity) -- -- Make sure to validate the 'SourceRepo' using 'validateSourceRepo' first. -- -cloneSourceRepo :: Verbosity - -> VCS ConfiguredProgram - -> SourceRepo -- ^ Must have 'repoLocation' filled. - -> FilePath -- ^ Destination directory - -> IO () -cloneSourceRepo _ _ repo@SourceRepo{ repoLocation = Nothing } _ = - error $ "cloneSourceRepo: precondition violation, missing repoLocation: \"" - ++ show repo ++ "\". Validate using validateSourceRepo first." +cloneSourceRepo + :: Verbosity + -> VCS ConfiguredProgram + -> SourceRepositoryPackage f + -> [Char] + -> IO () cloneSourceRepo verbosity vcs - repo@SourceRepo{ repoLocation = Just srcuri } destdir = + repo@SourceRepositoryPackage{ srpLocation = srcuri } destdir = mapM_ (runProgramInvocation verbosity) invocations where invocations = vcsCloneRepo vcs verbosity @@ -228,7 +210,7 @@ cloneSourceRepo verbosity vcs -- syncSourceRepos :: Verbosity -> VCS ConfiguredProgram - -> [(SourceRepo, FilePath)] + -> [(SourceRepositoryPackage f, FilePath)] -> Rebuild () syncSourceRepos verbosity vcs repos = do files <- liftIO $ vcsSyncRepos vcs verbosity (vcsProgram vcs) repos @@ -260,7 +242,7 @@ vcsBzr = where vcsCloneRepo :: Verbosity -> ConfiguredProgram - -> SourceRepo + -> SourceRepositoryPackage f -> FilePath -> FilePath -> [ProgramInvocation] @@ -274,13 +256,13 @@ vcsBzr = = "branch" | otherwise = "get" - tagArgs = case repoTag repo of + tagArgs = case srpTag repo of Nothing -> [] Just tag -> ["-r", "tag:" ++ tag] verboseArg = [ "--quiet" | verbosity < Verbosity.normal ] vcsSyncRepos :: Verbosity -> ConfiguredProgram - -> [(SourceRepo, FilePath)] -> IO [MonitorFilePath] + -> [(SourceRepositoryPackage f, FilePath)] -> IO [MonitorFilePath] vcsSyncRepos _v _p _rs = fail "sync repo not yet supported for bzr" bzrProgram :: Program @@ -306,7 +288,7 @@ vcsDarcs = where vcsCloneRepo :: Verbosity -> ConfiguredProgram - -> SourceRepo + -> SourceRepositoryPackage f -> FilePath -> FilePath -> [ProgramInvocation] @@ -319,13 +301,13 @@ vcsDarcs = cloneCmd | programVersion prog >= Just (mkVersion [2,8]) = "clone" | otherwise = "get" - tagArgs = case repoTag repo of + tagArgs = case srpTag repo of Nothing -> [] Just tag -> ["-t", tag] verboseArg = [ "--quiet" | verbosity < Verbosity.normal ] vcsSyncRepos :: Verbosity -> ConfiguredProgram - -> [(SourceRepo, FilePath)] -> IO [MonitorFilePath] + -> [(SourceRepositoryPackage f, FilePath)] -> IO [MonitorFilePath] vcsSyncRepos _v _p _rs = fail "sync repo not yet supported for darcs" darcsProgram :: Program @@ -351,7 +333,7 @@ vcsGit = where vcsCloneRepo :: Verbosity -> ConfiguredProgram - -> SourceRepo + -> SourceRepositoryPackage f -> FilePath -> FilePath -> [ProgramInvocation] @@ -361,11 +343,11 @@ vcsGit = ++ [ (programInvocation prog (checkoutArgs tag)) { progInvokeCwd = Just destdir } - | tag <- maybeToList (repoTag repo) ] + | tag <- maybeToList (srpTag repo) ] where cloneArgs = ["clone", srcuri, destdir] ++ branchArgs ++ verboseArg - branchArgs = case repoBranch repo of + branchArgs = case srpBranch repo of Just b -> ["--branch", b] Nothing -> [] checkoutArgs tag = "checkout" : verboseArg ++ [tag, "--"] @@ -373,7 +355,7 @@ vcsGit = vcsSyncRepos :: Verbosity -> ConfiguredProgram - -> [(SourceRepo, FilePath)] + -> [(SourceRepositoryPackage f, FilePath)] -> IO [MonitorFilePath] vcsSyncRepos _ _ [] = return [] vcsSyncRepos verbosity gitProg @@ -383,10 +365,10 @@ vcsGit = sequence_ [ vcsSyncRepo verbosity gitProg repo localDir (Just primaryLocalDir) | (repo, localDir) <- secondaryRepos ] - return [ monitorDirectoryExistence dir + return [ monitorDirectoryExistence dir | dir <- (primaryLocalDir : map snd secondaryRepos) ] - vcsSyncRepo verbosity gitProg SourceRepo{..} localDir peer = do + vcsSyncRepo verbosity gitProg SourceRepositoryPackage{..} localDir peer = do exists <- doesDirectoryExist localDir if exists then git localDir ["fetch"] @@ -404,10 +386,10 @@ vcsGit = Nothing -> [] Just peerLocalDir -> ["--reference", peerLocalDir] ++ verboseArg - where Just loc = repoLocation + where loc = srpLocation checkoutArgs = "checkout" : verboseArg ++ ["--detach", "--force" , checkoutTarget, "--" ] - checkoutTarget = fromMaybe "HEAD" (repoBranch `mplus` repoTag) + checkoutTarget = fromMaybe "HEAD" (srpBranch `mplus` srpTag) verboseArg = [ "--quiet" | verbosity < Verbosity.normal ] gitProgram :: Program @@ -444,7 +426,7 @@ vcsHg = where vcsCloneRepo :: Verbosity -> ConfiguredProgram - -> SourceRepo + -> SourceRepositoryPackage f -> FilePath -> FilePath -> [ProgramInvocation] @@ -453,17 +435,17 @@ vcsHg = where cloneArgs = ["clone", srcuri, destdir] ++ branchArgs ++ tagArgs ++ verboseArg - branchArgs = case repoBranch repo of + branchArgs = case srpBranch repo of Just b -> ["--branch", b] Nothing -> [] - tagArgs = case repoTag repo of + tagArgs = case srpTag repo of Just t -> ["--rev", t] Nothing -> [] verboseArg = [ "--quiet" | verbosity < Verbosity.normal ] vcsSyncRepos :: Verbosity -> ConfiguredProgram - -> [(SourceRepo, FilePath)] + -> [(SourceRepositoryPackage f, FilePath)] -> IO [MonitorFilePath] vcsSyncRepos _v _p _rs = fail "sync repo not yet supported for hg" @@ -490,7 +472,7 @@ vcsSvn = where vcsCloneRepo :: Verbosity -> ConfiguredProgram - -> SourceRepo + -> SourceRepositoryPackage f -> FilePath -> FilePath -> [ProgramInvocation] @@ -503,7 +485,7 @@ vcsSvn = vcsSyncRepos :: Verbosity -> ConfiguredProgram - -> [(SourceRepo, FilePath)] + -> [(SourceRepositoryPackage f, FilePath)] -> IO [MonitorFilePath] vcsSyncRepos _v _p _rs = fail "sync repo not yet supported for svn" diff --git a/cabal/cabal-install/Distribution/Deprecated/Text.hs b/cabal/cabal-install/Distribution/Deprecated/Text.hs index 44f2d89..c16bcb5 100644 --- a/cabal/cabal-install/Distribution/Deprecated/Text.hs +++ b/cabal/cabal-install/Distribution/Deprecated/Text.hs @@ -28,7 +28,6 @@ import Prelude (read) import Distribution.Deprecated.ReadP ((<++)) import qualified Distribution.Deprecated.ReadP as Parse -import Data.Functor.Identity (Identity (..)) import Distribution.Parsec import Distribution.Pretty import qualified Text.PrettyPrint as Disp diff --git a/cabal/cabal-install/Distribution/Deprecated/ViewAsFieldDescr.hs b/cabal/cabal-install/Distribution/Deprecated/ViewAsFieldDescr.hs index 87b7781..88357ac 100644 --- a/cabal/cabal-install/Distribution/Deprecated/ViewAsFieldDescr.hs +++ b/cabal/cabal-install/Distribution/Deprecated/ViewAsFieldDescr.hs @@ -5,6 +5,7 @@ module Distribution.Deprecated.ViewAsFieldDescr ( import Distribution.Client.Compat.Prelude hiding (get) import Prelude () +import qualified Data.List.NonEmpty as NE import Distribution.Parsec (parsec) import Distribution.Pretty import Distribution.ReadE (parsecToReadE) @@ -19,10 +20,10 @@ import Distribution.Deprecated.ParseUtils (FieldDescr (..), runE, syntaxError) viewAsFieldDescr :: OptionField a -> FieldDescr a viewAsFieldDescr (OptionField _n []) = error "Distribution.command.viewAsFieldDescr: unexpected" -viewAsFieldDescr (OptionField n dd) = FieldDescr n get set +viewAsFieldDescr (OptionField n (d:dd)) = FieldDescr n get set where - optDescr = head $ sortBy cmp dd + optDescr = head $ NE.sortBy cmp (d:|dd) cmp :: OptDescr a -> OptDescr a -> Ordering ReqArg{} `cmp` ReqArg{} = EQ diff --git a/cabal/cabal-install/Distribution/Solver/Modular.hs b/cabal/cabal-install/Distribution/Solver/Modular.hs index 4648ab8..a938b6a 100644 --- a/cabal/cabal-install/Distribution/Solver/Modular.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular.hs @@ -16,7 +16,7 @@ import Prelude () import Distribution.Solver.Compat.Prelude import qualified Data.Map as M -import Data.Set (Set, isSubsetOf) +import Data.Set (isSubsetOf) import Data.Ord import Distribution.Compat.Graph ( IsNode(..) ) diff --git a/cabal/cabal-install/Distribution/Solver/Modular/IndexConversion.hs b/cabal/cabal-install/Distribution/Solver/Modular/IndexConversion.hs index 377e935..c9565c8 100644 --- a/cabal/cabal-install/Distribution/Solver/Modular/IndexConversion.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular/IndexConversion.hs @@ -341,7 +341,7 @@ filterIPNs ipns d@(Dependency pn _ _) -- | Convert condition trees to flagged dependencies. Mutually -- recursive with 'convBranch'. See 'convBranch' for an explanation --- of all arguments preceeding the input 'CondTree'. +-- of all arguments preceding the input 'CondTree'. convCondTree :: Map FlagName Bool -> DependencyReason PN -> PackageDescription -> OS -> Arch -> CompilerInfo -> PN -> FlagInfo -> Component -> (a -> BuildInfo) -> diff --git a/cabal/cabal-install/Distribution/Solver/Modular/Linking.hs b/cabal/cabal-install/Distribution/Solver/Modular/Linking.hs index 3f14f65..35f4637 100644 --- a/cabal/cabal-install/Distribution/Solver/Modular/Linking.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular/Linking.hs @@ -12,7 +12,6 @@ import Control.Monad.Reader import Control.Monad.State import Data.Function (on) import Data.Map ((!)) -import Data.Set (Set) import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Traversable as T @@ -29,7 +28,7 @@ import qualified Distribution.Solver.Modular.WeightedPSQ as W import Distribution.Solver.Types.OptionalStanza import Distribution.Solver.Types.PackagePath -import Distribution.Types.GenericPackageDescription (unFlagName) +import Distribution.Types.Flag (unFlagName) {------------------------------------------------------------------------------- Validation diff --git a/cabal/cabal-install/Distribution/Solver/Types/ComponentDeps.hs b/cabal/cabal-install/Distribution/Solver/Types/ComponentDeps.hs index 87d5d65..e56734d 100644 --- a/cabal/cabal-install/Distribution/Solver/Types/ComponentDeps.hs +++ b/cabal/cabal-install/Distribution/Solver/Types/ComponentDeps.hs @@ -38,7 +38,7 @@ module Distribution.Solver.Types.ComponentDeps ( import Prelude () import Distribution.Types.UnqualComponentName -import Distribution.Solver.Compat.Prelude hiding (empty,zip) +import Distribution.Solver.Compat.Prelude hiding (empty,toList,zip) import qualified Data.Map as Map import Data.Foldable (fold) diff --git a/cabal/cabal-install/Distribution/Solver/Types/PackageIndex.hs b/cabal/cabal-install/Distribution/Solver/Types/PackageIndex.hs index c7a1ce0..2b349f3 100644 --- a/cabal/cabal-install/Distribution/Solver/Types/PackageIndex.hs +++ b/cabal/cabal-install/Distribution/Solver/Types/PackageIndex.hs @@ -50,7 +50,8 @@ import Distribution.Solver.Compat.Prelude hiding (lookup) import Control.Exception (assert) import qualified Data.Map as Map -import Data.List (groupBy, isInfixOf) +import Data.List (isInfixOf) +import qualified Data.List.NonEmpty as NE import Distribution.Package ( PackageName, unPackageName, PackageIdentifier(..) @@ -136,9 +137,9 @@ fromList pkgs = mkPackageIndex where fixBucket = -- out of groups of duplicates, later ones mask earlier ones -- but Map.fromListWith (++) constructs groups in reverse order - map head + map NE.head -- Eq instance for PackageIdentifier is wrong, so use Ord: - . groupBy (\a b -> EQ == comparing packageId a b) + . NE.groupBy (\a b -> EQ == comparing packageId a b) -- relies on sortBy being a stable sort so we -- can pick consistently among duplicates . sortBy (comparing packageId) diff --git a/cabal/cabal-install/Distribution/Solver/Types/PkgConfigDb.hs b/cabal/cabal-install/Distribution/Solver/Types/PkgConfigDb.hs index 3d2ed07..e63d3b0 100644 --- a/cabal/cabal-install/Distribution/Solver/Types/PkgConfigDb.hs +++ b/cabal/cabal-install/Distribution/Solver/Types/PkgConfigDb.hs @@ -31,7 +31,7 @@ import Distribution.Compat.Environment (lookupEnv) import Distribution.Package (PkgconfigName, mkPkgconfigName) import Distribution.Parsec import Distribution.Simple.Program - (ProgramDb, getProgramOutput, pkgConfigProgram, requireProgram) + (ProgramDb, getProgramOutput, pkgConfigProgram, needProgram) import Distribution.Simple.Utils (info) import Distribution.Types.PkgconfigVersion import Distribution.Types.PkgconfigVersionRange @@ -56,23 +56,28 @@ instance Binary PkgConfigDb -- information. readPkgConfigDb :: Verbosity -> ProgramDb -> IO PkgConfigDb readPkgConfigDb verbosity progdb = handle ioErrorHandler $ do - (pkgConfig, _) <- requireProgram verbosity pkgConfigProgram progdb - pkgList <- lines <$> getProgramOutput verbosity pkgConfig ["--list-all"] - -- The output of @pkg-config --list-all@ also includes a description - -- for each package, which we do not need. - let pkgNames = map (takeWhile (not . isSpace)) pkgList - pkgVersions <- lines <$> getProgramOutput verbosity pkgConfig - ("--modversion" : pkgNames) - (return . pkgConfigDbFromList . zip pkgNames) pkgVersions - where - -- For when pkg-config invocation fails (possibly because of a - -- too long command line). - ioErrorHandler :: IOException -> IO PkgConfigDb - ioErrorHandler e = do - info verbosity ("Failed to query pkg-config, Cabal will continue" - ++ " without solving for pkg-config constraints: " - ++ show e) - return NoPkgConfigDb + mpkgConfig <- needProgram verbosity pkgConfigProgram progdb + case mpkgConfig of + Nothing -> noPkgConfig "Cannot find pkg-config program" + Just (pkgConfig, _) -> do + pkgList <- lines <$> getProgramOutput verbosity pkgConfig ["--list-all"] + -- The output of @pkg-config --list-all@ also includes a description + -- for each package, which we do not need. + let pkgNames = map (takeWhile (not . isSpace)) pkgList + pkgVersions <- lines <$> getProgramOutput verbosity pkgConfig + ("--modversion" : pkgNames) + (return . pkgConfigDbFromList . zip pkgNames) pkgVersions + where + -- For when pkg-config invocation fails (possibly because of a + -- too long command line). + noPkgConfig extra = do + info verbosity ("Failed to query pkg-config, Cabal will continue" + ++ " without solving for pkg-config constraints: " + ++ extra) + return NoPkgConfigDb + + ioErrorHandler :: IOException -> IO PkgConfigDb + ioErrorHandler e = noPkgConfig (show e) -- | Create a `PkgConfigDb` from a list of @(packageName, version)@ pairs. pkgConfigDbFromList :: [(String, String)] -> PkgConfigDb @@ -134,10 +139,11 @@ getPkgConfigDbDirs verbosity progdb = -- > pkg-config --variable pc_path pkg-config -- getDefPath = handle ioErrorHandler $ do - (pkgConfig, _) <- requireProgram verbosity pkgConfigProgram progdb - parseSearchPath <$> - getProgramOutput verbosity pkgConfig - ["--variable", "pc_path", "pkg-config"] + mpkgConfig <- needProgram verbosity pkgConfigProgram progdb + case mpkgConfig of + Nothing -> return [] + Just (pkgConfig, _) -> parseSearchPath <$> + getProgramOutput verbosity pkgConfig ["--variable", "pc_path", "pkg-config"] parseSearchPath str = case lines str of diff --git a/cabal/cabal-install/bootstrap.sh b/cabal/cabal-install/bootstrap.sh index 35930a9..3eba264 100755 --- a/cabal/cabal-install/bootstrap.sh +++ b/cabal/cabal-install/bootstrap.sh @@ -260,14 +260,14 @@ EDIT_DISTANCE_VER="0.2.2.1"; EDIT_DISTANCE_VER_REGEXP="0\.2\.2\.?" # 0.2.2.* ED25519_VER="0.0.5.0"; ED25519_VER_REGEXP="0\.0\.?" # 0.0.* -HACKAGE_SECURITY_VER="0.5.3.0"; HACKAGE_SECURITY_VER_REGEXP="0\.5\.((2\.[2-9]|[3-9])|3)" - # >= 0.5.2 && < 0.6 +HACKAGE_SECURITY_VER="0.6.0.0"; HACKAGE_SECURITY_VER_REGEXP="0\.6\." + # >= 0.7.0.0 && < 0.7 TAR_VER="0.5.1.0"; TAR_VER_REGEXP="0\.5\.([1-9]|1[0-9]|0\.[3-9]|0\.1[0-9])\.?" # >= 0.5.0.3 && < 0.6 DIGEST_VER="0.0.1.2"; DIGEST_REGEXP="0\.0\.(1\.[2-9]|[2-9]\.?)" # >= 0.0.1.2 && < 0.1 -ZIP_ARCHIVE_VER="0.3.3"; ZIP_ARCHIVE_REGEXP="0\.3\.[3-9]" - # >= 0.3.3 && < 0.4 +LUKKO_VER="0.1.1"; LUKKO_VER_REGEXP="0\.1\.[1-9]" + # >= 0.1.1 && <0.2 HACKAGE_URL="https://hackage.haskell.org/package" @@ -471,7 +471,7 @@ info_pkg "edit-distance" ${EDIT_DISTANCE_VER} ${EDIT_DISTANCE_VER_REGEXP} info_pkg "ed25519" ${ED25519_VER} ${ED25519_VER_REGEXP} info_pkg "tar" ${TAR_VER} ${TAR_VER_REGEXP} info_pkg "digest" ${DIGEST_VER} ${DIGEST_REGEXP} -info_pkg "zip-archive" ${ZIP_ARCHIVE_VER} ${ZIP_ARCHIVE_REGEXP} +info_pkg "lukko" ${LUKKO_VER} ${LUKKO_REGEXP} info_pkg "hackage-security" ${HACKAGE_SECURITY_VER} \ ${HACKAGE_SECURITY_VER_REGEXP} @@ -509,7 +509,7 @@ do_pkg "edit-distance" ${EDIT_DISTANCE_VER} ${EDIT_DISTANCE_VER_REGEXP} do_pkg "ed25519" ${ED25519_VER} ${ED25519_VER_REGEXP} do_pkg "tar" ${TAR_VER} ${TAR_VER_REGEXP} do_pkg "digest" ${DIGEST_VER} ${DIGEST_REGEXP} -do_pkg "zip-archive" ${ZIP_ARCHIVE_VER} ${ZIP_ARCHIVE_REGEXP} +do_pkg "lukko" ${LUKKO_VER} ${LUKKO_REGEXP} do_pkg "hackage-security" ${HACKAGE_SECURITY_VER} \ ${HACKAGE_SECURITY_VER_REGEXP} diff --git a/cabal/cabal-install/cabal-install.cabal b/cabal/cabal-install/cabal-install.cabal index d50e934..7716ca5 100644 --- a/cabal/cabal-install/cabal-install.cabal +++ b/cabal/cabal-install/cabal-install.cabal @@ -21,7 +21,6 @@ Category: Distribution Build-type: Custom Extra-Source-Files: README.md bash-completion/cabal bootstrap.sh changelog - tests/README.md -- Generated with 'make gen-extra-source-files' -- Do NOT edit this section manually; instead, run the script. @@ -122,6 +121,11 @@ Flag debug-tracetree default: False manual: True +Flag lukko + description: Use @lukko@ for file-locking + default: True + manual: True + custom-setup setup-depends: Cabal >= 2.2, @@ -176,7 +180,6 @@ executable cabal Distribution.Client.CmdSdist Distribution.Client.Compat.Directory Distribution.Client.Compat.ExecutablePath - Distribution.Client.Compat.FileLock Distribution.Client.Compat.FilePerms Distribution.Client.Compat.Prelude Distribution.Client.Compat.Process @@ -239,7 +242,7 @@ executable cabal Distribution.Client.SetupWrapper Distribution.Client.SolverInstallPlan Distribution.Client.SourceFiles - Distribution.Client.SourceRepoParse + Distribution.Client.SourceRepo Distribution.Client.SrcDist Distribution.Client.Store Distribution.Client.Tar @@ -308,7 +311,7 @@ executable cabal build-depends: async >= 2.0 && < 2.3, array >= 0.4 && < 0.6, - base >= 4.8 && < 4.13, + base >= 4.8 && < 4.14, base16-bytestring >= 0.1.1 && < 0.2, binary >= 0.7.3 && < 0.9, bytestring >= 0.10.6.0 && < 0.11, @@ -331,8 +334,9 @@ executable cabal stm >= 2.0 && < 2.6, tar >= 0.5.0.3 && < 0.6, time >= 1.5.0.1 && < 1.10, + transformers >= 0.4.2.0 && < 0.6, zlib >= 0.5.3 && < 0.7, - hackage-security >= 0.5.2.2 && < 0.6, + hackage-security >= 0.6.0.0 && < 0.7, text >= 1.2.3 && < 1.3, parsec >= 3.1.13.0 && < 3.2 @@ -351,6 +355,11 @@ executable cabal else build-depends: unix >= 2.5 && < 2.9 + if flag(lukko) + build-depends: lukko >= 0.1 && <0.2 + else + build-depends: base >= 4.10 + if flag(debug-expensive-assertions) cpp-options: -DDEBUG_EXPENSIVE_ASSERTIONS diff --git a/cabal/cabal-install/cabal-install.cabal.pp b/cabal/cabal-install/cabal-install.cabal.pp index 0f4d208..e19db19 100644 --- a/cabal/cabal-install/cabal-install.cabal.pp +++ b/cabal/cabal-install/cabal-install.cabal.pp @@ -18,7 +18,7 @@ Version: 3.1.0.0 build-depends: async >= 2.0 && < 2.3, array >= 0.4 && < 0.6, - base >= 4.8 && < 4.13, + base >= 4.8 && < 4.14, base16-bytestring >= 0.1.1 && < 0.2, binary >= 0.7.3 && < 0.9, bytestring >= 0.10.6.0 && < 0.11, @@ -41,8 +41,9 @@ Version: 3.1.0.0 stm >= 2.0 && < 2.6, tar >= 0.5.0.3 && < 0.6, time >= 1.5.0.1 && < 1.10, + transformers >= 0.4.2.0 && < 0.6, zlib >= 0.5.3 && < 0.7, - hackage-security >= 0.5.2.2 && < 0.6, + hackage-security >= 0.6.0.0 && < 0.7, text >= 1.2.3 && < 1.3, parsec >= 3.1.13.0 && < 3.2 @@ -60,6 +61,11 @@ Version: 3.1.0.0 build-depends: Win32 >= 2 && < 3 else build-depends: unix >= 2.5 && < 2.9 + + if flag(lukko) + build-depends: lukko >= 0.1 && <0.2 + else + build-depends: base >= 4.10 %enddef %def CABAL_COMPONENTCOMMON default-language: Haskell2010 @@ -105,7 +111,6 @@ Version: 3.1.0.0 Distribution.Client.CmdSdist Distribution.Client.Compat.Directory Distribution.Client.Compat.ExecutablePath - Distribution.Client.Compat.FileLock Distribution.Client.Compat.FilePerms Distribution.Client.Compat.Prelude Distribution.Client.Compat.Process @@ -168,7 +173,7 @@ Version: 3.1.0.0 Distribution.Client.SetupWrapper Distribution.Client.SolverInstallPlan Distribution.Client.SourceFiles - Distribution.Client.SourceRepoParse + Distribution.Client.SourceRepo Distribution.Client.SrcDist Distribution.Client.Store Distribution.Client.Tar @@ -274,7 +279,6 @@ Build-type: Custom %endif Extra-Source-Files: README.md bash-completion/cabal bootstrap.sh changelog - tests/README.md -- Generated with 'make gen-extra-source-files' -- Do NOT edit this section manually; instead, run the script. @@ -375,6 +379,11 @@ Flag debug-tracetree default: False manual: True +Flag lukko + description: Use @lukko@ for file-locking + default: True + manual: True + %if CABAL_FLAG_LIB %else custom-setup @@ -495,7 +504,7 @@ executable cabal random, tagged, tar, - tasty >= 1.1.0.3 && < 1.2, + tasty >= 1.2.3 && < 1.3, tasty-hunit >= 0.10, tasty-quickcheck, tree-diff, @@ -561,7 +570,7 @@ Test-Suite unit-tests zlib, network-uri < 2.6.2.0, network, - tasty >= 1.1.0.3 && < 1.2, + tasty >= 1.2.3 && <1.3, tasty-hunit >= 0.10, tasty-quickcheck, tagged, @@ -593,7 +602,7 @@ Test-Suite memory-usage-tests containers, deepseq, tagged, - tasty >= 1.1.0.3 && < 1.2, + tasty >= 1.2.3 && <1.3, tasty-hunit >= 0.10 ghc-options: -threaded @@ -622,7 +631,7 @@ Test-Suite solver-quickcheck hashable, random, tagged, - tasty >= 1.1.0.3 && <1.2, + tasty >= 1.2.3 && <1.3, tasty-quickcheck, QuickCheck >= 2.8.2, pretty-show >= 1.6.15 @@ -650,7 +659,7 @@ test-suite integration-tests2 directory, edit-distance, filepath, - tasty >= 1.1.0.3 && < 1.2, + tasty >= 1.2.3 && <1.3, tasty-hunit >= 0.10, tagged diff --git a/cabal/cabal-install/changelog b/cabal/cabal-install/changelog index 12c115e..b5d1b72 100644 --- a/cabal/cabal-install/changelog +++ b/cabal/cabal-install/changelog @@ -1,10 +1,15 @@ -*-change-log-*- 3.1.0.0 (current development version) + * `v2-build` (and other `v2-`prefixed commands) now accept the + `--benchmark-option(s)` flags, which pass options to benchmark executables + (analogous to how `--test-option(s)` works). (#6209) -3.0.0.0 TBD - * Parses comma-seperated lists for extra-prog-path, extra-lib-dirs, extra-framework-dirs, +3.0.0.0 Mikhail Glushenkov <mikhail.glushenkov@gmail.com> August 2019 + * Parse comma-separated lists for extra-prog-path, extra-lib-dirs, extra-framework-dirs, and extra-include-dirs as actual lists. (#5420) + * `v2-haddock` fails on `haddock` failures (#5977) + * `v2-run` works when given `File.lhs` literate file. (#6134) * `v2-repl` no longer changes directory to a randomized temporary folder when used outside of a project. (#5544) * `install-method` and `overwrite-policy` in `.cabal/config` now actually work. (#5942) @@ -36,6 +41,7 @@ that make it possible to copy the executable instead of symlinking it * --symlink-bindir no longer controls the symlinking directory of v2-install (installdir controls both symlinking and copying now) + * Default to non-interactive init. * Add --test-wrapper that allows a prebuild script to set the test environment. * Add filterTestFlags: filter test-wrapper for Cabal < 3.0.0. * Cabal now only builds the minimum of a package for `v2-install` (#5754, #6091) @@ -503,7 +509,7 @@ 0.6.2 Duncan Coutts <duncan@haskell.org> Feb 2009 * The upgrade command has been disabled in this release * The configure and install commands now have consistent behaviour - * Reduce the tendancy to re-install already existing packages + * Reduce the tendency to re-install already existing packages * The --constraint= flag now works for the install command * New --preference= flag for soft constraints / version preferences * Improved bootstrap.sh script, smarter and better error checking diff --git a/cabal/cabal-install/main/Main.hs b/cabal/cabal-install/main/Main.hs index 9c0cb8e..5b4e9d4 100644 --- a/cabal/cabal-install/main/Main.hs +++ b/cabal/cabal-install/main/Main.hs @@ -236,9 +236,9 @@ main' = do mainWorker :: [String] -> IO () mainWorker args = do - hasScript <- if not (null args) - then CmdRun.validScript (head args) - else return False + maybeScriptAndArgs <- case args of + [] -> return Nothing + (h:tl) -> (\b -> if b then Just (h:|tl) else Nothing) <$> CmdRun.validScript h topHandler $ case commandsRun (globalCommand commands) commands args of @@ -253,9 +253,8 @@ mainWorker args = do -> printNumericVersion CommandHelp help -> printCommandHelp help CommandList opts -> printOptionsList opts - CommandErrors errs - | hasScript -> CmdRun.handleShebang (head args) (tail args) - | otherwise -> printErrors errs + CommandErrors errs -> maybe (printErrors errs) go maybeScriptAndArgs where + go (script:|scriptArgs) = CmdRun.handleShebang script scriptArgs CommandReadyToGo action -> do globalFlags' <- updateSandboxConfigFileFlag globalFlags action globalFlags' @@ -554,9 +553,10 @@ replAction (replFlags, buildExFlags) extraArgs globalFlags = do either (const onNoPkgDesc) (const onPkgDesc) pkgDesc -installAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +installAction :: ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags ) -> [String] -> Action -installAction (configFlags, _, installFlags, _, _) _ globalFlags +installAction (configFlags, _, installFlags, _, _, _) _ globalFlags | fromFlagOrDefault False (installOnly installFlags) = do let verb = fromFlagOrDefault normal (configVerbosity configFlags) (useSandbox, config) <- loadConfigOrSandboxConfig verb globalFlags @@ -565,10 +565,12 @@ installAction (configFlags, _, installFlags, _, _) _ globalFlags nixShellIfSandboxed verb dist globalFlags config useSandbox $ setupWrapper verb setupOpts Nothing - installCommand (const mempty) (const []) + installCommand (const (mempty, mempty, mempty, mempty, mempty, mempty)) + (const []) installAction - (configFlags, configExFlags, installFlags, haddockFlags, testFlags) + ( configFlags, configExFlags, installFlags + , haddockFlags, testFlags, benchmarkFlags ) extraArgs globalFlags = do let verb = fromFlagOrDefault normal (configVerbosity configFlags) (useSandbox, config) <- updateInstallDirs (configUserInstall configFlags) @@ -607,6 +609,9 @@ installAction testFlags' = Cabal.defaultTestFlags `mappend` savedTestFlags config `mappend` testFlags { testDistPref = toFlag dist } + benchmarkFlags' = Cabal.defaultBenchmarkFlags `mappend` + savedBenchmarkFlags config `mappend` + benchmarkFlags { benchmarkDistPref = toFlag dist } globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, platform, progdb) <- configCompilerAux' configFlags' -- TODO: Redesign ProgramDB API to prevent such problems as #2241 in the @@ -643,7 +648,7 @@ installAction comp platform progdb' useSandbox mSandboxPkgInfo globalFlags' configFlags'' configExFlags' - installFlags' haddockFlags' testFlags' + installFlags' haddockFlags' testFlags' benchmarkFlags' targets where @@ -885,9 +890,10 @@ updateAction updateFlags extraArgs globalFlags = do withRepoContext verbosity globalFlags' $ \repoContext -> update verbosity updateFlags repoContext -upgradeAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +upgradeAction :: ( ConfigFlags, ConfigExFlags, InstallFlags + , HaddockFlags, TestFlags, BenchmarkFlags ) -> [String] -> Action -upgradeAction (configFlags, _, _, _, _) _ _ = die' verbosity $ +upgradeAction (configFlags, _, _, _, _, _) _ _ = die' verbosity $ "Use the 'cabal install' command instead of 'cabal upgrade'.\n" ++ "You can install the latest version of a package using 'cabal install'. " ++ "The 'cabal upgrade' command has been removed because people found it " diff --git a/cabal/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs index 7b05bec..7a656c8 100644 --- a/cabal/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -39,6 +39,7 @@ module UnitTests.Distribution.Solver.Modular.DSL ( import Prelude () import Distribution.Solver.Compat.Prelude +import Distribution.Utils.Generic -- base import Control.Arrow (second) @@ -719,13 +720,13 @@ extractInstallPlan :: CI.SolverInstallPlan.SolverInstallPlan extractInstallPlan = catMaybes . map confPkg . CI.SolverInstallPlan.toList where confPkg :: CI.SolverInstallPlan.SolverPlanPackage -> Maybe (String, Int) - confPkg (CI.SolverInstallPlan.Configured pkg) = Just $ srcPkg pkg + confPkg (CI.SolverInstallPlan.Configured pkg) = srcPkg pkg confPkg _ = Nothing - srcPkg :: SolverPackage UnresolvedPkgLoc -> (String, Int) + srcPkg :: SolverPackage UnresolvedPkgLoc -> Maybe (String, Int) srcPkg cpkg = let C.PackageIdentifier pn ver = packageInfoId (solverPkgSource cpkg) - in (C.unPackageName pn, head (C.versionNumbers ver)) + in (\vn -> (C.unPackageName pn, vn)) <$> safeHead (C.versionNumbers ver) {------------------------------------------------------------------------------- Auxiliary diff --git a/cabal/cabal-install/tests/IntegrationTests2.hs b/cabal/cabal-install/tests/IntegrationTests2.hs index f064b0a..cd9e22b 100644 --- a/cabal/cabal-install/tests/IntegrationTests2.hs +++ b/cabal/cabal-install/tests/IntegrationTests2.hs @@ -68,6 +68,10 @@ import Data.Tagged (Tagged(..)) import Data.Proxy (Proxy(..)) import Data.Typeable (Typeable) +#if !MIN_VERSION_directory(1,2,7) +removePathForcibly :: FilePath -> IO () +removePathForcibly = removeDirectoryRecursive +#endif main :: IO () main = @@ -117,7 +121,10 @@ tests config = , testGroup "Successful builds" $ [ testCaseSteps "Setup script styles" (testSetupScriptStyles config) , testCase "keep-going" (testBuildKeepGoing config) +#ifndef mingw32_HOST_OS + -- disabled because https://github.com/haskell/cabal/issues/6272 , testCase "local tarball" (testBuildLocalTarball config) +#endif ] , testGroup "Regression tests" $ @@ -1403,7 +1410,7 @@ testBuildKeepGoing config = do expectBuildFailed failure1 _ <- expectPackageConfigured plan1 res1 "q-0.1" - -- With keep-going then we should go on to sucessfully build Q + -- With keep-going then we should go on to successfully build Q (plan2, res2) <- executePlan =<< planProject testdir (config `mappend` keepGoing True) (_, failure2) <- expectPackageFailed plan2 res2 "p-0.1" @@ -1579,7 +1586,7 @@ executePlan ((distDirLayout, cabalDirLayout, _, _, buildSettings), cleanProject :: FilePath -> IO () cleanProject testdir = do alreadyExists <- doesDirectoryExist distDir - when alreadyExists $ removeDirectoryRecursive distDir + when alreadyExists $ removePathForcibly distDir where projectRoot = ProjectRootImplicit (basedir </> testdir) distDirLayout = defaultDistDirLayout projectRoot Nothing diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Client/Get.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Client/Get.hs index 9868960..7fa9027 100644 --- a/cabal/cabal-install/tests/UnitTests/Distribution/Client/Get.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Client/Get.hs @@ -5,7 +5,8 @@ import Distribution.Client.Get import Distribution.Types.PackageId import Distribution.Types.PackageName -import Distribution.Types.SourceRepo +import Distribution.Types.SourceRepo (SourceRepo (..), emptySourceRepo, RepoKind (..), RepoType (..)) +import Distribution.Client.SourceRepo (SourceRepositoryPackage (..)) import Distribution.Verbosity as Verbosity import Distribution.Version @@ -92,11 +93,19 @@ testUnsupportedRepoType :: Assertion testUnsupportedRepoType = do e <- assertException $ clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos - e @?= ClonePackageUnsupportedRepoType pkgidfoo repo repotype + e @?= ClonePackageUnsupportedRepoType pkgidfoo repo' repotype where pkgrepos = [(pkgidfoo, [repo])] - repo = (emptySourceRepo RepoHead) { - repoType = Just repotype + repo = (emptySourceRepo RepoHead) + { repoType = Just repotype + , repoLocation = Just "loc" + } + repo' = SourceRepositoryPackage + { srpType = repotype + , srpLocation = "loc" + , srpTag = Nothing + , srpBranch = Nothing + , srpSubdir = Proxy } repotype = OtherRepoType "baz" @@ -169,10 +178,17 @@ testGitFetchFailed = repoType = Just Git, repoLocation = Just srcdir } + repo' = SourceRepositoryPackage + { srpType = Git + , srpLocation = srcdir + , srpTag = Nothing + , srpBranch = Nothing + , srpSubdir = Proxy + } pkgrepos = [(pkgidfoo, [repo])] e1 <- assertException $ clonePackagesFromSourceRepo verbosity tmpdir Nothing pkgrepos - e1 @?= ClonePackageFailedWithExitCode pkgidfoo repo "git" (ExitFailure 128) + e1 @?= ClonePackageFailedWithExitCode pkgidfoo repo' "git" (ExitFailure 128) testNetworkGitClone :: Assertion diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs index f8c4969..31c919d 100644 --- a/cabal/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module UnitTests.Distribution.Client.ProjectConfig (tests) where @@ -16,7 +17,7 @@ import Distribution.Deprecated.Text as Text import qualified Distribution.Deprecated.ReadP as Parse import Distribution.Package -import Distribution.PackageDescription hiding (Flag) +import Distribution.PackageDescription hiding (Flag, SourceRepo) import Distribution.Compiler import Distribution.Version import Distribution.Simple.Compiler @@ -33,6 +34,7 @@ import Distribution.Client.InstallSymlink import Distribution.Client.Dependency.Types import Distribution.Client.BuildReports.Types import Distribution.Client.Targets +import Distribution.Client.SourceRepo import Distribution.Utils.NubList import Network.URI @@ -173,7 +175,7 @@ prop_roundtrip_printparse_all config = prop_roundtrip_printparse_packages :: [PackageLocationString] -> [PackageLocationString] - -> [SourceRepo] + -> [SourceRepoList] -> [PackageVersionConstraint] -> Property prop_roundtrip_printparse_packages pkglocstrs1 pkglocstrs2 repos named = @@ -603,6 +605,7 @@ instance Arbitrary PackageConfig where <*> arbitraryFlag arbitraryShortToken <*> arbitrary <*> shortListOf 5 arbitrary + <*> shortListOf 5 arbitrary where arbitraryProgramName :: Gen String arbitraryProgramName = @@ -662,7 +665,8 @@ instance Arbitrary PackageConfig where , packageConfigTestKeepTix = x47 , packageConfigTestWrapper = x48 , packageConfigTestFailWhenNoTestSuites = x49 - , packageConfigTestTestOptions = x51 } = + , packageConfigTestTestOptions = x51 + , packageConfigBenchmarkOptions = x52 } = [ PackageConfig { packageConfigProgramPaths = postShrink_Paths x00' , packageConfigProgramArgs = postShrink_Args x01' , packageConfigProgramPathExtra = x02' @@ -716,7 +720,8 @@ instance Arbitrary PackageConfig where , packageConfigTestKeepTix = x47' , packageConfigTestWrapper = x48' , packageConfigTestFailWhenNoTestSuites = x49' - , packageConfigTestTestOptions = x51' } + , packageConfigTestTestOptions = x51' + , packageConfigBenchmarkOptions = x52' } | (((x00', x01', x02', x03', x04'), (x05', x42', x06', x50', x07', x08', x09'), (x10', x11', x12', x13', x14'), @@ -726,7 +731,7 @@ instance Arbitrary PackageConfig where (x30', x31', x32', (x33', x33_1'), x34'), (x35', x36', x37', x38', x43', x39'), (x40', x41'), - (x44', x45', x46', x47', x48', x49', x51'))) + (x44', x45', x46', x47', x48', x49', x51', x52'))) <- shrink (((preShrink_Paths x00, preShrink_Args x01, x02, x03, x04), (x05, x42, x06, x50, x07, x08, x09), @@ -740,7 +745,7 @@ instance Arbitrary PackageConfig where (x30, x31, x32, (x33, x33_1), x34), (x35, x36, fmap NonEmpty x37, x38, x43, fmap NonEmpty x39), (x40, x41), - (x44, x45, x46, x47, x48, x49, x51))) + (x44, x45, x46, x47, x48, x49, x51, x52))) ] where preShrink_Paths = Map.map NonEmpty @@ -762,35 +767,24 @@ instance Arbitrary HaddockTarget where instance Arbitrary TestShowDetails where arbitrary = arbitraryBoundedEnum -instance Arbitrary SourceRepo where - arbitrary = (SourceRepo kind - <$> arbitrary - <*> (fmap getShortToken <$> arbitrary) - <*> (fmap getShortToken <$> arbitrary) - <*> (fmap getShortToken <$> arbitrary) - <*> (fmap getShortToken <$> arbitrary) - <*> (fmap getShortToken <$> arbitrary)) - `suchThat` (/= emptySourceRepo kind) - where - kind = RepoKindUnknown "unused" - - shrink (SourceRepo _ x1 x2 x3 x4 x5 x6) = - [ repo - | ((x1', x2', x3'), (x4', x5', x6')) - <- shrink ((x1, - fmap ShortToken x2, - fmap ShortToken x3), - (fmap ShortToken x4, - fmap ShortToken x5, - fmap ShortToken x6)) - , let repo = SourceRepo RepoThis x1' - (fmap getShortToken x2') - (fmap getShortToken x3') - (fmap getShortToken x4') - (fmap getShortToken x5') - (fmap getShortToken x6') - , repo /= emptySourceRepo RepoThis - ] +instance f ~ [] => Arbitrary (SourceRepositoryPackage f) where + arbitrary = SourceRepositoryPackage + <$> arbitrary + <*> (getShortToken <$> arbitrary) + <*> (fmap getShortToken <$> arbitrary) + <*> (fmap getShortToken <$> arbitrary) + <*> (fmap getShortToken <$> shortListOf 3 arbitrary) + + shrink (SourceRepositoryPackage x1 x2 x3 x4 x5) = + [ SourceRepositoryPackage + x1' + (getShortToken x2') + (fmap getShortToken x3') + (fmap getShortToken x4') + (fmap getShortToken x5') + | (x1', x2', x3', x4', x5') <- shrink + (x1, ShortToken x2, fmap ShortToken x3, fmap ShortToken x4, fmap ShortToken x5) + ] instance Arbitrary RepoType where arbitrary = elements knownRepoTypes diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs index 49c9a92..a77e960 100644 --- a/cabal/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module UnitTests.Distribution.Client.TreeDiffInstances () where @@ -9,7 +10,7 @@ import Distribution.Simple.Flag import Distribution.Simple.InstallDirs import Distribution.Simple.InstallDirs.Internal import Distribution.Simple.Setup (HaddockTarget, TestShowDetails) -import Distribution.Types.GenericPackageDescription (FlagName, FlagAssignment) +import Distribution.Types.Flag (FlagName, FlagAssignment) import Distribution.Types.PackageId import Distribution.Types.PackageName import Distribution.Types.PackageVersionConstraint @@ -33,6 +34,7 @@ import Distribution.Client.IndexUtils.Timestamp import Distribution.Client.InstallSymlink import Distribution.Client.ProjectConfig.Types import Distribution.Client.Targets +import Distribution.Client.SourceRepo (SourceRepositoryPackage) import Distribution.Client.Types import UnitTests.Distribution.Client.GenericInstances () @@ -90,6 +92,7 @@ instance ToExpr RepoType instance ToExpr ReportLevel instance ToExpr ShortText instance ToExpr SourceRepo +instance ToExpr (f FilePath) => ToExpr (SourceRepositoryPackage f) instance ToExpr StrongFlags instance ToExpr TestShowDetails instance ToExpr Timestamp diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs index 46700bf..0808865 100644 --- a/cabal/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs @@ -1,22 +1,19 @@ {-# LANGUAGE RecordWildCards, NamedFieldPuns #-} module UnitTests.Distribution.Client.VCS (tests) where +import Distribution.Client.Compat.Prelude import Distribution.Client.VCS import Distribution.Client.RebuildMonad ( execRebuild ) import Distribution.Simple.Program import Distribution.Verbosity as Verbosity -import Distribution.Types.SourceRepo +import Distribution.Client.SourceRepo (SourceRepositoryPackage (..), SourceRepoProxy) import Data.List import Data.Tuple import qualified Data.Map as Map -import Data.Map (Map) import qualified Data.Set as Set -import Data.Set (Set) -import Data.Char (isSpace) -import Control.Monad import qualified Control.Monad.State as State import Control.Monad.State (StateT, liftIO, execStateT) import Control.Exception @@ -196,11 +193,13 @@ prop_cloneRepo vcs mkVCSTestDriver repoRecipe = removeDirectoryRecursiveHack verbosity destRepoPath where destRepoPath = tmpdir </> "dest" - repo = (emptySourceRepo RepoThis) { - repoType = Just (vcsRepoType vcsVCS), - repoLocation = Just vcsRepoRoot, - repoTag = Just tagname - } + repo = SourceRepositoryPackage + { srpType = vcsRepoType vcsVCS + , srpLocation = vcsRepoRoot + , srpTag = Just tagname + , srpBranch = Nothing + , srpSubdir = [] + } verbosity = silent @@ -264,7 +263,7 @@ checkSyncRepos verbosity VCSTestDriver { vcsVCS = vcs, vcsIgnoreFiles } (SyncTargetIterations syncTargetSetIterations) (PrngSeed seed) = mapM_ checkSyncTargetSet syncTargetSets where - checkSyncTargetSet :: [(SourceRepo, FilePath, RepoWorkingState)] -> IO () + checkSyncTargetSet :: [(SourceRepoProxy, FilePath, RepoWorkingState)] -> IO () checkSyncTargetSet syncTargets = do _ <- execRebuild "root-unused" $ syncSourceRepos verbosity vcs @@ -282,22 +281,24 @@ checkSyncRepos verbosity VCSTestDriver { vcsVCS = vcs, vcsIgnoreFiles } pickSyncTargetSets :: RepoType -> RepoState -> FilePath -> [FilePath] -> StdGen - -> [[(SourceRepo, FilePath, RepoWorkingState)]] + -> [[(SourceRepoProxy, FilePath, RepoWorkingState)]] pickSyncTargetSets repoType repoState srcRepoPath dstReposPath = assert (Map.size (allTags repoState) > 0) $ unfoldr (Just . swap . pickSyncTargetSet) where - pickSyncTargetSet :: Rand [(SourceRepo, FilePath, RepoWorkingState)] + pickSyncTargetSet :: Rand [(SourceRepoProxy, FilePath, RepoWorkingState)] pickSyncTargetSet = flip (mapAccumL (flip pickSyncTarget)) dstReposPath - pickSyncTarget :: FilePath -> Rand (SourceRepo, FilePath, RepoWorkingState) + pickSyncTarget :: FilePath -> Rand (SourceRepoProxy, FilePath, RepoWorkingState) pickSyncTarget destRepoPath prng = (prng', (repo, destRepoPath, workingState)) where - repo = (emptySourceRepo RepoThis) { - repoType = Just repoType, - repoLocation = Just srcRepoPath, - repoTag = Just tag + repo = SourceRepositoryPackage + { srpType = repoType + , srpLocation = srcRepoPath + , srpTag = Just tag + , srpBranch = Nothing + , srpSubdir = Proxy } (tag, workingState) = Map.elemAt tagIdx (allTags repoState) (tagIdx, prng') = randomR (0, Map.size (allTags repoState) - 1) prng @@ -631,7 +632,7 @@ vcsTestDriverGit verbosity vcs repoRoot = return (Just commit') , vcsTagState = \_ tagname -> - git ["tag", "--force", tagname] + git ["tag", "--force", "--no-sign", tagname] , vcsSwitchBranch = \RepoState{allBranches} branchname -> do unless (branchname `Map.member` allBranches) $ diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs index c6cf5d4..9624361 100644 --- a/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs @@ -21,7 +21,7 @@ import Text.Show.Pretty (parseValue, valToStr) import Test.Tasty (TestTree) import Test.Tasty.QuickCheck -import Distribution.Types.GenericPackageDescription (FlagName) +import Distribution.Types.Flag (FlagName) import Distribution.Utils.ShortText (ShortText) import Distribution.Client.Setup (defaultMaxBackjumps) diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs index d6c1a1d..3e725c1 100644 --- a/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -478,7 +478,7 @@ db1 = ] -- In this example, we _can_ install C and D as independent goals, but we have --- to pick two diferent versions for B (arbitrarily) +-- to pick two different versions for B (arbitrarily) db2 :: ExampleDb db2 = [ Right $ exAv "A" 1 [] @@ -874,7 +874,7 @@ db14 = [ -- has a setup dependency on D, and D has a regular dependency on C-*. However, -- version C-1.0 is already available (perhaps it didn't have this setup dep). -- Thus, we should be able to break this cycle even if we are installing package --- E, which explictly depends on C-2.0. +-- E, which explicitly depends on C-2.0. db15 :: ExampleDb db15 = [ -- First example (real cycle, no solution) @@ -1211,7 +1211,7 @@ testIndepGoals4 name = -- | Test the trace messages that we get when a package refers to an unknown pkg -- -- TODO: Currently we don't actually test the trace messages, and this particular --- test still suceeds. The trace can only be verified by hand. +-- test still succeeds. The trace can only be verified by hand. db21 :: ExampleDb db21 = [ Right $ exAv "A" 1 [ExAny "B"] diff --git a/cabal/cabal-testsuite/PackageTests/AutogenModules/SrcDist/setup.test.hs b/cabal/cabal-testsuite/PackageTests/AutogenModules/SrcDist/setup.test.hs index c5fbcf2..16c5e75 100644 --- a/cabal/cabal-testsuite/PackageTests/AutogenModules/SrcDist/setup.test.hs +++ b/cabal/cabal-testsuite/PackageTests/AutogenModules/SrcDist/setup.test.hs @@ -13,7 +13,7 @@ main = setupAndCabalTest $ do -- Calling sdist without running configure first makes test fail with: -- "Exception: Run the 'configure' command first." - -- This is becuase we are calling getPersistBuildConfig + -- This is because we are calling getPersistBuildConfig configureResult <- setup' "configure" [] sdistResult <- setup' "sdist" [] diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external.test.hs index 3e9936d..d07a967 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external.test.hs @@ -2,6 +2,7 @@ import Test.Cabal.Prelude main = cabalTest $ do skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) + skipIf =<< isWindows -- TODO: https://github.com/haskell/cabal/issues/6271 withProjectFile "cabal.external.project" $ do cabal "v2-build" ["exe"] withPlan $ do diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.test.hs index ed5c097..8aa865a 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.test.hs @@ -2,6 +2,7 @@ import Test.Cabal.Prelude main = cabalTest $ do skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) + skipIf =<< isWindows -- TODO: https://github.com/haskell/cabal/issues/6271 withProjectFile "cabal.internal.project" $ do cabal "v2-build" ["exe"] withPlan $ do diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/Includes3.cabal b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/Includes3.cabal index 483f21a..9bd9615 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/Includes3.cabal +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/Includes3.cabal @@ -9,17 +9,17 @@ cabal-version: 1.25 library sigs build-depends: base signatures: Data.Map - hs-source-dirs: sigs + hs-source-dirs: repo/sigs-0.1.0.0 default-language: Haskell2010 library indef build-depends: base, sigs exposed-modules: Foo - hs-source-dirs: indef + hs-source-dirs: repo/indef-0.1.0.0 default-language: Haskell2010 executable exe build-depends: base, containers, indef main-is: Main.hs - hs-source-dirs: exe + hs-source-dirs: repo/exe-0.1.0.0 default-language: Haskell2010 diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-external.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-external.test.hs index 2940109..1e247c8 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-external.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-external.test.hs @@ -2,6 +2,7 @@ import Test.Cabal.Prelude main = cabalTest $ do skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) + skipIf =<< isWindows -- TODO: https://github.com/haskell/cabal/issues/6271 withProjectFile "cabal.external.project" $ do cabal "v2-build" ["exe"] withPlan $ do diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-internal.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-internal.test.hs index 56c49c6..ebf0589 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-internal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-internal.test.hs @@ -2,6 +2,7 @@ import Test.Cabal.Prelude main = cabalTest $ do skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) + skipIf =<< isWindows -- TODO: https://github.com/haskell/cabal/issues/6271 withProjectFile "cabal.internal.project" $ do cabal "v2-build" ["exe"] withPlan $ do diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-repo.out b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-repo.out new file mode 100644 index 0000000..ac44d97 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-repo.out @@ -0,0 +1,29 @@ +# cabal v1-update +Downloading the latest package list from test-local-repo +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc-<GHCVER> -O1 +In order, the following will be built: + - sigs-0.1.0.0 (lib) (requires download & build) + - indef-0.1.0.0 (lib) (requires download & build) + - indef-0.1.0.0 (lib with Data.Map=containers-<VERSION>:Data.Map) (requires download & build) + - exe-0.1.0.0 (exe:exe) (first run) +Configuring library for sigs-0.1.0.0.. +Preprocessing library for sigs-0.1.0.0.. +Building library instantiated with Data.Map = <Data.Map> +for sigs-0.1.0.0.. +Installing library in <PATH> +Configuring library for indef-0.1.0.0.. +Preprocessing library for indef-0.1.0.0.. +Building library instantiated with Data.Map = <Data.Map> +for indef-0.1.0.0.. +Installing library in <PATH> +Configuring library instantiated with Data.Map = containers-<VERSION>:Data.Map +for indef-0.1.0.0.. +Preprocessing library for indef-0.1.0.0.. +Building library instantiated with Data.Map = containers-<VERSION>:Data.Map +for indef-0.1.0.0.. +Installing library in <PATH> +Configuring executable 'exe' for exe-0.1.0.0.. +Preprocessing executable 'exe' for exe-0.1.0.0.. +Building executable 'exe' for exe-0.1.0.0.. diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-repo.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-repo.test.hs new file mode 100644 index 0000000..713fcbc --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-repo.test.hs @@ -0,0 +1,8 @@ +import Test.Cabal.Prelude +main = withShorterPathForNewBuildStore $ \storeDir -> + cabalTest $ do + skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) + skipIf =<< isWindows -- TODO: https://github.com/haskell/cabal/issues/6271 + withProjectFile "cabal.repo.project" $ do + withRepo "repo" $ do + cabalG ["--store-dir=" ++ storeDir] "v2-build" ["exe"] diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal.external.project b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal.external.project index 4c9d75f..58c0e9b 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal.external.project +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal.external.project @@ -1 +1 @@ -packages: exe indef sigs +packages: repo/exe-0.1.0.0 repo/indef-0.1.0.0 repo/sigs-0.1.0.0 diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal.repo.project b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal.repo.project new file mode 100644 index 0000000..b1df788 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal.repo.project @@ -0,0 +1 @@ +packages: repo/exe-0.1.0.0 diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/exe/Main.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/repo/exe-0.1.0.0/Main.hs index e0cb6d0..e0cb6d0 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/exe/Main.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/repo/exe-0.1.0.0/Main.hs diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/exe/exe.cabal b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/repo/exe-0.1.0.0/exe.cabal index 2422fff..2422fff 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/exe/exe.cabal +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/repo/exe-0.1.0.0/exe.cabal diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/indef/Foo.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/repo/indef-0.1.0.0/Foo.hs index 5be3e4b..5be3e4b 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/indef/Foo.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/repo/indef-0.1.0.0/Foo.hs diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/indef/indef.cabal b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/repo/indef-0.1.0.0/indef.cabal index 625ff16..625ff16 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/indef/indef.cabal +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/repo/indef-0.1.0.0/indef.cabal diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/sigs/Data/Map.hsig b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/repo/sigs-0.1.0.0/Data/Map.hsig index 997ec1a..997ec1a 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/sigs/Data/Map.hsig +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/repo/sigs-0.1.0.0/Data/Map.hsig diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/sigs/sigs.cabal b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/repo/sigs-0.1.0.0/sigs.cabal index d1bbb82..d1bbb82 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/sigs/sigs.cabal +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/repo/sigs-0.1.0.0/sigs.cabal diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-explicit.out b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-explicit.out index 67ed89e..da91bf8 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-explicit.out +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-explicit.out @@ -8,7 +8,7 @@ for sigs-0.1.0.0.. Preprocessing library for sigs-0.1.0.0.. Running Haddock on library instantiated with Data.Map = <Data.Map> for sigs-0.1.0.0.. -Documentation created: ../setup-external-explicit.dist/work/sigs/dist/doc/html/sigs/index.html +Documentation created: ../../setup-external-explicit.dist/work/repo/sigs-0.1.0.0/dist/doc/html/sigs/index.html # Setup copy Installing library in <PATH> # Setup register @@ -24,7 +24,7 @@ for indef-0.1.0.0.. Preprocessing library for indef-0.1.0.0.. Running Haddock on library instantiated with Data.Map = <Data.Map> for indef-0.1.0.0.. -Documentation created: ../setup-external-explicit.dist/work/indef/dist/doc/html/indef/index.html +Documentation created: ../../setup-external-explicit.dist/work/repo/indef-0.1.0.0/dist/doc/html/indef/index.html # Setup copy Installing library in <PATH> # Setup register diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-explicit.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-explicit.test.hs index 4275277..50e158f 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-explicit.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-explicit.test.hs @@ -3,5 +3,5 @@ import Test.Cabal.Prelude main = setupTest $ do skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) withPackageDb $ do - withDirectory "sigs" $ setup_install_with_docs ["--cid", "sigs-0.1.0.0", "lib:sigs"] - withDirectory "indef" $ setup_install_with_docs ["--cid", "indef-0.1.0.0", "--dependency=sigs=sigs-0.1.0.0", "lib:indef"] + withDirectory "repo/sigs-0.1.0.0" $ setup_install_with_docs ["--cid", "sigs-0.1.0.0", "lib:sigs"] + withDirectory "repo/indef-0.1.0.0" $ setup_install_with_docs ["--cid", "indef-0.1.0.0", "--dependency=sigs=sigs-0.1.0.0", "lib:indef"] diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-fail.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-fail.test.hs index 2b9a075..fcdcc9c 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-fail.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-fail.test.hs @@ -2,10 +2,10 @@ import Test.Cabal.Prelude main = setupAndCabalTest $ do skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) withPackageDb $ do - withDirectory "sigs" $ setup_install [] - withDirectory "indef" $ setup_install [] + withDirectory "repo/sigs-0.1.0.0" $ setup_install [] + withDirectory "repo/indef-0.1.0.0" $ setup_install [] -- Forgot to build the instantiated versions! - withDirectory "exe" $ do + withDirectory "repo/exe-0.1.0.0" $ do -- Missing package message includes a unit identifier, -- which wobbles when version numbers change r <- recordMode DoNotRecord . fails $ setup' "configure" [] diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-ok.cabal.out b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-ok.cabal.out index eb5625f..3df24d7 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-ok.cabal.out +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-ok.cabal.out @@ -9,7 +9,7 @@ for sigs-0.1.0.0.. Preprocessing library for sigs-0.1.0.0.. Running Haddock on library instantiated with Data.Map = <Data.Map> for sigs-0.1.0.0.. -Documentation created: ../setup-external-ok.cabal.dist/work/sigs/dist/doc/html/sigs/index.html +Documentation created: ../../setup-external-ok.cabal.dist/work/repo/sigs-0.1.0.0/dist/doc/html/sigs/index.html # Setup copy Installing library in <PATH> # Setup register @@ -26,7 +26,7 @@ for indef-0.1.0.0.. Preprocessing library for indef-0.1.0.0.. Running Haddock on library instantiated with Data.Map = <Data.Map> for indef-0.1.0.0.. -Documentation created: ../setup-external-ok.cabal.dist/work/indef/dist/doc/html/indef/index.html +Documentation created: ../../setup-external-ok.cabal.dist/work/repo/indef-0.1.0.0/dist/doc/html/indef/index.html # Setup copy Installing library in <PATH> # Setup register @@ -44,7 +44,7 @@ Preprocessing library for sigs-0.1.0.0.. Running Haddock on library instantiated with Data.Map = containers-<VERSION>:Data.Map for sigs-0.1.0.0.. -Documentation created: ../setup-external-ok.cabal.dist/work/sigs/dist/doc/html/sigs/index.html +Documentation created: ../../setup-external-ok.cabal.dist/work/repo/sigs-0.1.0.0/dist/doc/html/sigs/index.html # Setup copy Installing library in <PATH> # Setup register @@ -62,7 +62,7 @@ Preprocessing library for indef-0.1.0.0.. Running Haddock on library instantiated with Data.Map = containers-<VERSION>:Data.Map for indef-0.1.0.0.. -Documentation created: ../setup-external-ok.cabal.dist/work/indef/dist/doc/html/indef/index.html +Documentation created: ../../setup-external-ok.cabal.dist/work/repo/indef-0.1.0.0/dist/doc/html/indef/index.html # Setup copy Installing library in <PATH> # Setup register diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-ok.out b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-ok.out index 31d49ef..4742508 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-ok.out +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-ok.out @@ -8,7 +8,7 @@ for sigs-0.1.0.0.. Preprocessing library for sigs-0.1.0.0.. Running Haddock on library instantiated with Data.Map = <Data.Map> for sigs-0.1.0.0.. -Documentation created: ../setup-external-ok.dist/work/sigs/dist/doc/html/sigs/index.html +Documentation created: ../../setup-external-ok.dist/work/repo/sigs-0.1.0.0/dist/doc/html/sigs/index.html # Setup copy Installing library in <PATH> # Setup register @@ -24,7 +24,7 @@ for indef-0.1.0.0.. Preprocessing library for indef-0.1.0.0.. Running Haddock on library instantiated with Data.Map = <Data.Map> for indef-0.1.0.0.. -Documentation created: ../setup-external-ok.dist/work/indef/dist/doc/html/indef/index.html +Documentation created: ../../setup-external-ok.dist/work/repo/indef-0.1.0.0/dist/doc/html/indef/index.html # Setup copy Installing library in <PATH> # Setup register @@ -41,7 +41,7 @@ Preprocessing library for sigs-0.1.0.0.. Running Haddock on library instantiated with Data.Map = containers-<VERSION>:Data.Map for sigs-0.1.0.0.. -Documentation created: ../setup-external-ok.dist/work/sigs/dist/doc/html/sigs/index.html +Documentation created: ../../setup-external-ok.dist/work/repo/sigs-0.1.0.0/dist/doc/html/sigs/index.html # Setup copy Installing library in <PATH> # Setup register @@ -58,7 +58,7 @@ Preprocessing library for indef-0.1.0.0.. Running Haddock on library instantiated with Data.Map = containers-<VERSION>:Data.Map for indef-0.1.0.0.. -Documentation created: ../setup-external-ok.dist/work/indef/dist/doc/html/indef/index.html +Documentation created: ../../setup-external-ok.dist/work/repo/indef-0.1.0.0/dist/doc/html/indef/index.html # Setup copy Installing library in <PATH> # Setup register diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-ok.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-ok.test.hs index e89541f..0563be2 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-ok.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-external-ok.test.hs @@ -5,18 +5,18 @@ main = setupAndCabalTest $ do skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) withPackageDb $ do containers_id <- getIPID "containers" - withDirectory "sigs" $ setup_install_with_docs ["--ipid", "sigs-0.1.0.0"] - withDirectory "indef" $ setup_install_with_docs ["--ipid", "indef-0.1.0.0"] - withDirectory "sigs" $ do + withDirectory "repo/sigs-0.1.0.0" $ setup_install_with_docs ["--ipid", "sigs-0.1.0.0"] + withDirectory "repo/indef-0.1.0.0" $ setup_install_with_docs ["--ipid", "indef-0.1.0.0"] + withDirectory "repo/sigs-0.1.0.0" $ do -- NB: this REUSES the dist directory that we typechecked -- indefinitely, but it's OK; the recompile checker should get it. setup_install_with_docs ["--ipid", "sigs-0.1.0.0", "--instantiate-with", "Data.Map=" ++ containers_id ++ ":Data.Map"] - withDirectory "indef" $ do + withDirectory "repo/indef-0.1.0.0" $ do -- Ditto. setup_install_with_docs ["--ipid", "indef-0.1.0.0", "--instantiate-with", "Data.Map=" ++ containers_id ++ ":Data.Map"] - withDirectory "exe" $ do + withDirectory "repo/exe-0.1.0.0" $ do setup_install [] runExe' "exe" [] >>= assertOutputContains "fromList [(0,2),(2,4)]" diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-internal.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-internal.test.hs index ef240fc..b75823a 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-internal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/setup-internal.test.hs @@ -3,7 +3,7 @@ main = setupAndCabalTest $ do skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) withPackageDb $ do setup_install [] - _ <- runM "touch" ["indef/Foo.hs"] + _ <- runM "touch" ["repo/indef-0.1.0.0/Foo.hs"] setup "build" [] runExe' "exe" [] >>= assertOutputContains "fromList [(0,2),(2,4)]" diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/cabal.test.hs index 08cbbd3..ae7e000 100644 --- a/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/cabal.test.hs @@ -2,4 +2,5 @@ import Test.Cabal.Prelude main = cabalTest $ do -- GHC 8.2.2 had a regression ("unknown package: hole"), see also #4908 skipUnless =<< ghcVersionIs (\v -> v >= mkVersion [8,2] && v /= mkVersion [8,2,2]) + skipIf =<< isWindows -- TODO: https://github.com/haskell/cabal/issues/6271 cabal "v2-build" ["all"] diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/OptionsFlag/OptionsFlag.cabal b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/OptionsFlag/OptionsFlag.cabal new file mode 100644 index 0000000..10be2b5 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/OptionsFlag/OptionsFlag.cabal @@ -0,0 +1,10 @@ +name: OptionsFlag +version: 1.0 +build-type: Simple +cabal-version: >= 1.10 + +benchmark optionsflag + type: exitcode-stdio-1.0 + main-is: OptionsFlag.hs + build-depends: base + default-language: Haskell2010 diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/OptionsFlag/OptionsFlag.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/OptionsFlag/OptionsFlag.hs new file mode 100644 index 0000000..2611448 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/OptionsFlag/OptionsFlag.hs @@ -0,0 +1,12 @@ +module Main where + +import System.Environment (getArgs) +import System.Exit (exitFailure, exitSuccess) + +main :: IO () +main = do + args <- getArgs + let allArgs = unwords args + if allArgs == "1 2 3 4 5 6" + then exitSuccess + else putStrLn ("Got: " ++ allArgs) >> exitFailure diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/OptionsFlag/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/OptionsFlag/cabal.out new file mode 100644 index 0000000..75e31a3 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/OptionsFlag/cabal.out @@ -0,0 +1,11 @@ +# cabal v2-bench +Resolving dependencies... +Build profile: -w ghc-<GHCVER> -O1 +In order, the following will be built: + - OptionsFlag-1.0 (bench:optionsflag) (first run) +Configuring benchmark 'optionsflag' for OptionsFlag-1.0.. +Preprocessing benchmark 'optionsflag' for OptionsFlag-1.0.. +Building benchmark 'optionsflag' for OptionsFlag-1.0.. +Running 1 benchmarks... +Benchmark optionsflag: RUNNING... +Benchmark optionsflag: FINISH diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/OptionsFlag/cabal.project b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/OptionsFlag/cabal.project new file mode 100644 index 0000000..e6fdbad --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/OptionsFlag/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/OptionsFlag/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/OptionsFlag/cabal.test.hs new file mode 100644 index 0000000..9174ba9 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/OptionsFlag/cabal.test.hs @@ -0,0 +1,9 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + cabal "v2-bench" + [ "--benchmark-option=1" + , "--benchmark-options=\"2 3\"" + , "--benchmark-option=4" + , "--benchmark-options=\"5 6\"" + ] diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdTest/OptionsFlag/OptionsFlag.cabal b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdTest/OptionsFlag/OptionsFlag.cabal new file mode 100644 index 0000000..1c9afd3 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdTest/OptionsFlag/OptionsFlag.cabal @@ -0,0 +1,10 @@ +name: OptionsFlag +version: 1.0 +build-type: Simple +cabal-version: >= 1.10 + +test-suite optionsflag + type: exitcode-stdio-1.0 + main-is: OptionsFlag.hs + build-depends: base + default-language: Haskell2010 diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdTest/OptionsFlag/OptionsFlag.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdTest/OptionsFlag/OptionsFlag.hs new file mode 100644 index 0000000..2611448 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdTest/OptionsFlag/OptionsFlag.hs @@ -0,0 +1,12 @@ +module Main where + +import System.Environment (getArgs) +import System.Exit (exitFailure, exitSuccess) + +main :: IO () +main = do + args <- getArgs + let allArgs = unwords args + if allArgs == "1 2 3 4 5 6" + then exitSuccess + else putStrLn ("Got: " ++ allArgs) >> exitFailure diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdTest/OptionsFlag/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdTest/OptionsFlag/cabal.out new file mode 100644 index 0000000..d845abf --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdTest/OptionsFlag/cabal.out @@ -0,0 +1,13 @@ +# cabal v2-test +Resolving dependencies... +Build profile: -w ghc-<GHCVER> -O1 +In order, the following will be built: + - OptionsFlag-1.0 (test:optionsflag) (first run) +Configuring test suite 'optionsflag' for OptionsFlag-1.0.. +Preprocessing test suite 'optionsflag' for OptionsFlag-1.0.. +Building test suite 'optionsflag' for OptionsFlag-1.0.. +Running 1 test suites... +Test suite optionsflag: RUNNING... +Test suite optionsflag: PASS +Test suite logged to: <ROOT>/cabal.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/OptionsFlag-1.0/t/optionsflag/test/OptionsFlag-1.0-optionsflag.log +1 of 1 test suites (1 of 1 test cases) passed. diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdTest/OptionsFlag/cabal.project b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdTest/OptionsFlag/cabal.project new file mode 100644 index 0000000..e6fdbad --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdTest/OptionsFlag/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdTest/OptionsFlag/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdTest/OptionsFlag/cabal.test.hs new file mode 100644 index 0000000..e9b8f5b --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdTest/OptionsFlag/cabal.test.hs @@ -0,0 +1,9 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + cabal "v2-test" + [ "--test-option=1" + , "--test-options=\"2 3\"" + , "--test-option=4" + , "--test-options=\"5 6\"" + ] diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T5309/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/Regression/T5309/cabal.test.hs index 62059c5..71f5f7a 100644 --- a/cabal/cabal-testsuite/PackageTests/Regression/T5309/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Regression/T5309/cabal.test.hs @@ -1,5 +1,6 @@ import Test.Cabal.Prelude main = cabalTest $ do - cabal "v2-build" ["all"] - cabal "v2-test" ["all"] - cabal "v2-bench" ["all"] + skipIf =<< isWindows -- TODO: https://github.com/haskell/cabal/issues/6271 + cabal "v2-build" ["all"] + cabal "v2-test" ["all"] + cabal "v2-bench" ["all"] diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrixWrapper.h b/cabal/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrixWrapper.h index f592347..e158143 100644 --- a/cabal/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrixWrapper.h +++ b/cabal/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrixWrapper.h @@ -5,7 +5,7 @@ #include "dynamicCharacterOperations.h" -/** Initialize a matrix (fill in all values for non-ambiguous chracter transition costs) using a TCM sent in from an outside source. */ +/** Initialize a matrix (fill in all values for non-ambiguous character transition costs) using a TCM sent in from an outside source. */ costMatrix_p matrixInit(size_t alphSize, int *tcm); /** C wrapper for cpp destructor */ diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T5677/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/Regression/T5677/cabal.test.hs index cf2a0b0..133f492 100644 --- a/cabal/cabal-testsuite/PackageTests/Regression/T5677/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Regression/T5677/cabal.test.hs @@ -2,4 +2,5 @@ import Test.Cabal.Prelude main = cabalTest $ do -- -Wmissing-export-lists is new in 8.4. skipUnless =<< ghcVersionIs (>= mkVersion [8,3]) + skipIf =<< isWindows -- TODO: https://github.com/haskell/cabal/issues/6271 cabal "v2-build" ["all"] diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T6334/cabal.out b/cabal/cabal-testsuite/PackageTests/Regression/T6334/cabal.out new file mode 100644 index 0000000..255f6d4 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T6334/cabal.out @@ -0,0 +1,8 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc-<GHCVER> -O1 +In order, the following will be built: + - foo-0 (lib) (first run) +Configuring library for foo-0.. +Preprocessing library for foo-0.. +Building library for foo-0.. diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T6334/cabal.project b/cabal/cabal-testsuite/PackageTests/Regression/T6334/cabal.project new file mode 100644 index 0000000..e63723e --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T6334/cabal.project @@ -0,0 +1 @@ +packages: foo diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T6334/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/Regression/T6334/cabal.test.hs new file mode 100644 index 0000000..1adfcad --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T6334/cabal.test.hs @@ -0,0 +1,3 @@ +import Test.Cabal.Prelude +main = cabalTest $ + cabal "v2-build" ["all"] diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T6334/foo/README.md b/cabal/cabal-testsuite/PackageTests/Regression/T6334/foo/README.md new file mode 100644 index 0000000..82ece4f --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T6334/foo/README.md @@ -0,0 +1 @@ +Some file diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T6334/foo/foo.cabal b/cabal/cabal-testsuite/PackageTests/Regression/T6334/foo/foo.cabal new file mode 100644 index 0000000..d6e03d8 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T6334/foo/foo.cabal @@ -0,0 +1,13 @@ +cabal-version: 2.2 +name: foo +version: 0 +description: + https://github.com/haskell/cabal/issues/6334 +extra-source-files: + README.md + +library + default-language: Haskell2010 + hs-source-dirs: src + exposed-modules: Foo + build-depends: base <5 diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T6334/foo/src/Foo.hs b/cabal/cabal-testsuite/PackageTests/Regression/T6334/foo/src/Foo.hs new file mode 100644 index 0000000..42e29cb --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T6334/foo/src/Foo.hs @@ -0,0 +1 @@ +module Foo () where diff --git a/cabal/cabal-testsuite/Test/Cabal/Prelude.hs b/cabal/cabal-testsuite/Test/Cabal/Prelude.hs index f5fe619..e070a52 100644 --- a/cabal/cabal-testsuite/Test/Cabal/Prelude.hs +++ b/cabal/cabal-testsuite/Test/Cabal/Prelude.hs @@ -818,8 +818,8 @@ getOpenFilesLimit = return (Just 2048) getOpenFilesLimit = liftIO $ do ResourceLimits { softLimit } <- getResourceLimit ResourceOpenFiles case softLimit of - ResourceLimit n -> return (Just n) - _ -> return Nothing + ResourceLimit n | n >= 0 && n <= 4096 -> return (Just n) + _ -> return Nothing #endif hasCabalForGhc :: TestM Bool diff --git a/cabal/cabal-testsuite/cabal-testsuite.cabal b/cabal/cabal-testsuite/cabal-testsuite.cabal index ad76c95..bd09f1d 100644 --- a/cabal/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal/cabal-testsuite/cabal-testsuite.cabal @@ -61,10 +61,10 @@ library , directory ^>= 1.2.0.1 || ^>= 1.3.0.0 , exceptions ^>= 0.10.0 , filepath ^>= 1.3.0.1 || ^>= 1.4.0.0 - , optparse-applicative ^>= 0.14.3.0 + , optparse-applicative ^>= 0.14.3.0 || ^>=0.15.1.0 , process ^>= 1.1.0.2 || ^>= 1.2.0.0 || ^>= 1.4.2.0 || ^>= 1.6.1.0 , regex-compat-tdfa ^>= 0.95.1.4 - , regex-tdfa ^>= 1.2.3.1 + , regex-tdfa ^>= 1.2.3.1 || ^>=1.3.0 , temporary ^>= 1.3 , text ^>= 1.2.3.1 , transformers ^>= 0.3.0.0 || ^>= 0.4.2.0 || ^>= 0.5.2.0 @@ -91,7 +91,7 @@ executable cabal-tests , process , transformers -- dependencies specific to exe:cabal-tests - , clock ^>= 0.7.2 + , clock ^>= 0.7.2 || ^>=0.8 build-tool-depends: cabal-testsuite:setup diff --git a/cabal/cabal.project b/cabal/cabal.project index 83a71bf..e041cc3 100644 --- a/cabal/cabal.project +++ b/cabal/cabal.project @@ -1,4 +1,6 @@ -packages: Cabal/ cabal-testsuite/ cabal-install/ solver-benchmarks/ +packages: Cabal/ cabal-testsuite/ +packages: cabal-install/ solver-benchmarks/ +tests: True -- Uncomment to allow picking up extra local unpacked deps: --optional-packages: */ diff --git a/cabal/cabal.project.travis.libonly b/cabal/cabal.project.libonly index 6cc029b..615915b 100644 --- a/cabal/cabal.project.travis.libonly +++ b/cabal/cabal.project.libonly @@ -1,8 +1,5 @@ --- A copy of cabal.project, but with a trimmed down 'packages' --- field. Needed for LIB_ONLY configurations that can't build cabal-install, --- only lib:Cabal. - packages: Cabal/ cabal-testsuite/ +tests: True -- Uncomment to allow picking up extra local unpacked deps: --optional-packages: */ @@ -20,5 +17,3 @@ package Cabal ghc-options: -fno-ignore-asserts package cabal-testsuite ghc-options: -fno-ignore-asserts -package cabal-install - ghc-options: -fno-ignore-asserts diff --git a/cabal/cabal.project.travis b/cabal/cabal.project.travis deleted file mode 100644 index 5998c90..0000000 --- a/cabal/cabal.project.travis +++ /dev/null @@ -1,20 +0,0 @@ --- Force error messages to be better --- Parallel new-build error messages are non-existent. --- Turn off parallelization to get good errors. -jobs: 1 - --- We vendor a copy of hackage-repo-tool so that we can --- build it reliably. If we eventually get new-install --- in the bootstrap, this can go away. -optional-packages: hackage-repo-tool-*/ --- hackage-repo-tool has upper bound on Cabal -allow-newer: hackage-repo-tool:Cabal, hackage-repo-tool:time, hackage-repo-tool:directory - --- The -fno-warn-orphans is a hack to make Cabal-1.24 --- build properly (unfortunately the flags here get applied --- to the dependencies too!) -package Cabal - ghc-options: -Werror -fno-warn-orphans - -package cabal-install - ghc-options: -Werror diff --git a/cabal/release-checklist.md b/cabal/release-checklist.md new file mode 100644 index 0000000..746cef9 --- /dev/null +++ b/cabal/release-checklist.md @@ -0,0 +1,10 @@ +# For major release + +- Add new SPDX License list data + +# For release for new GHC version: + +- Update GHC flags in `normaliseGhcArgs`, and add the GHC version to + `supportedGHCVersions` (`Distribution.Simple.Program.GHC`) +- Update `Language.Haskell.Extension` list, if there are new GHC extensions +- Update `setupMinCabalVersionConstraint` (in `Distribution.Client.ProjectPlanning`) diff --git a/cabal/solver-benchmarks/solver-benchmarks.cabal b/cabal/solver-benchmarks/solver-benchmarks.cabal index f91a00d..1fd5a86 100644 --- a/cabal/solver-benchmarks/solver-benchmarks.cabal +++ b/cabal/solver-benchmarks/solver-benchmarks.cabal @@ -33,7 +33,7 @@ library optparse-applicative, process, time, - statistics >= 0.14 && < 0.15, + statistics >= 0.14 && < 0.16, vector default-language: Haskell2010 @@ -54,7 +54,7 @@ test-suite unit-tests build-depends: base, solver-benchmarks, - statistics >= 0.14 && < 0.15, + statistics >= 0.14 && < 0.16, tasty, tasty-hunit default-language: Haskell2010 diff --git a/cabal/travis-common.sh b/cabal/travis-common.sh index 0582e28..40c102c 100644 --- a/cabal/travis-common.sh +++ b/cabal/travis-common.sh @@ -1,6 +1,5 @@ set -e -HACKAGE_REPO_TOOL_VERSION="0.1.1.1" CABAL_VERSION="3.1.0.0" CABAL_INSTALL_VERSION="3.1.0.0" @@ -16,7 +15,6 @@ CABAL_BDIR="${TRAVIS_BUILD_DIR}/dist-newstyle/build/$ARCH/ghc-$GHCVER/Cabal-${CA CABAL_TESTSUITE_BDIR="${TRAVIS_BUILD_DIR}/dist-newstyle/build/$ARCH/ghc-$GHCVER/cabal-testsuite-${CABAL_VERSION}" CABAL_INSTALL_BDIR="${TRAVIS_BUILD_DIR}/dist-newstyle/build/$ARCH/ghc-$GHCVER/cabal-install-${CABAL_INSTALL_VERSION}" SOLVER_BENCHMARKS_BDIR="${TRAVIS_BUILD_DIR}/dist-newstyle/build/$ARCH/ghc-$GHCVER/solver-benchmarks-${CABAL_VERSION}" -HACKAGE_REPO_TOOL_BDIR="${TRAVIS_BUILD_DIR}/dist-newstyle/build/$ARCH/ghc-$GHCVER/hackage-repo-tool-${HACKAGE_REPO_TOOL_VERSION}/x/hackage-repo-tool" CABAL_INSTALL_EXE=${CABAL_INSTALL_BDIR}/x/cabal/build/cabal/cabal # --------------------------------------------------------------------- diff --git a/cabal/travis-install.sh b/cabal/travis-install.sh index ade6e57..7b07885 100755 --- a/cabal/travis-install.sh +++ b/cabal/travis-install.sh @@ -19,7 +19,7 @@ if [ -z ${STACK_CONFIG+x} ]; then if [ "$SCRIPT" = "meta" ]; then # change to /tmp so cabal.project doesn't affect new-install cabal v2-update - (cd /tmp && cabal v2-install alex --constraint='alex ^>= 3.2.4' --overwrite=always) + (cd /tmp && cabal v2-install alex --constraint='alex ^>= 3.2.5' --overwrite=always) (cd /tmp && cabal v2-install happy --constraint='happy ^>= 1.19.9' --overwrite=always) fi diff --git a/cabal/travis-script.sh b/cabal/travis-script.sh index 80724b6..bad52e6 100755 --- a/cabal/travis-script.sh +++ b/cabal/travis-script.sh @@ -73,9 +73,7 @@ timed cabal update # Install executables if necessary # --------------------------------------------------------------------- -#if ! command -v happy; then - timed cabal install $jobs happy -#fi +timed cabal install $jobs happy # --------------------------------------------------------------------- # Setup our local project @@ -83,16 +81,10 @@ timed cabal update make cabal-install-monolithic if [ "x$CABAL_LIB_ONLY" = "xYES" ]; then - cp cabal.project.travis.libonly cabal.project + cp cabal.project.libonly cabal.project fi cp cabal.project.local.travis cabal.project.local -# hackage-repo-tool is a bit touchy to install on GHC 8.0, so instead we -# do it via new-build. See also cabal.project.local.travis. The downside of -# doing it this way is that the build product cannot be cached, but -# hackage-repo-tool is a relatively small package so it's good. -timed cabal unpack hackage-repo-tool-${HACKAGE_REPO_TOOL_VERSION} - # --------------------------------------------------------------------- # Cabal # --------------------------------------------------------------------- @@ -111,7 +103,12 @@ if [ "x$CABAL_INSTALL_ONLY" != "xYES" ] ; then # Run haddock. if [ "$TRAVIS_OS_NAME" = "linux" ]; then # TODO: use new-haddock? - (cd Cabal && timed cabal act-as-setup --build-type=Simple -- haddock --builddir=${CABAL_BDIR}) || exit $? + + # haddock: internal error: synifyKind + # https://github.com/haskell/haddock/issues/242 + if [ "$GHCVER" != "7.6.3" ]; then + (cd Cabal && timed cabal act-as-setup --build-type=Simple -- haddock --builddir=${CABAL_BDIR}) || exit $? + fi fi # Check for package warnings @@ -162,7 +159,7 @@ fi # test suites are baked into the cabal binary timed cabal new-build $jobs $CABAL_INSTALL_FLAGS cabal-install:cabal -timed cabal new-build $jobs hackage-repo-tool +timed cabal new-install $jobs hackage-repo-tool --overwrite-policy=always if [ "x$SKIP_TESTS" = "xYES" ]; then exit 1; @@ -172,7 +169,7 @@ fi timed ${CABAL_INSTALL_EXE} update # Big tests -(cd cabal-testsuite && timed ${CABAL_TESTSUITE_BDIR}/build/cabal-tests/cabal-tests --builddir=${CABAL_TESTSUITE_BDIR} -j3 --skip-setup-tests --with-cabal ${CABAL_INSTALL_EXE} --with-hackage-repo-tool ${HACKAGE_REPO_TOOL_BDIR}/build/hackage-repo-tool/hackage-repo-tool $TEST_OPTIONS) || exit $? +(cd cabal-testsuite && timed ${CABAL_TESTSUITE_BDIR}/build/cabal-tests/cabal-tests --builddir=${CABAL_TESTSUITE_BDIR} -j3 --skip-setup-tests --with-cabal ${CABAL_INSTALL_EXE} --with-hackage-repo-tool hackage-repo-tool $TEST_OPTIONS) || exit $? # Cabal check # TODO: remove -main-is and re-enable me. diff --git a/cabal/travis/upload.sh b/cabal/travis/upload.sh index d9fd618..1ae6014 100755 --- a/cabal/travis/upload.sh +++ b/cabal/travis/upload.sh @@ -86,7 +86,7 @@ rm $BINARIES # Don't check me in! # Upload to S3 S3_URL=$(curl -X POST "https://s3-bouncer.herokuapp.com/put") -curl "$S3_URL" --upload-file binaries.tgz +travis_retry curl "$S3_URL" --upload-file binaries.tgz rm binaries.tgz # Don't check me in! echo "$S3_URL" | xargs basename | cut -d '?' -f 1 > s3-object.txt diff --git a/cabal/validate.dockerfile b/cabal/validate.dockerfile new file mode 100644 index 0000000..ac52732 --- /dev/null +++ b/cabal/validate.dockerfile @@ -0,0 +1,48 @@ +FROM haskell:8.6.5 + +# We need prof GHC for some tests +RUN apt-get update +RUN apt-get install ghc-8.6.5-prof + +# Install cabal-plan +RUN cabal v2-update +RUN cabal v2-install cabal-plan --constraint 'cabal-plan ^>=0.6' + +# We install happy, so it's in the store; we (hopefully) don't use it directly. +RUN cabal v2-install happy --constraint 'happy ^>=1.19.12' + +# Install some other dependencies +# Remove $HOME/.ghc so there aren't any environments +RUN cabal v2-install -w ghc-8.6.5 --lib \ + aeson \ + async \ + base-compat \ + base16-bytestring \ + base64-bytestring \ + cryptohash-sha256 \ + Diff \ + echo \ + ed25519 \ + edit-distance \ + haskell-lexer \ + HTTP \ + network \ + optparse-applicative \ + pretty-show \ + regex-compat-tdfa \ + regex-tdfa \ + resolv \ + statistics \ + tar \ + tasty \ + tasty-golden \ + tasty-hunit \ + tasty-quickcheck \ + tree-diff \ + zlib \ + && rm -rf $HOME/.ghc + +# Validate +WORKDIR /build +COPY . /build +RUN sh ./validate.sh -w ghc-8.6.5 -v diff --git a/cabal/validate.sh b/cabal/validate.sh index 15c19d4..f6ab630 100755 --- a/cabal/validate.sh +++ b/cabal/validate.sh @@ -191,12 +191,12 @@ else PROJECTFILE=cabal.project.validate fi -BASEHC=$(basename $HC) +BASEHC=ghc-$($HC --numeric-version) BUILDDIR=dist-newstyle-validate-$BASEHC CABAL_TESTSUITE_BDIR="$(pwd)/$BUILDDIR/build/$ARCH/$BASEHC/cabal-testsuite-${CABAL_VERSION}" CABALNEWBUILD="${CABAL} v2-build $JOBS -w $HC --builddir=$BUILDDIR --project-file=$PROJECTFILE" -CABALPLAN="${CABALPLAN} --builddir=$BUILDDIR" +CABALPLANLISTBIN="${CABALPLAN} list-bin --builddir=$BUILDDIR" # SCRIPT ####################################################################### @@ -247,16 +247,16 @@ timed $CABALNEWBUILD Cabal:tests --enable-tests --disable-benchmarks --dry-run | timed $CABALNEWBUILD Cabal:tests --enable-tests --disable-benchmarks --dep || exit 1 timed $CABALNEWBUILD Cabal:tests --enable-tests --disable-benchmarks || exit 1 -CMD="$($CABALPLAN list-bin Cabal:test:unit-tests) $TESTSUITEJOBS --hide-successes --with-ghc=$HC" +CMD="$($CABALPLANLISTBIN Cabal:test:unit-tests) $TESTSUITEJOBS --hide-successes --with-ghc=$HC" (cd Cabal && timed $CMD) || exit 1 -CMD="$($CABALPLAN list-bin Cabal:test:check-tests) $TESTSUITEJOBS --hide-successes" +CMD="$($CABALPLANLISTBIN Cabal:test:check-tests) $TESTSUITEJOBS --hide-successes" (cd Cabal && timed $CMD) || exit 1 -CMD="$($CABALPLAN list-bin Cabal:test:parser-tests) $TESTSUITEJOBS --hide-successes" +CMD="$($CABALPLANLISTBIN Cabal:test:parser-tests) $TESTSUITEJOBS --hide-successes" (cd Cabal && timed $CMD) || exit 1 -CMD=$($CABALPLAN list-bin Cabal:test:hackage-tests) +CMD=$($CABALPLANLISTBIN Cabal:test:hackage-tests) (cd Cabal && timed $CMD read-fields) || exit 1 (cd Cabal && timed $CMD parsec d) || exit 1 (cd Cabal && timed $CMD roundtrip k) || exit 1 @@ -273,7 +273,7 @@ timed $CABALNEWBUILD cabal-testsuite --enable-tests --disable-benchmarks || exit echo "$CYAN=== cabal-testsuite: Cabal test ======================== $(date +%T) === $RESET" -CMD="$($CABALPLAN list-bin cabal-testsuite:exe:cabal-tests) --builddir=$CABAL_TESTSUITE_BDIR $TESTSUITEJOBS --with-ghc=$HC --hide-successes" +CMD="$($CABALPLANLISTBIN cabal-testsuite:exe:cabal-tests) --builddir=$CABAL_TESTSUITE_BDIR $TESTSUITEJOBS --with-ghc=$HC --hide-successes" (cd cabal-testsuite && timed $CMD) || exit 1 fi # CABALSUITETESTS (Cabal) @@ -300,19 +300,19 @@ if $CABALINSTALLTESTS; then echo "$CYAN=== cabal-install: test ================================ $(date +%T) === $RESET" # this are sorted in asc time used, quicker tests first. -CMD="$($CABALPLAN list-bin cabal-install:test:solver-quickcheck) $TESTSUITEJOBS --hide-successes" +CMD="$($CABALPLANLISTBIN cabal-install:test:solver-quickcheck) $TESTSUITEJOBS --hide-successes" (cd cabal-install && timed $CMD) || exit 1 # This doesn't work in parallel either -CMD="$($CABALPLAN list-bin cabal-install:test:unit-tests) -j1 --hide-successes" +CMD="$($CABALPLANLISTBIN cabal-install:test:unit-tests) -j1 --hide-successes" (cd cabal-install && timed $CMD) || exit 1 # Only single job, otherwise we fail with "Heap exhausted" -CMD="$($CABALPLAN list-bin cabal-install:test:memory-usage-tests) -j1 --hide-successes" +CMD="$($CABALPLANLISTBIN cabal-install:test:memory-usage-tests) -j1 --hide-successes" (cd cabal-install && timed $CMD) || exit 1 # This test-suite doesn't like concurrency -CMD="$($CABALPLAN list-bin cabal-install:test:integration-tests2) -j1 --hide-successes --with-ghc=$HC" +CMD="$($CABALPLANLISTBIN cabal-install:test:integration-tests2) -j1 --hide-successes --with-ghc=$HC" (cd cabal-install && timed $CMD) || exit 1 fi # CABALINSTALLTESTS @@ -321,7 +321,7 @@ fi # CABALINSTALLTESTS if $CABALSUITETESTS; then echo "$CYAN=== cabal-testsuite: cabal-install test ================ $(date +%T) === $RESET" -CMD="$($CABALPLAN list-bin cabal-testsuite:exe:cabal-tests) --builddir=$CABAL_TESTSUITE_BDIR --with-cabal=$($CABALPLAN list-bin cabal-install:exe:cabal) $TESTSUITEJOBS --hide-successes" +CMD="$($CABALPLANLISTBIN cabal-testsuite:exe:cabal-tests) --builddir=$CABAL_TESTSUITE_BDIR --with-cabal=$($CABALPLANLISTBIN cabal-install:exe:cabal) $TESTSUITEJOBS --hide-successes" (cd cabal-testsuite && timed $CMD) || exit 1 fi # CABALSUITETESTS diff --git a/hackage-security/.travis.yml b/hackage-security/.travis.yml index c1a4933..62a42d2 100644 --- a/hackage-security/.travis.yml +++ b/hackage-security/.travis.yml @@ -1,69 +1,220 @@ -# See also https://github.com/hvr/multi-ghc-travis +# This Travis job script has been generated by a script via +# +# haskell-ci '--ghc-head' '--osx=8.4.4' 'cabal.project' +# +# For more information, see https://github.com/haskell-CI/haskell-ci +# +# version: 0.7.20191101 +# language: c -sudo: false - +dist: xenial +git: + # whether to recursively clone submodules + submodules: false cache: directories: - $HOME/.cabal/packages - $HOME/.cabal/store - + - $HOME/.ghc-install before_cache: - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log + - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log # remove files that are regenerated by 'cabal update' - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx - + - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.* + - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json + - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache + - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar + - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx + - rm -rfv $CABALHOME/packages/head.hackage matrix: include: - - compiler: "ghc-7.4.2" - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.4.2], sources: [hvr-ghc]}} - - compiler: "ghc-7.6.3" - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.6.3], sources: [hvr-ghc]}} - - compiler: "ghc-7.8.4" - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}} - - compiler: "ghc-7.10.3" - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}} - - compiler: "ghc-8.0.2" - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}} - - compiler: "ghc-8.2.2" - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}} - - compiler: "ghc-8.4.3" - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.3], sources: [hvr-ghc]}} - + - compiler: ghc-8.8.1 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}} + - compiler: ghc-8.6.5 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-3.0"]}} + - compiler: ghc-8.4.4 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0"]}} + - compiler: ghc-8.2.2 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0"]}} + - compiler: ghc-8.0.2 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0"]}} + - compiler: ghc-7.10.3 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-3.0"]}} + - compiler: ghc-7.8.4 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-3.0"]}} + - compiler: ghc-7.6.3 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.6.3","cabal-install-3.0"]}} + - compiler: ghc-7.4.2 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.4.2","cabal-install-3.0"]}} + - compiler: ghc-head + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-head","cabal-install-head"]}} + - compiler: ghc-8.4.4 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0"]}} + os: osx + allow_failures: + - compiler: ghc-head before_install: - - HC=${CC} - - unset CC - - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH - + - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') + - WITHCOMPILER="-w $HC" + - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//') + - if [ "$TRAVIS_OS_NAME" = "osx" ]; then HADDOCK=$(echo $HADDOCK | sed "s:^/opt:$HOME/.ghc-install:"); fi + - HCPKG="$HC-pkg" + - unset CC + - CABAL=/opt/ghc/bin/cabal + - CABALHOME=$HOME/.cabal + - export PATH="$CABALHOME/bin:$PATH" + - TOP=$(pwd) + - if [ "$TRAVIS_OS_NAME" = "osx" ]; then curl https://haskell.futurice.com/haskell-on-macos.py | python3 - --make-dirs --install-dir=$HOME/.ghc-install --cabal-alias=head install cabal-install-head ${TRAVIS_COMPILER}; fi + - if [ "$TRAVIS_OS_NAME" = "osx" ]; then HC=$HOME/.ghc-install/ghc/bin/$TRAVIS_COMPILER; WITHCOMPILER="-w $HC"; HCPKG=${HC/ghc/ghc-pkg}; CABAL=$HOME/.ghc-install/ghc/bin/cabal; fi + - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')" + - echo $HCNUMVER + - CABAL="$CABAL -vnormal+nowrap+markoutput" + - set -o pipefail + - | + echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk + echo 'BEGIN { state = "output"; }' >> .colorful.awk + echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk + echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk + echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk + echo ' if (state == "cabal") {' >> .colorful.awk + echo ' print blue($0)' >> .colorful.awk + echo ' } else {' >> .colorful.awk + echo ' print $0' >> .colorful.awk + echo ' }' >> .colorful.awk + echo '}' >> .colorful.awk + - cat .colorful.awk + - | + color_cabal_output () { + awk -f $TOP/.colorful.awk + } + - echo text | color_cabal_output install: - - cabal --version - - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - - travis_retry cabal update -v - - cabal new-build -w ${HC} --dep ${XCABFLAGS} all - -# Here starts the actual work to be performed for the package under test; -# any command which exits with a non-zero exit code causes the build to fail. + - ${CABAL} --version + - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" + - TEST=--enable-tests + - BENCH=--enable-benchmarks + - HEADHACKAGE=false + - if [ $HCNUMVER -gt 80801 ] ; then HEADHACKAGE=true ; fi + - rm -f $CABALHOME/config + - | + echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config + echo "remote-build-reporting: anonymous" >> $CABALHOME/config + echo "write-ghc-environment-files: always" >> $CABALHOME/config + echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config + echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config + echo "world-file: $CABALHOME/world" >> $CABALHOME/config + echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config + echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config + echo "installdir: $CABALHOME/bin" >> $CABALHOME/config + echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config + echo "store-dir: $CABALHOME/store" >> $CABALHOME/config + echo "install-dirs user" >> $CABALHOME/config + echo " prefix: $CABALHOME" >> $CABALHOME/config + echo "repository hackage.haskell.org" >> $CABALHOME/config + echo " url: http://hackage.haskell.org/" >> $CABALHOME/config + echo " secure: True" >> $CABALHOME/config + echo " key-threshold: 3" >> $CABALHOME/config + echo " root-keys:" >> $CABALHOME/config + echo " fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0" >> $CABALHOME/config + echo " 1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42" >> $CABALHOME/config + echo " 2c6c3627bd6c982990239487f1abd02e08a02e6cf16edb105a8012d444d870c3" >> $CABALHOME/config + echo " 0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d" >> $CABALHOME/config + echo " 51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921" >> $CABALHOME/config + - | + if $HEADHACKAGE; then + echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1/g')" >> $CABALHOME/config + echo "repository head.hackage.ghc.haskell.org" >> $CABALHOME/config + echo " url: https://ghc.gitlab.haskell.org/head.hackage/" >> $CABALHOME/config + echo " secure: True" >> $CABALHOME/config + echo " root-keys: 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d" >> $CABALHOME/config + echo " 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329" >> $CABALHOME/config + echo " f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89" >> $CABALHOME/config + echo " key-threshold: 3" >> $CABALHOME/config + fi + - | + echo "program-default-options" >> $CABALHOME/config + echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config + - cat $CABALHOME/config + - rm -fv cabal.project cabal.project.local cabal.project.freeze + - travis_retry ${CABAL} v2-update -v + # Generate cabal.project + - rm -rf cabal.project cabal.project.local cabal.project.freeze + - touch cabal.project + - | + echo "packages: hackage-security" >> cabal.project + echo "packages: hackage-security-http-client" >> cabal.project + echo "packages: example-client" >> cabal.project + echo "packages: hackage-security-curl" >> cabal.project + echo "packages: hackage-root-tool" >> cabal.project + echo "packages: hackage-repo-tool" >> cabal.project + echo "packages: hackage-security-HTTP" >> cabal.project + - | + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(example-client|hackage-repo-tool|hackage-root-tool|hackage-security|hackage-security-HTTP|hackage-security-curl|hackage-security-http-client)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - cat cabal.project || true + - cat cabal.project.local || true + - if [ -f "hackage-security/configure.ac" ]; then (cd "hackage-security" && autoreconf -i); fi + - if [ -f "hackage-security-http-client/configure.ac" ]; then (cd "hackage-security-http-client" && autoreconf -i); fi + - if [ -f "example-client/configure.ac" ]; then (cd "example-client" && autoreconf -i); fi + - if [ -f "hackage-security-curl/configure.ac" ]; then (cd "hackage-security-curl" && autoreconf -i); fi + - if [ -f "hackage-root-tool/configure.ac" ]; then (cd "hackage-root-tool" && autoreconf -i); fi + - if [ -f "hackage-repo-tool/configure.ac" ]; then (cd "hackage-repo-tool" && autoreconf -i); fi + - if [ -f "hackage-security-HTTP/configure.ac" ]; then (cd "hackage-security-HTTP" && autoreconf -i); fi + - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output + - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" + - rm cabal.project.freeze + - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output script: -# prepare `cabal sdist` source-tree environment to make sure source-tarballs are complete - - read -a PKGS <<< "hackage-security hackage-security-http-client hackage-security-curl hackage-security-HTTP hackage-security hackage-root-tool hackage-repo-tool example-client" - - rm -rf sdists; mkdir sdists - - for PKG in "${PKGS[@]}"; do - cd "$PKG"; cabal sdist --output-directory="../sdists/$PKG" || break; cd ..; - done - - cd sdists/ - - # first build just hackage-security with installed constraints, with and without tests. - # silly yaml, seeing : colon - - "echo packages: hackage-security > cabal.project" - - cabal new-build --disable-tests --constraint "directory installed" --constraint "bytestring installed" ${XCABFLAGS} all - - cabal new-test --enable-tests --constraint "directory installed" --constraint "bytestring installed" ${XCABFLAGS} all - - # build all packages and run testsuite - - cp -v ../cabal.project ./ - - cabal new-build ${XCABFLAGS} -j1 all - - cabal new-test ${XCABFLAGS} -j1 all + - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) + # Packaging... + - ${CABAL} v2-sdist all | color_cabal_output + # Unpacking... + - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ + - cd ${DISTDIR} || false + - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \; + - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \; + - PKGDIR_hackage_security="$(find . -maxdepth 1 -type d -regex '.*/hackage-security-[0-9.]*')" + - PKGDIR_hackage_security_http_client="$(find . -maxdepth 1 -type d -regex '.*/hackage-security-http-client-[0-9.]*')" + - PKGDIR_example_client="$(find . -maxdepth 1 -type d -regex '.*/example-client-[0-9.]*')" + - PKGDIR_hackage_security_curl="$(find . -maxdepth 1 -type d -regex '.*/hackage-security-curl-[0-9.]*')" + - PKGDIR_hackage_root_tool="$(find . -maxdepth 1 -type d -regex '.*/hackage-root-tool-[0-9.]*')" + - PKGDIR_hackage_repo_tool="$(find . -maxdepth 1 -type d -regex '.*/hackage-repo-tool-[0-9.]*')" + - PKGDIR_hackage_security_HTTP="$(find . -maxdepth 1 -type d -regex '.*/hackage-security-HTTP-[0-9.]*')" + # Generate cabal.project + - rm -rf cabal.project cabal.project.local cabal.project.freeze + - touch cabal.project + - | + echo "packages: ${PKGDIR_hackage_security}" >> cabal.project + echo "packages: ${PKGDIR_hackage_security_http_client}" >> cabal.project + echo "packages: ${PKGDIR_example_client}" >> cabal.project + echo "packages: ${PKGDIR_hackage_security_curl}" >> cabal.project + echo "packages: ${PKGDIR_hackage_root_tool}" >> cabal.project + echo "packages: ${PKGDIR_hackage_repo_tool}" >> cabal.project + echo "packages: ${PKGDIR_hackage_security_HTTP}" >> cabal.project + - | + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(example-client|hackage-repo-tool|hackage-root-tool|hackage-security|hackage-security-HTTP|hackage-security-curl|hackage-security-http-client)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - cat cabal.project || true + - cat cabal.project.local || true + # Building... + # this builds all libraries and executables (without tests/benchmarks) + - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output + # Building with tests and benchmarks... + # build & run tests, build benchmarks + - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output + # Testing... + - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output + # cabal check... + - (cd ${PKGDIR_hackage_security} && ${CABAL} -vnormal check) + - (cd ${PKGDIR_hackage_security_http_client} && ${CABAL} -vnormal check) + - (cd ${PKGDIR_example_client} && ${CABAL} -vnormal check) + - (cd ${PKGDIR_hackage_security_curl} && ${CABAL} -vnormal check) + - (cd ${PKGDIR_hackage_root_tool} && ${CABAL} -vnormal check) + - (cd ${PKGDIR_hackage_repo_tool} && ${CABAL} -vnormal check) + - (cd ${PKGDIR_hackage_security_HTTP} && ${CABAL} -vnormal check) + # haddock... + - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all | color_cabal_output + # Building without installed constraints for packages in global-db... + - rm -f cabal.project.local + - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output +# REGENDATA ("0.7.20191101",["--ghc-head","--osx=8.4.4","cabal.project"]) # EOF diff --git a/hackage-security/cabal.haskell-ci b/hackage-security/cabal.haskell-ci new file mode 100644 index 0000000..85801d4 --- /dev/null +++ b/hackage-security/cabal.haskell-ci @@ -0,0 +1,6 @@ +ghc-head: True +osx: 8.4.4 + +constraint-set no-lukko + ghc: >=8.2 + constraints: hackage-security -lukko diff --git a/hackage-security/cabal.project b/hackage-security/cabal.project index 134f6a6..73f0f8e 100644 --- a/hackage-security/cabal.project +++ b/hackage-security/cabal.project @@ -13,3 +13,5 @@ package hackage-security -- FIXME/TODO -- packages: precompute-fileinfo + +-- constraints: hackage-security -lukko diff --git a/hackage-security/example-client/example-client.cabal b/hackage-security/example-client/example-client.cabal index a628bb1..cdf18f4 100644 --- a/hackage-security/example-client/example-client.cabal +++ b/hackage-security/example-client/example-client.cabal @@ -1,7 +1,7 @@ name: example-client version: 0.1.0.0 -synopsis: Example client using the Hackage security library --- description: +synopsis: Example hackage-security client +description: Example client using the hackage-security library. license: BSD3 license-file: LICENSE author: Edsko de Vries @@ -10,6 +10,8 @@ copyright: Copyright 2015 Well-Typed LLP category: Distribution build-type: Simple cabal-version: >=1.10 +tested-with: GHC==8.8.1, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, + GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 flag use-network-uri description: Are we using network-uri? @@ -19,7 +21,7 @@ executable example-client main-is: Main.hs other-modules: Prelude ExampleClient.Options - build-depends: base >= 4.4, + build-depends: base >= 4.5 && < 4.14, bytestring >= 0.9, Cabal >= 1.12, directory >= 1.1, @@ -43,6 +45,6 @@ executable example-client -- see comments in hackage-security.cabal if flag(use-network-uri) build-depends: network-uri >= 2.6 && < 2.7, - network >= 2.6 && < 2.8 + network >= 2.6 && < 3.2 else build-depends: network >= 2.5 && < 2.6 diff --git a/hackage-security/hackage-repo-tool/hackage-repo-tool.cabal b/hackage-security/hackage-repo-tool/hackage-repo-tool.cabal index 362b266..b1cb024 100644 --- a/hackage-security/hackage-repo-tool/hackage-repo-tool.cabal +++ b/hackage-security/hackage-repo-tool/hackage-repo-tool.cabal @@ -2,15 +2,18 @@ cabal-version: 1.12 name: hackage-repo-tool version: 0.1.1.1 -synopsis: Utility to manage secure file-based package repositories +synopsis: Manage secure file-based package repositories description: This utility can be used to manage secure file-based package - repositories (creating [TUF](https://theupdateframework.github.io/) - metadata as well as a Hackage index tarball) which can be used by - clients such as [cabal-install](http://hackage.haskell.org/package/cabal-install). - Currently it also provides various lower level utilities for creating - and signing TUF files. + repositories (creating + [TUF](https://theupdateframework.github.io/) + metadata as well as a Hackage index tarball) which can be used + by clients such as + [cabal-install](http://hackage.haskell.org/package/cabal-install). + Currently it also provides various lower level utilities + for creating and signing TUF files. . - This is part of the [Hackage Security](https://github.com/haskell/hackage-security#readme) + This is part of the + [Hackage Security](https://github.com/haskell/hackage-security#readme) infrastructure. license: BSD3 license-file: LICENSE @@ -21,6 +24,8 @@ category: Distribution homepage: https://github.com/haskell/hackage-security bug-reports: https://github.com/haskell/hackage-security/issues build-type: Simple +tested-with: GHC==8.8.1, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, + GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 extra-source-files: ChangeLog.md @@ -48,15 +53,16 @@ executable hackage-repo-tool Prelude build-depends: base >= 4.5 && < 5, - Cabal >= 1.14 && < 2.4, + Cabal >= 1.14 && < 3.1, bytestring >= 0.9 && < 0.11, directory >= 1.1 && < 1.4, filepath >= 1.2 && < 1.5, - optparse-applicative >= 0.11 && < 0.15, + microlens >= 0.4.11.2 && < 0.5, + optparse-applicative >= 0.11 && < 0.16, tar >= 0.4 && < 0.6, - time >= 1.2 && < 1.9, + time >= 1.2 && < 1.10, zlib >= 0.5 && < 0.7, - hackage-security >= 0.5 && < 0.6 + hackage-security >= 0.5 && < 0.7 if !os(windows) build-depends: unix >= 2.5 && < 2.8 @@ -69,7 +75,7 @@ executable hackage-repo-tool -- see comments in hackage-security.cabal if flag(use-network-uri) build-depends: network-uri >= 2.6 && < 2.7, - network >= 2.6 && < 2.8 + network >= 2.6 && < 3.2 else build-depends: network >= 2.5 && < 2.6 diff --git a/hackage-security/hackage-repo-tool/src/Main.hs b/hackage-security/hackage-repo-tool/src/Main.hs index 90c5a07..3615c6f 100644 --- a/hackage-security/hackage-repo-tool/src/Main.hs +++ b/hackage-security/hackage-repo-tool/src/Main.hs @@ -10,11 +10,13 @@ import GHC.Conc.Sync (setUncaughtExceptionHandler) import Network.URI (URI) import System.Exit import qualified Data.ByteString.Lazy as BS.L +import qualified Lens.Micro as Lens import qualified System.FilePath as FilePath #ifndef mingw32_HOST_OS import System.IO.Error (isAlreadyExistsError) #endif +import System.IO.Error (isDoesNotExistError) -- Cabal import Distribution.Package @@ -23,12 +25,10 @@ import Distribution.Text -- hackage-security import Hackage.Security.Server import Hackage.Security.Util.Some -import Hackage.Security.Util.IO import Hackage.Security.Util.Path import Hackage.Security.Util.Pretty import qualified Hackage.Security.Key.Env as KeyEnv import qualified Hackage.Security.TUF.FileMap as FileMap -import qualified Hackage.Security.Util.Lens as Lens import Text.JSON.Canonical (JSValue) -- hackage-repo-tool @@ -678,3 +678,10 @@ hasExtensions = \fp exts -> go (takeFileName fp) (reverse exts) throwErrors :: Exception e => Either e a -> IO a throwErrors (Left err) = throwIO err throwErrors (Right a) = return a + + +handleDoesNotExist :: IO a -> IO (Maybe a) +handleDoesNotExist act = handle aux (Just <$> act) + where + aux e | isDoesNotExistError e = return Nothing + | otherwise = throwIO e diff --git a/hackage-security/hackage-root-tool/hackage-root-tool.cabal b/hackage-security/hackage-root-tool/hackage-root-tool.cabal index 86da37d..994f03b 100644 --- a/hackage-security/hackage-root-tool/hackage-root-tool.cabal +++ b/hackage-security/hackage-root-tool/hackage-root-tool.cabal @@ -1,6 +1,6 @@ name: hackage-root-tool version: 0.1.0.0 -synopsis: Utility for Hackage key holders to generate keys and sign root info. +synopsis: Generate Hackage keys and sign root info description: A command line tool for people who hold Hackage root keys. It can generate new keys, and can sign root information. . @@ -14,6 +14,8 @@ copyright: Copyright 2015 Well-Typed LLP category: Distribution build-type: Simple cabal-version: >=1.10 +tested-with: GHC==8.8.1, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, + GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 extra-source-files: ChangeLog.md @@ -27,8 +29,8 @@ executable hackage-root-tool main-is: Main.hs build-depends: base >= 4.4 && < 5, filepath >= 1.2 && < 1.5, - optparse-applicative >= 0.11 && < 0.15, - hackage-security >= 0.5 && < 0.6 + optparse-applicative >= 0.11 && < 0.16, + hackage-security >= 0.5 && < 0.7 default-language: Haskell2010 other-extensions: CPP, ScopedTypeVariables, RecordWildCards ghc-options: -Wall diff --git a/hackage-security/hackage-security-HTTP/hackage-security-HTTP.cabal b/hackage-security/hackage-security-HTTP/hackage-security-HTTP.cabal index 9aef5f9..0f6998a 100644 --- a/hackage-security/hackage-security-HTTP/hackage-security-HTTP.cabal +++ b/hackage-security/hackage-security-HTTP/hackage-security-HTTP.cabal @@ -15,6 +15,8 @@ homepage: https://github.com/haskell/hackage-security bug-reports: https://github.com/haskell/hackage-security/issues build-type: Simple cabal-version: >=1.10 +tested-with: GHC==8.8.1, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, + GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 extra-source-files: ChangeLog.md @@ -32,9 +34,9 @@ library build-depends: base >= 4.4 && < 5, bytestring >= 0.9 && < 0.11, HTTP >= 4000.2.19 && < 4000.4, - mtl >= 2.2 && < 2.3, + mtl >= 2.1 && < 2.3, zlib >= 0.5 && < 0.7, - hackage-security >= 0.5 && < 0.6 + hackage-security >= 0.5 && < 0.7 hs-source-dirs: src default-language: Haskell2010 default-extensions: DeriveDataTypeable @@ -49,6 +51,6 @@ library -- See comments in hackage-security.cabal if flag(use-network-uri) build-depends: network-uri >= 2.6 && < 2.7, - network >= 2.6 && < 2.8 + network >= 2.6 && < 3.2 else build-depends: network >= 2.5 && < 2.6 diff --git a/hackage-security/hackage-security-HTTP/src/Hackage/Security/Client/Repository/HttpLib/HTTP.hs b/hackage-security/hackage-security-HTTP/src/Hackage/Security/Client/Repository/HttpLib/HTTP.hs index 7f82920..ebc7a69 100644 --- a/hackage-security/hackage-security-HTTP/src/Hackage/Security/Client/Repository/HttpLib/HTTP.hs +++ b/hackage-security/hackage-security-HTTP/src/Hackage/Security/Client/Repository/HttpLib/HTTP.hs @@ -31,7 +31,6 @@ import Hackage.Security.Client import Hackage.Security.Client.Repository.HttpLib import Hackage.Security.Util.Checked import Hackage.Security.Util.Pretty -import qualified Hackage.Security.Util.Lens as Lens {------------------------------------------------------------------------------- Top-level API @@ -257,7 +256,14 @@ setRequestHeaders = finalizeHeader (name, strs) = [(name, intercalate ", " (reverse strs))] insert :: Eq a => a -> [b] -> [(a, [b])] -> [(a, [b])] - insert x y = Lens.modify (Lens.lookupM x) (++ y) + insert x y = modifyAssocList x (++ y) + + -- modify the first maching element + modifyAssocList :: Eq a => a -> (b -> b) -> [(a, b)] -> [(a, b)] + modifyAssocList a f = go where + go [] = [] + go (p@(a', b) : xs) | a == a' = (a', f b) : xs + | otherwise = p : go xs getResponseHeaders :: HTTP.Response a -> [HttpResponseHeader] getResponseHeaders response = concat [ diff --git a/hackage-security/hackage-security-curl/hackage-security-curl.cabal b/hackage-security/hackage-security-curl/hackage-security-curl.cabal index ec03ce7..80b3a21 100644 --- a/hackage-security/hackage-security-curl/hackage-security-curl.cabal +++ b/hackage-security/hackage-security-curl/hackage-security-curl.cabal @@ -1,6 +1,10 @@ name: hackage-security-curl version: 0.1.0.0 -synopsis: Hackage security bindings against curl (and other external downloaders) +synopsis: curl bindings for hackage-security +description: hackage-security bindings for curl (and other + external downloaders) + . + This is part of the Hackage Security infrastructure. homepage: http://github.com/well-typed/hackage-security/ license: BSD3 license-file: LICENSE @@ -10,6 +14,8 @@ copyright: Copyright 2015 Well-Typed LLP category: Distribution build-type: Simple cabal-version: >=1.10 +tested-with: GHC==8.8.1, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, + GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 flag use-network-uri description: Are we using network-uri? @@ -17,7 +23,7 @@ flag use-network-uri library exposed-modules: Hackage.Security.Client.Repository.HttpLib.Curl - build-depends: base >= 4.4, + build-depends: base >= 4.5 && < 4.14, bytestring >= 0.9, process >= 1.1, hackage-security @@ -28,6 +34,6 @@ library -- See comments in hackage-security.cabal if flag(use-network-uri) build-depends: network-uri >= 2.6 && < 2.7, - network >= 2.6 && < 2.8 + network >= 2.6 && < 3.2 else build-depends: network >= 2.5 && < 2.6 diff --git a/hackage-security/hackage-security-http-client/hackage-security-http-client.cabal b/hackage-security/hackage-security-http-client/hackage-security-http-client.cabal index 8445e9a..e9304e5 100644 --- a/hackage-security/hackage-security-http-client/hackage-security-http-client.cabal +++ b/hackage-security/hackage-security-http-client/hackage-security-http-client.cabal @@ -1,6 +1,9 @@ name: hackage-security-http-client version: 0.1.1 -synopsis: Hackage security bindings for the http-client library +synopsis: hackage-security bindings for http-client +description: hackage-security bindings for the http-client library. + . + This is part of the Hackage Security infrastructure. homepage: http://github.com/well-typed/hackage-security/ license: BSD3 license-file: LICENSE @@ -10,6 +13,8 @@ copyright: Copyright 2015 Well-Typed LLP category: Distribution build-type: Simple cabal-version: >=1.10 +tested-with: GHC==8.8.1, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, + GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 flag use-network-uri description: Are we using network-uri? @@ -17,12 +22,12 @@ flag use-network-uri library exposed-modules: Hackage.Security.Client.Repository.HttpLib.HttpClient - build-depends: base >= 4.4, + build-depends: base >= 4.5 && < 4.14, bytestring >= 0.9, data-default-class >= 0.0, - http-client >= 0.5 && < 0.6, + http-client >= 0.4 && < 0.7, http-types >= 0.8, - hackage-security >= 0.5 && < 0.6 + hackage-security >= 0.5 && < 0.7 hs-source-dirs: src default-language: Haskell2010 default-extensions: FlexibleContexts @@ -34,6 +39,6 @@ library -- see comments in hackage-security.cabal if flag(use-network-uri) build-depends: network-uri >= 2.6 && < 2.7, - network >= 2.6 && < 2.8 + network >= 2.6 && < 3.2 else build-depends: network >= 2.5 && < 2.6 diff --git a/hackage-security/hackage-security-http-client/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs b/hackage-security/hackage-security-http-client/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs index 544979d..ced37bd 100644 --- a/hackage-security/hackage-security-http-client/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs +++ b/hackage-security/hackage-security-http-client/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Hackage.Security.Client.Repository.HttpLib.HttpClient ( withClient @@ -20,7 +21,6 @@ import qualified Network.HTTP.Types as HttpClient import Hackage.Security.Client hiding (Header) import Hackage.Security.Client.Repository.HttpLib import Hackage.Security.Util.Checked -import qualified Hackage.Security.Util.Lens as Lens {------------------------------------------------------------------------------- Top-level API @@ -84,8 +84,15 @@ getRange manager reqHeaders uri (from, to) callback = wrapCustomEx $ do callback HttpStatus200OK (getResponseHeaders response) br _otherwise -> throwChecked $ +#if MIN_VERSION_http_client(0,5,0) HttpClient.HttpExceptionRequest request $ HttpClient.StatusCodeException (void response) BS.empty +#else + HttpClient.StatusCodeException + (HttpClient.responseStatus response) + (HttpClient.responseHeaders response) + (HttpClient.responseCookieJar response) +#endif -- | Wrap custom exceptions -- @@ -153,7 +160,14 @@ setRequestHeaders opts req = req { finalizeHeader (name, strs) = [(name, BS.intercalate ", " (reverse strs))] insert :: Eq a => a -> [b] -> [(a, [b])] -> [(a, [b])] - insert x y = Lens.modify (Lens.lookupM x) (++ y) + insert x y = modifyAssocList x (++ y) + + -- modify the first maching element + modifyAssocList :: Eq a => a -> (b -> b) -> [(a, b)] -> [(a, b)] + modifyAssocList a f = go where + go [] = [] + go (p@(a', b) : xs) | a == a' = (a', f b) : xs + | otherwise = p : go xs -- | Extract the response headers getResponseHeaders :: HttpClient.Response a -> [HttpResponseHeader] diff --git a/hackage-security/hackage-security/ChangeLog.md b/hackage-security/hackage-security/ChangeLog.md index aee8155..0b29167 100644 --- a/hackage-security/hackage-security/ChangeLog.md +++ b/hackage-security/hackage-security/ChangeLog.md @@ -1,8 +1,17 @@ -unreleased ----------- +See also http://pvp.haskell.org/faq -* Allow `network-2.7.0.0` -* Allow `aeson-1.4.0.0` +0.6.0.0 +------- + +* Remove `Hackage.Security.TUF.FileMap.lookupM` +* Don't expose `Hackage.Security.Util.IO` module +* Don't expose `Hackage.Security.Util.Lens` module +* Report missing keys in `.meta` objects more appropriately as + `ReportSchemaErrors(expected)` instead of via `Monad(fail)` +* Add support for GHC 8.8 / base-4.13 +* Use `lukko` for file-locking +* Extend `LogMessage` to signal events for cache lock acquiring and release +* New `lockCacheWithLogger` operation 0.5.3.0 ------- diff --git a/hackage-security/hackage-security/hackage-security.cabal b/hackage-security/hackage-security/hackage-security.cabal index 148daa4..e9e0ccd 100644 --- a/hackage-security/hackage-security/hackage-security.cabal +++ b/hackage-security/hackage-security/hackage-security.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: hackage-security -version: 0.5.3.0 +version: 0.6.0.0 synopsis: Hackage security library description: The hackage security library provides both server and @@ -29,6 +29,9 @@ category: Distribution homepage: https://github.com/haskell/hackage-security bug-reports: https://github.com/haskell/hackage-security/issues build-type: Simple +tested-with: GHC==8.8.1, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, + GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 + extra-source-files: ChangeLog.md @@ -50,6 +53,16 @@ flag old-directory manual: False default: False +flag mtl21 + description: Use @mtl@ < 2.2 and @mtl-compat@ + manual: False + default: False + +flag lukko + description: Use @lukko@ for file-locking, otherwise use @GHC.IO.Handle.Lock@ + manual: True + default: True + library -- Most functionality is exported through the top-level entry points .Client -- and .Server; the other exported modules are intended for qualified imports. @@ -67,8 +80,6 @@ library Hackage.Security.Trusted Hackage.Security.TUF.FileMap Hackage.Security.Util.Checked - Hackage.Security.Util.IO - Hackage.Security.Util.Lens Hackage.Security.Util.Path Hackage.Security.Util.Pretty Hackage.Security.Util.Some @@ -92,39 +103,51 @@ library Hackage.Security.TUF.Timestamp Hackage.Security.Util.Base64 Hackage.Security.Util.Exit - Hackage.Security.Util.FileLock + Hackage.Security.Util.IO Hackage.Security.Util.JSON + Hackage.Security.Util.Lens Hackage.Security.Util.Stack Hackage.Security.Util.TypedEmbedded Prelude -- We support ghc 7.4 (bundled with Cabal 1.14) and up - build-depends: base >= 4.5 && < 4.13, + build-depends: base >= 4.5 && < 4.14, base16-bytestring >= 0.1.1 && < 0.2, base64-bytestring >= 1.0 && < 1.1, bytestring >= 0.9 && < 0.11, - Cabal >= 1.14 && < 2.6, + Cabal >= 1.14 && < 1.26 + || >= 2.0 && < 2.6 + || >= 3.0 && < 3.2, containers >= 0.4 && < 0.7, ed25519 >= 0.0 && < 0.1, filepath >= 1.2 && < 1.5, - mtl >= 2.2 && < 2.3, parsec >= 3.1 && < 3.2, pretty >= 1.0 && < 1.2, cryptohash-sha256 >= 0.11 && < 0.12, -- 0.4.2 introduces TarIndex, 0.4.4 introduces more -- functionality, 0.5.0 changes type of serialise tar >= 0.5 && < 0.6, - time >= 1.2 && < 1.9, - transformers >= 0.4 && < 0.6, + time >= 1.2 && < 1.10, + transformers >= 0.3 && < 0.6, zlib >= 0.5 && < 0.7, -- whatever versions are bundled with ghc: template-haskell, ghc-prim if flag(old-directory) - build-depends: directory >= 1.1.0.2 && < 1.2, - old-time >= 1 && < 1.2 + build-depends: directory >= 1.1.0.2 && < 1.2, + old-time >= 1 && < 1.2 + else + build-depends: directory >= 1.2 && < 1.4 + + if flag(mtl21) + build-depends: mtl >= 2.1 && < 2.2, + mtl-compat >= 0.2 && < 0.3 + else + build-depends: mtl >= 2.2 && < 2.3 + + if flag(lukko) + build-depends: lukko >= 0.1 && < 0.2 else - build-depends: directory >= 1.2 && < 1.4 - build-tool-depends: hsc2hs:hsc2hs >= 0.67 && <0.69 + build-depends: base >= 4.10 hs-source-dirs: src default-language: Haskell2010 @@ -201,6 +224,7 @@ library if flag(use-network-uri) build-depends: network-uri >= 2.6 && < 2.7, network >= 2.6 && < 2.9 + || >= 3.0 && < 3.2 else build-depends: network >= 2.5 && < 2.6 @@ -234,14 +258,14 @@ test-suite TestSuite zlib -- dependencies exclusive to test-suite - build-depends: tasty == 1.0.*, + build-depends: tasty == 1.2.*, tasty-hunit == 0.10.*, tasty-quickcheck == 0.10.*, - QuickCheck == 2.11.*, + QuickCheck >= 2.11 && <2.14, aeson == 1.4.*, vector == 0.12.*, unordered-containers >=0.2.8.0 && <0.3, - temporary == 1.2.* + temporary >= 1.2 && < 1.4 hs-source-dirs: tests default-language: Haskell2010 diff --git a/hackage-security/hackage-security/src/Hackage/Security/Client/Repository.hs b/hackage-security/hackage-security/src/Hackage/Security/Client/Repository.hs index 8eb320b..ce9e23c 100644 --- a/hackage-security/hackage-security/src/Hackage/Security/Client/Repository.hs +++ b/hackage-security/hackage-security/src/Hackage/Security/Client/Repository.hs @@ -316,6 +316,27 @@ data LogMessage = -- (we will try with a different mirror if any are available) | LogMirrorFailed MirrorDescription SomeException + -- | This log event is triggered before invoking a filesystem lock + -- operation that may block for a significant amount of time; once + -- the possibly blocking call completes successfully, + -- 'LogLockWaitDone' will be emitted. + -- + -- @since 0.6.0 + | LogLockWait (Path Absolute) + + -- | Denotes completion of the operation that advertised a + -- 'LogLockWait' event + -- + -- @since 0.6.0 + | LogLockWaitDone (Path Absolute) + + -- | Denotes the filesystem lock previously acquired (signaled by + -- 'LogLockWait') has been released. + -- + -- @since 0.6.0 + | LogUnlock (Path Absolute) + + -- | Records why we are downloading a file rather than updating it. data UpdateFailure = -- | Server does not support incremental downloads @@ -451,6 +472,12 @@ instance Pretty LogMessage where "Cannot update " ++ pretty file ++ " (" ++ pretty ex ++ ")" pretty (LogMirrorFailed mirror ex) = "Exception " ++ displayException ex ++ " when using mirror " ++ mirror + pretty (LogLockWait file) = + "Waiting to acquire cache lock on " ++ pretty file + pretty (LogLockWaitDone file) = + "Acquired cache lock on " ++ pretty file + pretty (LogUnlock file) = + "Released cache lock on " ++ pretty file instance Pretty UpdateFailure where pretty UpdateImpossibleUnsupported = diff --git a/hackage-security/hackage-security/src/Hackage/Security/Client/Repository/Cache.hs b/hackage-security/hackage-security/src/Hackage/Security/Client/Repository/Cache.hs index 949b651..da0b826 100644 --- a/hackage-security/hackage-security/src/Hackage/Security/Client/Repository/Cache.hs +++ b/hackage-security/hackage-security/src/Hackage/Security/Client/Repository/Cache.hs @@ -12,6 +12,7 @@ module Hackage.Security.Client.Repository.Cache ( , getIndexIdx , cacheRemoteFile , lockCache + , lockCacheWithLogger ) where import Control.Exception @@ -214,7 +215,18 @@ clearCache cache = void . handleDoesNotExist $ do -- This avoids two concurrent processes updating the cache at the same time, -- provided they both take the lock. lockCache :: Cache -> IO () -> IO () -lockCache Cache{..} = withDirLock cacheRoot +lockCache Cache{..} = withDirLock (\_ -> return ()) cacheRoot + +-- | Variant of 'lockCache' which emits 'LogMessage's before and after +-- a possibly blocking file-locking system call +-- +-- @since 0.6.0 +lockCacheWithLogger :: (LogMessage -> IO ()) -> Cache -> IO () -> IO () +lockCacheWithLogger logger Cache{..} = withDirLock logger' cacheRoot + where + logger' (WithDirLockEventPre fn) = logger (LogLockWait fn) + logger' (WithDirLockEventPost fn) = logger (LogLockWaitDone fn) + logger' (WithDirLockEventUnlock fn) = logger (LogUnlock fn) {------------------------------------------------------------------------------- Auxiliary: tar diff --git a/hackage-security/hackage-security/src/Hackage/Security/Client/Repository/Local.hs b/hackage-security/hackage-security/src/Hackage/Security/Client/Repository/Local.hs index fdc950a..8a6a2a9 100644 --- a/hackage-security/hackage-security/src/Hackage/Security/Client/Repository/Local.hs +++ b/hackage-security/hackage-security/src/Hackage/Security/Client/Repository/Local.hs @@ -51,7 +51,7 @@ withRepository repo , repClearCache = clearCache cache , repWithIndex = withIndex cache , repGetIndexIdx = getIndexIdx cache - , repLockCache = lockCache cache + , repLockCache = lockCacheWithLogger logger cache , repWithMirror = mirrorsUnsupported , repLog = logger , repLayout = repLayout diff --git a/hackage-security/hackage-security/src/Hackage/Security/Client/Repository/Remote.hs b/hackage-security/hackage-security/src/Hackage/Security/Client/Repository/Remote.hs index 948bd9d..35af241 100644 --- a/hackage-security/hackage-security/src/Hackage/Security/Client/Repository/Remote.hs +++ b/hackage-security/hackage-security/src/Hackage/Security/Client/Repository/Remote.hs @@ -178,7 +178,7 @@ withRepository httpLib , repClearCache = Cache.clearCache cache , repWithIndex = Cache.withIndex cache , repGetIndexIdx = Cache.getIndexIdx cache - , repLockCache = Cache.lockCache cache + , repLockCache = Cache.lockCacheWithLogger logger cache , repWithMirror = withMirror httpLib selectedMirror logger diff --git a/hackage-security/hackage-security/src/Hackage/Security/TUF/FileMap.hs b/hackage-security/hackage-security/src/Hackage/Security/TUF/FileMap.hs index a5d6c85..4d84189 100644 --- a/hackage-security/hackage-security/src/Hackage/Security/TUF/FileMap.hs +++ b/hackage-security/hackage-security/src/Hackage/Security/TUF/FileMap.hs @@ -13,8 +13,6 @@ module Hackage.Security.TUF.FileMap ( , (!) , insert , fromList - -- * Convenience accessors - , lookupM -- * Comparing file maps , FileChange(..) , fileMapChanges @@ -72,16 +70,6 @@ fromList :: [(TargetPath, FileInfo)] -> FileMap fromList = FileMap . Map.fromList {------------------------------------------------------------------------------- - Convenience accessors --------------------------------------------------------------------------------} - -lookupM :: Monad m => FileMap -> TargetPath -> m FileInfo -lookupM m fp = - case lookup fp m of - Nothing -> fail $ "No entry for " ++ pretty fp ++ " in filemap" - Just nfo -> return nfo - -{------------------------------------------------------------------------------- Comparing filemaps -------------------------------------------------------------------------------} diff --git a/hackage-security/hackage-security/src/Hackage/Security/TUF/Snapshot.hs b/hackage-security/hackage-security/src/Hackage/Security/TUF/Snapshot.hs index e31bf7a..1c6b281 100644 --- a/hackage-security/hackage-security/src/Hackage/Security/TUF/Snapshot.hs +++ b/hackage-security/hackage-security/src/Hackage/Security/TUF/Snapshot.hs @@ -13,6 +13,7 @@ import Hackage.Security.TUF.FileMap import Hackage.Security.TUF.Layout.Repo import Hackage.Security.TUF.Signed import qualified Hackage.Security.TUF.FileMap as FileMap +import Hackage.Security.Util.Pretty (pretty) {------------------------------------------------------------------------------- Datatypes @@ -76,9 +77,12 @@ instance ( MonadReader RepoLayout m snapshotVersion <- fromJSField enc "version" snapshotExpires <- fromJSField enc "expires" snapshotMeta <- fromJSField enc "meta" - snapshotInfoRoot <- FileMap.lookupM snapshotMeta (pathRoot repoLayout) - snapshotInfoMirrors <- FileMap.lookupM snapshotMeta (pathMirrors repoLayout) - snapshotInfoTarGz <- FileMap.lookupM snapshotMeta (pathIndexTarGz repoLayout) + let lookupMeta k = case FileMap.lookup k snapshotMeta of + Nothing -> expected ("\"" ++ pretty k ++ "\" entry in .meta object") Nothing + Just v -> pure v + snapshotInfoRoot <- lookupMeta (pathRoot repoLayout) + snapshotInfoMirrors <- lookupMeta (pathMirrors repoLayout) + snapshotInfoTarGz <- lookupMeta (pathIndexTarGz repoLayout) let snapshotInfoTar = FileMap.lookup (pathIndexTar repoLayout) snapshotMeta return Snapshot{..} diff --git a/hackage-security/hackage-security/src/Hackage/Security/TUF/Timestamp.hs b/hackage-security/hackage-security/src/Hackage/Security/TUF/Timestamp.hs index 175725a..0816a77 100644 --- a/hackage-security/hackage-security/src/Hackage/Security/TUF/Timestamp.hs +++ b/hackage-security/hackage-security/src/Hackage/Security/TUF/Timestamp.hs @@ -13,6 +13,7 @@ import Hackage.Security.TUF.Header import Hackage.Security.TUF.Layout.Repo import Hackage.Security.TUF.Signed import qualified Hackage.Security.TUF.FileMap as FileMap +import Hackage.Security.Util.Pretty (pretty) {------------------------------------------------------------------------------- Datatypes @@ -56,7 +57,10 @@ instance ( MonadReader RepoLayout m timestampVersion <- fromJSField enc "version" timestampExpires <- fromJSField enc "expires" timestampMeta <- fromJSField enc "meta" - timestampInfoSnapshot <- FileMap.lookupM timestampMeta (pathSnapshot repoLayout) + let lookupMeta k = case FileMap.lookup k timestampMeta of + Nothing -> expected ("\"" ++ pretty k ++ "\" entry in .meta object") Nothing + Just v -> pure v + timestampInfoSnapshot <- lookupMeta (pathSnapshot repoLayout) return Timestamp{..} instance (MonadKeys m, MonadReader RepoLayout m) => FromJSON m (Signed Timestamp) where diff --git a/hackage-security/hackage-security/src/Hackage/Security/Util/FileLock.hsc b/hackage-security/hackage-security/src/Hackage/Security/Util/FileLock.hsc deleted file mode 100644 index 65bee01..0000000 --- a/hackage-security/hackage-security/src/Hackage/Security/Util/FileLock.hsc +++ /dev/null @@ -1,202 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE InterruptibleFFI #-} -{-# LANGUAGE DeriveDataTypeable #-} - --- | This compat module can be removed once base-4.10 (ghc-8.2) is the minimum --- required version. Though note that the locking functionality is not in --- public modules in base-4.10, just in the "GHC.IO.Handle.Lock" module. --- --- Copied from @cabal-install@ codebase "Distribution.Client.Compat.FileLock". -module Hackage.Security.Util.FileLock ( - FileLockingNotSupported(..) - , LockMode(..) - , hLock - , hTryLock - ) where - -#if MIN_VERSION_base(4,10,0) - -import GHC.IO.Handle.Lock - -#else - --- The remainder of this file is a modified copy --- of GHC.IO.Handle.Lock from ghc-8.2.x --- --- The modifications were just to the imports and the CPP, since we do not have --- access to the HAVE_FLOCK from the ./configure script. We approximate the --- lack of HAVE_FLOCK with @defined(solaris2_HOST_OS) || defined(aix_HOST_OS)@ --- instead since those are known major Unix platforms lacking @flock()@ or --- having broken one. - -import Control.Exception (Exception) -import Data.Typeable - -#if defined(solaris2_HOST_OS) || defined(aix_HOST_OS) - -import Control.Exception (throwIO) -import System.IO (Handle) - -#else - -import Data.Bits -import Data.Function -import Control.Concurrent.MVar - -import Foreign.C.Error -import Foreign.C.Types - -import GHC.IO.Handle.Types -import GHC.IO.FD -import GHC.IO.Exception - -#if defined(mingw32_HOST_OS) - -#if defined(i386_HOST_ARCH) -## define WINDOWS_CCONV stdcall -#elif defined(x86_64_HOST_ARCH) -## define WINDOWS_CCONV ccall -#else -# error Unknown mingw32 arch -#endif - -#include <windows.h> - -import Foreign.Marshal.Alloc -import Foreign.Marshal.Utils -import Foreign.Ptr -import GHC.Windows - -#else /* !defined(mingw32_HOST_OS), so assume unix with flock() */ - -#include <sys/file.h> - -#endif /* !defined(mingw32_HOST_OS) */ - -#endif /* !(defined(solaris2_HOST_OS) || defined(aix_HOST_OS)) */ - - --- | Exception thrown by 'hLock' on non-Windows platforms that don't support --- 'flock'. -data FileLockingNotSupported = FileLockingNotSupported - deriving (Typeable, Show) - -instance Exception FileLockingNotSupported - - --- | Indicates a mode in which a file should be locked. -data LockMode = SharedLock | ExclusiveLock - --- | If a 'Handle' references a file descriptor, attempt to lock contents of the --- underlying file in appropriate mode. If the file is already locked in --- incompatible mode, this function blocks until the lock is established. The --- lock is automatically released upon closing a 'Handle'. --- --- Things to be aware of: --- --- 1) This function may block inside a C call. If it does, in order to be able --- to interrupt it with asynchronous exceptions and/or for other threads to --- continue working, you MUST use threaded version of the runtime system. --- --- 2) The implementation uses 'LockFileEx' on Windows and 'flock' otherwise, --- hence all of their caveats also apply here. --- --- 3) On non-Windows plaftorms that don't support 'flock' (e.g. Solaris) this --- function throws 'FileLockingNotImplemented'. We deliberately choose to not --- provide fcntl based locking instead because of its broken semantics. --- --- @since 4.10.0.0 -hLock :: Handle -> LockMode -> IO () -hLock h mode = lockImpl h "hLock" mode True >> return () - --- | Non-blocking version of 'hLock'. --- --- @since 4.10.0.0 -hTryLock :: Handle -> LockMode -> IO Bool -hTryLock h mode = lockImpl h "hTryLock" mode False - ----------------------------------------- - -#if defined(solaris2_HOST_OS) || defined(aix_HOST_OS) - --- | No-op implementation. -lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool -lockImpl _ _ _ _ = throwIO FileLockingNotSupported - -#else /* !(defined(solaris2_HOST_OS) || defined(aix_HOST_OS)) */ - -#if defined(mingw32_HOST_OS) - -lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool -lockImpl h ctx mode block = do - FD{fdFD = fd} <- handleToFd h - wh <- throwErrnoIf (== iNVALID_HANDLE_VALUE) ctx $ c_get_osfhandle fd - allocaBytes sizeof_OVERLAPPED $ \ovrlpd -> do - fillBytes ovrlpd (fromIntegral sizeof_OVERLAPPED) 0 - let flags = cmode .|. (if block then 0 else #{const LOCKFILE_FAIL_IMMEDIATELY}) - -- We want to lock the whole file without looking up its size to be - -- consistent with what flock does. According to documentation of LockFileEx - -- "locking a region that goes beyond the current end-of-file position is - -- not an error", however e.g. Windows 10 doesn't accept maximum possible - -- value (a pair of MAXDWORDs) for mysterious reasons. Work around that by - -- trying 2^32-1. - fix $ \retry -> c_LockFileEx wh flags 0 0xffffffff 0x0 ovrlpd >>= \b -> case b of - True -> return True - False -> getLastError >>= \err -> case () of - () | not block && err == #{const ERROR_LOCK_VIOLATION} -> return False - | err == #{const ERROR_OPERATION_ABORTED} -> retry - | otherwise -> failWith ctx err - where - sizeof_OVERLAPPED = #{size OVERLAPPED} - - cmode = case mode of - SharedLock -> 0 - ExclusiveLock -> #{const LOCKFILE_EXCLUSIVE_LOCK} - --- https://msdn.microsoft.com/en-us/library/aa297958.aspx -foreign import ccall unsafe "_get_osfhandle" - c_get_osfhandle :: CInt -> IO HANDLE - --- https://msdn.microsoft.com/en-us/library/windows/desktop/aa365203.aspx -foreign import WINDOWS_CCONV interruptible "LockFileEx" - c_LockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> DWORD -> Ptr () -> IO BOOL - -#else /* !defined(mingw32_HOST_OS), so assume unix with flock() */ - -lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool -lockImpl h ctx mode block = do - FD{fdFD = fd} <- handleToFd h - let flags = cmode .|. (if block then 0 else #{const LOCK_NB}) - fix $ \retry -> c_flock fd flags >>= \n -> case n of - 0 -> return True - _ -> getErrno >>= \errno -> case () of - () | not block && errno == eWOULDBLOCK -> return False - | errno == eINTR -> retry - | otherwise -> ioException $ errnoToIOError ctx errno (Just h) Nothing - where - cmode = case mode of - SharedLock -> #{const LOCK_SH} - ExclusiveLock -> #{const LOCK_EX} - -foreign import ccall interruptible "flock" - c_flock :: CInt -> CInt -> IO CInt - -#endif /* !defined(mingw32_HOST_OS) */ - --- | Turn an existing Handle into a file descriptor. This function throws an --- IOError if the Handle does not reference a file descriptor. -handleToFd :: Handle -> IO FD -handleToFd h = case h of - FileHandle _ mv -> do - Handle__{haDevice = dev} <- readMVar mv - case cast dev of - Just fd -> return fd - Nothing -> throwErr "not a file descriptor" - DuplexHandle{} -> throwErr "not a file handle" - where - throwErr msg = ioException $ IOError (Just h) - InappropriateType "handleToFd" msg Nothing Nothing - -#endif /* defined(solaris2_HOST_OS) || defined(aix_HOST_OS) */ - -#endif /* MIN_VERSION_base */ diff --git a/hackage-security/hackage-security/src/Hackage/Security/Util/IO.hs b/hackage-security/hackage-security/src/Hackage/Security/Util/IO.hs index 3e9f8d5..ba1ce21 100644 --- a/hackage-security/hackage-security/src/Hackage/Security/Util/IO.hs +++ b/hackage-security/hackage-security/src/Hackage/Security/Util/IO.hs @@ -1,20 +1,30 @@ +{-# LANGUAGE CPP #-} module Hackage.Security.Util.IO ( -- * Miscelleneous getFileSize , handleDoesNotExist + , WithDirLockEvent(..) , withDirLock -- * Debugging , timedIO ) where -import Control.Monad (unless) +import Control.Concurrent (threadDelay) import Control.Exception import Data.Time import System.IO hiding (openTempFile, withFile) import System.IO.Error import Hackage.Security.Util.Path -import Hackage.Security.Util.FileLock (hTryLock, LockMode(ExclusiveLock), FileLockingNotSupported) + +#ifdef MIN_VERSION_lukko +import Lukko (FD, fileLockingSupported, fdOpen, fdClose, fdLock, fdUnlock, LockMode(ExclusiveLock)) +#else +import GHC.IO.Handle.Lock (hLock, LockMode(ExclusiveLock), FileLockingNotSupported) +#if MIN_VERSION_base(4,11,0) +import GHC.IO.Handle.Lock (hUnlock) +#endif +#endif {------------------------------------------------------------------------------- Miscelleneous @@ -32,12 +42,21 @@ handleDoesNotExist act = then return Nothing else throwIO e + +data WithDirLockEvent + = WithDirLockEventPre (Path Absolute) + | WithDirLockEventPost (Path Absolute) + | WithDirLockEventUnlock (Path Absolute) + -- | Attempt to create a filesystem lock in the specified directory. -- -- This will use OS-specific file locking primitives: "GHC.IO.Handle.Lock" with -- @base-4.10" and later or a shim for @base@ versions. -- --- Throws an exception if the lock is already present. +-- Blocks if the lock is already present. +-- +-- The logger callback passed as first argument is invoked before and +-- after acquiring a lock, and after unlocking. -- -- May fallback to locking via creating a directory: -- Given a file @/path/to@, we do this by attempting to create the directory @@ -45,8 +64,10 @@ handleDoesNotExist act = -- afterwards. Creating a directory that already exists will throw an exception -- on most OSs (certainly Linux, OSX and Windows) and is a reasonably common way -- to implement a lock file. -withDirLock :: Path Absolute -> IO a -> IO a -withDirLock dir = bracket takeLock releaseLock . const +withDirLock :: (WithDirLockEvent -> IO ()) -> Path Absolute -> IO a -> IO a +withDirLock logger dir + = bracket takeLock (\h -> releaseLock h >> logger (WithDirLockEventUnlock lock)) + . const where lock :: Path Absolute lock = dir </> fragment "hackage-security-lock" @@ -54,29 +75,78 @@ withDirLock dir = bracket takeLock releaseLock . const lock' :: FilePath lock' = toFilePath lock + me = "Hackage.Security.Util.IO.withDirLock: " + + wrapLog :: IO a -> IO a + wrapLog op = do + logger (WithDirLockEventPre lock) + h <- op + logger (WithDirLockEventPost lock) + return h + +#ifdef MIN_VERSION_lukko + takeLock :: IO FD + takeLock + | fileLockingSupported = do + h <- fdOpen lock' + wrapLog (fdLock h ExclusiveLock `onException` fdClose h) + return h + | otherwise = wrapLog takeDirLock + where + takeDirLock :: IO FD + takeDirLock = handle onCreateDirError $ do + createDirectory lock + return (undefined :: FD) + + onCreateDirError :: IOError -> IO FD + onCreateDirError ioe + | isAlreadyExistsError ioe = threadDelay (1*1000*1000) >> takeDirLock + | otherwise = fail (me++"error creating directory lock: "++show ioe) + + releaseLock h + | fileLockingSupported = do + fdUnlock h + fdClose h + | otherwise = + removeDirectory lock + +#else takeLock = do h <- openFile lock' ReadWriteMode - handle (takeDirLock h) $ do - gotlock <- hTryLock h ExclusiveLock - unless gotlock $ - fail $ "hTryLock: lock already exists: " ++ lock' + wrapLog $ handle (fallbackToDirLock h) $ do + hLock h ExclusiveLock return (Just h) - takeDirLock :: Handle -> FileLockingNotSupported -> IO (Maybe Handle) - takeDirLock h _ = do - -- We fallback to directory locking - -- so we need to cleanup lock file first: close and remove - hClose h - handle onIOError (removeFile lock) - createDirectory lock - return Nothing - onIOError :: IOError -> IO () - onIOError _ = hPutStrLn stderr - "withDirLock: cannot remove lock file before directory lock fallback" + -- If file locking isn't supported then we fallback to directory locking, + -- polling if necessary. + fallbackToDirLock :: Handle -> FileLockingNotSupported -> IO (Maybe Handle) + fallbackToDirLock h _ = takeDirLock >> return Nothing + where + takeDirLock :: IO () + takeDirLock = do + -- We fallback to directory locking + -- so we need to cleanup lock file first: close and remove + hClose h + handle onIOError (removeFile lock) + handle onCreateDirError (createDirectory lock) - releaseLock (Just h) = hClose h + onCreateDirError :: IOError -> IO () + onCreateDirError ioe + | isAlreadyExistsError ioe = threadDelay (1*1000*1000) >> takeDirLock + | otherwise = fail (me++"error creating directory lock: "++show ioe) + + onIOError :: IOError -> IO () + onIOError _ = hPutStrLn stderr + (me++"cannot remove lock file before directory lock fallback") + + releaseLock (Just h) = + hClose h +#if MIN_VERSION_base(4,11,0) + >> hUnlock h +#endif releaseLock Nothing = removeDirectory lock +#endif {------------------------------------------------------------------------------- Debugging diff --git a/hackage-security/hackage-security/src/Hackage/Security/Util/Lens.hs b/hackage-security/hackage-security/src/Hackage/Security/Util/Lens.hs index 057e488..2b6c60f 100644 --- a/hackage-security/hackage-security/src/Hackage/Security/Util/Lens.hs +++ b/hackage-security/hackage-security/src/Hackage/Security/Util/Lens.hs @@ -7,11 +7,11 @@ module Hackage.Security.Util.Lens ( -- * Generic definitions Lens , Lens' + , Traversal + , Traversal' , get - , modify + , over , set - -- * Specific lenses - , lookupM ) where import Control.Applicative @@ -22,27 +22,25 @@ import Data.Functor.Identity -------------------------------------------------------------------------------} -- | Polymorphic lens -type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t +type Lens s t a b = forall f. Functor f => LensLike f s t a b -- | Monomorphic lens type Lens' s a = Lens s s a a -get :: Lens' s a -> s -> a -get l = getConst . l Const +-- | Polymorphic traversal +type Traversal s t a b = forall f. Applicative f => LensLike f s t a b -modify :: Lens s t a b -> (a -> b) -> s -> t -modify l f = runIdentity . l (Identity . f) +-- | Monomorphic traversal +type Traversal' s a = Traversal s s a a -set :: Lens s t a b -> b -> s -> t -set l = modify l . const +type LensLike f s t a b = (a -> f b) -> s -> f t +type LensLike' f s a = LensLike f s s a a -{------------------------------------------------------------------------------- - Specific lenses --------------------------------------------------------------------------------} +get :: LensLike' (Const a) s a -> s -> a +get l = getConst . l Const + +over :: LensLike Identity s t a b -> (a -> b) -> s -> t +over l f = runIdentity . l (Identity . f) -lookupM :: forall a b. (Eq a, Monoid b) => a -> Lens' [(a, b)] b -lookupM a f = go - where - go [] = (\b' -> [(a, b')] ) <$> f mempty - go ((a', b):xs) | a == a' = (\b' -> (a, b'):xs ) <$> f b - | otherwise = (\xs' -> (a', b):xs') <$> go xs +set :: LensLike Identity s t a b -> b -> s -> t +set l = over l . const diff --git a/hackage-security/hackage-security/tests/TestSuite.hs b/hackage-security/hackage-security/tests/TestSuite.hs index 3284ed7..598e151 100644 --- a/hackage-security/hackage-security/tests/TestSuite.hs +++ b/hackage-security/hackage-security/tests/TestSuite.hs @@ -284,6 +284,9 @@ msgsInitialUpdate = [ , downloading isMirrors , noLocalCopy , downloading isIndex + , lockingWait + , lockingWaitDone + , lockingRelease ] -- | Log messages when we do a check for updates and there are no changes @@ -291,6 +294,9 @@ msgsNoUpdates :: [LogMessage -> Bool] msgsNoUpdates = [ selectedMirror inMemURI , downloading isTimestamp + , lockingWait + , lockingWaitDone + , lockingRelease ] -- | Log messages we expect when the timestamp and snapshot have been resigned @@ -299,6 +305,9 @@ msgsResigned = [ selectedMirror inMemURI , downloading isTimestamp , downloading isSnapshot + , lockingWait + , lockingWaitDone + , lockingRelease ] -- | Log messages we expect when the timestamp key has been rolled over @@ -308,12 +317,18 @@ msgsKeyRollover = [ , downloading isTimestamp , verificationError $ unknownKeyError timestampPath , downloading isRoot + , lockingWait + , lockingWaitDone + , lockingRelease , downloading isTimestamp , downloading isSnapshot -- Since we delete the timestamp and snapshot on a root info change, -- we will then conclude that we need to update the mirrors and the index. , downloading isMirrors , updating isIndex + , lockingWait + , lockingWaitDone + , lockingRelease ] {------------------------------------------------------------------------------- @@ -336,6 +351,14 @@ updating :: (forall fs typ. RemoteFile fs typ -> Bool) -> LogMessage -> Bool updating isFile (LogUpdating file) = isFile file updating _ _ = False +lockingWait, lockingWaitDone, lockingRelease :: LogMessage -> Bool +lockingWait (LogLockWait _) = True +lockingWait _ = False +lockingWaitDone (LogLockWaitDone _) = True +lockingWaitDone _ = False +lockingRelease (LogUnlock _) = True +lockingRelease _ = False + expired :: TargetPath -> VerificationError -> Bool expired f (VerificationErrorExpired f') = f == f' expired _ _ = False @@ -494,6 +517,9 @@ httpMemTest test = uncheckClientErrors $ do bootstrapMsgs :: [LogMessage -> Bool] bootstrapMsgs = [ selectedMirror inMemURI , downloading isRoot + , lockingWait + , lockingWaitDone + , lockingRelease ] layout :: RepoLayout diff --git a/hackage-security/hackage-security/tests/TestSuite/JSON.hs b/hackage-security/hackage-security/tests/TestSuite/JSON.hs index 654ad4e..5ea2c7f 100644 --- a/hackage-security/hackage-security/tests/TestSuite/JSON.hs +++ b/hackage-security/hackage-security/tests/TestSuite/JSON.hs @@ -18,12 +18,12 @@ import Test.QuickCheck import Text.JSON.Canonical -- aeson -import Data.Aeson (Value (..), eitherDecode, FromJSON (..)) +import Data.Aeson (Value (..), eitherDecode) import Data.String (fromString) import qualified Data.Vector as V import qualified Data.HashMap.Strict as HM -prop_roundtrip_canonical, prop_roundtrip_pretty, prop_canonical_pretty +prop_aeson_canonical, prop_roundtrip_canonical, prop_roundtrip_pretty, prop_canonical_pretty :: JSValue -> Bool prop_roundtrip_canonical jsval = diff --git a/hackage-security/precompute-fileinfo/precompute-fileinfo.cabal b/hackage-security/precompute-fileinfo/precompute-fileinfo.cabal index a18d8af..82e5e67 100644 --- a/hackage-security/precompute-fileinfo/precompute-fileinfo.cabal +++ b/hackage-security/precompute-fileinfo/precompute-fileinfo.cabal @@ -1,6 +1,10 @@ name: precompute-fileinfo version: 0.1.0.0 synopsis: Precompute fileinfo for faster Hackage migration +description: Utility for precomputing fileinfo + for faster Hackage migration. + . + This is part of the Hackage Security infrastructure. license: BSD3 license-file: LICENSE author: Edsko de Vries @@ -9,6 +13,8 @@ copyright: Copyright 2015 Well-Typed LLP category: Distribution build-type: Simple cabal-version: >=1.10 +tested-with: GHC==8.6.4, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, + GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 executable precompute-fileinfo main-is: Main.hs diff --git a/hackport.cabal b/hackport.cabal index 6fffeb3..1da58f7 100644 --- a/hackport.cabal +++ b/hackport.cabal @@ -1,5 +1,5 @@ Name: hackport -Version: 0.6.4 +Version: 0.6.5 License: GPL License-file: LICENSE Author: Henning Günther, Duncan Coutts, Lennart Kolmodin @@ -27,41 +27,44 @@ Executable hackport cabal/cabal-install, hackage-security/hackage-security/src Build-Depends: - array, - base >= 2.0 && < 5, - deepseq >= 1.3, + array >= 0.4.0.1, + base >= 4.8 && < 5, + bytestring >= 0.10, + containers >= 0.5, + deepseq >= 1.3.0.1, + directory >= 1.2, extensible-exceptions, - filepath, - HTTP >= 4000.0.3, - MissingH, + filepath >= 1.3.0.1, + HTTP >= 4000.1.5, network >= 2.6, network-uri >= 2.6, - parsec, - pretty, - old-locale, - regex-compat, + parsec >= 3.1.13, + pretty >= 1.1.1, + process >= 1.1.0.2, + old-locale >= 1.0, split, tar >= 0.5, - time, - zlib, + time >= 1.4.0.1, + zlib >= 0.5.3, xml >= 1.3.7, -- cabal depends - binary, - random, - stm, - text, - unix, + binary >= 0.5.1.1, + text >= 1.2.3.0, + transformers >= 0.3, + unix >= 2.5, -- cabal-install depends - async, + async >= 2.0, + hashable >= 1.0, + random >= 1.0, + stm >= 2.0, -- hackage-security depends - base16-bytestring, - base64-bytestring, - cryptohash, + base16-bytestring >= 0.1.1, + base64-bytestring >= 1.0, + cryptohash-sha256 >= 0.11, ed25519, ghc-prim, - hashable, - mtl, - template-haskell, - transformers + lukko >= 0.1, + mtl >= 2.1, + template-haskell default-extensions: -- hackage-security @@ -100,37 +103,349 @@ Executable hackport RecordWildCards, TypeOperators - Build-Depends: - base >= 3 && < 5, - directory, - containers, - process, - old-time, - bytestring - other-modules: + -- hackport modules AnsiColor Cabal2Ebuild Error + HackPort.GlobalFlags + Merge + Merge.Dependencies Overlays Paths_hackport - Portage.Version + Portage.Cabal Portage.Dependency + Portage.Dependency.Builder + Portage.Dependency.Normalize + Portage.Dependency.Print + Portage.Dependency.Types Portage.EBuild Portage.EBuild.CabalFeature Portage.EBuild.Render + Portage.EMeta Portage.GHCCore - Portage.PackageId + Portage.Host + Portage.Metadata Portage.Overlay + Portage.PackageId Portage.Resolve - Portage.Host Portage.Tables - Merge.Dependencies + Portage.Use + Portage.Version Status - Merge Util - -- hsc files - Hackage.Security.Util.FileLock + -- cabal modules + Distribution.Backpack + Distribution.Backpack.ComponentsGraph + Distribution.Backpack.Configure + Distribution.Backpack.ConfiguredComponent + Distribution.Backpack.DescribeUnitId + Distribution.Backpack.FullUnitId + Distribution.Backpack.Id + Distribution.Backpack.LinkedComponent + Distribution.Backpack.MixLink + Distribution.Backpack.ModSubst + Distribution.Backpack.ModuleScope + Distribution.Backpack.ModuleShape + Distribution.Backpack.PreExistingComponent + Distribution.Backpack.PreModuleShape + Distribution.Backpack.ReadyComponent + Distribution.Backpack.UnifyM + Distribution.CabalSpecVersion + Distribution.Client.BuildReports.Types + Distribution.Client.CmdInstall.ClientInstallFlags + Distribution.Client.Compat.Directory + Distribution.Client.Compat.Prelude + Distribution.Client.Compat.Semaphore + Distribution.Client.Config + Distribution.Client.Dependency.Types + Distribution.Client.FetchUtils + Distribution.Client.GZipUtils + Distribution.Client.GlobalFlags + Distribution.Client.HttpUtils + Distribution.Client.IndexUtils + Distribution.Client.IndexUtils.Timestamp + Distribution.Client.Init.Types + Distribution.Client.InstallPlan + Distribution.Client.InstallSymlink + Distribution.Client.JobControl + Distribution.Client.ParseUtils + Distribution.Client.Security.DNS + Distribution.Client.Security.HTTP + Distribution.Client.Setup + Distribution.Client.SolverInstallPlan + Distribution.Client.SourceRepo + Distribution.Client.Tar + Distribution.Client.Targets + Distribution.Client.Types + Distribution.Client.Update + Distribution.Client.Utils + Distribution.Client.World + Distribution.Compat.Async + Distribution.Compat.Binary + Distribution.Compat.CharParsing + Distribution.Compat.CopyFile + Distribution.Compat.CreatePipe + Distribution.Compat.DList + Distribution.Compat.Directory + Distribution.Compat.Environment + Distribution.Compat.Exception + Distribution.Compat.FilePath + Distribution.Compat.Graph + Distribution.Compat.Internal.TempFile + Distribution.Compat.Lens + Distribution.Compat.MD5 + Distribution.Compat.MonadFail + Distribution.Compat.Newtype + Distribution.Compat.Parsing + Distribution.Compat.Prelude + Distribution.Compat.Prelude.Internal + Distribution.Compat.Semigroup + Distribution.Compat.Stack + Distribution.Compat.Time + Distribution.Compiler + Distribution.Deprecated.ParseUtils + Distribution.Deprecated.ReadP + Distribution.Deprecated.Text + Distribution.Deprecated.ViewAsFieldDescr + Distribution.FieldGrammar + Distribution.FieldGrammar.Class + Distribution.FieldGrammar.FieldDescrs + Distribution.FieldGrammar.Parsec + Distribution.FieldGrammar.Pretty + Distribution.Fields + Distribution.Fields.ConfVar + Distribution.Fields.Field + Distribution.Fields.Lexer + Distribution.Fields.LexerMonad + Distribution.Fields.ParseResult + Distribution.Fields.Parser + Distribution.Fields.Pretty + Distribution.GetOpt + Distribution.InstalledPackageInfo + Distribution.Lex + Distribution.License + Distribution.ModuleName + Distribution.Package + Distribution.PackageDescription + Distribution.PackageDescription.Check + Distribution.PackageDescription.Configuration + Distribution.PackageDescription.FieldGrammar + Distribution.PackageDescription.Parsec + Distribution.PackageDescription.PrettyPrint + Distribution.PackageDescription.Quirks + Distribution.PackageDescription.Utils + Distribution.Parsec + Distribution.Parsec.Error + Distribution.Parsec.FieldLineStream + Distribution.Parsec.Newtypes + Distribution.Parsec.Position + Distribution.Parsec.Warning + Distribution.Pretty + Distribution.ReadE + Distribution.SPDX + Distribution.SPDX.License + Distribution.SPDX.LicenseExceptionId + Distribution.SPDX.LicenseExpression + Distribution.SPDX.LicenseId + Distribution.SPDX.LicenseListVersion + Distribution.SPDX.LicenseReference + Distribution.Simple.Build.PathsModule + Distribution.Simple.BuildPaths + Distribution.Simple.BuildTarget + Distribution.Simple.BuildToolDepends + Distribution.Simple.CCompiler + Distribution.Simple.Command + Distribution.Simple.Compiler + Distribution.Simple.Configure + Distribution.Simple.Flag + Distribution.Simple.GHC + Distribution.Simple.GHC.EnvironmentParser + Distribution.Simple.GHC.ImplInfo + Distribution.Simple.GHC.Internal + Distribution.Simple.GHCJS + Distribution.Simple.Glob + Distribution.Simple.HaskellSuite + Distribution.Simple.Hpc + Distribution.Simple.InstallDirs + Distribution.Simple.InstallDirs.Internal + Distribution.Simple.LocalBuildInfo + Distribution.Simple.PackageIndex + Distribution.Simple.PreProcess + Distribution.Simple.PreProcess.Unlit + Distribution.Simple.Program + Distribution.Simple.Program.Ar + Distribution.Simple.Program.Builtin + Distribution.Simple.Program.Db + Distribution.Simple.Program.Find + Distribution.Simple.Program.GHC + Distribution.Simple.Program.HcPkg + Distribution.Simple.Program.Hpc + Distribution.Simple.Program.Internal + Distribution.Simple.Program.Ld + Distribution.Simple.Program.ResponseFile + Distribution.Simple.Program.Run + Distribution.Simple.Program.Strip + Distribution.Simple.Program.Types + Distribution.Simple.Setup + Distribution.Simple.Test.LibV09 + Distribution.Simple.Test.Log + Distribution.Simple.UHC + Distribution.Simple.Utils + Distribution.Solver.Compat.Prelude + Distribution.Solver.Types.ComponentDeps + Distribution.Solver.Types.ConstraintSource + Distribution.Solver.Types.InstSolverPackage + Distribution.Solver.Types.LabeledPackageConstraint + Distribution.Solver.Types.OptionalStanza + Distribution.Solver.Types.PackageConstraint + Distribution.Solver.Types.PackageFixedDeps + Distribution.Solver.Types.PackageIndex + Distribution.Solver.Types.PackagePath + Distribution.Solver.Types.ResolverPackage + Distribution.Solver.Types.Settings + Distribution.Solver.Types.SolverId + Distribution.Solver.Types.SolverPackage + Distribution.Solver.Types.SourcePackage + Distribution.System + Distribution.TestSuite + Distribution.Text + Distribution.Types.AbiDependency + Distribution.Types.AbiHash + Distribution.Types.AnnotatedId + Distribution.Types.Benchmark + Distribution.Types.Benchmark.Lens + Distribution.Types.BenchmarkInterface + Distribution.Types.BenchmarkType + Distribution.Types.BuildInfo + Distribution.Types.BuildInfo.Lens + Distribution.Types.BuildType + Distribution.Types.Component + Distribution.Types.ComponentId + Distribution.Types.ComponentInclude + Distribution.Types.ComponentLocalBuildInfo + Distribution.Types.ComponentName + Distribution.Types.ComponentRequestedSpec + Distribution.Types.CondTree + Distribution.Types.Condition + Distribution.Types.ConfVar + Distribution.Types.Dependency + Distribution.Types.DependencyMap + Distribution.Types.ExeDependency + Distribution.Types.Executable + Distribution.Types.Executable.Lens + Distribution.Types.ExecutableScope + Distribution.Types.ExposedModule + Distribution.Types.Flag + Distribution.Types.ForeignLib + Distribution.Types.ForeignLib.Lens + Distribution.Types.ForeignLibOption + Distribution.Types.ForeignLibType + Distribution.Types.GenericPackageDescription + Distribution.Types.GenericPackageDescription.Lens + Distribution.Types.GivenComponent + Distribution.Types.HookedBuildInfo + Distribution.Types.IncludeRenaming + Distribution.Types.InstalledPackageInfo + Distribution.Types.InstalledPackageInfo.FieldGrammar + Distribution.Types.InstalledPackageInfo.Lens + Distribution.Types.LegacyExeDependency + Distribution.Types.Lens + Distribution.Types.Library + Distribution.Types.Library.Lens + Distribution.Types.LibraryName + Distribution.Types.LibraryVisibility + Distribution.Types.LocalBuildInfo + Distribution.Types.Mixin + Distribution.Types.Module + Distribution.Types.ModuleReexport + Distribution.Types.ModuleRenaming + Distribution.Types.MungedPackageId + Distribution.Types.MungedPackageName + Distribution.Types.PackageDescription + Distribution.Types.PackageDescription.Lens + Distribution.Types.PackageId + Distribution.Types.PackageId.Lens |