From ffbfafd6a0b5ee2558914bb792a9b6e5baf0aaba Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 16 Dec 2017 11:16:30 +0200 Subject: [PATCH] Change license :: License to Either SPDX.License License Resolves #2547 I introduce SimpleLicenseExpression to make "OrAnyLater LicenseRef" unrepresentable. That also simplifies types. license field is parsed as old `License` when cabal-version <2.2, and as SPDX expression otherwise. `NONE` is recognised. There are best-effort functions to convert between `License` and `SPDX.License`. There are also IPI changes: parser accepts both `License` and `SPDX.License`, as both can occur in package database. Cabal will `register` a SDPX expression as `license` for GHC >= 8.4, and legacy `License` for other (we are smart when converting `PackageDescription` + LBI and other data to `InstalledPackageInfo`) Also add NFData InstalledPackageInfo --- Cabal/Distribution/License.hs | 80 +++++++++++++- Cabal/Distribution/PackageDescription.hs | 4 +- Cabal/Distribution/PackageDescription/Check.hs | 112 ++++++++++--------- .../PackageDescription/FieldGrammar.hs | 5 +- Cabal/Distribution/PackageDescription/Parse.hs | 5 +- Cabal/Distribution/Parsec/Newtypes.hs | 22 +++- Cabal/Distribution/SPDX.hs | 3 +- Cabal/Distribution/SPDX/License.hs | 2 +- Cabal/Distribution/SPDX/LicenseExpression.hs | 120 +++++++++++---------- Cabal/Distribution/SPDX/LicenseReference.hs | 9 +- Cabal/Distribution/Simple/GHC/IPIConvert.hs | 17 +-- Cabal/Distribution/Simple/Register.hs | 11 +- Cabal/Distribution/Types/AbiDependency.hs | 2 +- Cabal/Distribution/Types/AbiHash.hs | 2 + Cabal/Distribution/Types/ExposedModule.hs | 2 + Cabal/Distribution/Types/InstalledPackageInfo.hs | 7 +- .../Types/InstalledPackageInfo/FieldGrammar.hs | 19 +++- .../Types/InstalledPackageInfo/Lens.hs | 3 +- Cabal/Distribution/Types/PackageDescription.hs | 24 ++++- .../Distribution/Types/PackageDescription/Lens.hs | 11 +- Cabal/tests/Instances/TreeDiff.hs | 1 - Cabal/tests/Instances/TreeDiff/SPDX.hs | 11 ++ Cabal/tests/ParserHackageTests.hs | 16 +-- Cabal/tests/ParserTests.hs | 13 +-- Cabal/tests/ParserTests/ipi/Includes2.expr | 2 +- .../ipi/internal-preprocessor-test.expr | 2 +- .../tests/ParserTests/ipi/issue-2276-ghc-9885.expr | 2 +- Cabal/tests/ParserTests/ipi/transformers.expr | 2 +- .../tests/ParserTests/regressions/Octree-0.5.expr | 2 +- Cabal/tests/ParserTests/regressions/common.expr | 2 +- Cabal/tests/ParserTests/regressions/common2.expr | 2 +- Cabal/tests/ParserTests/regressions/elif.expr | 2 +- Cabal/tests/ParserTests/regressions/elif2.expr | 2 +- .../ParserTests/regressions/encoding-0.8.expr | 2 +- .../ParserTests/regressions/generics-sop.expr | 2 +- .../tests/ParserTests/regressions/issue-774.check | 2 +- Cabal/tests/ParserTests/regressions/issue-774.expr | 2 +- .../ParserTests/regressions/leading-comma.expr | 2 +- .../ParserTests/regressions/nothing-unicode.check | 2 +- .../ParserTests/regressions/nothing-unicode.expr | 2 +- Cabal/tests/ParserTests/regressions/shake.expr | 2 +- .../ParserTests/regressions/th-lift-instances.expr | 2 +- .../ParserTests/regressions/wl-pprint-indef.expr | 2 +- Cabal/tests/UnitTests/Distribution/SPDX.hs | 32 ++++-- cabal-install/Distribution/Client/List.hs | 11 +- .../UnitTests/Distribution/Solver/Modular/DSL.hs | 2 +- cabal-testsuite/PackageTests/COnlyMain/my.cabal | 2 +- cabal-testsuite/PackageTests/SPDX/M.hs | 1 + cabal-testsuite/PackageTests/SPDX/Setup.hs | 2 + .../PackageTests/SPDX/cabal-old-build.cabal.out | 10 ++ .../PackageTests/SPDX/cabal-old-build.out | 9 ++ .../PackageTests/SPDX/cabal-old-build.test.hs | 10 ++ cabal-testsuite/PackageTests/SPDX/cabal.project | 1 + cabal-testsuite/PackageTests/SPDX/cabal.test.hs | 6 ++ cabal-testsuite/PackageTests/SPDX/my.cabal | 10 ++ .../ExeV10/cabal-with-hpc.multitest.hs | 2 +- 56 files changed, 435 insertions(+), 202 deletions(-) create mode 100644 cabal-testsuite/PackageTests/SPDX/M.hs create mode 100644 cabal-testsuite/PackageTests/SPDX/Setup.hs create mode 100644 cabal-testsuite/PackageTests/SPDX/cabal-old-build.cabal.out create mode 100644 cabal-testsuite/PackageTests/SPDX/cabal-old-build.out create mode 100644 cabal-testsuite/PackageTests/SPDX/cabal-old-build.test.hs create mode 100644 cabal-testsuite/PackageTests/SPDX/cabal.project create mode 100644 cabal-testsuite/PackageTests/SPDX/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/SPDX/my.cabal diff --git a/Cabal/Distribution/License.hs b/Cabal/Distribution/License.hs index 70d5bdf75..63ce1aa72 100644 --- a/Cabal/Distribution/License.hs +++ b/Cabal/Distribution/License.hs @@ -45,6 +45,8 @@ module Distribution.License ( License(..), knownLicenses, + licenseToSPDX, + licenseFromSPDX, ) where import Distribution.Compat.Prelude @@ -56,7 +58,9 @@ import Distribution.Text import Distribution.Version import qualified Distribution.Compat.CharParsing as P +import qualified Distribution.Compat.Map.Strict as Map import qualified Distribution.Compat.ReadP as Parse +import qualified Distribution.SPDX as SPDX import qualified Text.PrettyPrint as Disp -- | Indicates the license under which a package's source code is released. @@ -138,9 +142,79 @@ knownLicenses = [ GPL unversioned, GPL (version [2]), GPL (version [3]) , MPL (mkVersion [2, 0]) , Apache unversioned, Apache (version [2, 0]) , PublicDomain, AllRightsReserved, OtherLicense] - where - unversioned = Nothing - version = Just . mkVersion + where + unversioned = Nothing + version = Just . mkVersion + +-- | Convert old 'License' to SPDX 'SPDX.License'. +-- Non-SPDX licenses are converted to 'SPDX.LicenseRef'. +-- +-- @since 2.2.0.0 +licenseToSPDX :: License -> SPDX.License +licenseToSPDX l = case l of + GPL v | v == version [2] -> spdx SPDX.GPL_2_0 + GPL v | v == version [3] -> spdx SPDX.GPL_3_0 + LGPL v | v == version [2,1] -> spdx SPDX.LGPL_2_1 + LGPL v | v == version [3] -> spdx SPDX.LGPL_3_0 + AGPL v | v == version [3] -> spdx SPDX.AGPL_3_0 + BSD2 -> spdx SPDX.BSD_2_Clause + BSD3 -> spdx SPDX.BSD_3_Clause + BSD4 -> spdx SPDX.BSD_4_Clause + MIT -> spdx SPDX.MIT + ISC -> spdx SPDX.ISC + MPL v | v == mkVersion [2,0] -> spdx SPDX.MPL_2_0 + Apache v | v == version [2,0] -> spdx SPDX.Apache_2_0 + AllRightsReserved -> SPDX.NONE + UnspecifiedLicense -> SPDX.NONE + OtherLicense -> ref (SPDX.mkLicenseRef' Nothing "OtherLicense") + PublicDomain -> ref (SPDX.mkLicenseRef' Nothing "PublicDomain") + UnknownLicense str -> ref (SPDX.mkLicenseRef' Nothing str) + _ -> ref (SPDX.mkLicenseRef' Nothing $ prettyShow l) + where + version = Just . mkVersion + spdx = SPDX.License . SPDX.simpleLicenseExpression + ref r = SPDX.License $ SPDX.ELicense (SPDX.ELicenseRef r) Nothing + +-- | Convert 'SPDX.License' to 'License', +-- +-- This is lossy conversion. We try our best. +-- +-- >>> licenseFromSPDX . licenseToSPDX $ BSD3 +-- BSD3 +-- +-- >>> licenseFromSPDX . licenseToSPDX $ GPL (Just (mkVersion [3])) +-- GPL (Just (mkVersion [3])) +-- +-- >>> licenseFromSPDX . licenseToSPDX $ PublicDomain +-- UnknownLicense "LicenseRefPublicDomain" +-- +-- >>> licenseFromSPDX $ SPDX.License $ SPDX.simpleLicenseExpression SPDX.EUPL_1_1 +-- UnknownLicense "EUPL-1.1" +-- +-- >>> licenseFromSPDX . licenseToSPDX $ AllRightsReserved +-- AllRightsReserved +-- +-- >>> licenseFromSPDX <$> simpleParsec "BSD-3-Clause OR GPL-3.0" +-- Just (UnknownLicense "BSD3ClauseORGPL30") +-- +-- @since 2.2.0.0 +licenseFromSPDX :: SPDX.License -> License +licenseFromSPDX SPDX.NONE = AllRightsReserved +licenseFromSPDX l = + fromMaybe (mungle $ prettyShow l) $ Map.lookup l m + where + m :: Map.Map SPDX.License License + m = Map.fromList $ filter (isSimple . fst ) $ + map (\x -> (licenseToSPDX x, x)) knownLicenses + + isSimple (SPDX.License (SPDX.ELicense (SPDX.ELicenseId _) Nothing)) = True + isSimple _ = False + + mungle name = fromMaybe (UnknownLicense (mapMaybe mangle name)) (simpleParsec name) + + mangle c + | isAlphaNum c = Just c + | otherwise = Nothing instance Pretty License where pretty (GPL version) = Disp.text "GPL" <<>> dispOptVersion version diff --git a/Cabal/Distribution/PackageDescription.hs b/Cabal/Distribution/PackageDescription.hs index 47e0fddee..4085278e6 100644 --- a/Cabal/Distribution/PackageDescription.hs +++ b/Cabal/Distribution/PackageDescription.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} - ----------------------------------------------------------------------------- -- | -- Module : Distribution.PackageDescription @@ -19,6 +16,7 @@ module Distribution.PackageDescription ( emptyPackageDescription, specVersion, buildType, + license, descCabalVersion, BuildType(..), knownBuildTypes, diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs index fa6cdd532..7bc895462 100644 --- a/Cabal/Distribution/PackageDescription/Check.hs +++ b/Cabal/Distribution/PackageDescription/Check.hs @@ -33,52 +33,49 @@ module Distribution.PackageDescription.Check ( checkPackageFileNames, ) where -import Prelude () import Distribution.Compat.Prelude +import Prelude () -import Distribution.PackageDescription -import Distribution.PackageDescription.Configuration -import qualified Distribution.Compat.DList as DList +import Control.Monad (mapM) +import Data.List (group) +import Distribution.Compat.Lens import Distribution.Compiler -import Distribution.System import Distribution.License -import Distribution.Simple.BuildPaths (autogenPathsModuleName) +import Distribution.Package +import Distribution.PackageDescription +import Distribution.PackageDescription.Configuration +import Distribution.Pretty (prettyShow) +import Distribution.Simple.BuildPaths (autogenPathsModuleName) import Distribution.Simple.BuildToolDepends import Distribution.Simple.CCompiler +import Distribution.Simple.Utils hiding (findPackageDesc, notice) +import Distribution.System +import Distribution.Text import Distribution.Types.ComponentRequestedSpec import Distribution.Types.CondTree -import Distribution.Types.Dependency -import Distribution.Types.ExeDependency -import Distribution.Types.PackageName import Distribution.Types.ExecutableScope +import Distribution.Types.ExeDependency import Distribution.Types.UnqualComponentName -import Distribution.Simple.Utils hiding (findPackageDesc, notice) +import Distribution.Utils.Generic (isAscii) import Distribution.Version -import Distribution.Package -import Distribution.Text -import Distribution.Utils.Generic (isAscii) import Language.Haskell.Extension +import System.FilePath + (splitDirectories, splitExtension, splitPath, takeExtension, takeFileName, (<.>), ()) -import Control.Monad (mapM) -import qualified Data.ByteString.Lazy as BS -import Data.List (group) -import qualified System.Directory as System - ( doesFileExist, doesDirectoryExist ) -import qualified Data.Map as Map +import qualified Data.ByteString.Lazy as BS +import qualified Data.Map as Map +import qualified Distribution.Compat.DList as DList +import qualified Distribution.SPDX as SPDX +import qualified System.Directory as System -import qualified System.Directory (getDirectoryContents) -import System.FilePath - ( (), (<.>), takeExtension, takeFileName, splitDirectories - , splitPath, splitExtension ) -import System.FilePath.Windows as FilePath.Windows - ( isValid ) +import qualified System.Directory (getDirectoryContents) +import qualified System.FilePath.Windows as FilePath.Windows (isValid) import qualified Data.Set as Set -import Distribution.Compat.Lens -import qualified Distribution.Types.BuildInfo.Lens as L -import qualified Distribution.Types.PackageDescription.Lens as L +import qualified Distribution.Types.BuildInfo.Lens as L import qualified Distribution.Types.GenericPackageDescription.Lens as L +import qualified Distribution.Types.PackageDescription.Lens as L -- | Results of some kind of failed package check. -- @@ -649,17 +646,35 @@ checkFields pkg = checkLicense :: PackageDescription -> [PackageCheck] -checkLicense pkg = - catMaybes [ +checkLicense pkg = case licenseRaw pkg of + Right l -> checkOldLicense pkg l + Left l -> checkNewLicense pkg l + +checkNewLicense :: PackageDescription -> SPDX.License -> [PackageCheck] +checkNewLicense _pkg lic = catMaybes + [ check (lic == SPDX.NONE) $ + PackageDistInexcusable + "The 'license' field is missing or is NONE." + ] - check (license pkg == UnspecifiedLicense) $ +checkOldLicense :: PackageDescription -> License -> [PackageCheck] +checkOldLicense pkg lic = catMaybes + [ check (lic == UnspecifiedLicense) $ PackageDistInexcusable "The 'license' field is missing." - , check (license pkg == AllRightsReserved) $ + , check (lic == AllRightsReserved) $ PackageDistSuspicious "The 'license' is AllRightsReserved. Is that really what you want?" - , case license pkg of + + , checkVersion [1,4] (lic `notElem` compatLicenses) $ + PackageDistInexcusable $ + "Unfortunately the license " ++ quote (prettyShow (license pkg)) + ++ " messes up the parser in earlier Cabal versions so you need to " + ++ "specify 'cabal-version: >= 1.4'. Alternatively if you require " + ++ "compatibility with earlier Cabal versions then use 'OtherLicense'." + + , case lic of UnknownLicense l -> Just $ PackageBuildWarning $ quote ("license: " ++ l) ++ " is not a recognised license. The " @@ -667,23 +682,23 @@ checkLicense pkg = ++ commaSep (map display knownLicenses) _ -> Nothing - , check (license pkg == BSD4) $ + , check (lic == BSD4) $ PackageDistSuspicious $ "Using 'license: BSD4' is almost always a misunderstanding. 'BSD4' " ++ "refers to the old 4-clause BSD license with the advertising " ++ "clause. 'BSD3' refers the new 3-clause BSD license." - , case unknownLicenseVersion (license pkg) of + , case unknownLicenseVersion (lic) of Just knownVersions -> Just $ PackageDistSuspicious $ - "'license: " ++ display (license pkg) ++ "' is not a known " + "'license: " ++ display (lic) ++ "' is not a known " ++ "version of that license. The known versions are " ++ commaSep (map display knownVersions) ++ ". If this is not a mistake and you think it should be a known " ++ "version then please file a ticket." _ -> Nothing - , check (license pkg `notElem` [ AllRightsReserved + , check (lic `notElem` [ AllRightsReserved , UnspecifiedLicense, PublicDomain] -- AllRightsReserved and PublicDomain are not strictly -- licenses so don't need license files. @@ -705,6 +720,15 @@ checkLicense pkg = where knownVersions = [ v' | Apache (Just v') <- knownLicenses ] unknownLicenseVersion _ = Nothing + checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheck + checkVersion ver cond pc + | specVersion pkg >= mkVersion ver = Nothing + | otherwise = check cond pc + + compatLicenses = [ GPL Nothing, LGPL Nothing, AGPL Nothing, BSD3, BSD4 + , PublicDomain, AllRightsReserved + , UnspecifiedLicense, OtherLicense ] + checkSourceRepos :: PackageDescription -> [PackageCheck] checkSourceRepos pkg = catMaybes $ concat [[ @@ -1228,7 +1252,7 @@ checkCabalVersion pkg = PackageDistInexcusable $ "The use of 'virtual-modules' requires the package " ++ " to specify at least 'cabal-version: >= 2.1'." - + -- check use of "tested-with: GHC (>= 1.0 && < 1.4) || >=1.8 " syntax , checkVersion [1,8] (not (null testedWithVersionRangeExpressions)) $ PackageDistInexcusable $ @@ -1275,14 +1299,6 @@ checkCabalVersion pkg = ++ "Unfortunately it messes up the parser in earlier Cabal versions " ++ "so you need to specify 'cabal-version: >= 1.6'." - -- check for new licenses - , checkVersion [1,4] (license pkg `notElem` compatLicenses) $ - PackageDistInexcusable $ - "Unfortunately the license " ++ quote (display (license pkg)) - ++ " messes up the parser in earlier Cabal versions so you need to " - ++ "specify 'cabal-version: >= 1.4'. Alternatively if you require " - ++ "compatibility with earlier Cabal versions then use 'OtherLicense'." - -- check for new language extensions , checkVersion [1,2,3] (not (null mentionedExtensionsThatNeedCabal12)) $ PackageDistInexcusable $ @@ -1428,10 +1444,6 @@ checkCabalVersion pkg = (orLaterVersion v) (earlierVersion (majorUpperBound v)) embed vr = embedVersionRange vr - compatLicenses = [ GPL Nothing, LGPL Nothing, AGPL Nothing, BSD3, BSD4 - , PublicDomain, AllRightsReserved - , UnspecifiedLicense, OtherLicense ] - mentionedExtensions = [ ext | bi <- allBuildInfo pkg , ext <- allExtensions bi ] mentionedExtensionsThatNeedCabal12 = diff --git a/Cabal/Distribution/PackageDescription/FieldGrammar.hs b/Cabal/Distribution/PackageDescription/FieldGrammar.hs index 329a074b4..605e47a21 100644 --- a/Cabal/Distribution/PackageDescription/FieldGrammar.hs +++ b/Cabal/Distribution/PackageDescription/FieldGrammar.hs @@ -45,7 +45,6 @@ import Prelude () import Distribution.Compiler (CompilerFlavor (..)) import Distribution.FieldGrammar -import Distribution.License (License (..)) import Distribution.ModuleName (ModuleName) import Distribution.Package import Distribution.PackageDescription @@ -58,6 +57,8 @@ import Distribution.Types.ForeignLibType import Distribution.Types.UnqualComponentName import Distribution.Version (anyVersion) +import qualified Distribution.SPDX as SPDX + import qualified Distribution.Types.Lens as L ------------------------------------------------------------------------------- @@ -70,7 +71,7 @@ packageDescriptionFieldGrammar packageDescriptionFieldGrammar = PackageDescription <$> optionalFieldDefAla "cabal-version" SpecVersion L.specVersionRaw (Right anyVersion) <*> blurFieldGrammar L.package packageIdentifierGrammar - <*> optionalFieldDef "license" L.license UnspecifiedLicense + <*> optionalFieldDefAla "license" SpecLicense L.licenseRaw (Left SPDX.NONE) <*> licenseFilesGrammar <*> optionalFieldDefAla "copyright" FreeText L.copyright "" <*> optionalFieldDefAla "maintainer" FreeText L.maintainer "" diff --git a/Cabal/Distribution/PackageDescription/Parse.hs b/Cabal/Distribution/PackageDescription/Parse.hs index 96194668a..d335f20a7 100644 --- a/Cabal/Distribution/PackageDescription/Parse.hs +++ b/Cabal/Distribution/PackageDescription/Parse.hs @@ -99,8 +99,9 @@ pkgDescrFieldDescrs = (maybe mempty disp) (fmap Just parse) buildTypeRaw (\t pkg -> pkg{buildTypeRaw=t}) , simpleField "license" - disp parseLicenseQ - license (\l pkg -> pkg{license=l}) + (either (error "pretty spdx expr") disp) + (fmap Right parseLicenseQ) + licenseRaw (\l pkg -> pkg{licenseRaw=l}) -- We have both 'license-file' and 'license-files' fields. -- Rather than declaring license-file to be deprecated, we will continue -- to allow both. The 'license-file' will continue to only allow single diff --git a/Cabal/Distribution/Parsec/Newtypes.hs b/Cabal/Distribution/Parsec/Newtypes.hs index 21f86c8a7..586f0c81c 100644 --- a/Cabal/Distribution/Parsec/Newtypes.hs +++ b/Cabal/Distribution/Parsec/Newtypes.hs @@ -17,9 +17,10 @@ module Distribution.Parsec.Newtypes ( NoCommaFSep (..), -- ** Type List, - -- * Version + -- * Version & License SpecVersion (..), TestedWith (..), + SpecLicense (..), -- * Identifiers Token (..), Token' (..), @@ -36,6 +37,7 @@ import Data.Functor.Identity (Identity (..)) import Data.List (dropWhileEnd) import Distribution.CabalSpecVersion import Distribution.Compiler (CompilerFlavor) +import Distribution.License (License) import Distribution.Parsec.Class import Distribution.Pretty import Distribution.Version @@ -43,6 +45,7 @@ import Distribution.Version import Text.PrettyPrint (Doc, comma, fsep, punctuate, vcat, (<+>)) import qualified Distribution.Compat.CharParsing as P +import qualified Distribution.SPDX as SPDX -- | Vertical list with commas. Displayed with 'vcat' data CommaVCat = CommaVCat @@ -189,6 +192,23 @@ specVersionFromRange versionRange = case asVersionIntervals versionRange of [] -> mkVersion [0] ((LowerBound version _, _):_) -> version +-- | SPDX License expression or legacy license +newtype SpecLicense = SpecLicense { getSpecLicense :: Either SPDX.License License } + +instance Newtype SpecLicense (Either SPDX.License License) where + pack = SpecLicense + unpack = getSpecLicense + +instance Parsec SpecLicense where + parsec = do + v <- askCabalSpecVersion + if v >= CabalSpecV22 + then SpecLicense . Left <$> parsec + else SpecLicense . Right <$> parsec + +instance Pretty SpecLicense where + pretty = either pretty pretty . unpack + -- | Version range or just version newtype TestedWith = TestedWith { getTestedWith :: (CompilerFlavor, VersionRange) } diff --git a/Cabal/Distribution/SPDX.hs b/Cabal/Distribution/SPDX.hs index 65e3fa19e..ded958c81 100644 --- a/Cabal/Distribution/SPDX.hs +++ b/Cabal/Distribution/SPDX.hs @@ -6,8 +6,8 @@ module Distribution.SPDX ( License (..), -- * License expression LicenseExpression (..), + SimpleLicenseExpression (..), simpleLicenseExpression, - OnlyOrAnyLater (..), -- * License identifier LicenseId (..), licenseId, @@ -25,7 +25,6 @@ module Distribution.SPDX ( licenseDocumentRef, mkLicenseRef, mkLicenseRef', - unsafeMkLicenseRef, ) where import Distribution.SPDX.LicenseExceptionId diff --git a/Cabal/Distribution/SPDX/License.hs b/Cabal/Distribution/SPDX/License.hs index e6f09f57c..71a65004d 100644 --- a/Cabal/Distribution/SPDX/License.hs +++ b/Cabal/Distribution/SPDX/License.hs @@ -41,7 +41,7 @@ data License -- ^ if the package contains no license information whatsoever; or | License LicenseExpression -- ^ A valid SPDX License Expression as defined in Appendix IV. - deriving (Show, Read, Eq, Typeable, Data, Generic) + deriving (Show, Read, Eq, Ord, Typeable, Data, Generic) instance Binary License diff --git a/Cabal/Distribution/SPDX/LicenseExpression.hs b/Cabal/Distribution/SPDX/LicenseExpression.hs index 0d4bf2589..71b07923f 100644 --- a/Cabal/Distribution/SPDX/LicenseExpression.hs +++ b/Cabal/Distribution/SPDX/LicenseExpression.hs @@ -2,8 +2,8 @@ {-# LANGUAGE DeriveGeneric #-} module Distribution.SPDX.LicenseExpression ( LicenseExpression (..), + SimpleLicenseExpression (..), simpleLicenseExpression, - OnlyOrAnyLater (..), ) where import Distribution.Compat.Prelude @@ -39,85 +39,102 @@ import qualified Text.PrettyPrint as Disp -- license expression = 1*1(simple expression / compound expression) -- @ data LicenseExpression - = ELicense !(Either LicenseRef LicenseId) !OnlyOrAnyLater !(Maybe LicenseExceptionId) + = ELicense !SimpleLicenseExpression !(Maybe LicenseExceptionId) | EAnd !LicenseExpression !LicenseExpression | EOr !LicenseExpression !LicenseExpression - deriving (Show, Read, Eq, Typeable, Data, Generic) + deriving (Show, Read, Eq, Ord, Typeable, Data, Generic) + +-- | Simple License Expressions. +data SimpleLicenseExpression + = ELicenseId LicenseId + -- ^ An SPDX License List Short Form Identifier. For example: @GPL-2.0@ + | ELicenseIdPlus LicenseId + -- ^ An SPDX License List Short Form Identifier with a unary"+" operator suffix to represent the current version of the license or any later version. For example: @GPL-2.0+@ + | ELicenseRef LicenseRef + -- ^ A SPDX user defined license reference: For example: @LicenseRef-23@, @LicenseRef-MIT-Style-1@, or @DocumentRef-spdx-tool-1.2:LicenseRef-MIT-Style-2@ + deriving (Show, Read, Eq, Ord, Typeable, Data, Generic) simpleLicenseExpression :: LicenseId -> LicenseExpression -simpleLicenseExpression i = ELicense (Right i) Only Nothing +simpleLicenseExpression i = ELicense (ELicenseId i) Nothing instance Binary LicenseExpression +instance Binary SimpleLicenseExpression instance Pretty LicenseExpression where pretty = go 0 where go :: Int -> LicenseExpression -> Disp.Doc - go _ (ELicense lic orLater exc) = - let doc = prettyId lic <<>> prettyOrLater orLater + go _ (ELicense lic exc) = + let doc = pretty lic in maybe id (\e d -> d <+> Disp.text "WITH" <+> pretty e) exc doc go d (EAnd e1 e2) = parens (d < 0) $ go 0 e1 <+> Disp.text "AND" <+> go 0 e2 go d (EOr e1 e2) = parens (d < 1) $ go 1 e1 <+> Disp.text "OR" <+> go 1 e2 - prettyId (Right i) = pretty i - prettyId (Left r) = pretty r - - prettyOrLater Only = mempty - prettyOrLater OrAnyLater = Disp.char '+' parens False doc = doc parens True doc = Disp.parens doc +instance Pretty SimpleLicenseExpression where + pretty (ELicenseId i) = pretty i + pretty (ELicenseIdPlus i) = pretty i <<>> Disp.char '+' + pretty (ELicenseRef r) = pretty r + +instance Parsec SimpleLicenseExpression where + parsec = idstring >>= simple where + simple n + | Just l <- "LicenseRef-" `isPrefixOfMaybe` n = + maybe (fail $ "Incorrect LicenseRef format: " ++ n) (return . ELicenseRef) $ mkLicenseRef Nothing l + | Just d <- "DocumentRef-" `isPrefixOfMaybe` n = do + _ <- P.string ":LicenseRef-" + l <- idstring + maybe (fail $ "Incorrect LicenseRef format:" ++ n) (return . ELicenseRef) $ mkLicenseRef (Just d) l + | otherwise = do + l <- maybe (fail $ "Unknown SPDX license identifier: " ++ n) return $ mkLicenseId n + orLater <- isJust <$> P.optional (P.char '+') + if orLater + then return (ELicenseIdPlus l) + else return (ELicenseId l) + +idstring :: P.CharParsing m => m String +idstring = P.munch1 $ \c -> isAsciiAlphaNum c || c == '-' || c == '.' + +-- returns suffix part +isPrefixOfMaybe :: Eq a => [a] -> [a] -> Maybe [a] +isPrefixOfMaybe pfx s + | pfx `isPrefixOf` s = Just (drop (length pfx) s) + | otherwise = Nothing + instance Parsec LicenseExpression where parsec = expr where expr = compoundOr - idstring = P.munch1 $ \c -> isAsciiAlphaNum c || c == '-' || c == '.' - - -- this parses "simple expression / simple expression "WITH" license exception id" simple = do - n <- idstring - i <- simple' n - orLater <- P.optional $ P.char '+' - _ <- P.spaces - exc <- P.optional $ P.try (P.string "WITH" *> spaces1) *> parsec - return $ ELicense i (maybe Only (const OrAnyLater) orLater) exc - - simple' n - | Just l <- "LicenseRef-" `isPrefixOfMaybe` n = - maybe (fail $ "Incorrect LicenseRef format: " ++ n) (return . Left) $ mkLicenseRef Nothing l - | Just d <- "DocumentRef-" `isPrefixOfMaybe` n = do - _ <- P.string ":LicenseRef" - l <- idstring - maybe (fail $ "Incorrect LicenseRef format:" ++ n) (return . Left) $ mkLicenseRef (Just d) l - | otherwise = - maybe (fail $ "Unknown SPDX license identifier: " ++ n) (return . Right) $ mkLicenseId n - - -- returns suffix part - isPrefixOfMaybe :: Eq a => [a] -> [a] -> Maybe [a] - isPrefixOfMaybe pfx s - | pfx `isPrefixOf` s = Just (drop (length pfx) s) - | otherwise = Nothing + s <- parsec + exc <- exception + return $ ELicense s exc + + exception = P.optional $ P.try (spaces1 *> P.string "WITH" *> spaces1) *> parsec compoundOr = do x <- compoundAnd - l <- P.optional $ P.try (P.string "OR" *> spaces1) *> compoundOr + l <- P.optional $ P.try (spaces1 *> P.string "OR" *> spaces1) *> compoundOr return $ maybe id (flip EOr) l x compoundAnd = do x <- compound - l <- P.optional $ P.try (P.string "AND" *> spaces1) *> compoundAnd + l <- P.optional $ P.try (spaces1 *> P.string "AND" *> spaces1) *> compoundAnd return $ maybe id (flip EAnd) l x compound = braces <|> simple + -- NOTE: we require that there's a space around AND & OR operators, + -- i.e. @(MIT)AND(MIT)@ will cause parse-error. braces = do _ <- P.char '(' _ <- P.spaces x <- expr _ <- P.char ')' - _ <- P.spaces return x spaces1 = P.space *> P.spaces @@ -131,20 +148,11 @@ instance Parsec LicenseExpression where -- We handle that by having greedy 'idstring' parser, so MITAND would parse as invalid license identifier. instance NFData LicenseExpression where - rnf (ELicense b i e) = rnf b `seq` rnf i `seq` rnf e - rnf (EAnd x y) = rnf x `seq` rnf y - rnf (EOr x y) = rnf x `seq` rnf y - -------------------------------------------------------------------------------- --- OnlyOrAnyLater -------------------------------------------------------------------------------- - --- | License version range. -data OnlyOrAnyLater = Only | OrAnyLater - deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) - -instance NFData OnlyOrAnyLater where - rnf Only = () - rnf OrAnyLater = () - -instance Binary OnlyOrAnyLater + rnf (ELicense s e) = rnf s `seq` rnf e + rnf (EAnd x y) = rnf x `seq` rnf y + rnf (EOr x y) = rnf x `seq` rnf y + +instance NFData SimpleLicenseExpression where + rnf (ELicenseId i) = rnf i + rnf (ELicenseIdPlus i) = rnf i + rnf (ELicenseRef r) = rnf r diff --git a/Cabal/Distribution/SPDX/LicenseReference.hs b/Cabal/Distribution/SPDX/LicenseReference.hs index 8f9d8366c..b3a98b83d 100644 --- a/Cabal/Distribution/SPDX/LicenseReference.hs +++ b/Cabal/Distribution/SPDX/LicenseReference.hs @@ -6,7 +6,6 @@ module Distribution.SPDX.LicenseReference ( licenseDocumentRef, mkLicenseRef, mkLicenseRef', - unsafeMkLicenseRef, ) where import Prelude () @@ -24,7 +23,7 @@ data LicenseRef = LicenseRef { _lrDocument :: !(Maybe String) , _lrLicense :: !String } - deriving (Show, Read, Eq, Typeable, Data, Generic) + deriving (Show, Read, Eq, Ord, Typeable, Data, Generic) -- | License reference. licenseRef :: LicenseRef -> String @@ -78,9 +77,3 @@ mkLicenseRef' d l = LicenseRef (fmap f d) (f l) f = map g g c | isAsciiAlphaNum c || c == '-' || c == '.' = c | otherwise = '-' - --- | Unsafe 'mkLicenseRef'. Consider using 'mkLicenseRef''. -unsafeMkLicenseRef :: Maybe String -> String -> LicenseRef -unsafeMkLicenseRef d l = case mkLicenseRef d l of - Nothing -> error $ "unsafeMkLicenseRef: panic" ++ show (d, l) - Just x -> x diff --git a/Cabal/Distribution/Simple/GHC/IPIConvert.hs b/Cabal/Distribution/Simple/GHC/IPIConvert.hs index e3c7bdb5b..6fd8cc2e9 100644 --- a/Cabal/Distribution/Simple/GHC/IPIConvert.hs +++ b/Cabal/Distribution/Simple/GHC/IPIConvert.hs @@ -20,6 +20,7 @@ import Distribution.Compat.Prelude import qualified Distribution.Types.PackageId as Current import qualified Distribution.Types.PackageName as Current import qualified Distribution.License as Current +import qualified Distribution.SPDX as SPDX import Distribution.Version import Distribution.ModuleName @@ -44,11 +45,11 @@ data License = GPL | LGPL | BSD3 | BSD4 convertModuleName :: String -> ModuleName convertModuleName s = fromMaybe (error "convertModuleName") $ simpleParse s -convertLicense :: License -> Current.License -convertLicense GPL = Current.GPL Nothing -convertLicense LGPL = Current.LGPL Nothing -convertLicense BSD3 = Current.BSD3 -convertLicense BSD4 = Current.BSD4 -convertLicense PublicDomain = Current.PublicDomain -convertLicense AllRightsReserved = Current.AllRightsReserved -convertLicense OtherLicense = Current.OtherLicense +convertLicense :: License -> Either SPDX.License Current.License +convertLicense GPL = Right $ Current.GPL Nothing +convertLicense LGPL = Right $ Current.LGPL Nothing +convertLicense BSD3 = Right $ Current.BSD3 +convertLicense BSD4 = Right $ Current.BSD4 +convertLicense PublicDomain = Right $ Current.PublicDomain +convertLicense AllRightsReserved = Right $ Current.AllRightsReserved +convertLicense OtherLicense = Right $ Current.OtherLicense diff --git a/Cabal/Distribution/Simple/Register.hs b/Cabal/Distribution/Simple/Register.hs index 1f84e5082..1413bcd6d 100644 --- a/Cabal/Distribution/Simple/Register.hs +++ b/Cabal/Distribution/Simple/Register.hs @@ -74,6 +74,7 @@ import qualified Distribution.Simple.Program.HcPkg as HcPkg import Distribution.Simple.Setup import Distribution.PackageDescription import Distribution.Package +import Distribution.License (licenseToSPDX, licenseFromSPDX) import qualified Distribution.InstalledPackageInfo as IPI import Distribution.InstalledPackageInfo (InstalledPackageInfo) import Distribution.Simple.Utils @@ -407,7 +408,11 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi IPI.instantiatedWith = componentInstantiatedWith clbi, IPI.sourceLibName = libName lib, IPI.compatPackageKey = componentCompatPackageKey clbi, - IPI.license = license pkg, + -- If GHC >= 8.4 we register with SDPX, otherwise with legacy license + IPI.license = + if ghc84 + then Left $ either id licenseToSPDX $ licenseRaw pkg + else Right $ either licenseFromSPDX id $ licenseRaw pkg, IPI.copyright = copyright pkg, IPI.maintainer = maintainer pkg, IPI.author = author pkg, @@ -450,6 +455,10 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi IPI.pkgRoot = Nothing } where + ghc84 = case compilerId $ compiler lbi of + CompilerId GHC v -> v >= mkVersion [8, 4] + _ -> False + bi = libBuildInfo lib --TODO: unclear what the root cause of the -- duplication is, but we nub it here for now: diff --git a/Cabal/Distribution/Types/AbiDependency.hs b/Cabal/Distribution/Types/AbiDependency.hs index f5c26251c..9223a215c 100644 --- a/Cabal/Distribution/Types/AbiDependency.hs +++ b/Cabal/Distribution/Types/AbiDependency.hs @@ -49,4 +49,4 @@ instance Text AbiDependency where instance Binary AbiDependency - +instance NFData AbiDependency where rnf = genericRnf diff --git a/Cabal/Distribution/Types/AbiHash.hs b/Cabal/Distribution/Types/AbiHash.hs index c66ad4980..0e1ec9524 100644 --- a/Cabal/Distribution/Types/AbiHash.hs +++ b/Cabal/Distribution/Types/AbiHash.hs @@ -54,6 +54,8 @@ instance IsString AbiHash where instance Binary AbiHash +instance NFData AbiHash where rnf = genericRnf + instance Pretty AbiHash where pretty = text . unAbiHash diff --git a/Cabal/Distribution/Types/ExposedModule.hs b/Cabal/Distribution/Types/ExposedModule.hs index 2538fa10f..f6eb47d77 100644 --- a/Cabal/Distribution/Types/ExposedModule.hs +++ b/Cabal/Distribution/Types/ExposedModule.hs @@ -53,3 +53,5 @@ instance Text ExposedModule where return (ExposedModule m reexport) instance Binary ExposedModule + +instance NFData ExposedModule where rnf = genericRnf diff --git a/Cabal/Distribution/Types/InstalledPackageInfo.hs b/Cabal/Distribution/Types/InstalledPackageInfo.hs index b32683ad7..008ac74dc 100644 --- a/Cabal/Distribution/Types/InstalledPackageInfo.hs +++ b/Cabal/Distribution/Types/InstalledPackageInfo.hs @@ -26,6 +26,7 @@ import Distribution.Types.UnqualComponentName import Distribution.Version (nullVersion) import qualified Distribution.Package as Package +import qualified Distribution.SPDX as SPDX -- ----------------------------------------------------------------------------- -- The InstalledPackageInfo type @@ -46,7 +47,7 @@ data InstalledPackageInfo -- with the same ModuleName as the key. instantiatedWith :: [(ModuleName, OpenModule)], compatPackageKey :: String, - license :: License, + license :: Either SPDX.License License, copyright :: String, maintainer :: String, author :: String, @@ -90,6 +91,8 @@ data InstalledPackageInfo instance Binary InstalledPackageInfo +instance NFData InstalledPackageInfo where rnf = genericRnf + instance Package.HasMungedPackageId InstalledPackageInfo where mungedId = mungedPackageId @@ -128,7 +131,7 @@ emptyInstalledPackageInfo installedUnitId = mkUnitId "", instantiatedWith = [], compatPackageKey = "", - license = UnspecifiedLicense, + license = Left SPDX.NONE, copyright = "", maintainer = "", author = "", diff --git a/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs index e348b3b2a..b4a132f55 100644 --- a/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs +++ b/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs @@ -1,7 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Distribution.Types.InstalledPackageInfo.FieldGrammar ( ipiFieldGrammar, ) where @@ -28,6 +28,7 @@ import Distribution.Version import qualified Data.Char as Char import qualified Data.Map as Map import qualified Distribution.Compat.CharParsing as P +import qualified Distribution.SPDX as SPDX import qualified Text.PrettyPrint as Disp import Distribution.Types.InstalledPackageInfo @@ -62,7 +63,7 @@ ipiFieldGrammar = mkInstalledPackageInfo <+> optionalFieldDef "id" L.installedUnitId (mkUnitId "") <+> optionalFieldDefAla "instantiated-with" InstWith L.instantiatedWith [] <+> optionalFieldDefAla "key" CompatPackageKey L.compatPackageKey "" - <+> optionalFieldDef "license" L.license UnspecifiedLicense + <+> optionalFieldDefAla "license" SpecLicenseLenient L.license (Left SPDX.NONE) <+> optionalFieldDefAla "copyright" FreeText L.copyright "" <+> optionalFieldDefAla "maintainer" FreeText L.maintainer "" <+> optionalFieldDefAla "author" FreeText L.author "" @@ -199,6 +200,20 @@ instance Parsec InstWith where parsec = InstWith . Map.toList <$> parsecOpenModuleSubst +-- | SPDX License expression or legacy license. Lenient parser, accepts either. +newtype SpecLicenseLenient = SpecLicenseLenient { getSpecLicenseLenient :: Either SPDX.License License } + +instance Newtype SpecLicenseLenient (Either SPDX.License License) where + pack = SpecLicenseLenient + unpack = getSpecLicenseLenient + +instance Parsec SpecLicenseLenient where + parsec = fmap SpecLicenseLenient $ Left <$> P.try parsec <|> Right <$> parsec + +instance Pretty SpecLicenseLenient where + pretty = either pretty pretty . unpack + + data Basic = Basic { _basicName :: MungedPackageName , _basicVersion :: Version diff --git a/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs b/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs index c741a02fb..36609b011 100644 --- a/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs +++ b/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs @@ -14,6 +14,7 @@ import Distribution.Package (AbiHash, ComponentId, PackageIde import Distribution.Types.InstalledPackageInfo (AbiDependency, ExposedModule, InstalledPackageInfo) import Distribution.Types.UnqualComponentName (UnqualComponentName) +import qualified Distribution.SPDX as SPDX import qualified Distribution.Types.InstalledPackageInfo as T sourcePackageId :: Lens' InstalledPackageInfo PackageIdentifier @@ -40,7 +41,7 @@ compatPackageKey :: Lens' InstalledPackageInfo String compatPackageKey f s = fmap (\x -> s { T.compatPackageKey = x }) (f (T.compatPackageKey s)) {-# INLINE compatPackageKey #-} -license :: Lens' InstalledPackageInfo License +license :: Lens' InstalledPackageInfo (Either SPDX.License License) license f s = fmap (\x -> s { T.license = x }) (f (T.license s)) {-# INLINE license #-} diff --git a/Cabal/Distribution/Types/PackageDescription.hs b/Cabal/Distribution/Types/PackageDescription.hs index aba47ec23..5550c090c 100644 --- a/Cabal/Distribution/Types/PackageDescription.hs +++ b/Cabal/Distribution/Types/PackageDescription.hs @@ -30,6 +30,8 @@ module Distribution.Types.PackageDescription ( PackageDescription(..), specVersion, specVersion', + license, + license', descCabalVersion, buildType, emptyPackageDescription, @@ -77,10 +79,12 @@ import Distribution.Types.BuildType import Distribution.Types.SourceRepo import Distribution.Types.HookedBuildInfo +import Distribution.Compiler +import Distribution.License import Distribution.Package import Distribution.Version -import Distribution.License -import Distribution.Compiler + +import qualified Distribution.SPDX as SPDX -- ----------------------------------------------------------------------------- -- The PackageDescription type @@ -102,7 +106,7 @@ data PackageDescription -- See also 'specVersion'. specVersionRaw :: Either Version VersionRange, package :: PackageIdentifier, - license :: License, + licenseRaw :: Either SPDX.License License, licenseFiles :: [FilePath], copyright :: String, maintainer :: String, @@ -180,6 +184,18 @@ specVersion' (Right versionRange) = case asVersionIntervals versionRange of [] -> mkVersion [0] ((LowerBound version _, _):_) -> version +-- | The SPDX 'LicenseExpression' of the package. +-- +-- @since 2.2.0.0 +license :: PackageDescription -> SPDX.License +license = license' . licenseRaw + +-- | See 'license'. +-- +-- @since 2.2.0.0 +license' :: Either SPDX.License License -> SPDX.License +license' = either id licenseToSPDX + -- | The range of versions of the Cabal tools that this package is intended to -- work with. -- @@ -222,7 +238,7 @@ emptyPackageDescription = PackageDescription { package = PackageIdentifier (mkPackageName "") nullVersion, - license = UnspecifiedLicense, + licenseRaw = Right UnspecifiedLicense, -- TODO: licenseFiles = [], specVersionRaw = Right anyVersion, buildTypeRaw = Nothing, diff --git a/Cabal/Distribution/Types/PackageDescription/Lens.hs b/Cabal/Distribution/Types/PackageDescription/Lens.hs index 5bdd9e6c2..6594b9953 100644 --- a/Cabal/Distribution/Types/PackageDescription/Lens.hs +++ b/Cabal/Distribution/Types/PackageDescription/Lens.hs @@ -3,9 +3,9 @@ module Distribution.Types.PackageDescription.Lens ( module Distribution.Types.PackageDescription.Lens, ) where -import Prelude () -import Distribution.Compat.Prelude import Distribution.Compat.Lens +import Distribution.Compat.Prelude +import Prelude () import Distribution.Compiler (CompilerFlavor) import Distribution.License (License) @@ -22,15 +22,16 @@ import Distribution.Types.SourceRepo (SourceRepo) import Distribution.Types.TestSuite (TestSuite) import Distribution.Version (Version, VersionRange) +import qualified Distribution.SPDX as SPDX import qualified Distribution.Types.PackageDescription as T package :: Lens' PackageDescription PackageIdentifier package f s = fmap (\x -> s { T.package = x }) (f (T.package s)) {-# INLINE package #-} -license :: Lens' PackageDescription License -license f s = fmap (\x -> s { T.license = x }) (f (T.license s)) -{-# INLINE license #-} +licenseRaw :: Lens' PackageDescription (Either SPDX.License License) +licenseRaw f s = fmap (\x -> s { T.licenseRaw = x }) (f (T.licenseRaw s)) +{-# INLINE licenseRaw #-} licenseFiles :: Lens' PackageDescription [String] licenseFiles f s = fmap (\x -> s { T.licenseFiles = x }) (f (T.licenseFiles s)) diff --git a/Cabal/tests/Instances/TreeDiff.hs b/Cabal/tests/Instances/TreeDiff.hs index 90e0c4ef2..9044fdc85 100644 --- a/Cabal/tests/Instances/TreeDiff.hs +++ b/Cabal/tests/Instances/TreeDiff.hs @@ -40,7 +40,6 @@ import Distribution.Types.UnqualComponentName -- instances ------------------------------------------------------------------------------- - instance (Eq a, Show a) => ToExpr (Condition a) where toExpr = defaultExprViaShow instance (Show a, ToExpr b, ToExpr c, Show b, Show c, Eq a, Eq c, Eq b) => ToExpr (CondTree a b c) instance (Show a, ToExpr b, ToExpr c, Show b, Show c, Eq a, Eq c, Eq b) => ToExpr (CondBranch a b c) diff --git a/Cabal/tests/Instances/TreeDiff/SPDX.hs b/Cabal/tests/Instances/TreeDiff/SPDX.hs index cd735dbef..e5d3d9802 100644 --- a/Cabal/tests/Instances/TreeDiff/SPDX.hs +++ b/Cabal/tests/Instances/TreeDiff/SPDX.hs @@ -12,6 +12,17 @@ import Distribution.License (License) import Instances.TreeDiff.Version () +import qualified Distribution.SPDX as SPDX + -- 'License' almost belongs here. instance ToExpr License + +-- Generics instance is too heavy +instance ToExpr SPDX.LicenseId where toExpr = defaultExprViaShow +instance ToExpr SPDX.LicenseExceptionId where toExpr = defaultExprViaShow + +instance ToExpr SPDX.License +instance ToExpr SPDX.LicenseExpression +instance ToExpr SPDX.LicenseRef +instance ToExpr SPDX.SimpleLicenseExpression diff --git a/Cabal/tests/ParserHackageTests.hs b/Cabal/tests/ParserHackageTests.hs index 5ae574428..4c9bb8c03 100644 --- a/Cabal/tests/ParserHackageTests.hs +++ b/Cabal/tests/ParserHackageTests.hs @@ -31,6 +31,7 @@ import qualified Distribution.PackageDescription.Parsec as Parsec import qualified Distribution.Parsec.Common as Parsec import qualified Distribution.Parsec.Parser as Parsec import qualified Distribution.ParseUtils as ReadP +import qualified Distribution.SPDX as SPDX import Distribution.Compat.Lens import qualified Distribution.Types.BuildInfo.Lens as L @@ -114,6 +115,9 @@ compareTest pfx fpath bsl let patchLocation (Just "") = Nothing patchLocation x = x + let unspecifiedToNone (Right UnspecifiedLicense) = Left SPDX.NONE + unspecifiedToNone x = x + -- Old parser is broken for many descriptions, and other free text fields let readp0 = readp & L.packageDescription . L.description .~ "" @@ -124,6 +128,10 @@ compareTest pfx fpath bsl & L.condExecutables . traverse . _2 . traverse . L.exeName .~ fromString "" -- custom fields: no order & L.buildInfos . L.customFieldsBI %~ sort + -- license UnspecifiedLicense -> NONE + & L.packageDescription . L.licenseRaw %~ unspecifiedToNone + + let parsec0 = parsec & L.packageDescription . L.description .~ "" & L.packageDescription . L.synopsis .~ "" @@ -197,12 +205,8 @@ roundtripTest _ fpath bsl = do let bs' = showGenericPackageDescription x0 y0 <- parse "2nd" (toUTF8BS bs') - -- 'License' type doesn't support parse . pretty roundrip (yet). - -- Will be fixed when we refactor to SPDX - let y1 = if x0 ^. L.packageDescription . L.license == UnspecifiedLicense - && y0 ^. L.packageDescription . L.license == UnknownLicense "UnspecifiedLicense" - then y0 & L.packageDescription . L.license .~ UnspecifiedLicense - else y0 + -- we mungled license here + let y1 = y0 -- license-files: "" let stripEmpty = filter (/="") diff --git a/Cabal/tests/ParserTests.hs b/Cabal/tests/ParserTests.hs index e21e7d7d4..fa52c515d 100644 --- a/Cabal/tests/ParserTests.hs +++ b/Cabal/tests/ParserTests.hs @@ -13,7 +13,6 @@ import Test.Tasty.HUnit import Control.Monad (void) import Data.Algorithm.Diff (Diff (..), getGroupedDiff) import Data.Maybe (isNothing) -import Distribution.License (License (..)) import Distribution.PackageDescription (GenericPackageDescription) import Distribution.PackageDescription.Parsec (parseGenericPackageDescription) import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) @@ -25,10 +24,6 @@ import System.FilePath (replaceExtension, ()) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 -import Distribution.Compat.Lens -import qualified Distribution.Types.GenericPackageDescription.Lens as L -import qualified Distribution.Types.PackageDescription.Lens as L - import qualified Distribution.InstalledPackageInfo as IPI import qualified Distribution.ParseUtils as ReadP @@ -187,12 +182,8 @@ formatRoundTripTest fp = testCase "roundtrip" $ do x <- parse contents let contents' = showGenericPackageDescription x y <- parse (toUTF8BS contents') - -- 'License' type doesn't support parse . pretty roundrip (yet). - -- Will be fixed when we refactor to SPDX - let y' = if x ^. L.packageDescription . L.license == UnspecifiedLicense - && y ^. L.packageDescription . L.license == UnknownLicense "UnspecifiedLicense" - then y & L.packageDescription . L.license .~ UnspecifiedLicense - else y + -- previously we mangled licenses a bit + let y' = y assertEqual "re-parsed doesn't match" x y' where parse :: BS.ByteString -> IO GenericPackageDescription diff --git a/Cabal/tests/ParserTests/ipi/Includes2.expr b/Cabal/tests/ParserTests/ipi/Includes2.expr index 22eebafb1..6b76b3f56 100644 --- a/Cabal/tests/ParserTests/ipi/Includes2.expr +++ b/Cabal/tests/ParserTests/ipi/Includes2.expr @@ -37,7 +37,7 @@ InstalledPackageInfo ldOptions = [], libraryDirs = ["/home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/build/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n"], libraryDynDirs = ["/home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/build/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n"], - license = BSD3, + license = Right BSD3, maintainer = "ezyang@cs.stanford.edu", pkgRoot = Nothing, pkgUrl = "", diff --git a/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr b/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr index aac0f4751..6f9ecf21b 100644 --- a/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr +++ b/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr @@ -31,7 +31,7 @@ InstalledPackageInfo libraryDirs = ["/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/build", "/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/build"], libraryDynDirs = [], - license = GPL (Just `mkVersion [3]`), + license = Right (GPL (Just `mkVersion [3]`)), maintainer = "mikhail.glushenkov@gmail.com", pkgRoot = Just "/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist", diff --git a/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr b/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr index fadc9cfda..0a867b53c 100644 --- a/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr +++ b/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr @@ -2072,7 +2072,7 @@ InstalledPackageInfo "-lm"], libraryDirs = ["/opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0"], libraryDynDirs = ["/opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0"], - license = BSD3, + license = Right BSD3, maintainer = "Ross Paterson ", pkgRoot = Nothing, pkgUrl = "", diff --git a/Cabal/tests/ParserTests/ipi/transformers.expr b/Cabal/tests/ParserTests/ipi/transformers.expr index 6441397ca..ba0830b14 100644 --- a/Cabal/tests/ParserTests/ipi/transformers.expr +++ b/Cabal/tests/ParserTests/ipi/transformers.expr @@ -72,7 +72,7 @@ InstalledPackageInfo ldOptions = [], libraryDirs = ["/opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0"], libraryDynDirs = ["/opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0"], - license = BSD3, + license = Right BSD3, maintainer = "Ross Paterson ", pkgRoot = Just "/opt/ghc/8.2.2/lib/ghc-8.2.2", pkgUrl = "", diff --git a/Cabal/tests/ParserTests/regressions/Octree-0.5.expr b/Cabal/tests/ParserTests/regressions/Octree-0.5.expr index a60b39933..1591c75da 100644 --- a/Cabal/tests/ParserTests/regressions/Octree-0.5.expr +++ b/Cabal/tests/ParserTests/regressions/Octree-0.5.expr @@ -259,8 +259,8 @@ GenericPackageDescription foreignLibs = [], homepage = "https://github.com/mgajda/octree", library = Nothing, - license = BSD3, licenseFiles = ["LICENSE"], + licenseRaw = Right BSD3, maintainer = "mjgajda@googlemail.com", package = PackageIdentifier {pkgName = `PackageName "Octree"`, diff --git a/Cabal/tests/ParserTests/regressions/common.expr b/Cabal/tests/ParserTests/regressions/common.expr index abdeec261..9341df23f 100644 --- a/Cabal/tests/ParserTests/regressions/common.expr +++ b/Cabal/tests/ParserTests/regressions/common.expr @@ -132,8 +132,8 @@ GenericPackageDescription foreignLibs = [], homepage = "", library = Nothing, - license = UnspecifiedLicense, licenseFiles = [], + licenseRaw = Left NONE, maintainer = "", package = PackageIdentifier {pkgName = `PackageName "common"`, diff --git a/Cabal/tests/ParserTests/regressions/common2.expr b/Cabal/tests/ParserTests/regressions/common2.expr index 2891db884..bb88b4287 100644 --- a/Cabal/tests/ParserTests/regressions/common2.expr +++ b/Cabal/tests/ParserTests/regressions/common2.expr @@ -388,8 +388,8 @@ GenericPackageDescription foreignLibs = [], homepage = "", library = Nothing, - license = UnspecifiedLicense, licenseFiles = [], + licenseRaw = Left NONE, maintainer = "", package = PackageIdentifier {pkgName = `PackageName "common"`, diff --git a/Cabal/tests/ParserTests/regressions/elif.expr b/Cabal/tests/ParserTests/regressions/elif.expr index 51b1b0277..09e8d6f70 100644 --- a/Cabal/tests/ParserTests/regressions/elif.expr +++ b/Cabal/tests/ParserTests/regressions/elif.expr @@ -133,8 +133,8 @@ GenericPackageDescription foreignLibs = [], homepage = "", library = Nothing, - license = UnspecifiedLicense, licenseFiles = [], + licenseRaw = Left NONE, maintainer = "", package = PackageIdentifier {pkgName = `PackageName "elif"`, diff --git a/Cabal/tests/ParserTests/regressions/elif2.expr b/Cabal/tests/ParserTests/regressions/elif2.expr index 30460cb23..a76f5cf3d 100644 --- a/Cabal/tests/ParserTests/regressions/elif2.expr +++ b/Cabal/tests/ParserTests/regressions/elif2.expr @@ -292,8 +292,8 @@ GenericPackageDescription foreignLibs = [], homepage = "", library = Nothing, - license = UnspecifiedLicense, licenseFiles = [], + licenseRaw = Left NONE, maintainer = "", package = PackageIdentifier {pkgName = `PackageName "elif"`, diff --git a/Cabal/tests/ParserTests/regressions/encoding-0.8.expr b/Cabal/tests/ParserTests/regressions/encoding-0.8.expr index 2a6a17368..76fe65980 100644 --- a/Cabal/tests/ParserTests/regressions/encoding-0.8.expr +++ b/Cabal/tests/ParserTests/regressions/encoding-0.8.expr @@ -94,8 +94,8 @@ GenericPackageDescription foreignLibs = [], homepage = "", library = Nothing, - license = UnspecifiedLicense, licenseFiles = [], + licenseRaw = Left NONE, maintainer = "", package = PackageIdentifier {pkgName = `PackageName "encoding"`, diff --git a/Cabal/tests/ParserTests/regressions/generics-sop.expr b/Cabal/tests/ParserTests/regressions/generics-sop.expr index d0d877273..a26d2bfbe 100644 --- a/Cabal/tests/ParserTests/regressions/generics-sop.expr +++ b/Cabal/tests/ParserTests/regressions/generics-sop.expr @@ -595,8 +595,8 @@ GenericPackageDescription foreignLibs = [], homepage = "", library = Nothing, - license = BSD3, licenseFiles = ["LICENSE"], + licenseRaw = Right BSD3, maintainer = "andres@well-typed.com", package = PackageIdentifier {pkgName = `PackageName "generics-sop"`, diff --git a/Cabal/tests/ParserTests/regressions/issue-774.check b/Cabal/tests/ParserTests/regressions/issue-774.check index 9fd6a5d9d..645065cc2 100644 --- a/Cabal/tests/ParserTests/regressions/issue-774.check +++ b/Cabal/tests/ParserTests/regressions/issue-774.check @@ -1,6 +1,6 @@ No 'category' field. No 'maintainer' field. -The 'license' field is missing. +The 'license' field is missing or is NONE. 'ghc-options: -threaded' has no effect for libraries. It should only be used for executables. 'ghc-options: -rtsopts' has no effect for libraries. It should only be used for executables. 'ghc-options: -with-rtsopts' has no effect for libraries. It should only be used for executables. diff --git a/Cabal/tests/ParserTests/regressions/issue-774.expr b/Cabal/tests/ParserTests/regressions/issue-774.expr index ce14d2db5..29380faad 100644 --- a/Cabal/tests/ParserTests/regressions/issue-774.expr +++ b/Cabal/tests/ParserTests/regressions/issue-774.expr @@ -88,8 +88,8 @@ GenericPackageDescription foreignLibs = [], homepage = "", library = Nothing, - license = UnspecifiedLicense, licenseFiles = [], + licenseRaw = Left NONE, maintainer = "", package = PackageIdentifier {pkgName = `PackageName "issue"`, diff --git a/Cabal/tests/ParserTests/regressions/leading-comma.expr b/Cabal/tests/ParserTests/regressions/leading-comma.expr index 5c803f4b3..71644e8cd 100644 --- a/Cabal/tests/ParserTests/regressions/leading-comma.expr +++ b/Cabal/tests/ParserTests/regressions/leading-comma.expr @@ -98,8 +98,8 @@ GenericPackageDescription foreignLibs = [], homepage = "", library = Nothing, - license = UnspecifiedLicense, licenseFiles = [], + licenseRaw = Left NONE, maintainer = "", package = PackageIdentifier {pkgName = `PackageName "leading-comma"`, diff --git a/Cabal/tests/ParserTests/regressions/nothing-unicode.check b/Cabal/tests/ParserTests/regressions/nothing-unicode.check index 02ff216d7..aa57fe962 100644 --- a/Cabal/tests/ParserTests/regressions/nothing-unicode.check +++ b/Cabal/tests/ParserTests/regressions/nothing-unicode.check @@ -1,6 +1,6 @@ No 'category' field. No 'maintainer' field. No 'description' field. -The 'license' field is missing. +The 'license' field is missing or is NONE. Suspicious flag names: 無. To avoid ambiguity in command line interfaces, flag shouldn't start with a dash. Also for better compatibility, flag names shouldn't contain non-ascii characters. Non ascii custom fields: x-無. For better compatibility, custom field names shouldn't contain non-ascii characters. diff --git a/Cabal/tests/ParserTests/regressions/nothing-unicode.expr b/Cabal/tests/ParserTests/regressions/nothing-unicode.expr index 1369190e8..6a544a5dc 100644 --- a/Cabal/tests/ParserTests/regressions/nothing-unicode.expr +++ b/Cabal/tests/ParserTests/regressions/nothing-unicode.expr @@ -133,8 +133,8 @@ GenericPackageDescription foreignLibs = [], homepage = "", library = Nothing, - license = UnspecifiedLicense, licenseFiles = [], + licenseRaw = Left NONE, maintainer = "", package = PackageIdentifier {pkgName = `PackageName "\\28961"`, diff --git a/Cabal/tests/ParserTests/regressions/shake.expr b/Cabal/tests/ParserTests/regressions/shake.expr index 79db87b9b..06ae41735 100644 --- a/Cabal/tests/ParserTests/regressions/shake.expr +++ b/Cabal/tests/ParserTests/regressions/shake.expr @@ -1692,8 +1692,8 @@ GenericPackageDescription foreignLibs = [], homepage = "http://shakebuild.com", library = Nothing, - license = BSD3, licenseFiles = ["LICENSE"], + licenseRaw = Right BSD3, maintainer = "Neil Mitchell ", package = PackageIdentifier {pkgName = `PackageName "shake"`, diff --git a/Cabal/tests/ParserTests/regressions/th-lift-instances.expr b/Cabal/tests/ParserTests/regressions/th-lift-instances.expr index f1cb24a73..273ad24be 100644 --- a/Cabal/tests/ParserTests/regressions/th-lift-instances.expr +++ b/Cabal/tests/ParserTests/regressions/th-lift-instances.expr @@ -407,8 +407,8 @@ GenericPackageDescription foreignLibs = [], homepage = "http://github.com/bennofs/th-lift-instances/", library = Nothing, - license = BSD3, licenseFiles = ["LICENSE"], + licenseRaw = Right BSD3, maintainer = "Benno F\252nfst\252ck ", package = PackageIdentifier {pkgName = `PackageName "th-lift-instances"`, diff --git a/Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr index ba7911bff..3ae10aece 100644 --- a/Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr +++ b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr @@ -158,8 +158,8 @@ GenericPackageDescription foreignLibs = [], homepage = "", library = Nothing, - license = BSD3, licenseFiles = ["LICENSE"], + licenseRaw = Right BSD3, maintainer = "Noam Lewis ", package = PackageIdentifier {pkgName = `PackageName "wl-pprint-indef"`, diff --git a/Cabal/tests/UnitTests/Distribution/SPDX.hs b/Cabal/tests/UnitTests/Distribution/SPDX.hs index f431cd20e..53ac3bfa4 100644 --- a/Cabal/tests/UnitTests/Distribution/SPDX.hs +++ b/Cabal/tests/UnitTests/Distribution/SPDX.hs @@ -15,6 +15,8 @@ spdxTests :: [TestTree] spdxTests = [ testProperty "LicenseId roundtrip" licenseIdRoundtrip , testProperty "LicenseExceptionId roundtrip" licenseExceptionIdRoundtrip + , testProperty "LicenseRef roundtrip" licenseRefRoundtrip + , testProperty "SimpleLicenseExpression roundtrip" simpleLicenseExpressionRoundtrip , testProperty "LicenseExpression roundtrip" licenseExpressionRoundtrip ] @@ -28,6 +30,16 @@ licenseExceptionIdRoundtrip x = counterexample (prettyShow x) $ Right x === eitherParsec (prettyShow x) +licenseRefRoundtrip :: LicenseRef -> Property +licenseRefRoundtrip x = + counterexample (prettyShow x) $ + Right x === eitherParsec (prettyShow x) + +simpleLicenseExpressionRoundtrip :: SimpleLicenseExpression -> Property +simpleLicenseExpressionRoundtrip x = + counterexample (prettyShow x) $ + Right x === eitherParsec (prettyShow x) + licenseExpressionRoundtrip :: LicenseExpression -> Property licenseExpressionRoundtrip x = counterexample (prettyShow x) $ @@ -53,16 +65,26 @@ instance Arbitrary LicenseId where instance Arbitrary LicenseExceptionId where arbitrary = arbitraryBoundedEnum -instance Arbitrary OnlyOrAnyLater where - arbitrary = arbitraryBoundedEnum +instance Arbitrary LicenseRef where + arbitrary = mkLicenseRef' <$> ids' <*> ids + where + ids = listOf1 $ elements $ ['a'..'z'] ++ ['A' .. 'Z'] ++ ['0'..'9'] ++ "_-" + ids' = oneof [ pure Nothing, Just <$> ids ] + +instance Arbitrary SimpleLicenseExpression where + arbitrary = oneof + [ ELicenseId <$> arbitrary + , ELicenseIdPlus <$> arbitrary + , ELicenseRef <$> arbitrary + ] instance Arbitrary LicenseExpression where arbitrary = sized arb where arb n - | n <= 0 = simple + | n <= 0 = ELicense <$> arbitrary <*> pure Nothing | otherwise = oneof - [ simple + [ ELicense <$> arbitrary <*> arbitrary , EAnd <$> arbA <*> arbB , EOr <$> arbA <*> arbB ] @@ -71,8 +93,6 @@ instance Arbitrary LicenseExpression where arbA = arb m arbB = arb (n - m) - simple = ELicense <$> (Right <$> arbitrary) <*> arbitrary <*> pure Nothing -- arbitrary - shrink (EAnd a b) = a : b : map (uncurry EAnd) (shrink (a, b)) shrink (EOr a b) = a : b : map (uncurry EOr) (shrink (a, b)) shrink _ = [] diff --git a/cabal-install/Distribution/Client/List.hs b/cabal-install/Distribution/Client/List.hs index a919582e1..65d43b652 100644 --- a/cabal-install/Distribution/Client/List.hs +++ b/cabal-install/Distribution/Client/List.hs @@ -26,6 +26,7 @@ import Distribution.PackageDescription ( Flag(..), unFlagName ) import Distribution.PackageDescription.Configuration ( flattenPackageDescription ) +import Distribution.Pretty (pretty) import Distribution.Simple.Compiler ( Compiler, PackageDBStack ) @@ -42,6 +43,8 @@ import Distribution.Verbosity (Verbosity) import Distribution.Text ( Text(disp), display ) +import qualified Distribution.SPDX as SPDX + import Distribution.Solver.Types.PackageConstraint import qualified Distribution.Solver.Types.PackageIndex as PackageIndex import Distribution.Solver.Types.SourcePackage @@ -280,7 +283,7 @@ data PackageDisplayInfo = PackageDisplayInfo { synopsis :: String, description :: String, category :: String, - license :: License, + license :: Either SPDX.License License, author :: String, maintainer :: String, dependencies :: [ExtDependency], @@ -316,7 +319,7 @@ showPackageSummaryInfo pkginfo = versions -> dispTopVersions 4 (preferredVersions pkginfo) versions , maybeShow (homepage pkginfo) "Homepage:" text - , text "License: " <+> text (display (license pkginfo)) + , text "License: " <+> either pretty pretty (license pkginfo) ]) $+$ text "" where @@ -344,7 +347,7 @@ showPackageDetailedInfo pkginfo = , entry "Bug reports" bugReports orNotSpecified text , entry "Description" description hideIfNull reflowParagraphs , entry "Category" category hideIfNull text - , entry "License" license alwaysShow disp + , entry "License" license alwaysShow (either pretty pretty) , entry "Author" author hideIfNull reflowLines , entry "Maintainer" maintainer hideIfNull reflowLines , entry "Source repo" sourceRepo orNotSpecified text @@ -435,7 +438,7 @@ mergePackageInfo versionPref installedPkgs sourcePkgs selectedPkg showVer = sourceVersions = map packageVersion sourcePkgs, preferredVersions = versionPref, - license = combine Source.license source + license = combine Source.licenseRaw source Installed.license installed, maintainer = combine Source.maintainer source Installed.maintainer installed, diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs index 622093989..85dba0490 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -349,7 +349,7 @@ exAvSrcPkg ex = C.packageDescription = C.emptyPackageDescription { C.package = pkgId , C.setupBuildInfo = setup - , C.license = BSD3 + , C.licenseRaw = Right BSD3 , C.buildTypeRaw = if isNothing setup then Just C.Simple else Just C.Custom diff --git a/cabal-testsuite/PackageTests/COnlyMain/my.cabal b/cabal-testsuite/PackageTests/COnlyMain/my.cabal index 81334a2e5..af2073406 100644 --- a/cabal-testsuite/PackageTests/COnlyMain/my.cabal +++ b/cabal-testsuite/PackageTests/COnlyMain/my.cabal @@ -1,7 +1,7 @@ cabal-version: 2.1 name: my version: 0.1 -license: BSD3 +license: BSD-3-Clause build-type: Simple executable foo diff --git a/cabal-testsuite/PackageTests/SPDX/M.hs b/cabal-testsuite/PackageTests/SPDX/M.hs new file mode 100644 index 000000000..ef2ad8bb3 --- /dev/null +++ b/cabal-testsuite/PackageTests/SPDX/M.hs @@ -0,0 +1 @@ +module M where diff --git a/cabal-testsuite/PackageTests/SPDX/Setup.hs b/cabal-testsuite/PackageTests/SPDX/Setup.hs new file mode 100644 index 000000000..2ee479d6a --- /dev/null +++ b/cabal-testsuite/PackageTests/SPDX/Setup.hs @@ -0,0 +1,2 @@ +main :: IO () +main = fail "Setup called despite `build-type:Simple`" diff --git a/cabal-testsuite/PackageTests/SPDX/cabal-old-build.cabal.out b/cabal-testsuite/PackageTests/SPDX/cabal-old-build.cabal.out new file mode 100644 index 000000000..542c554a7 --- /dev/null +++ b/cabal-testsuite/PackageTests/SPDX/cabal-old-build.cabal.out @@ -0,0 +1,10 @@ +# Setup configure +Resolving dependencies... +Configuring my-0... +# Setup build +Preprocessing library for my-0.. +Building library for my-0.. +# Setup copy +Installing library in +# Setup register +Registering library for my-0.. diff --git a/cabal-testsuite/PackageTests/SPDX/cabal-old-build.out b/cabal-testsuite/PackageTests/SPDX/cabal-old-build.out new file mode 100644 index 000000000..3b4f4f81c --- /dev/null +++ b/cabal-testsuite/PackageTests/SPDX/cabal-old-build.out @@ -0,0 +1,9 @@ +# Setup configure +Configuring my-0... +# Setup build +Preprocessing library for my-0.. +Building library for my-0.. +# Setup copy +Installing library in +# Setup register +Registering library for my-0.. diff --git a/cabal-testsuite/PackageTests/SPDX/cabal-old-build.test.hs b/cabal-testsuite/PackageTests/SPDX/cabal-old-build.test.hs new file mode 100644 index 000000000..e8a722e0f --- /dev/null +++ b/cabal-testsuite/PackageTests/SPDX/cabal-old-build.test.hs @@ -0,0 +1,10 @@ +import Test.Cabal.Prelude +main = setupAndCabalTest $ withPackageDb $ do + -- skip for GHC-8.4 and GHC-head until their Cabal modules are updated. + skipUnless =<< ghcVersionIs (< mkVersion [8,3]) + + setup_install [] + recordMode DoNotRecord $ do + ghc84 <- ghcVersionIs (>= mkVersion [8,4]) + let lic = if ghc84 then "BSD-3-Clause" else "BSD3" + ghcPkg' "field" ["my", "license"] >>= assertOutputContains lic diff --git a/cabal-testsuite/PackageTests/SPDX/cabal.project b/cabal-testsuite/PackageTests/SPDX/cabal.project new file mode 100644 index 000000000..e6fdbadb4 --- /dev/null +++ b/cabal-testsuite/PackageTests/SPDX/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/SPDX/cabal.test.hs b/cabal-testsuite/PackageTests/SPDX/cabal.test.hs new file mode 100644 index 000000000..2a3c602da --- /dev/null +++ b/cabal-testsuite/PackageTests/SPDX/cabal.test.hs @@ -0,0 +1,6 @@ +import Test.Cabal.Prelude +main = cabalTest $ do + recordMode DoNotRecord $ do + -- TODO: Hack; see also CustomDep/cabal.test.hs + withEnvFilter (/= "HOME") $ do + cabal "new-build" ["all"] diff --git a/cabal-testsuite/PackageTests/SPDX/my.cabal b/cabal-testsuite/PackageTests/SPDX/my.cabal new file mode 100644 index 000000000..9b90fb30d --- /dev/null +++ b/cabal-testsuite/PackageTests/SPDX/my.cabal @@ -0,0 +1,10 @@ +cabal-version: 2.1 +name: my +version: 0 +build-type: Simple +license: BSD-3-Clause + +library + exposed-modules: M + build-depends: base + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal-with-hpc.multitest.hs b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal-with-hpc.multitest.hs index b2713c65b..c029311ba 100644 --- a/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal-with-hpc.multitest.hs +++ b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal-with-hpc.multitest.hs @@ -1,7 +1,7 @@ import qualified Control.Exception as E (IOException, catch) import Control.Monad (unless) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Reader (ask) +import Control.Monad.Trans.Reader (ask) import Data.Maybe (catMaybes) import qualified Distribution.Verbosity as Verbosity -- 2.11.4.GIT