Skip to content

Commit 6be6a67

Browse files
vidit-odvidit-od
committed
Fix indentations and spacings + better use structured information
Fix a lot of spacing and indentation inconsistences, also propagate structured info further to better use it instead of direct conversion to string.
1 parent b89cbb6 commit 6be6a67

File tree

4 files changed

+73
-89
lines changed

4 files changed

+73
-89
lines changed

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

Lines changed: 15 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1025,23 +1025,23 @@ suggestReplaceIdentifier contents Diagnostic{_range=_range,..}
10251025

10261026
suggestNewDefinition :: IdeOptions -> ParsedModule -> Maybe T.Text -> FileDiagnostic -> [(T.Text, [TextEdit])]
10271027
suggestNewDefinition ideOptions parsedModule contents fd
1028-
| Just (name, typ) <- matchVariableNotInScope fd =
1029-
newDefinitionAction ideOptions parsedModule _range name typ
1030-
| Just (name, typ) <- matchFoundHole fd
1031-
, let definedName = fromMaybe name (T.stripPrefix "_" name)
1032-
, let typ' = case T.stripPrefix "_" name of
1033-
Nothing | isPlainTyVar typ -> Nothing
1034-
_ -> Just typ
1035-
, [(label, newDefinitionEdits)] <- newDefinitionAction ideOptions parsedModule _range name typ' =
1028+
| Just (rdrName, typ) <- matchVariableNotInScope fd =
1029+
newDefinitionAction ideOptions parsedModule _range rdrName typ
1030+
| Just (rdrName, typ) <- matchFoundHole fd
1031+
, let occName = rdrNameOcc rdrName
1032+
, let isHole = "_" `isPrefixOf` occNameString occName
1033+
, let definedName = printOutputable (if isHole then mkOccName (occNameSpace occName) (drop 1 (occNameString occName)) else occName)
1034+
, let typ' = if isHole || not (isPlainTyVar typ) then Just typ else Nothing
1035+
, [(label, newDefinitionEdits)] <- newDefinitionAction ideOptions parsedModule _range rdrName typ' =
10361036
[(label, mkRenameEdit contents _range definedName : newDefinitionEdits)]
10371037
| otherwise = []
10381038
where
10391039
Diagnostic{_message, _range} = fdLspDiagnostic fd :: Diagnostic
10401040
-- A "plain type variable" is a single lowercase word like p, a etc
1041-
isPlainTyVar t = T.all (\c -> isAlphaNum c || c == '_') t && not (T.null t) && isLower (T.head t)
1041+
isPlainTyVar = isJust . getTyVar_maybe
10421042

