Skip to content

Commit

Permalink
Improve cabal init code a bit
Browse files Browse the repository at this point in the history 
- Always ask for SPDX expression, we can "convert" them to old format
- No default license
- cabal-version is asked using CabalSpecVersion type
- seems to fix what haskell#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.
  • Loading branch information
@phadej
phadej committed Apr 6, 2020
1 parent 613a2a2 commit 90d3a5e
Show file tree
Hide file tree
Showing 6 changed files with 127 additions and 138 deletions.
9 changes: 3 additions & 6 deletions cabal-install/Distribution/Client/Config.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -51,6 +51,7 @@ import Language.Haskell.Extension ( Language(Haskell2010) )
import Distribution.Deprecated.ViewAsFieldDescr
( viewAsFieldDescr )

import Distribution.CabalSpecVersion
import Distribution.Client.Types
( RemoteRepo(..), LocalRepo (..), emptyRemoteRepo
, AllowOlder(..), AllowNewer(..), RelaxDeps(..), isRelaxDeps
Expand All @@ -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
Expand Down Expand Up @@ -114,8 +113,6 @@ import Distribution.Compiler
( CompilerFlavor(..), defaultCompilerFlavor )
import Distribution.Verbosity
( Verbosity, normal )
import Distribution.Version
( mkVersion )

import Distribution.Solver.Types.ConstraintSource

Expand Down Expand Up @@ -851,9 +848,9 @@ commentSavedConfig = do
},
savedInitFlags = mempty {
IT.interactive = toFlag False,
IT.cabalVersion = toFlag (mkVersion [2,4]),
IT.cabalVersion = toFlag CabalSpecV2_4,
IT.language = toFlag Haskell2010,
IT.license = toFlag BSD3,
IT.license = NoFlag,
IT.sourceDirs = Nothing,
IT.applicationDirs = Nothing
},
Expand Down
104 changes: 54 additions & 50 deletions cabal-install/Distribution/Client/Init/Command.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 )
Expand All @@ -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 )
Expand All @@ -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(..) )
Expand All @@ -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
Expand Down Expand Up @@ -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'
Expand Down Expand Up @@ -189,7 +186,7 @@ getSimpleProject flags = do
flags { interactive = Flag False
, simpleProject = Flag True
, packageType = Flag LibraryAndExecutable
, cabalVersion = Flag (mkVersion [2,4])
, cabalVersion = Flag CabalSpecV2_4
}
simpleProjFlag@_ ->
flags { simpleProject = simpleProjFlag }
Expand All @@ -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



Expand Down Expand Up @@ -269,39 +267,45 @@ 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.
Expand Down Expand Up @@ -641,7 +645,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
Expand Down
8 changes: 4 additions & 4 deletions cabal-install/Distribution/Client/Init/Defaults.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 = CabalSpecV1_10

myLibModule :: ModuleName
myLibModule = ModuleName.fromString "MyLib"
96 changes: 42 additions & 54 deletions cabal-install/Distribution/Client/Init/FileCreators.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -63,8 +64,8 @@ import Distribution.Simple.Utils
( dropWhileEndLE )
import Distribution.Pretty
( prettyShow )
import Distribution.Version
( mkVersion, orLaterVersion )

import qualified Distribution.SPDX as SPDX


---------------------------------------------------------------------------
Expand All @@ -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

Expand Down Expand Up @@ -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 "
Expand Down Expand Up @@ -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
Expand All @@ -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

Expand All @@ -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
Expand Down
Loading

0 comments on commit 90d3a5e

Please sign in to comment.