Refactor context search to use readFields

Instead of custom parsing of the cabal file, we use `readFields` to parse
the cabal file, as accurately as cabal supports. This allows us to
additionally benefit from future improvements to the cabal lexer.

Then, we traverse the fields and find the most likely location of the
cursor in the cabal file.
Based on these results, we can then establish the context accurately.

Further, we extend the known rules for the cabal plugin, to avoid
expensive reparsing using `readFields`.

Co-authored-by: VeryMilkyJoe <jana.chadt@nets.at>

haskell-language-server.cabal

@@ -241,6 +241,7 @@ library hls-cabal-plugin
     Ide.Plugin.Cabal.Completion.Data
     Ide.Plugin.Cabal.Completion.Types
     Ide.Plugin.Cabal.LicenseSuggest
+    Ide.Plugin.Cabal.Orphans
     Ide.Plugin.Cabal.Parse
 
 

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

@@ -11,7 +11,7 @@ import           Control.DeepSeq
 import           Control.Lens                                ((^.))
 import           Control.Monad.Extra
 import           Control.Monad.IO.Class
-import           Control.Monad.Trans.Class                   (lift)
+import           Control.Monad.Trans.Class
 import           Control.Monad.Trans.Maybe                   (runMaybeT)
 import qualified Data.ByteString                             as BS
 import           Data.Hashable
@@ -27,12 +27,17 @@ import           Development.IDE.Graph                       (Key, alwaysRerun)
 import qualified Development.IDE.Plugin.Completions.Logic    as Ghcide
 import qualified Development.IDE.Plugin.Completions.Types    as Ghcide
 import           Development.IDE.Types.Shake                 (toKey)
+import qualified Distribution.Fields                         as Syntax
+import qualified Distribution.Parsec.Position                as Syntax
 import           GHC.Generics
 import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
 import qualified Ide.Plugin.Cabal.Completion.Completions     as Completions
+import           Ide.Plugin.Cabal.Completion.Types           (ParseCabalFields (..),
+                                                              ParseCabalFile (..))
 import qualified Ide.Plugin.Cabal.Completion.Types           as Types
 import qualified Ide.Plugin.Cabal.Diagnostics                as Diagnostics
 import qualified Ide.Plugin.Cabal.LicenseSuggest             as LicenseSuggest
+import           Ide.Plugin.Cabal.Orphans                    ()
 import qualified Ide.Plugin.Cabal.Parse                      as Parse
 import           Ide.Types
 import qualified Language.LSP.Protocol.Lens                  as JL
@@ -70,7 +75,7 @@ instance Pretty Log where
       "Set files of interest to:" <+> viaShow files
     LogCompletionContext context position ->
       "Determined completion context:"
-        <+> viaShow context
+        <+> pretty context
         <+> "for cursor position:"
         <+> pretty position
     LogCompletions logs -> pretty logs
@@ -145,30 +150,55 @@ cabalRules recorder plId = do
   -- Make sure we initialise the cabal files-of-interest.
   ofInterestRules recorder
   -- Rule to produce diagnostics for cabal files.
-  define (cmapWithPrio LogShake recorder) $ \Types.GetCabalDiagnostics file -> do
+  define (cmapWithPrio LogShake recorder) $ \ParseCabalFields file -> do
     config <- getPluginConfigAction plId
     if not (plcGlobalOn config && plcDiagnosticsOn config)
-        then pure ([], Nothing)
-        else do
-          -- whenever this key is marked as dirty (e.g., when a user writes stuff to it),
-          -- we rerun this rule because this rule *depends* on GetModificationTime.
-          (t, mCabalSource) <- use_ GetFileContents file
-          log' Debug $ LogModificationTime file t
-          contents <- case mCabalSource of
-            Just sources ->
-              pure $ Encoding.encodeUtf8 sources
-            Nothing -> do
-              liftIO $ BS.readFile $ fromNormalizedFilePath file
+      then pure ([], Nothing)
+      else do
+        -- whenever this key is marked as dirty (e.g., when a user writes stuff to it),
+        -- we rerun this rule because this rule *depends* on GetModificationTime.
+        (t, mCabalSource) <- use_ GetFileContents file
+        log' Debug $ LogModificationTime file t
+        contents <- case mCabalSource of
+          Just sources ->
+            pure $ Encoding.encodeUtf8 sources
+          Nothing -> do
+            liftIO $ BS.readFile $ fromNormalizedFilePath file
 
-          (pWarnings, pm) <- liftIO $ Parse.parseCabalFileContents contents
-          let warningDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings
-          case pm of
-            Left (_cabalVersion, pErrorNE) -> do
-              let errorDiags = NE.toList $ NE.map (Diagnostics.errorDiagnostic file) pErrorNE
-                  allDiags = errorDiags <> warningDiags
-              pure (allDiags, Nothing)
-            Right gpd -> do
-              pure (warningDiags, Just gpd)
+        case Parse.readCabalFields file contents of
+          Left _ ->
+            pure ([], Nothing)
+          Right fields ->
+            pure ([], Just fields)
+
+  define (cmapWithPrio LogShake recorder) $ \ParseCabalFile file -> do
+    config <- getPluginConfigAction plId
+    if not (plcGlobalOn config && plcDiagnosticsOn config)
+      then pure ([], Nothing)
+      else do
+        -- whenever this key is marked as dirty (e.g., when a user writes stuff to it),
+        -- we rerun this rule because this rule *depends* on GetModificationTime.
+        (t, mCabalSource) <- use_ GetFileContents file
+        log' Debug $ LogModificationTime file t
+        contents <- case mCabalSource of
+          Just sources ->
+            pure $ Encoding.encodeUtf8 sources
+          Nothing -> do
+            liftIO $ BS.readFile $ fromNormalizedFilePath file
+
+        -- Instead of fully reparsing the sources to get a 'GenericPackageDescription',
+        -- we would much rather re-use the already parsed results of 'ParseCabalFields'.
+        -- Unfortunately, Cabal-syntax doesn't expose the function 'parseGenericPackageDescription''
+        -- which allows us to resume the parsing pipeline with '[Field Position]'.
+        (pWarnings, pm) <- liftIO $ Parse.parseCabalFileContents contents
+        let warningDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings
+        case pm of
+          Left (_cabalVersion, pErrorNE) -> do
+            let errorDiags = NE.toList $ NE.map (Diagnostics.errorDiagnostic file) pErrorNE
+                allDiags = errorDiags <> warningDiags
+            pure (allDiags, Nothing)
+          Right gpd -> do
+            pure (warningDiags, Just gpd)
 
   action $ do
     -- Run the cabal kick. This code always runs when 'shakeRestart' is run.
