Skip to content

Commit 1078d4b

Browse files
authored
Rely on gitignore to exclude listed files in ghcide (#4665) (#4736)
* Rely on gitignore to exclude listed files in ghcide (#4665) * doc: document expandFiles * fix: check thrown error (not found) * fix: add log when using git
1 parent 39519d6 commit 1078d4b

File tree

2 files changed

+43
-9
lines changed

2 files changed

+43
-9
lines changed

ghcide/ghcide.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -89,6 +89,7 @@ library
8989
, optparse-applicative
9090
, os-string
9191
, parallel
92+
, process
9293
, prettyprinter >=1.7
9394
, prettyprinter-ansi-terminal
9495
, random

ghcide/src/Development/IDE/Main.hs

Lines changed: 42 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)
@@ -114,16 +115,17 @@ import qualified Language.LSP.Server as LSP
114115
import Numeric.Natural (Natural)
115116
import Options.Applicative hiding (action)
116117
import qualified System.Directory.Extra as IO
117-
import System.Exit (ExitCode (ExitFailure),
118+
import System.Exit (ExitCode (ExitFailure, ExitSuccess),
118119
exitWith)
119120
import System.FilePath (takeExtension,
120-
takeFileName)
121+
takeFileName, (</>))
121122
import System.IO (BufferMode (LineBuffering, NoBuffering),
122123
Handle, hFlush,
123124
hPutStrLn,
124125
hSetBuffering,
125126
hSetEncoding, stderr,
126127
stdin, stdout, utf8)
128+
import System.Process (readProcessWithExitCode)
127129
import System.Random (newStdGen)
128130
import System.Time.Extra (Seconds, offsetTime,
129131
showDuration)
@@ -141,6 +143,7 @@ data Log
141143
| LogSession Session.Log
142144
| LogPluginHLS PluginHLS.Log
143145
| LogRules Rules.Log
146+
| LogUsingGit
144147
deriving Show
145148

146149
instance Pretty Log where
@@ -164,6 +167,7 @@ instance Pretty Log where
164167
LogSession msg -> pretty msg
165168
LogPluginHLS msg -> pretty msg
166169
LogRules msg -> pretty msg
170+
LogUsingGit -> "Using git to list file, relying on .gitignore"
167171

168172
data Command
169173
= Check [FilePath] -- ^ Typecheck some paths and print diagnostics. Exit code is the number of failures
@@ -383,7 +387,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
383387
putStrLn "Report bugs at https://github.com/haskell/haskell-language-server/issues"
384388

385389
putStrLn $ "\nStep 1/4: Finding files to test in " ++ dir
386-
files <- expandFiles (argFiles ++ ["." | null argFiles])
390+
files <- expandFiles recorder (argFiles ++ ["." | null argFiles])
387391
-- LSP works with absolute file paths, so try and behave similarly
388392
absoluteFiles <- nubOrd <$> mapM IO.canonicalizePath files
389393
putStrLn $ "Found " ++ show (length absoluteFiles) ++ " files"
@@ -445,16 +449,45 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
445449
registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing)
446450
c ide
447451

448-
expandFiles :: [FilePath] -> IO [FilePath]
449-
expandFiles = concatMapM $ \x -> do
452+
-- | List the haskell files given some paths
453+
--
454+
-- It will rely on git if possible to filter-out ignored files.
455+
expandFiles :: Recorder (WithPriority Log) -> [FilePath] -> IO [FilePath]
456+
expandFiles recorder paths = do
457+
let haskellFind x =
458+
let recurse "." = True
459+
recurse y | "." `isPrefixOf` takeFileName y = False -- skip .git etc
460+
recurse y = takeFileName y `notElem` ["dist", "dist-newstyle"] -- cabal directories
461+
in filter (\y -> takeExtension y `elem` [".hs", ".lhs"]) <$> IO.listFilesInside (return . recurse) x
462+
git args = do
463+
mResult <- (Just <$> readProcessWithExitCode "git" args "") `Safe.catchAny`const (pure Nothing)
464+
pure $
465+
case mResult of
466+
Just (ExitSuccess, gitStdout, _) -> Just gitStdout
467+
_ -> Nothing
468+
mHasGit <- git ["status"]
469+
when (isJust mHasGit) $ logWith recorder Info LogUsingGit
470+
let findFiles =
471+
case mHasGit of
472+
Just _ -> \path -> do
473+
let lookups =
474+
if takeExtension path `elem` [".hs", ".lhs"]
475+
then [path]
476+
else [path </> "*.hs", path </> "*.lhs"]
477+
gitLines args = fmap lines <$> git args
478+
mTracked <- gitLines ("ls-files":lookups)
479+
mUntracked <- gitLines ("ls-files":"-o":lookups)
480+
case mTracked <> mUntracked of
481+
Nothing -> haskellFind path
482+
Just files -> pure files
483+
_ -> haskellFind
484+
485+
flip concatMapM paths $ \x -> do
450486
b <- IO.doesFileExist x
451487
if b
452488
then return [x]
453489
else do
454-
let recurse "." = True
455-
recurse y | "." `isPrefixOf` takeFileName y = False -- skip .git etc
456-
recurse y = takeFileName y `notElem` ["dist", "dist-newstyle"] -- cabal directories
457-
files <- filter (\y -> takeExtension y `elem` [".hs", ".lhs"]) <$> IO.listFilesInside (return . recurse) x
490+
files <- findFiles x
458491
when (null files) $
459492
fail $ "Couldn't find any .hs/.lhs files inside directory: " ++ x
460493
return files

0 commit comments

Comments
 (0)