Skip to content

Return empty default when git fails #8755

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.

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
Mar 5, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
Original file line number Diff line number Diff line change
Expand Up @@ -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 $
Expand Down Expand Up @@ -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)
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,9 @@ tests _v _initFlags comp pkgIx srcDb =
}
inputs =
-- createProject stuff
[ "True"
[ "Foobar"
, "foobar@qux.com"
, "True"
, "[\"quxTest/Main.hs\"]"
-- writeProject stuff
-- writeLicense
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -73,7 +73,9 @@ driverFunctionTest pkgIx srcDb comp = testGroup "createProject"
, dependencies = Flag []
}
inputs = NEL.fromList
[ "True"
["Foobar"
, "foobar@qux.com"
, "True"
, "[\"quxTest/Main.hs\"]"
]

Expand Down Expand Up @@ -149,8 +151,11 @@ driverFunctionTest pkgIx srcDb comp = testGroup "createProject"
, dependencies = Flag []
}
inputs = NEL.fromList

[ "Foobar"
, "foobar@qux.com"
-- extra sources
[ "[\"CHANGELOG.md\"]"
, "[\"CHANGELOG.md\"]"
-- lib other modules
, "False"
-- exe other modules
Expand Down