hls-pragmas-plugin 1.0.0.0 → 1.0.0.1
raw patch · 3 files changed
+35/−60 lines, 3 filesdep −lsp-testdep ~hls-plugin-apidep ~hls-test-utilsnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies removed: lsp-test
Dependency ranges changed: hls-plugin-api, hls-test-utils
API changes (from Hackage documentation)
Files
- hls-pragmas-plugin.cabal +9/−10
- src/Ide/Plugin/Pragmas.hs +3/−1
- test/Main.hs +23/−49
hls-pragmas-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-pragmas-plugin-version: 1.0.0.0+version: 1.0.0.1 synopsis: Pragmas plugin for Haskell Language Server description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -18,21 +18,22 @@ test/testdata/*.yaml library- exposed-modules: Ide.Plugin.Pragmas- hs-source-dirs: src+ exposed-modules: Ide.Plugin.Pragmas+ hs-source-dirs: src build-depends:- base >=4.12 && <5+ , base >=4.12 && <5 , extra , fuzzy- , ghcide >=1.2 && <1.4- , hls-plugin-api ^>=1.1+ , ghcide >=1.2 && <1.5+ , hls-plugin-api >=1.1 && <1.3 , lens , lsp , text , transformers , unordered-containers- default-language: Haskell2010 + default-language: Haskell2010+ test-suite tests type: exitcode-stdio-1.0 default-language: Haskell2010@@ -43,8 +44,6 @@ , base , filepath , hls-pragmas-plugin- , hls-test-utils ^>=1.0+ , hls-test-utils >=1.0 && <1.2 , lens- , lsp-test , lsp-types- , text
src/Ide/Plugin/Pragmas.hs view
@@ -6,7 +6,9 @@ {-# LANGUAGE ViewPatterns #-} -- | Provides code actions to add missing pragmas (whenever GHC suggests to)-module Ide.Plugin.Pragmas (descriptor) where+module Ide.Plugin.Pragmas+ ( descriptor+ ) where import Control.Applicative ((<|>)) import Control.Lens hiding (List)
test/Main.hs view
@@ -1,15 +1,9 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-module Main (- main,-) where+{-# LANGUAGE OverloadedStrings #-}+module Main+ ( main+ ) where import Control.Lens ((^.))-import qualified Data.Text as T-import qualified Data.Text.IO as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TL import qualified Ide.Plugin.Pragmas as Pragmas import qualified Language.LSP.Types.Lens as L import System.FilePath@@ -31,78 +25,62 @@ codeActionTests :: TestTree codeActionTests = testGroup "code actions"- [ pragmasGolden "adds TypeSynonymInstances pragma" "NeedsPragmas" $ \path -> do- doc <- openDoc path "haskell"+ [ goldenWithPragmas "adds TypeSynonymInstances pragma" "NeedsPragmas" $ \doc -> do _ <- waitForDiagnosticsFromSource doc "typecheck" cas <- map fromAction <$> getAllCodeActions doc liftIO $ "Add \"TypeSynonymInstances\"" `elem` map (^. L.title) cas @? "Contains TypeSynonymInstances code action" liftIO $ "Add \"FlexibleInstances\"" `elem` map (^. L.title) cas @? "Contains FlexibleInstances code action" executeCodeAction $ head cas- documentContents doc - , pragmasGolden "adds TypeApplications pragma" "TypeApplications" $ \path -> do- doc <- openDoc path "haskell"+ , goldenWithPragmas "adds TypeApplications pragma" "TypeApplications" $ \doc -> do _ <- waitForDiagnosticsFrom doc cas <- map fromAction <$> getAllCodeActions doc liftIO $ "Add \"TypeApplications\"" `elem` map (^. L.title) cas @? "Contains TypeApplications code action" executeCodeAction $ head cas- documentContents doc - , pragmasGolden "no duplication" "NamedFieldPuns" $ \path -> do- doc <- openDoc path "haskell"+ , goldenWithPragmas "no duplication" "NamedFieldPuns" $ \doc -> do _ <- waitForDiagnosticsFrom doc cas <- map fromAction <$> getCodeActions doc (Range (Position 8 9) (Position 8 9)) liftIO $ length cas == 1 @? "Expected one code action, but got: " <> show cas let ca = head cas liftIO $ (ca ^. L.title == "Add \"NamedFieldPuns\"") @? "NamedFieldPuns code action" executeCodeAction ca- documentContents doc - , pragmasGolden "after shebang" "AfterShebang" $ \path -> do- doc <- openDoc path "haskell"+ , goldenWithPragmas "after shebang" "AfterShebang" $ \doc -> do _ <- waitForDiagnosticsFrom doc cas <- map fromAction <$> getAllCodeActions doc liftIO $ "Add \"NamedFieldPuns\"" `elem` map (^. L.title) cas @? "Contains NamedFieldPuns code action" executeCodeAction $ head cas- documentContents doc - , pragmasGolden "append to existing pragmas" "AppendToExisting" $ \path -> do- doc <- openDoc path "haskell"+ , goldenWithPragmas "append to existing pragmas" "AppendToExisting" $ \doc -> do _ <- waitForDiagnosticsFrom doc cas <- map fromAction <$> getAllCodeActions doc liftIO $ "Add \"NamedFieldPuns\"" `elem` map (^. L.title) cas @? "Contains NamedFieldPuns code action" executeCodeAction $ head cas- documentContents doc - , pragmasGolden "before doc comments" "BeforeDocComment" $ \path -> do- doc <- openDoc path "haskell"+ , goldenWithPragmas "before doc comments" "BeforeDocComment" $ \doc -> do _ <- waitForDiagnosticsFrom doc cas <- map fromAction <$> getAllCodeActions doc liftIO $ "Add \"NamedFieldPuns\"" `elem` map (^. L.title) cas @? "Contains NamedFieldPuns code action" executeCodeAction $ head cas- documentContents doc - , pragmasGolden "before doc comments" "MissingSignatures" $ \path -> do- doc <- openDoc path "haskell"+ , goldenWithPragmas "before doc comments" "MissingSignatures" $ \doc -> do _ <- waitForDiagnosticsFrom doc cas <- map fromAction <$> getAllCodeActions doc liftIO $ "Disable \"missing-signatures\" warnings" `elem` map (^. L.title) cas @? "Contains missing-signatures code action" executeCodeAction $ head cas- documentContents doc - , pragmasGolden "before doc comments" "UnusedImports" $ \path -> do- doc <- openDoc path "haskell"+ , goldenWithPragmas "before doc comments" "UnusedImports" $ \doc -> do _ <- waitForDiagnosticsFrom doc cas <- map fromAction <$> getAllCodeActions doc liftIO $ "Disable \"unused-imports\" warnings" `elem` map (^. L.title) cas @? "Contains unused-imports code action" executeCodeAction $ head cas- documentContents doc ] completionTests :: TestTree completionTests = testGroup "completions"- [ testCase "completes pragmas" $ runSessionWithServer pragmasPlugin testDirectory $ do+ [ testCase "completes pragmas" $ runSessionWithServer pragmasPlugin testDataDir $ do doc <- openDoc "Completion.hs" "haskell" _ <- waitForDiagnostics let te = TextEdit (Range (Position 0 4) (Position 0 34)) ""@@ -115,7 +93,7 @@ item ^. L.insertTextFormat @?= Just Snippet item ^. L.insertText @?= Just "LANGUAGE ${1:extension} #-}" - , testCase "completes pragmas no close" $ runSessionWithServer pragmasPlugin testDirectory $ do+ , testCase "completes pragmas no close" $ runSessionWithServer pragmasPlugin testDataDir $ do doc <- openDoc "Completion.hs" "haskell" let te = TextEdit (Range (Position 0 4) (Position 0 24)) "" _ <- applyEdit doc te@@ -127,7 +105,7 @@ item ^. L.insertTextFormat @?= Just Snippet item ^. L.insertText @?= Just "LANGUAGE ${1:extension}" - , testCase "completes options pragma" $ runSessionWithServer pragmasPlugin testDirectory $ do+ , testCase "completes options pragma" $ runSessionWithServer pragmasPlugin testDataDir $ do doc <- openDoc "Completion.hs" "haskell" _ <- waitForDiagnostics let te = TextEdit (Range (Position 0 4) (Position 0 34)) "OPTIONS"@@ -140,7 +118,7 @@ item ^. L.insertTextFormat @?= Just Snippet item ^. L.insertText @?= Just "OPTIONS_GHC -${1:option} #-}" - , testCase "completes ghc options pragma values" $ runSessionWithServer pragmasPlugin testDirectory $ do+ , testCase "completes ghc options pragma values" $ runSessionWithServer pragmasPlugin testDataDir $ do doc <- openDoc "Completion.hs" "haskell" let te = TextEdit (Range (Position 0 0) (Position 0 0)) "{-# OPTIONS_GHC -Wno-red #-}\n" _ <- applyEdit doc te@@ -152,7 +130,7 @@ item ^. L.insertTextFormat @?= Nothing item ^. L.insertText @?= Nothing - , testCase "completes language extensions" $ runSessionWithServer pragmasPlugin testDirectory $ do+ , testCase "completes language extensions" $ runSessionWithServer pragmasPlugin testDataDir $ do doc <- openDoc "Completion.hs" "haskell" _ <- waitForDiagnostics let te = TextEdit (Range (Position 0 24) (Position 0 31)) ""@@ -163,7 +141,7 @@ item ^. L.label @?= "OverloadedStrings" item ^. L.kind @?= Just CiKeyword - , testCase "completes the Strict language extension" $ runSessionWithServer pragmasPlugin testDirectory $ do+ , testCase "completes the Strict language extension" $ runSessionWithServer pragmasPlugin testDataDir $ do doc <- openDoc "Completion.hs" "haskell" _ <- waitForDiagnostics let te = TextEdit (Range (Position 0 13) (Position 0 31)) "Str"@@ -174,7 +152,7 @@ item ^. L.label @?= "Strict" item ^. L.kind @?= Just CiKeyword - , testCase "completes No- language extensions" $ runSessionWithServer pragmasPlugin testDirectory $ do+ , testCase "completes No- language extensions" $ runSessionWithServer pragmasPlugin testDataDir $ do doc <- openDoc "Completion.hs" "haskell" _ <- waitForDiagnostics let te = TextEdit (Range (Position 0 13) (Position 0 31)) "NoOverload"@@ -186,12 +164,8 @@ item ^. L.kind @?= Just CiKeyword ] -pragmasGolden :: TestName -> FilePath -> (FilePath -> Session T.Text) -> TestTree-pragmasGolden title path action =- goldenGitDiff title (testDirectory </> path <.> "expected.hs")- $ runSessionWithServer pragmasPlugin testDirectory- $ TL.encodeUtf8 . TL.fromStrict- <$> action (path <.> "hs")+goldenWithPragmas :: TestName -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree+goldenWithPragmas title path = goldenWithHaskellDoc pragmasPlugin title testDataDir path "expected" "hs" -testDirectory :: FilePath-testDirectory = "test" </> "testdata"+testDataDir :: FilePath+testDataDir = "test" </> "testdata"