diff --git a/cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs b/cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs index 138f9684553..e6838aa2e45 100644 --- a/cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs +++ b/cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs @@ -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) diff --git a/cabal-install/src/Distribution/Client/Init/Types.hs b/cabal-install/src/Distribution/Client/Init/Types.hs index 0887cb54a71..8da7ba2b52b 100644 --- a/cabal-install/src/Distribution/Client/Init/Types.hs +++ b/cabal-install/src/Distribution/Client/Init/Types.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} -- | -- Module : Distribution.Client.Init.Types @@ -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] @@ -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 @@ -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 diff --git a/cabal-testsuite/PackageTests/Init/init-without-git.out b/cabal-testsuite/PackageTests/Init/init-without-git.out new file mode 100644 index 00000000000..9a143a9375c --- /dev/null +++ b/cabal-testsuite/PackageTests/Init/init-without-git.out @@ -0,0 +1 @@ +# cabal init diff --git a/cabal-testsuite/PackageTests/Init/init-without-git.test.hs b/cabal-testsuite/PackageTests/Init/init-without-git.test.hs new file mode 100644 index 00000000000..4c98f751c57 --- /dev/null +++ b/cabal-testsuite/PackageTests/Init/init-without-git.test.hs @@ -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" diff --git a/changelog.d/pr-10486 b/changelog.d/pr-10486 new file mode 100644 index 00000000000..237d2c857b0 --- /dev/null +++ b/changelog.d/pr-10486 @@ -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. + +}