Improve cabal init code a bit

- Always ask for SPDX expression, we can "convert" them to old format
- No default license
- Add cabal-version: 3.0 to the list
- cabal-version is asked using CabalSpecVersion type
- seems to fix what #6619 tries to fix:

```
% /code/shared-haskell/cabal/dist-newstyle/build/x86_64-linux/ghc-8.8.3/cabal-install-3.3.0.0/x/cabal/build/cabal/cabal init -l 'FOO AND BAR'
Cannot parse license: FOO AND BAR
CallStack (from HasCallStack):
  error, called at ./Distribution/ReadE.hs:42:24 in Cabal-3.3.0.0-inplace:Distribution.ReadE
```

an error, but it doesn't loop.

Author: phadej

cabal-install/Distribution/Client/Config.hs

@@ -61,6 +61,7 @@ import Distribution.Client.BuildReports.Types
          ( ReportLevel(..) )
 import qualified Distribution.Client.Init.Types as IT
          ( InitFlags(..) )
+import qualified Distribution.Client.Init.Defaults as IT
 import Distribution.Client.Setup
          ( GlobalFlags(..), globalCommand, defaultGlobalFlags
          , ConfigExFlags(..), configureExOptions, defaultConfigExFlags
@@ -74,8 +75,6 @@ import Distribution.Client.CmdInstall.ClientInstallFlags
 import Distribution.Utils.NubList
          ( NubList, fromNubList, toNubList, overNubList )
 
-import Distribution.License
-         ( License(BSD3) )
 import Distribution.Simple.Compiler
          ( DebugInfoLevel(..), OptimisationLevel(..) )
 import Distribution.Simple.Setup
@@ -114,8 +113,6 @@ import Distribution.Compiler
          ( CompilerFlavor(..), defaultCompilerFlavor )
 import Distribution.Verbosity
          ( Verbosity, normal )
-import Distribution.Version
-         ( mkVersion )
 
 import Distribution.Solver.Types.ConstraintSource
 
@@ -851,9 +848,9 @@ commentSavedConfig = do
             },
         savedInitFlags       = mempty {
             IT.interactive     = toFlag False,
-            IT.cabalVersion    = toFlag (mkVersion [2,4]),
+            IT.cabalVersion    = toFlag IT.defaultCabalVersion,
             IT.language        = toFlag Haskell2010,
-            IT.license         = toFlag BSD3,
+            IT.license         = NoFlag,
             IT.sourceDirs      = Nothing,
             IT.applicationDirs = Nothing
             },

cabal-install/Distribution/Client/Init/Command.hs

@@ -31,8 +31,6 @@ import System.Directory
 import System.FilePath
   ( (</>), takeBaseName, equalFilePath )
 
-import Data.List
-  ( (\\) )
 import qualified Data.List.NonEmpty as NE
 import Data.Function
   ( on )
@@ -43,8 +41,10 @@ import Control.Monad
 import Control.Arrow
   ( (&&&), (***) )
 
+import Distribution.CabalSpecVersion
+  ( CabalSpecVersion (..), showCabalSpecVersion )
 import Distribution.Version
-  ( Version, mkVersion, alterVersion, versionNumbers, majorBoundVersion
+  ( Version, mkVersion, alterVersion, majorBoundVersion
   , orLaterVersion, earlierVersion, intersectVersionRanges, VersionRange )
 import Distribution.Verbosity
   ( Verbosity )
@@ -53,6 +53,7 @@ import Distribution.ModuleName
 import Distribution.InstalledPackageInfo
   ( InstalledPackageInfo, exposed )
 import qualified Distribution.Package as P
+import qualified Distribution.SPDX as SPDX
 import Distribution.Types.LibraryName
   ( LibraryName(..) )
 import Language.Haskell.Extension ( Language(..) )
@@ -75,10 +76,6 @@ import Distribution.Client.Init.Heuristics
     SourceFileEntry(..),
     scanForModules, neededBuildPrograms )
 
-import Distribution.License
-  ( License(..), knownLicenses, licenseToSPDX )
-import qualified Distribution.SPDX as SPDX
-
 import Distribution.Simple.Setup
   ( Flag(..), flagToMaybe )
 import Distribution.Simple.Configure
@@ -123,8 +120,8 @@ initCabal verbosity packageDBs repoCtxt comp progdb initFlags = do
   initFlags' <- extendFlags installedPkgIndex sourcePkgDb initFlags
 
   case license initFlags' of
