Skip to content

Commit

Permalink
rebase fixes
Browse files Browse the repository at this point in the history
  • Loading branch information
wz1000 committed Feb 12, 2021
1 parent c608a0f commit da71cd7
Show file tree
Hide file tree
Showing 6 changed files with 23 additions and 74 deletions.
1 change: 0 additions & 1 deletion ghcide/ghcide.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -166,7 +166,6 @@ library
Development.IDE.LSP.HoverDefinition
Development.IDE.LSP.LanguageServer
Development.IDE.LSP.Outline
Development.IDE.LSP.Protocol
Development.IDE.LSP.Server
Development.IDE.Spans.Common
Development.IDE.Spans.Documentation
Expand Down
11 changes: 7 additions & 4 deletions ghcide/src/Development/IDE/Core/Shake.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1036,7 +1036,7 @@ updateFileDiagnostics :: MonadIO m
-> ShakeExtras
-> [(ShowDiagnostic,Diagnostic)] -- ^ current results
-> m ()
updateFileDiagnostics fp k ShakeExtras{diagnostics, hiddenDiagnostics, publishedDiagnostics, state, debouncer, lspEnv} current = liftIO $ do
updateFileDiagnostics fp k ShakeExtras{logger, diagnostics, hiddenDiagnostics, publishedDiagnostics, state, debouncer, lspEnv} current = liftIO $ do
modTime <- (currentValue . fst =<<) <$> getValues state GetModificationTime fp
let (currentShown, currentHidden) = partition ((== ShowDiag) . fst) current
uri = filePathToUri' fp
Expand All @@ -1057,9 +1057,12 @@ updateFileDiagnostics fp k ShakeExtras{diagnostics, hiddenDiagnostics, published
registerEvent debouncer delay uri $ do
mask_ $ modifyVar_ publishedDiagnostics $ \published -> do
let lastPublish = HMap.lookupDefault [] uri published
when (lastPublish /= newDiags) $ mRunLspT lspEnv $
LSP.sendNotification LSP.STextDocumentPublishDiagnostics $
LSP.PublishDiagnosticsParams (fromNormalizedUri uri) ver (List newDiags)
when (lastPublish /= newDiags) $ case lspEnv of
Nothing -> -- Print an LSP event.
logInfo logger $ showDiagnosticsColored $ map (fp,ShowDiag,) newDiags
Just env -> LSP.runLspT env $
LSP.sendNotification LSP.STextDocumentPublishDiagnostics $
LSP.PublishDiagnosticsParams (fromNormalizedUri uri) ver (List newDiags)
pure $! HMap.insert uri newDiags published

newtype Priority = Priority Double
Expand Down
23 changes: 0 additions & 23 deletions ghcide/src/Development/IDE/LSP/Protocol.hs

This file was deleted.

56 changes: 14 additions & 42 deletions ghcide/src/Development/IDE/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,6 @@ import Control.Exception.Safe (
Exception (displayException),
catchAny,
)
import Control.Lens ((^.))
import Control.Monad.Extra (concatMapM, unless, when)
import qualified Data.Aeson as J
import Data.Default (Default (def))
Expand Down Expand Up @@ -47,18 +46,13 @@ import Development.IDE.Core.Shake (
)
import Development.IDE.Core.Tracing (measureMemory)
import Development.IDE.LSP.LanguageServer (runLanguageServer)
import Development.IDE.LSP.Protocol
import Development.IDE.Plugin (
Plugin (pluginHandler, pluginRules),
Plugin (pluginHandlers, pluginRules),
)
import Development.IDE.Plugin.HLS (asGhcIdePlugin)
import Development.IDE.Session (SessionLoadingOptions, defaultLoadingOptions, loadSessionWithOptions, setInitialDynFlags)
import Development.IDE.Types.Diagnostics (
ShowDiagnostic (ShowDiag),
showDiagnosticsColored,
)
import Development.IDE.Types.Location (toNormalizedFilePath')
import Development.IDE.Types.Logger (Logger, logInfo)
import Development.IDE.Types.Logger (Logger)
import Development.IDE.Types.Options (
IdeGhcSession,
IdeOptions (optCheckParents, optCheckProject, optReportProgress),
Expand All @@ -71,14 +65,7 @@ import HIE.Bios.Cradle (findCradle)
import Ide.Plugin.Config (CheckParents (NeverCheck), Config)
import Ide.PluginUtils (allLspCmdIds', getProcessID, pluginDescToIdePlugins)
import Ide.Types (IdePlugins)
import qualified Language.Haskell.LSP.Core as LSP
import Language.Haskell.LSP.Messages (FromServerMessage)
import Language.Haskell.LSP.Types (
DidChangeConfigurationNotification,
InitializeRequest,
LspId (IdInt),
)
import Language.Haskell.LSP.Types.Lens (initializationOptions, params)
import qualified Language.LSP.Server as LSP
import qualified System.Directory.Extra as IO
import System.Exit (ExitCode (ExitFailure), exitWith)
import System.FilePath (takeExtension, takeFileName)
Expand All @@ -99,8 +86,7 @@ data Arguments = Arguments
, argsSessionLoadingOptions :: SessionLoadingOptions
, argsIdeOptions :: Maybe Config -> Action IdeGhcSession -> IdeOptions
, argsLspOptions :: LSP.Options
, argsGetInitialConfig :: InitializeRequest -> Either T.Text Config
, argsOnConfigChange :: DidChangeConfigurationNotification -> Either T.Text Config
, argsOnConfigChange :: IdeState -> J.Value -> IO (Either T.Text Config)
}

defArguments :: HieDb -> IndexQueue -> Arguments
Expand All @@ -117,12 +103,9 @@ defArguments hiedb hiechan =
, argsSessionLoadingOptions = defaultLoadingOptions
, argsIdeOptions = const defaultIdeOptions
, argsLspOptions = def {LSP.completionTriggerCharacters = Just "."}
, argsOnConfigChange = const $ Left "Updating Not supported"
, argsGetInitialConfig = \x -> case x ^. params . initializationOptions of
Nothing -> Right def
Just v -> case J.fromJSON v of
J.Error err -> Left $ T.pack err
J.Success a -> Right a
, argsOnConfigChange = \_ide v -> pure $ case J.fromJSON v of
J.Error err -> Left $ T.pack err
J.Success a -> Right a
}

defaultMain :: Arguments -> IO ()
Expand All @@ -140,7 +123,7 @@ defaultMain Arguments{..} = do
t <- offsetTime
hPutStrLn stderr "Starting LSP server..."
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
runLanguageServer options (pluginHandler plugins) argsGetInitialConfig argsOnConfigChange $ \getLspId event vfs caps wProg wIndefProg getConfig rootPath -> do
runLanguageServer options argsOnConfigChange (pluginHandlers plugins) $ \env vfs rootPath -> do
t <- t
hPutStrLn stderr $ "Started LSP server in " ++ showDuration t

Expand All @@ -153,19 +136,16 @@ defaultMain Arguments{..} = do
`catchAny` (\e -> (hPutStrLn stderr $ "setInitialDynFlags: " ++ displayException e) >> pure Nothing)

sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions $ fromMaybe dir rootPath
config <- getConfig
config <- LSP.runLspT env LSP.getConfig
let options = (argsIdeOptions config sessionLoader)
{ optReportProgress = clientSupportsProgress caps
}
rules = argsRules >> pluginRules plugins
caps = LSP.resClientCapabilities env
debouncer <- newAsyncDebouncer
initialise
caps
rules
getLspId
event
wProg
wIndefProg
(Just env)
argsLogger
debouncer
options
Expand Down Expand Up @@ -195,13 +175,12 @@ defaultMain Arguments{..} = do
putStrLn "\nStep 3/4: Initializing the IDE"
vfs <- makeVFSHandle
debouncer <- newAsyncDebouncer
let dummyWithProg _ _ f = f (const (pure ()))
sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions dir
let options = (argsIdeOptions Nothing sessionLoader)
{ optCheckParents = NeverCheck
, optCheckProject = False
{ optCheckParents = pure NeverCheck
, optCheckProject = pure False
}
ide <- initialise def mainRule (pure $ IdInt 0) (showEvent argsLogger) dummyWithProg (const (const id)) argsLogger debouncer options vfs argsHiedb argsHieChan
ide <- initialise mainRule Nothing argsLogger debouncer options vfs argsHiedb argsHieChan

putStrLn "\nStep 4/4: Type checking the files"
setFilesOfInterest ide $ HashMap.fromList $ map ((,OnDisk) . toNormalizedFilePath') files
Expand Down Expand Up @@ -246,10 +225,3 @@ expandFiles = concatMapM $ \x -> do
when (null files) $
fail $ "Couldn't find any .hs/.lhs files inside directory: " ++ x
return files

-- | Print an LSP event.
showEvent :: Logger -> FromServerMessage -> IO ()
showEvent _ (EventFileDiagnostics _ []) = return ()
showEvent argsLogger (EventFileDiagnostics (toNormalizedFilePath' -> file) diags) =
logInfo argsLogger $ showDiagnosticsColored $ map (file,ShowDiag,) diags
showEvent argsLogger e = logInfo argsLogger $ T.pack $ show e
1 change: 0 additions & 1 deletion plugins/hls-eval-plugin/test/Eval.hs
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,6 @@ import Test.Tasty.HUnit (
(@?=),
)
import Data.List.Extra (nubOrdOn)
import Development.IDE (List(List))
import Ide.Plugin.Eval.Types (EvalParams(..))
import Data.Aeson (fromJSON)
import Data.Aeson.Types (Result(Success))
Expand Down
5 changes: 2 additions & 3 deletions src/Ide/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@ import qualified Data.Text as T
import Development.IDE.Core.Rules
import Development.IDE.Session (setInitialDynFlags, getHieDbLoc, runWithDb)
import Development.IDE.Types.Logger as G
import qualified Language.Haskell.LSP.Core as LSP
import qualified Language.LSP.Server as LSP
import Ide.Arguments
import Ide.Logger
import Ide.Version
Expand All @@ -31,7 +31,7 @@ import HieDb.Run
import qualified Development.IDE.Main as Main
import qualified Development.IDE.Types.Options as Ghcide
import Development.Shake (ShakeOptions(shakeThreads))
import Ide.Plugin.Config (getInitialConfig, getConfigFromNotification)
import Ide.Plugin.Config (getConfigFromNotification)

defaultMain :: Arguments -> IdePlugins IdeState -> IO ()
defaultMain args idePlugins = do
Expand Down Expand Up @@ -100,7 +100,6 @@ runLspMode lspArgs@LspArguments{..} idePlugins = do
{ Main.argFiles = if argLSP then Nothing else Just []
, Main.argsHlsPlugins = idePlugins
, Main.argsLogger = hlsLogger
, Main.argsGetInitialConfig = getInitialConfig
, Main.argsOnConfigChange = getConfigFromNotification
, Main.argsIdeOptions = \_config sessionLoader ->
let defOptions = Ghcide.defaultIdeOptions sessionLoader
Expand Down

0 comments on commit da71cd7

Please sign in to comment.