never executed always true always false

    1 module Conjure.LSP.Handlers.SemanticTokens where
    2 
    3 import Conjure.LSP.Util (ProcessedFile (ProcessedFile), sendErrorMessage, sourcePosToPosition, withProcessedDoc)
    4 import Conjure.Language.Lexer (ETok (..), Offsets (..), trueLength)
    5 import Conjure.Language.Validator (TagType (..), TaggedToken (TaggedToken), ValidatorState (symbolCategories))
    6 import Conjure.Prelude
    7 import Control.Lens
    8 import Data.Map qualified as M
    9 import Language.LSP.Protocol.Lens (HasParams (..), HasTextDocument (..))
   10 import Language.LSP.Protocol.Message
   11 import Language.LSP.Protocol.Types
   12 import Language.LSP.Server (Handlers, LspM, requestHandler)
   13 
   14 semanticTokensHandler :: Handlers (LspM ())
   15 semanticTokensHandler = semanticTokensHandlerFull
   16 
   17 semanticTokensHandlerFull :: Handlers (LspM ())
   18 semanticTokensHandlerFull = requestHandler SMethod_TextDocumentSemanticTokensFull $ \req res -> do
   19   let ps = req ^. params . textDocument
   20   withProcessedDoc ps $ \(ProcessedFile _ _ (symbolCategories -> ts) _) -> do
   21     let toks = mapMaybe createSemanticToken (sortOn (\(TaggedToken _ (oTrueStart . offsets -> e)) -> e) $ M.elems ts)
   22     let sToks = makeSemanticTokens defaultSemanticTokensLegend toks
   23     r <- case sToks of
   24       Left txt -> sendErrorMessage txt >> return (Right $ InR Null)
   25       Right st -> return . Right . InL $ st
   26     res r
   27 
   28 createSemanticToken :: TaggedToken -> Maybe SemanticTokenAbsolute
   29 createSemanticToken (TaggedToken tt tok) =
   30   uncurry (SemanticTokenAbsolute ln col len) <$> symbolType tt
   31   where
   32     Position ln col = sourcePosToPosition (oSourcePos . offsets $ tok)
   33     len = fromInteger . toInteger . trueLength $ tok
   34     symbolType :: TagType -> Maybe (SemanticTokenTypes, [SemanticTokenModifiers])
   35     symbolType s = case s of
   36       TtType -> Just (SemanticTokenTypes_Type, [SemanticTokenModifiers_DefaultLibrary])
   37       TtNumber -> Just (SemanticTokenTypes_Number, [])
   38       TtBool -> Just (SemanticTokenTypes_Regexp, [])
   39       TtDomain -> Just (SemanticTokenTypes_Class, [SemanticTokenModifiers_Abstract])
   40       TtEnum -> Just (SemanticTokenTypes_Enum, [SemanticTokenModifiers_Abstract])
   41       TtEnumMember -> Just (SemanticTokenTypes_EnumMember, [])
   42       TtRecord -> Just (SemanticTokenTypes_Struct, [])
   43       TtRecordMember -> Just (SemanticTokenTypes_Property, [SemanticTokenModifiers_Readonly])
   44       TtUserFunction -> Just (SemanticTokenTypes_Function, [])
   45       TtFunction -> Just (SemanticTokenTypes_Function, [SemanticTokenModifiers_DefaultLibrary])
   46       TtAttribute -> Just (SemanticTokenTypes_Variable, [SemanticTokenModifiers_Readonly])
   47       TtAAC -> Just (SemanticTokenTypes_Interface, [])
   48       TtVariable -> Just (SemanticTokenTypes_Variable, [])
   49       TtKeyword -> Just (SemanticTokenTypes_Keyword, [])
   50       TtQuantifier -> Just (SemanticTokenTypes_Macro, [])
   51       TtSubKeyword -> Just (SemanticTokenTypes_Modifier, [])
   52       TtOperator -> Just (SemanticTokenTypes_Operator, [])
   53       TtLocal -> Just (SemanticTokenTypes_Parameter, [])
   54       TtOther _ -> Nothing