Skip to content

Commit 558cd9d

Browse files
July541July541
committed
Resolve reviews
1 parent a8cb453 commit 558cd9d

File tree

3 files changed

+57
-47
lines changed

3 files changed

+57
-47
lines changed

‎plugins/hls-class-plugin/README.md‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22

33
The class plugin provides handy operations about class, includes:
44

5-
1. Code action to add minimul class definition methods.
5+
1. Code action to add minimal class definition methods.
66
2. Type lens about missing type signatures for instance methods.
77

88
## Demo

‎plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs‎

Lines changed: 24 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -10,13 +10,14 @@ import Control.Lens hiding (List, use)
1010
import Control.Monad.Extra
1111
import Control.Monad.IO.Class (liftIO)
1212
import Control.Monad.Trans.Class (lift)
13-
import Control.Monad.Trans.Except (throwE)
13+
import Control.Monad.Trans.Except (ExceptT, throwE)
1414
import Control.Monad.Trans.Maybe
1515
import Data.Aeson
1616
import Data.Either.Extra (rights)
1717
import Data.List
1818
import qualified Data.Map.Strict as Map
19-
import Data.Maybe (fromJust, isNothing)
19+
import Data.Maybe (isNothing, listToMaybe,
20+
mapMaybe)
2021
import qualified Data.Set as Set
2122
import qualified Data.Text as T
2223
import Development.IDE
@@ -28,6 +29,7 @@ import GHC.LanguageExtensions.Type
2829
import Ide.Plugin.Class.ExactPrint
2930
import Ide.Plugin.Class.Types
3031
import Ide.Plugin.Class.Utils
32+
import qualified Ide.Plugin.Config
3133
import Ide.PluginUtils
3234
import Ide.Types
3335
import Language.LSP.Server
@@ -89,6 +91,10 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginRe
8991
ghcDiags = filter (\d -> d ^. J.source == Just "typecheck") diags
9092
methodDiags = filter (\d -> isClassMethodWarning (d ^. J.message)) ghcDiags
9193

94+
mkActions
95+
:: NormalizedFilePath
96+
-> Diagnostic
97+
-> ExceptT String (LspT Ide.Plugin.Config.Config IO) [Command |? CodeAction]
9298
mkActions docPath diag = do
9399
(HAR {hieAst = ast}, pmap) <- handleMaybeM "Unable to GetHieAst"
94100
. liftIO
@@ -114,10 +120,10 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginRe
114120
= [ mkCodeAction title
115121
$ mkLspCommand plId codeActionCommandId title
116122
(Just $ mkCmdParams methodGroup False)
117-
, mkCodeAction titleWithSig
123+
, mkCodeAction titleWithSig
118124
$ mkLspCommand plId codeActionCommandId titleWithSig
119125
(Just $ mkCmdParams methodGroup True)
120-
]
126+
]
121127
where
122128
title = mkTitle $ fst <$> methodGroup
123129
titleWithSig = mkTitleWithSig $ fst <$> methodGroup
@@ -143,15 +149,19 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginRe
143149
(Just cmd)
144150
Nothing
145151

146-
findClassIdentifier hf instancePosition = do
147-
pure
148-
$ head . head
149-
$ pointCommand hf instancePosition
150-
( (Map.keys . Map.filter isClassNodeIdentifier . getNodeIds)
151-
<=< nodeChildren
152-
)
153-
154-
-- findImplementedMethods :: HieASTs a -> Position -> MaybeT IO [T.Text]
152+
findClassIdentifier hf instancePosition =
153+
handleMaybe "No Identifier found"
154+
$ listToMaybe
155+
$ mapMaybe listToMaybe
156+
$ pointCommand hf instancePosition
157+
( (Map.keys . Map.filter isClassNodeIdentifier . getNodeIds)
158+
<=< nodeChildren
159+
)
160+
161+
findImplementedMethods
162+
:: HieASTs a
163+
-> Position
164+
-> ExceptT String (LspT Ide.Plugin.Config.Config IO) [T.Text]
155165
findImplementedMethods asts instancePosition = do
156166
pure
157167
$ concat
@@ -184,7 +194,7 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginRe
184194
case tcthing of
185195
AGlobal (AConLike (RealDataCon con))
186196
| Just cls <- tyConClass_maybe (dataConOrigTyCon con) -> pure cls
187-
_ -> panic "Ide.Plugin.Class.findClassFromIdentifier"
197+
_ -> fail "Ide.Plugin.Class.findClassFromIdentifier"
188198
findClassFromIdentifier _ (Left _) = throwE "Ide.Plugin.Class.findClassIdentifier"
189199

190200
isClassNodeIdentifier :: IdentifierDetails a -> Bool

‎plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs‎

