Skip to content

Commit 975ef7a

Browse files
author
Santiago Weight
committed
refact: Extract FillHole
1 parent df7139c commit 975ef7a

File tree

4 files changed

+103
-87
lines changed

4 files changed

+103
-87
lines changed

‎plugins/hls-refactor-plugin/hls-refactor-plugin.cabal

+3
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,9 @@ library
3636
Development.IDE.Plugin.CodeAction.PositionIndexed
3737
Development.IDE.Plugin.Plugins.AddArgument
3838
Development.IDE.Plugin.Plugins.Diagnostic
39+
Development.IDE.Plugin.Plugins.FillHole
40+
Development.IDE.Plugin.Plugins.FillTypeWildcard
41+
Development.IDE.Plugin.Plugins.ImportUtils
3942
default-extensions:
4043
BangPatterns
4144
CPP

‎plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs

+3-84
Original file line numberDiff line numberDiff line change
@@ -93,6 +93,9 @@ import qualified Text.Fuzzy.Parallel as TFP
9393
import Text.Regex.TDFA (mrAfter,
9494
(=~), (=~~))
9595
#if MIN_VERSION_ghc(9,2,0)
96+
import Development.IDE.Plugin.Plugins.FillHole (suggestFillHole)
97+
import Development.IDE.Plugin.Plugins.FillTypeWildcard (suggestFillTypeWildcard)
98+
import Development.IDE.Plugin.Plugins.ImportUtils
9699
import GHC (AddEpAnn (AddEpAnn),
97100
Anchor (anchor_op),
98101
AnchorOperation (..),
@@ -102,8 +105,6 @@ import GHC (AddEpAnn (Ad
102105
EpaLocation (..),
103106
LEpaComment,
104107
LocatedA)
105-
import Development.IDE.Plugin.Plugins.ImportUtils
106-
import Development.IDE.Plugin.Plugins.FillTypeWildcard (suggestFillTypeWildcard)
107108
#else
108109
import Language.Haskell.GHC.ExactPrint.Types (Annotation (annsDP),
109110
DeltaPos,
@@ -944,88 +945,6 @@ suggestModuleTypo Diagnostic{_range=_range,..}
944945
_ -> Nothing
945946

946947

947-
suggestFillHole :: Diagnostic -> [(T.Text, TextEdit)]
948-
suggestFillHole Diagnostic{_range=_range,..}
949-
| Just holeName <- extractHoleName _message
950-
, (holeFits, refFits) <- processHoleSuggestions (T.lines _message) =
951-
let isInfixHole = _message =~ addBackticks holeName :: Bool in
952-
map (proposeHoleFit holeName False isInfixHole) holeFits
953-
++ map (proposeHoleFit holeName True isInfixHole) refFits
954-
| otherwise = []
955-
where
956-
extractHoleName = fmap head . flip matchRegexUnifySpaces "Found hole: ([^ ]*)"
957-
addBackticks text = "`" <> text <> "`"
958-
addParens text = "(" <> text <> ")"
959-
proposeHoleFit holeName parenthise isInfixHole name =
960-
let isInfixOperator = T.head name == '('
961-
name' = getOperatorNotation isInfixHole isInfixOperator name in
962-
( "replace " <> holeName <> " with " <> name
963-
, TextEdit _range (if parenthise then addParens name' else name')
964-
)
965-
getOperatorNotation True False name = addBackticks name
966-
getOperatorNotation True True name = T.drop 1 (T.dropEnd 1 name)
967-
getOperatorNotation _isInfixHole _isInfixOperator name = name
968-
969-
processHoleSuggestions :: [T.Text] -> ([T.Text], [T.Text])
970-
processHoleSuggestions mm = (holeSuggestions, refSuggestions)
971-
{-
972-
• Found hole: _ :: LSP.Handlers
973-
974-
Valid hole fits include def
975-
Valid refinement hole fits include
976-
fromMaybe (_ :: LSP.Handlers) (_ :: Maybe LSP.Handlers)
977-
fromJust (_ :: Maybe LSP.Handlers)
978-
haskell-lsp-types-0.22.0.0:Language.LSP.Types.Window.$sel:_value:ProgressParams (_ :: ProgressParams
979-
LSP.Handlers)
980-
T.foldl (_ :: LSP.Handlers -> Char -> LSP.Handlers)
981-
(_ :: LSP.Handlers)
982-
(_ :: T.Text)
983-
T.foldl' (_ :: LSP.Handlers -> Char -> LSP.Handlers)
984-
(_ :: LSP.Handlers)
985-
(_ :: T.Text)
986-
-}
987-
where
988-
t = id @T.Text
989-
holeSuggestions = do
990-
-- get the text indented under Valid hole fits
991-
validHolesSection <-
992-
getIndentedGroupsBy (=~ t " *Valid (hole fits|substitutions) include") mm
993-
-- the Valid hole fits line can contain a hole fit
994-
holeFitLine <-
995-
mapHead
996-
(mrAfter . (=~ t " *Valid (hole fits|substitutions) include"))
997-
validHolesSection
998-
let holeFit = T.strip $ T.takeWhile (/= ':') holeFitLine
999-
guard (not $ T.null holeFit)
1000-
return holeFit
1001-
refSuggestions = do -- @[]
1002-
-- get the text indented under Valid refinement hole fits
1003-
refinementSection <-
1004-
getIndentedGroupsBy (=~ t " *Valid refinement hole fits include") mm
1005-
-- get the text for each hole fit
1006-
holeFitLines <- getIndentedGroups (tail refinementSection)
1007-
let holeFit = T.strip $ T.unwords holeFitLines
1008-
guard $ not $ holeFit =~ t "Some refinement hole fits suppressed"
1009-
return holeFit
1010-
1011-
mapHead f (a:aa) = f a : aa
1012-
mapHead _ [] = []
1013-
1014-
-- > getIndentedGroups [" H1", " l1", " l2", " H2", " l3"] = [[" H1,", " l1", " l2"], [" H2", " l3"]]
1015-
getIndentedGroups :: [T.Text] -> [[T.Text]]
1016-
getIndentedGroups [] = []
1017-
getIndentedGroups ll@(l:_) = getIndentedGroupsBy ((== indentation l) . indentation) ll
1018-
-- |
1019-
-- > getIndentedGroupsBy (" H" `isPrefixOf`) [" H1", " l1", " l2", " H2", " l3"] = [[" H1", " l1", " l2"], [" H2", " l3"]]
1020-
getIndentedGroupsBy :: (T.Text -> Bool) -> [T.Text] -> [[T.Text]]
1021-
getIndentedGroupsBy pred inp = case dropWhile (not.pred) inp of
1022-
(l:ll) -> case span (\l' -> indentation l < indentation l') ll of
1023-
(indented, rest) -> (l:indented) : getIndentedGroupsBy pred rest
1024-
_ -> []
1025-
1026-
indentation :: T.Text -> Int
1027-
indentation = T.length . T.takeWhile isSpace
1028-
1029948
#if !MIN_VERSION_ghc(9,3,0)
1030949
suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, Rewrite)]
1031950
suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_range,..}

