Change license :: License to Either SPDX.License License

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

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,

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,41 +646,59 @@ 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 "
           ++ "known licenses are: "
           ++ 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 =

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 ""

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