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

Remove JSON transport #1105

Closed
wants to merge 20 commits into from
Closed

Remove JSON transport #1105

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
20 commits
Select commit Hold shift + click to select a range
792e900
JsonStdio (2015-2019)
lukel97 Feb 11, 2019
346ec52
Remove unused plugin fields
lukel97 Feb 12, 2019
9eaaee7
Move modules that aren't actually plugins out of Plugins
lukel97 Feb 12, 2019
430f9ca
Remove superfluous PluginCommand title
lukel97 Feb 12, 2019
f988a11
Move pluginId into the plugins themselves
lukel97 Feb 13, 2019
a96b5d6
Add back lookup and revert hoogle naming (original was more sensible)
lukel97 Feb 13, 2019
5fcffa3
Merge branch 'master' into remove-json-stdio
lukel97 Apr 22, 2019
ec17fff
Fix tests
lukel97 Apr 23, 2019
2bdff3f
Use newtype for PluginId and CommandId
lukel97 Apr 23, 2019
416c184
Fix pluginCommand error messages
lukel97 Apr 23, 2019
2ed1396
Remove unused CPP pragma
lukel97 Apr 23, 2019
823e2d2
Remove more unnecessary CPP pragmas
lukel97 Apr 23, 2019
06769da
Update build-tool-depends for func-test
lukel97 Apr 23, 2019
45e7b2e
Remove trailing whitespace
lukel97 Apr 28, 2019
95c467e
Check at launch for pluginId clashes
lukel97 Apr 28, 2019
ef9cd1a
Merge branch 'master' of https://github.com/haskell/haskell-ide-engin…
lukel97 May 5, 2019
3b45d21
Fix 8.2.2
lukel97 May 5, 2019
fb97085
Fix tests
lukel97 May 5, 2019
13a97a8
Add back type command
lukel97 May 5, 2019
c5bda7b
Export TypeParams
lukel97 May 5, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 3 additions & 3 deletions app/HieWrapper.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ import qualified GhcMod.Monad as GM
import qualified GhcMod.Types as GM
import Haskell.Ide.Engine.MonadFunctions
import Haskell.Ide.Engine.Options
import Haskell.Ide.Engine.Plugin.Base
import Haskell.Ide.Engine.Version
import qualified Language.Haskell.LSP.Core as Core
import Options.Applicative.Simple
import qualified Paths_haskell_ide_engine as Meta
Expand Down Expand Up @@ -42,7 +42,7 @@ main = do
-- Parse the options and run
(global, ()) <-
simpleOptions
version
hieVersion
"hie-wrapper - Launch the appropriate haskell-ide-engine for a given project"
""
(numericVersion <*> compiler <*> globalOptsParser)
Expand All @@ -66,7 +66,7 @@ run opts = do


progName <- getProgName
logm $ "run entered for hie-wrapper(" ++ progName ++ ") " ++ version
logm $ "run entered for hie-wrapper(" ++ progName ++ ") " ++ hieVersion
d <- getCurrentDirectory
logm $ "Current directory:" ++ d

Expand Down
50 changes: 20 additions & 30 deletions app/MainHie.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,8 +9,8 @@ import Haskell.Ide.Engine.MonadFunctions
import Haskell.Ide.Engine.MonadTypes
import Haskell.Ide.Engine.Options
import Haskell.Ide.Engine.Scheduler
import Haskell.Ide.Engine.Transport.LspStdio
import Haskell.Ide.Engine.Transport.JsonStdio
import Haskell.Ide.Engine.Server
import Haskell.Ide.Engine.Version
import qualified Language.Haskell.LSP.Core as Core
import Options.Applicative.Simple
import qualified Paths_haskell_ide_engine as Meta
Expand All @@ -22,15 +22,12 @@ import qualified System.Log.Logger as L
-- plugins

