Skip to content
This repository was archived by the owner on Jan 2, 2021. It is now read-only.

Commit aa70637

Browse files
pepeiborrapepeiborra
committed
Invert the dependency with hls-plugin-api
1 parent 6de5acd commit aa70637

File tree

10 files changed

+753
-36
lines changed

10 files changed

+753
-36
lines changed

‎ghcide.cabal

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,8 @@ library
5555
haskell-lsp-types == 0.22.*,
5656
haskell-lsp == 0.22.*,
5757
hie-compat,
58+
hls-plugin-api,
59+
lens,
5860
mtl,
5961
network-uri,
6062
parallel,
@@ -126,7 +128,6 @@ library
126128
include
127129
exposed-modules:
128130
Development.IDE
129-
Development.IDE.Compat
130131
Development.IDE.Core.Debouncer
131132
Development.IDE.Core.FileStore
132133
Development.IDE.Core.IdeConfiguration
@@ -161,6 +162,7 @@ library
161162
Development.IDE.Plugin
162163
Development.IDE.Plugin.Completions
163164
Development.IDE.Plugin.CodeAction
165+
Development.IDE.Plugin.HLS
164166
Development.IDE.Plugin.Test
165167

166168
-- Unfortunately, we cannot use loadSession with ghc-lib since hie-bios uses

‎src/Development/IDE.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ module Development.IDE
99
import Development.IDE.Core.RuleTypes as X
1010
import Development.IDE.Core.Rules as X
1111
(getAtPoint
12+
,getClientConfigAction
1213
,getDefinition
1314
,getParsedModule
1415
,getTypeDefinition

‎src/Development/IDE/Compat.hs

Lines changed: 0 additions & 19 deletions
This file was deleted.

‎src/Development/IDE/Core/IdeConfiguration.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -88,4 +88,4 @@ isWorkspaceFile file =
8888
workspaceFolders
8989

9090
getClientSettings :: Action (Maybe Value)
91-
getClientSettings = unhashed . clientSettings <$> getIdeConfiguration
91+
getClientSettings = unhashed . clientSettings <$> getIdeConfiguration

‎src/Development/IDE/Core/Rules.hs

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,11 +27,14 @@ module Development.IDE.Core.Rules(
2727
highlightAtPoint,
2828
getDependencies,
2929
getParsedModule,
30+
getClientConfigAction,
3031
) where
3132

3233
import Fingerprint
3334

35+
import Data.Aeson (fromJSON, Result(Success), FromJSON)
3436
import Data.Binary hiding (get, put)
37+
import Data.Default
3538
import Data.Tuple.Extra
3639
import Control.Monad.Extra
3740
import Control.Monad.Trans.Class
@@ -886,6 +889,15 @@ getClientSettingsRule = defineEarlyCutOffNoFile $ \GetClientSettings -> do
886889
settings <- clientSettings <$> getIdeConfiguration
887890
return (BS.pack . show . hash $ settings, settings)
888891

892+
-- | Returns the client configurarion stored in the IdeState.
893+
-- You can use this function to access it from shake Rules
894+
getClientConfigAction :: (Default a, FromJSON a) => Action a
895+
getClientConfigAction = do
896+
mbVal <- unhashed <$> useNoFile_ GetClientSettings
897+
case fromJSON <$> mbVal of
898+
Just (Success c) -> return c
899+
_ -> return def
900+
889901
-- | For now we always use bytecode
890902
getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType)
891903
getLinkableType f = do

‎src/Development/IDE/Plugin.hs

Lines changed: 10 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,17 @@
1-
2-
module Development.IDE.Plugin(Plugin(..), codeActionPlugin, codeActionPluginWithRules,makeLspCommandId,getPid) where
1+
module Development.IDE.Plugin
2+
( Plugin(..)
3+
, codeActionPlugin
4+
, codeActionPluginWithRules
5+
, makeLspCommandId
6+
) where
37

48
import Data.Default
59
import qualified Data.Text as T
610
import Development.Shake
711
import Development.IDE.LSP.Server
8-
9-
import Language.Haskell.LSP.Types
10-
import Development.IDE.Compat
1112
import Development.IDE.Core.Rules
13+
import Ide.Types as Ide
14+
import Language.Haskell.LSP.Types
1215
import qualified Language.Haskell.LSP.Core as LSP
1316
import Language.Haskell.LSP.Messages
1417

