1
- {-# LANGUAGE PolyKinds #-}
2
- {-# LANGUAGE TypeOperators #-}
3
- {-# LANGUAGE GADTs #-}
4
1
{-# LANGUAGE DataKinds #-}
5
- {-# LANGUAGE KindSignatures #-}
6
- {-# LANGUAGE OverloadedStrings #-}
2
+ {-# LANGUAGE DeriveFunctor #-}
7
3
{-# LANGUAGE DeriveGeneric #-}
8
- {-# LANGUAGE TypeSynonymInstances #-}
9
4
{-# LANGUAGE FlexibleInstances #-}
10
- {-# LANGUAGE RankNTypes #-}
11
- {-# LANGUAGE StandaloneDeriving #-}
5
+ {-# LANGUAGE GADTs #-}
6
+ {-# LANGUAGE GeneralizedNewtypeDeriving #-}
7
+ {-# LANGUAGE KindSignatures #-}
8
+ {-# LANGUAGE MultiParamTypeClasses #-}
9
+ {-# LANGUAGE OverloadedStrings #-}
12
10
{-# LANGUAGE PatternSynonyms #-}
11
+ {-# LANGUAGE PolyKinds #-}
12
+ {-# LANGUAGE RankNTypes #-}
13
13
{-# LANGUAGE ScopedTypeVariables #-}
14
+ {-# LANGUAGE StandaloneDeriving #-}
15
+ {-# LANGUAGE TypeOperators #-}
16
+ {-# LANGUAGE TypeSynonymInstances #-}
14
17
-- | Experimenting with a data structure to define a plugin.
15
18
--
16
19
-- The general idea is that a given plugin returns this structure during the
27
30
-- shared resource management, e.g. default Calendar app, default SMS app,
28
31
-- all making use of Contacts service.
29
32
30
- module Haskell.Ide.Engine.PluginDescriptor where
33
+ module Haskell.Ide.Engine.PluginDescriptor
34
+ (
35
+ PluginDescriptor (.. )
36
+ , Service (.. )
37
+ , AcceptedContext (.. )
38
+ , CabalSection (.. )
39
+ , contextMapping
40
+
41
+ , fileParam
42
+ , startPosParam
43
+ , endPosParam
44
+ , cabalParam
45
+
46
+ -- * Parameters
47
+ , ParamDescription (.. )
48
+ , ParamHelp
49
+ , ParamName
50
+ , ParamType (.. )
51
+ , ParamVal (.. )
52
+ , ParamValP (.. )
53
+ , ParamMap
54
+ , pattern ParamTextP
55
+ , pattern ParamFileP
56
+ , pattern ParamPosP
57
+ , ParamId
58
+ , TaggedParamId (.. )
59
+
60
+ -- * Commands
61
+ , CommandDescriptor (.. )
62
+ , Command (.. )
63
+ , CommandFunc (.. ), SyncCommandFunc , AsyncCommandFunc
64
+ , CommandName
65
+ , PluginName
66
+ , ExtendedCommandDescriptor (.. )
67
+ , buildCommand
68
+ , ValidResponse (.. )
69
+
70
+ -- * Interface types
71
+ , IdeRequest (.. )
72
+ , IdeResponse (.. )
73
+ , IdeError (.. )
74
+ , IdeErrorCode (.. )
75
+
76
+ , Pos
77
+ , posToJSON
78
+ , jsonToPos
79
+
80
+ -- * Plugins
81
+ , Plugins
82
+ , PluginId
83
+ , IdePlugins (.. )
84
+
85
+ -- * The IDE monad
86
+ , IdeM (.. )
87
+ , IdeState (.. )
88
+ , HasIdeState (.. )
89
+ ) where
90
+
91
+ import qualified DynFlags as GHC
92
+ import qualified GHC as GHC
93
+ import qualified HscTypes as GHC
31
94
32
95
import Control.Applicative
33
- import Control.Monad
34
- import Control.Monad.IO.Class
35
96
import Data.Aeson
36
97
import Data.Aeson.Types
37
98
import qualified Data.Map as Map
38
99
import Data.Maybe
39
100
import qualified Data.HashMap.Strict as H
40
101
import qualified Data.Text as T
41
102
import Data.Typeable
42
- import qualified GHC
103
+ import Control.Monad.IO.Class
104
+ import Control.Monad.State
105
+ import Control.Monad.Trans.Control ( control , liftBaseOp , liftBaseOp_ )
106
+ import Exception
43
107
import GHC.Generics
44
-
108
+ import qualified Language.Haskell.GhcMod.Monad as GM
45
109
46
110
-- ---------------------------------------------------------------------
47
111
@@ -113,8 +177,8 @@ data ExtendedCommandDescriptor =
113
177
114
178
-- | Subset type extracted from 'Plugins' to be sent to the IDE as
115
179
-- a description of the available commands
116
- data IdePlugins = IdePlugins {
117
- ipMap :: Map. Map PluginId [CommandDescriptor ]
180
+ data IdePlugins = IdePlugins
181
+ { ipMap :: Map. Map PluginId [CommandDescriptor ]
118
182
} deriving (Show ,Eq ,Generic )
119
183
120
184
-- | Define what context will be accepted from the frontend for the specific
@@ -131,7 +195,9 @@ data AcceptedContext
131
195
type Pos = (Int ,Int )
132
196
133
197
-- | It will simplify things to always work with an absolute file path
134
- type AbsFilePath = FilePath
198
+
199
+ -- AZ:TODO: reinstate this
200
+ -- type AbsFilePath = FilePath
135
201
136
202
data CabalSection = CabalSection T. Text deriving (Show ,Eq ,Generic )
137
203
@@ -279,12 +345,6 @@ data IdeError = IdeError
279
345
}
280
346
deriving (Show ,Read ,Eq ,Generic )
281
347
282
- class (Monad m ) => HasIdeState m where
283
- getPlugins :: m Plugins
284
- -- | Set up an underlying GHC session for the specific targets. Should map
285
- -- down to ghc-mod setTargets.
286
- setTargets :: [FilePath ] -> m ()
287
-
288
348
-- | The 'CommandFunc' is called once the dispatcher has checked that it
289
349
-- satisfies at least one of the `AcceptedContext` values for the command
290
350
-- descriptor, and has all the required parameters. Where a command has only one
@@ -295,11 +355,11 @@ data CommandFunc resp = CmdSync (SyncCommandFunc resp)
295
355
-- ^ Note: does not forkIO, the command must decide when
296
356
-- to do this.
297
357
298
- type SyncCommandFunc resp = forall m . ( MonadIO m , GHC. GhcMonad m , HasIdeState m )
299
- = > [AcceptedContext ] -> IdeRequest -> m (IdeResponse resp )
358
+ type SyncCommandFunc resp
359
+ = [AcceptedContext ] -> IdeRequest -> IdeM (IdeResponse resp )
300
360
301
- type AsyncCommandFunc resp = forall m . ( MonadIO m , GHC. GhcMonad m , HasIdeState m )
302
- = > ( IdeResponse resp -> IO () ) -> [AcceptedContext ] -> IdeRequest -> m ()
361
+ type AsyncCommandFunc resp = ( IdeResponse resp -> IO () )
362
+ -> [AcceptedContext ] -> IdeRequest -> IdeM ()
303
363
304
364
-- ---------------------------------------------------------------------
305
365
-- ValidResponse instances
@@ -535,4 +595,58 @@ instance (ValidResponse a) => FromJSON (IdeResponse a) where
535
595
return $ fromJust $ mf <|> me <|> mo
536
596
parseJSON _ = empty
537
597
598
+ -- ---------------------------------------------------------------------
599
+
600
+ newtype IdeM a = IdeM { unIdeM :: GM. GhcModT (GM. GmOutT (StateT IdeState IO )) a }
601
+ deriving ( Functor
602
+ , Applicative
603
+ , Alternative
604
+ , Monad
605
+ , MonadPlus
606
+ , MonadIO
607
+ , GM.GmEnv
608
+ , GM.GmOut
609
+ , GM.MonadIO
610
+ , ExceptionMonad
611
+ )
612
+
613
+ data IdeState = IdeState
614
+ {
615
+ idePlugins :: Plugins
616
+ } deriving (Show )
617
+
618
+ class (Monad m ) => HasIdeState m where
619
+ getPlugins :: m Plugins
620
+ -- | Set up an underlying GHC session for the specific targets. Should map
621
+ -- down to ghc-mod setTargets.
622
+ setTargets :: [FilePath ] -> m ()
623
+
624
+ -- ---------------------------------------------------------------------
625
+
626
+ instance GM. MonadIO (StateT IdeState IO ) where
627
+ liftIO = liftIO
628
+
629
+ instance MonadState IdeState IdeM where
630
+ get = IdeM (lift $ lift $ lift get)
631
+ put s = IdeM (lift $ lift $ lift (put s))
632
+
633
+ instance GHC. GhcMonad IdeM where
634
+ getSession = IdeM $ GM. unGmlT GM. gmlGetSession
635
+ setSession env = IdeM $ GM. unGmlT (GM. gmlSetSession env)
636
+
637
+ instance GHC. HasDynFlags IdeM where
638
+ getDynFlags = GHC. hsc_dflags <$> GHC. getSession
639
+
640
+ instance ExceptionMonad (StateT IdeState IO ) where
641
+ gcatch act handler = control $ \ run ->
642
+ run act `gcatch` (run . handler)
643
+
644
+ gmask = liftBaseOp gmask . liftRestore
645
+ where liftRestore f r = f $ liftBaseOp_ r
646
+
647
+ -- AZ:TODO: These can become just MonadFunctions
648
+ instance HasIdeState IdeM where
649
+ getPlugins = gets idePlugins
650
+ setTargets targets = IdeM $ GM. runGmlT (map Left targets) (return () )
651
+
538
652
-- EOF
0 commit comments