Add more test cases for context queries

Author: fendor

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

@@ -1,7 +1,6 @@
 module Haskell.Ide.Engine.Context where
 
 import Data.Generics
-import Data.Foldable (asum)
 import Language.Haskell.LSP.Types
 import GHC
 import qualified GhcModCore as GM (GhcPs) -- for GHC 8.2.2
@@ -37,10 +36,10 @@ getContext pos pm
   , pos `isInsideRange` r
   = Just ExportContext
 
-  | Just ctx <- everything (<|>) (Nothing `mkQ` go `extQ` goInline) decl
+  | Just ctx <- something (Nothing `mkQ` go `extQ` goInline) decl
   = Just ctx
 
-  | Just ctx <- asum $ map importGo imports
+  | Just ctx <- something (Nothing `mkQ` importGo) imports
   = Just ctx
 
   | otherwise

test/testdata/context/ExampleContext.hs

@@ -4,9 +4,12 @@ import Data.List (find)
 import Control.Monad hiding (fix)
 
 foo :: Int -> Int
-foo xs = xs + 1
+foo xs = bar xs + 1
+    where
+        bar :: Int -> Int
+        bar x = x + 2
 
-data Foo a = Foo a
+data Foo a = Foo a 
     deriving (Show)
 
 class Bar a where

test/unit/ContextSpec.hs

@@ -77,6 +77,13 @@ spec = describe "Context of different cursor positions" $ do
 
         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
@@ -85,6 +92,14 @@ spec = describe "Context of different cursor positions" $ do
               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"
@@ -95,70 +110,126 @@ spec = describe "Context of different cursor positions" $ do
               actual <- getContextAt fp_ (toPos (7, 1))
               actual `shouldBe` res
 
-    it "function signature context"
+    -- 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 TypeContext)
-              actual <- getContextAt fp_ (toPos (6, 8))
-              actual `shouldBe` res
+            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 (9, 8))
+            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
 
     it "class declaration context"
         $ withCurrentDirectory "./test/testdata/context"
         $ do
             fp_ <- makeAbsolute "./ExampleContext.hs"
             let res = IdeResultOk (Just ClassContext)
-            actual <- getContextAt fp_ (toPos (12, 8))
+            actual <- getContextAt fp_ (toPos (15, 8))
             actual `shouldBe` res
 
     it "class declaration function sig context"
         $ withCurrentDirectory "./test/testdata/context"
         $ do
             fp_ <- makeAbsolute "./ExampleContext.hs"
             let res = IdeResultOk (Just ClassContext)
-            actual <- getContextAt fp_ (toPos (13, 7))
+            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 (Just InstanceContext)
-            actual <- getContextAt fp_ (toPos (15, 7))
+            actual <- getContextAt fp_ (toPos (18, 7))
             actual `shouldBe` res
 
+    -- Function definition
     it "instance declaration function def context"
             $ withCurrentDirectory "./test/testdata/context"
             $ do
                 fp_ <- makeAbsolute "./ExampleContext.hs"
                 let res = IdeResultOk (Just InstanceContext)
-                actual <- getContextAt fp_ (toPos (16, 6))
+                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 (10, 9))
+            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 (10, 18))
+            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