@@ -50,11 +53,5 @@ codeActionPluginWithRules rr f = Plugin rr $ PartialHandlers $ \WithMessage{..}
5053
-- on that.
5154
makeLspCommandId :: T.Text -> IO T.Text
5255
makeLspCommandId command = do
53-
pid <- getPid
54-
return $ pid <> ":ghcide:" <> command
55-
56-
-- | Get the operating system process id for the running server
57-
-- instance. This should be the same for the lifetime of the instance,
58-
-- and different from that of any other currently running instance.
59-
getPid :: IO T.Text
60-
getPid = T.pack . show <$> getProcessID
56+
pid <- getProcessID
57+
return $ T.pack (show pid) <> ":ghcide:" <> command

‎src/Development/IDE/Plugin/CodeAction.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -648,7 +648,7 @@ suggestExtendImport exportsMap contents Diagnostic{_range=_range,..}
648648
| Just (binding, mod_srcspan) <-
649649
matchRegExMultipleImports _message
650650
, Just c <- contents
651-
= mod_srcspan >>= (\(x, y) -> suggestions c binding x y)
651+
= mod_srcspan >>= (\(x, y) -> suggestions c binding x y)
652652
| otherwise = []
653653
where
654654
suggestions c binding mod srcspan
@@ -664,7 +664,7 @@ suggestExtendImport exportsMap contents Diagnostic{_range=_range,..}
664664
renderImport IdentInfo {parent, rendered}
665665
| Just p <- parent = p <> "(" <> rendered <> ")"
666666
| otherwise = rendered
667-
lookupExportMap binding mod
667+
lookupExportMap binding mod
668668
| Just match <- Map.lookup binding (getExportsMap exportsMap)
669669
, [(ident, _)] <- filter (\(_,m) -> mod == m) (Set.toList match)
670670
= Just ident

‎src/Development/IDE/Plugin/Formatter.hs

