git.iko.soy/ghcide
on master help sign in
Escape colons in URIs to be consistent with VSCode (#1504)
30b531aMoritz Kiefer
BUILD.bazel+1
compare with master
unifiedsplit
@@ -19,6 +19,7 @@ depends = [
19 "haskell-lsp",
19 "haskell-lsp",
20 "haskell-lsp-types",
20 "haskell-lsp-types",
21 "mtl",
21 "mtl",
22+ "network-uri",
22 "pretty",
23 "pretty",
23 "rope-utf16-splay",
24 "rope-utf16-splay",
24 "safe-exceptions",
25 "safe-exceptions",
src/Development/IDE/Functions/GHCError.hs+1−2
@@ -38,7 +38,6 @@ import Data.Maybe
38import ErrUtils
38import ErrUtils
39import SrcLoc
39import SrcLoc
40import qualified Outputable as Out
40import qualified Outputable as Out
41−import qualified Language.Haskell.LSP.Types as LSP
42
41
43
42
44
43
@@ -79,7 +78,7 @@ srcSpanToFilename (RealSrcSpan real) = FS.unpackFS $ srcSpanFile real
79
78
80srcSpanToLocation :: SrcSpan -> Location
79srcSpanToLocation :: SrcSpan -> Location
81srcSpanToLocation src =
80srcSpanToLocation src =
82− Location (LSP.filePathToUri $ srcSpanToFilename src) (srcSpanToRange src)
81+ Location (D.filePathToUri' $ srcSpanToFilename src) (srcSpanToRange src)
83
82
84-- | Convert a GHC severity to a DAML compiler Severity. Severities below
83-- | Convert a GHC severity to a DAML compiler Severity. Severities below
85-- "Warning" level are dropped (returning Nothing).
84-- "Warning" level are dropped (returning Nothing).
src/Development/IDE/State/FileStore.hs+5−5
@@ -96,7 +96,7 @@ getFileExistsRule vfs =
96 defineEarlyCutoff $ \GetFileExists file -> do
96 defineEarlyCutoff $ \GetFileExists file -> do
97 alwaysRerun
97 alwaysRerun
98 res <- liftIO $ handle (\(_ :: IOException) -> return False) $
98 res <- liftIO $ handle (\(_ :: IOException) -> return False) $
99− (isJust <$> getVirtualFile vfs (filePathToUri file)) ||^
99+ (isJust <$> getVirtualFile vfs (filePathToUri' file)) ||^
100 Dir.doesFileExist file
100 Dir.doesFileExist file
101 return (Just $ if res then BS.singleton '1' else BS.empty, ([], Just res))
101 return (Just $ if res then BS.singleton '1' else BS.empty, ([], Just res))
102
102
@@ -109,7 +109,7 @@ getModificationTimeRule vfs =
109 defineEarlyCutoff $ \GetModificationTime file -> do
109 defineEarlyCutoff $ \GetModificationTime file -> do
110 let wrap time = (Just $ BS.pack $ showTimePrecise time, ([], Just $ ModificationTime time))
110 let wrap time = (Just $ BS.pack $ showTimePrecise time, ([], Just $ ModificationTime time))
111 alwaysRerun
111 alwaysRerun
112− mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri file
112+ mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri' file
113 case mbVirtual of
113 case mbVirtual of
114 Just (VirtualFile ver _ _) -> pure (Just $ BS.pack $ show ver, ([], Just $ VFSVersion ver))
114 Just (VirtualFile ver _ _) -> pure (Just $ BS.pack $ show ver, ([], Just $ VFSVersion ver))
115 Nothing -> liftIO $ fmap wrap (Dir.getModificationTime file) `catch` \(e :: IOException) -> do
115 Nothing -> liftIO $ fmap wrap (Dir.getModificationTime file) `catch` \(e :: IOException) -> do
@@ -124,7 +124,7 @@ getFileContentsRule vfs =
124 -- need to depend on modification time to introduce a dependency with Cutoff
124 -- need to depend on modification time to introduce a dependency with Cutoff
125 time <- use_ GetModificationTime file
125 time <- use_ GetModificationTime file
126 res <- liftIO $ ideTryIOException file $ do
126 res <- liftIO $ ideTryIOException file $ do
127− mbVirtual <- getVirtualFile vfs $ filePathToUri file
127+ mbVirtual <- getVirtualFile vfs $ filePathToUri' file
128 case mbVirtual of
128 case mbVirtual of
129 Just (VirtualFile _ rope _) -> return $ textToStringBuffer $ Rope.toText rope
129 Just (VirtualFile _ rope _) -> return $ textToStringBuffer $ Rope.toText rope
130 Nothing -> hGetStringBuffer file
130 Nothing -> hGetStringBuffer file
@@ -157,8 +157,8 @@ setBufferModified :: IdeState -> FilePath -> Maybe T.Text -> IO ()
157setBufferModified state absFile mbContents = do
157setBufferModified state absFile mbContents = do
158 VFSHandle{..} <- getIdeGlobalState state
158 VFSHandle{..} <- getIdeGlobalState state
159 case mbContents of
159 case mbContents of
160− Nothing -> removeVirtualFile (filePathToUri absFile)
160+ Nothing -> removeVirtualFile (filePathToUri' absFile)
161− Just contents -> setVirtualFileContents (filePathToUri absFile) contents
161+ Just contents -> setVirtualFileContents (filePathToUri' absFile) contents
162 void $ shakeRun state []
162 void $ shakeRun state []
163
163
164
164
src/Development/IDE/Types/Diagnostics.hs+15−2
@@ -28,7 +28,7 @@ module Development.IDE.Types.Diagnostics (
28 showDiagnostics,
28 showDiagnostics,
29 showDiagnosticsColored,
29 showDiagnosticsColored,
30 defDiagnostic,
30 defDiagnostic,
31− filePathToUri,
31+ filePathToUri',
32 uriToFilePath',
32 uriToFilePath',
33 ProjectDiagnostics,
33 ProjectDiagnostics,
34 emptyDiagnostics,
34 emptyDiagnostics,
@@ -47,6 +47,7 @@ import qualified Data.Map as Map
47import qualified Data.Text as T
47import qualified Data.Text as T
48import Data.Text.Prettyprint.Doc.Syntax
48import Data.Text.Prettyprint.Doc.Syntax
49import qualified Data.SortedList as SL
49import qualified Data.SortedList as SL
50+import Network.URI (escapeURIString)
50import qualified Text.PrettyPrint.Annotated.HughesPJClass as Pretty
51import qualified Text.PrettyPrint.Annotated.HughesPJClass as Pretty
51import qualified Language.Haskell.LSP.Types as LSP
52import qualified Language.Haskell.LSP.Types as LSP
52import Language.Haskell.LSP.Types as LSP (
53import Language.Haskell.LSP.Types as LSP (
@@ -67,9 +68,21 @@ import Development.IDE.Types.Location
67-- So we have our own wrapper here that supports empty filepaths.
68-- So we have our own wrapper here that supports empty filepaths.
68uriToFilePath' :: Uri -> Maybe FilePath
69uriToFilePath' :: Uri -> Maybe FilePath
69uriToFilePath' uri
70uriToFilePath' uri
70− | uri == filePathToUri "" = Just ""
71+ | uri == filePathToUri' "" = Just ""
71 | otherwise = LSP.uriToFilePath uri
72 | otherwise = LSP.uriToFilePath uri
72
73
74+-- TODO This is a temporary hack: VSCode escapes ':' in URIs while haskell-lsp’s filePathToUri doesn't.
75+-- This causes issues since haskell-lsp stores the original URI in the VFS while we roundtrip once via
76+-- uriToFilePath' and filePathToUri before we look it up again. At that point : will be unescaped in the URI
77+-- so the lookup fails. The long-term solution here is to avoid roundtripping URIs but that is a larger task
78+-- so for now we have our own version of filePathToUri that does escape colons.
79+filePathToUri' :: FilePath -> Uri
80+filePathToUri' fp =
81+ case T.stripPrefix "file:" (getUri uri) of
82+ Just suffix -> Uri $ T.pack $ "file:" <> escapeURIString (/= ':') (T.unpack suffix)
83+ Nothing -> uri
84+ where uri = filePathToUri fp
85+
73ideErrorText :: FilePath -> T.Text -> FileDiagnostic
86ideErrorText :: FilePath -> T.Text -> FileDiagnostic
74ideErrorText fp = errorDiag fp "Ide Error"
87ideErrorText fp = errorDiag fp "Ide Error"
75
88