/
Types.hs
171 lines (144 loc) · 5.94 KB
/
Types.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Wingman.AbstractLSP.Types where
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe (MaybeT (MaybeT), mapMaybeT)
import qualified Data.Aeson as A
import Data.Text (Text)
import Development.IDE (IdeState)
import Development.IDE.GHC.ExactPrint (Graft)
import Development.IDE.Core.UseStale
import Development.IDE.GHC.Compat hiding (Target)
import GHC.Generics (Generic)
import qualified Ide.Plugin.Config as Plugin
import Ide.Types
import Language.LSP.Server (LspM)
import Language.LSP.Types hiding (CodeLens, CodeAction)
import Wingman.LanguageServer (judgementForHole)
import Wingman.Types
------------------------------------------------------------------------------
-- | An 'Interaction' is an existential 'Continuation', which handles both
-- sides of the request/response interaction for LSP.
data Interaction where
Interaction
:: (IsTarget target, IsContinuationSort sort, A.ToJSON b, A.FromJSON b)
=> Continuation sort target b
-> Interaction
------------------------------------------------------------------------------
-- | Metadata for a command. Used by both code actions and lenses, though for
-- lenses, only 'md_title' is currently used.
data Metadata
= Metadata
{ md_title :: Text
, md_kind :: CodeActionKind
, md_preferred :: Bool
}
deriving stock (Eq, Show)
------------------------------------------------------------------------------
-- | Whether we're defining a CodeAction or CodeLens.
data SynthesizeCommand a b
= SynthesizeCodeAction
( LspEnv
-> TargetArgs a
-> MaybeT (LspM Plugin.Config) [(Metadata, b)]
)
| SynthesizeCodeLens
( LspEnv
-> TargetArgs a
-> MaybeT (LspM Plugin.Config) [(Range, Metadata, b)]
)
------------------------------------------------------------------------------
-- | Transform a "continuation sort" into a 'CommandId'.
class IsContinuationSort a where
toCommandId :: a -> CommandId
instance IsContinuationSort CommandId where
toCommandId = id
instance IsContinuationSort Text where
toCommandId = CommandId
------------------------------------------------------------------------------
-- | Ways a 'Continuation' can resolve.
data ContinuationResult
= -- | Produce some error messages.
ErrorMessages [UserFacingMessage]
-- | Produce an explicit 'WorkspaceEdit'.
| RawEdit WorkspaceEdit
-- | Produce a 'Graft', corresponding to a transformation of the current
-- AST.
| GraftEdit (Graft (Either String) ParsedSource)
------------------------------------------------------------------------------
-- | A 'Continuation' is a single object corresponding to an action that users
-- can take via LSP. It generalizes codeactions and codelenses, allowing for
-- a significant amount of code reuse.
--
-- Given @Continuation sort target payload@:
--
-- the @sort@ corresponds to a 'CommandId', allowing you to namespace actions
-- rather than working directly with text. This functionality is driven via
-- 'IsContinuationSort'.
--
-- the @target@ is used to fetch data from LSP on both sides of the
-- request/response barrier. For example, you can use it to resolve what node
-- in the AST the incoming range refers to. This functionality is driven via
-- 'IsTarget'.
--
-- the @payload@ is used for data you'd explicitly like to send from the
-- request to the response. It's like @target@, but only gets computed once.
-- This is beneficial if you can do it, but requires that your data is
-- serializable via JSON.
data Continuation sort target payload = Continuation
{ c_sort :: sort
, c_makeCommand :: SynthesizeCommand target payload
, c_runCommand
:: LspEnv
-> TargetArgs target
-> FileContext
-> payload
-> MaybeT (LspM Plugin.Config) [ContinuationResult]
}
------------------------------------------------------------------------------
-- | What file are we looking at, and what bit of it?
data FileContext = FileContext
{ fc_uri :: Uri
, fc_nfp :: NormalizedFilePath
, fc_range :: Maybe (Tracked 'Current Range)
-- ^ For code actions, this is 'Just'. For code lenses, you'll get
-- a 'Nothing' in the request, and a 'Just' in the response.
}
deriving stock (Eq, Ord, Show, Generic)
deriving anyclass (A.ToJSON, A.FromJSON)
deriving anyclass instance A.ToJSON NormalizedFilePath
deriving anyclass instance A.ToJSON NormalizedUri
deriving anyclass instance A.FromJSON NormalizedFilePath
deriving anyclass instance A.FromJSON NormalizedUri
------------------------------------------------------------------------------
-- | Everything we need to resolve continuations.
data LspEnv = LspEnv
{ le_ideState :: IdeState
, le_pluginId :: PluginId
, le_dflags :: DynFlags
, le_config :: Config
, le_fileContext :: FileContext
}
------------------------------------------------------------------------------
-- | Extract some information from LSP, so it can be passed to the requests and
-- responses of a 'Continuation'.
class IsTarget t where
type TargetArgs t
fetchTargetArgs
:: LspEnv
-> MaybeT (LspM Plugin.Config) (TargetArgs t)
------------------------------------------------------------------------------
-- | A 'HoleTarget' is a target (see 'IsTarget') which succeeds if the given
-- range is an HsExpr hole. It gives continuations access to the resulting
-- tactic judgement.
data HoleTarget = HoleTarget
deriving stock (Eq, Ord, Show, Enum, Bounded)
instance IsTarget HoleTarget where
type TargetArgs HoleTarget = HoleJudgment
fetchTargetArgs LspEnv{..} = do
let FileContext{..} = le_fileContext
range <- MaybeT $ pure fc_range
mapMaybeT liftIO $ judgementForHole le_ideState fc_nfp range le_config