Lines changed: 32 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ module Ide.Plugin.Class.CodeLens where
88
import Control.Lens ((^.))
99
import Control.Monad.IO.Class (liftIO)
1010
import Data.Aeson
11-
import Data.Maybe (mapMaybe)
11+
import Data.Maybe (mapMaybe, maybeToList)
1212
import qualified Data.Text as T
1313
import Development.IDE
1414
import Development.IDE.GHC.Compat
@@ -32,7 +32,8 @@ codeLens state plId CodeLensParams{..} = do
3232
$ runAction "classplugin.TypeCheck" state
3333
$ use TypeCheck nfp
3434

35-
InstanceBindTypeSigsResult binds <-
35+
-- All instance binds
36+
InstanceBindTypeSigsResult allBinds <-
3637
handleMaybeM "Unable to get InstanceBindTypeSigsResult"
3738
$ liftIO
3839
$ runAction "classplugin.GetInstanceBindTypeSigs" state
@@ -42,29 +43,39 @@ codeLens state plId CodeLensParams{..} = do
4243

4344
let (hsGroup, _, _, _) = tmrRenamed tmr
4445
tycls = hs_tyclds hsGroup
45-
-- class instance decls
46-
insts = mapMaybe (getClsInstD . unLoc) $ concatMap group_instds tycls
47-
-- Declared instance methods without signatures
48-
bindInfos = concatMap getBindSpanWithoutSig insts
49-
targetSigs = matchBind bindInfos binds
50-
codeLens =
51-
(\x@(range, title) ->
52-
generateLens plId range title
46+
-- declared instance methods without signatures
47+
bindInfos = [ bind
48+
| instds <- map group_instds tycls -- class instance decls
49+
, instd <- instds
50+
, inst <- maybeToList $ getClsInstD (unLoc instd)
51+
, bind <- getBindSpanWithoutSig inst
52+
]
53+
targetSigs = matchBind bindInfos allBinds
54+
makeLens (range, title) =
55+
generateLens plId range title
5356
$ workspaceEdit pragmaInsertion
54-
$ makeEdit x
55-
) <$> mapMaybe getRangeWithSig targetSigs
57+
$ makeEdit range title
58+
codeLens = makeLens <$> mapMaybe getRangeWithSig targetSigs
5659

5760
pure $ List codeLens
5861
where
5962
uri = _textDocument ^. J.uri
6063

6164
-- Match Binds with their signatures
65+
-- We try to give every `InstanceBindTypeSig` a `SrcSpan`,
66+
-- hence we can display signatures for `InstanceBindTypeSig` with span later.
6267
matchBind :: [BindInfo] -> [InstanceBindTypeSig] -> [InstanceBindTypeSig]
63-
matchBind binds = map go
68+
matchBind existedBinds allBindWithSigs =
69+
[foldl go bindSig existedBinds | bindSig <- allBindWithSigs]
6470
where
71+
-- | The `bindDefSpan` of the bind is `Nothing` before,
72+
-- we update it with the span where binding occurs.
73+
-- Hence, we can infer the place to display the signature later.
74+
update :: InstanceBindTypeSig -> SrcSpan -> InstanceBindTypeSig
6575
update bind sp = bind {bindDefSpan = Just sp}
66-
go sig = foldl go' sig binds
67-
go' bindSig bind = case (srcSpanToRange . bindNameSpan) bind of
76+
77+
go :: InstanceBindTypeSig -> BindInfo -> InstanceBindTypeSig
78+
go bindSig bind = case (srcSpanToRange . bindNameSpan) bind of
6879
Nothing -> bindSig
6980
Just range ->
7081
if inRange range (getSrcSpan $ bindName bindSig)
@@ -109,23 +120,12 @@ codeLens state plId CodeLensParams{..} = do
109120
let cmd = mkLspCommand plId typeLensCommandId title (Just [toJSON edit])
110121
in CodeLens range (Just cmd) Nothing
111122

112-
makeEdit :: (Range, T.Text) -> [TextEdit]
113-
makeEdit (range, bind)
114-
| indentSize > maxSize =
115-
[TextEdit (insertRange (indentSize - 1)) -- minus one to remove the leading space
116-
("\n"
117-
<> T.replicate defaultIndent " "
118-
<> bind
119-
<> "\n"
120-
<> T.replicate (defaultIndent - 1) " ")]
121-
| otherwise = [TextEdit (insertRange 0) (T.replicate indentSize " " <> bind <> "\n")]
122-
where
123-
startOfLine = Position (_line (range ^. J.start))
124-
insertRange c = Range (startOfLine c) (startOfLine c)
125-
maxSize :: Int
126-
maxSize = 18 -- Length of the shortest instance like `instance X A where`
127-
indentSize :: Num a => a
128-
indentSize = fromIntegral $ _character $ range ^. J.start
123+
makeEdit :: Range -> T.Text -> [TextEdit]
124+
makeEdit range bind =
125+
let startPos = range ^. J.start
126+
insertChar = startPos ^. J.character
127+
insertRange = Range startPos startPos
128+
in [TextEdit insertRange (bind <> "\n" <> T.replicate (fromIntegral insertChar) " ")]
129129

130130
codeLensCommandHandler :: CommandFunction IdeState WorkspaceEdit
131131
codeLensCommandHandler _ wedit = do

0 commit comments

Comments
 (0)