Skip to content

Commit 82cf824

Browse files
author
Santiago Weight
committed
refact: Extract FillHole
1 parent df7139c commit 82cf824

File tree

3 files changed

+99
-87
lines changed

3 files changed

+99
-87
lines changed

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

Lines changed: 3 additions & 84 deletions
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‎

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

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

Lines changed: 2 additions & 3 deletions
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)