SymbolsSpec.hs

{-# LANGUAGE OverloadedStrings #-}
module SymbolsSpec where

import Control.Monad.IO.Class
import Language.Haskell.LSP.Test as Test
import Language.Haskell.LSP.Types
import Language.Haskell.LSP.Types.Capabilities
import Test.Hspec
import TestUtils

spec :: Spec
spec = describe "document symbols" $ do

  -- Some common ranges and selection ranges in Symbols.hs
  let fooSR = Range (Position 5 0) (Position 5 3)
      fooR  = Range (Position 5 0) (Position 7 43)
      barSR = Range (Position 6 8) (Position 6 11)
      barR  = Range (Position 6 8) (Position 7 43)
      dogSR = Range (Position 7 17) (Position 7 20)
      dogR  = Range (Position 7 16) (Position 7 43)
      catSR = Range (Position 7 22) (Position 7 25)
      catR  = Range (Position 7 16) (Position 7 43)
      myDataSR = Range (Position 9 5) (Position 9 11)
      myDataR  = Range (Position 9 0) (Position 10 22)
      aSR = Range (Position 9 14) (Position 9 15)
      aR  = Range (Position 9 14) (Position 9 19)
      bSR = Range (Position 10 14) (Position 10 15)
      bR  = Range (Position 10 14) (Position 10 22)
      testPatternSR = Range (Position 13 8) (Position 13 19)
      testPatternR = Range (Position 13 0) (Position 13 27)

  describe "3.10 hierarchical document symbols" $ do
    it "provides nested data types and constructors" $ runSession hieCommand fullCaps "test/testdata" $ do
      doc <- openDoc "Symbols.hs" "haskell"
      Left symbs <- getDocumentSymbols doc

      let myData = DocumentSymbol "MyData" (Just "") SkClass Nothing myDataR myDataSR (Just (List [a, b]))
          a = DocumentSymbol "A" (Just "") SkConstructor Nothing aR aSR (Just mempty)
          b = DocumentSymbol "B" (Just "") SkConstructor Nothing bR bSR (Just mempty)

      liftIO $ symbs `shouldContain` [myData]

    it "provides nested where functions" $ runSession hieCommand fullCaps "test/testdata" $ do
      doc <- openDoc "Symbols.hs" "haskell"
      Left symbs <- getDocumentSymbols doc

      let foo = DocumentSymbol "foo" (Just "") SkFunction Nothing fooR fooSR (Just (List [bar]))
          bar = DocumentSymbol "bar" (Just "") SkFunction Nothing barR barSR (Just (List [dog, cat]))
          dog = DocumentSymbol "dog" (Just "") SkVariable Nothing dogR dogSR (Just mempty)
          cat = DocumentSymbol "cat" (Just "") SkVariable Nothing catR catSR (Just mempty)

      liftIO $ symbs `shouldContain` [foo]
    it "provides pattern synonyms" $ runSession hieCommand fullCaps "test/testdata" $ do
      doc <- openDoc "Symbols.hs" "haskell"
      Left symbs <- getDocumentSymbols doc

      let testPattern = DocumentSymbol "TestPattern"
            (Just "") SkFunction Nothing testPatternR testPatternSR (Just mempty)

      liftIO $ symbs `shouldContain` [testPattern]

    -- TODO: Test module, imports

  describe "pre 3.10 symbol information" $ do
    it "provides nested data types and constructors" $ runSession hieCommand oldCaps "test/testdata" $ do
      doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell"
      Right symbs <- getDocumentSymbols doc

      let myData = SymbolInformation "MyData" SkClass Nothing (Location testUri myDataR) Nothing
          a = SymbolInformation "A" SkConstructor Nothing (Location testUri aR) (Just "MyData")
          b = SymbolInformation "B" SkConstructor Nothing (Location testUri bR) (Just "MyData")

      liftIO $ symbs `shouldContain` [myData, a, b]

    it "provides nested where functions" $ runSession hieCommand oldCaps "test/testdata" $ do
      doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell"
      Right symbs <- getDocumentSymbols doc

      let foo = SymbolInformation "foo" SkFunction Nothing (Location testUri fooR) Nothing
          bar = SymbolInformation "bar" SkFunction Nothing (Location testUri barR) (Just "foo")
          dog = SymbolInformation "dog" SkVariable Nothing (Location testUri dogR) (Just "bar")
          cat = SymbolInformation "cat" SkVariable Nothing (Location testUri catR) (Just "bar")

      -- Order is important!
      liftIO $ symbs `shouldContain` [foo, bar, dog, cat]


oldCaps :: ClientCapabilities
oldCaps = capsForVersion (LSPVersion 3 9)