add realSrcSpanToCodePointRange, realSrcLocToCodePointPosition to Development.IDE.GHC.Error

Author: soulomoon

Diff for: ghcide/src/Development/IDE/GHC/Error.hs

@@ -17,6 +17,8 @@ module Development.IDE.GHC.Error
   , realSrcSpanToRange
   , realSrcLocToPosition
   , realSrcSpanToLocation
+  , realSrcSpanToCodePointRange
+  , realSrcLocToCodePointPosition
   , srcSpanToFilename
   , rangeToSrcSpan
   , rangeToRealSrcSpan
@@ -45,6 +47,8 @@ import           Development.IDE.Types.Diagnostics as D
 import           Development.IDE.Types.Location
 import           GHC
 import           Language.LSP.Protocol.Types       (isSubrangeOf)
+import           Language.LSP.VFS                  (CodePointPosition (CodePointPosition),
+                                                    CodePointRange (CodePointRange))
 
 
 diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
@@ -86,6 +90,28 @@ realSrcLocToPosition :: RealSrcLoc -> Position
 realSrcLocToPosition real =
   Position (fromIntegral $ srcLocLine real - 1) (fromIntegral $ srcLocCol real - 1)
 
+-- Note [Unicode support]
+-- the current situation is:
+-- LSP Positions use UTF-16 code units(Unicode may count as variable columns);
+-- GHC use Unicode code points(Unicode count as one column).
+-- To support unicode, ideally range should be in lsp standard,
+-- and codePoint should be in ghc standard.
+-- see https://github.com/haskell/lsp/pull/407
+
+-- | Convert a GHC SrcSpan to CodePointRange
+-- see Note [Unicode support]
+realSrcSpanToCodePointRange :: RealSrcSpan -> CodePointRange
+realSrcSpanToCodePointRange real =
+  CodePointRange
+    (realSrcLocToCodePointPosition $ Compat.realSrcSpanStart real)
+    (realSrcLocToCodePointPosition $ Compat.realSrcSpanEnd real)
+
+-- | Convert a GHC RealSrcLoc to CodePointPosition
+-- see Note [Unicode support]
+realSrcLocToCodePointPosition :: RealSrcLoc -> CodePointPosition
+realSrcLocToCodePointPosition real =
+  CodePointPosition (fromIntegral $ srcLocLine real - 1) (fromIntegral $ srcLocCol real - 1)
+
 -- | Extract a file name from a GHC SrcSpan (use message for unhelpful ones)
 -- FIXME This may not be an _absolute_ file name, needs fixing.
 srcSpanToFilename :: SrcSpan -> Maybe FilePath

Diff for: plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs

@@ -94,7 +94,7 @@ semanticTokensFull state _ param = do
 -- Visible names from 'tmrRenamed'
 --
 -- It then combines this information to compute the semantic tokens for the file.
-getSemanticTokensRule :: Recorder (WithPriority SemanticLog) ->  Rules ()
+getSemanticTokensRule :: Recorder (WithPriority SemanticLog) -> Rules ()
 getSemanticTokensRule recorder =
   define (cmapWithPrio LogShake recorder) $ \GetSemanticTokens nfp -> handleError recorder $ do
     (HAR {..}) <- lift $ use_ GetHieAst nfp

Diff for: plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Mappings.hs

@@ -20,7 +20,7 @@ import qualified Data.Set                        as Set
 import           Data.Text                       (Text, unpack)
 import           Development.IDE                 (HieKind (HieFresh, HieFromDisk))
 import           Development.IDE.GHC.Compat
-import           Ide.Plugin.SemanticTokens.Types hiding (tokens)
+import           Ide.Plugin.SemanticTokens.Types
 import           Ide.Plugin.SemanticTokens.Utils (mkRange, recoverFunMaskArray)
 import           Language.LSP.Protocol.Types     (LspEnum (knownValues),
                                                   SemanticTokenAbsolute (SemanticTokenAbsolute),

Diff for: plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Query.hs

@@ -19,11 +19,11 @@ import           Data.Text                            (Text)
 import           Development.IDE.Core.PositionMapping (PositionMapping,
                                                        toCurrentRange)
 import           Development.IDE.GHC.Compat
+import           Development.IDE.GHC.Error            (realSrcSpanToCodePointRange)
 import           Ide.Plugin.SemanticTokens.Mappings
 import           Ide.Plugin.SemanticTokens.Types      (HieFunMaskKind,
                                                        HsSemanticTokenType,
                                                        NameSemanticMap)
-import           Ide.Plugin.SemanticTokens.Utils      (realSrcSpanToCodePointRange)
 import           Language.LSP.Protocol.Types
 import           Language.LSP.VFS                     (VirtualFile,
                                                        codePointRangeToRange)
@@ -50,6 +50,8 @@ nameNameSemanticFromHie hieKind rm ns = do
     nameSemanticFromRefMap rm' name' = do
       spanInfos <- -- traceShow ("getting spans:", nameString) $
         Map.lookup (Right name') rm'
+    --   let combinedFunction x = (identType . snd) x <|> (identInfo . snd) x
+    --   let result = foldMap (typeSemantic hieKind) $ listToMaybe $ mapMaybe combinedFunction spanInfos
       let typeTokenType = foldMap (typeSemantic hieKind) $ listToMaybe $ mapMaybe (identType . snd) spanInfos
       contextInfoTokenType <- foldMap (contextInfosMaybeTokenType . identInfo . snd) spanInfos
       fold [typeTokenType, Just contextInfoTokenType]

Diff for: plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Utils.hs

@@ -123,18 +123,7 @@ recoverFunMaskArray flattened = unflattened
     go (HTyConApp _ _)             = False
 
 
-realSrcSpanToCodePointRange :: RealSrcSpan -> CodePointRange
-realSrcSpanToCodePointRange real =
-  CodePointRange (realSrcLocToCodePointPosition $ Compat.realSrcSpanStart real)
-        (realSrcLocToCodePointPosition $ Compat.realSrcSpanEnd   real)
-
-
-realSrcLocToCodePointPosition :: RealSrcLoc -> CodePointPosition
-realSrcLocToCodePointPosition real =
-  CodePointPosition (fromIntegral $ srcLocLine real - 1) (fromIntegral $ srcLocCol real - 1)
-
 -- rangeToCodePointRange
--- mkRange :: Int -> Int -> Int -> Range
 mkRange :: (Integral a1, Integral a2) => a1 -> a2 -> a2 -> Range
 mkRange startLine startCol len =
     Range (Position (fromIntegral startLine) (fromIntegral startCol)) (Position (fromIntegral startLine) (fromIntegral $ startCol + len))