Skip to content

Commit 586292e

Browse files
berbermanberberman
committed
Expand and remove TH, Remove the existential type
1 parent 5e76ce7 commit 586292e

File tree

4 files changed

+219
-97
lines changed

4 files changed

+219
-97
lines changed

‎ghcide/ghcide.cabal

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -101,8 +101,7 @@ library
101101
cryptohash-sha1 >=0.11.100 && <0.12,
102102
hie-bios >= 0.7.1 && < 0.8.0,
103103
implicit-hie-cradle >= 0.3.0.2 && < 0.4,
104-
base16-bytestring >=0.1.1 && <0.2,
105-
template-haskell
104+
base16-bytestring >=0.1.1 && <0.2
106105
if os(windows)
107106
build-depends:
108107
Win32
@@ -192,7 +191,6 @@ library
192191
Development.IDE.LSP.Notifications
193192
Development.IDE.Plugin.CodeAction.PositionIndexed
194193
Development.IDE.Plugin.CodeAction.Args
195-
Development.IDE.Plugin.CodeAction.Args.TH
196194
Development.IDE.Plugin.Completions.Logic
197195
Development.IDE.Session.VersionCheck
198196
Development.IDE.Types.Action

‎ghcide/src/Development/IDE/Plugin/CodeAction.hs

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -127,8 +127,7 @@ mkCA title diags edit =
127127

128128
suggestAction :: CodeActionArgs -> [(T.Text, [TextEdit])]
129129
suggestAction caa =
130-
concat $ unwrap caa <$>
131-
-- Order these suggestions by priority
130+
concat -- Order these suggestions by priority
132131
[ wrap $ suggestSignature True
133132
, wrap suggestExtendImport
134133
, wrap suggestImportDisambiguation
@@ -148,6 +147,9 @@ suggestAction caa =
148147
, wrap suggestExportUnusedTopBinding
149148
, wrap suggestFillHole -- Lowest priority
150149
]
150+
where
151+
wrap :: ToCodeAction a => a -> [(T.Text, [TextEdit])]
152+
wrap = toCodeAction caa
151153

152154
findSigOfDecl :: (IdP p -> Bool) -> [LHsDecl p] -> Maybe (Sig p)
153155
findSigOfDecl pred decls =

‎ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs

Lines changed: 214 additions & 51 deletions
Original file line numberDiff line numberDiff line change
@@ -1,25 +1,27 @@
1-
{-# LANGUAGE ExistentialQuantification #-}
2-
{-# LANGUAGE FlexibleInstances #-}
3-
{-# LANGUAGE TemplateHaskell #-}
1+
{-# LANGUAGE FlexibleInstances #-}
42

5-
module Development.IDE.Plugin.CodeAction.Args (
6-
module Development.IDE.Plugin.CodeAction.Args,
7-
) where
3+
module Development.IDE.Plugin.CodeAction.Args
4+
( module Development.IDE.Plugin.CodeAction.Args,
5+
)
6+
where
87

98
import Control.Lens (alaf)
109
import Data.Bifunctor (second)
1110
import Data.Monoid (Ap (..))
1211
import qualified Data.Text as T
13-
import Development.IDE
14-
import Development.IDE.GHC.Compat
15-
import Development.IDE.Plugin.CodeAction.Args.TH
16-
import Development.IDE.Plugin.CodeAction.ExactPrint
12+
import Development.IDE (Diagnostic,
13+
HieAstResult,
14+
TcModuleResult)
15+
import Development.IDE.GHC.Compat (DynFlags,
16+
ParsedModule,
17+
ParsedSource)
18+
import Development.IDE.Plugin.CodeAction.ExactPrint (Rewrite,
19+
rewriteToEdit)
1720
import Development.IDE.Plugin.TypeLenses (GlobalBindingTypeSigsResult)
1821
import Development.IDE.Spans.LocalBindings (Bindings)
1922
import Development.IDE.Types.Exports (ExportsMap)
2023
import Development.IDE.Types.Options (IdeOptions)
21-
import Language.LSP.Types (TextEdit,
22-
type (|?) (..))
24+
import Language.LSP.Types (TextEdit)
2325
import Retrie (Annotated (astA))
2426
import Retrie.ExactPrint (annsA)
2527

@@ -50,55 +52,216 @@ rewrite (Just df) (Just ps) r
5052
edit
5153
rewrite _ _ _ = []
5254

53-
-- we need this intermediate existential type to encapsulate functions producing code actions into a list
54-
data SomeAction = forall a. ToCodeAction a => SomeAction a
55-
56-
wrap :: ToCodeAction a => a -> SomeAction
57-
wrap = SomeAction
58-
59-
unwrap :: CodeActionArgs -> SomeAction -> [(T.Text, [TextEdit])]
60-
unwrap caa (SomeAction x) = toCodeAction caa x
55+
-------------------------------------------------------------------------------------------------
6156

57+
-- | Given 'CodeActionArgs', @a@ can be converted into the representation of code actions.
58+
-- This class is designed to package functions that produce code actions in "Development.IDE.Plugin.CodeAction".
59+
--
60+
-- For each field @fld@ of 'CodeActionArgs', we make
61+
--
62+
-- @@
63+
-- instance ToCodeAction r => ToCodeAction (fld -> r)
64+
-- @@
65+
--
66+
-- where we take the value of @fld@ from 'CodeActionArgs' and then feed it into @(fld -> r)@.
67+
-- If @fld@ is @Maybe a@, we make
68+
--
69+
-- @@
70+
-- instance ToCodeAction r => ToCodeAction (Maybe a -> r)
71+
-- instance ToCodeAction r => ToCodeAction (a -> r)
72+
-- @@
6273
class ToCodeAction a where
6374
toCodeAction :: CodeActionArgs -> a -> [(T.Text, [TextEdit])]
6475

76+
-------------------------------------------------------------------------------------------------
77+
-- Acceptable return types:
6578
instance ToCodeAction [(T.Text, [TextEdit])] where
6679
toCodeAction _ = id
6780

6881
instance ToCodeAction [(T.Text, [Rewrite])] where
69-
toCodeAction CodeActionArgs{..} = rewrite caaDf caaAnnSource
82+
toCodeAction CodeActionArgs {..} = rewrite caaDf caaAnnSource
83+
84+
instance ToCodeAction [(T.Text, [Either TextEdit Rewrite])] where
85+
toCodeAction CodeActionArgs {..} r = second (concatMap go) <$> r
86+
where
87+
go (Left te) = [te]
88+
go (Right rw)
89+
| Just df <- caaDf,
90+
Just ps <- caaAnnSource,
91+
Right x <- rewriteToEdit df (annsA ps) rw =
92+
x
93+
| otherwise = []
94+
95+
-------------------------------------------------------------------------------------------------
7096

97+
-- | Complement: we can obtain 'ParsedSource' from 'caaAnnSource'
7198
instance ToCodeAction r => ToCodeAction (ParsedSource -> r) where
72-
toCodeAction caa@CodeActionArgs{caaAnnSource = Just ps} f = toCodeAction caa $ f $ astA ps
99+
toCodeAction caa@CodeActionArgs {caaAnnSource = Just ps} f = toCodeAction caa $ f $ astA ps
73100
toCodeAction _ _ = []
74101

75-
instance ToCodeAction [(T.Text, [TextEdit |? Rewrite])] where
76-
toCodeAction CodeActionArgs{..} r = second (concatMap go) <$> r
77-
where
78-
go (InL te) = [te]
79-
go (InR rw)
80-
| Just df <- caaDf
81-
, Just ps <- caaAnnSource
82-
, Right x <- rewriteToEdit df (annsA ps) rw =
83-
x
84-
| otherwise = []
85-
86-
-- generates instances of 'ToCodeAction',
87-
-- where the pattern is @instance ToCodeAction r => ToCodeAction (field -> r)@, for each field of 'CodeActionArgs'.
88-
-- therefore functions to produce code actions in CodeAction.hs can be wrapped into 'SomeAction' without modification.
89-
-- for types applied to 'Maybe', it generates to instances: for example,
90-
--
91-
-- @
92-
-- instance ToCodeAction r => ToCodeAction (Maybe DynFlags -> r) where
93-
-- toCodeAction caa@CodeActionArgs {caaDf = x} f = toCodeAction caa $ f x
94-
-- @
95-
--
96-
-- and
102+
-- The following boilerplate code can be generated by 'mkInstances'.
103+
-- Now it was commented out with generated code spliced out,
104+
-- because fields of 'CodeActionArgs' don't change frequently.
97105
--
98-
-- @
99-
-- instance ToCodeAction r => ToCodeAction (DynFlags -> r) where
100-
-- toCodeAction caa@CodeActionArgs {caaDf = Just x} f = toCodeAction caa $ f x
101-
-- toCodeAction _ _ = []
102-
-- @
103-
-- will be derived from 'caaDf'.
104-
mkInstances ''CodeActionArgs
106+
-- mkInstances :: Name -> DecsQ
107+
-- mkInstances tyConName =
108+
-- reify tyConName >>= \case
109+
-- (TyConI (DataD _ _ _ _ [RecC dataConName tys] _)) -> concat <$> mapM (genForVar dataConName) tys
110+
-- _ -> error "unsupported"
111+
-- where
112+
-- clsType = conT $ mkName "ToCodeAction"
113+
-- methodName = mkName "toCodeAction"
114+
-- tempType = varT $ mkName "r"
115+
-- commonFun dataConName fieldName =
116+
-- funD
117+
-- methodName
118+
-- [ clause
119+
-- [ mkName "caa"
120+
-- `asP` recP
121+
-- dataConName
122+
-- [fieldPat fieldName $ varP (mkName "x")]
123+
-- , varP (mkName "f")
124+
-- ]
125+
-- (normalB [|$(varE methodName) caa $ f x|])
126+
-- []
127+
-- ]
128+
-- genForVar dataConName (fieldName, _, ty@(AppT (ConT _maybe) ty'))
129+
-- | _maybe == ''Maybe =
130+
-- do
131+
-- withMaybe <-
132+
-- instanceD
133+
-- (cxt [clsType `appT` tempType])
134+
-- (clsType `appT` ((arrowT `appT` pure ty) `appT` tempType))
135+
-- [commonFun dataConName fieldName]
136+
-- withoutMaybe <-
137+
-- instanceD
138+
-- (cxt [clsType `appT` tempType])
139+
-- (clsType `appT` ((arrowT `appT` pure ty') `appT` tempType))
140+
-- [ funD
141+
-- methodName
142+
-- [ clause
143+
-- [ mkName "caa"
144+
-- `asP` recP
145+
-- dataConName
146+
-- [fieldPat fieldName $ conP 'Just [varP (mkName "x")]]
147+
-- , varP (mkName "f")
148+
-- ]
149+
-- (normalB [|$(varE methodName) caa $ f x|])
150+
-- []
151+
-- , clause [wildP, wildP] (normalB [|[]|]) []
152+
-- ]
153+
-- ]
154+
-- pure [withMaybe, withoutMaybe]
155+
-- genForVar dataConName (fieldName, _, ty) =
156+
-- pure
157+
-- <$> instanceD
158+
-- (cxt [clsType `appT` tempType])
159+
-- (clsType `appT` ((arrowT `appT` pure ty) `appT` tempType))
160+
-- [commonFun dataConName fieldName]
161+
162+
instance ToCodeAction r => ToCodeAction (ExportsMap -> r) where
163+
toCodeAction caa@CodeActionArgs {caaExportsMap = x} f =
164+
toCodeAction caa $ f x
165+
166+
instance ToCodeAction r => ToCodeAction (IdeOptions -> r) where
167+
toCodeAction caa@CodeActionArgs {caaIdeOptions = x} f =
168+
toCodeAction caa $ f x
169+
170+
instance
171+
ToCodeAction r =>
172+
ToCodeAction (Maybe ParsedModule -> r)
173+
where
174+
toCodeAction caa@CodeActionArgs {caaParsedModule = x} f =
175+
toCodeAction caa $ f x
176+
177+
instance ToCodeAction r => ToCodeAction (ParsedModule -> r) where
178+
toCodeAction caa@CodeActionArgs {caaParsedModule = Just x} f =
179+
toCodeAction caa $ f x
180+
toCodeAction _ _ = []
181+
182+
instance ToCodeAction r => ToCodeAction (Maybe T.Text -> r) where
183+
toCodeAction caa@CodeActionArgs {caaContents = x} f =
184+
toCodeAction caa $ f x
185+
186+
instance ToCodeAction r => ToCodeAction (T.Text -> r) where
187+
toCodeAction caa@CodeActionArgs {caaContents = Just x} f =
188+
toCodeAction caa $ f x
189+
toCodeAction _ _ = []
190+
191+
instance ToCodeAction r => ToCodeAction (Maybe DynFlags -> r) where
192+
toCodeAction caa@CodeActionArgs {caaDf = x} f =
193+
toCodeAction caa $ f x
194+
195+
instance ToCodeAction r => ToCodeAction (DynFlags -> r) where
196+
toCodeAction caa@CodeActionArgs {caaDf = Just x} f =
197+
toCodeAction caa $ f x
198+
toCodeAction _ _ = []
199+
200+
instance
201+
ToCodeAction r =>
202+
ToCodeAction (Maybe (Annotated ParsedSource) -> r)
203+
where
204+
toCodeAction caa@CodeActionArgs {caaAnnSource = x} f =
205+
toCodeAction caa $ f x
206+
207+
instance
208+
ToCodeAction r =>
209+
ToCodeAction (Annotated ParsedSource -> r)
210+
where
211+
toCodeAction caa@CodeActionArgs {caaAnnSource = Just x} f =
212+
toCodeAction caa $ f x
213+
toCodeAction _ _ = []
214+
215+
instance
216+
ToCodeAction r =>
217+
ToCodeAction (Maybe TcModuleResult -> r)
218+
where
219+
toCodeAction caa@CodeActionArgs {caaTmr = x} f =
220+
toCodeAction caa $ f x
221+
222+
instance ToCodeAction r => ToCodeAction (TcModuleResult -> r) where
223+
toCodeAction caa@CodeActionArgs {caaTmr = Just x} f =
224+
toCodeAction caa $ f x
225+
toCodeAction _ _ = []
226+
227+
instance
228+
ToCodeAction r =>
229+
ToCodeAction (Maybe HieAstResult -> r)
230+
where
231+
toCodeAction caa@CodeActionArgs {caaHar = x} f =
232+
toCodeAction caa $ f x
233+
234+
instance ToCodeAction r => ToCodeAction (HieAstResult -> r) where
235+
toCodeAction caa@CodeActionArgs {caaHar = Just x} f =
236+
toCodeAction caa $ f x
237+
toCodeAction _ _ = []
238+
239+
instance ToCodeAction r => ToCodeAction (Maybe Bindings -> r) where
240+
toCodeAction caa@CodeActionArgs {caaBindings = x} f =
241+
toCodeAction caa $ f x
242+
243+
instance ToCodeAction r => ToCodeAction (Bindings -> r) where
244+
toCodeAction caa@CodeActionArgs {caaBindings = Just x} f =
245+
toCodeAction caa $ f x
246+
toCodeAction _ _ = []
247+
248+
instance
249+
ToCodeAction r =>
250+
ToCodeAction (Maybe GlobalBindingTypeSigsResult -> r)
251+
where
252+
toCodeAction caa@CodeActionArgs {caaGblSigs = x} f =
253+
toCodeAction caa $ f x
254+
255+
instance
256+
ToCodeAction r =>
257+
ToCodeAction (GlobalBindingTypeSigsResult -> r)
258+
where
259+
toCodeAction caa@CodeActionArgs {caaGblSigs = Just x} f =
260+
toCodeAction caa $ f x
261+
toCodeAction _ _ = []
262+
263+
instance ToCodeAction r => ToCodeAction (Diagnostic -> r) where
264+
toCodeAction caa@CodeActionArgs {caaDiagnostics = x} f =
265+
toCodeAction caa $ f x
266+
267+
-------------------------------------------------------------------------------------------------

‎ghcide/src/Development/IDE/Plugin/CodeAction/Args/TH.hs

Lines changed: 0 additions & 41 deletions
This file was deleted.

0 commit comments

Comments
 (0)