import Haskell.Ide.Engine.Plugin.ApplyRefact
import Haskell.Ide.Engine.Plugin.Base
import Haskell.Ide.Engine.Plugin.Brittany
import Haskell.Ide.Engine.Plugin.Build
import Haskell.Ide.Engine.Plugin.Example2
import Haskell.Ide.Engine.Plugin.GhcMod
import Haskell.Ide.Engine.Plugin.HaRe
import Haskell.Ide.Engine.Plugin.Haddock
import Haskell.Ide.Engine.Plugin.HfaAlign
import Haskell.Ide.Engine.Plugin.Hoogle
import Haskell.Ide.Engine.Plugin.HsImport
import Haskell.Ide.Engine.Plugin.Liquid
import Haskell.Ide.Engine.Plugin.Package
Expand All @@ -41,29 +38,26 @@ import Haskell.Ide.Engine.Plugin.Floskell

-- | This will be read from a configuration, eventually
plugins :: Bool -> IdePlugins
plugins includeExamples = pluginDescToIdePlugins allPlugins
plugins includeExamples = mkIdePlugins allPlugins
where
allPlugins = if includeExamples
then basePlugins ++ examplePlugins
else basePlugins
basePlugins =
[ applyRefactDescriptor "applyrefact"
, baseDescriptor "base"
, brittanyDescriptor "brittany"
, buildPluginDescriptor "build"
, ghcmodDescriptor "ghcmod"
, haddockDescriptor "haddock"
, hareDescriptor "hare"
, hoogleDescriptor "hoogle"
, hsimportDescriptor "hsimport"
, liquidDescriptor "liquid"
, packageDescriptor "package"
, pragmasDescriptor "pragmas"
, floskellDescriptor "floskell"
[ applyRefactDescriptor
, brittanyDescriptor
, ghcmodDescriptor
, haddockDescriptor
, hareDescriptor
, hsimportDescriptor
, liquidDescriptor
, packageDescriptor
, pragmasDescriptor
, floskellDescriptor
]
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The reason I put in the plugin id string when the plugin list is assembled is so that people can easily change the list of installed plugins, and only need to worry about possible name clashes in one place, namely here. By delegating it to the individual plugins we lose this capability.

Unless there is some other mechanism to disambiguate them?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think this might need a larger discussion about how loading plugins will eventually look like.
I'm also thinking it might make more sense to remove pluginId as a field from PluginDescriptor, and have HIE generate a unique id at launch instead?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Scrap that thought: It's used by liquid/ghc-mod and floskell/brittany to get specific plugins

examplePlugins =
[example2Descriptor "eg2"
,hfaAlignDescriptor "hfaa"
[ example2Descriptor
, hfaAlignDescriptor
]

-- ---------------------------------------------------------------------
Expand All @@ -86,7 +80,7 @@ main = do
-- Parse the options and run
(global, ()) <-
simpleOptions
version
hieVersion
"haskell-ide-engine - Provide a common engine to power any Haskell IDE"
""
(numericVersion <*> compiler <*> globalOptsParser)
Expand Down Expand Up @@ -116,7 +110,7 @@ run opts = do
maybe (pure ()) setCurrentDirectory $ projectRoot opts

progName <- getProgName
logm $ "Run entered for HIE(" ++ progName ++ ") " ++ version
logm $ "Run entered for HIE(" ++ progName ++ ") " ++ hieVersion
d <- getCurrentDirectory
logm $ "Current directory:" ++ d

Expand All @@ -135,10 +129,6 @@ run opts = do

let plugins' = plugins (optExamplePlugin opts)

-- launch the dispatcher.
if optJson opts then do
scheduler <- newScheduler plugins' biosOptions
jsonStdioTransport scheduler
else do
scheduler <- newScheduler plugins' biosOptions
lspStdioTransport scheduler origDir plugins' (optCaptureFile opts)
-- launch the server.
scheduler <- newScheduler plugins' biosOptions
server scheduler origDir plugins' (optCaptureFile opts)
20 changes: 9 additions & 11 deletions haskell-ide-engine.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,31 +20,29 @@ flag pedantic
library
hs-source-dirs: src
exposed-modules: Haskell.Ide.Engine.Channel
Haskell.Ide.Engine.LSP.CodeActions
Haskell.Ide.Engine.Plugin.Base
Haskell.Ide.Engine.LSP.Reactor
Haskell.Ide.Engine.Scheduler
Haskell.Ide.Engine.Server
Haskell.Ide.Engine.CodeActions
Haskell.Ide.Engine.Reactor
Haskell.Ide.Engine.Support.Fuzzy
Haskell.Ide.Engine.Support.Extras
Haskell.Ide.Engine.Hoogle
Haskell.Ide.Engine.Options
Haskell.Ide.Engine.Types
Haskell.Ide.Engine.Version
Haskell.Ide.Engine.Plugin.ApplyRefact
Haskell.Ide.Engine.Plugin.Brittany
Haskell.Ide.Engine.Plugin.Build
Haskell.Ide.Engine.Plugin.Example2
Haskell.Ide.Engine.Plugin.Floskell
Haskell.Ide.Engine.Plugin.GhcMod
Haskell.Ide.Engine.Plugin.HaRe
Haskell.Ide.Engine.Plugin.Haddock
Haskell.Ide.Engine.Plugin.HfaAlign
Haskell.Ide.Engine.Plugin.Hoogle
Haskell.Ide.Engine.Plugin.HsImport
Haskell.Ide.Engine.Plugin.Liquid
Haskell.Ide.Engine.Plugin.Package
Haskell.Ide.Engine.Plugin.Package.Compat
Haskell.Ide.Engine.Plugin.Pragmas
Haskell.Ide.Engine.Scheduler
Haskell.Ide.Engine.Support.Fuzzy
Haskell.Ide.Engine.Support.HieExtras
Haskell.Ide.Engine.Transport.JsonStdio
Haskell.Ide.Engine.Transport.LspStdio
Haskell.Ide.Engine.Types
other-modules: Paths_haskell_ide_engine
build-depends: Cabal >= 1.22
, Diff
Expand Down
84 changes: 45 additions & 39 deletions hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,12 +20,12 @@ module Haskell.Ide.Engine.PluginsIdeMonads
, allLspCmdIds
, mkLspCmdId
-- * Plugins
, PluginId
, CommandName
, IdePlugins
, mkIdePlugins
, PluginId(..)
, CommandId(..)
, PluginDescriptor(..)
, pluginDescToIdePlugins
, PluginCommand(..)
, CommandFunc(..)
, runPluginCommand
, DynamicJSON
, dynToJSON
Expand All @@ -41,7 +41,6 @@ module Haskell.Ide.Engine.PluginsIdeMonads
, SymbolProvider
, FormattingType(..)
, FormattingProvider
, IdePlugins(..)
, getDiagnosticProvidersConfig
-- * IDE monads
, IdeState(..)
Expand Down Expand Up @@ -112,6 +111,7 @@ import qualified Data.Map as Map
import Data.Maybe
import Data.Monoid ( (<>) )
import qualified Data.Set as S
import Data.String
import qualified Data.Text as T
import Data.Typeable ( TypeRep
, Typeable
Expand Down Expand Up @@ -175,19 +175,19 @@ instance HasPidCache IO where
instance HasPidCache m => HasPidCache (IdeResultT m) where
getPidCache = lift getPidCache

mkLspCommand :: HasPidCache m => PluginId -> CommandName -> T.Text -> Maybe [Value] -> m Command
mkLspCommand :: HasPidCache m => PluginId -> CommandId -> T.Text -> Maybe [Value] -> m Command
mkLspCommand plid cn title args' = do
cmdId <- mkLspCmdId plid cn
let args = List <$> args'
return $ Command title cmdId args

allLspCmdIds :: HasPidCache m => IdePlugins -> m [T.Text]
allLspCmdIds (IdePlugins m) = concat <$> mapM go (Map.toList (pluginCommands <$> m))
allLspCmdIds m = concat <$> mapM go (Map.toList (pluginCommands <$> m))
where
go (plid, cmds) = mapM (mkLspCmdId plid . commandName) cmds
go (plid, cmds) = mapM (mkLspCmdId plid . commandId) cmds

mkLspCmdId :: HasPidCache m => PluginId -> CommandName -> m T.Text
mkLspCmdId plid cn = do
mkLspCmdId :: HasPidCache m => PluginId -> CommandId -> m T.Text
mkLspCmdId (PluginId plid) (CommandId cn) = do
pid <- T.pack . show <$> getPidCache
return $ pid <> ":" <> plid <> ":" <> cn

Expand Down Expand Up @@ -262,8 +262,6 @@ type FormattingProvider = T.Text -- ^ Text to format

data PluginDescriptor =
PluginDescriptor { pluginId :: PluginId
, pluginName :: T.Text
, pluginDesc :: T.Text
, pluginCommands :: [PluginCommand]
, pluginCodeActionProvider :: Maybe CodeActionProvider
, pluginDiagnosticProvider :: Maybe DiagnosticProvider
Expand All @@ -272,22 +270,26 @@ data PluginDescriptor =
, pluginFormattingProvider :: Maybe FormattingProvider
} deriving (Generic)

instance Show PluginCommand where
show (PluginCommand name _ _) = "PluginCommand { name = " ++ T.unpack name ++ " }"
newtype PluginId = PluginId T.Text
deriving (Show, Read, Eq, Ord)

instance IsString PluginId where
fromString = PluginId . T.pack

type PluginId = T.Text
type CommandName = T.Text
newtype CommandId = CommandId T.Text
deriving (Show, Read, Eq, Ord)

newtype CommandFunc a b = CmdSync (a -> IdeGhcM (IdeResult b))
instance IsString CommandId where
fromString = CommandId . T.pack

-- TODO: Figure out a type-safer way to handle plugin + command ids
data PluginCommand = forall a b. (FromJSON a, ToJSON b, Typeable b) =>
PluginCommand { commandName :: CommandName
, commandDesc :: T.Text
, commandFunc :: CommandFunc a b
PluginCommand { commandId :: CommandId
, commandFunc :: a -> IdeGhcM (IdeResult b)
}

pluginDescToIdePlugins :: [PluginDescriptor] -> IdePlugins
pluginDescToIdePlugins plugins = IdePlugins $ Map.fromList $ map (\p -> (pluginId p, p)) plugins
instance Show PluginCommand where
show (PluginCommand (CommandId name) _) = "PluginCommand { name = " ++ T.unpack name ++ " }"

type DynamicJSON = CD.ConstrainedDynamic ToJSON

Expand All @@ -300,34 +302,38 @@ fromDynJSON = CD.fromDynamic
toDynJSON :: (Typeable a, ToJSON a) => a -> DynamicJSON
toDynJSON = CD.toDyn

-- | Runs a plugin command given a PluginId, CommandName and
-- | Runs a plugin command given a PluginId, CommandId and
-- arguments in the form of a JSON object.
runPluginCommand :: PluginId -> CommandName -> Value
runPluginCommand :: PluginId -> CommandId -> Value
-> IdeGhcM (IdeResult DynamicJSON)
runPluginCommand p com arg = do
IdePlugins m <- getPlugins
runPluginCommand p@(PluginId pText) com@(CommandId comText) arg = do
m <- getPlugins
case Map.lookup p m of
Nothing -> return $
IdeResultFail $ IdeError UnknownPlugin ("Plugin " <> p <> " doesn't exist") Null
Just PluginDescriptor { pluginCommands = xs } -> case List.find ((com ==) . commandName) xs of
IdeResultFail $ IdeError UnknownPlugin ("Plugin " <> pText <> " doesn't exist") Null
Just PluginDescriptor { pluginCommands = xs } -> case List.find ((com ==) . commandId) xs of
Nothing -> return $ IdeResultFail $
IdeError UnknownCommand ("Command " <> com <> " isn't defined for plugin " <> p <> ". Legal commands are: " <> T.pack(show $ map commandName xs)) Null
Just (PluginCommand _ _ (CmdSync f)) -> case fromJSON arg of
IdeError UnknownCommand ("Command " <> comText <> " isn't defined for plugin " <> pText <> ". Legal commands are: " <> (T.pack $ show $ map (\(CommandId x) -> x) $ map commandId xs)) Null
Just (PluginCommand _ f) -> case fromJSON arg of
Error err -> return $ IdeResultFail $
IdeError ParameterError ("error while parsing args for " <> com <> " in plugin " <> p <> ": " <> T.pack err) Null
IdeError ParameterError ("error while parsing args for " <> comText <> " in plugin " <> pText <> ": " <> T.pack err) Null
Success a -> do
res <- f a
return $ fmap toDynJSON res

-- | a Description of the available commands stored in IdeGhcM
newtype IdePlugins = IdePlugins
{ ipMap :: Map.Map PluginId PluginDescriptor
} deriving (Generic)
type IdePlugins = Map.Map PluginId PluginDescriptor

-- TODO:AZ this is a defective instance, do we actually need it?
-- Perhaps rather make a separate type explicitly for this purpose.
instance ToJSON IdePlugins where
toJSON (IdePlugins m) = toJSON $ fmap (\x -> (commandName x, commandDesc x)) <$> fmap pluginCommands m
mkIdePlugins :: [PluginDescriptor] -> IdePlugins
mkIdePlugins plugins
| Just pid <- checkClashes plugins = error $ "Two plugins have the same id: " <> pid
| otherwise = Map.fromList $ map (\x -> (pluginId x, x)) plugins
where
checkClashes = foldl go Nothing . List.group . List.sort . map pluginId
go :: Maybe String -> [PluginId] -> Maybe String
go (Just x) _ = Just x
go Nothing (PluginId a:_:_) = Just (T.unpack a)
go Nothing _ = Nothing

-- | For the diagnostic providers in the config, return a map of
-- current enabled state, indexed by the plugin id.
Expand Down Expand Up @@ -357,7 +363,7 @@ runIdeGhcM biosOptions plugins mlf stateVar f = do
runIdeGhcMBare :: BiosOptions -> IdeGhcM a -> IO a
runIdeGhcMBare biosOptions f = do
let
plugins = IdePlugins Map.empty
plugins = mkIdePlugins mempty
mlf = Nothing
initialState = IdeState emptyModuleCache Map.empty Map.empty Nothing
stateVar <- newTVarIO initialState
Expand Down
8 changes: 3 additions & 5 deletions src/Haskell/Ide/Engine/LSP/CodeActions.hs → src/Haskell/Ide/Engine/CodeActions.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,15 +3,15 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Haskell.Ide.Engine.LSP.CodeActions where
module Haskell.Ide.Engine.CodeActions where

import Control.Lens
import Control.Monad.Reader
import qualified Data.Aeson as J
import Data.Maybe
import Data.Foldable
import qualified GHC.Generics as G
import Haskell.Ide.Engine.LSP.Reactor
import Haskell.Ide.Engine.Reactor
import Haskell.Ide.Engine.Types
import qualified Language.Haskell.LSP.Core as Core
import qualified Language.Haskell.LSP.Types as J
Expand All @@ -36,9 +36,7 @@ handleCodeActionReq tn req = do
let docId = J.VersionedTextDocumentIdentifier docUri docVersion

let getProvider p = pluginCodeActionProvider p <*> return (pluginId p)
getProviders = do
IdePlugins m <- getPlugins
return $ IdeResultOk $ mapMaybe getProvider $ toList m
getProviders = IdeResultOk . mapMaybe getProvider . toList <$> getPlugins

providersCb providers =
let reqs = map (\f -> lift (f docId range context)) providers
Expand Down
Loading