Skip to content
This repository has been archived by the owner on Oct 7, 2020. It is now read-only.

Commit

Permalink
Scrap contexts that may or may not be useful yet
Browse files Browse the repository at this point in the history
  • Loading branch information
fendor committed Aug 31, 2019
1 parent 82f3870 commit a127d55
Show file tree
Hide file tree
Showing 2 changed files with 66 additions and 74 deletions.
22 changes: 5 additions & 17 deletions hie-plugin-api/Haskell/Ide/Engine/Context.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,14 +14,11 @@ import Control.Applicative ( (<|>) )
-- smarter code completion
data Context = TypeContext
| ValueContext
| ModuleContext String
| ImportContext String
| ImportListContext String
| ImportHidingContext String
| ExportContext
| InstanceContext
| ClassContext
| DerivingContext
| 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
Expand Down Expand Up @@ -57,15 +54,6 @@ getContext pos pm
go (L (GHC.RealSrcSpan r) GHC.ValD {})
| pos `isInsideRange` r = Just ValueContext
| otherwise = Nothing
go (L (GHC.RealSrcSpan r) GHC.InstD {})
| pos `isInsideRange` r = Just InstanceContext
| otherwise = Nothing
go (L (GHC.RealSrcSpan r) GHC.DerivD {})
| pos `isInsideRange` r = Just DerivingContext
| otherwise = Nothing
go (L (GHC.RealSrcSpan r) (GHC.TyClD _ GHC.ClassDecl {}))
| pos `isInsideRange` r = Just ClassContext
| otherwise = Nothing
go _ = Nothing

goInline :: GHC.LHsType GM.GhcPs -> Maybe Context
Expand Down
118 changes: 61 additions & 57 deletions test/unit/ContextSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -32,82 +32,82 @@ spec = describe "Context of different cursor positions" $ do
it "module header context"
$ withCurrentDirectory "./test/testdata/context"
$ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk (Just (ModuleContext "ExampleContext"))

actual <- getContextAt fp_ (toPos (1, 10))
actual <- getContextAt fp (toPos (1, 10))

actual `shouldBe` res


it "module export list context"
$ withCurrentDirectory "./test/testdata/context"
$ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk (Just ExportContext)
actual <- getContextAt fp_ (toPos (1, 24))
actual <- getContextAt fp (toPos (1, 24))

actual `shouldBe` res

it "value context" $ withCurrentDirectory "./test/testdata/context" $ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk (Just ValueContext)
actual <- getContextAt fp_ (toPos (7, 6))
actual <- getContextAt fp (toPos (7, 6))

actual `shouldBe` res

it "value addition context" $ withCurrentDirectory "./test/testdata/context" $ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk (Just ValueContext)
actual <- getContextAt fp_ (toPos (7, 12))
actual <- getContextAt fp (toPos (7, 12))

actual `shouldBe` res

it "import context" $ withCurrentDirectory "./test/testdata/context" $ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk (Just (ImportContext "Data.List"))
actual <- getContextAt fp_ (toPos (3, 8))
actual <- getContextAt fp (toPos (3, 8))

actual `shouldBe` res

it "import list context" $ withCurrentDirectory "./test/testdata/context" $ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk (Just (ImportListContext "Data.List"))
actual <- getContextAt fp_ (toPos (3, 20))
actual <- getContextAt fp (toPos (3, 20))

actual `shouldBe` res

it "import hiding context" $ withCurrentDirectory "./test/testdata/context" $ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk (Just (ImportHidingContext "Control.Monad"))
actual <- getContextAt fp_ (toPos (4, 32))
actual <- getContextAt fp (toPos (4, 32))

actual `shouldBe` res

it "function declaration context"
$ withCurrentDirectory "./test/testdata/context"
$ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk (Just TypeContext)
actual <- getContextAt fp_ (toPos (6, 1))
actual <- getContextAt fp (toPos (6, 1))

actual `shouldBe` res

