Add different Contexts for Module, import etc...

Author: fendor

haskell-ide-engine.cabal

@@ -177,6 +177,7 @@ test-suite unit-test
   main-is:             Main.hs
   other-modules:       ApplyRefactPluginSpec
                        CodeActionsSpec
+                       ContextSpec
                        DiffSpec
                        ExtensibleStateSpec
                        GhcModPluginSpec
@@ -196,6 +197,7 @@ test-suite unit-test
                      , directory
                      , filepath
                      , free
+                     , ghc
                      , haskell-ide-engine
                      , haskell-lsp-types >= 0.15.0.0
                      , hie-test-utils

hie-plugin-api/Haskell/Ide/Engine/Context.hs

@@ -1,6 +1,8 @@
+{-# LANGUAGE LambdaCase #-}
 module Haskell.Ide.Engine.Context where
 
 import Data.Generics
+import Data.List (find)
 import Language.Haskell.LSP.Types
 import GHC
 import qualified GhcModCore as GM (GhcPs) -- for GHC 8.2.2
@@ -13,13 +15,37 @@ import Haskell.Ide.Engine.PluginUtils
 -- smarter code completion
 data Context = TypeContext
              | ValueContext
+             | ModuleContext String
+             | ImportContext String
+             | ExportContext
   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 -> ParsedModule -> Maybe Context
-getContext pos pm = everything join (Nothing `mkQ` go `extQ` goInline) decl
+getContext pos pm
+  | Just (L (RealSrcSpan r) modName) <- moduleHeader
+  , pos `isInsideRange` r
+  = Just (ModuleContext (moduleNameString modName))
+
+  | Just (L (RealSrcSpan r) _) <- exportList
+  , pos `isInsideRange` r
+  = Just ExportContext
+
+  | Just ctx <- everything join (Nothing `mkQ` go `extQ` goInline) decl
+  = Just ctx
+
+  | Just (L _ impDecl) <- importRegion
+  = Just (ImportContext (moduleNameString $ unLoc $ ideclName impDecl))
+
+  | otherwise
+  = Nothing
+  
   where decl = hsmodDecls $ unLoc $ pm_parsed_source pm
+        moduleHeader = hsmodName $ unLoc $ pm_parsed_source pm
+        exportList = hsmodExports $ unLoc $ pm_parsed_source pm
+        imports = hsmodImports $ unLoc $ pm_parsed_source pm
+
         go :: LHsDecl GM.GhcPs -> Maybe Context
         go (L (RealSrcSpan r) (SigD {}))
           | pos `isInsideRange` r = Just TypeContext
@@ -37,3 +63,11 @@ getContext pos pm = everything join (Nothing `mkQ` go `extQ` goInline) decl
         join (Just x) _ = Just x
         p `isInsideRange` r = sp <= p && p <= ep
           where (sp, ep) = unpackRealSrcSpan r
+
+        importRegion = find
+          (\case
+            (L (RealSrcSpan r) _) -> pos `isInsideRange` r
+            _                     -> False
+          )
+          imports
+

src/Haskell/Ide/Engine/LSP/Completions.hs

@@ -373,6 +373,7 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) =
                 ctxCompls' = case context of
                               TypeContext -> filter isTypeCompl compls
                               ValueContext -> filter (not . isTypeCompl) compls
+                              _ -> []
                 -- Add whether the text to insert has backticks
                 ctxCompls = map (\comp -> comp { isInfix = infixCompls }) ctxCompls'
 

test/testdata/context/ExampleContext.hs

@@ -0,0 +1,8 @@
+module ExampleContext (foo) where
+
+import Data.List
+import Control.Monad
+
+foo :: Int -> Int
+foo xs = xs + 1
+

test/testdata/context/Foo/Bar.hs

@@ -0,0 +1,3 @@
+module Foo.Bar where
+
+

test/unit/ContextSpec.hs

