Outline.hs

{-# LANGUAGE OverloadedStrings #-}

module Outline (
  outlineTests,
) where

import           Language.LSP.Protocol.Types (DocumentSymbol (..),
                                              Position (..), Range (..))
import qualified Test.Hls                    as T
import           Utils

testSymbols :: (T.HasCallStack) => T.TestName -> FilePath -> [DocumentSymbol] -> T.TestTree
testSymbols testName path expectedSymbols =
  runCabalTestCaseSession testName "outline-cabal" $ do
    docId <- T.openDoc path "cabal"
    symbols <- T.getDocumentSymbols docId
    T.liftIO $ symbols T.@?= Right expectedSymbols

outlineTests :: T.TestTree
outlineTests =
  T.testGroup
    "Cabal Outline Tests"
    [ testSymbols
        "cabal Field outline test"
        "field.cabal"
        [fieldDocumentSymbol]
    , testSymbols
        "cabal FieldLine outline test"
        "fieldline.cabal"
        [fieldLineDocumentSymbol]
    , testSymbols
        "cabal Section outline test"
        "section.cabal"
        [sectionDocumentSymbol]
    , testSymbols
        "cabal SectionArg outline test"
        "sectionarg.cabal"
        [sectionArgDocumentSymbol]
    ]
 where
  fieldDocumentSymbol :: DocumentSymbol
  fieldDocumentSymbol =
    ( defDocumentSymbol
        ( Range { _start = Position{_line = 0, _character = 0}
                , _end = Position{_line = 0, _character = 8} })
    )
      { _name = "homepage"
      , _kind = T.SymbolKind_Field
      , _children = Nothing
      }
  fieldLineDocumentSymbol :: DocumentSymbol
  fieldLineDocumentSymbol =
    ( defDocumentSymbol
        ( Range { _start = Position{_line = 0, _character = 0}
                , _end = Position{_line = 0, _character = 13} })
    )
      { _name = "cabal-version"
      , _kind = T.SymbolKind_Field
      , _children = Nothing -- the values of fieldLine are removed from the outline
      }
  sectionDocumentSymbol :: DocumentSymbol
  sectionDocumentSymbol =
    ( defDocumentSymbol
        ( Range { _start = Position{_line = 0, _character = 2}
                , _end = Position{_line = 0, _character = 15} })
    )
      { _name = "build-depends"
      , _kind = T.SymbolKind_Field
      , _children = Nothing -- the values of fieldLine are removed from the outline
      }
  sectionArgDocumentSymbol :: DocumentSymbol
  sectionArgDocumentSymbol =
    ( defDocumentSymbol
        ( Range { _start = Position{_line = 0, _character = 2}
                , _end = Position{_line = 0, _character = 19} })
    )
      { _name = "if os ( windows )"
      , _kind = T.SymbolKind_Object
      , _children = Just $ [sectionArgChildrenDocumentSymbol]
      }
  sectionArgChildrenDocumentSymbol :: DocumentSymbol
  sectionArgChildrenDocumentSymbol =
    ( defDocumentSymbol
        ( Range { _start = Position{_line = 1, _character = 4}
                , _end = Position{_line = 1, _character = 17} })
    )
      { _name = "build-depends"
      , _kind = T.SymbolKind_Field
      , _children = Nothing
      }

defDocumentSymbol :: Range -> DocumentSymbol
defDocumentSymbol range =
  DocumentSymbol
    { _detail = Nothing
    , _deprecated = Nothing
    , _name = ""
    , _kind = T.SymbolKind_File
    , _range = range
    , _selectionRange = range
    , _children = Nothing
    , _tags = Nothing
    }