1043-
newDefinitionAction :: IdeOptions -> ParsedModule -> Range -> T.Text -> Maybe T.Text -> [(T.Text, [TextEdit])]
1044-
newDefinitionAction IdeOptions {..} parsedModule Range {_start} name typ
1043+
newDefinitionAction :: IdeOptions -> ParsedModule -> Range -> RdrName -> Maybe Type -> [(T.Text, [TextEdit])]
1044+
newDefinitionAction IdeOptions {..} parsedModule Range {_start} rdrName typ
10451045
| Range _ lastLineP : _ <-
10461046
[ realSrcSpanToRange sp
10471047
| (L (locA -> l@(RealSrcSpan sp _)) _) <- hsmodDecls,
@@ -1055,11 +1055,11 @@ newDefinitionAction IdeOptions {..} parsedModule Range {_start} name typ
10551055
| otherwise = []
10561056
where
10571057
colon = if optNewColonConvention then " : " else " :: "
1058+
occName = rdrNameOcc rdrName
10581059
definedName =
1059-
case T.stripPrefix "_" name of
1060-
Just n -> n
1061-
Nothing -> name
1062-
sig = definedName <> colon <> T.dropWhileEnd isSpace (fromMaybe "_" typ)
1060+
let name = occNameString occName
1061+
in T.pack $ if "_" `isPrefixOf` name then drop 1 name else name
1062+
sig = definedName <> colon <> T.dropWhileEnd isSpace (maybe "_" printOutputable typ)
10631063
ParsedModule {pm_parsed_source = L _ HsModule {hsmodDecls}} = parsedModule
10641064

10651065
{- Handles two variants with different formatting

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

Lines changed: 21 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -69,42 +69,39 @@ type HsArrow pass = HsMultAnn pass
6969
-- In this case a new argument would have to add its type between b and c in the signature.
7070
plugin :: ParsedModule -> FileDiagnostic -> Either PluginError [(T.Text, [TextEdit])]
7171
plugin parsedModule fd
72-
| Just (name, typ) <- matchVariableNotInScope fd = addArgumentAction parsedModule _range name typ
73-
| Just (name, typ) <- matchFoundHoleIncludeUnderscore fd = addArgumentAction parsedModule _range name (Just typ)
72+
| Just (rdrName, typ) <- matchVariableNotInScope fd = addArgumentAction parsedModule _range rdrName typ
73+
| Just (rdrName, typ) <- matchFoundHole fd = addArgumentAction parsedModule _range rdrName (Just typ)
7474
| otherwise = pure []
7575
where
76-
Diagnostic{_message, _range} = fdLspDiagnostic fd :: Diagnostic
76+
Diagnostic{_message, _range} = fdLspDiagnostic fd
7777

7878
-- Given a name for the new binding, add a new pattern to the match in the last position,
7979
-- returning how many patterns there were in this match prior to the transformation:
8080
-- addArgToMatch "foo" `bar arg1 arg2 = ...`
8181
-- => (`bar arg1 arg2 foo = ...`, 2)
82-
addArgToMatch :: T.Text -> GenLocated l (Match GhcPs (LocatedA (HsExpr GhcPs))) -> (GenLocated l (Match GhcPs (LocatedA (HsExpr GhcPs))), Int)
82+
addArgToMatch :: RdrName -> GenLocated l (Match GhcPs (LocatedA (HsExpr GhcPs))) -> (GenLocated l (Match GhcPs (LocatedA (HsExpr GhcPs))), Int)
8383

8484
-- NOTE: The code duplication within CPP clauses avoids a parse error with
8585
-- `stylish-haskell`.
8686
#if MIN_VERSION_ghc(9,11,0)
87-
addArgToMatch name (L locMatch (Match xMatch ctxMatch (L l pats) rhs)) =
88-
let unqualName = mkRdrUnqual $ mkVarOcc $ T.unpack name
89-
newPat = L noAnnSrcSpanDP1 $ VarPat NoExtField $ L noAnn unqualName
87+
addArgToMatch unqualName (L locMatch (Match xMatch ctxMatch (L l pats) rhs)) =
88+
let newPat = L noAnnSrcSpanDP1 $ VarPat NoExtField $ L noAnn unqualName
9089
-- The intention is to move `= ...` (right-hand side with equals) to the right so there's 1 space between
9190
-- the newly added pattern and the rest
9291
indentRhs :: GRHSs GhcPs (LocatedA (HsExpr GhcPs)) -> GRHSs GhcPs (LocatedA (HsExpr GhcPs))
9392
indentRhs rhs@GRHSs{grhssGRHSs} = rhs {grhssGRHSs = fmap (`setEntryDP` (SameLine 1)) grhssGRHSs }
9493
in (L locMatch (Match xMatch ctxMatch (L l (pats <> [newPat])) (indentRhs rhs)), Prelude.length pats)
9594
#elif MIN_VERSION_ghc(9,9,0)
96-
addArgToMatch name (L locMatch (Match xMatch ctxMatch pats rhs)) =
97-
let unqualName = mkRdrUnqual $ mkVarOcc $ T.unpack name
98-
newPat = L noAnnSrcSpanDP1 $ VarPat NoExtField $ L noAnn unqualName
95+
addArgToMatch unqualName (L locMatch (Match xMatch ctxMatch pats rhs)) =
96+
let newPat = L noAnnSrcSpanDP1 $ VarPat NoExtField $ L noAnn unqualName
9997
-- The intention is to move `= ...` (right-hand side with equals) to the right so there's 1 space between
10098
-- the newly added pattern and the rest
10199
indentRhs :: GRHSs GhcPs (LocatedA (HsExpr GhcPs)) -> GRHSs GhcPs (LocatedA (HsExpr GhcPs))
102100
indentRhs rhs@GRHSs{grhssGRHSs} = rhs {grhssGRHSs = fmap (`setEntryDP` (SameLine 1)) grhssGRHSs }
103101
in (L locMatch (Match xMatch ctxMatch (pats <> [newPat]) (indentRhs rhs)), Prelude.length pats)
104102
#else
105-
addArgToMatch name (L locMatch (Match xMatch ctxMatch pats rhs)) =
106-
let unqualName = mkRdrUnqual $ mkVarOcc $ T.unpack name
107-
newPat = L (noAnnSrcSpanDP1 generatedSrcSpan) $ VarPat NoExtField (noLocA unqualName)
103+
addArgToMatch unqualName (L locMatch (Match xMatch ctxMatch pats rhs)) =
104+
let newPat = L (noAnnSrcSpanDP1 generatedSrcSpan) $ VarPat NoExtField (noLocA unqualName)
108105
indentRhs = id
109106
in (L locMatch (Match xMatch ctxMatch (pats <> [newPat]) (indentRhs rhs)), Prelude.length pats)
110107
#endif
@@ -117,10 +114,10 @@ addArgToMatch name (L locMatch (Match xMatch ctxMatch pats rhs)) =
117114
-- For example:
118115
-- insertArg "new_pat" `foo bar baz = 1`
119116
-- => (`foo bar baz new_pat = 1`, Just ("foo", 2))
120-
appendFinalPatToMatches :: T.Text -> LHsDecl GhcPs -> TransformT (Either PluginError) (LHsDecl GhcPs, Maybe (GenLocated SrcSpanAnnN RdrName, Int))
121-
appendFinalPatToMatches name = \case
117+
appendFinalPatToMatches :: RdrName -> LHsDecl GhcPs -> TransformT (Either PluginError) (LHsDecl GhcPs, Maybe (GenLocated SrcSpanAnnN RdrName, Int))
118+
appendFinalPatToMatches rdrName = \case
122119
(L locDecl (ValD xVal fun@FunBind{fun_matches=mg,fun_id = idFunBind})) -> do
123-
(mg', numPatsMay) <- modifyMgMatchesT' mg (pure . second Just . addArgToMatch name) Nothing combineMatchNumPats
120+
(mg', numPatsMay) <- modifyMgMatchesT' mg (pure . second Just . addArgToMatch rdrName) Nothing combineMatchNumPats
124121
numPats <- TransformT $ lift $ maybeToEither (PluginInternalError "Unexpected empty match group in HsDecl") numPatsMay
125122
let decl' = L locDecl (ValD xVal fun{fun_matches=mg'})
126123
pure (decl', Just (idFunBind, numPats))
@@ -143,8 +140,8 @@ appendFinalPatToMatches name = \case
143140
-- foo () = new_def
144141
--
145142
-- TODO instead of inserting a typed hole; use GHC's suggested type from the error
146-
addArgumentAction :: ParsedModule -> Range -> T.Text -> Maybe T.Text -> Either PluginError [(T.Text, [TextEdit])]
147-
addArgumentAction (ParsedModule _ moduleSrc _) range name _typ = do
143+
addArgumentAction :: ParsedModule -> Range -> RdrName -> Maybe Type -> Either PluginError [(T.Text, [TextEdit])]
144+
addArgumentAction (ParsedModule _ moduleSrc _) range rdrName _typ = do
148145
(newSource, _, _) <- runTransformT $ do
149146
(moduleSrc', join -> matchedDeclNameMay) <- addNameAsLastArgOfMatchingDecl
150147
#if MIN_VERSION_ghc(9,9,0)
@@ -153,17 +150,15 @@ addArgumentAction (ParsedModule _ moduleSrc _) range name _typ = do
153150
(makeDeltaAst moduleSrc)
154151
#endif
155152
case matchedDeclNameMay of
156-
Just (matchedDeclName, numPats) -> modifySigWithM (unLoc matchedDeclName) (addTyHoleToTySigArg numPats) moduleSrc'
157-
Nothing -> pure moduleSrc'
153+
Just (matchedDeclName, numPats) -> modifySigWithM (unLoc matchedDeclName) (addTyHoleToTySigArg numPats) moduleSrc'
154+
Nothing -> pure moduleSrc'
158155
let diff = makeDiffTextEdit (T.pack $ exactPrint moduleSrc) (T.pack $ exactPrint newSource)
159-
pure [("Add argument ‘" <> definedName <> "’ to function", diff)]
156+
pure [("Add argument ‘" <> labelName <> "’ to function", diff)]
160157
where
161158
addNameAsLastArgOfMatchingDecl = modifySmallestDeclWithM spanContainsRangeOrErr addNameAsLastArg
162-
addNameAsLastArg = fmap (first (:[])) . appendFinalPatToMatches definedName
163-
definedName =
164-
case T.stripPrefix "_" name of
165-
Just n -> n
166-
Nothing -> name
159+
addNameAsLastArg = fmap (first (:[])) . appendFinalPatToMatches rdrName
160+
occName = rdrNameOcc rdrName
161+
labelName = T.pack $ occNameString occName
167162
spanContainsRangeOrErr = maybeToEither (PluginInternalError "SrcSpan was not valid range") . (`spanContainsRange` range)
168163

169164
-- Transform an LHsType into a list of arguments and return type, to make transformations easier.

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

Lines changed: 7 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -5,16 +5,13 @@ module Development.IDE.Plugin.Plugins.Diagnostic (
55
matchRegexUnifySpaces,
66
unifySpaces,
77
matchFoundHole,
8-
matchFoundHoleIncludeUnderscore,
98
diagReportHoleError
109
)
1110
where
1211

1312
import Control.Lens
14-
import Data.Bifunctor (Bifunctor (..))
1513
import qualified Data.Text as T
16-
import Development.IDE (printOutputable)
17-
import Development.IDE.GHC.Compat (RdrName)
14+
import Development.IDE.GHC.Compat (RdrName, Type)
1815
import Development.IDE.GHC.Compat.Error (Hole, _ReportHoleError,
1916
_TcRnMessage,
2017
_TcRnNotInScope,
@@ -43,20 +40,18 @@ matchRegex message regex = case message =~~ regex of
4340
matchRegexUnifySpaces :: T.Text -> T.Text -> Maybe [T.Text]
4441
matchRegexUnifySpaces message = matchRegex (unifySpaces message)
4542

46-
matchFoundHole :: FileDiagnostic -> Maybe (T.Text, T.Text)
43+
matchFoundHole :: FileDiagnostic -> Maybe (RdrName, Type)
4744
matchFoundHole fd = do
4845
hole <- diagReportHoleError fd
49-
Just (printOutputable (hole_occ hole), printOutputable (hole_ty hole))
46+
Just (hole_occ hole, hole_ty hole)
5047

51-
matchFoundHoleIncludeUnderscore :: FileDiagnostic -> Maybe (T.Text, T.Text)
52-
matchFoundHoleIncludeUnderscore fd = first ("_" <>) <$> matchFoundHole fd
53-
54-
matchVariableNotInScope :: FileDiagnostic -> Maybe (T.Text, Maybe T.Text)
48+
matchVariableNotInScope :: FileDiagnostic -> Maybe (RdrName, Maybe Type)
5549
matchVariableNotInScope fd = do
5650
(rdrName, _) <- diagReportNotInScope fd
57-
Just (printOutputable rdrName, Nothing)
51+
Just (rdrName, Nothing)
5852

59-
-- | Extract the 'Hole' out of a 'FileDiagnostic'
53+
-- | Extract the typed hole information from a diagnostic, if the diagnostic
54+
-- originates from a hole. Returns 'Nothing' for any other kind of diagnostic.
6055
diagReportHoleError :: FileDiagnostic -> Maybe Hole
6156
diagReportHoleError diag = do
6257
solverReport <-
@@ -68,7 +63,6 @@ diagReportHoleError diag = do
6863
. _TcRnSolverReport
6964
. _1
7065
(hole, _) <- solverReport ^? reportContentL . _ReportHoleError
71-
7266
Just hole
7367

7468
-- | Extract the 'NotInScopeError' and the corresponding 'RdrName' from a 'FileDiagnostic'

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

Lines changed: 30 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,6 @@ import Data.Char
99
import qualified Data.HashSet as Set
1010
import qualified Data.Text as T
1111
import Development.IDE (FileDiagnostic,
12-
_message,
1312
fdLspDiagnosticL,
1413
printOutputable)
1514
import Development.IDE.GHC.Compat (ParsedModule,
@@ -33,7 +32,7 @@ import Development.IDE.Types.Exports (ExportsMap (..),
3332
moduleNameText)
3433
import GHC.Tc.Errors.Types (ErrInfo (ErrInfo))
3534
import Language.Haskell.Syntax.ImpExp (ImportDeclQualifiedStyle (..))
36-
import Language.LSP.Protocol.Lens (HasRange (..))
35+
import Language.LSP.Protocol.Lens (HasRange (..), message)
3736
import Language.LSP.Protocol.Types (TextEdit (TextEdit))
3837
import Text.Regex.TDFA (MatchResult (..),
3938
(=~))
@@ -43,12 +42,12 @@ suggestFillHole exportsMap pm diag
4342
| Just holeName <- extractHoleName diag
4443
#if MIN_VERSION_ghc(9,13,0)
4544
, Just _errInfo <- extractErrInfo diag
46-
, let supplText = _message (diag ^. fdLspDiagnosticL)
45+
, let supplText = diag ^. fdLspDiagnosticL . message
4746
, let ctxText = supplText
4847
#else
4948
, Just (ErrInfo ctx suppl) <- extractErrInfo diag
50-
, let ctxText = printOutputable ctx
5149
, let supplText = printOutputable suppl
50+
, let ctxText = printOutputable ctx
5251
#endif
5352
, let (holeFits, refFits) = processHoleSuggestions (T.lines supplText)
5453
, let isInfixHole = ctxText =~ addBackticks holeName :: Bool =
@@ -57,8 +56,6 @@ suggestFillHole exportsMap pm diag
5756
map (proposeHoleFit holeName True isInfixHole) refFits
5857
| otherwise = []
5958
where
60-
qualify = qualifyFit exportsMap pm
61-
6259
extractHoleName :: FileDiagnostic -> Maybe T.Text
6360
extractHoleName d = do
6461
hole <- diagReportHoleError d
@@ -85,7 +82,7 @@ suggestFillHole exportsMap pm diag
8582
case T.uncons name of
8683
Nothing -> error "impossible: empty name provided by ghc"
8784
Just (firstChr, _) ->
88-
let cleanName = qualify (stripUnique name)
85+
let cleanName = (qualifyFit exportsMap pm) (stripUnique name)
8986
isInfixOperator = firstChr == '('
9087
name' = getOperatorNotation isInfixHole isInfixOperator cleanName
9188
replacement = if parenthise then addParens name' else name'
@@ -114,49 +111,47 @@ suggestFillHole exportsMap pm diag
114111
qualifyFit :: ExportsMap -> ParsedModule -> T.Text -> T.Text
115112
qualifyFit exportsMap pm fitName =
116113
case findQualifier of
117-
Nothing -> fitName
118-
Just qualifier -> qualifier <> "." <> fitName
119-
where
120-
-- All modules that export this name
121-
exportingModules :: [T.Text]
122-
exportingModules =
114+
Nothing -> fitName
115+
Just qualifier -> qualifier <> "." <> fitName
116+
where
117+
-- All modules that export this name
118+
exportingModules :: [T.Text]
119+
exportingModules =
123120
let occ = mkVarOrDataOcc fitName
124121
identSet = lookupOccEnv (getExportsMap exportsMap) occ
125122
idents = maybe [] Set.toList identSet
126-
in map moduleNameText idents
123+
in map moduleNameText idents
127124

128-
-- All qualified imports from this file: (moduleName, qualifier)
129-
qualifiedImports :: [(T.Text, T.Text)]
130-
qualifiedImports =
125+
-- All qualified imports from this file: (moduleName, qualifier)
126+
importQualifiers :: [(T.Text, T.Text)]
127+
importQualifiers =
131128
let imports = hsmodImports . unLoc . pm_parsed_source $ pm
132-
in [ (modName decl, qualifier decl)
129+
in [ (modName decl, extractQualifier decl)
133130
| i <- imports
134131
, let decl = unLoc i
135-
, isQualified decl
132+
, ideclQualified decl `elem` [QualifiedPre, QualifiedPost]
136133
]
137134

138-
isQualified decl = ideclQualified decl `elem` [QualifiedPre, QualifiedPost]
139-
140-
modName decl =
141-
T.pack . moduleNameString . unLoc . ideclName $ decl
135+
-- extract the module name from declaration
136+
modName decl = T.pack . moduleNameString . unLoc . ideclName $ decl
142137

143-
qualifier decl =
138+
-- extract the qualifier alias of import declaration (if present)
139+
extractQualifier decl =
144140
case ideclAs decl of
145-
Just alias -> T.pack . moduleNameString . unLoc $ alias
146-
Nothing -> modName decl
141+
Just alias -> T.pack . moduleNameString . unLoc $ alias
142+
Nothing -> modName decl
147143

148-
-- Find first qualified import whose module is in the exporting modules list
149-
findQualifier :: Maybe T.Text
150-
findQualifier =
144+
-- Find first qualified import whose module is in the exporting modules list
145+
findQualifier :: Maybe T.Text
146+
findQualifier =
151147
let exportingSet = exportingModules
152148
in fmap snd
153-
. safeHead
154-
. filter (\(modN, _) -> modN `elem` exportingSet)
155-
$ qualifiedImports
156-
157-
safeHead [] = Nothing
158-
safeHead (x:_) = Just x
149+
. safeHead
150+
. filter (\(modN, _) -> modN `elem` exportingSet)
151+
$ importQualifiers
159152

153+
safeHead [] = Nothing
154+
safeHead (x:_) = Just x
160155

161156
processHoleSuggestions :: [T.Text] -> ([T.Text], [T.Text])
162157
processHoleSuggestions mm = (holeSuggestions, refSuggestions)

0 commit comments

Comments
 (0)