never executed always true always false

    1 module Conjure.LSP.Handlers.SemanticTokens where
    2 import Language.LSP.Server (requestHandler, LspM, Handlers)
    3 import qualified Language.LSP.Types as T
    4 import Control.Lens
    5 import Conjure.Prelude
    6 import Conjure.LSP.Util (withProcessedDoc, ProcessedFile (ProcessedFile), sourcePosToPosition,  sendErrorMessage)
    7 import Conjure.Language.Validator (ValidatorState (symbolCategories), TaggedToken (TaggedToken), TagType (..))
    8 import Language.LSP.Types.Lens (HasParams(..), HasTextDocument (textDocument))
    9 import Conjure.Language.Lexer (ETok(..), Offsets (..), trueLength)
   10 import Language.LSP.Types (SemanticTokenTypes(..), SemanticTokenModifiers (..))
   11 import qualified Data.Map as M
   12 
   13 semanticTokensHandler :: Handlers (LspM ())
   14 semanticTokensHandler = semanticTokensHandlerFull
   15 
   16 
   17 semanticTokensHandlerFull :: Handlers (LspM ())
   18 semanticTokensHandlerFull = requestHandler T.STextDocumentSemanticTokensFull $ \ 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         -- sendInfoMessage . pack $  "Got semantic tokens req : " ++ show toks
   23         let sToks = T.makeSemanticTokens def toks
   24         r <-case sToks of
   25           Left txt -> sendErrorMessage txt >> return (Right Nothing)
   26           Right st -> return . Right . pure $ st
   27         res r
   28 
   29 
   30 createSemanticToken :: TaggedToken -> Maybe T.SemanticTokenAbsolute
   31 createSemanticToken (TaggedToken tt tok) = 
   32   (uncurry (T.SemanticTokenAbsolute ln col len)) <$> symbolType tt
   33   where
   34     T.Position ln col = sourcePosToPosition (oSourcePos . offsets $ tok)
   35     len = fromInteger . toInteger . trueLength  $ tok
   36     symbolType :: TagType -> Maybe (T.SemanticTokenTypes,[T.SemanticTokenModifiers])
   37     symbolType s = case s of
   38       TtType -> Just (SttType,[StmDefaultLibrary])
   39       TtNumber -> Just (SttNumber,[])
   40       TtBool -> Just (SttRegexp,[])
   41       TtDomain -> Just (SttClass,[StmAbstract])
   42       TtEnum -> Just (SttEnum,[StmAbstract])
   43       TtEnumMember -> Just (SttEnumMember,[])
   44       TtRecord -> Just (SttStruct,[])
   45       TtRecordMember -> Just (SttProperty,[StmReadonly])
   46       TtUserFunction -> Just (SttFunction,[])
   47       TtFunction -> Just (SttFunction,[StmDefaultLibrary])
   48       TtAttribute -> Just (SttVariable,[StmReadonly])
   49       TtAAC -> Just (SttInterface,[])
   50       TtVariable -> Just (SttVariable,[])
   51       TtKeyword -> Just (SttKeyword,[])
   52       TtQuantifier -> Just (SttMacro,[])
   53       TtSubKeyword -> Just (SttModifier,[])
   54       TtOperator -> Just (SttOperator,[])
   55       TtLocal -> Just (SttParameter,[])
   56       TtOther _ -> Nothing
   57