Skip to content
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

Catch exception if git is not installed #10486

Merged
merged 17 commits into from
Nov 6, 2024
Original file line number Diff line number Diff line change
Expand Up @@ -165,14 +165,14 @@ guessAuthorEmail = guessGitInfo "user.email"

guessGitInfo :: Interactive m => String -> m (Maybe String)
guessGitInfo target = do
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
localInfo <- maybeReadProcessWithExitCode "git" ["config", "--local", target] ""
case localInfo of
Nothing -> return Nothing
Just (_, localStdout, _) ->
if null localStdout
then do
globalInfo <- maybeReadProcessWithExitCode "git" ["config", "--global", target] ""
case globalInfo of
Just (ExitSuccess, globalStdout, _) -> return $ Just (trim globalStdout)
_ -> return Nothing
else return $ Just (trim localStdout)
4 changes: 4 additions & 0 deletions cabal-install/src/Distribution/Client/Init/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module : Distribution.Client.Init.Types
Expand Down Expand Up @@ -346,6 +347,7 @@ class Monad m => Interactive m where
doesFileExist :: FilePath -> m Bool
canonicalizePathNoThrow :: FilePath -> m FilePath
readProcessWithExitCode :: FilePath -> [String] -> String -> m (ExitCode, String, String)
maybeReadProcessWithExitCode :: FilePath -> [String] -> String -> m (Maybe (ExitCode, String, String))
getEnvironment :: m [(String, String)]
getCurrentYear :: m Integer
listFilesInside :: (FilePath -> m Bool) -> FilePath -> m [FilePath]
Expand Down Expand Up @@ -389,6 +391,7 @@ instance Interactive PromptIO where
doesFileExist = liftIO <$> P.doesFileExist
canonicalizePathNoThrow = liftIO <$> P.canonicalizePathNoThrow
readProcessWithExitCode a b c = liftIO $ Process.readProcessWithExitCode a b c
maybeReadProcessWithExitCode a b c = liftIO $ (Just <$> Process.readProcessWithExitCode a b c) `P.catch` const @_ @IOError (pure Nothing)
getEnvironment = liftIO P.getEnvironment
getCurrentYear = liftIO P.getCurrentYear
listFilesInside test dir = do
Expand Down Expand Up @@ -438,6 +441,7 @@ instance Interactive PurePrompt where
readProcessWithExitCode !_ !_ !_ = do
input <- pop
return (ExitSuccess, input, "")
maybeReadProcessWithExitCode a b c = Just <$> readProcessWithExitCode a b c
ulysses4ever marked this conversation as resolved.
Show resolved Hide resolved
getEnvironment = fmap (map read) popList
getCurrentYear = fmap read pop
listFilesInside pred' !_ = do
Expand Down
1 change: 1 addition & 0 deletions cabal-testsuite/PackageTests/Init/init-without-git.out
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
# cabal init
22 changes: 22 additions & 0 deletions cabal-testsuite/PackageTests/Init/init-without-git.test.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,22 @@
import Test.Cabal.Prelude
import System.Directory
import System.FilePath
import Distribution.Simple.Utils
import Distribution.Verbosity

-- Test cabal init when git is not installed
main = do
skipIfWindows "Might fail on windows."
tmp <- getTemporaryDirectory
withTempDirectory normal tmp "bin" $
\bin -> cabalTest $
do
ghc_path <- programPathM ghcProgram
cabal_path <- programPathM cabalProgram
withSymlink ghc_path (bin </> "ghc") . withSymlink cabal_path (bin </> "cabal") .
withEnv [("PATH", Just bin)] $ do
cwd <- fmap testSourceCopyDir getTestEnv

void . withDirectory cwd $ do
cabalWithStdin "init" ["-i"]
"2\n\n5\n\n\n2\n\n\n\n\n\n\n\n\n\n"
12 changes: 12 additions & 0 deletions changelog.d/pr-10486
Original file line number Diff line number Diff line change
@@ -0,0 +1,12 @@
synopsis: Fix a bug that causes `cabal init` to crash if `git` is not installed
packages: cabal-install
prs: #10486
issues: #10484 #8478
significance:

description: {

- `cabal init` tries to use `git config` to guess the user's name and email.
It no longer crashes if there is no executable named `git` on $PATH.

}
Loading