Merge pull request #7951 from ptkato/cabal-init-license-version

Fixing `cabal init` file output for `cabal-version < 2.2`

Cabal-syntax/src/Distribution/FieldGrammar/Newtypes.hs

@@ -356,6 +356,7 @@ instance Pretty SpecVersion where
 
 -- | SPDX License expression or legacy license
 newtype SpecLicense = SpecLicense { getSpecLicense :: Either SPDX.License License }
+    deriving (Show, Eq)
 
 instance Newtype (Either SPDX.License License) SpecLicense
 

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

@@ -48,7 +48,8 @@ import qualified Distribution.SPDX.LicenseId as SPDX
 import Distribution.Simple.Flag (toFlag)
 import Distribution.Verbosity (normal)
 import Distribution.Types.Version
-import Distribution.Simple
+import Distribution.FieldGrammar.Newtypes
+import Distribution.Simple (Language(..), License(..))
 
 
 -- -------------------------------------------------------------------- --
@@ -75,8 +76,10 @@ defaultPackageType = Executable
 defaultChangelog :: FilePath
 defaultChangelog = "CHANGELOG.md"
 
-defaultLicense :: SPDX.License
-defaultLicense = SPDX.NONE
+defaultLicense :: CabalSpecVersion -> SpecLicense
+defaultLicense csv
+  | csv < CabalSpecV2_2 = SpecLicense $ Right AllRightsReserved
+  | otherwise           = SpecLicense $ Left  SPDX.NONE
 
 defaultMainIs :: HsFilePath
 defaultMainIs = toHsFilePath "Main.hs"

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

@@ -40,6 +40,8 @@ import Distribution.Client.Init.Format
 import Distribution.CabalSpecVersion (showCabalSpecVersion)
 
 import System.FilePath ((</>), (<.>))
+import Distribution.FieldGrammar.Newtypes
+import Distribution.License (licenseToSPDX)
 
 -- -------------------------------------------------------------------- --
 --  File generation
@@ -172,11 +174,11 @@ writeLicense writeOpts pkgDesc = do
       writeFileSafe writeOpts "LICENSE" licenseText
     Nothing -> message writeOpts T.Warning "unknown license type, you must put a copy in LICENSE yourself."
   where
-    getLid (SPDX.License (SPDX.ELicense (SPDX.ELicenseId lid) Nothing)) =
-      Just lid
+    getLid (Left (SPDX.License (SPDX.ELicense (SPDX.ELicenseId lid) Nothing))) = Just lid
+    getLid (Right l) = getLid . Left $ licenseToSPDX l
     getLid _ = Nothing
 
-    licenseFile year auth = case getLid $ _pkgLicense pkgDesc of
+    licenseFile year auth = case getLid . getSpecLicense $ _pkgLicense pkgDesc of
       Just SPDX.BSD_2_Clause -> Just $ bsd2 auth year
       Just SPDX.BSD_3_Clause -> Just $ bsd3 auth year
       Just SPDX.Apache_2_0 -> Just apache20

cabal-install/src/Distribution/Client/Init/FlagExtractors.hs

@@ -5,6 +5,7 @@ module Distribution.Client.Init.FlagExtractors
 , getSimpleProject
 , getMinimal
 , getCabalVersion
+, getCabalVersionNoPrompt
 , getPackageName
 , getVersion
 , getLicense
@@ -48,8 +49,8 @@ import Distribution.Version (Version)
 import Distribution.ModuleName (ModuleName)
 import Distribution.Types.Dependency (Dependency(..))
 import Distribution.Types.PackageName (PackageName)
-import qualified Distribution.SPDX as SPDX
 import Distribution.Client.Init.Defaults
+import Distribution.FieldGrammar.Newtypes (SpecLicense)
 import Distribution.Client.Init.Types
 import Distribution.Simple.Setup (Flag(..), fromFlagOrDefault, flagToMaybe)
 import Distribution.Simple.Flag (flagElim)
@@ -84,6 +85,9 @@ getMinimal = return . fromFlagOrDefault False . minimal
 getCabalVersion :: Interactive m => InitFlags -> m CabalSpecVersion -> m CabalSpecVersion
 getCabalVersion flags = fromFlagOrPrompt (cabalVersion flags)
 
+getCabalVersionNoPrompt :: InitFlags -> CabalSpecVersion
+getCabalVersionNoPrompt = fromFlagOrDefault defaultCabalVersion . cabalVersion
+
 -- | Get the package name: use the package directory (supplied, or the current
 --   directory by default) as a guess. It looks at the SourcePackageDb to avoid
 --   using an existing package name.