‎plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/FillHole.hs

+95
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,95 @@
1+
module Development.IDE.Plugin.Plugins.FillHole
2+
( suggestFillHole
3+
) where
4+
5+
import Control.Monad (guard)
6+
import Data.Char
7+
import qualified Data.Text as T
8+
import Development.IDE.Plugin.Plugins.Diagnostic
9+
import Language.LSP.Types (Diagnostic (..),
10+
TextEdit (TextEdit))
11+
import Text.Regex.TDFA (MatchResult (..),
12+
(=~))
13+
14+
suggestFillHole :: Diagnostic -> [(T.Text, TextEdit)]
15+
suggestFillHole Diagnostic{_range=_range,..}
16+
| Just holeName <- extractHoleName _message
17+
, (holeFits, refFits) <- processHoleSuggestions (T.lines _message) =
18+
let isInfixHole = _message =~ addBackticks holeName :: Bool in
19+
map (proposeHoleFit holeName False isInfixHole) holeFits
20+
++ map (proposeHoleFit holeName True isInfixHole) refFits
21+
| otherwise = []
22+
where
23+
extractHoleName = fmap head . flip matchRegexUnifySpaces "Found hole: ([^ ]*)"
24+
addBackticks text = "`" <> text <> "`"
25+
addParens text = "(" <> text <> ")"
26+
proposeHoleFit holeName parenthise isInfixHole name =
27+
let isInfixOperator = T.head name == '('
28+
name' = getOperatorNotation isInfixHole isInfixOperator name in
29+
( "replace " <> holeName <> " with " <> name
30+
, TextEdit _range (if parenthise then addParens name' else name')
31+
)
32+
getOperatorNotation True False name = addBackticks name
33+
getOperatorNotation True True name = T.drop 1 (T.dropEnd 1 name)
34+
getOperatorNotation _isInfixHole _isInfixOperator name = name
35+
36+
processHoleSuggestions :: [T.Text] -> ([T.Text], [T.Text])
37+
processHoleSuggestions mm = (holeSuggestions, refSuggestions)
38+
{-
39+
• Found hole: _ :: LSP.Handlers
40+
41+
Valid hole fits include def
42+
Valid refinement hole fits include
43+
fromMaybe (_ :: LSP.Handlers) (_ :: Maybe LSP.Handlers)
44+
fromJust (_ :: Maybe LSP.Handlers)
45+
haskell-lsp-types-0.22.0.0:Language.LSP.Types.Window.$sel:_value:ProgressParams (_ :: ProgressParams
46+
LSP.Handlers)
47+
T.foldl (_ :: LSP.Handlers -> Char -> LSP.Handlers)
48+
(_ :: LSP.Handlers)
49+
(_ :: T.Text)
50+
T.foldl' (_ :: LSP.Handlers -> Char -> LSP.Handlers)
51+
(_ :: LSP.Handlers)
52+
(_ :: T.Text)
53+
-}
54+
where
55+
t = id @T.Text
56+
holeSuggestions = do
57+
-- get the text indented under Valid hole fits
58+
validHolesSection <-
59+
getIndentedGroupsBy (=~ t " *Valid (hole fits|substitutions) include") mm
60+
-- the Valid hole fits line can contain a hole fit
61+
holeFitLine <-
62+
mapHead
63+
(mrAfter . (=~ t " *Valid (hole fits|substitutions) include"))
64+
validHolesSection
65+
let holeFit = T.strip $ T.takeWhile (/= ':') holeFitLine
66+
guard (not $ T.null holeFit)
67+
return holeFit
68+
refSuggestions = do -- @[]
69+
-- get the text indented under Valid refinement hole fits
70+
refinementSection <-
71+
getIndentedGroupsBy (=~ t " *Valid refinement hole fits include") mm
72+
-- get the text for each hole fit
73+
holeFitLines <- getIndentedGroups (tail refinementSection)
74+
let holeFit = T.strip $ T.unwords holeFitLines
75+
guard $ not $ holeFit =~ t "Some refinement hole fits suppressed"
76+
return holeFit
77+
78+
mapHead f (a:aa) = f a : aa
79+
mapHead _ [] = []
80+
81+
-- > getIndentedGroups [" H1", " l1", " l2", " H2", " l3"] = [[" H1,", " l1", " l2"], [" H2", " l3"]]
82+
getIndentedGroups :: [T.Text] -> [[T.Text]]
83+
getIndentedGroups [] = []
84+
getIndentedGroups ll@(l:_) = getIndentedGroupsBy ((== indentation l) . indentation) ll
85+
-- |
86+
-- > getIndentedGroupsBy (" H" `isPrefixOf`) [" H1", " l1", " l2", " H2", " l3"] = [[" H1", " l1", " l2"], [" H2", " l3"]]
87+
getIndentedGroupsBy :: (T.Text -> Bool) -> [T.Text] -> [[T.Text]]
88+
getIndentedGroupsBy pred inp = case dropWhile (not.pred) inp of
89+
(l:ll) -> case span (\l' -> indentation l < indentation l') ll of
90+
(indented, rest) -> (l:indented) : getIndentedGroupsBy pred rest
91+
_ -> []
92+
93+
indentation :: T.Text -> Int
94+
indentation = T.length . T.takeWhile isSpace
95+

‎plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/FillTypeWildcard.hs

+2-3
Original file line numberDiff line numberDiff line change
@@ -3,9 +3,8 @@ module Development.IDE.Plugin.Plugins.FillTypeWildcard
33
) where
44

55
import Data.Char
6-
import qualified Data.Text as T
7-
import Language.LSP.Types (Diagnostic (..),
8-
TextEdit (TextEdit))
6+
import qualified Data.Text as T
7+
import Language.LSP.Types (Diagnostic (..), TextEdit (TextEdit))
98

109
suggestFillTypeWildcard :: Diagnostic -> [(T.Text, TextEdit)]
1110
suggestFillTypeWildcard Diagnostic{_range=_range,..}

0 commit comments

Comments
 (0)