Add different Contexts for Module, import etc...

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

@@ -5,6 +5,7 @@ import Language.Haskell.LSP.Types
 import GHC
 import qualified GhcModCore as GM (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
@@ -13,27 +14,74 @@ import Haskell.Ide.Engine.PluginUtils
 -- 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 -> 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 <- something (Nothing `mkQ` go `extQ` goInline) decl
+  = Just ctx
+
+  | Just ctx <- something (Nothing `mkQ` importGo) imports
+  = Just ctx
+
+  | 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 {}))
+        go (L (RealSrcSpan r) SigD {})
           | pos `isInsideRange` r = Just TypeContext
           | otherwise = Nothing
-        go (L (GHC.RealSrcSpan r) (GHC.ValD {}))
+        go (L (GHC.RealSrcSpan r) GHC.ValD {})
           | pos `isInsideRange` r = Just ValueContext
           | otherwise = Nothing
         go _ = Nothing
+
         goInline :: GHC.LHsType GM.GhcPs -> Maybe Context
         goInline (GHC.L (GHC.RealSrcSpan r) _)
           | pos `isInsideRange` r = Just TypeContext
           | otherwise = Nothing
         goInline _ = Nothing
-        join Nothing x = x
-        join (Just x) _ = Just x
+
         p `isInsideRange` r = sp <= p && p <= ep
           where (sp, ep) = unpackRealSrcSpan r
+
+        importGo :: GHC.LImportDecl GM.GhcPs -> Maybe Context
+        importGo (L (RealSrcSpan r) impDecl)
+          | pos `isInsideRange` r
+          = importInline importModuleName (ideclHiding impDecl)
+          <|> Just (ImportContext importModuleName)
+
+          | otherwise = Nothing
+          where importModuleName = moduleNameString $ unLoc $ ideclName impDecl
+
+        importGo _ = Nothing
+
+        importInline :: String -> Maybe (Bool,  GHC.Located [GHC.LIE GM.GhcPs]) -> Maybe Context
+        importInline modName (Just (True, L (RealSrcSpan r) _))
+          | pos `isInsideRange` r = Just $ ImportHidingContext modName
+          | otherwise = Nothing
+        importInline modName (Just (False, L (RealSrcSpan r) _))
+          | pos `isInsideRange` r = Just $ ImportListContext modName
+          | otherwise = Nothing
+        importInline _ _ = Nothing
+

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
+                              _ -> 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,20 @@
+module ExampleContext (foo) where
+
+import Data.List (find)
+import Control.Monad hiding (fix)
+
+foo :: Int -> Int
+foo xs = bar xs + 1
+    where
+        bar :: Int -> Int
+        bar x = x + 2
+
+data Foo a = Foo a 
+    deriving (Show)
+
+class Bar a where
+    bar :: a -> Integer
+
+instance Integral a => Bar (Foo a) where
+    bar (Foo a) = toInteger a
+

test/testdata/context/Foo/Bar.hs

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

test/unit/ContextSpec.hs

