{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module OutlineTests (tests) where
import Config
import Control.Monad.IO.Class (liftIO)
import Data.Text (Text)
import qualified Data.Text as T
import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion)
import Language.LSP.Protocol.Types hiding (SemanticTokenAbsolute (..),
SemanticTokenRelative (..),
SemanticTokensEdit (..), mkRange)
import Language.LSP.Test
import Test.Hls.FileSystem (file, text)
import Test.Tasty
import Test.Tasty.HUnit
testSymbols :: (HasCallStack) => TestName -> FilePath -> [Text] -> [DocumentSymbol] -> TestTree
testSymbols testName path content expectedSymbols =
testCase testName $ runWithDummyPlugin (mkIdeTestFs [file path (text $ T.unlines content)]) $ do
docId <- openDoc path "haskell"
symbols <- getDocumentSymbols docId
liftIO $ symbols @?= Right expectedSymbols
testSymbolsA :: (HasCallStack) => TestName -> [Text] -> [DocumentSymbol] -> TestTree
testSymbolsA testName content expectedSymbols =
testSymbols testName "A.hs" content expectedSymbols
tests :: TestTree
tests =
testGroup
"outline"
[ testSymbolsA
"type class:"
["module A where", "class A a where a :: a -> Bool"]
[ moduleSymbol
"A"
(R 0 7 0 8)
[ classSymbol
"A a"
(R 1 0 1 30)
[docSymbol' "a" SymbolKind_Method (R 1 16 1 30) (R 1 16 1 17)]
]
],
testSymbolsA
"type class instance "
["class A a where", "instance A () where"]
[ classSymbol "A a" (R 0 0 0 15) [],
docSymbol "A ()" SymbolKind_Interface (R 1 0 1 19)
],
testSymbolsA "type family" ["{-# language TypeFamilies #-}", "type family A"] [docSymbolD "A" "type family" SymbolKind_Function (R 1 0 1 13)],
testSymbolsA
"type family instance "
["{-# language TypeFamilies #-}", "type family A a", "type instance A () = ()"]
[ docSymbolD "A a" "type family" SymbolKind_Function (R 1 0 1 15),
docSymbol "A ()" SymbolKind_Interface (R 2 0 2 23)
],
testSymbolsA "data family" ["{-# language TypeFamilies #-}", "data family A"] [docSymbolD "A" "data family" SymbolKind_Function (R 1 0 1 (if ghcVersion >= GHC910 then 13 else 11))],
testSymbolsA
"data family instance "
["{-# language TypeFamilies #-}", "data family A a", "data instance A () = A ()"]
[ docSymbolD "A a" "data family" SymbolKind_Function (R 1 0 1 (if ghcVersion >= GHC910 then 15 else 11)),
docSymbol "A ()" SymbolKind_Interface (R 2 0 2 25)
],
testSymbolsA "constant" ["a = ()"] [docSymbol "a" SymbolKind_Function (R 0 0 0 6)],
testSymbolsA "pattern" ["Just foo = Just 21"] [docSymbol "Just foo" SymbolKind_Function (R 0 0 0 18)],
testSymbolsA "pattern with type signature" ["{-# language ScopedTypeVariables #-}", "a :: () = ()"] [docSymbol "a :: ()" SymbolKind_Function (R 1 0 1 12)],
testSymbolsA "function" ["a _x = ()"] [docSymbol "a" SymbolKind_Function (R 0 0 0 9)],
testSymbolsA "type synonym" ["type A = Bool"] [docSymbol' "A" SymbolKind_TypeParameter (R 0 0 0 13) (R 0 5 0 6)],
testSymbolsA "datatype" ["data A = C"] [docSymbolWithChildren "A" SymbolKind_Struct (R 0 0 0 10) [docSymbol "C" SymbolKind_Constructor (R 0 9 0 10)]],
testSymbolsA
"record fields"
["data A = B {", " x :: Int", " , y :: Int}"]
[ docSymbolWithChildren
"A"
SymbolKind_Struct
(R 0 0 2 13)
[ docSymbolWithChildren'
"B"
SymbolKind_Constructor
(R 0 9 2 13)
(R 0 9 0 10)
[ docSymbol "x" SymbolKind_Field (R 1 2 1 3),
docSymbol "y" SymbolKind_Field (R 2 4 2 5)
]
]
],
testSymbolsA
"import"
["import Data.Maybe ()"]
[ docSymbolWithChildren
"imports"
SymbolKind_Module
(R 0 0 0 20)
[ docSymbol "import Data.Maybe" SymbolKind_Module (R 0 0 0 20)
]
],
testSymbolsA
"multiple import"
["", "import Data.Maybe ()", "", "import Control.Exception ()", ""]
[ docSymbolWithChildren
"imports"
SymbolKind_Module
(R 1 0 3 27)
[ docSymbol "import Data.Maybe" SymbolKind_Module (R 1 0 1 20),
docSymbol "import Control.Exception" SymbolKind_Module (R 3 0 3 27)
]
],
testSymbolsA
"foreign import"
[ "{-# language ForeignFunctionInterface #-}",
"foreign import ccall \"a\" a :: Int"
]
[docSymbolD "a" "import" SymbolKind_Object (R 1 0 1 33)],
testSymbolsA
"foreign export"
[ "{-# language ForeignFunctionInterface #-}",
"foreign export ccall odd :: Int -> Bool"
]
[docSymbolD "odd" "export" SymbolKind_Object (R 1 0 1 39)]
]
where
docSymbol name kind loc =
DocumentSymbol name Nothing kind Nothing Nothing loc loc Nothing
docSymbol' name kind loc selectionLoc =
DocumentSymbol name Nothing kind Nothing Nothing loc selectionLoc Nothing
docSymbolD name detail kind loc =
DocumentSymbol name (Just detail) kind Nothing Nothing loc loc Nothing
docSymbolWithChildren name kind loc cc =
DocumentSymbol name Nothing kind Nothing Nothing loc loc (Just cc)
docSymbolWithChildren' name kind loc selectionLoc cc =
DocumentSymbol name Nothing kind Nothing Nothing loc selectionLoc (Just cc)
moduleSymbol name loc cc =
DocumentSymbol
name
Nothing
SymbolKind_File
Nothing
Nothing
(R 0 0 maxBound 0)
loc
(Just cc)
classSymbol name loc cc =
DocumentSymbol
name
(Just "class")
SymbolKind_Interface
Nothing
Nothing
loc
loc
(Just cc)