Merge pull request #97 from fwcd/local-ident-lookup

Resolve local identifiers in definition lookups, hover etc.

Author: fwcd

src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs

@@ -22,7 +22,7 @@ import Curry.LanguageServer.Utils.Lookup (findScopeAtPos)
 import Curry.LanguageServer.Utils.Uri (normalizeUriWithPath)
 import Curry.LanguageServer.Utils.VFS (PosPrefixInfo (..), getCompletionPrefix)
 import Curry.LanguageServer.Monad (LSM)
-import Data.Bifunctor (first)
+import Data.Bifunctor (Bifunctor (..))
 import Data.List.Extra (nubOrdOn)
 import qualified Data.Map as M
 import Data.Maybe (maybeToList, fromMaybe, isNothing)
@@ -33,6 +33,7 @@ import qualified Language.LSP.Protocol.Types as J
 import qualified Language.LSP.Protocol.Lens as J
 import qualified Language.LSP.Protocol.Message as J
 import Language.LSP.Server (MonadLsp)
+import qualified Curry.Base.Ident as CI
 
 completionHandler :: S.Handlers LSM
 completionHandler = S.requestHandler J.SMethod_TextDocumentCompletion $ \req responder -> do
@@ -102,8 +103,8 @@ importCompletions opts store query = do
 
 generalCompletions :: (MonadIO m, MonadLsp CFG.Config m) => CompletionOptions -> I.ModuleStoreEntry -> I.IndexStore -> PosPrefixInfo -> m [J.CompletionItem]
 generalCompletions opts entry store query = do
