286635b · ghcide · git.iko.soy

git.iko.soy/ghcide

Suggestions for missing pattern signatures (#436)

commit286635bac84c573ca2fbafc6a65d633302b152d1 authorPepe Iborra <pepeiborra@gmail.com> dateMon 17 Feb 2020, 10:22 (7 years ago) parentdee0624

3 files changed+36−38

compare with master

unifiedsplit

src/Development/IDE/Core/Compile.hs+3−2 src/Development/IDE/Plugin/CodeAction.hs+10−11 test/exe/Main.hs+23−25

src/Development/IDE/Core/Compile.hs+3−2

@@ -193,9 +193,10 @@ demoteTypeErrorsToWarnings =

193193enableTopLevelWarnings :: ParsedModule -> ParsedModule

194194enableTopLevelWarnings =

195195 (update_pm_mod_summary . update_hspp_opts)

196− (`wopt_set` Opt_WarnMissingSignatures)

196+ ((`wopt_set` Opt_WarnMissingPatternSynonymSignatures) .

197+ (`wopt_set` Opt_WarnMissingSignatures))

197198 -- the line below would show also warnings for let bindings without signature

198− -- ((`wopt_set` Opt_WarnMissingSignatures) . (`wopt_set` Opt_WarnMissingLocalSignatures))

199+ -- ((`wopt_set` Opt_WarnMissingSignatures) . (`wopt_set` Opt_WarnMissingLocalSignatures)))

199200

200201update_hspp_opts :: (DynFlags -> DynFlags) -> ModSummary -> ModSummary

201202update_hspp_opts up ms = ms{ms_hspp_opts = up $ ms_hspp_opts ms}

src/Development/IDE/Plugin/CodeAction.hs+10−11

@@ -310,27 +310,26 @@ suggestFixConstructorImport _ Diagnostic{_range=_range,..}

310310

311311suggestSignature :: Bool -> Diagnostic -> [(T.Text, [TextEdit])]

312312suggestSignature isQuickFix Diagnostic{_range=_range@Range{..},..}

313− | "Top-level binding with no type signature" `T.isInfixOf` _message = let

314− signature = T.strip $ unifySpaces $ last $ T.splitOn "type signature: " $ filterNewlines _message

315− startOfLine = Position (_line _start) 0

316− beforeLine = Range startOfLine startOfLine

317− title = if isQuickFix then "add signature: " <> signature else signature

318− action = TextEdit beforeLine $ signature <> "\n"

319− in [(title, [action])]

320−suggestSignature isQuickFix Diagnostic{_range=_range@Range{..},..}

321− | "Polymorphic local binding with no type signature" `T.isInfixOf` _message = let

313+ | _message =~

314+ ("(Top-level binding|Polymorphic local binding|Pattern synonym) with no type signature" :: T.Text) = let

322315 signature = removeInitialForAll

323316 $ T.takeWhile (\x -> x/='*' && x/='•')

324317 $ T.strip $ unifySpaces $ last $ T.splitOn "type signature: " $ filterNewlines _message

325− startOfLine = Position (_line _start) (_character _start)

318+ startOfLine = Position (_line _start) startCharacter

326319 beforeLine = Range startOfLine startOfLine

327320 title = if isQuickFix then "add signature: " <> signature else signature

328− action = TextEdit beforeLine $ signature <> "\n" <> T.replicate (_character _start) " "

321+ action = TextEdit beforeLine $ signature <> "\n" <> T.replicate startCharacter " "

329322 in [(title, [action])]

330323 where removeInitialForAll :: T.Text -> T.Text

331324 removeInitialForAll (T.breakOnEnd " :: " -> (nm, ty))

332325 | "forall" `T.isPrefixOf` ty = nm <> T.drop 2 (snd (T.breakOn "." ty))

333326 | otherwise = nm <> ty

327+ startCharacter

328+ | "Polymorphic local binding" `T.isPrefixOf` _message

329+ = _character _start

330+ | otherwise

331+ = 0

332+

334333suggestSignature _ _ = []

335334

336335topOfHoleFitsMarker :: T.Text

test/exe/Main.hs+23−25

@@ -1095,8 +1095,8 @@ fillTypedHoleTests = let

10951095

10961096addSigActionTests :: TestTree

10971097addSigActionTests = let

1098− header = "{-# OPTIONS_GHC -Wmissing-signatures #-}"

1099− moduleH = "module Sigs where"

1098+ header = "{-# OPTIONS_GHC -Wmissing-signatures -Wmissing-pattern-synonym-signatures #-}"

1099+ moduleH = "{-# LANGUAGE PatternSynonyms #-}\nmodule Sigs where"

11001100 before def = T.unlines [header, moduleH, def]

11011101 after' def sig = T.unlines [header, moduleH, sig, def]

11021102

@@ -1112,19 +1112,20 @@ addSigActionTests = let

11121112 liftIO $ expectedCode @=? modifiedCode

11131113 in

11141114 testGroup "add signature"

1115− [ "abc = True" >:: "abc :: Bool"

1116− , "foo a b = a + b" >:: "foo :: Num a => a -> a -> a"

1117− , "bar a b = show $ a + b" >:: "bar :: (Show a, Num a) => a -> a -> String"

1118− , "(!!!) a b = a > b" >:: "(!!!) :: Ord a => a -> a -> Bool"

1119− , "a >>>> b = a + b" >:: "(>>>>) :: Num a => a -> a -> a"

1120− , "a `haha` b = a b" >:: "haha :: (t1 -> t2) -> t1 -> t2"

1115+ [ "abc = True" >:: "abc :: Bool"

1116+ , "foo a b = a + b" >:: "foo :: Num a => a -> a -> a"

1117+ , "bar a b = show $ a + b" >:: "bar :: (Show a, Num a) => a -> a -> String"

1118+ , "(!!!) a b = a > b" >:: "(!!!) :: Ord a => a -> a -> Bool"

1119+ , "a >>>> b = a + b" >:: "(>>>>) :: Num a => a -> a -> a"

1120+ , "a `haha` b = a b" >:: "haha :: (t1 -> t2) -> t1 -> t2"

1121+ , "pattern Some a = Just a" >:: "pattern Some :: a -> Maybe a"

11211122 ]

11221123

11231124addSigLensesTests :: TestTree

11241125addSigLensesTests = let

1125− missing = "{-# OPTIONS_GHC -Wmissing-signatures -Wunused-matches #-}"

1126+ missing = "{-# OPTIONS_GHC -Wmissing-signatures -Wmissing-pattern-synonym-signatures -Wunused-matches #-}"

11261127 notMissing = "{-# OPTIONS_GHC -Wunused-matches #-}"

1127− moduleH = "module Sigs where"

1128+ moduleH = "{-# LANGUAGE PatternSynonyms #-}\nmodule Sigs where"

11281129 other = T.unlines ["f :: Integer -> Integer", "f x = 3"]

11291130 before withMissing def

11301131 = T.unlines $ (if withMissing then (missing :) else (notMissing :)) [moduleH, def, other]

@@ -1141,22 +1142,19 @@ addSigLensesTests = let

11411142 liftIO $ expectedCode @=? modifiedCode

11421143 in

11431144 testGroup "add signature"

1144− [ testGroup "with warnings enabled"

1145− [ sigSession True "abc = True" "abc :: Bool"

1146− , sigSession True "foo a b = a + b" "foo :: Num a => a -> a -> a"

1147− , sigSession True "bar a b = show $ a + b" "bar :: (Show a, Num a) => a -> a -> String"

1148− , sigSession True "(!!!) a b = a > b" "(!!!) :: Ord a => a -> a -> Bool"

1149− , sigSession True "a >>>> b = a + b" "(>>>>) :: Num a => a -> a -> a"

1150− , sigSession True "a `haha` b = a b" "haha :: (t1 -> t2) -> t1 -> t2"

1151− ]

1152− , testGroup "with warnings disabled"

1153− [ sigSession False "abc = True" "abc :: Bool"

1154− , sigSession False "foo a b = a + b" "foo :: Num a => a -> a -> a"

1155− , sigSession False "bar a b = show $ a + b" "bar :: (Show a, Num a) => a -> a -> String"

1156− , sigSession False "(!!!) a b = a > b" "(!!!) :: Ord a => a -> a -> Bool"

1157− , sigSession False "a >>>> b = a + b" "(>>>>) :: Num a => a -> a -> a"

1158− , sigSession False "a `haha` b = a b" "haha :: (t1 -> t2) -> t1 -> t2"

1145+ [ testGroup title

1146+ [ sigSession enableWarnings "abc = True" "abc :: Bool"

1147+ , sigSession enableWarnings "foo a b = a + b" "foo :: Num a => a -> a -> a"

1148+ , sigSession enableWarnings "bar a b = show $ a + b" "bar :: (Show a, Num a) => a -> a -> String"

1149+ , sigSession enableWarnings "(!!!) a b = a > b" "(!!!) :: Ord a => a -> a -> Bool"

1150+ , sigSession enableWarnings "a >>>> b = a + b" "(>>>>) :: Num a => a -> a -> a"

1151+ , sigSession enableWarnings "a `haha` b = a b" "haha :: (t1 -> t2) -> t1 -> t2"

1152+ , sigSession enableWarnings "pattern Some a = Just a" "pattern Some :: a -> Maybe a"

11591153 ]

1154+ | (title, enableWarnings) <-

1155+ [("with warnings enabled", True)

1156+ ,("with warnings disabled", False)

1157+ ]

11601158 ]

11611159

11621160findDefinitionAndHoverTests :: TestTree