@@ -98,7 +102,7 @@ getVersion flags = fromFlagOrPrompt (version flags)
 -- | Choose a license for the package.
 -- The license can come from Initflags (license field), if it is not present
 -- then prompt the user from a predefined list of licenses.
-getLicense :: Interactive m => InitFlags -> m SPDX.License -> m SPDX.License
+getLicense :: Interactive m => InitFlags -> m SpecLicense -> m SpecLicense
 getLicense flags = fromFlagOrPrompt (license flags)
 
 -- | The author's name. Prompt, or try to guess from an existing

cabal-install/src/Distribution/Client/Init/Format.hs

@@ -31,14 +31,16 @@ module Distribution.Client.Init.Format
 import Distribution.Pretty
 import Distribution.Fields
 import Distribution.Client.Init.Types
+import Distribution.License
 import Text.PrettyPrint
 import Distribution.Solver.Compat.Prelude hiding (empty)
 import Distribution.PackageDescription.FieldGrammar
-import Distribution.Simple.Utils
+import Distribution.Simple.Utils hiding (cabalVersion)
 import Distribution.Utils.Path
 import Distribution.Package (unPackageName)
 import qualified Distribution.SPDX.License as SPDX
 import Distribution.CabalSpecVersion
+import Distribution.FieldGrammar.Newtypes (SpecLicense(SpecLicense))
 
 
 -- | Construct a 'PrettyField' from a field that can be automatically
@@ -328,13 +330,15 @@ mkPkgDescription opts pkgDesc =
       False
       opts
 
-    , field  "license" pretty (_pkgLicense pkgDesc)
+    , field "license" pretty (_pkgLicense pkgDesc)
       ["The license under which the package is released."]
       True
       opts
 
     , case _pkgLicense pkgDesc of
-        SPDX.NONE -> PrettyEmpty
+        SpecLicense (Left  SPDX.NONE)          -> PrettyEmpty
+        SpecLicense (Right AllRightsReserved)  -> PrettyEmpty
+        SpecLicense (Right UnspecifiedLicense) -> PrettyEmpty
         _ -> field "license-file" text "LICENSE"
              ["The file containing the license text."]
              False
@@ -359,12 +363,10 @@ mkPkgDescription opts pkgDesc =
       []
       False
       opts
-    , if cabalSpec < CabalSpecV2_2
-      then PrettyEmpty
-      else field "build-type" text "Simple"
-           []
-           False
-           opts
+    , field "build-type" text "Simple"
+      []
+      False
+      opts
     , case _pkgExtraDocFiles pkgDesc of
         Nothing -> PrettyEmpty
         Just fs ->

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

@@ -53,12 +53,15 @@ import Distribution.Client.Init.FlagExtractors
 import Distribution.Client.Init.Prompt
 import Distribution.Client.Init.Types
 import Distribution.Client.Init.Utils
-import Distribution.Simple.Setup (Flag(..))
+import Distribution.FieldGrammar.Newtypes (SpecLicense(..))
+import Distribution.Simple.Setup (Flag(..), fromFlagOrDefault)
 import Distribution.Simple.PackageIndex (InstalledPackageIndex)
 import Distribution.Client.Types (SourcePackageDb(..))
 import Distribution.Solver.Types.PackageIndex (elemByPackageName)
 
 import Language.Haskell.Extension (Language(..))