-    Flag PublicDomain -> return ()
-    _                 -> writeLicense initFlags'
+    Flag SPDX.NONE -> return ()
+    _              -> writeLicense initFlags'
   writeChangeLog initFlags'
   createDirectories (sourceDirs initFlags')
   createLibHs initFlags'
@@ -189,7 +186,7 @@ getSimpleProject flags = do
       flags { interactive = Flag False
             , simpleProject = Flag True
             , packageType = Flag LibraryAndExecutable
-            , cabalVersion = Flag (mkVersion [2,4])
+            , cabalVersion = Flag defaultCabalVersion
             }
     simpleProjFlag@_ ->
       flags { simpleProject = simpleProjFlag }
@@ -205,20 +202,21 @@ getCabalVersion flags = do
   cabVer <-     return (flagToMaybe $ cabalVersion flags)
             ?>> maybePrompt flags (either (const defaultCabalVersion) id `fmap`
                                   promptList "Please choose version of the Cabal specification to use"
-                                  [mkVersion [1,10], mkVersion [2,0], mkVersion [2,2], mkVersion [2,4]]
+                                  [CabalSpecV1_10, CabalSpecV2_0, CabalSpecV2_2, CabalSpecV2_4, CabalSpecV3_0]
                                   (Just defaultCabalVersion) displayCabalVersion False)
             ?>> return (Just defaultCabalVersion)
 
   return $  flags { cabalVersion = maybeToFlag cabVer }
 
   where
-    displayCabalVersion :: Version -> String
-    displayCabalVersion v = case versionNumbers v of
-      [1,10] -> "1.10   (legacy)"
-      [2,0]  -> "2.0    (+ support for Backpack, internal sub-libs, '^>=' operator)"
-      [2,2]  -> "2.2    (+ support for 'common', 'elif', redundant commas, SPDX)"
-      [2,4]  -> "2.4    (+ support for '**' globbing)"
-      _      -> display v
+    displayCabalVersion :: CabalSpecVersion -> String
+    displayCabalVersion v = case v of
+      CabalSpecV1_10 -> "1.10   (legacy)"
+      CabalSpecV2_0  -> "2.0    (+ support for Backpack, internal sub-libs, '^>=' operator)"
+      CabalSpecV2_2  -> "2.2    (+ support for 'common', 'elif', redundant commas, SPDX)"
+      CabalSpecV2_4  -> "2.4    (+ support for '**' globbing)"
+      CabalSpecV3_0  -> "3.0    (+ set notation for ==, common stanzas in ifs, more redundant commas, better pkgconfig-depends)"
+      _              -> showCabalSpecVersion v
 
 
 
@@ -269,39 +267,44 @@ getVersion flags = do
 -- then prompt the user from a predefined list of licenses.
 getLicense :: InitFlags -> IO InitFlags
 getLicense flags = do
-  lic <-     return (flagToMaybe $ license flags)
-         ?>> fmap (fmap (either UnknownLicense id))
-                  (maybePrompt flags
-                    (promptList "Please choose a license" listedLicenses
-                     (Just BSD3) displayLicense True))
-
-  case checkLicenseInvalid lic of
-    Just msg -> putStrLn msg >> getLicense flags
-    Nothing  -> return $ flags { license = maybeToFlag lic }
-
+  elic <- return (fmap Right $ flagToMaybe $ license flags)
+      ?>> maybePrompt flags (promptList "Please choose a license" listedLicenses Nothing prettyShow True)
+
+  case elic of
+      Nothing          -> return flags { license = NoFlag }
+      Just (Right lic) -> return flags { license = Flag lic }
+      Just (Left str)  -> case eitherParsec str of
+          Right lic -> return flags { license = Flag lic }
+          -- on error, loop
+          Left err -> do
+              putStrLn "The license must be a valid SPDX expression."
+              putStrLn err
+              getLicense flags
   where
-    displayLicense l | needSpdx  = prettyShow (licenseToSPDX l)
-                     | otherwise = display l
-
-    checkLicenseInvalid (Just (UnknownLicense t))
-      | needSpdx  = case eitherParsec t :: Either String SPDX.License of
-                      Right _ -> Nothing
-                      Left _  -> Just "\nThe license must be a valid SPDX expression."
-      | otherwise = if any (not . isAlphaNum) t
-                    then Just promptInvalidOtherLicenseMsg
-                    else Nothing
-    checkLicenseInvalid _ = Nothing
-
-    promptInvalidOtherLicenseMsg = "\nThe license must be alphanumeric. " ++
-                                   "If your license name has many words, " ++
-                                   "the convention is to use camel case (e.g. PublicDomain). " ++
-                                   "Please choose a different license."
-
+    -- perfectly we'll have this and writeLicense (in FileCreators)
+    -- in a single file
     listedLicenses =
-      knownLicenses \\ [GPL Nothing, LGPL Nothing, AGPL Nothing
-                       , Apache Nothing, OtherLicense]
-
-    needSpdx = maybe False (>= mkVersion [2,2]) $ flagToMaybe (cabalVersion flags)
+      SPDX.NONE :
+      map (\lid -> SPDX.License (SPDX.ELicense (SPDX.ELicenseId lid) Nothing))
+      [ SPDX.BSD_2_Clause
+      , SPDX.BSD_3_Clause
+      , SPDX.Apache_2_0
+      , SPDX.MIT
+      , SPDX.MPL_2_0
+      , SPDX.ISC
+
+      , SPDX.GPL_2_0_only
+      , SPDX.GPL_3_0_only
+      , SPDX.LGPL_2_1_only
+      , SPDX.LGPL_3_0_only
+      , SPDX.AGPL_3_0_only
+
+      , SPDX.GPL_2_0_or_later
+      , SPDX.GPL_3_0_or_later
+      , SPDX.LGPL_2_1_or_later
+      , SPDX.LGPL_3_0_or_later
+      , SPDX.AGPL_3_0_or_later
+      ]
 
 -- | The author's name and email. Prompt, or try to guess from an existing
 --   darcs repo.
@@ -641,7 +644,7 @@ chooseDep flags (m, Just ps)
   where
     pkgGroups = NE.groupBy ((==) `on` P.pkgName) (map P.packageId ps)
 
-    desugar = maybe True (< mkVersion [2]) $ flagToMaybe (cabalVersion flags)
+    desugar = maybe True (< CabalSpecV2_0) $ flagToMaybe (cabalVersion flags)
 
     -- Given a list of available versions of the same package, pick a dependency.
     toDep :: NonEmpty P.PackageIdentifier -> IO P.Dependency

cabal-install/Distribution/Client/Init/Defaults.hs

@@ -21,11 +21,11 @@ import Distribution.ModuleName
   ( ModuleName )  -- And for the Text instance
 import qualified Distribution.ModuleName as ModuleName
   ( fromString )
-import Distribution.Version
-  ( Version, mkVersion )
+import Distribution.CabalSpecVersion
+  ( CabalSpecVersion (..))
 
-defaultCabalVersion :: Version
-defaultCabalVersion = mkVersion [1,10]
+defaultCabalVersion :: CabalSpecVersion
+defaultCabalVersion = CabalSpecV2_4
 
 myLibModule :: ModuleName
 myLibModule = ModuleName.fromString "MyLib"

cabal-install/Distribution/Client/Init/FileCreators.hs

@@ -49,10 +49,11 @@ import Distribution.Client.Init.Utils
 import Distribution.Client.Init.Types
   ( InitFlags(..), BuildType(..), PackageType(..) )
 
+import Distribution.CabalSpecVersion
 import Distribution.Deprecated.Text
   ( display, Text(..) )
 import Distribution.License
-  ( License(..), licenseToSPDX )
+  ( licenseFromSPDX )
 import qualified Distribution.ModuleName as ModuleName
   ( toFilePath )
 import qualified Distribution.Package as P
@@ -63,8 +64,8 @@ import Distribution.Simple.Utils
   ( dropWhileEndLE )
 import Distribution.Pretty
   ( prettyShow )
-import Distribution.Version
-  ( mkVersion, orLaterVersion )
+
+import qualified Distribution.SPDX as SPDX
 
 
 ---------------------------------------------------------------------------
@@ -84,40 +85,31 @@ writeLicense flags = do
   message flags "\nGenerating LICENSE..."
   year <- show <$> getCurrentYear
   let authors = fromMaybe "???" . flagToMaybe . author $ flags
+  let isSimpleLicense :: SPDX.License -> Maybe SPDX.LicenseId
+      isSimpleLicense (SPDX.License (SPDX.ELicense (SPDX.ELicenseId lid) Nothing)) = Just lid
+      isSimpleLicense _                                                            = Nothing
   let licenseFile =
-        case license flags of
-          Flag BSD2
-            -> Just $ bsd2 authors year
-
-          Flag BSD3
-            -> Just $ bsd3 authors year
-
-          Flag (GPL (Just v)) | v == mkVersion [2]
-            -> Just gplv2
-
-          Flag (GPL (Just v)) | v == mkVersion [3]
-            -> Just gplv3
-
-          Flag (LGPL (Just v)) | v == mkVersion [2,1]
-            -> Just lgpl21
-
-          Flag (LGPL (Just v)) | v == mkVersion [3]
-            -> Just lgpl3
-
-          Flag (AGPL (Just v)) | v == mkVersion [3]
-            -> Just agplv3
-
-          Flag (Apache (Just v)) | v == mkVersion [2,0]
-            -> Just apache20
-
-          Flag MIT
-            -> Just $ mit authors year
-
-          Flag (MPL v) | v == mkVersion [2,0]
-            -> Just mpl20
-
-          Flag ISC
-            -> Just $ isc authors year
+        case flagToMaybe (license flags) >>= isSimpleLicense of
+          Just SPDX.BSD_2_Clause  -> Just $ bsd2 authors year
+          Just SPDX.BSD_3_Clause  -> Just $ bsd3 authors year
+          Just SPDX.Apache_2_0    -> Just apache20
+          Just SPDX.MIT           -> Just $ mit authors year
+          Just SPDX.MPL_2_0       -> Just mpl20
+          Just SPDX.ISC           -> Just $ isc authors year
+
+          -- GNU license come in "only" and "or-later" flavours
+          -- license file used are the same.
+          Just SPDX.GPL_2_0_only  -> Just gplv2
+          Just SPDX.GPL_3_0_only  -> Just gplv3
+          Just SPDX.LGPL_2_1_only -> Just lgpl21
+          Just SPDX.LGPL_3_0_only -> Just lgpl3
+          Just SPDX.AGPL_3_0_only -> Just agplv3
+
+          Just SPDX.GPL_2_0_or_later  -> Just gplv2
+          Just SPDX.GPL_3_0_or_later  -> Just gplv3
+          Just SPDX.LGPL_2_1_or_later -> Just lgpl21
+          Just SPDX.LGPL_3_0_or_later -> Just lgpl3
+          Just SPDX.AGPL_3_0_or_later -> Just agplv3
 
           _ -> Nothing
 
@@ -345,11 +337,11 @@ generateCabalFile fileName c = trimTrailingWS $
   (++ "\n") .
   renderStyle style { lineLength = 79, ribbonsPerLine = 1.1 } $
   -- Starting with 2.2 the `cabal-version` field needs to be the first line of the PD
-  (if specVer < mkVersion [1,12]
-   then field "cabal-version" (Flag $ orLaterVersion specVer) -- legacy
-   else field "cabal-version" (Flag $ specVer))
-              Nothing -- NB: the first line must be the 'cabal-version' declaration
-              False
+  (if specVer < CabalSpecV1_12
+   then fieldS "cabal-version" (Flag $ ">=" ++ showCabalSpecVersion specVer)
+   else fieldS "cabal-version" (Flag $ showCabalSpecVersion specVer))
+      Nothing
+      False
   $$
   (if minimal c /= Flag True
     then showComment (Just $ "Initial package description '" ++ fileName ++ "' generated "
@@ -389,8 +381,9 @@ generateCabalFile fileName c = trimTrailingWS $
                 (Just "The license under which the package is released.")
                 True
 
-       , case (license c) of
-           Flag PublicDomain -> empty
+       , case license c of
+           NoFlag         -> empty
+           Flag SPDX.NONE -> empty
            _ -> fieldS "license-file" (Flag "LICENSE")
                        (Just "The file containing the license text.")
                        True
@@ -403,17 +396,15 @@ generateCabalFile fileName c = trimTrailingWS $
                 (Just "An email address to which users can send suggestions, bug reports, and patches.")
                 True
 
-       , case (license c) of
-           Flag PublicDomain -> empty
-           _ -> fieldS "copyright"     NoFlag
-                       (Just "A copyright notice.")
-                       True
+       , fieldS "copyright"     NoFlag
+                (Just "A copyright notice.")
+                True
 
        , fieldS "category"      (either id display `fmap` category c)
                 Nothing
                 True
 
-       , fieldS "build-type"    (if specVer >= mkVersion [2,2] then NoFlag else Flag "Simple")
+       , fieldS "build-type"    (if specVer >= CabalSpecV2_2 then NoFlag else Flag "Simple")
                 Nothing
                 False
 
@@ -432,11 +423,8 @@ generateCabalFile fileName c = trimTrailingWS $
  where
    specVer = fromMaybe defaultCabalVersion $ flagToMaybe (cabalVersion c)
 
-   licenseStr | specVer < mkVersion [2,2] = prettyShow `fmap` license c
-              | otherwise                 = go `fmap` license c
-     where
-       go (UnknownLicense s) = s
-       go l                  = prettyShow (licenseToSPDX l)
+   licenseStr | specVer < CabalSpecV2_2 = prettyShow . licenseFromSPDX <$> license c
+              | otherwise               = prettyShow                   <$> license c
 
    generateBuildInfo :: BuildType -> InitFlags -> Doc
    generateBuildInfo buildType c' = vcat