never executed always true always false
1 module Conjure.LSP.Handlers.Suggestions (suggestionHandler) where
2
3 import Conjure.LSP.Util (ProcessedFile (ProcessedFile), getNextTokenStart, positionToSourcePos, sourcePosToPosition, withProcessedDoc, getRelevantRegions)
4 import Conjure.Language (Type (..))
5 import Conjure.Language.AST.Reformer
6 -- (Class (..), Kind (..), RegionInfo (..), ValidatorState (regionInfo), RegionType (..), StructuralType (..),symbolTable)
7
8 import Conjure.Language.AST.Syntax (LToken (MissingToken))
9 import Conjure.Language.Lexemes
10 import Conjure.Language.Lexer
11 import Conjure.Language.Pretty (prettyT)
12 import Conjure.Language.Validator
13 import Conjure.Prelude
14 import Control.Lens
15 import Language.LSP.Server (Handlers, LspM, requestHandler)
16 import Language.LSP.Types (SMethod(STextDocumentCompletion),type (|?) (..), CompletionItem (..), CompletionItemKind (..))
17 import qualified Language.LSP.Types as T
18 import Language.LSP.Types.Lens (HasParams (..), HasTextDocument (textDocument), HasPosition (position))
19 import qualified Data.Map.Strict as Map
20 import Text.Megaparsec (SourcePos)
21
22 suggestionHandler :: Handlers (LspM ())
23 suggestionHandler = requestHandler STextDocumentCompletion $ \req res -> do
24 let ps = req ^. params . textDocument
25 let context = req ^. params . position
26 withProcessedDoc ps $ \(ProcessedFile _ diags valState pt) -> do
27 let nextTStart = getNextTokenStart context pt
28 let roi = getRelevantRegions valState nextTStart
29 let innermostSymbolTable = if null roi then [] else Map.toList . rTable $ last roi
30 let errors = [(r, d) | (ValidatorDiagnostic r (Error (TokenError d))) <- diags]
31 let contextTokens = take 1 [lexeme w | (r, MissingToken w) <- errors, isInRange nextTStart r]
32 let missingTokenBasedHint = missingToSuggestion innermostSymbolTable contextTokens
33 -- sendInfoMessage $ pack . show $ context
34 let tlSymbol = getLowestLevelTaggedRegion (positionToSourcePos context) $ makeTree pt
35 let tlSymbolSuggestion = case tlSymbol of
36 Just (TIDomain _) -> makeDomainSuggestions innermostSymbolTable
37 Just (TIExpression _) -> makeExpressionSuggestions innermostSymbolTable
38 Just (TIList t) -> makeTagSuggestions innermostSymbolTable t
39 _ -> [] -- or for debugging -> [defaultCompletion $ pack . show $ tlSymbol]
40 res $
41 Right $
42 InL . T.List $ nubBy isSameInsertion $
43 concat
44 [ missingTokenBasedHint,
45 tlSymbolSuggestion,
46 keywordCompletions
47 ]
48 isSameInsertion :: CompletionItem -> CompletionItem -> Bool
49 isSameInsertion CompletionItem{_label=a} CompletionItem{_label=b} = a == b
50
51 isInRange :: T.Position -> DiagnosticRegion -> Bool
52 isInRange p reg = sourcePosToPosition (drSourcePos reg) == p
53
54 makeSuggestionsFromSymbolTable :: [(Text, SymbolTableValue)] -> [CompletionItem]
55 makeSuggestionsFromSymbolTable = map symbolToHint
56
57 makeDomainSuggestions :: [(Text, SymbolTableValue)] -> [CompletionItem]
58 makeDomainSuggestions table = stDomains ++ newDomainPlaceholders
59 where
60 stDomains = map symbolToHint $ [x | x@(_, (_, _, Kind DomainType t)) <- table, typesUnifyS [t, TypeAny]]
61 newDomainPlaceholders =
62 uncurry snippetCompletion
63 <$> [ ("int", "int"),
64 ("int", "bool"),
65 ("matrix", "matrix indexed by ${1:[index_domains]} of ${2:type}"),
66 ("set", "set of $1"),
67 ("mset", "mset of $1")
68 ]
69
70 makeExpressionSuggestions :: [(Text, SymbolTableValue)] -> [CompletionItem]
71 makeExpressionSuggestions table = stExprs ++ newExpressionPlaceholders
72 where
73 stExprs = map symbolToHint $ [x | x@(_, (_, _, Kind ValueType {} t)) <- table, typesUnifyS [t, TypeAny]]
74 newExpressionPlaceholders = []
75
76 makeTagSuggestions :: [(Text, SymbolTableValue)] -> ListItemClasses -> [CompletionItem]
77 makeTagSuggestions table tag = case tag of
78 ICAttribute -> defaultCompletion <$> ["size"]
79 ICExpression -> makeExpressionSuggestions table
80 ICDomain -> makeDomainSuggestions table
81 ICRange -> uncurry snippetCompletion <$> [("openL", "..$1"), ("closed", "$1..$2"), ("openR", "$1..")]
82 ICIdentifier -> freeIdentifierSuggestion table
83 ICStatement -> topLevelSuggestions
84
85 symbolToHint :: (Text, SymbolTableValue) -> CompletionItem
86 symbolToHint (name, (_, _, k)) =
87 let typeName = prettyT k
88 in (defaultCompletion name) {_detail = Just typeName, _kind = pure $ getCIKind k}
89
90 getCIKind :: Kind -> CompletionItemKind
91 getCIKind (Kind DomainType _) = CiClass
92 getCIKind (Kind ValueType {} t) = case t of
93 TypeAny -> CiVariable
94 TypeBool -> CiVariable
95 TypeInt _ -> CiVariable
96 TypeEnum _ -> CiEnum
97 TypeUnnamed _ -> CiVariable
98 TypeTuple _ -> CiVariable
99 TypeRecord _ -> CiVariable
100 TypeRecordMember _ _ -> CiEnumMember
101 TypeVariant _ -> CiVariable
102 TypeVariantMember _ _ -> CiEnumMember
103 TypeList _ -> CiVariable
104 TypeMatrix _ _ -> CiVariable
105 TypeSet _ -> CiVariable
106 TypeMSet _ -> CiVariable
107 TypeFunction _ _ -> CiVariable
108 TypeSequence _ -> CiVariable
109 TypeRelation _ -> CiVariable
110 TypePartition _ -> CiVariable
111
112 snippetCompletion :: Text -> Text -> CompletionItem
113 snippetCompletion label snippet = (defaultCompletion label) {_kind = pure CiSnippet, _insertText = pure snippet, _insertTextFormat = pure T.Snippet}
114
115 defaultCompletion :: Text -> CompletionItem
116 defaultCompletion n =
117 CompletionItem
118 n
119 Nothing
120 Nothing
121 Nothing
122 Nothing
123 Nothing
124 Nothing
125 Nothing
126 Nothing
127 Nothing
128 Nothing
129 Nothing
130 Nothing
131 Nothing
132 Nothing
133 Nothing
134 Nothing
135
136 --
137 missingToSuggestion :: [(Text, SymbolTableValue)] -> [Lexeme] -> [CompletionItem]
138 missingToSuggestion table (x : _) = makeMissingTokenHint x
139 where
140 makeMissingTokenHint (L_Missing s) = case s of
141 MissingExpression -> makeExpressionSuggestions table
142 MissingDomain -> makeDomainSuggestions table
143 MissingUnknown -> []
144 makeMissingTokenHint LMissingIdentifier = freeIdentifierSuggestion table
145 makeMissingTokenHint l = [defaultCompletion $ lexemeText l]
146 missingToSuggestion table _ = makeSuggestionsFromSymbolTable table
147
148 keywordCompletions :: [CompletionItem]
149 keywordCompletions = []
150
151 getLowestLevelTaggedRegion :: SourcePos -> HLTree -> Maybe TreeItemLinks
152 getLowestLevelTaggedRegion p tr =
153 let regs = filterContaining p tr
154 in case [t | HLTagged t _ <- regs, t /= TIGeneral] of
155 [] -> Nothing
156 ins -> Just $ last ins
157
158 topLevelSuggestions :: [CompletionItem]
159 topLevelSuggestions =
160 uncurry snippetCompletion
161 <$> [ ("find", "find $1 : $2"),
162 ("given", "such that $0"),
163 ("such that", "given $1 : $2")
164 ]
165
166 freeIdentifierSuggestion :: a -> [CompletionItem]
167 freeIdentifierSuggestion _ = [defaultCompletion "identifier"]