Skip to content

Commit 14961f3

Browse files
committed
[chore] some more fixes to URI handling and bug fix for dropping MVar
1 parent f9d0d3d commit 14961f3

File tree

8 files changed

+80
-58
lines changed

8 files changed

+80
-58
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-
Just filename -> 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+
let filename = 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

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+
let fp = 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)