hls-haddock-comments-plugin 1.0.0.0 → 1.0.0.1

raw patch · 16 files changed

+262/−43 lines, 16 filesdep +bytestringdep +filepathdep +hls-haddock-comments-plugindep ~basedep ~ghcidedep ~hls-plugin-apinew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, filepath, hls-haddock-comments-plugin, hls-test-utils

Dependency ranges changed: base, ghcide, hls-plugin-api

API changes (from Hackage documentation)

Files

• hls-haddock-comments-plugin.cabal +41/−19
• src/Ide/Plugin/HaddockComments.hs +28/−24
• test/Main.hs +76/−0
• test/testdata/ConstFunction.hs +4/−0
• test/testdata/HigherRankFunction.expected.hs +9/−0
• test/testdata/HigherRankFunction.hs +6/−0
• test/testdata/KindSigFunction.expected.hs +12/−0
• test/testdata/KindSigFunction.hs +11/−0
• test/testdata/MultivariateFunction.expected.hs +13/−0
• test/testdata/MultivariateFunction.hs +6/−0
• test/testdata/QualFunction.expected.hs +6/−0
• test/testdata/QualFunction.hs +4/−0
• test/testdata/Record.expected.hs +20/−0
• test/testdata/Record.hs +14/−0
• test/testdata/StaleFunction.hs +6/−0
• test/testdata/StaleRecord.hs +6/−0

@@ -1,33 +1,55 @@-cabal-version: 2.2-name:          hls-haddock-comments-plugin-version:       1.0.0.0-synopsis:      Haddock comments plugin for Haskell Language Server+cabal-version:      2.4+name:               hls-haddock-comments-plugin+version:            1.0.0.1+synopsis:           Haddock comments plugin for Haskell Language Server description:   Please see the README on GitHub at <https://github.com/haskell/haskell-language-server> -license:       Apache-2.0-license-file:  LICENSE-author:        Potato Hatsue-maintainer:    berberman@yandex.com-category:      Development-build-type:    Simple-homepage:      https://github.com/haskell/haskell-language-server-bug-reports:   https://github.com/haskell/haskell-language-server/issues+license:            Apache-2.0+license-file:       LICENSE+author:             Potato Hatsue+maintainer:         berberman@yandex.com+category:           Development+build-type:         Simple+homepage:           https://github.com/haskell/haskell-language-server+bug-reports:        https://github.com/haskell/haskell-language-server/issues+extra-source-files:+  LICENSE+  test/testdata/*.hs  library-  exposed-modules:  Ide.Plugin.HaddockComments-  hs-source-dirs:   src-  ghc-options:      -Wall -Wno-name-shadowing -Wredundant-constraints -Wno-unticked-promoted-constructors+  exposed-modules:    Ide.Plugin.HaddockComments+  hs-source-dirs:     src+  ghc-options:+    -Wall -Wno-name-shadowing -Wredundant-constraints+    -Wno-unticked-promoted-constructors+   build-depends:-    , base                  >=4.12 && <5+    , base                  >=4.12    && <5     , containers     , ghc     , ghc-exactprint-    , ghcide                ^>= 1.0.0.0+    , ghcide                ^>=1.2+    , hls-plugin-api        ^>=1.1     , lsp-types-    , hls-plugin-api        ^>= 1.0.0.0     , text     , unordered-containers +  default-language:   Haskell2010+  default-extensions:+    DataKinds+    TypeOperators++test-suite tests+  type:             exitcode-stdio-1.0   default-language: Haskell2010-  default-extensions: DataKinds, TypeOperators+  hs-source-dirs:   test+  main-is:          Main.hs+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N+  build-depends:+    , base+    , bytestring+    , filepath+    , hls-haddock-comments-plugin+    , hls-test-utils  ^>= 1.0+    , text

