Skip to content

Commit

Permalink
Catch exception if git is not installed (#10486)
Browse files Browse the repository at this point in the history
* Catch exception if git is not installed

* fix formatting

* change type from IO to m

* add maybeReadProcessWithExitCode

* use maybeReadProcessWithExitCode

* disambiguate P.catch

* add TypeApplications pragma

* add missing arguments

* Add changelog entry

* Add test for `cabal init` when `git` is not installed

* Remove withSourceCopyDir from test

* Remove withSourceCopyDir from test

* Remove configure and build from test

* Remove assert

* Skip test on windows

---------

Co-authored-by: noiioiu <[email protected]>
  • Loading branch information
noiioiu and noiioiu authored Nov 6, 2024
1 parent 9f62de9 commit e7bc62b
Show file tree
Hide file tree
Showing 5 changed files with 50 additions and 11 deletions.
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
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.

}

0 comments on commit e7bc62b

Please sign in to comment.