Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 26c5db8

Browse files
committed
[chore] some more fixes to URI handling and bug fix for dropping MVar
1 parent 5dfe183 commit 26c5db8

File tree

9 files changed

+86
-61
lines changed

9 files changed

+86
-61
lines changed

‎ghcide/src/Development/IDE/Core/Compile.hs

Lines changed: 38 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -1125,43 +1125,44 @@ getModSummaryFromImports env uri _modTime mContents = do
11251125
liftIO $ evaluate $ rnf textualImports
11261126

11271127

1128-
case uriToFilePath' uri of
1129-
Nothing -> do
1130-
let nuri = toNormalizedUri uri
1131-
throwError [ideErrorText nuri $ "Uri is not a file uri: " <> getUri uri]
1132-
Just file -> do
1133-
modLoc <- liftIO $ if mod == mAIN_NAME
1134-
-- specially in tests it's common to have lots of nameless modules
1135-
-- mkHomeModLocation will map them to the same hi/hie locations
1136-
then mkHomeModLocation dflags (pathToModuleName uri) file
1137-
else mkHomeModLocation dflags mod file
1138-
1139-
let modl = mkHomeModule (hscHomeUnit ppEnv) mod
1140-
sourceType = if "-boot" `isSuffixOf` takeExtension file then HsBootFile else HsSrcFile
1141-
msrModSummary =
1142-
ModSummary
1143-
{ ms_mod = modl
1144-
, ms_hie_date = Nothing
1145-
, ms_dyn_obj_date = Nothing
1146-
, ms_ghc_prim_import = ghc_prim_import
1147-
, ms_hs_hash = _src_hash
1148-
1149-
, ms_hsc_src = sourceType
1150-
-- The contents are used by the GetModSummary rule
1151-
, ms_hspp_buf = Just contents
1152-
, ms_hspp_file = file
1153-
, ms_hspp_opts = dflags
1154-
, ms_iface_date = Nothing
1155-
, ms_location = withBootSuffix sourceType modLoc
1156-
, ms_obj_date = Nothing
1157-
, ms_parsed_mod = Nothing
1158-
, ms_srcimps = srcImports
1159-
, ms_textual_imps = textualImports
1160-
}
1161-
1162-
msrFingerprint <- liftIO $ computeFingerprint file opts msrModSummary
1163-
msrHscEnv <- liftIO $ Loader.initializePlugins (hscSetFlags (ms_hspp_opts msrModSummary) ppEnv)
1164-
return ModSummaryResult{..}
1128+
-- NOTE: thisis pretty bad as it relies on the prepropcessors not actually reading from a file when it's not needed
1129+
when (isNothing (uriToFilePath' uri) && isNothing mContents) $ do
1130+
throwError [ideErrorText (toNormalizedUri uri) $ "Uri is not a file uri: " <> getUri uri]
1131+
1132+
let file = T.unpack $ getUri uri
1133+
1134+
modLoc <- liftIO $ if mod == mAIN_NAME
1135+
-- specially in tests it's common to have lots of nameless modules
1136+
-- mkHomeModLocation will map them to the same hi/hie locations
1137+
then mkHomeModLocation dflags (pathToModuleName uri) file
1138+
else mkHomeModLocation dflags mod file
1139+
1140+
let modl = mkHomeModule (hscHomeUnit ppEnv) mod
1141+
sourceType = if "-boot" `isSuffixOf` takeExtension file then HsBootFile else HsSrcFile
1142+
msrModSummary =
1143+
ModSummary
1144+
{ ms_mod = modl
1145+
, ms_hie_date = Nothing
1146+
, ms_dyn_obj_date = Nothing
1147+
, ms_ghc_prim_import = ghc_prim_import
1148+
, ms_hs_hash = _src_hash
1149+
1150+
, ms_hsc_src = sourceType
1151+
-- The contents are used by the GetModSummary rule
1152+
, ms_hspp_buf = Just contents
1153+
, ms_hspp_file = file
1154+
, ms_hspp_opts = dflags
1155+
, ms_iface_date = Nothing
1156+
, ms_location = withBootSuffix sourceType modLoc
1157+
, ms_obj_date = Nothing
1158+
, ms_parsed_mod = Nothing
1159+
, ms_srcimps = srcImports
1160+
, ms_textual_imps = textualImports
1161+
}
1162+
1163+
msrFingerprint <- liftIO $ computeFingerprint file opts msrModSummary
1164+
msrHscEnv <- liftIO $ Loader.initializePlugins (hscSetFlags (ms_hspp_opts msrModSummary) ppEnv)
1165+
return ModSummaryResult{..}
11651166
where
11661167
-- Compute a fingerprint from the contents of `ModSummary`,
11671168
-- eliding the timestamps, the preprocessed source and other non relevant fields

‎ghcide/src/Development/IDE/Core/Preprocessor.hs

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@ import Language.LSP.Protocol.Types (uriToFilePath)
1616
import Control.DeepSeq (NFData (rnf))
1717
import Control.Exception (evaluate)
1818
import Control.Exception.Safe (catch, throw)
19+
import Control.Monad (when)
1920
import Control.Monad.Except (throwError)
2021
import Control.Monad.IO.Class
2122
import Control.Monad.Trans.Except
@@ -38,11 +39,11 @@ import System.IO.Extra
3839
-- | Given a file and some contents, apply any necessary preprocessors,
3940
-- e.g. unlit/cpp. Return the resulting buffer and the DynFlags it implies.
4041
preprocessor :: HscEnv -> Uri -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO (Util.StringBuffer, [String], HscEnv, Util.Fingerprint)
41-
preprocessor env uri mbContents = case uriToFilePath uri of
42-
Nothing->do
43-
let nuri = toNormalizedUri uri
44-
throwError [ideErrorText nuri $ "Uri is not a file uri: " <> getUri uri]
45-
Justfilename ->do
42+
preprocessor env uri mbContents = do
43+
-- NOTE: thisis pretty bad as it relies on the prepropcessors not actually reading from a file when it's not needed
44+
when (isNothing (uriToFilePath uri) && isNothing mbContents) $do
45+
throwError [ideErrorText (toNormalizedUri uri) $ "Uri is not a file uri and contents are not available: " <> getUri uri]
46+
letfilename =T.unpack $ getUri uri
4647
-- Perform unlit
4748
(isOnDisk, contents) <-
4849
if isLiterate uri then do

‎ghcide/src/Development/IDE/Core/Rules.hs

Lines changed: 23 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -173,6 +173,7 @@ import System.Info.Extra (isWindows)
173173

174174
import qualified Data.IntMap as IM
175175
import GHC.Fingerprint
176+
import System.Process.Extra (proc, readCreateProcess)
176177

177178
data Log
178179
= LogShake Shake.Log
@@ -710,11 +711,31 @@ loadGhcSession recorder ghcSessionDepsConfig = do
710711
return (fingerprint, res)
711712

712713
defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GhcSession uri -> do
714+
-- let mk k = case uriToNormalizedFilePath nuri of
715+
-- -- FIXME: awful hack to get cradles to work
716+
-- Nothing -> withSystemTempDirectory "tmp_cradle" $ \dir -> do
717+
-- writeFile (dir </> "hie.yaml") "cradle:\n direct:\n arguments: []"
718+
-- k dir
719+
-- Just file -> k $ fromNormalizedFilePath file
713720
IdeGhcSession{loadSessionFun} <- useNoFile_ GhcSessionIO
714721
-- loading is always returning a absolute path now
715722
(val,deps) <- case uriToNormalizedFilePath uri of
716-
Just file -> liftIO $ loadSessionFun $ fromNormalizedFilePath file
717-
Nothing -> pure (([], Nothing), [])
723+
Just fp -> liftIO $ loadSessionFun (fromNormalizedFilePath fp)
724+
Nothing -> do
725+
hscEnv :: HscEnv <- do
726+
ShakeExtras{ideNc} <- getShakeExtras
727+
728+
liftIO $ do
729+
-- TODO: clean up
730+
-- e.g. the hack to drop the line break but also other stuff
731+
libdir <- init <$> readCreateProcess (proc "ghc" ["--print-libdir"]) ""
732+
env <- runGhc {- get lib dir from somewhere -} (Just libdir) $
733+
getSessionDynFlags >>= setSessionDynFlags >> getSession
734+
pure $ (hscSetFlags ((hsc_dflags env){useUnicode = True }) env) {hsc_NC = ideNc}
735+
736+
hscEnvEq <- liftIO $ newHscEnvEq hscEnv
737+
pure (([], Just hscEnvEq), [])
738+
718739

719740

720741
-- add the deps to the Shake graph

‎ghcide/src/Development/IDE/LSP/LanguageServer.hs

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,7 @@ import UnliftIO.Directory
3434
import UnliftIO.Exception
3535

3636
import qualified Colog.Core as Colog
37+
import Control.Exception (BlockedIndefinitelyOnMVar (..))
3738
import Control.Monad.IO.Unlift (MonadUnliftIO)
3839
import Control.Monad.Trans.Cont (evalContT)
3940
import Development.IDE.Core.IdeConfiguration
@@ -265,11 +266,13 @@ runWithWorkerThreads recorder dbLoc f = evalContT $ do
265266
(WithHieDbShield hiedb, threadQueue) <- runWithDb recorder dbLoc
266267
liftIO $ f hiedb (ThreadQueue threadQueue sessionRestartTQueue sessionLoaderTQueue)
267268

268-
-- | Runs the action until it ends or until the given MVar is put.
269+
-- | Runs the action until it ends or until the given MVar is put or the thread to fill the mvar is dropped, in which case the MVar will never be filled.
270+
-- This happens when the thread that handles the shutdown notification dies. Ideally, this should not rely on the RTS detecting the blocked MVar
271+
-- and instead *also* run the shutdown inf a finally block enclosing the handlers. In which case the BlockedIndefinitelyOnMVar Exception also wouldn't
272+
-- be thrown.
269273
-- Rethrows any exceptions.
270274
untilMVar :: MonadUnliftIO m => MVar () -> m () -> m ()
271-
untilMVar mvar io = void $
272-
waitAnyCancel =<< traverse async [ io , readMVar mvar ]
275+
untilMVar mvar io = race_ (readMVar mvar `catch` \BlockedIndefinitelyOnMVar -> pure ()) io
273276

274277
cancelHandler :: (SomeLspId -> IO ()) -> LSP.Handlers (ServerM c)
275278
cancelHandler cancelRequest = LSP.notificationHandler SMethod_CancelRequest $ \TNotificationMessage{_params=CancelParams{_id}} ->

‎hls-plugin-api/src/Ide/Plugin/Config.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ import Ide.Types
2727
-- | Given a DidChangeConfigurationNotification message, this function returns the parsed
2828
-- Config object if possible.
2929
getConfigFromNotification :: IdePlugins s -> Config -> A.Value -> Either T.Text Config
30+
getConfigFromNotification _plugins defaultValue Null = pure defaultValue
3031
getConfigFromNotification plugins defaultValue p =
3132
case A.parse (parseConfig plugins defaultValue) p of
3233
A.Success c -> Right c

‎plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -167,12 +167,12 @@ type instance RuleResult GetCodeRange = CodeRange
167167

168168
codeRangeRule :: Recorder (WithPriority Log) -> Rules ()
169169
codeRangeRule recorder =
170-
define (cmapWithPrio LogShake recorder) $ \GetCodeRange file -> handleError recorder $ do
170+
define (cmapWithPrio LogShake recorder) $ \GetCodeRange nuri -> handleError recorder $ do
171171
-- We need both 'HieAST' (for basic AST) and api annotations (for comments and some keywords).
172172
-- See https://gitlab.haskell.org/ghc/ghc/-/wikis/api-annotations
173-
HAR{hieAst, refMap} <- lift $ use_ GetHieAst file
173+
HAR{hieAst, refMap} <- lift $ use_ GetHieAst nuri
174174
ast <- maybeToExceptT LogNoAST . MaybeT . pure $
175-
getAsts hieAst Map.!? (coerce . mkFastString . T.unpack . getUri . fromNormalizedUri) file
175+
getAsts hieAst Map.!? (coerce . mkFastString . T.unpack . getUri . fromNormalizedUri) nuri
176176
let (codeRange, warnings) = runWriter (buildCodeRange ast refMap)
177177
traverse_ (logWith recorder Warning) warnings
178178

‎plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -152,7 +152,7 @@ mkRangeCommands recorder st plId textDocument =
152152
in perf "evalMkRangeCommands" $
153153
do
154154
let TextDocumentIdentifier uri = textDocument
155-
fp <- uriToFilePathE uri
155+
letfp =T.unpack $ getUri uri
156156
let nuri = toNormalizedUri uri
157157
isLHS = isLiterate fp
158158
dbg $ LogCodeLensFp fp
@@ -207,7 +207,6 @@ runEvalCmd recorder plId st mtoken EvalParams{..} =
207207
let tests = map (\(a,_,b) -> (a,b)) $ testsBySection sections
208208

209209
let TextDocumentIdentifier{_uri} = module_
210-
fp <- uriToFilePathE _uri
211210
let nuri = toNormalizedUri _uri
212211
mdlText <- moduleText st _uri
213212

@@ -230,7 +229,7 @@ runEvalCmd recorder plId st mtoken EvalParams{..} =
230229
perf "edits" $
231230
liftIO $
232231
evalGhcEnv final_hscEnv $ do
233-
runTests recorder evalCfg fp tests
232+
runTests recorder evalCfg (T.unpack $ getUri _uri) tests
234233

235234
let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)
236235
let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing

‎plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs

Lines changed: 6 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -107,13 +107,11 @@ data Action = Replace
107107
-- | Required action (that can be converted to either CodeLenses or CodeActions)
108108
action :: Recorder (WithPriority Log) -> IdeState -> Uri -> ExceptT PluginError (HandlerM c) [Action]
109109
action recorder state uri = do
110-
fp <- uriToFilePathE uri
111110
let nuri = toNormalizedUri uri
112-
113111
contents <- liftIO $ runAction "ModuleName.getFileContents" state $ getFileContents nuri
114112
let emptyModule = maybe True (T.null . T.strip . Rope.toText) contents
115113

116-
correctNames <- mapExceptT liftIO $ pathModuleNames recorder state nuri fp
114+
correctNames <- mapExceptT liftIO $ pathModuleNames recorder state nuri
117115
logWith recorder Debug (CorrectNames correctNames)
118116
let bestName = minimumBy (comparing T.length) <$> NE.nonEmpty correctNames
119117
logWith recorder Debug (BestName bestName)
@@ -133,10 +131,10 @@ action recorder state uri = do
133131
-- | Possible module names, as derived by the position of the module in the
134132
-- source directories. There may be more than one possible name, if the source
135133
-- directories are nested inside each other.
136-
pathModuleNames :: Recorder (WithPriority Log) -> IdeState -> NormalizedUri -> FilePath->ExceptT PluginError IO [T.Text]
137-
pathModuleNames recorder state nuri filePath
138-
| firstLetter isLower $ takeFileName filePath =return ["Main"]
139-
|otherwise = do
134+
pathModuleNames :: Recorder (WithPriority Log) -> IdeState -> NormalizedUri -> ExceptT PluginError IO [T.Text]
135+
pathModuleNames recorder state nuri
136+
| Just filePath <- uriToFilePath $ fromNormalizedUri nuri
137+
, firstLetter isUpper $ takeFileName filePath = do
140138
(session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession nuri
141139
srcPaths <- liftIO $ evalGhcEnv (hscEnv session) $ importPaths <$> getSessionDynFlags
142140
logWith recorder Debug (SrcPaths srcPaths)
@@ -155,6 +153,7 @@ pathModuleNames recorder state nuri filePath
155153

156154
let suffixes = mapMaybe (`stripPrefix` mdlPath) paths
157155
pure (map moduleNameFrom suffixes)
156+
| otherwise = pure [T.pack "Main"]
158157
where
159158
firstLetter :: (Char -> Bool) -> FilePath -> Bool
160159
firstLetter _ [] = False

‎plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -108,7 +108,7 @@ rules recorder plId = do
108108
define (cmapWithPrio LogShake recorder) $
109109
\GetStanDiagnostics nuri -> do
110110
case LSP.uriToNormalizedFilePath nuri of
111-
Nothing -> pure ([ideErrorText nuri $"Uri is no a file Uri: "<> getUri (fromNormalizedUri nuri)], Nothing)
111+
Nothing -> pure ([], Nothing)
112112
Just nfp -> do
113113
config <- getPluginConfigAction plId
114114
if plcGlobalOn config && plcDiagnosticsOn config then do

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /