Merge pull request #8755 from BasLaa/no-git-default

Return empty default when git fails

Author: mergify[bot]

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

@@ -355,14 +355,10 @@ licensePrompt flags = getLicense flags $ do
       else fmap prettyShow knownLicenses
 
 authorPrompt :: Interactive m => InitFlags -> m String
-authorPrompt flags = getAuthor flags $ do
-    name <- guessAuthorName
-    promptStr "Author name" (DefaultPrompt name)
+authorPrompt flags = getAuthor flags $ guessAuthorName >>= promptOrDefault "Author name"
 
 emailPrompt :: Interactive m => InitFlags -> m String
-emailPrompt flags = getEmail flags $ do
-    email' <- guessAuthorEmail
-    promptStr "Maintainer email" (DefaultPrompt email')
+emailPrompt flags = getEmail flags $ guessAuthorEmail >>= promptOrDefault "Maintainer email"
 
 homepagePrompt :: Interactive m => InitFlags -> m String
 homepagePrompt flags = getHomepage flags $
@@ -467,3 +463,6 @@ srcDirsPrompt flags = getSrcDirs flags $ do
       True
 
     return [dir]
+
+promptOrDefault :: Interactive m => String -> Maybe String -> m String
+promptOrDefault s = maybe (promptStr s MandatoryPrompt)  (promptStr s . DefaultPrompt)

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

@@ -274,14 +274,16 @@ licenseHeuristics :: Interactive m => InitFlags -> m SpecLicense
 licenseHeuristics flags = getLicense flags $ guessLicense flags
 
 -- | The author's name. Prompt, or try to guess from an existing
---   darcs repo.
+--   git repo.
 authorHeuristics :: Interactive m => InitFlags -> m String
-authorHeuristics flags = getAuthor flags guessAuthorEmail
+authorHeuristics flags = guessAuthorName >>=
+  maybe (getAuthor flags $ return "Unknown") (getAuthor flags . return)
 
 -- | The author's email. Prompt, or try to guess from an existing
---   darcs repo.
+--   git repo.
 emailHeuristics :: Interactive m => InitFlags -> m String
-emailHeuristics flags = getEmail flags guessAuthorName
+emailHeuristics flags = guessAuthorEmail >>=
+  maybe (getEmail flags $ return "Unknown") (getEmail flags . return)
 
 -- | Prompt for a homepage URL for the package.
 homepageHeuristics :: Interactive m => InitFlags -> m String

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

@@ -151,18 +151,23 @@ guessSourceDirectories flags = do
     True  -> ["src"]
 
 -- | Guess author and email using git configuration options.
-guessAuthorName :: Interactive m => m String
+guessAuthorName :: Interactive m => m (Maybe String)
 guessAuthorName = guessGitInfo "user.name"
 
-guessAuthorEmail :: Interactive m => m String
+guessAuthorEmail :: Interactive m => m (Maybe String)
 guessAuthorEmail = guessGitInfo "user.email"
 
-guessGitInfo :: Interactive m => String -> m String
+guessGitInfo :: Interactive m => String -> m (Maybe String)
 guessGitInfo target = do
-  info <- readProcessWithExitCode "git" ["config", "--local", target] ""
-  if null $ snd' info
-    then trim . snd' <$> readProcessWithExitCode "git" ["config", "--global", target] ""
-    else return . trim $ snd' info
+  localInfo <- readProcessWithExitCode "git" ["config", "--local", target] ""
+  if null $ snd' localInfo
+    then do
+      globalInfo <- readProcessWithExitCode "git" ["config", "--global", target] ""
+      case fst' globalInfo of
+        ExitSuccess -> return $  Just (trim $ snd' globalInfo)
+        _           -> return Nothing
+    else return $  Just (trim $ snd' localInfo)
 
   where
+    fst' (x, _, _) = x
     snd' (_, x, _) = x

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

@@ -44,7 +44,9 @@ tests _v _initFlags comp pkgIx srcDb =
               }
             inputs =
               -- createProject stuff
-              [ "True"
+              [ "Foobar"
+              , "[email protected]"
+              , "True"
               , "[\"quxTest/Main.hs\"]"
               -- writeProject stuff
               -- writeLicense

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

@@ -73,7 +73,9 @@ driverFunctionTest pkgIx srcDb comp = testGroup "createProject"
               , dependencies = Flag []
               }
             inputs = NEL.fromList
-              [ "True"
+              ["Foobar"
+              , "[email protected]"
+              , "True"
               , "[\"quxTest/Main.hs\"]"
               ]
 
@@ -149,8 +151,11 @@ driverFunctionTest pkgIx srcDb comp = testGroup "createProject"
               , dependencies = Flag []
               }
             inputs = NEL.fromList
+
+              [ "Foobar"
+              , "[email protected]"
               -- extra sources
-              [ "[\"CHANGELOG.md\"]"
+              , "[\"CHANGELOG.md\"]"
               -- lib other modules
               , "False"
               -- exe other modules