Skip to content

Commit 8e3da02

Browse files
phadejphadej
authored
Merge pull request #5050 from phadej/spdx-license-2
Change license :: License to Either SPDX.License License
2 parents 429fbc7 + ffbfafd commit 8e3da02

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

56 files changed

+435
-202
lines changed

‎Cabal/Distribution/License.hs

Lines changed: 77 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,8 @@
4545
module Distribution.License (
4646
License(..),
4747
knownLicenses,
48+
licenseToSPDX,
49+
licenseFromSPDX,
4850
) where
4951

5052
import Distribution.Compat.Prelude
@@ -56,7 +58,9 @@ import Distribution.Text
5658
import Distribution.Version
5759

5860
import qualified Distribution.Compat.CharParsing as P
61+
import qualified Distribution.Compat.Map.Strict as Map
5962
import qualified Distribution.Compat.ReadP as Parse
63+
import qualified Distribution.SPDX as SPDX
6064
import qualified Text.PrettyPrint as Disp
6165

6266
-- | 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])
138142
, MPL (mkVersion [2, 0])
139143
, Apache unversioned, Apache (version [2, 0])
140144
, PublicDomain, AllRightsReserved, OtherLicense]
141-
where
142-
unversioned = Nothing
143-
version = Just . mkVersion
145+
where
146+
unversioned = Nothing
147+
version = Just . mkVersion
148+
149+
-- | Convert old 'License' to SPDX 'SPDX.License'.
150+
-- Non-SPDX licenses are converted to 'SPDX.LicenseRef'.
151+
--
152+
-- @since 2.2.0.0
153+
licenseToSPDX :: License -> SPDX.License
154+
licenseToSPDX l = case l of
155+
GPL v | v == version [2] -> spdx SPDX.GPL_2_0
156+
GPL v | v == version [3] -> spdx SPDX.GPL_3_0
157+
LGPL v | v == version [2,1] -> spdx SPDX.LGPL_2_1
158+
LGPL v | v == version [3] -> spdx SPDX.LGPL_3_0
159+
AGPL v | v == version [3] -> spdx SPDX.AGPL_3_0
160+
BSD2 -> spdx SPDX.BSD_2_Clause
161+
BSD3 -> spdx SPDX.BSD_3_Clause
162+
BSD4 -> spdx SPDX.BSD_4_Clause
163+
MIT -> spdx SPDX.MIT
164+
ISC -> spdx SPDX.ISC
165+
MPL v | v == mkVersion [2,0] -> spdx SPDX.MPL_2_0
166+
Apache v | v == version [2,0] -> spdx SPDX.Apache_2_0
167+
AllRightsReserved -> SPDX.NONE
168+
UnspecifiedLicense -> SPDX.NONE
169+
OtherLicense -> ref (SPDX.mkLicenseRef' Nothing "OtherLicense")
170+
PublicDomain -> ref (SPDX.mkLicenseRef' Nothing "PublicDomain")
171+
UnknownLicense str -> ref (SPDX.mkLicenseRef' Nothing str)
172+
_ -> ref (SPDX.mkLicenseRef' Nothing $ prettyShow l)
173+
where
174+
version = Just . mkVersion
175+
spdx = SPDX.License . SPDX.simpleLicenseExpression
176+
ref r = SPDX.License $ SPDX.ELicense (SPDX.ELicenseRef r) Nothing
177+
178+
-- | Convert 'SPDX.License' to 'License',
179+
--
180+
-- This is lossy conversion. We try our best.
181+
--
182+
-- >>> licenseFromSPDX . licenseToSPDX $ BSD3
183+
-- BSD3
184+
--
185+
-- >>> licenseFromSPDX . licenseToSPDX $ GPL (Just (mkVersion [3]))
186+
-- GPL (Just (mkVersion [3]))
187+
--
188+
-- >>> licenseFromSPDX . licenseToSPDX $ PublicDomain
189+
-- UnknownLicense "LicenseRefPublicDomain"
190+
--
191+
-- >>> licenseFromSPDX $ SPDX.License $ SPDX.simpleLicenseExpression SPDX.EUPL_1_1
192+
-- UnknownLicense "EUPL-1.1"
193+
--
194+
-- >>> licenseFromSPDX . licenseToSPDX $ AllRightsReserved
195+
-- AllRightsReserved
196+
--
197+
-- >>> licenseFromSPDX <$> simpleParsec "BSD-3-Clause OR GPL-3.0"
198+
-- Just (UnknownLicense "BSD3ClauseORGPL30")
199+
--
200+
-- @since 2.2.0.0
201+
licenseFromSPDX :: SPDX.License -> License
202+
licenseFromSPDX SPDX.NONE = AllRightsReserved
203+
licenseFromSPDX l =
204+
fromMaybe (mungle $ prettyShow l) $ Map.lookup l m
205+
where
206+
m :: Map.Map SPDX.License License
207+
m = Map.fromList $ filter (isSimple . fst ) $
208+
map (\x -> (licenseToSPDX x, x)) knownLicenses
209+
210+
isSimple (SPDX.License (SPDX.ELicense (SPDX.ELicenseId _) Nothing)) = True
211+
isSimple _ = False
212+
213+
mungle name = fromMaybe (UnknownLicense (mapMaybe mangle name)) (simpleParsec name)
214+
215+
mangle c
216+
| isAlphaNum c = Just c
217+
| otherwise = Nothing
144218

145219
instance Pretty License where
146220
pretty (GPL version) = Disp.text "GPL" <<>> dispOptVersion version

‎Cabal/Distribution/PackageDescription.hs

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,3 @@
1-
{-# LANGUAGE DeriveDataTypeable #-}
2-
{-# LANGUAGE DeriveGeneric #-}
3-
41
-----------------------------------------------------------------------------
52
-- |
63
-- Module : Distribution.PackageDescription
@@ -19,6 +16,7 @@ module Distribution.PackageDescription (
1916
emptyPackageDescription,
2017
specVersion,
2118
buildType,
19+
license,
2220
descCabalVersion,
2321
BuildType(..),
2422
knownBuildTypes,

‎Cabal/Distribution/PackageDescription/Check.hs

Lines changed: 62 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -33,52 +33,49 @@ module Distribution.PackageDescription.Check (
3333
checkPackageFileNames,
3434
) where
3535

36-
import Prelude ()
3736
import Distribution.Compat.Prelude
37+
import Prelude ()
3838

39-
import Distribution.PackageDescription
40-
import Distribution.PackageDescription.Configuration
41-
import qualified Distribution.Compat.DList as DList
39+
import Control.Monad (mapM)
40+
import Data.List (group)
41+
import Distribution.Compat.Lens
4242
import Distribution.Compiler
43-
import Distribution.System
4443
import Distribution.License
45-
import Distribution.Simple.BuildPaths (autogenPathsModuleName)
44+
import Distribution.Package
45+
import Distribution.PackageDescription
46+
import Distribution.PackageDescription.Configuration
47+
import Distribution.Pretty (prettyShow)
48+
import Distribution.Simple.BuildPaths (autogenPathsModuleName)
4649
import Distribution.Simple.BuildToolDepends
4750
import Distribution.Simple.CCompiler
51+
import Distribution.Simple.Utils hiding (findPackageDesc, notice)
52+
import Distribution.System
53+
import Distribution.Text
4854
import Distribution.Types.ComponentRequestedSpec
4955
import Distribution.Types.CondTree
50-
import Distribution.Types.Dependency
51-
import Distribution.Types.ExeDependency
52-
import Distribution.Types.PackageName
5356
import Distribution.Types.ExecutableScope
57+
import Distribution.Types.ExeDependency
5458
import Distribution.Types.UnqualComponentName
55-
import Distribution.Simple.Utils hiding (findPackageDesc, notice)
59+
import Distribution.Utils.Generic (isAscii)
5660
import Distribution.Version
57-
import Distribution.Package
58-
import Distribution.Text
59-
import Distribution.Utils.Generic (isAscii)
6061
import Language.Haskell.Extension
62+
import System.FilePath
63+
(splitDirectories, splitExtension, splitPath, takeExtension, takeFileName, (<.>), (</>))
6164

62-
import Control.Monad (mapM)
63-
import qualified Data.ByteString.Lazy as BS
64-
import Data.List (group)
65-
import qualified System.Directory as System
66-
( doesFileExist, doesDirectoryExist )
67-
import qualified Data.Map as Map
65+
import qualified Data.ByteString.Lazy as BS
66+
import qualified Data.Map as Map
67+
import qualified Distribution.Compat.DList as DList
68+
import qualified Distribution.SPDX as SPDX
69+
import qualified System.Directory as System
6870

69-
import qualified System.Directory (getDirectoryContents)
70-
import System.FilePath
71-
( (</>), (<.>), takeExtension, takeFileName, splitDirectories
72-
, splitPath, splitExtension )
73-
import System.FilePath.Windows as FilePath.Windows
74-
( isValid )
71+
import qualified System.Directory (getDirectoryContents)
72+
import qualified System.FilePath.Windows as FilePath.Windows (isValid)
7573

7674
import qualified Data.Set as Set
7775

78-
import Distribution.Compat.Lens
79-
import qualified Distribution.Types.BuildInfo.Lens as L
80-
import qualified Distribution.Types.PackageDescription.Lens as L
76+
import qualified Distribution.Types.BuildInfo.Lens as L
8177
import qualified Distribution.Types.GenericPackageDescription.Lens as L
78+
import qualified Distribution.Types.PackageDescription.Lens as L
8279

8380
-- | Results of some kind of failed package check.
8481
--
@@ -649,41 +646,59 @@ checkFields pkg =
649646

650647

651648
checkLicense :: PackageDescription -> [PackageCheck]
652-
checkLicense pkg =
653-
catMaybes [
649+
checkLicense pkg = case licenseRaw pkg of
650+
Right l -> checkOldLicense pkg l
651+
Left l -> checkNewLicense pkg l
652+
653+
checkNewLicense :: PackageDescription -> SPDX.License -> [PackageCheck]
654+
checkNewLicense _pkg lic = catMaybes
655+
[ check (lic == SPDX.NONE) $
656+
PackageDistInexcusable
657+
"The 'license' field is missing or is NONE."
658+
]
654659

655-
check (license pkg == UnspecifiedLicense) $
660+
checkOldLicense :: PackageDescription -> License -> [PackageCheck]
661+
checkOldLicense pkg lic = catMaybes
662+
[ check (lic == UnspecifiedLicense) $
656663
PackageDistInexcusable
657664
"The 'license' field is missing."
658665

659-
, check (license pkg == AllRightsReserved) $
666+
, check (lic == AllRightsReserved) $
660667
PackageDistSuspicious
661668
"The 'license' is AllRightsReserved. Is that really what you want?"
662-
, case license pkg of
669+
670+
, checkVersion [1,4] (lic `notElem` compatLicenses) $
671+
PackageDistInexcusable $
672+
"Unfortunately the license " ++ quote (prettyShow (license pkg))
673+
++ " messes up the parser in earlier Cabal versions so you need to "
674+
++ "specify 'cabal-version: >= 1.4'. Alternatively if you require "
675+
++ "compatibility with earlier Cabal versions then use 'OtherLicense'."
676+
677+
, case lic of
663678
UnknownLicense l -> Just $
664679
PackageBuildWarning $
665680
quote ("license: " ++ l) ++ " is not a recognised license. The "
666681
++ "known licenses are: "
667682
++ commaSep (map display knownLicenses)
668683
_ -> Nothing
669684

670-
, check (license pkg == BSD4) $
685+
, check (lic == BSD4) $
671686
PackageDistSuspicious $
672687
"Using 'license: BSD4' is almost always a misunderstanding. 'BSD4' "
673688
++ "refers to the old 4-clause BSD license with the advertising "
674689
++ "clause. 'BSD3' refers the new 3-clause BSD license."
675690

676-
, case unknownLicenseVersion (license pkg) of
691+
, case unknownLicenseVersion (lic) of
677692
Just knownVersions -> Just $
678693
PackageDistSuspicious $
679-
"'license: " ++ display (license pkg) ++ "' is not a known "
694+
"'license: " ++ display (lic) ++ "' is not a known "
680695
++ "version of that license. The known versions are "
681696
++ commaSep (map display knownVersions)
682697
++ ". If this is not a mistake and you think it should be a known "
683698
++ "version then please file a ticket."
684699
_ -> Nothing
685700

686-
, check (license pkg `notElem` [ AllRightsReserved
701+
, check (lic `notElem` [ AllRightsReserved
687702
, UnspecifiedLicense, PublicDomain]
688703
-- AllRightsReserved and PublicDomain are not strictly
689704
-- licenses so don't need license files.
@@ -705,6 +720,15 @@ checkLicense pkg =
705720
where knownVersions = [ v' | Apache (Just v') <- knownLicenses ]
706721
unknownLicenseVersion _ = Nothing
707722

723+
checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheck
724+
checkVersion ver cond pc
725+
| specVersion pkg >= mkVersion ver = Nothing
726+
| otherwise = check cond pc
727+
728+
compatLicenses = [ GPL Nothing, LGPL Nothing, AGPL Nothing, BSD3, BSD4
729+
, PublicDomain, AllRightsReserved
730+
, UnspecifiedLicense, OtherLicense ]
731+
708732
checkSourceRepos :: PackageDescription -> [PackageCheck]
709733
checkSourceRepos pkg =
710734
catMaybes $ concat [[
@@ -1228,7 +1252,7 @@ checkCabalVersion pkg =
12281252
PackageDistInexcusable $
12291253
"The use of 'virtual-modules' requires the package "
12301254
++ " to specify at least 'cabal-version: >= 2.1'."
1231-
1255+
12321256
-- check use of "tested-with: GHC (>= 1.0 && < 1.4) || >=1.8 " syntax
12331257
, checkVersion [1,8] (not (null testedWithVersionRangeExpressions)) $
12341258
PackageDistInexcusable $
@@ -1275,14 +1299,6 @@ checkCabalVersion pkg =
12751299
++ "Unfortunately it messes up the parser in earlier Cabal versions "
12761300
++ "so you need to specify 'cabal-version: >= 1.6'."
12771301

1278-
-- check for new licenses
1279-
, checkVersion [1,4] (license pkg `notElem` compatLicenses) $
1280-
PackageDistInexcusable $
1281-
"Unfortunately the license " ++ quote (display (license pkg))
1282-
++ " messes up the parser in earlier Cabal versions so you need to "
1283-
++ "specify 'cabal-version: >= 1.4'. Alternatively if you require "
1284-
++ "compatibility with earlier Cabal versions then use 'OtherLicense'."
1285-
12861302
-- check for new language extensions
12871303
, checkVersion [1,2,3] (not (null mentionedExtensionsThatNeedCabal12)) $
12881304
PackageDistInexcusable $
@@ -1428,10 +1444,6 @@ checkCabalVersion pkg =
14281444
(orLaterVersion v) (earlierVersion (majorUpperBound v))
14291445
embed vr = embedVersionRange vr
14301446

1431-
compatLicenses = [ GPL Nothing, LGPL Nothing, AGPL Nothing, BSD3, BSD4
1432-
, PublicDomain, AllRightsReserved
1433-
, UnspecifiedLicense, OtherLicense ]
1434-
14351447
mentionedExtensions = [ ext | bi <- allBuildInfo pkg
14361448
, ext <- allExtensions bi ]
14371449
mentionedExtensionsThatNeedCabal12 =

‎Cabal/Distribution/PackageDescription/FieldGrammar.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,6 @@ import Prelude ()
4545

4646
import Distribution.Compiler (CompilerFlavor (..))
4747
import Distribution.FieldGrammar
48-
import Distribution.License (License (..))
4948
import Distribution.ModuleName (ModuleName)
5049
import Distribution.Package
5150
import Distribution.PackageDescription
@@ -58,6 +57,8 @@ import Distribution.Types.ForeignLibType
5857
import Distribution.Types.UnqualComponentName
5958
import Distribution.Version (anyVersion)
6059

60+
import qualified Distribution.SPDX as SPDX
61+
6162
import qualified Distribution.Types.Lens as L
6263

6364
-------------------------------------------------------------------------------
@@ -70,7 +71,7 @@ packageDescriptionFieldGrammar
7071
packageDescriptionFieldGrammar = PackageDescription
7172
<$> optionalFieldDefAla "cabal-version" SpecVersion L.specVersionRaw (Right anyVersion)
7273
<*> blurFieldGrammar L.package packageIdentifierGrammar
73-
<*> optionalFieldDef "license" L.license UnspecifiedLicense
74+
<*> optionalFieldDefAla "license" SpecLicense L.licenseRaw (Left SPDX.NONE)
7475
<*> licenseFilesGrammar
7576
<*> optionalFieldDefAla "copyright" FreeText L.copyright ""
7677
<*> optionalFieldDefAla "maintainer" FreeText L.maintainer ""

‎Cabal/Distribution/PackageDescription/Parse.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -99,8 +99,9 @@ pkgDescrFieldDescrs =
9999
(maybe mempty disp) (fmap Just parse)
100100
buildTypeRaw (\t pkg -> pkg{buildTypeRaw=t})
101101
, simpleField "license"
102-
disp parseLicenseQ
103-
license (\l pkg -> pkg{license=l})
102+
(either (error "pretty spdx expr") disp)
103+
(fmap Right parseLicenseQ)
104+
licenseRaw (\l pkg -> pkg{licenseRaw=l})
104105
-- We have both 'license-file' and 'license-files' fields.
105106
-- Rather than declaring license-file to be deprecated, we will continue
106107
-- to allow both. The 'license-file' will continue to only allow single

0 commit comments

Comments
 (0)