it "function signature context"
$ withCurrentDirectory "./test/testdata/context"
$ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk (Just TypeContext)
actual <- getContextAt fp_ (toPos (6, 8))
actual <- getContextAt fp (toPos (6, 8))
actual `shouldBe` res


it "function definition context"
$ withCurrentDirectory "./test/testdata/context"
$ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk (Just ValueContext)
actual <- getContextAt fp_ (toPos (7, 1))
actual <- getContextAt fp (toPos (7, 1))
actual `shouldBe` res

-- This is interesting, the context for this is assumed to be ValueContext
Expand All @@ -118,69 +118,73 @@ spec = describe "Context of different cursor positions" $ do
it "inner function declaration context"
$ withCurrentDirectory "./test/testdata/context"
$ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk (Just ValueContext)
actual <- getContextAt fp_ (toPos (9, 10))
actual <- getContextAt fp (toPos (9, 10))
actual `shouldBe` res

it "inner function value context"
$ withCurrentDirectory "./test/testdata/context"
$ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk (Just ValueContext)
actual <- getContextAt fp_ (toPos (10, 10))
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"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk Nothing
actual <- getContextAt fp_ (toPos (12, 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"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk (Just TypeContext)
actual <- getContextAt fp_ (toPos (12, 18))
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 (Just ClassContext)
actual <- getContextAt fp_ (toPos (15, 8))
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 (Just ClassContext)
actual <- getContextAt fp_ (toPos (16, 7))
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 (Just InstanceContext)
actual <- getContextAt fp_ (toPos (18, 7))
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk Nothing
actual <- getContextAt fp (toPos (18, 7))
actual `shouldBe` res

-- Function definition
-- 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 (Just InstanceContext)
actual <- getContextAt fp_ (toPos (19, 6))
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",
Expand All @@ -189,9 +193,9 @@ spec = describe "Context of different cursor positions" $ do
it "deriving context"
$ withCurrentDirectory "./test/testdata/context"
$ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk Nothing
actual <- getContextAt fp_ (toPos (13, 9))
actual <- getContextAt fp (toPos (13, 9))
actual `shouldBe` res

-- Cursor is directly before the open parenthesis of a deriving clause.
Expand All @@ -201,9 +205,9 @@ spec = describe "Context of different cursor positions" $ do
it "deriving parenthesis context"
$ withCurrentDirectory "./test/testdata/context"
$ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk Nothing
actual <- getContextAt fp_ (toPos (13, 14))
actual <- getContextAt fp (toPos (13, 14))
actual `shouldBe` res

-- Cursor is directly after the open parenthesis of a deriving clause.
Expand All @@ -215,32 +219,32 @@ spec = describe "Context of different cursor positions" $ do
it "deriving parenthesis context"
$ withCurrentDirectory "./test/testdata/context"
$ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk (Just TypeContext)
actual <- getContextAt fp_ (toPos (13, 15))
actual <- getContextAt fp (toPos (13, 15))
actual `shouldBe` res

it "deriving typeclass context"
$ withCurrentDirectory "./test/testdata/context"
$ do
fp_ <- makeAbsolute "./ExampleContext.hs"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk (Just TypeContext)
actual <- getContextAt fp_ (toPos (13, 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"
fp <- makeAbsolute "./ExampleContext.hs"
let res = IdeResultOk Nothing
actual <- getContextAt fp_ (toPos (2, 1))
actual <- getContextAt fp (toPos (2, 1))
actual `shouldBe` res

getContextAt :: [Char] -> Position -> IO (IdeResult (Maybe Context))
getContextAt fp_ pos = do
let arg = filePathToUri fp_
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 _ () ->
pluginGetFile "getContext: " arg $ \fp_ ->
ifCachedModuleAndData fp_ (IdeResultOk Nothing) $ \tm _ () ->
return $ IdeResultOk $ getContext pos (tm_parsed_module tm)

0 comments on commit a127d55

Please sign in to comment.