Cabal plugin outline view

plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs

@@ -1,4 +1,4 @@
-module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, findFieldSection, getOptionalSectionName, getAnnotation, getFieldName) where
+module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, findFieldSection, getOptionalSectionName, getAnnotation, getFieldName, onelineSectionArgs) where
 
 import           Data.List.NonEmpty                (NonEmpty)
 import qualified Data.List.NonEmpty                as NE
@@ -66,3 +66,19 @@ getOptionalSectionName (x:xs) = case x of
     Syntax.SecArgName _ name -> Just (T.decodeUtf8 name)
     _                        -> getOptionalSectionName xs
 
+
+-- | Makes a single text line out of multiple
+--   @SectionArg@s. Allowes to display conditions,
+--   flags, etc in one line, which is easier to read.
+--
+--   For example, @flag@ @(@ @pedantic@ @)@ will be joined in
+--   one line, instead of four @SectionArg@s separately.
+onelineSectionArgs :: [Syntax.SectionArg Syntax.Position] -> T.Text
+onelineSectionArgs sectionArgs = joinedName
+  where
+    joinedName = T.unwords $ map getName sectionArgs
+
+    getName :: Syntax.SectionArg Syntax.Position -> T.Text
+    getName (Syntax.SecArgName _ identifier)  = T.decodeUtf8 identifier
+    getName (Syntax.SecArgStr _ quotedString) = T.decodeUtf8 quotedString
+    getName (Syntax.SecArgOther _ string)     = T.decodeUtf8 string

plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs

@@ -181,5 +181,9 @@ lspPositionToCabalPosition pos = Syntax.Position
   (fromIntegral (pos ^. JL.line) + 1)
   (fromIntegral (pos ^. JL.character) + 1)
 
+-- | Convert an 'Syntax.Position' to a LSP 'Position'.
+--
+-- Cabal Positions start their indexing at 1 while LSP starts at 0.
+-- This helper makes sure, the translation is done properly.
 cabalPositionToLSPPosition :: Syntax.Position -> Position
 cabalPositionToLSPPosition (Syntax.Position start end) = Position (toEnum start -1) (toEnum end -1)

plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs

@@ -9,24 +9,24 @@ module Ide.Plugin.Cabal.Outline where
 
 import           Control.Monad.IO.Class
 import           Data.Maybe
-import qualified Data.Text                         as T
-import           Data.Text.Encoding                (decodeUtf8)
+import qualified Data.Text                               as T
+import           Data.Text.Encoding                      (decodeUtf8)
 import           Development.IDE.Core.Rules
