haskell-language-server-2.13.0.0: plugins/hls-cabal-plugin/test/Definition.hs
{-# LANGUAGE OverloadedStrings #-}
module Definition (
gotoDefinitionTests,
) where
import Control.Lens ((^.))
import Data.List.Extra (isSuffixOf)
import qualified Language.LSP.Protocol.Lens as L
import qualified Language.LSP.Protocol.Types as LSP
import System.FilePath
import Test.Hls
import Utils
gotoDefinitionTests :: TestTree
gotoDefinitionTests = testGroup "Goto Definition"
[ gotoCommonSectionDefinitionTests
, gotoModuleDefinitionTests
]
gotoModuleDefinitionTests :: TestTree
gotoModuleDefinitionTests = testGroup "Goto Module Definition"
[ testGoToDefinitionLink "simple cabal test" "simple-cabal" "simple-cabal.cabal"
(Position 8 23) "A.hs"
, testGoToDefinitionLink "library start of exposed-modules" ("goto-definition" </> "modules") "module-examples.cabal"
(Position 6 22) ("src" </> "Library" </> "Lib.hs")
, testGoToDefinitionLink "library middle of exposed-modules" ("goto-definition" </> "modules") "module-examples.cabal"
(Position 6 29) ("src" </> "Library" </> "Lib.hs")
, testGoToDefinitionLink "library end of exposed-modules" ("goto-definition" </> "modules") "module-examples.cabal"
(Position 6 33) ("src" </> "Library" </> "Lib.hs")
, testGoToDefinitionLink "library start of other-modules" ("goto-definition" </> "modules") "module-examples.cabal"
(Position 9 22) ("src" </> "Library" </> "Other" </> "OtherLib.hs")
, testGoToDefinitionLink "library end of other-modules" ("goto-definition" </> "modules") "module-examples.cabal"
(Position 9 44) ("src" </> "Library" </> "Other" </> "OtherLib.hs")
, testGoToDefinitionLink "executable other-modules" ("goto-definition" </> "modules") "module-examples.cabal"
(Position 22 10) ("src" </> "exe" </> "Config.hs")
, testGoToDefinitionLink "test-suite other-modules Config" ("goto-definition" </> "modules") "module-examples.cabal"
(Position 31 10) ("src" </> "test"</> "Config.hs")
, testGoToDefinitionLink "test-suite other-modules Library" ("goto-definition" </> "modules") "module-examples.cabal"
(Position 34 10) ("src" </> "test" </> "Library.hs")
, testGoToDefinitionLink "benchmark other-modules Config" ("goto-definition" </> "modules") "module-examples.cabal"
(Position 45 30) ("src" </> "bench" </> "Config.hs")
, testGoToDefinitionLinkNoLocation "not existent module" ("goto-definition" </> "modules") "module-examples.cabal" (Position 48 25)
, testGoToDefinitionLinkNoLocation "behind module" ("goto-definition" </> "modules") "module-examples.cabal" (Position 9 20)
, testGoToDefinitionLinkNoLocation "after module" ("goto-definition" </> "modules") "module-examples.cabal" (Position 9 50)
]
where
getUriFromDefinition :: Show b => (Definition |? b) -> Uri
getUriFromDefinition (InL (Definition (InL loc))) = loc^.L.uri
getUriFromDefinition unk = error $ "Unexpected pattern '" ++ show unk ++ "' , expected '(InL (Definition (InL loc))'"
testGoToDefinitionLink :: TestName -> FilePath -> FilePath -> Position -> FilePath -> TestTree
testGoToDefinitionLink testName testDir cabalFile cursorPos expectedFilePath =
runCabalTestCaseSession testName testDir $ do
doc <- openDoc cabalFile "cabal"
definitions <- getDefinitions doc cursorPos
let uri = getUriFromDefinition definitions
case uriToFilePath uri of
Nothing -> error $ "Not possible to convert Uri " <> show uri <> " to FilePath"
Just filePath -> do
let
isCorrectPath = expectedFilePath `isSuffixOf` filePath
liftIO $ isCorrectPath @? ("Absolute path expected to end on " <> filePath <>
" but " <> filePath <> " was given.")
testGoToDefinitionLinkNoLocation :: TestName -> FilePath -> FilePath -> Position -> TestTree
testGoToDefinitionLinkNoLocation testName testDir cabalFile cursorPos =
runCabalTestCaseSession testName testDir $ do
doc <- openDoc cabalFile "cabal"
empty <- getDefinitions doc cursorPos
liftIO $ empty @?= (InR $ InR LSP.Null)
gotoCommonSectionDefinitionTests :: TestTree
gotoCommonSectionDefinitionTests = testGroup "Goto Common Section Definition"
[ positiveTest "middle of identifier" (Position 27 16) (mkRange 6 0 7 22)
, positiveTest "left of identifier" (Position 30 12) (mkRange 10 0 17 40)
, positiveTest "right of identifier" (Position 33 22) (mkRange 20 0 23 34)
, positiveTest "left of '-' in identifier" (Position 36 20) (mkRange 6 0 7 22)
, positiveTest "right of '-' in identifier" (Position 39 19) (mkRange 10 0 17 40)
, positiveTest "identifier in identifier list" (Position 42 16) (mkRange 20 0 23 34)
, positiveTest "left of ',' right of identifier" (Position 45 33) (mkRange 10 0 17 40)
, positiveTest "right of ',' left of identifier" (Position 48 34) (mkRange 6 0 7 22)
, negativeTest "right of ',' left of space" (Position 51 23)
, negativeTest "right of ':' left of space" (Position 54 11)
, negativeTest "not a definition" (Position 57 8)
, negativeTest "empty space" (Position 59 7)
]
where
getRangeFromDefinition :: Show b => (Definition |? b) -> Range
getRangeFromDefinition (InL (Definition (InL loc))) = loc^.L.range
getRangeFromDefinition unk = error $ "Unexpected pattern '" ++ show unk ++ "' , expected '(InL (Definition (InL loc))'"
-- A positive test checks if the provided range is equal
-- to the expected range from the definition in the test file.
-- The test emulates a goto-definition request of an actual definition.
positiveTest :: TestName -> Position -> Range -> TestTree
positiveTest testName cursorPos expectedRange =
runCabalTestCaseSession testName ("goto-definition" </> "common-section") $ do
doc <- openDoc "simple-with-common.cabal" "cabal"
definitions <- getDefinitions doc cursorPos
let range = getRangeFromDefinition definitions
liftIO $ range @?= expectedRange
-- A negative test checks if the request failed and
-- the provided result is empty, i.e. `InR $ InR Null`.
-- The test emulates a goto-definition request of anything but an
-- actual definition.
negativeTest :: TestName -> Position -> TestTree
negativeTest testName cursorPos =
runCabalTestCaseSession testName ("goto-definition" </> "common-section") $ do
doc <- openDoc "simple-with-common.cabal" "cabal"
empty <- getDefinitions doc cursorPos
liftIO $ empty @?= (InR $ InR LSP.Null)