@@ -1,25 +1,26 @@ {-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE NamedFieldPuns            #-}+{-# LANGUAGE OverloadedStrings         #-}+{-# LANGUAGE RecordWildCards           #-}+{-# LANGUAGE ViewPatterns              #-}  module Ide.Plugin.HaddockComments (descriptor) where -import Control.Monad (join)-import qualified Data.HashMap.Strict as HashMap-import qualified Data.Map as Map-import qualified Data.Text as T-import Development.IDE hiding (pluginHandlers)-import Development.IDE.GHC.Compat-import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (..), annsA, astA)-import Ide.Types-import Language.Haskell.GHC.ExactPrint-import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs)-import Language.Haskell.GHC.ExactPrint.Utils-import Language.LSP.Types-import Control.Monad.IO.Class+import           Control.Monad                         (join)+import           Control.Monad.IO.Class+import qualified Data.HashMap.Strict                   as HashMap+import qualified Data.Map                              as Map+import qualified Data.Text                             as T+import           Development.IDE                       hiding (pluginHandlers)+import           Development.IDE.GHC.Compat+import           Development.IDE.GHC.ExactPrint        (GetAnnotatedParsedSource (..),+                                                        annsA, astA)+import           Ide.Types+import           Language.Haskell.GHC.ExactPrint+import           Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs)+import           Language.Haskell.GHC.ExactPrint.Utils+import           Language.LSP.Types  ----------------------------------------------------------------------------- descriptor :: PluginId -> PluginDescriptor IdeState@@ -50,11 +51,11 @@ -- | Defines how to generate haddock comments by tweaking annotations of AST data GenComments = forall a.   GenComments-  { title :: T.Text,-    fromDecl :: HsDecl GhcPs -> Maybe a,-    collectKeys :: a -> [AnnKey],-    isFresh :: Annotation -> Bool,-    updateAnn :: Annotation -> Annotation,+  { title         :: T.Text,+    fromDecl      :: HsDecl GhcPs -> Maybe a,+    collectKeys   :: a -> [AnnKey],+    isFresh       :: Annotation -> Bool,+    updateAnn     :: Annotation -> Annotation,     updateDeclAnn :: Annotation -> Annotation   } @@ -81,7 +82,7 @@     title = "Generate signature comments"      fromDecl (SigD _ (TypeSig _ _ (HsWC _ (HsIB _ x)))) = Just x-    fromDecl _ = Nothing+    fromDecl _                                          = Nothing      updateAnn x = x {annEntryDelta = DP (0, 1), annsDP = dp}     updateDeclAnn = cleanPriorComments@@ -124,6 +125,9 @@     _edit = Just WorkspaceEdit {..}     _isPreferred = Nothing     _disabled = Nothing+    _xdata = Nothing+    _changeAnnotations = Nothing+  toRange :: SrcSpan -> Maybe Range toRange src

@@ -0,0 +1,76 @@+{-# LANGUAGE DataKinds                #-}+{-# LANGUAGE DisambiguateRecordFields #-}+{-# LANGUAGE GADTs                    #-}+{-# LANGUAGE NamedFieldPuns           #-}+{-# LANGUAGE OverloadedStrings        #-}+{-# LANGUAGE TypeOperators            #-}+{-# LANGUAGE ViewPatterns             #-}++module Main+  ( 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++main :: IO ()+main = defaultTestRunner tests++plugin :: PluginDescriptor IdeState+plugin = 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,+      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"+    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"++expectedNothing :: FilePath -> GenCommentsType -> Int -> Int -> TestTree+expectedNothing fp (toTitle -> expectedTitle) l c = testCase fp $+  runSessionWithServer plugin haddockCommentsPath $ 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"++data GenCommentsType = Signature | Record++toTitle :: GenCommentsType -> Text+toTitle Signature = "Generate signature comments"+toTitle Record    = "Generate fields comments"++caTitle :: (Command |? CodeAction) -> Maybe Text+caTitle (InR CodeAction {_title}) = Just _title+caTitle _                         = Nothing++haddockCommentsPath :: String+haddockCommentsPath = "test" </> "testdata"+

@@ -0,0 +1,4 @@+module ConstFunction where++f :: Int+f = 233

@@ -0,0 +1,9 @@+{-# LANGUAGE RankNTypes #-}++module HigherRankFunction where++f :: (forall a. [a] -> Int) -- ^ +  -> [b] -- ^ +  -> [c] -- ^ +  -> (Int, Int)+f l xs ys = (l xs, l ys)

@@ -0,0 +1,6 @@+{-# LANGUAGE RankNTypes #-}++module HigherRankFunction where++f :: (forall a. [a] -> Int) -> [b] -> [c] -> (Int, Int)+f l xs ys = (l xs, l ys)

@@ -0,0 +1,12 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}++module KindSigFunction where++import GHC.TypeLits++f :: KnownSymbol k => (proxy :: k -> *) k -- ^ +  -> String+f = symbolVal

@@ -0,0 +1,11 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}++module KindSigFunction where++import GHC.TypeLits++f :: KnownSymbol k => (proxy :: k -> *) k -> String+f = symbolVal

@@ -0,0 +1,13 @@+module MultivariateFunction where++-- | some+-- docs+f :: a -- ^ +  -> b -- ^ +  -> c -- ^ +  -> d -- ^ +  -> e -- ^ +  -> f -- ^ +  -> g -- ^ +  -> g+f _ _ _ _ _ _ x = x

@@ -0,0 +1,6 @@+module MultivariateFunction where++-- | some+-- docs+f :: a -> b -> c -> d -> e -> f -> g -> g+f _ _ _ _ _ _ x = x

@@ -0,0 +1,6 @@+module QualFunction where++f :: (Show a, Show b) => a -- ^ +  -> b -- ^ +  -> String+f x y = show x <> show y

@@ -0,0 +1,4 @@+module QualFunction where++f :: (Show a, Show b) => a -> b -> String+f x y = show x <> show y

@@ -0,0 +1,20 @@+module Record where++-- | A record+data Record a b c d e f+  = RecordA+      {+      -- | +      a :: a,+      -- | +      b :: b+      }+  | Pair c d+  | RecordB+      {+      -- | +      c :: e,+      -- | +      d :: f+      }+  | Void

@@ -0,0 +1,14 @@+module Record where++-- | A record+data Record a b c d e f+  = RecordA+      { a :: a,+        b :: b+      }+  | Pair c d+  | RecordB+      { c :: e,+        d :: f+      }+  | Void

@@ -0,0 +1,6 @@+module StaleFunction where++f :: a +  -> b -- ^ ...+  -> c -> c+f _ _ c = c

@@ -0,0 +1,6 @@+module StaleRecord where++data Record = Record+  { a :: Int, -- ^ ...+    b :: String+  }