Skip to content

Improve cabal init code a bit #6661

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Apr 6, 2020
Merged

Improve cabal init code a bit #6661

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
2fa8302
Improve `cabal init` code a bit
phadej Apr 4, 2020
738a333
Add changelog for cabal-init changes so far
phadej Apr 6, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
9 changes: 3 additions & 6 deletions cabal-install/Distribution/Client/Config.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
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 IT.defaultCabalVersion,
IT.language = toFlag Haskell2010,
IT.license = toFlag BSD3,
IT.license = NoFlag,
IT.sourceDirs = Nothing,
IT.applicationDirs = Nothing
},
Expand Down
103 changes: 53 additions & 50 deletions cabal-install/Distribution/Client/Init/Command.hs
View file
Open in desktop
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 defaultCabalVersion
}
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,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.
Expand Down Expand Up @@ -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
Expand Down
8 changes: 4 additions & 4 deletions cabal-install/Distribution/Client/Init/Defaults.hs
View file
Open in desktop
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 = CabalSpecV2_4

myLibModule :: ModuleName
myLibModule = ModuleName.fromString "MyLib"
96 changes: 42 additions & 54 deletions cabal-install/Distribution/Client/Init/FileCreators.hs
View file
Open in desktop
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