Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit 52d9dc7

Browse files
committed
Merge pull request #122 from alanz/rework-api-split
Rework api split
2 parents 9d13bcb + 0a097b6 commit 52d9dc7

File tree

6 files changed

+151
-86
lines changed

6 files changed

+151
-86
lines changed

haskell-ide-engine.cabal

-2
Original file line numberDiff line numberDiff line change
@@ -18,8 +18,6 @@ library
1818
exposed-modules: Haskell.Ide.Engine.BasePlugin
1919
Haskell.Ide.Engine.Console
2020
Haskell.Ide.Engine.Dispatcher
21-
Haskell.Ide.Engine.Monad
22-
Haskell.Ide.Engine.MonadFunctions
2321
Haskell.Ide.Engine.Options
2422
Haskell.Ide.Engine.Transport.JsonHttp
2523
Haskell.Ide.Engine.Transport.JsonStdio
Original file line numberDiff line numberDiff line change
@@ -1,48 +1,17 @@
1-
{-# LANGUAGE DeriveFunctor #-}
21
{-# LANGUAGE FlexibleInstances #-}
3-
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
42
{-# LANGUAGE MultiParamTypeClasses #-}
53

64
module Haskell.Ide.Engine.Monad where
75

8-
import qualified DynFlags as GHC
9-
import qualified GHC as GHC
10-
import qualified HscTypes as GHC
11-
12-
import Control.Applicative
136
import Control.Exception
147
import Control.Monad.IO.Class
158
import Control.Monad.State
169
import Data.IORef
17-
import Exception
1810
import Haskell.Ide.Engine.PluginDescriptor
1911
import qualified Language.Haskell.GhcMod.Monad as GM
2012
import qualified Language.Haskell.GhcMod.Types as GM
2113
import System.Directory
2214

23-
-- Monad transformer stuff
24-
import Control.Monad.Trans.Control ( control, liftBaseOp, liftBaseOp_)
25-
26-
-- ---------------------------------------------------------------------
27-
28-
newtype IdeM a = IdeM { unIdeM :: GM.GhcModT (GM.GmOutT (StateT IdeState IO)) a}
29-
deriving ( Functor
30-
, Applicative
31-
, Alternative
32-
, Monad
33-
, MonadPlus
34-
, MonadIO
35-
, GM.GmEnv
36-
, GM.GmOut
37-
, GM.MonadIO
38-
, ExceptionMonad
39-
)
40-
41-
data IdeState = IdeState
42-
{
43-
idePlugins :: Plugins
44-
} deriving (Show)
45-
4615
-- ---------------------------------------------------------------------
4716

4817
runIdeM :: IdeState -> IdeM a -> IO a
@@ -76,31 +45,6 @@ runIdeM initState f = do
7645
setTargets :: [Either FilePath GM.ModuleName] -> IdeM ()
7746
setTargets targets = IdeM $ GM.runGmlT targets (return ())
7847

79-
-- ---------------------------------------------------------------------
80-
81-
instance GM.MonadIO (StateT IdeState IO) where
82-
liftIO = liftIO
83-
84-
instance MonadState IdeState IdeM where
85-
get = IdeM (lift $ lift $ lift get)
86-
put s = IdeM (lift $ lift $ lift (put s))
87-
88-
instance GHC.GhcMonad IdeM where
89-
getSession = IdeM $ GM.unGmlT GM.gmlGetSession
90-
setSession env = IdeM $ GM.unGmlT (GM.gmlSetSession env)
91-
92-
instance GHC.HasDynFlags IdeM where
93-
getDynFlags = GHC.hsc_dflags <$> GHC.getSession
94-
95-
instance ExceptionMonad (StateT IdeState IO) where
96-
gcatch act handler = control $ \run ->
97-
run act `gcatch` (run . handler)
98-
99-
gmask = liftBaseOp gmask . liftRestore
100-
where liftRestore f r = f $ liftBaseOp_ r
10148

102-
instance HasIdeState IdeM where
103-
getPlugins = gets idePlugins
104-
setTargets targets = IdeM $ GM.runGmlT (map Left targets) (return ())
10549

10650
-- EOF

hie-plugin-api/Haskell/Ide/Engine/PluginDescriptor.hs

+140-26
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,19 @@
1-
{-# LANGUAGE PolyKinds #-}
2-
{-# LANGUAGE TypeOperators #-}
3-
{-# LANGUAGE GADTs #-}
41
{-# LANGUAGE DataKinds #-}
5-
{-# LANGUAGE KindSignatures #-}
6-
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE DeriveFunctor #-}
73
{-# LANGUAGE DeriveGeneric #-}
8-
{-# LANGUAGE TypeSynonymInstances #-}
94
{-# LANGUAGE FlexibleInstances #-}
10-
{-# LANGUAGE RankNTypes #-}
11-
{-# LANGUAGE StandaloneDeriving #-}
5+
{-# LANGUAGE GADTs #-}
6+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7+
{-# LANGUAGE KindSignatures #-}
8+
{-# LANGUAGE MultiParamTypeClasses #-}
9+
{-# LANGUAGE OverloadedStrings #-}
1210
{-# LANGUAGE PatternSynonyms #-}
11+
{-# LANGUAGE PolyKinds #-}
12+
{-# LANGUAGE RankNTypes #-}
1313
{-# LANGUAGE ScopedTypeVariables #-}
14+
{-# LANGUAGE StandaloneDeriving #-}
15+
{-# LANGUAGE TypeOperators #-}
16+
{-# LANGUAGE TypeSynonymInstances #-}
1417
-- | Experimenting with a data structure to define a plugin.
1518
--
1619
-- The general idea is that a given plugin returns this structure during the
@@ -27,21 +30,82 @@
2730
-- shared resource management, e.g. default Calendar app, default SMS app,
2831
-- all making use of Contacts service.
2932

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
3194

3295
import Control.Applicative
33-
import Control.Monad
34-
import Control.Monad.IO.Class
3596
import Data.Aeson
3697
import Data.Aeson.Types
3798
import qualified Data.Map as Map
3899
import Data.Maybe
39100
import qualified Data.HashMap.Strict as H
40101
import qualified Data.Text as T
41102
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
43107
import GHC.Generics
44-
108+
import qualified Language.Haskell.GhcMod.Monad as GM
45109

46110
-- ---------------------------------------------------------------------
47111

@@ -113,8 +177,8 @@ data ExtendedCommandDescriptor =
113177

114178
-- | Subset type extracted from 'Plugins' to be sent to the IDE as
115179
-- 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]
118182
} deriving (Show,Eq,Generic)
119183

120184
-- | Define what context will be accepted from the frontend for the specific
@@ -131,7 +195,9 @@ data AcceptedContext
131195
type Pos = (Int,Int)
132196

133197
-- |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
135201

136202
data CabalSection = CabalSection T.Text deriving (Show,Eq,Generic)
137203

@@ -279,12 +345,6 @@ data IdeError = IdeError
279345
}
280346
deriving (Show,Read,Eq,Generic)
281347

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-
288348
-- | The 'CommandFunc' is called once the dispatcher has checked that it
289349
-- satisfies at least one of the `AcceptedContext` values for the command
290350
-- descriptor, and has all the required parameters. Where a command has only one
@@ -295,11 +355,11 @@ data CommandFunc resp = CmdSync (SyncCommandFunc resp)
295355
-- ^ Note: does not forkIO, the command must decide when
296356
-- to do this.
297357

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)
300360

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 ()
303363

304364
-- ---------------------------------------------------------------------
305365
-- ValidResponse instances
@@ -535,4 +595,58 @@ instance (ValidResponse a) => FromJSON (IdeResponse a) where
535595
return $ fromJust $ mf <|> me <|> mo
536596
parseJSON _ = empty
537597

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+
538652
-- EOF

hie-plugin-api/hie-plugin-api.cabal

+11-1
Original file line numberDiff line numberDiff line change
@@ -12,15 +12,25 @@ build-type: Simple
1212
cabal-version: >=1.10
1313

1414
library
15-
exposed-modules: Haskell.Ide.Engine.PluginUtils
15+
exposed-modules: Haskell.Ide.Engine.Monad
16+
Haskell.Ide.Engine.MonadFunctions
1617
Haskell.Ide.Engine.PluginDescriptor
18+
Haskell.Ide.Engine.PluginUtils
1719
Haskell.Ide.Engine.SemanticTypes
1820
build-depends: base >= 4.7 && < 5
1921
, Diff
2022
, aeson
2123
, containers
24+
, directory
25+
, fast-logger
2226
, ghc
27+
, ghc-mod >= 5.4
28+
, lifted-base
29+
, monad-control
30+
, monad-logger
31+
, mtl
2332
, text
33+
, time
2434
, transformers
2535
, unordered-containers
2636
, vinyl >= 0.5 && < 0.6

src/Haskell/Ide/Engine/Dispatcher.hs

-1
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,6 @@ import Data.Aeson
1111
import Data.Either
1212
import Data.Monoid
1313
import qualified Data.Text as T
14-
import Haskell.Ide.Engine.Monad
1514
import Haskell.Ide.Engine.MonadFunctions
1615
import Haskell.Ide.Engine.PluginDescriptor
1716
import Haskell.Ide.Engine.PluginUtils

0 commit comments

Comments
 (0)