@@ -188,7 +218,7 @@ function invocation.
 kick :: Action ()
 kick = do
   files <- HashMap.keys <$> getCabalFilesOfInterestUntracked
-  void $ uses Types.GetCabalDiagnostics files
+  void $ uses Types.ParseCabalFile files
 
 -- ----------------------------------------------------------------
 -- Code Actions
@@ -281,24 +311,31 @@ completion :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.M
 completion recorder ide _ complParams = do
   let (TextDocumentIdentifier uri) = complParams ^. JL.textDocument
       position = complParams ^. JL.position
-  contents <- lift $ getVirtualFile $ toNormalizedUri uri
-  case (contents, uriToFilePath' uri) of
-    (Just cnts, Just path) -> do
-      let pref = Ghcide.getCompletionPrefix position cnts
-      let res = result pref path cnts
-      liftIO $ fmap InL res
-    _ -> pure . InR $ InR Null
+  mVf <- lift $ getVirtualFile $ toNormalizedUri uri
+  case (,) <$> mVf <*> uriToFilePath' uri of
+    Just (cnts, path) -> do
+      mFields <- liftIO $ runIdeAction "cabal-plugin.fields" (shakeExtras ide) $ useWithStaleFast ParseCabalFields $ toNormalizedFilePath path
+      case mFields of
+        Nothing ->
+          pure . InR $ InR Null
+        Just (fields, _) -> do
+          let pref = Ghcide.getCompletionPrefix position cnts
+          let res = produceCompletions pref path fields
+          liftIO $ fmap InL res
+    Nothing -> pure . InR $ InR Null
  where
-  result :: Ghcide.PosPrefixInfo -> FilePath -> VFS.VirtualFile -> IO [CompletionItem]
-  result prefix fp cnts = do
-    runMaybeT context >>= \case
+  completerRecorder = cmapWithPrio LogCompletions recorder
+
+  produceCompletions :: Ghcide.PosPrefixInfo -> FilePath -> [Syntax.Field Syntax.Position] -> IO [CompletionItem]
+  produceCompletions prefix fp fields = do
+    runMaybeT (context fields) >>= \case
       Nothing -> pure []
       Just ctx -> do
         logWith recorder Debug $ LogCompletionContext ctx pos
         let completer = Completions.contextToCompleter ctx
         let completerData = CompleterTypes.CompleterData
               { getLatestGPD = do
-                mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast Types.GetCabalDiagnostics $ toNormalizedFilePath fp
+                mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast ParseCabalFile $ toNormalizedFilePath fp
                 pure $ fmap fst mGPD
               , cabalPrefixInfo = prefInfo
               , stanzaName =
@@ -309,7 +346,6 @@ completion recorder ide _ complParams = do
         completions <- completer completerRecorder completerData
         pure completions
    where
-    completerRecorder = cmapWithPrio LogCompletions recorder
     pos = Ghcide.cursorPos prefix
-    context = Completions.getContext completerRecorder prefInfo (cnts ^. VFS.file_text)
+    context fields = Completions.getContext completerRecorder prefInfo fields
     prefInfo = Completions.getCabalPrefixInfo fp prefix

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

@@ -4,17 +4,15 @@ module Ide.Plugin.Cabal.Completion.Completions (contextToCompleter, getContext,
 
 import           Control.Lens                                  ((^.))
 import           Control.Monad.IO.Class                        (MonadIO)
-import           Control.Monad.Trans.Maybe
-import           Data.Foldable                                 (asum)
-import qualified Data.List                                     as List
-import           Data.Map                                      (Map)
+import           Data.List.NonEmpty                            (NonEmpty)
+import qualified Data.List.NonEmpty                            as NE
 import qualified Data.Map                                      as Map
 import qualified Data.Text                                     as T
-import qualified Data.Text.Utf16.Lines                         as Rope (Position (..))
-import           Data.Text.Utf16.Rope.Mixed                    (Rope)
-import qualified Data.Text.Utf16.Rope.Mixed                    as Rope
+import qualified Data.Text.Encoding                            as T
 import           Development.IDE                               as D
 import qualified Development.IDE.Plugin.Completions.Types      as Ghcide
+import qualified Distribution.Fields                           as Syntax
+import qualified Distribution.Parsec.Position                  as Syntax
 import           Ide.Plugin.Cabal.Completion.Completer.Simple
 import           Ide.Plugin.Cabal.Completion.Completer.Snippet
 import           Ide.Plugin.Cabal.Completion.Completer.Types   (Completer)
@@ -64,32 +62,13 @@ contextToCompleter (Stanza s _, KeyWord kw) =
 --  Can return Nothing if an error occurs.
 --
 --  TODO: first line can only have cabal-version: keyword
-getContext :: (MonadIO m) => Recorder (WithPriority Log) -> CabalPrefixInfo -> Rope -> MaybeT m Context
-getContext recorder prefInfo ls =
-  case prevLinesM of
-    Just prevLines -> do
-      let lvlContext =
-            if completionIndentation prefInfo == 0
-              then TopLevel
-              else currentLevel prevLines
-      case lvlContext of
-        TopLevel -> do
-          kwContext <- MaybeT . pure $ getKeyWordContext prefInfo prevLines (cabalVersionKeyword <> cabalKeywords)
-          pure (TopLevel, kwContext)
-        Stanza s n ->
-          case Map.lookup s stanzaKeywordMap of
-            Nothing -> do
-              pure (Stanza s n, None)
-            Just m -> do
-              kwContext <- MaybeT . pure $ getKeyWordContext prefInfo prevLines m
-              pure (Stanza s n, kwContext)
-    Nothing -> do
-      logWith recorder Warning $ LogFileSplitError pos
-      -- basically returns nothing
-      fail "Abort computation"
+getContext :: (MonadIO m) => Recorder (WithPriority Log) -> CabalPrefixInfo -> [Syntax.Field Syntax.Position] -> m Context
+getContext recorder prefInfo fields = do
+    let ctx = findCursorContext cursor (NE.singleton (0, TopLevel)) (completionPrefix prefInfo) fields
+    logWith recorder Debug $ LogCompletionContext ctx
+    pure ctx
   where
-    pos = completionCursorPosition prefInfo
-    prevLinesM = splitAtPosition pos ls
+    cursor = lspPositionToCabalPosition (completionCursorPosition prefInfo)
 
 -- | Takes information about the current file's file path,
 --  and the cursor position in the file; and builds a CabalPrefixInfo
@@ -144,84 +123,111 @@ getCabalPrefixInfo fp prefixInfo =
 -- Implementation Details
 -- ----------------------------------------------------------------
 
--- | Takes prefix info about the previously written text,
---  a list of lines (representing a file) and a map of
---  keywords and returns a keyword context if the
---  previously written keyword matches one in the map.
+findCursorContext ::
+  Syntax.Position ->
+  -- ^ The cursor position we look for in the fields
+  NonEmpty (Int, StanzaContext) ->
+  -- ^ A stack of current stanza contexts and their starting line numbers
+  T.Text ->
+  -- ^ The cursor's prefix text
+  [Syntax.Field Syntax.Position] ->
+  -- ^ The fields to traverse
+  Context
+findCursorContext cursor parentHistory prefixText fields =
+  case findFieldSection cursor fields of
+    Nothing -> (snd $ NE.head parentHistory, None)
+    -- We found the most likely section. Now, are we starting a new section or are we completing an existing one?
+    Just field@(Syntax.Field _ _) -> classifyFieldContext parentHistory cursor field
+    Just section@(Syntax.Section _ args sectionFields)
+      | inSameLineAsSectionName section -> (stanzaCtx, None) -- TODO: test whether keyword in same line is parsed correctly
+      | otherwise ->
+          findCursorContext cursor
+            (NE.cons (Syntax.positionCol (getAnnotation section) + 1, Stanza (getFieldName section) (getOptionalSectionName args)) parentHistory)
+            prefixText sectionFields
+    where
+        inSameLineAsSectionName section = Syntax.positionRow (getAnnotation section) == Syntax.positionRow cursor
+        stanzaCtx = snd $ NE.head parentHistory
+
+-- | Finds the cursor's context, where the cursor is already found to be in a specific field
 --
---  From a cursor position, we traverse the cabal file upwards to
---  find the latest written keyword if there is any.
---  Values may be written on subsequent lines,
---  in order to allow for this we take the indentation of the current
---  word to be completed into account to find the correct keyword context.
-getKeyWordContext :: CabalPrefixInfo -> [T.Text] -> Map KeyWordName a -> Maybe FieldContext
-getKeyWordContext prefInfo ls keywords = do
-  case lastNonEmptyLineM of
-    Nothing -> Just None
-    Just lastLine' -> do
-      let (whiteSpaces, lastLine) = T.span (== ' ') lastLine'
-      let keywordIndentation = T.length whiteSpaces
-      let cursorIndentation = completionIndentation prefInfo
-      -- in order to be in a keyword context the cursor needs
-      -- to be indented more than the keyword
-      if cursorIndentation > keywordIndentation
-        then -- if the last thing written was a keyword without a value
-        case List.find (`T.isPrefixOf` lastLine) (Map.keys keywords) of
-          Nothing -> Just None
-          Just kw -> Just $ KeyWord kw
-        else Just None
+-- Due to the way the field context is recognised for incomplete cabal files,
+-- an incomplete keyword is also recognised as a field, therefore we need to determine
+-- the specific context as we could still be in a stanza context in this case.
+classifyFieldContext :: NonEmpty (Int, StanzaContext) -> Syntax.Position -> Syntax.Field Syntax.Position -> Context
+classifyFieldContext ctx cursor field
+  -- the cursor is not indented enough to be within the field
+  -- but still indented enough to be within the stanza
+  | cursorColumn <= fieldColumn && minIndent <= cursorColumn = (stanzaCtx, None)
+  -- the cursor is not in the current stanza's context as it is not indented enough
+  | cursorColumn < minIndent = findStanzaForColumn cursorColumn ctx
+  | cursorIsInFieldName = (stanzaCtx, None)
+  | cursorIsBeforeFieldName = (stanzaCtx, None)
+  | otherwise = (stanzaCtx, KeyWord (getFieldName field <> ":"))
   where
-    lastNonEmptyLineM :: Maybe T.Text
-    lastNonEmptyLineM = do
-      (curLine, rest) <- List.uncons ls
-      -- represents the current line while disregarding the
-      -- currently written text we want to complete
-      let cur = stripPartiallyWritten curLine
-      List.find (not . T.null . T.stripEnd) $
-        cur : rest
+    (minIndent, stanzaCtx) = NE.head ctx
 
--- | Traverse the given lines (starting before current cursor position
---  up to the start of the file) to find the nearest stanza declaration,
---  if none is found we are in the top level context.
+    cursorIsInFieldName = inSameLineAsFieldName &&
+      fieldColumn <= cursorColumn &&
+      cursorColumn <= fieldColumn + T.length (getFieldName field)
+
+    cursorIsBeforeFieldName = inSameLineAsFieldName &&
+      cursorColumn < fieldColumn
+
+    inSameLineAsFieldName = Syntax.positionRow (getAnnotation field) == Syntax.positionRow cursor
+
+    cursorColumn = Syntax.positionCol cursor
+    fieldColumn = Syntax.positionCol (getAnnotation field)
+
+-- ----------------------------------------------------------------
+-- Cabal-syntax utilities I don't really want to write myself
+-- ----------------------------------------------------------------
+
+-- | Determine the context of a cursor position within a stack of stanza contexts
 --
---  TODO: this could be merged with getKeyWordContext in order to increase
---  performance by reducing the number of times we have to traverse the cabal file.
-currentLevel :: [T.Text] -> StanzaContext
-currentLevel [] = TopLevel
-currentLevel (cur : xs)
-  | Just (s, n) <- stanza = Stanza s n
-  | otherwise = currentLevel xs
-  where
-    stanza = asum $ map checkStanza (Map.keys stanzaKeywordMap)
-    checkStanza :: StanzaType -> Maybe (StanzaType, Maybe StanzaName)
-    checkStanza t =
-      case T.stripPrefix t (T.strip cur) of
-        Just n
-          | T.null n -> Just (t, Nothing)
-          | otherwise -> Just (t, Just $ T.strip n)
-        Nothing -> Nothing
+-- If the cursor is indented more than one of the stanzas in the stack
+-- the respective stanza is returned if this is never the case, the toplevel stanza
+-- in the stack is returned.
+findStanzaForColumn :: Int -> NonEmpty (Int, StanzaContext) -> (StanzaContext, FieldContext)
+findStanzaForColumn col ctx = case NE.uncons ctx of
+    ((_, stanza), Nothing) -> (stanza, None)
+    ((indentation, stanza), Just res)
+        | col < indentation -> findStanzaForColumn col res
+        | otherwise -> (stanza, None)
 
--- | Get all lines before the given cursor position in the given file
---  and reverse their order to traverse backwards starting from the given position.
-splitAtPosition :: Position -> Rope -> Maybe [T.Text]
-splitAtPosition pos ls = do
-  split <- splitFile
-  pure $ reverse $ Rope.lines $ fst split
-  where
-    splitFile = Rope.utf16SplitAtPosition ropePos ls
-    ropePos =
-      Rope.Position
-        { Rope.posLine = fromIntegral $ pos ^. JL.line,
-          Rope.posColumn = fromIntegral $ pos ^. JL.character
-        }
+-- | Determine the field the cursor is currently a part of.
+--
+-- The result is said field and its starting position
+-- or Nothing if the passed list of fields is empty.
 
--- | Takes a line of text and removes the last partially
--- written word to be completed.
-stripPartiallyWritten :: T.Text -> T.Text
-stripPartiallyWritten = T.dropWhileEnd (\y -> (y /= ' ') && (y /= ':'))
-
--- | Calculates how many spaces the currently completed item is indented.
-completionIndentation :: CabalPrefixInfo -> Int
-completionIndentation prefInfo = fromIntegral (pos ^. JL.character) - (T.length $ completionPrefix prefInfo)
+-- This only looks at the row of the cursor and not at the cursor's
+-- position within the row.
+--
+-- TODO: we do not handle braces correctly. Add more tests!
+findFieldSection :: Syntax.Position -> [Syntax.Field Syntax.Position] -> Maybe (Syntax.Field Syntax.Position)
+findFieldSection _cursor [] = Nothing
+findFieldSection _cursor [x] =
+  -- Last field. We decide later, whether we are starting
+  -- a new section.
+  Just x
+findFieldSection cursor (x:y:ys)
+    | Syntax.positionRow (getAnnotation x) <= cursorLine && cursorLine < Syntax.positionRow (getAnnotation y)
+    = Just x
+    | otherwise = findFieldSection cursor (y:ys)
   where
-    pos = completionCursorPosition prefInfo
+    cursorLine = Syntax.positionRow cursor
+
+type FieldName = T.Text
+
+getAnnotation :: Syntax.Field ann -> ann
+getAnnotation (Syntax.Field (Syntax.Name ann _) _)     = ann
+getAnnotation (Syntax.Section (Syntax.Name ann _) _ _) = ann
+
+getFieldName :: Syntax.Field ann -> FieldName
+getFieldName (Syntax.Field (Syntax.Name _ fn) _)     = T.decodeUtf8 fn
+getFieldName (Syntax.Section (Syntax.Name _ fn) _ _) = T.decodeUtf8 fn
+
+getOptionalSectionName :: [Syntax.SectionArg ann] -> Maybe T.Text
+getOptionalSectionName [] = Nothing
+getOptionalSectionName (x:xs) = case x of
+    Syntax.SecArgName _ name -> Just (T.decodeUtf8 name)
+    _                        -> getOptionalSectionName xs

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

@@ -4,13 +4,17 @@
 
 module Ide.Plugin.Cabal.Completion.Types where
 
-import           Control.DeepSeq        (NFData)
+import           Control.DeepSeq                 (NFData)
+import           Control.Lens                    ((^.))
 import           Data.Hashable
-import qualified Data.Text              as T
+import qualified Data.Text                       as T
 import           Data.Typeable
-import           Development.IDE        as D
+import           Development.IDE                 as D
+import qualified Distribution.Fields             as Syntax
+import qualified Distribution.PackageDescription as PD
+import qualified Distribution.Parsec.Position    as Syntax
 import           GHC.Generics
-import qualified Ide.Plugin.Cabal.Parse as Parse
+import qualified Language.LSP.Protocol.Lens      as JL
 
 data Log
   = LogFileSplitError Position
@@ -21,6 +25,7 @@ data Log
   | LogFilePathCompleterIOError FilePath IOError
   | LogUseWithStaleFastNoResult
   | LogMapLookUpOfKnownKeyFailed T.Text
+  | LogCompletionContext Context
   deriving (Show)
 
 instance Pretty Log where
@@ -34,15 +39,25 @@ instance Pretty Log where
       "When trying to complete the file path:" <+> pretty fp <+> "the following unexpected IO error occurred" <+> viaShow ioErr
     LogUseWithStaleFastNoResult -> "Package description couldn't be read"
     LogMapLookUpOfKnownKeyFailed key -> "Lookup of key in map failed even though it should exist" <+> pretty key
+    LogCompletionContext ctx -> "Completion context is:" <+> pretty ctx
 
-type instance RuleResult GetCabalDiagnostics = Parse.GenericPackageDescription
+type instance RuleResult ParseCabalFile = PD.GenericPackageDescription
 
-data GetCabalDiagnostics = GetCabalDiagnostics
+data ParseCabalFile = ParseCabalFile
   deriving (Eq, Show, Typeable, Generic)
 
-instance Hashable GetCabalDiagnostics
+instance Hashable ParseCabalFile
 
-instance NFData GetCabalDiagnostics
+instance NFData ParseCabalFile
+
+type instance RuleResult ParseCabalFields = [Syntax.Field Syntax.Position]
+
+data ParseCabalFields = ParseCabalFields
+  deriving (Eq, Show, Typeable, Generic)
+
+instance Hashable ParseCabalFields
+
+instance NFData ParseCabalFields
 
 -- | The context a cursor can be in within a cabal file.
 --
@@ -61,9 +76,13 @@ data StanzaContext
     -- Stanzas have their own fields which differ from top-level fields.
     -- Each stanza must be named, such as 'executable exe',
     -- except for the main library.
-    Stanza StanzaType (Maybe StanzaName)
+    Stanza !StanzaType !(Maybe StanzaName)
   deriving (Eq, Show, Read)
 
+instance Pretty StanzaContext where
+    pretty TopLevel      = "TopLevel"
+    pretty (Stanza t ms) = "Stanza" <+> pretty t <+> (maybe mempty pretty ms)
+
 -- | Keyword context in a cabal file.
 --
 --  Used to decide whether to suggest values or keywords.
@@ -71,12 +90,16 @@ data FieldContext
   = -- | Key word context, where a keyword
     -- occurs right before the current word
     -- to be completed
-    KeyWord KeyWordName
+    KeyWord !KeyWordName
   | -- | Keyword context where no keyword occurs
     -- right before the current word to be completed
     None
   deriving (Eq, Show, Read)
 
+instance Pretty FieldContext where
+    pretty (KeyWord kw) = "KeyWord" <+> pretty kw
+    pretty None         = "No Keyword"
+
 type KeyWordName = T.Text
 
 type StanzaName = T.Text
@@ -139,3 +162,12 @@ applyStringNotation (Just LeftSide) compl = compl <> "\""
 applyStringNotation Nothing compl
   | Just _ <- T.find (== ' ') compl = "\"" <> compl <> "\""
   | otherwise = compl
+
+-- | Convert an LSP 'Position' to a 'Syntax.Position'.
+--
+-- Cabal Positions start their indexing at 1 while LSP starts at 0.
+-- This helper makes sure, the translation is done properly.
+lspPositionToCabalPosition :: Position -> Syntax.Position
+lspPositionToCabalPosition pos = Syntax.Position
+  (fromIntegral (pos ^. JL.line) + 1)
+  (fromIntegral (pos ^. JL.character) + 1)

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

@@ -4,6 +4,7 @@ module Ide.Plugin.Cabal.Diagnostics
 ( errorDiagnostic
 , warningDiagnostic
 , positionFromCabalPosition
+, fatalParseErrorDiagnostic
   -- * Re-exports
 , FileDiagnostic
 , Diagnostic(..)
@@ -14,7 +15,7 @@ import qualified Data.Text                   as T
 import           Development.IDE             (FileDiagnostic,
                                               ShowDiagnostic (ShowDiag))
 import           Distribution.Fields         (showPError, showPWarning)
-import qualified Ide.Plugin.Cabal.Parse      as Lib
+import qualified Distribution.Parsec         as Syntax
 import           Ide.PluginUtils             (extendNextLine)
 import           Language.LSP.Protocol.Types (Diagnostic (..),
                                               DiagnosticSeverity (..),
@@ -23,16 +24,21 @@ import           Language.LSP.Protocol.Types (Diagnostic (..),
                                               Range (Range),
                                               fromNormalizedFilePath)
 
+-- | Produce a diagnostic for a fatal Cabal parser error.
+fatalParseErrorDiagnostic :: NormalizedFilePath -> T.Text -> FileDiagnostic
+fatalParseErrorDiagnostic fp msg =
+  mkDiag fp "cabal" DiagnosticSeverity_Error (toBeginningOfNextLine Syntax.zeroPos) msg
+
 -- | Produce a diagnostic from a Cabal parser error
-errorDiagnostic :: NormalizedFilePath -> Lib.PError -> FileDiagnostic
-errorDiagnostic fp err@(Lib.PError pos _) =
+errorDiagnostic :: NormalizedFilePath -> Syntax.PError -> FileDiagnostic
+errorDiagnostic fp err@(Syntax.PError pos _) =
   mkDiag fp "cabal" DiagnosticSeverity_Error (toBeginningOfNextLine pos) msg
   where
     msg = T.pack $ showPError (fromNormalizedFilePath fp) err
 
 -- | Produce a diagnostic from a Cabal parser warning
-warningDiagnostic :: NormalizedFilePath -> Lib.PWarning -> FileDiagnostic
-warningDiagnostic fp warning@(Lib.PWarning _ pos _) =
+warningDiagnostic :: NormalizedFilePath -> Syntax.PWarning -> FileDiagnostic
+warningDiagnostic fp warning@(Syntax.PWarning _ pos _) =
   mkDiag fp "cabal" DiagnosticSeverity_Warning (toBeginningOfNextLine pos) msg
   where
     msg = T.pack $ showPWarning (fromNormalizedFilePath fp) warning
@@ -41,7 +47,7 @@ warningDiagnostic fp warning@(Lib.PWarning _ pos _) =
 -- only a single source code 'Lib.Position'.
 -- We define the range to be _from_ this position
 -- _to_ the first column of the next line.
-toBeginningOfNextLine :: Lib.Position -> Range
+toBeginningOfNextLine :: Syntax.Position -> Range
 toBeginningOfNextLine cabalPos = extendNextLine $ Range pos pos
    where
     pos = positionFromCabalPosition cabalPos
@@ -53,8 +59,8 @@ toBeginningOfNextLine cabalPos = extendNextLine $ Range pos pos
 --
 -- >>> positionFromCabalPosition $ Lib.Position 1 1
 -- Position 0 0
-positionFromCabalPosition :: Lib.Position -> Position
-positionFromCabalPosition (Lib.Position line column) = Position (fromIntegral line') (fromIntegral col')
+positionFromCabalPosition :: Syntax.Position -> Position
+positionFromCabalPosition (Syntax.Position line column) = Position (fromIntegral line') (fromIntegral col')
   where
     -- LSP is zero-based, Cabal is one-based
     line' = line-1

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

@@ -0,0 +1,24 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Ide.Plugin.Cabal.Orphans where
+import           Control.DeepSeq
+import           Distribution.Fields.Field
+import           Distribution.Parsec.Position
+
+-- ----------------------------------------------------------------
+-- Cabal-syntax orphan instances we need sometimes
+-- ----------------------------------------------------------------
+
+instance NFData (Field Position) where
+    rnf (Field name fieldLines) = rnf name `seq` rnf fieldLines
+    rnf (Section name sectionArgs fields) =  rnf name `seq` rnf sectionArgs `seq` rnf fields
+
+instance NFData (Name Position) where
+    rnf (Name ann fName) = rnf ann `seq` rnf fName
+
+instance NFData (FieldLine Position) where
+    rnf (FieldLine ann bs) = rnf ann `seq` rnf bs
+
+instance NFData (SectionArg Position) where
+    rnf (SecArgName ann bs)  = rnf ann `seq` rnf bs
+    rnf (SecArgStr ann bs)   = rnf ann `seq` rnf bs
+    rnf (SecArgOther ann bs) = rnf ann `seq` rnf bs

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

@@ -1,13 +1,7 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Ide.Plugin.Cabal.Parse
 ( parseCabalFileContents
-  -- * Re-exports
-, FilePath
-, NonEmpty(..)
-, PWarning(..)
-, Version
-, PError(..)
-, Position(..)
-, GenericPackageDescription(..)
+, readCabalFields
 ) where
 
 import qualified Data.ByteString                              as BS
@@ -16,12 +10,31 @@ import           Distribution.Fields                          (PError (..),
                                                                PWarning (..))
 import           Distribution.Fields.ParseResult              (runParseResult)
 import           Distribution.PackageDescription.Parsec       (parseGenericPackageDescription)
-import           Distribution.Parsec.Position                 (Position (..))
 import           Distribution.Types.GenericPackageDescription (GenericPackageDescription (..))
 import           Distribution.Types.Version                   (Version)
+import qualified Ide.Plugin.Cabal.Diagnostics                 as Diagnostics
+
+import qualified Data.Text                                    as T
+import           Development.IDE
+import qualified Distribution.Fields.Parser                   as Syntax
+import qualified Distribution.Parsec.Position                 as Syntax
+
 
 parseCabalFileContents
   :: BS.ByteString -- ^ UTF-8 encoded bytestring
   -> IO ([PWarning], Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
 parseCabalFileContents bs =
   pure $ runParseResult (parseGenericPackageDescription bs)
+
+readCabalFields ::
+  NormalizedFilePath ->
+  BS.ByteString ->
+  Either FileDiagnostic [Syntax.Field Syntax.Position]
+readCabalFields file contents  = do
+  case Syntax.readFields' contents of
+    Left parseError ->
+      Left $ Diagnostics.fatalParseErrorDiagnostic file
+           $ "Failed to parse cabal file: " <> T.pack (show parseError)
+    Right (fields, _warnings) -> do
+      -- we don't want to double report diagnostics, all diagnostics are produced by 'ParseCabalFile'.
+      Right fields

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

@@ -9,6 +9,7 @@ import qualified Data.ByteString                                as ByteString
 import           Data.Maybe                                     (mapMaybe)
 import qualified Data.Text                                      as T
 import qualified Development.IDE.Plugin.Completions.Types       as Ghcide
+import           Distribution.PackageDescription                (GenericPackageDescription)
 import           Distribution.PackageDescription.Parsec         (parseGenericPackageDescriptionMaybe)
 import           Ide.Plugin.Cabal.Completion.Completer.FilePath
 import           Ide.Plugin.Cabal.Completion.Completer.Module
@@ -17,7 +18,6 @@ import           Ide.Plugin.Cabal.Completion.Completer.Types    (CompleterData (
 import           Ide.Plugin.Cabal.Completion.Completions
 import           Ide.Plugin.Cabal.Completion.Types              (CabalPrefixInfo (..),
                                                                  StanzaName)
-import           Ide.Plugin.Cabal.Parse                         (GenericPackageDescription)
 import qualified Language.LSP.Protocol.Lens                     as L
 import           System.FilePath
 import           Test.Hls

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

@@ -1,18 +1,20 @@
 {-# LANGUAGE DisambiguateRecordFields #-}
 {-# LANGUAGE LambdaCase               #-}
 {-# LANGUAGE OverloadedStrings        #-}
+{-# LANGUAGE QuasiQuotes              #-}
 
 module Context where
 
-import           Control.Monad.Trans.Maybe                   (runMaybeT)
 import qualified Data.Text                                   as T
-import qualified Data.Text.Utf16.Rope.Mixed                  as Rope
+import qualified Data.Text.Encoding                          as Text
+import           Development.IDE.Plugin.Completions.Types    (PosPrefixInfo (..))
 import           Ide.Plugin.Cabal
 import           Ide.Plugin.Cabal.Completion.Completer.Paths
 import           Ide.Plugin.Cabal.Completion.Completions
 import           Ide.Plugin.Cabal.Completion.Types           (Context,
                                                               FieldContext (KeyWord, None),
                                                               StanzaContext (Stanza, TopLevel))
+import qualified Ide.Plugin.Cabal.Parse                      as Parse
 import           Test.Hls
 import           Utils                                       as T
 
@@ -22,7 +24,7 @@ cabalPlugin = mkPluginTestDescriptor descriptor "cabal context"
 contextTests :: TestTree
 contextTests =
     testGroup
-        "Context Tests "
+        "Context Tests"
         [ pathCompletionInfoFromCompletionContextTests
         , getContextTests
         ]
@@ -58,39 +60,39 @@ pathCompletionInfoFromCompletionContextTests =
 getContextTests :: TestTree
 getContextTests =
     testGroup
-        "Context Tests"
+        "Context Tests Real"
         [ testCase "Empty File - Start" $ do
             -- for a completely empty file, the context needs to
             -- be top level without a specified keyword
-            ctx <- callGetContext (Position 0 0) "" [""]
+            ctx <- callGetContext (Position 0 0) "" ""
             ctx @?= (TopLevel, None)
         , testCase "Cabal version keyword - no value, no space after :" $ do
             -- on a file, where the keyword is already written
             -- the context should still be toplevel but the keyword should be recognized
-            ctx <- callGetContext (Position 0 14) "" ["cabal-version:"]
+            ctx <- callGetContext (Position 0 14) "" "cabal-version:\n"
             ctx @?= (TopLevel, KeyWord "cabal-version:")
         , testCase "Cabal version keyword - cursor in keyword" $ do
             -- on a file, where the keyword is already written
             -- but the cursor is in the middle of the keyword,
             -- we are not in a keyword context
-            ctx <- callGetContext (Position 0 5) "cabal" ["cabal-version:"]
+            ctx <- callGetContext (Position 0 5) "cabal" "cabal-version:\n"
             ctx @?= (TopLevel, None)
         , testCase "Cabal version keyword - no value, many spaces" $ do
             -- on a file, where the "cabal-version:" keyword is already written
             -- the context should still be top level but the keyword should be recognized
-            ctx <- callGetContext (Position 0 45) "" ["cabal-version:" <> T.replicate 50 " "]
+            ctx <- callGetContext (Position 0 45) "" ("cabal-version:" <> T.replicate 50 " " <> "\n")
             ctx @?= (TopLevel, KeyWord "cabal-version:")
         , testCase "Cabal version keyword - keyword partly written" $ do
             -- in the first line of the file, if the keyword
             -- has not been written completely, the keyword context
             -- should still be None
-            ctx <- callGetContext (Position 0 5) "cabal" ["cabal"]
+            ctx <- callGetContext (Position 0 5) "cabal" "cabal"
             ctx @?= (TopLevel, None)
         , testCase "Cabal version keyword - value partly written" $ do
             -- in the first line of the file, if the keyword
             -- has not been written completely, the keyword context
             -- should still be None
-            ctx <- callGetContext (Position 0 17) "1." ["cabal-version: 1."]
+            ctx <- callGetContext (Position 0 17) "1." "cabal-version: 1."
             ctx @?= (TopLevel, KeyWord "cabal-version:")
         , testCase "Inside Stanza - no keyword" $ do
             -- on a file, where the library stanza has been defined
@@ -102,14 +104,15 @@ getContextTests =
             -- has been defined, the keyword and stanza should be recognized
             ctx <- callGetContext (Position 4 21) "" libraryStanzaData
             ctx @?= (Stanza "library" Nothing, KeyWord "build-depends:")
-        , expectFailBecause "While not valid, it is not that important to make the code more complicated for this" $
-            testCase "Cabal version keyword - no value, next line" $ do
-                -- if the cabal version keyword has been written but without a value,
-                -- in the next line we still should be in top level context with no keyword
-                -- since the cabal version keyword and value pair need to be in the same line
-                ctx <- callGetContext (Position 1 2) "" ["cabal-version:", ""]
-                ctx @?= (TopLevel, None)
-        , testCase "Non-cabal-version keyword - no value, next line indentented position" $ do
+        , testCase "Cabal version keyword - no value, next line" $ do
+            -- if the cabal version keyword has been written but without a value,
+            -- in the next line we still should be in top level context with no keyword
+            -- since the cabal version keyword and value pair need to be in the same line.
+            -- However, that's too much work to implement for virtually no benefit, so we
+            -- test here the status-quo is satisfied.
+            ctx <- callGetContext (Position 1 2) "" "cabal-version:\n\n"
+            ctx @?= (TopLevel, KeyWord "cabal-version:")
+        , testCase "Non-cabal-version keyword - no value, next line indented position" $ do
             -- if a keyword, other than the cabal version keyword has been written
             -- with no value, in the next line we still should be in top level keyword context
             -- of the keyword with no value, since its value may be written in the next line
@@ -153,46 +156,124 @@ getContextTests =
             ctx @?= (TopLevel, KeyWord "name:")
         , testCase "Named Stanza" $ do
             ctx <- callGetContext (Position 2 18) "" executableStanzaData
-            ctx @?= (Stanza "executable" (Just "exeName"), None)
+            ctx @?= (TopLevel, None)
+        , testCase "Multi line, finds context in same line" $ do
+            ctx <- callGetContext (Position 5 18) "" multiLineOptsData
+            ctx @?= (Stanza "library" Nothing, KeyWord "build-depends:")
+        , testCase "Multi line, in the middle of option" $ do
+            ctx <- callGetContext (Position 6 11) "" multiLineOptsData
+            ctx @?= (Stanza "library" Nothing, KeyWord "build-depends:")
+        , testCase "Multi line, finds context in between lines" $ do
+            ctx <- callGetContext (Position 7 8) "" multiLineOptsData
+            ctx @?= (Stanza "library" Nothing, KeyWord "build-depends:")
+        , testCase "Multi line, finds context in between lines, start if line" $ do
+            ctx <- callGetContext (Position 7 0) "" multiLineOptsData
+            ctx @?= (TopLevel, None)
+        , testCase "Multi line, end of option" $ do
+            ctx <- callGetContext (Position 8 14) "" multiLineOptsData
+            ctx @?= (Stanza "library" Nothing, KeyWord "build-depends:")
+        , parameterisedCursorTest "Contexts in large testfile" multiPositionTestData
+            [ (TopLevel, None)
+            , (TopLevel, KeyWord "cabal-version:")
+            , (TopLevel, None)
+            , (TopLevel, KeyWord "description:")
+            , (TopLevel, KeyWord "extra-source-files:")
+            , (TopLevel, None)
+            -- this might not be what we want, maybe add another Context
+            , (TopLevel, None)
+            -- this might not be what we want, maybe add another Context
+            , (TopLevel, None)
+            , (Stanza "source-repository" (Just "head"), None)
+            , (Stanza "source-repository" (Just "head"), KeyWord "type:")
+            , (Stanza "source-repository" (Just "head"), KeyWord "type:")
+            , (Stanza "source-repository" (Just "head"), KeyWord "type:")
+            , (Stanza "source-repository" (Just "head"), None)
+            ]
+            $ \fileContent posPrefInfo ->
+                callGetContext (cursorPos posPrefInfo) (prefixText posPrefInfo) fileContent
         ]
   where
-    callGetContext :: Position -> T.Text -> [T.Text] -> IO Context
+    callGetContext :: Position -> T.Text -> T.Text -> IO Context
     callGetContext pos pref ls = do
-        runMaybeT (getContext mempty (simpleCabalPrefixInfoFromPos pos pref) (Rope.fromText $ T.unlines ls))
-            >>= \case
-                Nothing -> assertFailure "Context must be found"
-                Just ctx -> pure ctx
+        case Parse.readCabalFields "not-real" (Text.encodeUtf8 ls) of
+            Left err -> fail $ show err
+            Right fields -> do
+                getContext mempty (simpleCabalPrefixInfoFromPos pos pref) fields
 
 -- ------------------------------------------------------------------------
 -- Test Data
 -- ------------------------------------------------------------------------
 
-libraryStanzaData :: [T.Text]
-libraryStanzaData =
-    [ "cabal-version:      3.0"
-    , "name:               simple-cabal"
-    , "library "
-    , "    default-language: Haskell98"
-    , "    build-depends:    "
-    , "           "
-    , "ma  "
-    ]
+libraryStanzaData :: T.Text
+libraryStanzaData = [trimming|
+cabal-version:      3.0
+name:               simple-cabal
+library
+    default-language: Haskell98
+    build-depends:
 
-executableStanzaData :: [T.Text]
-executableStanzaData =
-    [ "cabal-version:      3.0"
-    , "name:               simple-cabal"
-    , "executable exeName"
-    , "    default-language: Haskell2010"
-    , "    hs-source-dirs: test/preprocessor"
-    ]
+ma
+|]
 
-topLevelData :: [T.Text]
-topLevelData =
-    [ "cabal-version:      3.0"
-    , "name:"
-    , ""
-    , ""
-    , ""
-    , "          eee"
-    ]
+executableStanzaData :: T.Text
+executableStanzaData = [trimming|
+cabal-version:      3.0
+name:               simple-cabal
+executable exeName
+    default-language: Haskell2010
+    hs-source-dirs: test/preprocessor
+|]
+
+topLevelData :: T.Text
+topLevelData = [trimming|
+cabal-version:      3.0
+name:
+
+
+
+          eee
+|]
+
+multiLineOptsData :: T.Text
+multiLineOptsData = [trimming|
+cabal-version:      3.0
+name:
+
+
+library
+    build-depends:
+        base,
+
+        text ,
+|]
+
+multiPositionTestData :: T.Text
+multiPositionTestData = [trimming|
+cabal-version:      3.4
+       ^             ^
+category:           Development
+^
+name:               haskell-language-server
+description:
+  Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>
+    ^
+extra-source-files:
+  README.md
+  ChangeLog.md
+  test/testdata/**/*.project
+  test/testdata/**/*.cabal
+  test/testdata/**/*.yaml
+  test/testdata/**/*.hs
+  test/testdata/**/*.json
+    ^
+  -- These globs should only match test/testdata
+  plugins/**/*.project
+
+source-repository head
+     ^              ^   ^
+  type:     git
+    ^    ^    ^  ^
+  location: https://github.com/haskell/haskell-language-server
+
+  ^
+|]