-    let localIdentifiers   = join <$> maybe M.empty (`findScopeAtPos` query.cursorPos) entry.moduleAST
-        localIdentifiers'  = M.fromList $ map (first ppToText) $ M.toList localIdentifiers
+    let localIdentifiers   = M.fromList . map (second join . snd) . M.toList $ maybe M.empty (`findScopeAtPos` query.cursorPos) entry.moduleAST
+        localIdentifiers'  = M.mapKeys ppToText (localIdentifiers :: M.Map CI.Ident (Maybe CT.PredType))
         localCompletions   = toMatchingCompletions opts query $ uncurry Local <$> M.toList localIdentifiers'
         symbols            = filter (flip M.notMember localIdentifiers' . (.ident)) $ nubOrdOn (.qualIdent)
                                                                                     $ I.storedSymbolsWithPrefix query.prefixText store

src/Curry/LanguageServer/Handlers/TextDocument/References.hs

@@ -10,7 +10,7 @@ import Control.Monad.Trans (MonadTrans (..))
 import Control.Monad.Trans.Maybe (MaybeT (..))
 import qualified Curry.LanguageServer.Config as CFG
 import Curry.LanguageServer.Monad (LSM, getStore)
-import Curry.LanguageServer.Utils.Convert (ppToText, currySpanInfo2Location)
+import Curry.LanguageServer.Utils.Convert (currySpanInfo2Location)
 import Curry.LanguageServer.Utils.General (liftMaybe, (<.$>), joinFst)
 import Curry.LanguageServer.Utils.Logging (debugM, infoM)
 import Curry.LanguageServer.Utils.Sema (ModuleAST)

src/Curry/LanguageServer/Index/Resolve.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE NoFieldSelectors #-}
 -- | Lookup and resolution with the index.
 module Curry.LanguageServer.Index.Resolve
     ( resolveAtPos
@@ -9,16 +10,23 @@ import qualified Curry.Base.Ident as CI
 import qualified Curry.Syntax as CS
 
 import Control.Applicative (Alternative ((<|>)))
+import Control.Monad (join, when)
+import Control.Monad.Trans.Maybe (MaybeT(..))
 import qualified Curry.LanguageServer.Index.Store as I
 import qualified Curry.LanguageServer.Index.Symbol as I
-import Curry.LanguageServer.Utils.Convert (currySpanInfo2Range)
+import Curry.LanguageServer.Index.Symbol (Symbol (..))
+import Curry.LanguageServer.Utils.Convert (currySpanInfo2Range, currySpanInfo2Location, ppToText)
 import Curry.LanguageServer.Utils.Sema (ModuleAST)
-import Curry.LanguageServer.Utils.Lookup (findQualIdentAtPos, findModuleIdentAtPos)
+import Curry.LanguageServer.Utils.Lookup (findQualIdentAtPos, findModuleIdentAtPos, findScopeAtPos)
 import qualified Language.LSP.Protocol.Types as J
+import Data.Default (Default(def))
+import qualified Data.Map as M
+import System.IO.Unsafe (unsafePerformIO)
 
 -- | Resolves the identifier at the given position.
 resolveAtPos :: I.IndexStore -> ModuleAST -> J.Position -> Maybe ([I.Symbol], J.Range)
-resolveAtPos store ast pos =  resolveQualIdentAtPos   store ast pos
+resolveAtPos store ast pos =  resolveLocalIdentAtPos        ast pos
+                          <|> resolveQualIdentAtPos   store ast pos
                           <|> resolveModuleIdentAtPos store ast pos
 
 -- | Resolves the qualified identifier at the given position.
@@ -37,6 +45,25 @@ resolveModuleIdentAtPos store ast pos = do
     let symbols = resolveModuleIdent store mid
     return (symbols, range)
 
+-- | Resolves the local identifier at the given position.
+resolveLocalIdentAtPos :: ModuleAST -> J.Position -> Maybe ([I.Symbol], J.Range)
+resolveLocalIdentAtPos ast pos = do
+    let scope = findScopeAtPos ast pos
+    (qid, spi) <- findQualIdentAtPos ast pos
+    range <- currySpanInfo2Range spi
+    let symbols = [def { ident = ppToText lid
+                       , qualIdent = ppToText lid
+                       , printedType = ppToText <$> join lty
+                       , location = unsafePerformIO (runMaybeT (currySpanInfo2Location lid)) -- SAFETY: We expect this conversion to be pure
+                       }
+                  | (_, (lid, lty)) <- M.toList scope
+                  , CI.idName lid == CI.idName (CI.qidIdent qid)
+                  ]
+    -- Fail the computation when no local source identifier could be found
+    when (null symbols)
+        Nothing
+    return (symbols, range)
+
 -- | Resolves the qualified identifier at the given position.
 resolveQualIdent :: I.IndexStore -> ModuleAST -> CI.QualIdent -> [I.Symbol]
 resolveQualIdent store (CS.Module _ _ _ mid _ imps _) qid = do

src/Curry/LanguageServer/Utils/Lookup.hs

@@ -2,16 +2,19 @@
 -- | Position lookup in the AST.
 module Curry.LanguageServer.Utils.Lookup
     ( findQualIdentAtPos
+    , findExprIdentAtPos
     , findModuleIdentAtPos
     , findTypeAtPos
     , findScopeAtPos
+    , showScope
     , Scope
     ) where
 
 -- Curry Compiler Libraries + Dependencies
 import qualified Curry.Base.Ident as CI
 import qualified Curry.Base.SpanInfo as CSPI
 import qualified Curry.Syntax as CS
+import qualified Curry.Base.Position as CP
 
 import Control.Applicative (Alternative ((<|>)))
 import Control.Monad (when)
@@ -28,19 +31,24 @@ import Curry.LanguageServer.Utils.Syntax
     )
 import Curry.LanguageServer.Utils.Sema
     ( HasTypedSpanInfos(typedSpanInfos), TypedSpanInfo )
+import Data.Bifunctor (Bifunctor(..))
 import qualified Data.Map as M
 import qualified Language.LSP.Protocol.Types as J
 
 -- | A collectScope of bound identifiers.
-type Scope a = M.Map CI.Ident (Maybe a)
+type Scope a = M.Map String (CI.Ident, Maybe a)
 
 -- | Finds identifier and (occurrence) span info at a given position.
 findQualIdentAtPos :: CS.Module a -> J.Position -> Maybe (CI.QualIdent, CSPI.SpanInfo)
 findQualIdentAtPos ast pos = qualIdent <|> exprIdent <|> basicIdent
     where qualIdent = withSpanInfo <$> elementAt pos (qualIdentifiers ast)
-          exprIdent = joinFst $ qualIdentifier <.$> withSpanInfo <$> elementAt pos (expressions ast)
+          exprIdent = findExprIdentAtPos ast pos
           basicIdent = CI.qualify <.$> withSpanInfo <$> elementAt pos (identifiers ast)
 
+--- | Finds expression identifier and (occurrence) span info at a given position.
+findExprIdentAtPos :: CS.Module a -> J.Position -> Maybe (CI.QualIdent, CSPI.SpanInfo)
+findExprIdentAtPos ast pos = joinFst $ qualIdentifier <.$> withSpanInfo <$> elementAt pos (expressions ast)
+
 -- | Finds module identifier and (occurrence) span info at a given position.
 findModuleIdentAtPos :: CS.Module a -> J.Position -> Maybe (CI.ModuleIdent, CSPI.SpanInfo)
 findModuleIdentAtPos ast pos = withSpanInfo <$> elementAt pos (moduleIdentifiers ast)
@@ -65,12 +73,17 @@ containsPos x pos = maybe False (rangeElem pos) $ currySpanInfo2Range x
 
 -- | Binds an identifier in the innermost scope.
 bindInScopes :: CI.Ident -> Maybe a -> [Scope a] -> [Scope a]
-bindInScopes i t (sc:scs) = M.insert (CI.unRenameIdent i) t sc : scs
+bindInScopes i t (sc:scs) = M.insert (CI.idName i') (i', t) sc : scs
+    where i' = CI.unRenameIdent i
 bindInScopes _ _ _        = error "Cannot bind without a scope!"
 
+-- | Shows a scope with line numbers (for debugging).
+showScope :: Scope a -> String
+showScope = show . map (second (CP.line . CSPI.getStartPosition . CI.idSpanInfo . fst)) . M.toList
+
 -- | Flattens the given scopes, preferring earlier binds.
 flattenScopes :: [Scope a] -> Scope a
-flattenScopes = foldr M.union M.empty
+flattenScopes = M.unions
 
 -- | Stores nested scopes and a cursor position. The head of the list is always the innermost collectScope.
 data ScopeState a = ScopeState
@@ -98,7 +111,7 @@ updateEnvs :: CSPI.HasSpanInfo e => e -> ScopeM a ()
 updateEnvs (CSPI.getSpanInfo -> spi) = do
     pos <- gets (.position)
     when (spi `containsPos` pos) $
-        modify $ \s -> s { matchingEnv = M.union (flattenScopes s.currentEnv) s.matchingEnv }
+        modify $ \s -> s { matchingEnv = M.union s.matchingEnv (flattenScopes s.currentEnv) }
 
 class CollectScope e a where
     collectScope :: e -> ScopeM a ()