@@ -0,0 +1,250 @@
+{-# 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 addition 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 "import list context" $ withCurrentDirectory "./test/testdata/context" $ do
+        fp <- makeAbsolute "./ExampleContext.hs"
+        let res = IdeResultOk (Just (ImportListContext "Data.List"))
+        actual <- getContextAt fp (toPos (3, 20))
+
+        actual `shouldBe` res
+
+    it "import hiding context" $ withCurrentDirectory "./test/testdata/context" $ do
+        fp <- makeAbsolute "./ExampleContext.hs"
+        let res = IdeResultOk (Just (ImportHidingContext "Control.Monad"))
+        actual <- getContextAt fp (toPos (4, 32))
+
+        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 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 "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
+
+    -- This is interesting, the context for this is assumed to be ValueContext
+    -- although the cursor is at the signature of a function in a where clause.
+    -- Reason is probably that we only traverse the AST until we know that
+    -- that we are in a ValueContext, however, within a ValueContext, another
+    -- TypeContext may arise, like in this case.
+    it "inner function declaration context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+            fp <- makeAbsolute "./ExampleContext.hs"
+            let res = IdeResultOk (Just ValueContext)
+            actual <- getContextAt fp (toPos (9, 10))
+            actual `shouldBe` res
+
+    it "inner function value context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+            fp <- makeAbsolute "./ExampleContext.hs"
+            let res = IdeResultOk (Just ValueContext)
+            actual <- getContextAt fp (toPos (10, 10))
+            actual `shouldBe` res
+
+
+    -- Declare a datatype, is Nothing, could be DataContext
+    it "data declaration context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+            fp <- makeAbsolute "./ExampleContext.hs"
+            let res = IdeResultOk Nothing
+            actual <- getContextAt fp (toPos (12, 8))
+            actual `shouldBe` res
+
+    -- Define a datatype.
+    it "data definition context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+            fp <- makeAbsolute "./ExampleContext.hs"
+            let res = IdeResultOk (Just TypeContext)
+            actual <- getContextAt fp (toPos (12, 18))
+            actual `shouldBe` res
+
+    -- Declaration of a class. Should be something with types.
+    it "class declaration context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+            fp <- makeAbsolute "./ExampleContext.hs"
+            let res = IdeResultOk Nothing
+            actual <- getContextAt fp (toPos (15, 8))
+            actual `shouldBe` res
+
+    -- Function signature in class declaration.
+    -- Ought to be TypeContext
+    it "class declaration function sig context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+            fp <- makeAbsolute "./ExampleContext.hs"
+            let res = IdeResultOk Nothing
+            actual <- getContextAt fp (toPos (16, 7))
+            actual `shouldBe` res
+
+    it "instance declaration context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+            fp <- makeAbsolute "./ExampleContext.hs"
+            let res = IdeResultOk Nothing
+            actual <- getContextAt fp (toPos (18, 7))
+            actual `shouldBe` res
+
+    -- Function definition in an instance declaration
+    -- Should be ValueContext, but nothing is fine, too for now
+    it "instance declaration function def context"
+            $ withCurrentDirectory "./test/testdata/context"
+            $ do
+                fp <- makeAbsolute "./ExampleContext.hs"
+                let res = IdeResultOk Nothing
+                actual <- getContextAt fp (toPos (19, 6))
+                actual `shouldBe` res
+
+    -- This seems plain wrong, if the cursor is on the String "deriving",
+    -- we would expect the context to be DerivingContext, but it is not.
+    -- May require investigation if this is important.
+    it "deriving context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+            fp <- makeAbsolute "./ExampleContext.hs"
+            let res = IdeResultOk Nothing
+            actual <- getContextAt fp (toPos (13, 9))
+            actual `shouldBe` res
+
+    -- Cursor is directly before the open parenthesis of a deriving clause.
+    -- E.g. deriving (...)
+    --               ^---- cursor is here
+    -- Context is still Nothing.
+    it "deriving parenthesis context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+            fp <- makeAbsolute "./ExampleContext.hs"
+            let res = IdeResultOk Nothing
+            actual <- getContextAt fp (toPos (13, 14))
+            actual `shouldBe` res
+
+    -- Cursor is directly after the open parenthesis of a deriving clause.
+    -- E.g. deriving (...)
+    --                ^---- cursor is here
+    -- Context is now Type. This makes sense, but an extension may be to be
+    -- aware of the context of a deriving clause, thus offering only Type Classes
+    -- as a completion.
+    it "deriving parenthesis context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+            fp <- makeAbsolute "./ExampleContext.hs"
+            let res = IdeResultOk (Just TypeContext)
+            actual <- getContextAt fp (toPos (13, 15))
+            actual `shouldBe` res
+
+    it "deriving typeclass context"
+        $ withCurrentDirectory "./test/testdata/context"
+        $ do
+            fp <- makeAbsolute "./ExampleContext.hs"
+            let res = IdeResultOk (Just TypeContext)
+            actual <- getContextAt fp (toPos (13, 18))
+            actual `shouldBe` res
+
+    -- Point at an empty line.
+    -- There is no context
+    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 :: FilePath -> 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)