+import Distribution.License (knownLicenses)
+import Distribution.Parsec (simpleParsec')
 
 
 -- | Main driver for interactive prompt code.
@@ -100,37 +103,38 @@ createProject v pkgIx srcDb initFlags = do
       mkOpts cs = WriteOpts
         doOverwrite isMinimal cs
         v pkgDir pkgType pkgName
+      initFlags' = initFlags { cabalVersion = Flag cabalSpec }
 
   case pkgType of
     Library -> do
-      libTarget <- genLibTarget initFlags pkgIx
+      libTarget <- genLibTarget initFlags' pkgIx
       testTarget <- addLibDepToTest pkgName <$>
-        genTestTarget initFlags pkgIx
+        genTestTarget initFlags' pkgIx
 
-      comments <- noCommentsPrompt initFlags
+      comments <- noCommentsPrompt initFlags'
 
       return $ ProjectSettings
         (mkOpts comments cabalSpec) pkgDesc
         (Just libTarget) Nothing testTarget
 
     Executable -> do
-      exeTarget <- genExeTarget initFlags pkgIx
-      comments <- noCommentsPrompt initFlags
+      exeTarget <- genExeTarget initFlags' pkgIx
+      comments <- noCommentsPrompt initFlags'
 
       return $ ProjectSettings
         (mkOpts comments cabalSpec) pkgDesc Nothing
         (Just exeTarget) Nothing
 
     LibraryAndExecutable -> do
-      libTarget <- genLibTarget initFlags pkgIx
+      libTarget <- genLibTarget initFlags' pkgIx
 
       exeTarget <- addLibDepToExe pkgName <$>
-        genExeTarget initFlags pkgIx
+        genExeTarget initFlags' pkgIx
 
       testTarget <- addLibDepToTest pkgName <$>
-        genTestTarget initFlags pkgIx
+        genTestTarget initFlags' pkgIx
 
-      comments <- noCommentsPrompt initFlags
+      comments <- noCommentsPrompt initFlags'
 
       return $ ProjectSettings
         (mkOpts comments cabalSpec) pkgDesc (Just libTarget)
@@ -141,10 +145,10 @@ createProject v pkgIx srcDb initFlags = do
       -- are *not* passed, the user will be prompted for a package type (which
       -- includes TestSuite in the list). It prevents that the user end up with a
       -- TestSuite target with initializeTestSuite set to NoFlag, thus avoiding the prompt.
-      let initFlags' = initFlags { initializeTestSuite = Flag True }
-      testTarget <- genTestTarget initFlags' pkgIx
+      let initFlags'' = initFlags' { initializeTestSuite = Flag True }
+      testTarget <- genTestTarget initFlags'' pkgIx
 
-      comments <- noCommentsPrompt initFlags'
+      comments <- noCommentsPrompt initFlags''
 
       return $ ProjectSettings
         (mkOpts comments cabalSpec) pkgDesc
@@ -163,9 +167,11 @@ genPkgDescription
     => InitFlags
     -> SourcePackageDb
     -> m PkgDescription
-genPkgDescription flags srcDb = PkgDescription
-    <$> cabalVersionPrompt flags
-    <*> packageNamePrompt srcDb flags
+genPkgDescription flags' srcDb = do
+  csv <- cabalVersionPrompt flags'
+  let flags = flags' { cabalVersion = Flag csv }
+  PkgDescription csv
+    <$> packageNamePrompt srcDb flags
     <*> versionPrompt flags
     <*> licensePrompt flags
     <*> authorPrompt flags
@@ -318,15 +324,16 @@ versionPrompt flags = getVersion flags go
           go
         Just v -> return v
 
-licensePrompt :: Interactive m => InitFlags -> m SPDX.License
+licensePrompt :: Interactive m => InitFlags -> m SpecLicense
 licensePrompt flags = getLicense flags $ do
+    let csv = fromFlagOrDefault defaultCabalVersion (cabalVersion flags)
     l <- promptList "Please choose a license"
-      licenses
+      (licenses csv)
       MandatoryPrompt
       Nothing
       True
 
-    case simpleParsec l of
+    case simpleParsec' csv l of
       Nothing -> do
         putStrLn ( "The license must be a valid SPDX expression:"
                 ++ "\n - On the SPDX License List: https://spdx.org/licenses/"
@@ -336,7 +343,9 @@ licensePrompt flags = getLicense flags $ do
         licensePrompt flags
       Just l' -> return l'
   where
-    licenses = SPDX.licenseId <$> defaultLicenseIds
+    licenses csv = if csv >= CabalSpecV2_2
+      then SPDX.licenseId <$> defaultLicenseIds
+      else fmap prettyShow knownLicenses
 
 authorPrompt :: Interactive m => InitFlags -> m String
 authorPrompt flags = getAuthor flags $

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

@@ -46,7 +46,6 @@ import Distribution.Version (Version)
 import Distribution.ModuleName (ModuleName, components)
 import Distribution.Types.Dependency (Dependency(..))
 import Distribution.Types.PackageName (PackageName, unPackageName)
-import qualified Distribution.SPDX as SPDX
 import Distribution.Client.Init.Defaults
 import Distribution.Client.Init.NonInteractive.Heuristics
 import Distribution.Client.Init.Utils
@@ -63,6 +62,7 @@ import Language.Haskell.Extension (Language(..), Extension(..))
 import System.FilePath (splitDirectories, (</>))
 import Distribution.Simple.Compiler
 import qualified Data.Set as Set
+import Distribution.FieldGrammar.Newtypes
 
 
 -- | Main driver for interactive prompt code.
@@ -270,7 +270,7 @@ versionHeuristics flags = getVersion flags $ return defaultVersion
 -- | Choose a license for the package.
 -- The license can come from Initflags (license field), if it is not present
 -- then prompt the user from a predefined list of licenses.
-licenseHeuristics :: Interactive m => InitFlags -> m SPDX.License
+licenseHeuristics :: Interactive m => InitFlags -> m SpecLicense
 licenseHeuristics flags = getLicense flags $ guessLicense flags
 
 -- | The author's name. Prompt, or try to guess from an existing

cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs

@@ -33,16 +33,17 @@ import Distribution.Simple.Setup (fromFlagOrDefault)
 
 import qualified Data.List as L
 import Distribution.Client.Init.Defaults
+import Distribution.Client.Init.FlagExtractors (getCabalVersionNoPrompt)
 import Distribution.Client.Init.Types
 import Distribution.Client.Init.Utils
-import qualified Distribution.SPDX as SPDX
 import System.FilePath
 import Distribution.CabalSpecVersion
 import Language.Haskell.Extension
 import Distribution.Version
 import Distribution.Types.PackageName (PackageName, mkPackageName)
 import Distribution.Simple.Compiler
 import qualified Data.Set as Set
+import Distribution.FieldGrammar.Newtypes
 
 
 
@@ -103,8 +104,8 @@ guessPackageName = fmap (mkPackageName . repair . fromMaybe "" . safeLast . spli
 -- | Try to guess the license from an already existing @LICENSE@ file in
 --   the package directory, comparing the file contents with the ones
 --   listed in @Licenses.hs@, for now it only returns a default value.
-guessLicense :: Interactive m => InitFlags -> m SPDX.License
-guessLicense _ = return SPDX.NONE
+guessLicense :: Interactive m => InitFlags -> m SpecLicense
+guessLicense flags = return . defaultLicense $ getCabalVersionNoPrompt flags
 
 guessExtraDocFiles :: Interactive m => InitFlags -> m (Maybe (Set FilePath))
 guessExtraDocFiles flags = do

cabal-install/src/Distribution/Client/Init/Simple.hs

@@ -98,7 +98,7 @@ genSimplePkgDesc flags = mkPkgDesc <$> currentDirPkgName
       (fromFlagOrDefault defaultCabalVersion (cabalVersion flags))
       pkgName
       (fromFlagOrDefault defaultVersion (version flags))
-      (fromFlagOrDefault defaultLicense (license flags))
+      (fromFlagOrDefault (defaultLicense $ getCabalVersionNoPrompt flags) (license flags))
       (fromFlagOrDefault "" (author flags))
       (fromFlagOrDefault "" (email flags))
       (fromFlagOrDefault "" (homepage flags))

cabal-install/src/Distribution/Client/Init/Types.hs

@@ -64,7 +64,6 @@ import Distribution.Types.Dependency as P
 import Distribution.Verbosity (silent)
 import Distribution.Version
 import qualified Distribution.Package as P
-import Distribution.SPDX.License (License)
 import Distribution.ModuleName
 import Distribution.CabalSpecVersion
 import Distribution.Client.Utils as P
@@ -76,6 +75,7 @@ import qualified System.Directory as P
 import qualified System.Process as Process
 import qualified Distribution.Compat.Environment as P
 import System.FilePath
+import Distribution.FieldGrammar.Newtypes (SpecLicense)
 
 
 -- -------------------------------------------------------------------- --
@@ -96,7 +96,7 @@ data InitFlags =
     , packageName :: Flag P.PackageName
     , version :: Flag Version
     , cabalVersion :: Flag CabalSpecVersion
-    , license :: Flag License
+    , license :: Flag SpecLicense
     , author :: Flag String
     , email :: Flag String
     , homepage :: Flag String
@@ -139,7 +139,7 @@ data PkgDescription = PkgDescription
     { _pkgCabalVersion :: CabalSpecVersion
     , _pkgName :: P.PackageName
     , _pkgVersion :: Version
-    , _pkgLicense :: License
+    , _pkgLicense :: SpecLicense
     , _pkgAuthor :: String
     , _pkgEmail :: String
     , _pkgHomePage :: String