-import           Development.IDE.Core.Shake        (IdeState (shakeExtras),
-                                                    runIdeAction,
-                                                    useWithStaleFast)
-import           Development.IDE.Types.Location    (toNormalizedFilePath')
-import           Distribution.Fields.Field         (Field (Field, Section),
-                                                    Name (Name),
-                                                    SectionArg (SecArgName, SecArgOther, SecArgStr))
-import           Distribution.Parsec.Position      (Position)
-import           Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..),
-                                                    cabalPositionToLSPPosition)
-import           Ide.Plugin.Cabal.Orphans          ()
-import           Ide.Types                         (PluginMethodHandler)
-import           Language.LSP.Protocol.Message     (Method (..))
-import           Language.LSP.Protocol.Types       (DocumentSymbol (..))
-import qualified Language.LSP.Protocol.Types       as LSP
+import           Development.IDE.Core.Shake              (IdeState (shakeExtras),
+                                                          runIdeAction,
+                                                          useWithStaleFast)
+import           Development.IDE.Types.Location          (toNormalizedFilePath')
+import           Distribution.Fields.Field               (Field (Field, Section),
+                                                          Name (Name))
+import           Distribution.Parsec.Position            (Position)
+import           Ide.Plugin.Cabal.Completion.CabalFields (onelineSectionArgs)
+import           Ide.Plugin.Cabal.Completion.Types       (ParseCabalFields (..),
+                                                          cabalPositionToLSPPosition)
+import           Ide.Plugin.Cabal.Orphans                ()
+import           Ide.Types                               (PluginMethodHandler)
+import           Language.LSP.Protocol.Message           (Method (..))
+import           Language.LSP.Protocol.Types             (DocumentSymbol (..))
+import qualified Language.LSP.Protocol.Types             as LSP
 
 
 moduleOutline :: PluginMethodHandler IdeState Method_TextDocumentDocumentSymbol
@@ -41,9 +41,35 @@ moduleOutline ideState _ LSP.DocumentSymbolParams {_textDocument = LSP.TextDocum
         Nothing -> pure $ LSP.InL []
     Nothing -> pure $ LSP.InL []
 
--- | Creates a DocumentSumbol object for the
---   cabal AST, without displaying fieldLines and
---   displaying Section name and SectionArgs in one line
+-- | Creates a @DocumentSymbol@ object for the
+--   cabal AST, without displaying @fieldLines@ and
+--   displaying @Section Name@ and @SectionArgs@ in one line.
+--
+--   @fieldLines@ are leaves of a cabal AST, so they are omitted
+--   in the outline. Sections have to be displayed in one line, because
+--   the AST representation looks unnatural. See examples:
+--
+-- *  part of a cabal file:
+--
+-- >   if impl(ghc >= 9.8)
+-- >      ghc-options: -Wall
+--
+-- * AST representation:
+--
+-- >   if
+-- >      impl
+-- >      (
+-- >      ghc >= 9.8
+-- >      )
+-- >
+-- >      ghc-options:
+-- >        -Wall
+--
+-- * resulting @DocumentSymbol@:
+--
+-- >   if impl(ghc >= 9.8)
+-- >      ghc-options:
+-- >
 documentSymbolForField :: Field Position -> Maybe DocumentSymbol
 documentSymbolForField (Field (Name pos fieldName) _) =
   Just
@@ -64,19 +90,9 @@ documentSymbolForField (Section (Name pos fieldName) sectionArgs fields) =
             (mapMaybe documentSymbolForField fields)
       }
   where
-    joinedName = decodeUtf8 fieldName <> " " <> joinedNameForSectionArgs sectionArgs
+    joinedName = decodeUtf8 fieldName <> " " <> onelineSectionArgs sectionArgs
     range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` joinedName
 
-joinedNameForSectionArgs :: [SectionArg Position] -> T.Text
-joinedNameForSectionArgs sectionArgs = joinedName
-  where
-    joinedName = T.unwords $ map getName sectionArgs
-
-    getName :: SectionArg Position -> T.Text
-    getName (SecArgName _ identifier)  = decodeUtf8 identifier
-    getName (SecArgStr _ quotedString) = decodeUtf8 quotedString
-    getName (SecArgOther _ string)     = decodeUtf8 string
-
 -- | Creates a single point LSP range
 --   using cabal position
 cabalPositionToLSPRange :: Position -> LSP.Range

plugins/hls-cabal-plugin/test/Outline.hs

@@ -1,13 +1,16 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Outline (
-    outlineTests
+  outlineTests,
 ) where
 
-import           Language.LSP.Protocol.Types (DocumentSymbol (..),
-                                              Position (..), Range (..))
-import qualified Test.Hls                    as T
-import           Utils
+import Language.LSP.Protocol.Types (
+  DocumentSymbol (..),
+  Position (..),
+  Range (..),
+ )
+import Test.Hls qualified as T
+import Utils
 
 testSymbols :: (T.HasCallStack) => T.TestName -> FilePath -> [DocumentSymbol] -> T.TestTree
 testSymbols testName path expectedSymbols =
@@ -23,64 +26,81 @@ outlineTests =
     [ testSymbols
         "cabal Field outline test"
         "field.cabal"
-        [fieldDocumentSymbol],
-      testSymbols
+        [fieldDocumentSymbol]
+    , testSymbols
         "cabal FieldLine outline test"
         "fieldline.cabal"
-        [fieldLineDocumentSymbol],
-      testSymbols
+        [fieldLineDocumentSymbol]
+    , testSymbols
         "cabal Section outline test"
         "section.cabal"
-        [sectionDocumentSymbol],
-      testSymbols
+        [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
-                                    }
+ 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
-  }
+defDocumentSymbol range =
+  DocumentSymbol
+    { _detail = Nothing
+    , _deprecated = Nothing
+    , _name = ""
+    , _kind = T.SymbolKind_File
+    , _range = range
+    , _selectionRange = range
+    , _children = Nothing
+    , _tags = Nothing
+    }