@@ -0,0 +1,112 @@
+{-# LANGUAGE OverloadedStrings #-}
+module ContextSpec where
+
+
+import           Test.Hspec
+
+import           GHC                            ( tm_parsed_module )
+import           System.Directory
+
+import           Haskell.Ide.Engine.PluginApi
+import           Haskell.Ide.Engine.PluginsIdeMonads
+import           Haskell.Ide.Engine.PluginUtils
+import           Haskell.Ide.Engine.ModuleCache
+import           Haskell.Ide.Engine.Context
+
+import           TestUtils
+
+spec :: Spec
+spec = describe "Context of different cursor positions" $ do
+    it "can set the module as type checked"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+              fp <- makeAbsolute "./ExampleContext.hs"
+              let arg = filePathToUri fp
+              let res = IdeResultOk (Nothing :: Maybe Context)
+              actual <- runSingle (IdePlugins mempty) $ do
+                  _ <- setTypecheckedModule arg
+                  return $ IdeResultOk Nothing
+
+              actual `shouldBe` res
+
+    it "module header context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+              fp_ <- makeAbsolute "./ExampleContext.hs"
+              let res = IdeResultOk (Just (ModuleContext "ExampleContext"))
+
+              actual <- getContextAt fp_ (toPos (1, 10))
+
+              actual `shouldBe` res
+
+
+    it "module export list context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+              fp_ <- makeAbsolute "./ExampleContext.hs"
+              let res = IdeResultOk (Just ExportContext)
+              actual <- getContextAt fp_ (toPos (1, 24))
+
+              actual `shouldBe` res
+
+    it "value context" $ withCurrentDirectory "./test/testdata/context" $ do
+        fp_ <- makeAbsolute "./ExampleContext.hs"
+        let res = IdeResultOk (Just ValueContext)
+        actual <- getContextAt fp_ (toPos (7, 6))
+
+        actual `shouldBe` res
+
+    it "value context" $ withCurrentDirectory "./test/testdata/context" $ do
+        fp_ <- makeAbsolute "./ExampleContext.hs"
+        let res = IdeResultOk (Just ValueContext)
+        actual <- getContextAt fp_ (toPos (7, 12))
+
+        actual `shouldBe` res
+
+    it "import context" $ withCurrentDirectory "./test/testdata/context" $ do
+        fp_ <- makeAbsolute "./ExampleContext.hs"
+        let res = IdeResultOk (Just (ImportContext "Data.List"))
+        actual <- getContextAt fp_ (toPos (3, 8))
+
+        actual `shouldBe` res
+
+    it "function declaration context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+              fp_ <- makeAbsolute "./ExampleContext.hs"
+              let res = IdeResultOk (Just TypeContext)
+              actual <- getContextAt fp_ (toPos (6, 1))
+
+              actual `shouldBe` res
+
+
+    it "function definition context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+              fp_ <- makeAbsolute "./ExampleContext.hs"
+              let res = IdeResultOk (Just ValueContext)
+              actual <- getContextAt fp_ (toPos (7, 1))
+              actual `shouldBe` res
+
+    it "function signature context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+              fp_ <- makeAbsolute "./ExampleContext.hs"
+              let res = IdeResultOk (Just TypeContext)
+              actual <- getContextAt fp_ (toPos (6, 8))
+              actual `shouldBe` res
+
+    it "nothing" $ withCurrentDirectory "./test/testdata/context" $ do
+        fp_ <- makeAbsolute "./ExampleContext.hs"
+        let res = IdeResultOk Nothing
+        actual <- getContextAt fp_ (toPos (2, 1))
+        actual `shouldBe` res
+
+getContextAt :: [Char] -> Position -> IO (IdeResult (Maybe Context))
+getContextAt fp_ pos = do
+    let arg = filePathToUri fp_
+    runSingle (IdePlugins mempty) $ do
+        _ <- setTypecheckedModule arg
+        pluginGetFile "getContext: " arg $ \fp ->
+            ifCachedModuleAndData fp (IdeResultOk Nothing) $ \tm _ () ->
+                return $ IdeResultOk $ getContext pos (tm_parsed_module tm)