Lines changed: 98 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,98 @@
1+
{-# LANGUAGE RecordWildCards #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE ScopedTypeVariables #-}
4+
{-# LANGUAGE TypeApplications #-}
5+
{-# LANGUAGE ViewPatterns #-}
6+
7+
module Development.IDE.Plugin.Formatter
8+
(
9+
formatting
10+
, rangeFormatting
11+
, extractRange
12+
, fullRange
13+
)
14+
where
15+
16+
import qualified Data.Map as Map
17+
import qualified Data.Text as T
18+
import Development.IDE
19+
import Ide.Types
20+
import Ide.Plugin.Config
21+
import qualified Language.Haskell.LSP.Core as LSP
22+
import Language.Haskell.LSP.Types
23+
import Text.Regex.TDFA.Text()
24+
25+
-- ---------------------------------------------------------------------
26+
27+
formatting :: Map.Map PluginId (FormattingProvider IdeState IO)
28+
-> LSP.LspFuncs Config -> IdeState -> DocumentFormattingParams
29+
-> IO (Either ResponseError (List TextEdit))
30+
formatting providers lf ideState
31+
(DocumentFormattingParams (TextDocumentIdentifier uri) params _mprogress)
32+
= doFormatting lf providers ideState FormatText uri params
33+
34+
-- ---------------------------------------------------------------------
35+
36+
rangeFormatting :: Map.Map PluginId (FormattingProvider IdeState IO)
37+
-> LSP.LspFuncs Config -> IdeState -> DocumentRangeFormattingParams
38+
-> IO (Either ResponseError (List TextEdit))
39+
rangeFormatting providers lf ideState
40+
(DocumentRangeFormattingParams (TextDocumentIdentifier uri) range params _mprogress)
41+
= doFormatting lf providers ideState (FormatRange range) uri params
42+
43+
-- ---------------------------------------------------------------------
44+
45+
doFormatting :: LSP.LspFuncs Config -> Map.Map PluginId (FormattingProvider IdeState IO)
46+
-> IdeState -> FormattingType -> Uri -> FormattingOptions
47+
-> IO (Either ResponseError (List TextEdit))
48+
doFormatting lf providers ideState ft uri params = do
49+
mc <- LSP.config lf
50+
let mf = maybe "none" formattingProvider mc
51+
case Map.lookup (PluginId mf) providers of
52+
Just provider ->
53+
case uriToFilePath uri of
54+
Just (toNormalizedFilePath -> fp) -> do
55+
(_, mb_contents) <- runAction "Formatter" ideState $ getFileContents fp
56+
case mb_contents of
57+
Just contents -> do
58+
logDebug (ideLogger ideState) $ T.pack $
59+
"Formatter.doFormatting: contents=" ++ show contents -- AZ
60+
provider lf ideState ft contents fp params
61+
Nothing -> return $ Left $ responseError $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri
62+
Nothing -> return $ Left $ responseError $ T.pack $ "Formatter plugin: uriToFilePath failed for: " ++ show uri
63+
Nothing -> return $ Left $ responseError $ mconcat
64+
[ "Formatter plugin: no formatter found for:["
65+
, mf
66+
, "]"
67+
, if mf == "brittany"
68+
then T.unlines
69+
[ "\nThe haskell-language-server must be compiled with the agpl flag to provide Brittany."
70+
, "Stack users add 'agpl: true' in the flags section of the 'stack.yaml' file."
71+
, "The 'haskell-language-server.cabal' file already has this flag enabled by default."
72+
, "For more information see: https://github.com/haskell/haskell-language-server/issues/269"
73+
]
74+
else ""
75+
]
76+
77+
-- ---------------------------------------------------------------------
78+
79+
extractRange :: Range -> T.Text -> T.Text
80+
extractRange (Range (Position sl _) (Position el _)) s = newS
81+
where focusLines = take (el-sl+1) $ drop sl $ T.lines s
82+
newS = T.unlines focusLines
83+
84+
-- | Gets the range that covers the entire text
85+
fullRange :: T.Text -> Range
86+
fullRange s = Range startPos endPos
87+
where startPos = Position 0 0
88+
endPos = Position lastLine 0
89+
{-
90+
In order to replace everything including newline characters,
91+
the end range should extend below the last line. From the specification:
92+
"If you want to specify a range that contains a line including
93+
the line ending character(s) then use an end position denoting
94+
the start of the next line"
95+
-}
96+
lastLine = length $ T.lines s
97+
98+
-- ---------------------------------------------------------------------

‎src/Development/IDE/Plugin/GhcIde.hs

Lines changed: 64 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,64 @@
1+
{-# LANGUAGE DuplicateRecordFields #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
module Development.Ide.Plugin.GhcIde
4+
(
5+
descriptor
6+
) where
7+
8+
import Data.Aeson
9+
import Development.IDE
10+
import Development.IDE.Plugin.Completions
11+
import Development.IDE.Plugin.CodeAction
12+
import Development.IDE.LSP.HoverDefinition
13+
import Development.IDE.LSP.Outline
14+
import Ide.Types
15+
import Language.Haskell.LSP.Types
16+
import Text.Regex.TDFA.Text()
17+
18+
-- ---------------------------------------------------------------------
19+
20+
descriptor :: PluginId -> PluginDescriptor IdeState
21+
descriptor plId = (defaultPluginDescriptor plId)
22+
{ pluginCommands = [PluginCommand (CommandId "typesignature.add") "adds a signature" commandAddSignature]
23+
, pluginCodeActionProvider = Just codeAction'
24+
, pluginCodeLensProvider = Just codeLens'
25+
, pluginHoverProvider = Just hover'
26+
, pluginSymbolsProvider = Just symbolsProvider
27+
, pluginCompletionProvider = Just getCompletionsLSP
28+
}
29+
30+
-- ---------------------------------------------------------------------
31+
32+
hover' :: HoverProvider IdeState
33+
hover' ideState params = do
34+
logInfo (ideLogger ideState) "GhcIde.hover entered (ideLogger)" -- AZ
35+
hover ideState params
36+
37+
-- ---------------------------------------------------------------------
38+
39+
commandAddSignature :: CommandFunction IdeState WorkspaceEdit
40+
commandAddSignature lf ide params
41+
= commandHandler lf ide (ExecuteCommandParams "typesignature.add" (Just (List [toJSON params])) Nothing)
42+
43+
-- ---------------------------------------------------------------------
44+
45+
codeAction' :: CodeActionProvider IdeState
46+
codeAction' lf ide _ doc range context = fmap List <$> codeAction lf ide doc range context
47+
48+
-- ---------------------------------------------------------------------
49+
50+
codeLens' :: CodeLensProvider IdeState
51+
codeLens' lf ide _ params = codeLens lf ide params
52+
53+
-- ---------------------------------------------------------------------
54+
55+
symbolsProvider :: SymbolsProvider IdeState
56+
symbolsProvider ls ide params = do
57+
ds <- moduleOutline ls ide params
58+
case ds of
59+
Right (DSDocumentSymbols (List ls)) -> return $ Right ls
60+
Right (DSSymbolInformation (List _si)) ->
61+
return $ Left $ responseError "GhcIde.symbolsProvider: DSSymbolInformation deprecated"
62+
Left err -> return $ Left err
63+
64+
-- ---------------------------------------------------------------------

0 commit comments

Comments
 (0)