From 0e2af2a25f02f57b589141cc7028fcbe2248fea8 Mon Sep 17 00:00:00 2001 From: Paul Brinkmeier Date: Fri, 11 Oct 2024 11:18:47 +0200 Subject: [PATCH 1/9] Add text about running just plugin tests and using TASTY_PATTERN --- docs/contributing/contributing.md | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/docs/contributing/contributing.md b/docs/contributing/contributing.md index c38ce0421d..049c7a7b9f 100644 --- a/docs/contributing/contributing.md +++ b/docs/contributing/contributing.md @@ -81,6 +81,14 @@ Running just the wrapper tests $ cabal test wrapper-test ``` +Running just the tests for a specific plugin + +```bash +$ cabal test hls--plugin-tests +# E.g. +$ cabal test hls-refactor-plugin-tests +``` + Running a subset of tests Tasty supports providing @@ -99,6 +107,13 @@ An alternative, which only recompiles when tests (or dependencies) change: $ cabal run haskell-language-server:func-test -- -p "hlint enables" ``` +Yet another way to pass the pattern without recompilation is to use the `TASTY_PATTERN` environment variable. +Run any of the `cabal test` commands above and set it to your pattern, e.g.: + +```bash +$ TASTY_PATTERN='-p hlint' cabal test func-test +``` + ## Using HLS on HLS code Refer to the [HLS project configuration guidelines](../configuration.md#configuring-your-project-build) as they also apply to the HLS project itself. From 4cc51d38ae41725b2e00f317ef327ac62a20156c Mon Sep 17 00:00:00 2001 From: Paul Brinkmeier Date: Fri, 11 Oct 2024 11:29:35 +0200 Subject: [PATCH 2/9] fixup! Add text about running just plugin tests and using TASTY_PATTERN --- docs/contributing/contributing.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/contributing/contributing.md b/docs/contributing/contributing.md index 049c7a7b9f..6f264de96e 100644 --- a/docs/contributing/contributing.md +++ b/docs/contributing/contributing.md @@ -111,7 +111,7 @@ Yet another way to pass the pattern without recompilation is to use the `TASTY_P Run any of the `cabal test` commands above and set it to your pattern, e.g.: ```bash -$ TASTY_PATTERN='-p hlint' cabal test func-test +$ TASTY_PATTERN='hlint' cabal test func-test ``` ## Using HLS on HLS code From 6c4189c31ec4006eac13d691fe6c2b7e0c07edd6 Mon Sep 17 00:00:00 2001 From: Paul Brinkmeier Date: Fri, 11 Oct 2024 14:42:12 +0200 Subject: [PATCH 3/9] Remove docs for passing tasty pattern using cabal run --- docs/contributing/contributing.md | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/docs/contributing/contributing.md b/docs/contributing/contributing.md index 6f264de96e..5d01154d8c 100644 --- a/docs/contributing/contributing.md +++ b/docs/contributing/contributing.md @@ -100,15 +100,7 @@ $ cabal test func-test --test-option "-p hlint" ``` The above recompiles everything every time you use a different test option though. - -An alternative, which only recompiles when tests (or dependencies) change: - -```bash -$ cabal run haskell-language-server:func-test -- -p "hlint enables" -``` - -Yet another way to pass the pattern without recompilation is to use the `TASTY_PATTERN` environment variable. -Run any of the `cabal test` commands above and set it to your pattern, e.g.: +An alternative, which only recompiles when tests (or dependencies) change is to pass the `TASTY_PATTERN` environment variable: ```bash $ TASTY_PATTERN='hlint' cabal test func-test From 15f786255ff6baa23226fa7b3b9247b8e167fd38 Mon Sep 17 00:00:00 2001 From: Paul Brinkmeier Date: Sat, 12 Oct 2024 12:03:15 +0200 Subject: [PATCH 4/9] Linearize hover handler using MaybeT --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 39 +++++++++++-------- 1 file changed, 23 insertions(+), 16 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index d68f61639a..a4b9d92733 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -12,7 +12,9 @@ import Control.Lens ((^.)) import Control.Monad.Extra import Control.Monad.IO.Class import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Maybe (runMaybeT) +import Control.Monad.Trans.Maybe (MaybeT (..), + hoistMaybe, + runMaybeT) import qualified Data.ByteString as BS import Data.Hashable import Data.HashMap.Strict (HashMap) @@ -349,22 +351,27 @@ cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) -- If found that the filtered hover message is a dependency, -- adds a Documentation link. hover :: PluginMethodHandler IdeState LSP.Method_TextDocumentHover -hover ide _ msgParam = do - nfp <- getNormalizedFilePathE uri - cabalFields <- runActionE "cabal.cabal-hover" ide $ useE ParseCabalFields nfp - case CabalFields.findTextWord cursor cabalFields of - Nothing -> - pure $ InR Null - Just cursorText -> do - gpd <- runActionE "cabal.GPD" ide $ useE ParseCabalFile nfp - let depsNames = map dependencyName $ allBuildDepends $ flattenPackageDescription gpd - case filterVersion cursorText of - Nothing -> pure $ InR Null - Just txt -> - if txt `elem` depsNames - then pure $ foundHover (Nothing, [txt <> "\n", documentationText txt]) - else pure $ InR Null +hover ide _ msgParam = getHoverMessage >>= showHoverMessage where + -- Return the tooltip content for a hovered name... + getHoverMessage = runMaybeT $ do + nfp <- lift $ getNormalizedFilePathE uri + cabalFields <- lift $ runActionE "cabal.cabal-hover" ide $ useE ParseCabalFields nfp + -- ... at the cursor position... + cursorText <- hoistMaybe $ CabalFields.findTextWord cursor cabalFields + -- ... without any version information... + txt <- hoistMaybe $ filterVersion cursorText + -- ... and only if it's a listed depdendency. + gpd <- lift $ runActionE "cabal.GPD" ide $ useE ParseCabalFile nfp + let depsNames = map dependencyName $ allBuildDepends $ flattenPackageDescription gpd + guard $ txt `elem` depsNames + + pure [txt <> "\n", documentationText txt] + + showHoverMessage = \case + Nothing -> pure $ InR Null + Just message -> pure $ foundHover (Nothing, message) + cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position) uri = msgParam ^. JL.textDocument . JL.uri From 4b922a65679b1c1f543b0431722bf4b1968ab2b7 Mon Sep 17 00:00:00 2001 From: Paul Brinkmeier Date: Sat, 12 Oct 2024 13:17:49 +0200 Subject: [PATCH 5/9] Add output of cabal info to package hover tooltip --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index a4b9d92733..5a34faefba 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -68,6 +68,8 @@ import Text.Regex.TDFA import qualified Data.Text () import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd +import System.Exit (ExitCode (ExitSuccess)) +import System.Process (readProcessWithExitCode) data Log = LogModificationTime NormalizedFilePath FileVersion @@ -366,7 +368,9 @@ hover ide _ msgParam = getHoverMessage >>= showHoverMessage let depsNames = map dependencyName $ allBuildDepends $ flattenPackageDescription gpd guard $ txt `elem` depsNames - pure [txt <> "\n", documentationText txt] + cabalInfo <- MaybeT $ liftIO $ execCabalInfo txt + + pure [txt <> "\n", cabalInfo, documentationText txt] showHoverMessage = \case Nothing -> pure $ InR Null @@ -396,6 +400,14 @@ hover ide _ msgParam = getHoverMessage >>= showHoverMessage getMatch (_, _, _, [dependency]) = Just dependency getMatch (_, _, _, _) = Nothing -- impossible case + execCabalInfo :: T.Text -> IO (Maybe T.Text) + execCabalInfo package = do + (exitCode, stdout, _stderr) <- readProcessWithExitCode "cabal" ["info", T.unpack package] "" + if exitCode == System.Exit.ExitSuccess then + pure $ Just $ T.pack stdout + else + pure Nothing + documentationText :: T.Text -> T.Text documentationText package = "[Documentation](https://hackage.haskell.org/package/" <> package <> ")" From 3a68af41adf732641d856777e5bf2173bd3518cc Mon Sep 17 00:00:00 2001 From: Paul Brinkmeier Date: Sat, 12 Oct 2024 15:47:32 +0200 Subject: [PATCH 6/9] Add simple test and implementation for a cabal info parser --- haskell-language-server.cabal | 3 + .../src/Ide/Plugin/Cabal/CabalInfoParser.hs | 90 +++++++++++++++ .../hls-cabal-plugin/test/CabalInfoParser.hs | 20 ++++ plugins/hls-cabal-plugin/test/Main.hs | 2 + .../test/testdata/cabal-info/text.cabal-info | 105 ++++++++++++++++++ 5 files changed, 220 insertions(+) create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalInfoParser.hs create mode 100644 plugins/hls-cabal-plugin/test/CabalInfoParser.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-info/text.cabal-info diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 447882a61e..87ca0bef17 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -237,6 +237,7 @@ library hls-cabal-plugin buildable: False exposed-modules: Ide.Plugin.Cabal + Ide.Plugin.Cabal.CabalInfoParser Ide.Plugin.Cabal.Diagnostics Ide.Plugin.Cabal.Completion.CabalFields Ide.Plugin.Cabal.Completion.Completer.FilePath @@ -273,6 +274,7 @@ library hls-cabal-plugin , lens , lsp ^>=2.7 , lsp-types ^>=2.3 + , megaparsec , regex-tdfa ^>=1.3.1 , text , text-rope @@ -296,6 +298,7 @@ test-suite hls-cabal-plugin-tests main-is: Main.hs other-modules: CabalAdd + CabalInfoParser Completer Context Definition diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalInfoParser.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalInfoParser.hs new file mode 100644 index 0000000000..e32484c0b5 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalInfoParser.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | This module allows you to parse the output of @cabal info@. +module Ide.Plugin.Cabal.CabalInfoParser (parseCabalInfo, cabalInfo) where + +import Data.Map.Strict (Map) +import Data.Text (Text) +import Data.Void (Void) +import Text.Megaparsec (MonadParsec (..), Parsec, chunk, many, + parse, sepBy, single, (<|>)) + +import Control.Monad (void) +import Data.Either.Extra (mapLeft) +import qualified Data.Map.Strict as Map +import qualified Data.Text as T + +type Parser = Parsec Void Text + +parseCabalInfo :: Text -> Either CabalInfoParserError (Map Text (Map Text [Text])) +parseCabalInfo = mapLeft (T.pack . show) . parse cabalInfo "" + +type CabalInfoParserError = Text + +-- TODO: parse eof at the end to avoid early exits +cabalInfo :: Parser (Map Text (Map Text [Text])) +cabalInfo = do + entries <- cabalInfoEntry `sepBy` chunk "\n\n" + void $ takeWhileP (Just "trailing whitespace") (`elem` (" \t\r\n" :: String)) + eof + + pure $ Map.fromList entries + +cabalInfoEntry :: Parser (Text, Map Text [Text]) +cabalInfoEntry = do + void $ single '*' + void spaces + + name <- takeWhileP (Just "package name") (/= ' ') + + void restOfLine + + pairs <- many $ try kvPair + + pure (name, Map.fromList pairs) + +kvPair :: Parser (Text, [Text]) +kvPair = do + spacesBeforeKey <- spaces + key <- takeWhileP (Just "field name") (/= ':') + void $ single ':' + spacesAfterKey <- spaces + firstLine <- restOfLine + + -- The first line of the field may be empty. + -- In this case, we have to look at the second line to determine + -- the indentation depth. + if T.null firstLine then do + spacesBeforeFirstLine <- spaces + firstLine' <- restOfLine + let indent = T.length spacesBeforeFirstLine + lines <- trailingIndentedLines indent + pure (key, firstLine' : lines) + -- If the first line is *not* empty, we can determine the indentation + -- depth by calculating how many characters came before it. + else do + let indent = T.length spacesBeforeKey + T.length key + 1 + T.length spacesAfterKey + lines <- trailingIndentedLines indent + pure (key, firstLine : lines) + + where + trailingIndentedLines :: Int -> Parser [Text] + trailingIndentedLines indent = many $ try $ indentedLine indent + +indentedLine :: Int -> Parser Text +indentedLine indent = do + void $ chunk $ T.replicate indent " " + restOfLine + +spaces :: Parser Text +spaces = takeWhileP Nothing (== ' ') + +-- | Parse until next @\n@, return text before that. +restOfLine :: Parser Text +restOfLine = do + s <- takeWhileP (Just "rest of line") (/= '\n') + eolOrEof + pure s + +eolOrEof :: Parser () +eolOrEof = void (single '\n') <|> eof diff --git a/plugins/hls-cabal-plugin/test/CabalInfoParser.hs b/plugins/hls-cabal-plugin/test/CabalInfoParser.hs new file mode 100644 index 0000000000..518e4fb7b8 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/CabalInfoParser.hs @@ -0,0 +1,20 @@ +module CabalInfoParser (cabalInfoParserUnitTests) where + +import System.FilePath (()) +import Test.Hls (TestTree, testCase, + testGroup, (@?)) +import Utils (testDataDir) + +import qualified Data.Text.IO as TIO + +import Data.Either (isRight) +import Ide.Plugin.Cabal.CabalInfoParser (parseCabalInfo) + +cabalInfoParserUnitTests :: TestTree +cabalInfoParserUnitTests = testGroup "cabal info Parser Tests" + [ simpleParsingWorks + ] + where + simpleParsingWorks = testCase "Simple parsing works" $ do + res <- parseCabalInfo <$> TIO.readFile (testDataDir "cabal-info" "text.cabal-info") + isRight res @? "Failed to parse well-formed input" diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 499d4aa569..4f5bed8f15 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -7,6 +7,7 @@ module Main ( ) where import CabalAdd (cabalAddTests) +import CabalInfoParser (cabalInfoParserUnitTests) import Completer (completerTests) import Context (contextTests) import Control.Lens ((^.)) @@ -51,6 +52,7 @@ unitTests = "Unit Tests" [ cabalParserUnitTests , codeActionUnitTests + , cabalInfoParserUnitTests ] cabalParserUnitTests :: TestTree diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-info/text.cabal-info b/plugins/hls-cabal-plugin/test/testdata/cabal-info/text.cabal-info new file mode 100644 index 0000000000..097b9ac177 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-info/text.cabal-info @@ -0,0 +1,105 @@ +* text (library) + Synopsis: An efficient packed Unicode text type. + djaksldjks + Versions available: 0.11.3.1, 1.1.1.4, 1.2.4.1, 1.2.5.0, 2.0, 2.0.1, 2.0.2, + 2.1, 2.1.1 (and 70 others) + Versions installed: 2.0.2 + Homepage: https://github.com/haskell/text + Bug reports: https://github.com/haskell/text/issues + Description: An efficient packed, immutable Unicode text type (both strict + and lazy). + + The 'Text' type represents Unicode character strings, in a + time and space-efficient manner. This package provides text + processing capabilities that are optimized for performance + critical use, both in terms of large data quantities and high + speed. + + The 'Text' type provides character-encoding, type-safe case + conversion via whole-string case conversion functions (see + "Data.Text"). It also provides a range of functions for + converting 'Text' values to and from 'ByteStrings', using + several standard encodings (see "Data.Text.Encoding"). + + Efficient locale-sensitive support for text IO is also + supported (see "Data.Text.IO"). + + These modules are intended to be imported qualified, to avoid + name clashes with Prelude functions, e.g. + + > import qualified Data.Text as T + + == ICU Support + + To use an extended and very rich family of functions for + working with Unicode text (including normalization, regular + expressions, non-standard encodings, text breaking, and + locales), see the [text-icu + package](https://hackage.haskell.org/package/text-icu) based + on the well-respected and liberally licensed [ICU + library](http://site.icu-project.org/). + Category: Data, Text + License: BSD-2-Clause + Author: Bryan O'Sullivan + Maintainer: Haskell Text Team , Core Libraries Committee + Source repo: https://github.com/haskell/text + Flags: developer, simdutf, pure-haskell + Dependencies: array >=0.3 && <0.6, base >=4.10 && <5, binary >=0.5 && <0.9, + bytestring >=0.10.4 && <0.13, deepseq >=1.1 && <1.6, + ghc-prim >=0.2 && <0.12, template-haskell >=2.5 && <2.23, + system-cxx-std-lib ==1.0, base <0, + data-array-byte >=0.1 && <0.2, QuickCheck >=2.12.6 && <2.15, + base <5, bytestring, deepseq, directory, ghc-prim, tasty, + tasty-hunit, tasty-quickcheck, template-haskell, + transformers, text, data-array-byte >=0.1 && <0.2, + tasty-inspection-testing, base, bytestring >=0.10.4, + containers, deepseq, directory, filepath, tasty-bench >=0.2, + text, transformers + Documentation: [ Not installed ] + Cached: No + Modules: + Data.Text + Data.Text.Array + Data.Text.Encoding + Data.Text.Encoding.Error + Data.Text.Foreign + Data.Text.IO + Data.Text.Internal + Data.Text.Internal.Builder + Data.Text.Internal.Builder.Functions + Data.Text.Internal.Builder.Int.Digits + Data.Text.Internal.Builder.RealFloat.Functions + Data.Text.Internal.ByteStringCompat + Data.Text.Internal.Encoding + Data.Text.Internal.Encoding.Fusion + Data.Text.Internal.Encoding.Fusion.Common + Data.Text.Internal.Encoding.Utf16 + Data.Text.Internal.Encoding.Utf32 + Data.Text.Internal.Encoding.Utf8 + Data.Text.Internal.Fusion + Data.Text.Internal.Fusion.CaseMapping + Data.Text.Internal.Fusion.Common + Data.Text.Internal.Fusion.Size + Data.Text.Internal.Fusion.Types + Data.Text.Internal.IO + Data.Text.Internal.Lazy + Data.Text.Internal.Lazy.Encoding.Fusion + Data.Text.Internal.Lazy.Fusion + Data.Text.Internal.Lazy.Search + Data.Text.Internal.PrimCompat + Data.Text.Internal.Private + Data.Text.Internal.Read + Data.Text.Internal.Search + Data.Text.Internal.StrictBuilder + Data.Text.Internal.Unsafe + Data.Text.Internal.Unsafe.Char + Data.Text.Lazy + Data.Text.Lazy.Builder + Data.Text.Lazy.Builder.Int + Data.Text.Lazy.Builder.RealFloat + Data.Text.Lazy.Encoding + Data.Text.Lazy.IO + Data.Text.Lazy.Internal + Data.Text.Lazy.Read + Data.Text.Read + Data.Text.Unsafe \ No newline at end of file From 0b2597c1a67471354bd236eae810cec76fcd4a47 Mon Sep 17 00:00:00 2001 From: Paul Brinkmeier Date: Sat, 12 Oct 2024 16:21:31 +0200 Subject: [PATCH 7/9] Fix cabal info parser issue --- haskell-language-server.cabal | 1 + .../src/Ide/Plugin/Cabal/CabalInfoParser.hs | 21 +- .../hls-cabal-plugin/test/CabalInfoParser.hs | 29 +- .../cabal-info/containers-base.cabal-info | 326 ++++++++++++++++++ 4 files changed, 363 insertions(+), 14 deletions(-) create mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-info/containers-base.cabal-info diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 87ca0bef17..c5b77e57d9 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -308,6 +308,7 @@ test-suite hls-cabal-plugin-tests , base , bytestring , Cabal-syntax >= 3.7 + , containers , extra , filepath , ghcide diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalInfoParser.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalInfoParser.hs index e32484c0b5..a0b9a0249e 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalInfoParser.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalInfoParser.hs @@ -6,10 +6,10 @@ module Ide.Plugin.Cabal.CabalInfoParser (parseCabalInfo, cabalInfo) where import Data.Map.Strict (Map) import Data.Text (Text) import Data.Void (Void) -import Text.Megaparsec (MonadParsec (..), Parsec, chunk, many, - parse, sepBy, single, (<|>)) +import Text.Megaparsec (MonadParsec (..), Parsec, chunk, failure, + many, parse, single, (<|>)) -import Control.Monad (void) +import Control.Monad (void, when) import Data.Either.Extra (mapLeft) import qualified Data.Map.Strict as Map import qualified Data.Text as T @@ -21,11 +21,9 @@ parseCabalInfo = mapLeft (T.pack . show) . parse cabalInfo "" type CabalInfoParserError = Text --- TODO: parse eof at the end to avoid early exits cabalInfo :: Parser (Map Text (Map Text [Text])) cabalInfo = do - entries <- cabalInfoEntry `sepBy` chunk "\n\n" - void $ takeWhileP (Just "trailing whitespace") (`elem` (" \t\r\n" :: String)) + entries <- many $ try cabalInfoEntry eof pure $ Map.fromList entries @@ -39,13 +37,18 @@ cabalInfoEntry = do void restOfLine - pairs <- many $ try kvPair + pairs <- many $ try field + + void $ takeWhileP (Just "trailing whitespace") (`elem` (" \t\r\n" :: String)) pure (name, Map.fromList pairs) -kvPair :: Parser (Text, [Text]) -kvPair = do +field :: Parser (Text, [Text]) +field = do spacesBeforeKey <- spaces + -- We assume that all fields are indented ==> fail if that ain't so. + when (T.null spacesBeforeKey) $ failure Nothing mempty + key <- takeWhileP (Just "field name") (/= ':') void $ single ':' spacesAfterKey <- spaces diff --git a/plugins/hls-cabal-plugin/test/CabalInfoParser.hs b/plugins/hls-cabal-plugin/test/CabalInfoParser.hs index 518e4fb7b8..f483aae179 100644 --- a/plugins/hls-cabal-plugin/test/CabalInfoParser.hs +++ b/plugins/hls-cabal-plugin/test/CabalInfoParser.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE OverloadedStrings #-} + module CabalInfoParser (cabalInfoParserUnitTests) where import System.FilePath (()) -import Test.Hls (TestTree, testCase, - testGroup, (@?)) +import Test.Hls (Assertion, TestTree, + assertFailure, testCase, + testGroup, (@=?), (@?)) import Utils (testDataDir) import qualified Data.Text.IO as TIO @@ -10,11 +13,27 @@ import qualified Data.Text.IO as TIO import Data.Either (isRight) import Ide.Plugin.Cabal.CabalInfoParser (parseCabalInfo) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Text (Text) + cabalInfoParserUnitTests :: TestTree cabalInfoParserUnitTests = testGroup "cabal info Parser Tests" [ simpleParsingWorks + , simpleMultiEntryParsingWorks ] where - simpleParsingWorks = testCase "Simple parsing works" $ do - res <- parseCabalInfo <$> TIO.readFile (testDataDir "cabal-info" "text.cabal-info") - isRight res @? "Failed to parse well-formed input" + simpleParsingWorks = + testCase "Simple parsing works" $ testParserWithFile "text.cabal-info" $ \ci -> do + Map.keys ci @=? ["text"] + + simpleMultiEntryParsingWorks = + testCase "Simple parsing works for multiple packages" $ testParserWithFile "containers-base.cabal-info" $ \ci -> do + Map.keys ci @=? ["base", "containers"] + +testParserWithFile :: FilePath -> (Map Text (Map Text [Text]) -> Assertion) -> Assertion +testParserWithFile file f = do + res <- parseCabalInfo <$> TIO.readFile (testDataDir "cabal-info" file) + case res of + Left _ -> assertFailure "Failed to parse well-formed input" + Right ci -> f ci diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-info/containers-base.cabal-info b/plugins/hls-cabal-plugin/test/testdata/cabal-info/containers-base.cabal-info new file mode 100644 index 0000000000..ad6cd42bea --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-info/containers-base.cabal-info @@ -0,0 +1,326 @@ +* containers (library) + Synopsis: Assorted concrete container types + Versions available: 0.4.2.1, 0.5.10.1, 0.5.10.2, 0.5.11.0, 0.6.5.1, 0.6.6, + 0.6.7, 0.6.8, 0.7 (and 32 others) + Versions installed: 0.6.7 + Homepage: [ Not specified ] + Bug reports: https://github.com/haskell/containers/issues + Description: This package contains efficient general-purpose + implementations of various immutable container types + including sets, maps, sequences, trees, and graphs. + + For a walkthrough of what this package provides with examples + of common operations see the [containers + introduction](https://haskell-containers.readthedocs.io). + + The declared cost of each operation is either worst-case or + amortized, but remains valid even if structures are shared. + Category: Data Structures + License: BSD3 + Maintainer: libraries@haskell.org + Source repo: http://github.com/haskell/containers.git + Dependencies: base >=4.10 && <5, array >=0.4.0.0, deepseq >=1.2 && <1.6, + template-haskell + Documentation: [ Not installed ] + Cached: No + Modules: + Data.Containers.ListUtils + Data.Graph + Data.IntMap + Data.IntMap.Internal + Data.IntMap.Internal.Debug + Data.IntMap.Lazy + Data.IntMap.Merge.Lazy + Data.IntMap.Merge.Strict + Data.IntMap.Strict + Data.IntMap.Strict.Internal + Data.IntSet + Data.IntSet.Internal + Data.Map + Data.Map.Internal + Data.Map.Internal.Debug + Data.Map.Lazy + Data.Map.Merge.Lazy + Data.Map.Merge.Strict + Data.Map.Strict + Data.Map.Strict.Internal + Data.Sequence + Data.Sequence.Internal + Data.Sequence.Internal.Sorting + Data.Set + Data.Set.Internal + Data.Tree + Utils.Containers.Internal.BitQueue + Utils.Containers.Internal.BitUtil + Utils.Containers.Internal.StrictPair + +* base (library) + Synopsis: Core data structures and operations + Versions available: 3.0.3.1, 3.0.3.2, 4.18.1.0, 4.18.2.0, 4.18.2.1, + 4.19.0.0, 4.19.1.0, 4.20.0.0, 4.20.0.1 (and 43 others) + Versions installed: 4.18.2.1 + Homepage: [ Not specified ] + Bug reports: https://github.com/haskell/core-libraries-committee/issues + Description: Haskell's base library provides, among other things, core + types (e.g. [Bool]("Data.Bool") and [Int]("Data.Int")), data + structures (e.g. [List]("Data.List"), [Tuple]("Data.Tuple") + and [Maybe]("Data.Maybe")), the + [Exception]("Control.Exception") mechanism, and the + [IO]("System.IO") & [Concurrency]("Control.Concurrent") + operations. The "Prelude" module, which is imported by + default, exposes a curated set of types and functions from + other modules. + + Other data structures like + [Map](https://hackage.haskell.org/package/containers/docs/Data-Map.html), + [Set](https://hackage.haskell.org/package/containers/docs/Data-Set.html) + are available in the + [containers](https://hackage.haskell.org/package/containers) + library. To work with textual data, use the + [text](https://hackage.haskell.org/package/text/docs/Data-Text.html) + library. + Category: Prelude + License: BSD-3-Clause + Maintainer: Core Libraries Committee + Source repo: [ Not specified ] + Dependencies: ghc-internal >=9.1001 && <9.1002, ghc-prim + Documentation: [ Not installed ] + Cached: No + Modules: + Control.Applicative + Control.Arrow + Control.Category + Control.Concurrent + Control.Concurrent.Chan + Control.Concurrent.MVar + Control.Concurrent.QSem + Control.Concurrent.QSemN + Control.Exception + Control.Exception.Base + Control.Monad + Control.Monad.Fail + Control.Monad.Fix + Control.Monad.IO.Class + Control.Monad.Instances + Control.Monad.ST + Control.Monad.ST.Lazy + Control.Monad.ST.Lazy.Safe + Control.Monad.ST.Lazy.Unsafe + Control.Monad.ST.Safe + Control.Monad.ST.Strict + Control.Monad.ST.Unsafe + Control.Monad.Zip + Data.Array.Byte + Data.Bifoldable + Data.Bifoldable1 + Data.Bifunctor + Data.Bitraversable + Data.Bits + Data.Bool + Data.Char + Data.Coerce + Data.Complex + Data.Data + Data.Dynamic + Data.Either + Data.Eq + Data.Fixed + Data.Foldable + Data.Foldable1 + Data.Function + Data.Functor + Data.Functor.Classes + Data.Functor.Compose + Data.Functor.Const + Data.Functor.Contravariant + Data.Functor.Identity + Data.Functor.Product + Data.Functor.Sum + Data.IORef + Data.Int + Data.Ix + Data.Kind + Data.List + Data.List.NonEmpty + Data.Maybe + Data.Monoid + Data.Ord + Data.Proxy + Data.Ratio + Data.STRef + Data.STRef.Lazy + Data.STRef.Strict + Data.Semigroup + Data.String + Data.Traversable + Data.Tuple + Data.Type.Bool + Data.Type.Coercion + Data.Type.Equality + Data.Type.Ord + Data.Typeable + Data.Unique + Data.Version + Data.Void + Data.Word + Debug.Trace + Foreign + Foreign.C + Foreign.C.ConstPtr + Foreign.C.Error + Foreign.C.String + Foreign.C.Types + Foreign.Concurrent + Foreign.ForeignPtr + Foreign.ForeignPtr.Safe + Foreign.ForeignPtr.Unsafe + Foreign.Marshal + Foreign.Marshal.Alloc + Foreign.Marshal.Array + Foreign.Marshal.Error + Foreign.Marshal.Pool + Foreign.Marshal.Safe + Foreign.Marshal.Unsafe + Foreign.Marshal.Utils + Foreign.Ptr + Foreign.Safe + Foreign.StablePtr + Foreign.Storable + GHC.Arr + GHC.ArrayArray + GHC.Base + GHC.Bits + GHC.ByteOrder + GHC.Char + GHC.Clock + GHC.Conc + GHC.Conc.IO + GHC.Conc.Signal + GHC.Conc.Sync + GHC.ConsoleHandler + GHC.Constants + GHC.Desugar + GHC.Encoding.UTF8 + GHC.Enum + GHC.Environment + GHC.Err + GHC.Event + GHC.Event.TimeOut + GHC.Exception + GHC.Exception.Type + GHC.ExecutionStack + GHC.ExecutionStack.Internal + GHC.Exts + GHC.Fingerprint + GHC.Fingerprint.Type + GHC.Float + GHC.Float.ConversionUtils + GHC.Float.RealFracMethods + GHC.Foreign + GHC.ForeignPtr + GHC.GHCi + GHC.GHCi.Helpers + GHC.Generics + GHC.IO + GHC.IO.Buffer + GHC.IO.BufferedIO + GHC.IO.Device + GHC.IO.Encoding + GHC.IO.Encoding.CodePage + GHC.IO.Encoding.Failure + GHC.IO.Encoding.Iconv + GHC.IO.Encoding.Latin1 + GHC.IO.Encoding.Types + GHC.IO.Encoding.UTF16 + GHC.IO.Encoding.UTF32 + GHC.IO.Encoding.UTF8 + GHC.IO.Exception + GHC.IO.FD + GHC.IO.Handle + GHC.IO.Handle.FD + GHC.IO.Handle.Internals + GHC.IO.Handle.Lock + GHC.IO.Handle.Text + GHC.IO.Handle.Types + GHC.IO.IOMode + GHC.IO.StdHandles + GHC.IO.SubSystem + GHC.IO.Unsafe + GHC.IOArray + GHC.IOPort + GHC.IORef + GHC.InfoProv + GHC.Int + GHC.Integer + GHC.Integer.Logarithms + GHC.IsList + GHC.Ix + GHC.List + GHC.MVar + GHC.Maybe + GHC.Natural + GHC.Num + GHC.Num.BigNat + GHC.Num.Integer + GHC.Num.Natural + GHC.OldList + GHC.OverloadedLabels + GHC.Pack + GHC.Profiling + GHC.Ptr + GHC.RTS.Flags + GHC.Read + GHC.Real + GHC.Records + GHC.ResponseFile + GHC.ST + GHC.STRef + GHC.Show + GHC.Stable + GHC.StableName + GHC.Stack + GHC.Stack.CCS + GHC.Stack.CloneStack + GHC.Stack.Types + GHC.StaticPtr + GHC.Stats + GHC.Storable + GHC.TopHandler + GHC.TypeError + GHC.TypeLits + GHC.TypeLits.Internal + GHC.TypeNats + GHC.TypeNats.Internal + GHC.Unicode + GHC.Weak + GHC.Weak.Finalize + GHC.Word + Numeric + Numeric.Natural + Prelude + System.CPUTime + System.Console.GetOpt + System.Environment + System.Environment.Blank + System.Exit + System.IO + System.IO.Error + System.IO.Unsafe + System.Info + System.Mem + System.Mem.StableName + System.Mem.Weak + System.Posix.Internals + System.Posix.Types + System.Timeout + Text.ParserCombinators.ReadP + Text.ParserCombinators.ReadPrec + Text.Printf + Text.Read + Text.Read.Lex + Text.Show + Text.Show.Functions + Type.Reflection + Type.Reflection.Unsafe + Unsafe.Coerce + From 36d9b9f5312ddfa28de0cca913fcee75bb69460a Mon Sep 17 00:00:00 2001 From: Paul Brinkmeier Date: Sun, 13 Oct 2024 10:59:11 +0200 Subject: [PATCH 8/9] Add markdownified description on depdendency hover --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 15 +++++++++++++-- .../src/Ide/Plugin/Cabal/CabalInfoParser.hs | 2 ++ 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 5a34faefba..87eb2429e1 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -20,6 +20,7 @@ import Data.Hashable import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import qualified Data.List.NonEmpty as NE +import qualified Data.Map.Strict as Map import qualified Data.Maybe as Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as Encoding @@ -66,8 +67,13 @@ import qualified Language.LSP.VFS as VFS import Text.Regex.TDFA +import Data.Either.Extra (eitherToMaybe) import qualified Data.Text () +import qualified Development.IDE.GHC.Compat as T +import Development.IDE.Spans.Common (spanDocToMarkdown, + spanDocToMarkdownForTest) import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd +import Ide.Plugin.Cabal.CabalInfoParser (parseCabalInfo) import System.Exit (ExitCode (ExitSuccess)) import System.Process (readProcessWithExitCode) @@ -368,9 +374,14 @@ hover ide _ msgParam = getHoverMessage >>= showHoverMessage let depsNames = map dependencyName $ allBuildDepends $ flattenPackageDescription gpd guard $ txt `elem` depsNames - cabalInfo <- MaybeT $ liftIO $ execCabalInfo txt + cabalInfoRaw <- MaybeT $ liftIO $ execCabalInfo txt + cabalInfoData <- hoistMaybe $ eitherToMaybe $ parseCabalInfo cabalInfoRaw - pure [txt <> "\n", cabalInfo, documentationText txt] + let fields = cabalInfoData Map.! txt + let description = T.unlines $ fields Map.! "Description" + let descriptionMarkdown = T.pack $ spanDocToMarkdownForTest $ T.unpack description + + pure [txt <> "\n", descriptionMarkdown <> "\n", documentationText txt] showHoverMessage = \case Nothing -> pure $ InR Null diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalInfoParser.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalInfoParser.hs index a0b9a0249e..90f64c0990 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalInfoParser.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalInfoParser.hs @@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} -- | This module allows you to parse the output of @cabal info@. +-- This is basically a placeholder implementation until cabal info provides +-- machine readable output or Cabal provides an API for this. module Ide.Plugin.Cabal.CabalInfoParser (parseCabalInfo, cabalInfo) where import Data.Map.Strict (Map) From 7c6ebea788fa9f72a5526930cf2e62ea3c6514f4 Mon Sep 17 00:00:00 2001 From: Paul Brinkmeier Date: Sun, 13 Oct 2024 11:29:38 +0200 Subject: [PATCH 9/9] Handle all Nothings --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 29 ++++++++++++------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 87eb2429e1..f3f000a567 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -69,9 +69,7 @@ import Text.Regex.TDFA import Data.Either.Extra (eitherToMaybe) import qualified Data.Text () -import qualified Development.IDE.GHC.Compat as T -import Development.IDE.Spans.Common (spanDocToMarkdown, - spanDocToMarkdownForTest) +import Development.IDE.Spans.Common (spanDocToMarkdownForTest) import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd import Ide.Plugin.Cabal.CabalInfoParser (parseCabalInfo) import System.Exit (ExitCode (ExitSuccess)) @@ -368,20 +366,23 @@ hover ide _ msgParam = getHoverMessage >>= showHoverMessage -- ... at the cursor position... cursorText <- hoistMaybe $ CabalFields.findTextWord cursor cabalFields -- ... without any version information... - txt <- hoistMaybe $ filterVersion cursorText + packageName <- hoistMaybe $ filterVersion cursorText -- ... and only if it's a listed depdendency. gpd <- lift $ runActionE "cabal.GPD" ide $ useE ParseCabalFile nfp let depsNames = map dependencyName $ allBuildDepends $ flattenPackageDescription gpd - guard $ txt `elem` depsNames + guard $ packageName `elem` depsNames - cabalInfoRaw <- MaybeT $ liftIO $ execCabalInfo txt - cabalInfoData <- hoistMaybe $ eitherToMaybe $ parseCabalInfo cabalInfoRaw + rawCabalInfo <- MaybeT $ liftIO $ execCabalInfo packageName - let fields = cabalInfoData Map.! txt - let description = T.unlines $ fields Map.! "Description" - let descriptionMarkdown = T.pack $ spanDocToMarkdownForTest $ T.unpack description + let cabalInfo = eitherToMaybe $ parseCabalInfo rawCabalInfo + liftIO $ print cabalInfo - pure [txt <> "\n", descriptionMarkdown <> "\n", documentationText txt] + case getDescription rawCabalInfo packageName of + Nothing -> + pure [packageName <> "\n", "Description not available\n", documentationText packageName] + Just description -> do + let descriptionMarkdown = T.pack $ spanDocToMarkdownForTest $ T.unpack description + pure [packageName <> "\n", descriptionMarkdown <> "\n", documentationText packageName] showHoverMessage = \case Nothing -> pure $ InR Null @@ -422,6 +423,12 @@ hover ide _ msgParam = getHoverMessage >>= showHoverMessage documentationText :: T.Text -> T.Text documentationText package = "[Documentation](https://hackage.haskell.org/package/" <> package <> ")" + getDescription :: T.Text -> T.Text -> Maybe T.Text + getDescription rawCabalInfo packageName = do + cabalInfo <- eitherToMaybe $ parseCabalInfo rawCabalInfo + pkInfo <- cabalInfo Map.!? packageName + T.unlines <$> pkInfo Map.!? "Description" + -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable