Merge pull request #8274 from haskell/mergify/bp/3.8/pr-8267

cabal init -i should autodetect author name and maintainer email (backport #8267)

Author: mergify[bot]

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

@@ -53,6 +53,7 @@ import Distribution.Client.Init.FlagExtractors
 import Distribution.Client.Init.Prompt
 import Distribution.Client.Init.Types
 import Distribution.Client.Init.Utils
+import Distribution.Client.Init.NonInteractive.Heuristics (guessAuthorName, guessAuthorEmail)
 import Distribution.FieldGrammar.Newtypes (SpecLicense(..))
 import Distribution.Simple.Setup (Flag(..), fromFlagOrDefault)
 import Distribution.Simple.PackageIndex (InstalledPackageIndex)
@@ -355,12 +356,14 @@ licensePrompt flags = getLicense flags $ do
       else fmap prettyShow knownLicenses
 
 authorPrompt :: Interactive m => InitFlags -> m String
-authorPrompt flags = getAuthor flags $
-    promptStr "Author name" OptionalPrompt
+authorPrompt flags = getAuthor flags $ do
+    name <- guessAuthorName
+    promptStr "Author name" (DefaultPrompt name)
 
 emailPrompt :: Interactive m => InitFlags -> m String
-emailPrompt flags = getEmail flags $
-    promptStr "Maintainer email" OptionalPrompt
+emailPrompt flags = getEmail flags $ do
+    email' <- guessAuthorEmail
+    promptStr "Maintainer email" (DefaultPrompt email')
 
 homepagePrompt :: Interactive m => InitFlags -> m String
 homepagePrompt flags = getHomepage flags $

cabal-install/tests/UnitTests/Distribution/Client/Init/Golden.hs

@@ -340,7 +340,9 @@ pkgArgs = fromList
     , "y"
     , "0.1.0.0"
     , "2"
+    , "git username"
     , "foo-kmett"
+    , "git email"
     , "[email protected]"
     , "home"
     , "synopsis"

cabal-install/tests/UnitTests/Distribution/Client/Init/Interactive.hs

@@ -145,8 +145,10 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               -- license
               , "3"
               -- author
+              , "git username"
               , "Foobar"
               -- email
+              , "git email"
               , "[email protected]"
               -- homepage
               , "qux.com"
@@ -249,8 +251,10 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               -- license
               , "3"
               -- author
+              , "git username"
               , "Foobar"
               -- email
+              , "git email"
               , "[email protected]"
               -- homepage
               , "qux.com"
@@ -338,8 +342,10 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               -- license
               , "3"
               -- author
+              , "git username"
               , "Foobar"
               -- email
+              , "git email"
               , "[email protected]"
               -- homepage
               , "qux.com"
@@ -414,8 +420,10 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               -- license
               , "3"
               -- author
+              , "git username"
               , "Foobar"
               -- email
+              , "git email"
               , "[email protected]"
               -- homepage
               , "qux.com"
@@ -504,8 +512,10 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               -- license
               , "3"
               -- author
+              , "git username"
               , "Foobar"
               -- email
+              , "git email"
               , "[email protected]"
               -- homepage
               , "qux.com"
@@ -579,8 +589,10 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               -- license
               , "3"
               -- author
+              , "git username"
               , "Foobar"
               -- email
+              , "git email"
               , "[email protected]"
               -- homepage
               , "qux.com"
@@ -660,8 +672,10 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               -- license
               , "3"
               -- author
+              , "git username"
               , "Foobar"
               -- email
+              , "git email"
               , "[email protected]"
               -- homepage
               , "qux.com"
@@ -728,7 +742,9 @@ fileCreatorTests pkgIx srcDb _pkgName = testGroup "generators"
               , "y"               -- "yes to prompt internal to package name"
               , "0.2.0.1"         -- package version
               , "2"               -- pick the second license in the list
+              , "git username"    -- name guessed by calling "git config user.name"
               , "Foobar"          -- author name
+              , "git email"       -- email guessed by calling "git config user.email"
               , "[email protected]"  -- maintainer email
               , "qux.com"         -- package homepage
               , "Qux's package"   -- package synopsis
@@ -834,10 +850,14 @@ interactiveTests srcDb = testGroup "Check top level getter functions"
         , testSimplePrompt "2" synopsisPrompt
             "Resistance is futile, you will be assimilated" ["Resistance is futile, you will be assimilated"]
         ]
-    , testSimplePrompt "Check authorPrompt output" authorPrompt
-        "Foobar" ["Foobar"]
-    , testSimplePrompt "Check emailPrompt output" emailPrompt
-        "[email protected]" ["[email protected]"]
+    , testSimplePrompt "Check authorPrompt output (name supplied by the user)" authorPrompt
+        "Foobar" ["git username", "Foobar"]
+    , testSimplePrompt "Check authorPrompt output (name guessed from git config)" authorPrompt
+        "git username" ["git username", ""]
+    , testSimplePrompt "Check emailPrompt output (email supplied by the user)" emailPrompt
+        "[email protected]" ["git email", "[email protected]"]
+    , testSimplePrompt "Check emailPrompt output (email guessed from git config)" emailPrompt
+        "git@email" ["git@email", ""]
     , testSimplePrompt "Check homepagePrompt output" homepagePrompt
         "qux.com" ["qux.com"]
     , testSimplePrompt "Check testDirsPrompt output" testDirsPrompt

changelog.d/issue-8255

@@ -0,0 +1,4 @@
+synopsis: cabal init -i should autodetect author name and maintainer email (fix #8255)
+packages: cabal-install
+issues: #8255
+prs: #8267