hls-haddock-comments-plugin 1.0.0.1 → 1.0.0.2
raw patch · 3 files changed
+36/−34 lines, 3 filesdep −bytestringdep ~ghcidenew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies removed: bytestring
Dependency ranges changed: ghcide
API changes (from Hackage documentation)
Files
- hls-haddock-comments-plugin.cabal +4/−5
- src/Ide/Plugin/HaddockComments.hs +15/−1
- test/Main.hs +17/−28
hls-haddock-comments-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-haddock-comments-plugin-version: 1.0.0.1+version: 1.0.0.2 synopsis: Haddock comments plugin for Haskell Language Server description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server>@@ -25,11 +25,11 @@ -Wno-unticked-promoted-constructors build-depends:- , base >=4.12 && <5+ , base >=4.12 && <5 , containers , ghc , ghc-exactprint- , ghcide ^>=1.2+ , ghcide >=1.2 && <1.5 , hls-plugin-api ^>=1.1 , lsp-types , text@@ -48,8 +48,7 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: , base- , bytestring , filepath , hls-haddock-comments-plugin- , hls-test-utils ^>= 1.0+ , hls-test-utils ^>=1.0 , text
src/Ide/Plugin/HaddockComments.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-}@@ -90,7 +91,11 @@ isFresh Ann {annsDP} = null [() | (AnnComment _, _) <- annsDP] collectKeys = keyFromTyVar 0 +#if MIN_VERSION_ghc(9,0,0)+ comment = mkComment "-- ^ " badRealSrcSpan+#else comment = mkComment "-- ^ " noSrcSpan+#endif dp = [(AnnComment comment, DP (0, 1)), (G AnnRarrow, DP (1, 2))] genForRecord :: GenComments@@ -109,7 +114,11 @@ collectKeys = keyFromCon +#if MIN_VERSION_ghc(9,0,0)+ comment = mkComment "-- | " badRealSrcSpan+#else comment = mkComment "-- | " noSrcSpan+#endif ----------------------------------------------------------------------------- @@ -131,7 +140,7 @@ toRange :: SrcSpan -> Maybe Range toRange src- | (RealSrcSpan s) <- src,+ | (OldRealSrcSpan s) <- src, range' <- realSrcSpanToRange s = Just range' | otherwise = Nothing@@ -146,7 +155,12 @@ ----------------------------------------------------------------------------- keyFromTyVar :: Int -> LHsType GhcPs -> [AnnKey]+#if MIN_VERSION_ghc(9,0,0)+-- GHC9 HsFunTy has 4 arguments, we could extract this+keyFromTyVar dep c@(L _ (HsFunTy _ _ x y))+#else keyFromTyVar dep c@(L _ (HsFunTy _ x y))+#endif | dep < 1 = mkAnnKey c : keyFromTyVar dep x ++ keyFromTyVar dep y | otherwise = [] keyFromTyVar dep (L _ t@HsForAllTy {}) = keyFromTyVar dep (hst_body t)
test/Main.hs view
@@ -1,21 +1,16 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE DisambiguateRecordFields #-}-{-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} module Main- ( main,- )-where+ ( main+ ) where -import qualified Data.ByteString.Lazy as LBS import Data.Foldable (find) import Data.Maybe (mapMaybe) import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8) import qualified Ide.Plugin.HaddockComments as HaddockComments import System.FilePath ((<.>), (</>)) import Test.Hls@@ -23,40 +18,34 @@ main :: IO () main = defaultTestRunner tests -plugin :: PluginDescriptor IdeState-plugin = HaddockComments.descriptor "haddockComments"+haddockCommentsPlugin :: PluginDescriptor IdeState+haddockCommentsPlugin = HaddockComments.descriptor "haddockComments" tests :: TestTree tests = testGroup "haddock comments"- [ goldenTest "HigherRankFunction" Signature 4 6,- goldenTest "KindSigFunction" Signature 9 10,- goldenTest "MultivariateFunction" Signature 4 8,- goldenTest "QualFunction" Signature 2 10,- goldenTest "Record" Record 7 2,+ [ goldenWithHaddockComments "HigherRankFunction" Signature 4 6,+ goldenWithHaddockComments "KindSigFunction" Signature 9 10,+ goldenWithHaddockComments "MultivariateFunction" Signature 4 8,+ goldenWithHaddockComments "QualFunction" Signature 2 10,+ goldenWithHaddockComments "Record" Record 7 2, expectedNothing "ConstFunction" Signature 2 2, expectedNothing "StaleFunction" Signature 3 3, expectedNothing "StaleRecord" Record 3 12 ] -goldenTest :: FilePath -> GenCommentsType -> Int -> Int -> TestTree-goldenTest fp (toTitle -> expectedTitle) l c = goldenGitDiff (fp <> " (golden)") goldenFilePath $- runSessionWithServer plugin haddockCommentsPath $ do- doc <- openDoc hsFilePath "haskell"+goldenWithHaddockComments :: FilePath -> GenCommentsType -> Int -> Int -> TestTree+goldenWithHaddockComments fp (toTitle -> expectedTitle) l c =+ goldenWithHaskellDoc haddockCommentsPlugin (fp <> " (golden)") testDataDir fp "expected" "hs" $ \doc -> do actions <- getCodeActions doc (Range (Position l c) (Position l $ succ c)) case find ((== Just expectedTitle) . caTitle) actions of- Just (InR x) -> do- executeCodeAction x- LBS.fromStrict . encodeUtf8 <$> documentContents doc- _ -> liftIO $ assertFailure "Unable to find CodeAction"- where- hsFilePath = fp <.> "hs"- goldenFilePath = haddockCommentsPath </> fp <.> "expected" <.> "hs"+ Just (InR x) -> executeCodeAction x+ _ -> liftIO $ assertFailure "Unable to find CodeAction" expectedNothing :: FilePath -> GenCommentsType -> Int -> Int -> TestTree expectedNothing fp (toTitle -> expectedTitle) l c = testCase fp $- runSessionWithServer plugin haddockCommentsPath $ do+ runSessionWithServer haddockCommentsPlugin testDataDir $ do doc <- openDoc (fp <.> "hs") "haskell" titles <- mapMaybe caTitle <$> getCodeActions doc (Range (Position l c) (Position l $ succ c)) liftIO $ expectedTitle `notElem` titles @? "Unexpected CodeAction"@@ -71,6 +60,6 @@ caTitle (InR CodeAction {_title}) = Just _title caTitle _ = Nothing -haddockCommentsPath :: String-haddockCommentsPath = "test" </> "testdata"+testDataDir :: String+testDataDir = "test" </> "testdata"