diff --git a/hls-pragmas-plugin.cabal b/hls-pragmas-plugin.cabal --- a/hls-pragmas-plugin.cabal +++ b/hls-pragmas-plugin.cabal @@ -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 @@ -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 diff --git a/src/Ide/Plugin/Pragmas.hs b/src/Ide/Plugin/Pragmas.hs --- a/src/Ide/Plugin/Pragmas.hs +++ b/src/Ide/Plugin/Pragmas.hs @@ -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) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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"