diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index b217012bec..b3a1fc495f 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -89,6 +89,7 @@ library , optparse-applicative , os-string , parallel + , process , prettyprinter >=1.7 , prettyprinter-ansi-terminal , random diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index ad4a36327a..3e4f79131b 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -15,6 +15,7 @@ import Control.Concurrent.Extra (withNumCapabilities) import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, tryReadMVar) import Control.Concurrent.STM.Stats (dumpSTMStats) +import Control.Exception.Safe as Safe import Control.Monad.Extra (concatMapM, unless, when) import Control.Monad.IO.Class (liftIO) @@ -114,16 +115,17 @@ import qualified Language.LSP.Server as LSP import Numeric.Natural (Natural) import Options.Applicative hiding (action) import qualified System.Directory.Extra as IO -import System.Exit (ExitCode (ExitFailure), +import System.Exit (ExitCode (ExitFailure, ExitSuccess), exitWith) import System.FilePath (takeExtension, - takeFileName) + takeFileName, ()) import System.IO (BufferMode (LineBuffering, NoBuffering), Handle, hFlush, hPutStrLn, hSetBuffering, hSetEncoding, stderr, stdin, stdout, utf8) +import System.Process (readProcessWithExitCode) import System.Random (newStdGen) import System.Time.Extra (Seconds, offsetTime, showDuration) @@ -445,16 +447,43 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing) c ide +-- | List the haskell files given some paths +-- +-- It will rely on git if possible to filter-out ignored files. expandFiles :: [FilePath] -> IO [FilePath] -expandFiles = concatMapM $ \x -> do +expandFiles paths = do + let haskellFind x = + let recurse "." = True + recurse y | "." `isPrefixOf` takeFileName y = False -- skip .git etc + recurse y = takeFileName y `notElem` ["dist", "dist-newstyle"] -- cabal directories + in filter (\y -> takeExtension y `elem` [".hs", ".lhs"]) <$> IO.listFilesInside (return . recurse) x + git args = do + mResult <- (Just <$> readProcessWithExitCode "git" args "") `Safe.catchAny`const (pure Nothing) + pure $ + case mResult of + Just (ExitSuccess, gitStdout, _) -> Just gitStdout + _ -> Nothing + mHasGit <- git ["status"] + let findFiles = + case mHasGit of + Just _ -> \path -> do + let lookups = + if takeExtension path `elem` [".hs", ".lhs"] + then [path] + else [path "*.hs", path "*.lhs"] + gitLines args = fmap lines <$> git args + mTracked <- gitLines ("ls-files":lookups) + mUntracked <- gitLines ("ls-files":"-o":lookups) + case mTracked <> mUntracked of + Nothing -> haskellFind path + Just files -> pure files + _ -> haskellFind + flip concatMapM paths $ \x -> do b <- IO.doesFileExist x if b then return [x] else do - let recurse "." = True - recurse y | "." `isPrefixOf` takeFileName y = False -- skip .git etc - recurse y = takeFileName y `notElem` ["dist", "dist-newstyle"] -- cabal directories - files <- filter (\y -> takeExtension y `elem` [".hs", ".lhs"]) <$> IO.listFilesInside (return . recurse) x + files <- findFiles x when (null files) $ fail $ "Couldn't find any .hs/.lhs files inside directory: " ++ x return files