From 2e5318f714f682b274fa8abfebd9301c77603a5d Mon Sep 17 00:00:00 2001 From: Jose Lorenzo Rodriguez Date: Sun, 19 Aug 2018 16:27:05 +0200 Subject: [PATCH 1/5] Improved the suggestions for typed holes actions This implements what is described in #767 I took the liberty of renaming one test file, so I could run the tests from inside ghci. Without the rename, it would complain about duplicate module names --- haskell-ide-engine.cabal | 4 +- src/Haskell/Ide/Engine/Plugin/GhcMod.hs | 113 +++++++++++++++--- ...nsSpec.hs => FunctionalCodeActionsSpec.hs} | 37 +++++- test/functional/FunctionalSpec.hs | 1 + test/functional/Main.hs | 4 +- test/functional/Spec.hs | 1 - test/testdata/TypedHoles2.hs | 6 + test/unit/CodeActionsSpec.hs | 16 ++- 8 files changed, 150 insertions(+), 32 deletions(-) rename test/functional/{CodeActionsSpec.hs => FunctionalCodeActionsSpec.hs} (87%) create mode 100644 test/functional/FunctionalSpec.hs delete mode 100644 test/functional/Spec.hs create mode 100644 test/testdata/TypedHoles2.hs diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal index 19f273e7d..4aabeb8f5 100644 --- a/haskell-ide-engine.cabal +++ b/haskell-ide-engine.cabal @@ -245,18 +245,18 @@ test-suite func-test main-is: Main.hs other-modules: CompletionSpec , CommandSpec - , CodeActionsSpec , DeferredSpec , DefinitionSpec , DiagnosticsSpec , FormatSpec + , FunctionalCodeActionsSpec + , FunctionalSpec , HaReSpec , HighlightSpec , HoverSpec , ReferencesSpec , RenameSpec , SymbolsSpec - , Spec , TestUtils build-depends: aeson diff --git a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs index 7ffef651f..d2697e013 100644 --- a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs +++ b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs @@ -389,9 +389,27 @@ runGhcModCommand cmd = -- --------------------------------------------------------------------- +newtype TypeDef = TypeDef T.Text deriving (Eq, Show) + +data FunctionSig = + FunctionSig { fsName :: !T.Text + , fsType :: !TypeDef + } deriving (Eq, Show) + +newtype ValidSubstitutions = ValidSubstitutions [FunctionSig] deriving (Eq, Show) + +newtype Bindings = Bindings [FunctionSig] deriving (Eq, Show) + +data TypedHoles = + TypedHoles { thDiag :: LSP.Diagnostic + , thWant :: TypeDef + , thSubstitutions :: ValidSubstitutions + , thBIndings :: Bindings + } deriving (Eq, Show) + codeActionProvider :: CodeActionProvider codeActionProvider pid docId mfp r ctx = do - support <- clientSupportsDocumentChanges + support <- clientSupportsDocumentChanges codeActionProvider' support pid docId mfp r ctx codeActionProvider' :: Bool -> CodeActionProvider @@ -401,7 +419,7 @@ codeActionProvider' supportsDocChanges _ docId _ _ context = renameActions = map (uncurry mkRenamableAction) terms redundantTerms = mapMaybe getRedundantImports diags redundantActions = concatMap (uncurry mkRedundantImportActions) redundantTerms - typedHoleActions = map (uncurry mkTypedHoleAction) (concatMap getTypedHoles diags) + typedHoleActions = concatMap mkTypedHoleActions (mapMaybe getTypedHoles diags) in return $ IdeResponseOk (renameActions ++ redundantActions ++ typedHoleActions) where @@ -457,18 +475,30 @@ codeActionProvider' supportsDocChanges _ docId _ _ context = getRedundantImports diag@(LSP.Diagnostic _ _ _ (Just "ghcmod") msg _) = (diag,) <$> extractRedundantImport msg getRedundantImports _ = Nothing - mkTypedHoleAction :: LSP.Diagnostic -> T.Text -> LSP.CodeAction - mkTypedHoleAction diag sub = codeAction - where title = "Substitute with " <> sub - diags = LSP.List [diag] - edit = mkWorkspaceEdit [LSP.TextEdit (diag ^. LSP.range) sub] - kind = LSP.CodeActionQuickFix - codeAction = LSP.CodeAction title (Just kind) (Just diags) (Just edit) Nothing - - - getTypedHoles :: LSP.Diagnostic -> [(LSP.Diagnostic, T.Text)] - getTypedHoles diag@(LSP.Diagnostic _ _ _ (Just "ghcmod") msg _) = map (diag,) $ extractHoleSubstitutions msg - getTypedHoles _ = [] + mkTypedHoleActions :: TypedHoles -> [LSP.CodeAction] + mkTypedHoleActions (TypedHoles diag (TypeDef want) (ValidSubstitutions subs) (Bindings bindings)) + | onlyErrorFuncs = substitutions <> suggestions + | otherwise = substitutions + where + onlyErrorFuncs = null + $ (map fsName subs) \\ ["undefined", "error", "errorWithoutStackTrace"] + substitutions = map mkHoleAction subs + suggestions = map mkHoleAction bindings + mkHoleAction (FunctionSig name (TypeDef sig)) = codeAction + where title :: T.Text + title = "Substitute hole (" <> want <> ") with " <> name <> " (" <> sig <> ")" + diags = LSP.List [diag] + edit = mkWorkspaceEdit [LSP.TextEdit (diag ^. LSP.range) name] + kind = LSP.CodeActionQuickFix + codeAction = LSP.CodeAction title (Just kind) (Just diags) (Just edit) Nothing + + + getTypedHoles :: LSP.Diagnostic -> Maybe TypedHoles + getTypedHoles diag@(LSP.Diagnostic _ _ _ (Just "ghcmod") msg _) = + case extractHoleSubstitutions msg of + Nothing -> Nothing + Just (want, subs, bindings) -> Just $ TypedHoles diag want subs bindings + getTypedHoles _ = Nothing extractRenamableTerms :: T.Text -> [T.Text] extractRenamableTerms msg @@ -479,7 +509,7 @@ extractRenamableTerms msg -- Extract everything in between ‘ ’ go t | t == "" = [] - | "‘" `T.isPrefixOf` t = + | "‘" `T.isPrefixOf` t = let rest = T.tail t x = T.takeWhile (/= '’') rest in x:go rest @@ -493,12 +523,57 @@ extractRedundantImport msg = else Nothing where firstLine = head (T.lines msg) -extractHoleSubstitutions :: T.Text -> [T.Text] +extractHoleSubstitutions :: T.Text -> Maybe (TypeDef, ValidSubstitutions, Bindings) extractHoleSubstitutions diag | "Found hole:" `T.isInfixOf` diag = - let ls = T.lines $ snd $ T.breakOnEnd "Valid substitutions include" diag - in map (T.strip . fst . T.breakOn " ::") $ filter (T.isInfixOf "::") ls - | otherwise = mempty + let (header, subsBlock) = T.breakOn "Valid substitutions include" diag + (foundHole, expr) = T.breakOn "In the expression:" header + expectedType = TypeDef + . T.strip + . T.takeWhile (/= '•') + . keepAfter "::" + $ foundHole + bindingsBlock = T.dropWhile (== '\n') + . keepAfter "Relevant bindings include" + $ expr + substitutions = extractSignatures + . T.dropWhile (== '\n') + . fromMaybe "" + . T.stripPrefix "Valid substitutions include" + $ subsBlock + bindings = extractSignatures bindingsBlock + in Just (expectedType, ValidSubstitutions substitutions, Bindings bindings) + | otherwise = Nothing + where + keepAfter prefix = fromMaybe "" + . T.stripPrefix prefix + . snd + . T.breakOn prefix + + extractSignatures :: T.Text -> [FunctionSig] + extractSignatures tBlock = map nameAndSig + . catMaybes + . gatherLastGroup + . mapAccumL (groupSignatures (countSpaces tBlock)) T.empty + . T.lines + $ tBlock + + countSpaces = T.length . T.takeWhile (== ' ') + + groupSignatures indentSize acc line + | countSpaces line == indentSize && acc /= T.empty = (T.strip line, Just acc) + | "(" `T.isPrefixOf` T.strip line = (acc, Nothing) + | otherwise = (acc <> " " <> T.strip line, Nothing) + + gatherLastGroup :: (T.Text, [Maybe T.Text]) -> [Maybe T.Text] + gatherLastGroup ("", groupped) = groupped + gatherLastGroup (lastGroup, groupped) = groupped ++ [Just lastGroup] + + nameAndSig :: T.Text -> FunctionSig + nameAndSig t = FunctionSig extractName extractSig + where + extractName = T.strip . fst . T.breakOn "::" $ t + extractSig = TypeDef . T.strip . keepAfter "::" $ t -- --------------------------------------------------------------------- diff --git a/test/functional/CodeActionsSpec.hs b/test/functional/FunctionalCodeActionsSpec.hs similarity index 87% rename from test/functional/CodeActionsSpec.hs rename to test/functional/FunctionalCodeActionsSpec.hs index 04e5b4491..a7fcd3242 100644 --- a/test/functional/CodeActionsSpec.hs +++ b/test/functional/FunctionalCodeActionsSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module CodeActionsSpec where +module FunctionalCodeActionsSpec where import Control.Applicative.Combinators import Control.Lens hiding (List) @@ -210,8 +210,8 @@ spec = describe "code actions" $ do \import Data.Maybe\n\ \foo :: Int\n\ \foo = fromJust (Just 3)\n" - - describe "typed hole code actions" $ + + describe "typed hole code actions" $ do it "works" $ when ghc84 $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "TypedHoles.hs" "haskell" @@ -219,9 +219,9 @@ spec = describe "code actions" $ do cas <- map (\(CACodeAction x)-> x) <$> getAllCodeActions doc liftIO $ map (^. title) cas `shouldMatchList` - [ "Substitute with undefined" - , "Substitute with maxBound" - , "Substitute with minBound" + [ "Substitute hole (Int) with undefined (forall (a :: TYPE r). GHC.Stack.Types.HasCallStack => a)" + , "Substitute hole (Int) with maxBound (forall a. Bounded a => a)" + , "Substitute hole (Int) with minBound (forall a. Bounded a => a)" ] executeCodeAction $ head cas @@ -233,6 +233,31 @@ spec = describe "code actions" $ do \foo :: [Int] -> Int\n\ \foo x = maxBound" + it "shows more suggestions" $ when ghc84 $ + runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "TypedHoles2.hs" "haskell" + _ <- waitForDiagnosticsSource "ghcmod" + cas <- map (\(CACodeAction x)-> x) <$> getAllCodeActions doc + + liftIO $ map (^. title) cas `shouldMatchList` + [ "Substitute hole (A) with undefined (forall (a :: TYPE r). GHC.Stack.Types.HasCallStack => a)" + , "Substitute hole (A) with stuff (A -> A)" + , "Substitute hole (A) with x ([A])" + , "Substitute hole (A) with foo2 ([A] -> A)" + ] + + executeCodeAction $ head cas + + contents <- documentContents doc + + liftIO $ contents `shouldBe` + "module TypedHoles2 (foo2) where\n\ + \newtype A = A Int\n\ + \foo2 :: [A] -> A\n\ + \foo2 x = undefined\n\ + \ where\n\ + \ stuff (A a) = A (a + 1)\n" + fromAction :: CAResult -> CodeAction fromAction (CACodeAction action) = action fromAction _ = error "Not a code action" diff --git a/test/functional/FunctionalSpec.hs b/test/functional/FunctionalSpec.hs new file mode 100644 index 000000000..6a7e8ad4e --- /dev/null +++ b/test/functional/FunctionalSpec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=FunctionalSpec #-} diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 1414488ec..b25921150 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -1,10 +1,10 @@ module Main where import Test.Hspec -import qualified Spec +import qualified FunctionalSpec import TestUtils main :: IO () main = do setupStackFiles - withFileLogging "functional.log" $ hspec Spec.spec + withFileLogging "functional.log" $ hspec FunctionalSpec.spec diff --git a/test/functional/Spec.hs b/test/functional/Spec.hs deleted file mode 100644 index 5416ef6a8..000000000 --- a/test/functional/Spec.hs +++ /dev/null @@ -1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} diff --git a/test/testdata/TypedHoles2.hs b/test/testdata/TypedHoles2.hs new file mode 100644 index 000000000..cc10d249c --- /dev/null +++ b/test/testdata/TypedHoles2.hs @@ -0,0 +1,6 @@ +module TypedHoles2 (foo2) where +newtype A = A Int +foo2 :: [A] -> A +foo2 x = _ + where + stuff (A a) = A (a + 1) diff --git a/test/unit/CodeActionsSpec.hs b/test/unit/CodeActionsSpec.hs index fabcfb51f..19b832df7 100644 --- a/test/unit/CodeActionsSpec.hs +++ b/test/unit/CodeActionsSpec.hs @@ -55,7 +55,19 @@ spec = do describe "typed holes" $ it "picks them up" $ do msg <- T.readFile "test/testdata/typedHoleDiag.txt" - extractHoleSubstitutions msg `shouldBe` ["Nothing", "mempty", "undefined", "GM.mzero"] + let substitutions = ValidSubstitutions [ FunctionSig "Nothing" (TypeDef "forall a. Maybe a") + , FunctionSig "mempty" (TypeDef "forall a. Monoid a => a") + , FunctionSig "undefined" (TypeDef "forall (a :: TYPE r). GHC.Stack.Types.HasCallStack => a") + , FunctionSig "GM.mzero" (TypeDef "forall (m :: * -> *). GM.MonadPlus m => forall a. m a") + ] + + + bindings = Bindings [ FunctionSig "diag" (TypeDef "T.Text") + , FunctionSig "extractHoles" (TypeDef "T.Text -> Maybe T.Text") + ] + + expected = Just (TypeDef "Maybe T.Text", substitutions, bindings) + extractHoleSubstitutions msg `shouldBe` expected describe "missing package code actions" $ do it "pick up relevant messages" $ @@ -63,4 +75,4 @@ spec = do in extractModuleName msg `shouldBe` Just "Foo.Bar" it "don't pick up irrelevant messages" $ let msg = "Could not find modulez ‘Foo.Bar’\n Use -v to see a list of the files searched for." - in extractModuleName msg `shouldBe` Nothing \ No newline at end of file + in extractModuleName msg `shouldBe` Nothing From 47d20755d41709761e34ba851370f9f40207ffd2 Mon Sep 17 00:00:00 2001 From: Jose Lorenzo Rodriguez Date: Sun, 19 Aug 2018 18:51:14 +0200 Subject: [PATCH 2/5] Fixed substitutions parsing when identifiers are short --- src/Haskell/Ide/Engine/Plugin/GhcMod.hs | 7 ++++++- test/testdata/typedHoleDiag2.txt | 17 +++++++++++++++++ test/unit/CodeActionsSpec.hs | 14 +++++++++++++- 3 files changed, 36 insertions(+), 2 deletions(-) create mode 100644 test/testdata/typedHoleDiag2.txt diff --git a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs index d2697e013..12d550853 100644 --- a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs +++ b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs @@ -573,7 +573,12 @@ extractHoleSubstitutions diag nameAndSig t = FunctionSig extractName extractSig where extractName = T.strip . fst . T.breakOn "::" $ t - extractSig = TypeDef . T.strip . keepAfter "::" $ t + extractSig = TypeDef + . T.strip + . fst + . T.breakOn "(bound at" + . keepAfter "::" + $ t -- --------------------------------------------------------------------- diff --git a/test/testdata/typedHoleDiag2.txt b/test/testdata/typedHoleDiag2.txt new file mode 100644 index 000000000..032d18bac --- /dev/null +++ b/test/testdata/typedHoleDiag2.txt @@ -0,0 +1,17 @@ +• Found hole: _ :: A +• In the expression: _ + In an equation for ‘foo2’: + foo2 x + = _ + where + stuff (A a) = A (a + 1) +• Relevant bindings include + stuff :: A -> A (bound at test/testdata/TypedHoles2.hs:6:5) + x :: [A] (bound at test/testdata/TypedHoles2.hs:4:6) + foo2 :: [A] -> A (bound at test/testdata/TypedHoles2.hs:4:1) + Valid substitutions include + undefined :: forall (a :: TYPE r). + GHC.Stack.Types.HasCallStack => + a + (imported from ‘Prelude’ at test/testdata/TypedHoles2.hs:1:8-18 + (and originally defined in ‘GHC.Err’)) diff --git a/test/unit/CodeActionsSpec.hs b/test/unit/CodeActionsSpec.hs index 19b832df7..02b276997 100644 --- a/test/unit/CodeActionsSpec.hs +++ b/test/unit/CodeActionsSpec.hs @@ -52,7 +52,7 @@ spec = do let msg = "• Variable not in scope:\n forM_ :: [CodeAction] -> (s0 -> Expectation) -> IO a0\n• Perhaps you meant ‘iforM_’ (imported from Control.Lens)" in extractRenamableTerms msg `shouldBe` ["iforM_"] - describe "typed holes" $ + describe "typed holes" $ do it "picks them up" $ do msg <- T.readFile "test/testdata/typedHoleDiag.txt" let substitutions = ValidSubstitutions [ FunctionSig "Nothing" (TypeDef "forall a. Maybe a") @@ -69,6 +69,18 @@ spec = do expected = Just (TypeDef "Maybe T.Text", substitutions, bindings) extractHoleSubstitutions msg `shouldBe` expected + it "removes bound at" $ do + msg <- T.readFile "test/testdata/typedHoleDiag2.txt" + let substitutions = ValidSubstitutions [FunctionSig "undefined" (TypeDef "forall (a :: TYPE r). GHC.Stack.Types.HasCallStack => a")] + + bindings = Bindings [ FunctionSig "stuff" (TypeDef "A -> A") + , FunctionSig "x" (TypeDef "[A]") + , FunctionSig "foo2" (TypeDef "[A] -> A") + ] + + expected = Just (TypeDef "A", substitutions, bindings) + extractHoleSubstitutions msg `shouldBe` expected + describe "missing package code actions" $ do it "pick up relevant messages" $ let msg = "Could not find module ‘Foo.Bar’\n Use -v to see a list of the files searched for." From 421aef26fc26e51bc2bfd9f0ad4400ff1af8c4f1 Mon Sep 17 00:00:00 2001 From: Jose Lorenzo Rodriguez Date: Sun, 19 Aug 2018 23:23:23 +0200 Subject: [PATCH 3/5] Fixed case where hole signature is too long --- src/Haskell/Ide/Engine/Plugin/GhcMod.hs | 5 ++-- test/testdata/typedHoleDiag3.txt | 37 +++++++++++++++++++++++++ test/unit/CodeActionsSpec.hs | 19 +++++++++++++ 3 files changed, 59 insertions(+), 2 deletions(-) create mode 100644 test/testdata/typedHoleDiag3.txt diff --git a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs index 12d550853..2576599f2 100644 --- a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs +++ b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs @@ -530,7 +530,8 @@ extractHoleSubstitutions diag (foundHole, expr) = T.breakOn "In the expression:" header expectedType = TypeDef . T.strip - . T.takeWhile (/= '•') + . fst + . T.breakOn "\n" . keepAfter "::" $ foundHole bindingsBlock = T.dropWhile (== '\n') @@ -561,8 +562,8 @@ extractHoleSubstitutions diag countSpaces = T.length . T.takeWhile (== ' ') groupSignatures indentSize acc line - | countSpaces line == indentSize && acc /= T.empty = (T.strip line, Just acc) | "(" `T.isPrefixOf` T.strip line = (acc, Nothing) + | countSpaces line == indentSize && acc /= T.empty = (T.strip line, Just acc) | otherwise = (acc <> " " <> T.strip line, Nothing) gatherLastGroup :: (T.Text, [Maybe T.Text]) -> [Maybe T.Text] diff --git a/test/testdata/typedHoleDiag3.txt b/test/testdata/typedHoleDiag3.txt new file mode 100644 index 000000000..ffe520ffa --- /dev/null +++ b/test/testdata/typedHoleDiag3.txt @@ -0,0 +1,37 @@ +• Found hole: _ :: t -> FilePath + Where: ‘t’ is a rigid type variable bound by + the inferred type of + lintDockerfile :: [IgnoreRule] + -> t + -> IO (Either Language.Docker.Parser.Error [Rules.RuleCheck]) + at app/Main.hs:(229,5)-(235,47) +• In the expression: _ + In the first argument of ‘Docker.parseFile’, namely + ‘(_ dockerFile)’ + In a stmt of a 'do' block: ast <- Docker.parseFile (_ dockerFile) +• Relevant bindings include + processedFile :: Either Language.Docker.Parser.Error Dockerfile + -> Either Language.Docker.Parser.Error [Rules.RuleCheck] + (bound at app/Main.hs:233:9) + processRules :: Dockerfile -> [Rules.RuleCheck] + (bound at app/Main.hs:234:9) + ignoredRules :: Rules.RuleCheck -> Bool + (bound at app/Main.hs:235:9) + dockerFile :: t (bound at app/Main.hs:229:32) + ignoreRules :: [IgnoreRule] (bound at app/Main.hs:229:20) + lintDockerfile :: [IgnoreRule] + -> t -> IO (Either Language.Docker.Parser.Error [Rules.RuleCheck]) + (bound at app/Main.hs:229:5) + (Some bindings suppressed; use -fmax-relevant-binds=N or -fno-max-relevant-binds) + Valid substitutions include + mempty :: forall a. Monoid a => a + (imported from ‘Prelude’ at app/Main.hs:5:8-11 + (and originally defined in ‘GHC.Base’)) + undefined :: forall (a :: TYPE r). + GHC.Stack.Types.HasCallStack => + a + (imported from ‘Prelude’ at app/Main.hs:5:8-11 + (and originally defined in ‘GHC.Err’)) + idm :: forall m. Monoid m => m + (imported from ‘Options.Applicative’ at app/Main.hs:21:1-46 + (and originally defined in ‘Options.Applicative.Builder’)) diff --git a/test/unit/CodeActionsSpec.hs b/test/unit/CodeActionsSpec.hs index 02b276997..dac10793e 100644 --- a/test/unit/CodeActionsSpec.hs +++ b/test/unit/CodeActionsSpec.hs @@ -81,6 +81,25 @@ spec = do expected = Just (TypeDef "A", substitutions, bindings) extractHoleSubstitutions msg `shouldBe` expected + it "tolerates long signatures" $ do + msg <- T.readFile "test/testdata/typedHoleDiag3.txt" + let substitutions = ValidSubstitutions [ FunctionSig "mempty" (TypeDef "forall a. Monoid a => a") + , FunctionSig "undefined" (TypeDef "forall (a :: TYPE r). GHC.Stack.Types.HasCallStack => a") + , FunctionSig "idm" (TypeDef "forall m. Monoid m => m") + ] + longSig = "Either Language.Docker.Parser.Error Dockerfile -> Either Language.Docker.Parser.Error [Rules.RuleCheck]" + longSig2 = "[IgnoreRule] -> t -> IO (Either Language.Docker.Parser.Error [Rules.RuleCheck])" + bindings = Bindings [ FunctionSig "processedFile" (TypeDef longSig) + , FunctionSig "processRules" (TypeDef "Dockerfile -> [Rules.RuleCheck]") + , FunctionSig "ignoredRules" (TypeDef "Rules.RuleCheck -> Bool") + , FunctionSig "dockerFile" (TypeDef "t") + , FunctionSig "ignoreRules" (TypeDef "[IgnoreRule]") + , FunctionSig "lintDockerfile" (TypeDef longSig2) + ] + + expected = Just (TypeDef "t -> FilePath", substitutions, bindings) + extractHoleSubstitutions msg `shouldBe` expected + describe "missing package code actions" $ do it "pick up relevant messages" $ let msg = "Could not find module ‘Foo.Bar’\n Use -v to see a list of the files searched for." From ff5b52b7ea7bb2dd132480aa3c162cc42ec86a9e Mon Sep 17 00:00:00 2001 From: Jose Lorenzo Rodriguez Date: Mon, 20 Aug 2018 11:10:57 +0200 Subject: [PATCH 4/5] Improving tests so the also run in ghc < 8.4 --- test/functional/FunctionalCodeActionsSpec.hs | 50 ++++++++++++++------ 1 file changed, 35 insertions(+), 15 deletions(-) diff --git a/test/functional/FunctionalCodeActionsSpec.hs b/test/functional/FunctionalCodeActionsSpec.hs index a7fcd3242..9bde9e0d8 100644 --- a/test/functional/FunctionalCodeActionsSpec.hs +++ b/test/functional/FunctionalCodeActionsSpec.hs @@ -17,6 +17,7 @@ import qualified Language.Haskell.LSP.Types as LSP import qualified Language.Haskell.LSP.Types.Capabilities as C import Test.Hspec import TestUtils +import Data.Semigroup spec :: Spec spec = describe "code actions" $ do @@ -212,17 +213,26 @@ spec = describe "code actions" $ do \foo = fromJust (Just 3)\n" describe "typed hole code actions" $ do - it "works" $ when ghc84 $ + it "works" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "TypedHoles.hs" "haskell" _ <- waitForDiagnosticsSource "ghcmod" cas <- map (\(CACodeAction x)-> x) <$> getAllCodeActions doc - liftIO $ map (^. title) cas `shouldMatchList` - [ "Substitute hole (Int) with undefined (forall (a :: TYPE r). GHC.Stack.Types.HasCallStack => a)" - , "Substitute hole (Int) with maxBound (forall a. Bounded a => a)" - , "Substitute hole (Int) with minBound (forall a. Bounded a => a)" - ] + suggestion <- + if ghc84 then do + liftIO $ map (^. title) cas `shouldMatchList` + [ "Substitute hole (Int) with maxBound (forall a. Bounded a => a)" + , "Substitute hole (Int) with minBound (forall a. Bounded a => a)" + , "Substitute hole (Int) with undefined (forall (a :: TYPE r). GHC.Stack.Types.HasCallStack => a)" + ] + return "maxBound" + else do + liftIO $ map (^. title) cas `shouldMatchList` + [ "Substitute hole (Int) with x ([Int])" + , "Substitute hole (Int) with foo ([Int] -> Int)" + ] + return "x" executeCodeAction $ head cas @@ -231,20 +241,30 @@ spec = describe "code actions" $ do liftIO $ contents `shouldBe` "module TypedHoles where\n\ \foo :: [Int] -> Int\n\ - \foo x = maxBound" + \foo x = " <> suggestion - it "shows more suggestions" $ when ghc84 $ + it "shows more suggestions" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "TypedHoles2.hs" "haskell" _ <- waitForDiagnosticsSource "ghcmod" cas <- map (\(CACodeAction x)-> x) <$> getAllCodeActions doc - liftIO $ map (^. title) cas `shouldMatchList` - [ "Substitute hole (A) with undefined (forall (a :: TYPE r). GHC.Stack.Types.HasCallStack => a)" - , "Substitute hole (A) with stuff (A -> A)" - , "Substitute hole (A) with x ([A])" - , "Substitute hole (A) with foo2 ([A] -> A)" - ] + suggestion <- + if ghc84 then do + liftIO $ map (^. title) cas `shouldMatchList` + [ "Substitute hole (A) with undefined (forall (a :: TYPE r). GHC.Stack.Types.HasCallStack => a)" + , "Substitute hole (A) with stuff (A -> A)" + , "Substitute hole (A) with x ([A])" + , "Substitute hole (A) with foo2 ([A] -> A)" + ] + return "undefined" + else do + liftIO $ map (^. title) cas `shouldMatchList` + [ "Substitute hole (A) with stuff (A -> A)" + , "Substitute hole (A) with x ([A])" + , "Substitute hole (A) with foo2 ([A] -> A)" + ] + return "stuff" executeCodeAction $ head cas @@ -254,7 +274,7 @@ spec = describe "code actions" $ do "module TypedHoles2 (foo2) where\n\ \newtype A = A Int\n\ \foo2 :: [A] -> A\n\ - \foo2 x = undefined\n\ + \foo2 x = " <> suggestion <> "\n\ \ where\n\ \ stuff (A a) = A (a + 1)\n" From 63e286743d4f5968ad16f17ccc1f313ca9b6b571 Mon Sep 17 00:00:00 2001 From: Jose Lorenzo Rodriguez Date: Mon, 20 Aug 2018 12:25:27 +0200 Subject: [PATCH 5/5] Using a simpler import for the <> operator --- test/functional/FunctionalCodeActionsSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/functional/FunctionalCodeActionsSpec.hs b/test/functional/FunctionalCodeActionsSpec.hs index 9bde9e0d8..c8cd316c0 100644 --- a/test/functional/FunctionalCodeActionsSpec.hs +++ b/test/functional/FunctionalCodeActionsSpec.hs @@ -17,7 +17,7 @@ import qualified Language.Haskell.LSP.Types as LSP import qualified Language.Haskell.LSP.Types.Capabilities as C import Test.Hspec import TestUtils -import Data.Semigroup +import Data.Monoid ((<>)) spec :: Spec spec = describe "code actions" $ do