Skip to content

Commit dfa2415

Browse files
committed
fix: check thrown error (not found)
1 parent 7957387 commit dfa2415

File tree

1 file changed

+20
-9
lines changed

1 file changed

+20
-9
lines changed

ghcide/src/Development/IDE/Main.hs

Lines changed: 20 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ import Control.Concurrent.Extra (withNumCapabilities)
1515
import Control.Concurrent.MVar (MVar, newEmptyMVar,
1616
putMVar, tryReadMVar)
1717
import Control.Concurrent.STM.Stats (dumpSTMStats)
18+
import Control.Exception.Safe as Safe
1819
import Control.Monad.Extra (concatMapM, unless,
1920
when)
2021
import Control.Monad.IO.Class (liftIO)
@@ -456,16 +457,26 @@ expandFiles paths = do
456457
recurse y | "." `isPrefixOf` takeFileName y = False -- skip .git etc
457458
recurse y = takeFileName y `notElem` ["dist", "dist-newstyle"] -- cabal directories
458459
in filter (\y -> takeExtension y `elem` [".hs", ".lhs"]) <$> IO.listFilesInside (return . recurse) x
459-
(testGitExitCode, _, _) <- readProcessWithExitCode "git" ["status"] ""
460+
git args = do
461+
mResult <- (Just <$> readProcessWithExitCode "git" args "") `Safe.catchAny`const (pure Nothing)
462+
pure $
463+
case mResult of
464+
Just (ExitSuccess, gitStdout, _) -> Just gitStout
465+
_ -> Nothing
466+
mHasGit <- git ["status"]
460467
let findFiles =
461-
case testGitExitCode of
462-
ExitSuccess -> \path -> do
463-
let lookups = [path, path </> "*.hs", path </> "*.lhs"]
464-
(trackedExitCode, trackedStdout, _) <- readProcessWithExitCode "git" ("ls-files":lookups) ""
465-
(untrackedExitCode, untrackedStdout, _) <- readProcessWithExitCode "git" ("ls-files":"-o":lookups) ""
466-
if trackedExitCode == ExitSuccess && untrackedExitCode == ExitSuccess
467-
then pure $ lines trackedStdout <> lines untrackedStdout
468-
else haskellFind path
468+
case mHasGit of
469+
Just _ -> \path -> do
470+
let lookups =
471+
if takeExtension path `elem` [".hs", ".lhs"]
472+
then [path]
473+
else [path </> "*.hs", path </> "*.lhs"]
474+
gitLines args = fmap lines <$> git args
475+
mTracked <- gitLines ("ls-files":lookups)
476+
mUntracked <- gitLines ("ls-files":"-o":lookups)
477+
case mTracked <> mUntracked of
478+
Nothing -> haskellFind path
479+
Just files -> pure files
469480
_ -> haskellFind
470481
flip concatMapM paths $ \x -> do
471482
b <- IO.doesFileExist x

0 commit comments

Comments
 (0)