Skip to content

Commit 31b31a2

Browse files
soulomoonsoulomoon
committed
fix: handle unicode in semantic tokens
1 parent 6f9a903 commit 31b31a2

File tree

7 files changed

+74
-33
lines changed

7 files changed

+74
-33
lines changed

‎plugins/hls-semantic-tokens-plugin/hls-semantic-tokens-plugin.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -76,6 +76,7 @@ test-suite tests
7676
, lens
7777
, lsp
7878
, ghc
79+
, text-rope
7980
, lsp-test
8081
, text
8182
, data-default

‎plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,6 @@ import Control.Monad.Except (ExceptT, liftEither,
2525
import Control.Monad.IO.Class (MonadIO, liftIO)
2626
import Control.Monad.Trans (lift)
2727
import Control.Monad.Trans.Except (runExceptT)
28-
import Data.Either (fromRight)
2928
import qualified Data.Map as Map
3029
import Data.Maybe (listToMaybe, mapMaybe)
3130
import qualified Data.Text as T
@@ -34,7 +33,6 @@ import Development.IDE (Action,
3433
GetHieAst (GetHieAst),
3534
HieAstResult (HAR, hieAst, hieModule, refMap),
3635
IdeResult, IdeState,
37-
Pretty (pretty),
3836
Priority (..), Recorder,
3937
Rules, WithPriority,
4038
cmapWithPrio, define,
@@ -46,12 +44,14 @@ import Development.IDE.Core.PositionMapping (idDelta, toCurrentRange)
4644
import Development.IDE.Core.Rules (toIdeResult)
4745
import Development.IDE.Core.RuleTypes (DocAndKindMap (..))
4846
import Development.IDE.Core.Shake (addPersistentRule,
47+
getVirtualFile,
4948
useWithStale_)
5049
import Development.IDE.GHC.Compat hiding (Warning)
5150
import Ide.Logger (logWith)
5251
import Ide.Plugin.Error (PluginError (PluginInternalError),
5352
getNormalizedFilePathE,
54-
handleMaybe)
53+
handleMaybe,
54+
handleMaybeM)
5555
import Ide.Plugin.SemanticTokens.Mappings
5656
import Ide.Plugin.SemanticTokens.Query
5757
import Ide.Plugin.SemanticTokens.Types
@@ -101,8 +101,9 @@ getSemanticTokensRule recorder =
101101
(HAR {..}) <- lift $ use_ GetHieAst nfp
102102
(DKMap{getKindMap}, _) <- lift $ useWithStale_ GetDocMap nfp
103103
(_, ast) <- handleMaybe LogNoAST $ listToMaybe $ Map.toList $ getAsts hieAst
104+
virtualFile <- handleMaybeM LogNoVF $ getVirtualFile nfp
104105
-- get current location from the old ones
105-
let spanNamesMap = hieAstSpanNames ast
106+
let spanNamesMap = hieAstSpanNames virtualFile ast
106107
let names = nameSetElemsStable $ unionNameSets $ Map.elems spanNamesMap
107108
let localSemanticMap = mkLocalNameSemanticFromAst names (hieKindFunMasksKind hieKind) refMap
108109
-- get imported name semantic map

‎plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Mappings.hs

Lines changed: 21 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -15,18 +15,20 @@ module Ide.Plugin.SemanticTokens.Mappings where
1515
import qualified Data.Array as A
1616
import Data.List.Extra (chunksOf, (!?))
1717
import qualified Data.Map as Map
18+
import Data.Maybe (mapMaybe)
1819
import qualified Data.Set as Set
19-
import Data.Text (Text)
20+
import Data.Text (Text, unpack)
2021
import Development.IDE (HieKind (HieFresh, HieFromDisk))
2122
import Development.IDE.GHC.Compat
22-
import Ide.Plugin.SemanticTokens.Types
23-
import Ide.Plugin.SemanticTokens.Utils (recoverFunMaskArray)
23+
import Ide.Plugin.SemanticTokens.Types hiding (tokens)
24+
import Ide.Plugin.SemanticTokens.Utils (mkRange, recoverFunMaskArray)
2425
import Language.LSP.Protocol.Types (LspEnum (knownValues),
2526
SemanticTokenAbsolute (SemanticTokenAbsolute),
2627
SemanticTokenRelative (SemanticTokenRelative),
2728
SemanticTokenTypes (..),
2829
SemanticTokens (SemanticTokens),
2930
UInt, absolutizeTokens)
31+
import Language.LSP.VFS hiding (line)
3032

3133
-- * 1. Mapping semantic token type to and from the LSP default token type.
3234

@@ -140,16 +142,23 @@ type ActualToken = (UInt, UInt, UInt, HsSemanticTokenType, UInt)
140142
-- for debug and test.
141143
-- this function is used to recover the original tokens(with token in haskell token type zoon)
142144
-- from the lsp semantic tokens(with token in lsp token type zoon)
143-
recoverSemanticTokens :: String -> SemanticTokens -> Either Text [SemanticTokenOriginal]
144-
recoverSemanticTokens sourceCode (SemanticTokens _ xs) = fmap (tokenOrigin sourceCode) <$> dataActualToken xs
145+
recoverSemanticTokens :: VirtualFile -> SemanticTokens -> Either Text [SemanticTokenOriginal]
146+
recoverSemanticTokens vsf (SemanticTokens _ xs) = do
147+
tokens <- dataActualToken xs
148+
return $ mapMaybe (tokenOrigin sourceCode) tokens
145149
where
146-
tokenOrigin :: [Char] -> ActualToken -> SemanticTokenOriginal
147-
tokenOrigin sourceCode' (line, startChar, len, tokenType, _) =
148-
-- convert back to count from 1
149-
SemanticTokenOriginal tokenType (Loc (line + 1) (startChar + 1) len) name
150-
where
151-
tLine = lines sourceCode' !? fromIntegral line
152-
name = maybe "no source" (take (fromIntegral len) . drop (fromIntegral startChar)) tLine
150+
sourceCode = unpack $ virtualFileText vsf
151+
tokenOrigin :: [Char] -> ActualToken -> Maybe SemanticTokenOriginal
152+
tokenOrigin sourceCode' (line, startChar, len, tokenType, _) = do
153+
-- convert back to count from 1
154+
let range = mkRange line startChar len
155+
CodePointRange (CodePointPosition x y) (CodePointPosition _ y1) <- rangeToCodePointRange vsf range
156+
let line' = x
157+
let startChar' = y
158+
let len' = y1 - y
159+
let tLine = lines sourceCode' !? fromIntegral line'
160+
let name = maybe "no source" (take (fromIntegral len') . drop (fromIntegral startChar')) tLine
161+
return $ SemanticTokenOriginal tokenType (Loc (line' + 1) (startChar' + 1) len') name
153162

154163
dataActualToken :: [UInt] -> Either Text [ActualToken]
155164
dataActualToken dt =

‎plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Query.hs

Lines changed: 13 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -10,23 +10,25 @@ module Ide.Plugin.SemanticTokens.Query where
1010

1111
import Data.Either (rights)
1212
import Data.Foldable (fold)
13-
import Data.Generics (everything)
1413
import qualified Data.List as List
1514
import qualified Data.Map as M
1615
import qualified Data.Map as Map
17-
import Data.Maybe (listToMaybe, mapMaybe)
16+
import Data.Maybe (fromMaybe, listToMaybe,
17+
mapMaybe)
1818
import qualified Data.Set as S
1919
import qualified Data.Set as Set
2020
import Data.Text (Text)
21-
import Development.IDE (HieKind,
22-
realSrcSpanToRange)
21+
import Development.IDE (realSrcSpanToRange)
2322
import Development.IDE.GHC.Compat
24-
import Generics.SYB (mkQ)
2523
import Ide.Plugin.SemanticTokens.Mappings
2624
import Ide.Plugin.SemanticTokens.Types (HieFunMaskKind,
2725
HsSemanticTokenType,
2826
NameSemanticMap)
27+
import Ide.Plugin.SemanticTokens.Utils (realSrcSpanToCodePointRange)
2928
import Language.LSP.Protocol.Types
29+
import Language.LSP.VFS (CodePointRange,
30+
VirtualFile,
31+
codePointRangeToRange)
3032
import Prelude hiding (span)
3133

3234
---------------------------------------------------------
@@ -66,13 +68,15 @@ nameNameSemanticFromHie hieKind rm ns = do
6668
-- | get only visible names from HieAST
6769
-- we care only the leaf node of the AST
6870
-- and filter out the derived and evidence names
69-
hieAstSpanNames :: HieAST a -> M.Map Range NameSet
70-
hieAstSpanNames ast =
71+
hieAstSpanNames :: VirtualFile -> HieAST a -> M.Map Range NameSet
72+
hieAstSpanNames vf ast =
7173
if null (nodeChildren ast)
7274
then getIds ast
73-
else M.unionsWith unionNameSet $ map hieAstSpanNames (nodeChildren ast)
75+
else M.unionsWith unionNameSet $ map (hieAstSpanNames vf) (nodeChildren ast)
7476
where
75-
getIds ast' = M.singleton (realSrcSpanToRange $ nodeSpan ast') (getNodeIds' ast')
77+
getIds ast' = fromMaybe mempty $ do
78+
range <- codePointRangeToRange vf $ realSrcSpanToCodePointRange $ nodeSpan ast'
79+
return $ M.singleton range (getNodeIds' ast')
7680
getNodeIds' =
7781
Map.foldl' combineNodeIds mempty
7882
. Map.filterWithKey (\k _ -> k == SourceInfo)

‎plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Types.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -83,10 +83,12 @@ data HieFunMaskKind kind where
8383

8484
data SemanticLog = LogShake Shake.Log
8585
| LogNoAST
86+
| LogNoVF
8687
deriving Show
8788

8889
instance Pretty SemanticLog where
8990
pretty theLog = case theLog of
9091
LogShake shakeLog -> pretty shakeLog
9192
LogNoAST -> "no HieAst exist for file"
93+
LogNoVF -> "no VirtualSourceFile exist for file"
9294

‎plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Utils.hs

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,8 +9,12 @@ import qualified Data.Array as A
99
import Data.ByteString (ByteString)
1010
import Data.ByteString.Char8 (unpack)
1111
import qualified Data.Map as Map
12+
import Development.IDE (Position (..), Range (..))
1213
import Development.IDE.GHC.Compat
14+
import qualified Development.IDE.GHC.Compat as Compat
1315
import Ide.Plugin.SemanticTokens.Types
16+
import Language.LSP.VFS (CodePointPosition (..),
17+
CodePointRange (..))
1418
import Prelude hiding (span)
1519

1620
deriving instance Show DeclType
@@ -119,4 +123,18 @@ recoverFunMaskArray flattened = unflattened
119123
go (HTyConApp _ _) = False
120124

121125

126+
realSrcSpanToCodePointRange :: RealSrcSpan -> CodePointRange
127+
realSrcSpanToCodePointRange real =
128+
CodePointRange (realSrcLocToCodePointPosition $ Compat.realSrcSpanStart real)
129+
(realSrcLocToCodePointPosition $ Compat.realSrcSpanEnd real)
122130

131+
132+
realSrcLocToCodePointPosition :: RealSrcLoc -> CodePointPosition
133+
realSrcLocToCodePointPosition real =
134+
CodePointPosition (fromIntegral $ srcLocLine real - 1) (fromIntegral $ srcLocCol real - 1)
135+
136+
-- rangeToCodePointRange
137+
-- mkRange :: Int -> Int -> Int -> Range
138+
mkRange :: (Integral a1, Integral a2) => a1 -> a2 -> a2 -> Range
139+
mkRange startLine startCol len =
140+
Range (Position (fromIntegral startLine) (fromIntegral startCol)) (Position (fromIntegral startLine) (fromIntegral $ startCol + len))

‎plugins/hls-semantic-tokens-plugin/test/Main.hs

Lines changed: 14 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -23,8 +23,11 @@ import qualified Data.Set as Set
2323
import Data.String (fromString)
2424
import Data.Text hiding (length, map,
2525
unlines)
26-
import Development.IDE (getFileContents, runAction)
26+
import qualified Data.Text.Utf16.Rope as Rope
27+
import Development.IDE (getFileContents, runAction,
28+
toNormalizedUri)
2729
import Development.IDE.Core.Rules (Log)
30+
import Development.IDE.Core.Shake (getVirtualFile)
2831
import Development.IDE.Plugin.Test (WaitForIdeRuleResult (..))
2932
import Development.IDE.Test (waitForBuildQueue)
3033
import Ide.Plugin.Error (getNormalizedFilePathE)
@@ -36,12 +39,14 @@ import qualified Language.LSP.Protocol.Lens as L
3639
import Language.LSP.Protocol.Types (SemanticTokens (..),
3740
SemanticTokensParams (..),
3841
_L, type (|?) (..))
39-
import Language.LSP.Test (openDoc)
42+
import qualified Language.LSP.Server as Lsp
43+
import Language.LSP.Test (Session (..), openDoc)
4044
import qualified Language.LSP.Test as Test
45+
import Language.LSP.VFS (VirtualFile (..))
4146
import System.Environment.Blank
4247
import System.FilePath
4348
import Test.Hls (PluginTestDescriptor,
44-
Session, TestName,
49+
Session (..), TestName,
4550
TestTree,
4651
TextDocumentIdentifier,
4752
defaultTestRunner,
@@ -90,11 +95,12 @@ goldenWithSemanticTokens title path =
9095
docSemanticTokensString :: TextDocumentIdentifier -> Session String
9196
docSemanticTokensString doc = do
9297
res <- Test.getSemanticTokens doc
93-
content <- unpack <$> documentContents doc
98+
textContent <- documentContents doc
99+
let vfs = VirtualFile 0 0 (Rope.fromText textContent)
94100
let expect = []
95101
case res ^? _L of
96102
Just tokens -> do
97-
either (error . show) (return . unlines . map show) $ recoverSemanticTokens content tokens
103+
either (error . show) (return . unlines . map show) $ recoverSemanticTokens vfs tokens
98104
_noTokens -> error "No tokens found"
99105

100106
semanticTokensImportedTests :: TestTree
@@ -130,8 +136,6 @@ semanticTokensTests =
130136
[ testCase "module import test" $ do
131137
let filePath1 = "./test/testdata/TModuleA.hs"
132138
let filePath2 = "./test/testdata/TModuleB.hs"
133-
content1 <- liftIO $ Prelude.readFile filePath1
134-
content2 <- liftIO $ Prelude.readFile filePath2
135139

136140
let file1 = "TModuleA.hs"
137141
let file2 = "TModuleB.hs"
@@ -149,12 +153,14 @@ semanticTokensTests =
149153
Left y -> error "TypeCheck2 failed"
150154

151155
res2 <- Test.getSemanticTokens doc2
156+
textContent2 <- documentContents doc2
157+
let vfs = VirtualFile 0 0 (Rope.fromText textContent2)
152158
case res2 ^? _L of
153159
Just tokens -> do
154160
either
155161
(error . show)
156162
(\xs -> liftIO $ xs @?= expect)
157-
$ recoverSemanticTokens content2 tokens
163+
$ recoverSemanticTokens vfs tokens
158164
return ()
159165
_ -> error "No tokens found"
160166
liftIO $ 1 @?= 1,

0 commit comments

Comments
 (0)