working highlighting

datalog-lsp/src/Datalog/LSP/Highlight.hs

@@ -12,6 +12,7 @@ import Language.LSP.Server
 import Text.Megaparsec
 import Language.LSP.VFS (virtualFileText)
 import Datalog.Parser (parseProgram)
+import qualified Data.Text as T
 
 tokenHandler :: Handlers (LspM ())
 tokenHandler = requestHandler SMethod_TextDocumentSemanticTokensFull $ \req responder -> do
@@ -34,7 +35,20 @@ highlightRule (Rule _ a as) = a : as >>= highlightAtom
 
 highlightAtom :: Atom' SrcLoc -> [SemanticTokenAbsolute]
 highlightAtom (Atom loc (RelId relId) ts) = highlightRel ++ (ts >>= highlightTerm) where
-    highlightRel = []
+    highlightRel =
+        [ SemanticTokenAbsolute
+            { _line = unPos' startLine - 1
+            , _startChar = unPos' startCol - 1
+            , _length = fromIntegral . length . T.unpack $ relId
+            , _tokenType = SemanticTokenTypes_Interface
+            , _tokenModifiers = []
+            }
+        ]
+        where
+            unPos' = fromIntegral . unPos
+            startLine = sourceLine . start $ loc
+            startCol = sourceColumn . start $ loc
+            stopCol = sourceColumn . end $ loc
 
 getConLoc :: Term' SrcLoc -> SrcLoc
 getConLoc (Con loc _) = loc
@@ -43,12 +57,12 @@ getConLoc (Var loc _) = loc
 highlightTerm :: Term' SrcLoc -> [SemanticTokenAbsolute]
 highlightTerm t =
     [ SemanticTokenAbsolute
-        { _line = unPos' startLine
-        , _startChar = unPos' startCol
+        { _line = unPos' startLine - 1
+        , _startChar = unPos' startCol - 1
         , _length = fromIntegral $ unPos stopCol - unPos startCol
         , _tokenType = case t of
             Con _ _ -> SemanticTokenTypes_Number
-            Var _ _ -> SemanticTokenTypes_Variable
+            Var _ _ -> SemanticTokenTypes_Keyword
         , _tokenModifiers = []
         }
     ]

test.dl

@@ -0,0 +1,11 @@
+odd(X,Y) :- r(X,Y).
+odd(X,Y) :- even(X,Z), r(Z,Y).
+even(X,Y) :- odd(X,Z), r(Z,Y).
+
+r(0,1).
+r(1,2).
+r(2,3).
+r(3,4).
+r(4,5).
+
+r(X,Y) :- r(Y,X).