Skip to content

Commit 9607930

Browse files
SoupstrawSoupstraw
committed
Fixed none cradle files shown as failed
1 parent 8fd2b89 commit 9607930

File tree

2 files changed

+21
-21
lines changed

2 files changed

+21
-21
lines changed

‎ghcide/session-loader/Development/IDE/Session.hs

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ module Development.IDE.Session
1717
,retryOnSqliteBusy
1818
,retryOnException
1919
,Log(..)
20+
,ignoredFilesGlobalVar
2021
) where
2122

2223
-- Unfortunately, we cannot use loadSession with ghc-lib since hie-bios uses
@@ -101,6 +102,7 @@ import qualified Data.HashSet as Set
101102
import Database.SQLite.Simple
102103
import Development.IDE.Core.Tracing (withTrace)
103104
import Development.IDE.Types.Shake (WithHieDb)
105+
import GHC.IO (unsafePerformIO)
104106
import HieDb.Create
105107
import HieDb.Types
106108
import HieDb.Utils
@@ -201,6 +203,10 @@ instance Pretty Log where
201203
hiedbDataVersion :: String
202204
hiedbDataVersion = "1"
203205

206+
ignoredFilesGlobalVar :: IORef [FilePath]
207+
{-# NOINLINE ignoredFilesGlobalVar #-}
208+
ignoredFilesGlobalVar = unsafePerformIO $ newIORef []
209+
204210
data CacheDirs = CacheDirs
205211
{ hiCacheDir, hieCacheDir, oCacheDir :: Maybe FilePath}
206212

@@ -659,6 +665,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
659665
session (hieYaml, toNormalizedFilePath' cfp, opts, libDir)
660666
-- Failure case, either a cradle error or the none cradle
661667
Left err -> do
668+
modifyIORef ignoredFilesGlobalVar (cfp :)
662669
dep_info <- getDependencyInfo (maybeToList hieYaml)
663670
let ncfp = toNormalizedFilePath' cfp
664671
let res = (map (renderCradleError ncfp) err, Nothing)

‎ghcide/src/Development/IDE/Main.hs

Lines changed: 14 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -13,27 +13,26 @@ module Development.IDE.Main
1313
,Log(..)
1414
) where
1515
import Control.Concurrent.Extra (withNumCapabilities)
16-
import Control.Concurrent.STM.Stats (atomically,
17-
dumpSTMStats)
16+
import Control.Concurrent.STM.Stats (dumpSTMStats)
1817
import Control.Exception.Safe (SomeException,
1918
catchAny,
2019
displayException)
20+
import Control.Lens (Bifunctor (..))
2121
import Control.Monad.Extra (concatMapM, unless,
2222
when)
23-
import qualified Data.Aeson.Encode.Pretty as A
2423
import Data.Coerce (coerce)
2524
import Data.Default (Default (def))
2625
import Data.Foldable (traverse_)
2726
import Data.Hashable (hashed)
2827
import qualified Data.HashMap.Strict as HashMap
28+
import Data.IORef (readIORef)
29+
import Data.List ((\\))
2930
import Data.List.Extra (intercalate,
30-
isPrefixOf, nub,
31-
nubOrd, partition)
31+
isPrefixOf, nubOrd,
32+
partition)
3233
import Data.Maybe (catMaybes, isJust)
3334
import qualified Data.Text as T
34-
import Data.Text.Lazy.Encoding (decodeUtf8)
35-
import qualified Data.Text.Lazy.IO as LT
36-
import Data.Typeable (typeOf)
35+
import Debug.Trace (traceM)
3736
import Development.IDE (Action,
3837
GhcVersion (..),
3938
Priority (Debug, Error),
@@ -47,20 +46,16 @@ import Development.IDE.Core.IdeConfiguration (IdeConfiguration (..)
4746
import Development.IDE.Core.OfInterest (FileOfInterestStatus (OnDisk),
4847
kick,
4948
setFilesOfInterest)
50-
import Development.IDE.Core.Rules (GhcSessionIO (GhcSessionIO),
51-
mainRule)
49+
import Development.IDE.Core.Rules (mainRule)
5250
import qualified Development.IDE.Core.Rules as Rules
5351
import Development.IDE.Core.RuleTypes (GenerateCore (GenerateCore),
5452
GetHieAst (GetHieAst),
55-
GhcSession (GhcSession),
56-
GhcSessionDeps (GhcSessionDeps),
5753
TypeCheck (TypeCheck))
5854
import Development.IDE.Core.Service (initialise,
5955
runAction)
6056
import qualified Development.IDE.Core.Service as Service
6157
import Development.IDE.Core.Shake (IdeState (shakeExtras),
6258
IndexQueue,
63-
ShakeExtras (state),
6459
shakeSessionInit,
6560
uses)
6661
import qualified Development.IDE.Core.Shake as Shake
@@ -79,6 +74,7 @@ import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde
7974
import qualified Development.IDE.Plugin.Test as Test
8075
import Development.IDE.Session (SessionLoadingOptions,
8176
getHieDbLoc,
77+
ignoredFilesGlobalVar,
8278
loadSessionWithOptions,
8379
retryOnSqliteBusy,
8480
runWithDb,
@@ -102,8 +98,7 @@ import Development.IDE.Types.Options (IdeGhcSession,
10298
defaultIdeOptions,
10399
optModifyDynFlags,
104100
optTesting)
105-
import Development.IDE.Types.Shake (WithHieDb,
106-
fromKeyType)
101+
import Development.IDE.Types.Shake (WithHieDb)
107102
import GHC.Conc (getNumProcessors)
108103
import GHC.IO.Encoding (setLocaleEncoding)
109104
import GHC.IO.Handle (hDuplicate)
@@ -113,8 +108,6 @@ import Ide.Plugin.Config (CheckParents (NeverCh
113108
Config, checkParents,
114109
checkProject,
115110
getConfigFromNotification)
116-
import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig,
117-
pluginsToVSCodeExtensionSchema)
118111
import Ide.PluginUtils (allLspCmdIds',
119112
getProcessID,
120113
idePluginsToPluginDesc,
@@ -125,10 +118,8 @@ import Ide.Types (IdeCommand (IdeComman
125118
PluginId (PluginId),
126119
ipMap, pluginId)
127120
import qualified Language.LSP.Server as LSP
128-
import qualified "list-t" ListT
129121
import Numeric.Natural (Natural)
130122
import Options.Applicative hiding (action)
131-
import qualified StmContainers.Map as STM
132123
import qualified System.Directory.Extra as IO
133124
import System.Exit (ExitCode (ExitFailure),
134125
exitWith)
@@ -414,9 +405,11 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
414405
results <- runAction "User TypeCheck" ide $ uses TypeCheck (map toNormalizedFilePath' files)
415406
_results <- runAction "GetHie" ide $ uses GetHieAst (map toNormalizedFilePath' files)
416407
_results <- runAction "GenerateCore" ide $ uses GenerateCore (map toNormalizedFilePath' files)
417-
let (worked, failed) = partition fst $ zip (map isJust results) files
408+
let (worked, failedOrNone) = bimap (fmap snd) (fmap snd) . partition fst $ zip (map isJust results) files
409+
ignoredFiles <- readIORef ignoredFilesGlobalVar
410+
let failed = failedOrNone \\ ignoredFiles
418411
when (failed /= []) $
419-
putStr $ unlines $ "Files that failed:" : map ((++) " * " . snd) failed
412+
putStr $ unlines $ "Files that failed:" : map ((++) " * ") failed
420413

421414
let nfiles xs = let n = length xs in if n == 1 then "1 file" else show n ++ " files"
422415
putStrLn $ "\nCompleted (" ++ nfiles worked ++ " worked, " ++ nfiles failed ++ " failed)"

0 commit comments

Comments
 (0)