mirror of
https://github.com/haskell/haskell-ide-engine.git
synced 2024-10-26 11:18:42 +03:00
88 lines
3.4 KiB
Haskell
88 lines
3.4 KiB
Haskell
module Haskell.Ide.Engine.Context where
|
|
|
|
import Data.Generics
|
|
import Language.Haskell.LSP.Types
|
|
import qualified GHC
|
|
import Haskell.Ide.Engine.GhcCompat (GhcPs) -- for GHC 8.2.2
|
|
import Haskell.Ide.Engine.PluginUtils
|
|
import Control.Applicative ( (<|>) )
|
|
|
|
-- | A context of a declaration in the program
|
|
-- e.g. is the declaration a type declaration or a value declaration
|
|
-- Used for determining which code completions to show
|
|
-- TODO: expand this with more contexts like classes or instances for
|
|
-- smarter code completion
|
|
data Context = TypeContext
|
|
| ValueContext
|
|
| ModuleContext String -- ^ module context with module name
|
|
| ImportContext String -- ^ import context with module name
|
|
| ImportListContext String -- ^ import list context with module name
|
|
| ImportHidingContext String -- ^ import hiding context with module name
|
|
| ExportContext -- ^ List of exported identifiers from the current module
|
|
deriving (Show, Eq)
|
|
|
|
-- | Generates a map of where the context is a type and where the context is a value
|
|
-- i.e. where are the value decls and the type decls
|
|
getContext :: Position -> GHC.ParsedModule -> Maybe Context
|
|
getContext pos pm
|
|
| Just (GHC.L (GHC.RealSrcSpan r) modName) <- moduleHeader
|
|
, pos `isInsideRange` r
|
|
= Just (ModuleContext (GHC.moduleNameString modName))
|
|
|
|
| Just (GHC.L (GHC.RealSrcSpan r) _) <- exportList
|
|
, pos `isInsideRange` r
|
|
= Just ExportContext
|
|
|
|
| Just ctx <- something (Nothing `mkQ` go `extQ` goInline) decl
|
|
= Just ctx
|
|
|
|
| Just ctx <- something (Nothing `mkQ` importGo) imports
|
|
= Just ctx
|
|
|
|
| otherwise
|
|
= Nothing
|
|
|
|
where decl = GHC.hsmodDecls $ GHC.unLoc $ GHC.pm_parsed_source pm
|
|
moduleHeader = GHC.hsmodName $ GHC.unLoc $ GHC.pm_parsed_source pm
|
|
exportList = GHC.hsmodExports $ GHC.unLoc $ GHC.pm_parsed_source pm
|
|
imports = GHC.hsmodImports $ GHC.unLoc $ GHC.pm_parsed_source pm
|
|
|
|
go :: GHC.LHsDecl GhcPs -> Maybe Context
|
|
go (GHC.L (GHC.RealSrcSpan r) GHC.SigD {})
|
|
| pos `isInsideRange` r = Just TypeContext
|
|
| otherwise = Nothing
|
|
go (GHC.L (GHC.RealSrcSpan r) GHC.ValD {})
|
|
| pos `isInsideRange` r = Just ValueContext
|
|
| otherwise = Nothing
|
|
go _ = Nothing
|
|
|
|
goInline :: GHC.LHsType GhcPs -> Maybe Context
|
|
goInline (GHC.L (GHC.RealSrcSpan r) _)
|
|
| pos `isInsideRange` r = Just TypeContext
|
|
| otherwise = Nothing
|
|
goInline _ = Nothing
|
|
|
|
p `isInsideRange` r = sp <= p && p <= ep
|
|
where (sp, ep) = unpackRealSrcSpan r
|
|
|
|
importGo :: GHC.LImportDecl GhcPs -> Maybe Context
|
|
importGo (GHC.L (GHC.RealSrcSpan r) impDecl)
|
|
| pos `isInsideRange` r
|
|
= importInline importModuleName (GHC.ideclHiding impDecl)
|
|
<|> Just (ImportContext importModuleName)
|
|
|
|
| otherwise = Nothing
|
|
where importModuleName = GHC.moduleNameString $ GHC.unLoc $ GHC.ideclName impDecl
|
|
|
|
importGo _ = Nothing
|
|
|
|
importInline :: String -> Maybe (Bool, GHC.Located [GHC.LIE GhcPs]) -> Maybe Context
|
|
importInline modName (Just (True, GHC.L (GHC.RealSrcSpan r) _))
|
|
| pos `isInsideRange` r = Just $ ImportHidingContext modName
|
|
| otherwise = Nothing
|
|
importInline modName (Just (False, GHC.L (GHC.RealSrcSpan r) _))
|
|
| pos `isInsideRange` r = Just $ ImportListContext modName
|
|
| otherwise = Nothing
|
|
importInline _ _ = Nothing
|
|
|