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

Commit 1cbb6ae

Browse files
alanzalanz
authored
Merge pull request #1505 from alanz/ghc-mod-plugin-proxy
Restore the ghcmod plugin command routing
2 parents c686b63 + 9ebaf03 commit 1cbb6ae

File tree

4 files changed

+192
-0
lines changed

4 files changed

+192
-0
lines changed

‎app/MainHie.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,7 @@ import Haskell.Ide.Engine.Plugin.Package
3535
import Haskell.Ide.Engine.Plugin.Pragmas
3636
import Haskell.Ide.Engine.Plugin.Floskell
3737
import Haskell.Ide.Engine.Plugin.Generic
38+
import Haskell.Ide.Engine.Plugin.GhcMod
3839

3940
-- ---------------------------------------------------------------------
4041

@@ -56,6 +57,7 @@ plugins includeExamples = pluginDescToIdePlugins allPlugins
5657
, pragmasDescriptor "pragmas"
5758
, floskellDescriptor "floskell"
5859
, genericDescriptor "generic"
60+
, ghcmodDescriptor "ghcmod"
5961
]
6062
examplePlugins =
6163
[example2Descriptor "eg2"

‎haskell-ide-engine.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,7 @@ library
3737
Haskell.Ide.Engine.Plugin.Package.Compat
3838
Haskell.Ide.Engine.Plugin.Pragmas
3939
Haskell.Ide.Engine.Plugin.Generic
40+
Haskell.Ide.Engine.Plugin.GhcMod
4041
Haskell.Ide.Engine.Scheduler
4142
Haskell.Ide.Engine.Support.FromHaRe
4243
Haskell.Ide.Engine.Support.Hoogle
@@ -180,6 +181,7 @@ test-suite unit-test
180181
DiffSpec
181182
ExtensibleStateSpec
182183
GenericPluginSpec
184+
GhcModPluginSpec
183185
-- HaRePluginSpec
184186
HooglePluginSpec
185187
JsonSpec

‎src/Haskell/Ide/Engine/Plugin/GhcMod.hs

Lines changed: 95 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,95 @@
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE DeriveGeneric #-}
3+
{-# LANGUAGE FlexibleContexts #-}
4+
{-# LANGUAGE OverloadedStrings #-}
5+
{-# LANGUAGE ScopedTypeVariables #-}
6+
{-# LANGUAGE TupleSections #-}
7+
{-# LANGUAGE TypeFamilies #-}
8+
module Haskell.Ide.Engine.Plugin.GhcMod
9+
(
10+
ghcmodDescriptor
11+
12+
-- * For tests
13+
-- , Bindings(..)
14+
-- , FunctionSig(..)
15+
-- , TypeDef(..)
16+
-- , TypeParams(..)
17+
-- , TypedHoles(..) -- only to keep the GHC 8.4 and below unused field warning happy
18+
-- , ValidSubstitutions(..)
19+
-- , extractHoleSubstitutions
20+
-- , extractMissingSignature
21+
-- , extractRenamableTerms
22+
-- , extractUnusedTerm
23+
-- , newTypeCmd
24+
-- , symbolProvider
25+
, splitCaseCmd
26+
) where
27+
28+
import Data.Aeson
29+
import Data.Monoid ((<>))
30+
import GHC.Generics
31+
import qualified Haskell.Ide.Engine.Ghc as HIE
32+
import Haskell.Ide.Engine.MonadTypes
33+
import qualified Haskell.Ide.Engine.Plugin.Generic as PG
34+
import qualified Haskell.Ide.Engine.Support.HieExtras as Hie
35+
36+
-- ---------------------------------------------------------------------
37+
38+
ghcmodDescriptor :: PluginId -> PluginDescriptor
39+
ghcmodDescriptor plId = PluginDescriptor
40+
{ pluginId = plId
41+
, pluginName = "ghc-mod"
42+
, pluginDesc = "ghc-mod is a backend program to enrich Haskell programming "
43+
<> "in editors. It strives to offer most of the features one has come to expect "
44+
<> "from modern IDEs in any editor."
45+
, pluginCommands =
46+
[
47+
-- This one is used in the dispatcher tests, and is a wrapper around what we are already using anyway
48+
PluginCommand "check" "check a file for GHC warnings and errors" checkCmd
49+
50+
-- PluginCommand "info" "Look up an identifier in the context of FILE (like ghci's `:info')" infoCmd
51+
, PluginCommand "type" "Get the type of the expression under (LINE,COL)" PG.typeCmd
52+
53+
-- This one is registered in the vscode plugin, for some reason
54+
, PluginCommand "casesplit" "Generate a pattern match for a binding under (LINE,COL)" splitCaseCmd
55+
]
56+
, pluginCodeActionProvider = Nothing
57+
, pluginDiagnosticProvider = Nothing
58+
, pluginHoverProvider = Nothing
59+
, pluginSymbolProvider = Nothing
60+
, pluginFormattingProvider = Nothing
61+
}
62+
63+
-- ---------------------------------------------------------------------
64+
65+
-- checkCmd :: CommandFunc Uri (Diagnostics, AdditionalErrs)
66+
-- checkCmd = CmdSync setTypecheckedModule
67+
68+
checkCmd :: Uri -> IdeGhcM (IdeResult (HIE.Diagnostics, HIE.AdditionalErrs))
69+
checkCmd = HIE.setTypecheckedModule
70+
71+
-- ---------------------------------------------------------------------
72+
73+
splitCaseCmd :: Hie.HarePoint -> IdeGhcM (IdeResult WorkspaceEdit)
74+
splitCaseCmd (Hie.HP _uri _pos)
75+
= return (IdeResultFail (IdeError PluginError "splitCaseCmd not implemented" Null))
76+
77+
-- ---------------------------------------------------------------------
78+
79+
customOptions :: Options
80+
customOptions = defaultOptions { fieldLabelModifier = camelTo2 '_' . drop 2}
81+
82+
-- ---------------------------------------------------------------------
83+
84+
data TypeParams =
85+
TP { tpIncludeConstraints :: Bool
86+
, tpFile :: Uri
87+
, tpPos :: Position
88+
} deriving (Eq,Show,Generic)
89+
90+
instance FromJSON TypeParams where
91+
parseJSON = genericParseJSON customOptions
92+
instance ToJSON TypeParams where
93+
toJSON = genericToJSON customOptions
94+
95+
-- -- ---------------------------------------------------------------------

‎test/unit/GhcModPluginSpec.hs

Lines changed: 93 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,93 @@
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
module GhcModPluginSpec where
4+
5+
import qualified Data.Map as Map
6+
import qualified Data.Set as S
7+
import qualified Data.Text as T
8+
import Haskell.Ide.Engine.Ghc
9+
import Haskell.Ide.Engine.MonadTypes
10+
import Haskell.Ide.Engine.Plugin.Generic
11+
import Haskell.Ide.Engine.Plugin.GhcMod
12+
import Haskell.Ide.Engine.PluginUtils
13+
import Language.Haskell.LSP.Types ( toNormalizedUri )
14+
import System.Directory
15+
import TestUtils
16+
17+
import Test.Hspec
18+
19+
-- ---------------------------------------------------------------------
20+
21+
main :: IO ()
22+
main = hspec spec
23+
24+
spec :: Spec
25+
spec = do
26+
describe "ghc-mod plugin" ghcmodSpec
27+
28+
-- ---------------------------------------------------------------------
29+
30+
testPlugins :: IdePlugins
31+
testPlugins = pluginDescToIdePlugins [ghcmodDescriptor "ghcmod"]
32+
33+
-- ---------------------------------------------------------------------
34+
35+
ghcmodSpec :: Spec
36+
ghcmodSpec =
37+
describe "ghc-mod plugin commands(old plugin api)" $ do
38+
it "runs the check command" $ withCurrentDirectory "./test/testdata" $ do
39+
fp <- makeAbsolute "./FileWithWarning.hs"
40+
let act = setTypecheckedModule arg
41+
arg = filePathToUri fp
42+
IdeResultOk (_,env) <- runSingle testPlugins act
43+
case env of
44+
[] -> return ()
45+
[s] -> T.unpack s `shouldStartWith` "Loaded package environment from"
46+
ss -> fail $ "got:" ++ show ss
47+
let
48+
res = IdeResultOk $
49+
(Diagnostics (Map.singleton (toNormalizedUri arg) (S.singleton diag)), env)
50+
diag = Diagnostic (Range (toPos (4,7))
51+
(toPos (4,8)))
52+
(Just DsError)
53+
Nothing
54+
(Just "bios")
55+
"Variable not in scope: x"
56+
Nothing
57+
58+
testCommand testPlugins act "ghcmod" "check" arg res
59+
60+
61+
-- ----------------------------------------------------------------------------
62+
63+
it "runs the type command, find type" $ withCurrentDirectory "./test/testdata" $ do
64+
fp <- makeAbsolute "HaReRename.hs"
65+
let uri = filePathToUri fp
66+
act = do
67+
_ <- setTypecheckedModule uri
68+
liftToGhc $ newTypeCmd (toPos (5,9)) uri
69+
arg = TP False uri (toPos (5,9))
70+
res = IdeResultOk
71+
[ (Range (toPos (5,9)) (toPos (5,10)), "Int")
72+
, (Range (toPos (5,1)) (toPos (5,14)), "Int -> Int")
73+
]
74+
75+
testCommand testPlugins act "ghcmod" "type" arg res
76+
77+
78+
-- ----------------------------------------------------------------------------
79+
80+
-- it "runs the casesplit command" $ withCurrentDirectory "./test/testdata" $ do
81+
-- fp <- makeAbsolute "GhcModCaseSplit.hs"
82+
-- let uri = filePathToUri fp
83+
-- act = do
84+
-- _ <- setTypecheckedModule uri
85+
-- -- splitCaseCmd' uri (toPos (5,5))
86+
-- splitCaseCmd uri (toPos (5,5))
87+
-- arg = HP uri (toPos (5,5))
88+
-- res = IdeResultOk $ WorkspaceEdit
89+
-- (Just $ H.singleton uri
90+
-- $ List [TextEdit (Range (Position 4 0) (Position 4 10))
91+
-- "foo Nothing = ()\nfoo (Just x) = ()"])
92+
-- Nothing
93+
-- testCommand testPlugins act "ghcmod" "casesplit" arg res

0 commit comments

Comments
 (0)