111 lines
4.9 KiB
Haskell
111 lines
4.9 KiB
Haskell
|
|
{-| This is the entry point for the LSP server. All calls are delegated to the haskell-lsp library
|
|
which does the heavy lifting.
|
|
-}
|
|
module LSP.Server(run) where
|
|
|
|
import Control.Concurrent(forkIO)
|
|
import Control.Concurrent.STM.TChan
|
|
import qualified GHC.IO.Exception
|
|
import qualified Control.Exception
|
|
import Data.Default
|
|
import Language.Haskell.LSP.Messages
|
|
import qualified Language.Haskell.LSP.Control as LSP.Control
|
|
import qualified Language.Haskell.LSP.Core as LSP.Core
|
|
import qualified Language.Haskell.LSP.Utility as LSP.Utility
|
|
|
|
import qualified Data.Aeson as J
|
|
import qualified Language.Haskell.LSP.Types as J
|
|
import qualified Language.Haskell.LSP.Types.Lens as J
|
|
|
|
import qualified System.Log.Logger
|
|
|
|
import LSP.Dispatcher(dispatcher)
|
|
|
|
run :: Maybe String -> IO () -> IO Int
|
|
run maybeLog dispatcherProc = flip Control.Exception.catches handlers $ do
|
|
|
|
rin <- atomically newTChan :: IO (TChan FromClientMessage)
|
|
|
|
let
|
|
dp lf = do
|
|
_rpid <- forkIO $ dispatcher lf rin
|
|
dispatcherProc
|
|
pure Nothing
|
|
|
|
flip Control.Exception.finally finalProc $ do
|
|
setupLogger maybeLog
|
|
LSP.Control.run (pure (Right ()), dp) (lspHandlers rin) lspOptions Nothing
|
|
-- TODO: CTRL.run takes logger as the last option, and should write LSP log into it
|
|
-- TODO: 1. make upstream logger write in the format which lsp-inspector can read
|
|
-- TODO: 2. it would be cool, if we start writing log on file creation, e.g.
|
|
-- TODO: e.g. "touch file /var/log/dhall-lsp-server/log-2018-03-12-12-45-34-fe5dk3.log to enable LSP logging"
|
|
|
|
where
|
|
handlers = [ Control.Exception.Handler ioExcept
|
|
, Control.Exception.Handler someExcept
|
|
]
|
|
finalProc = System.Log.Logger.removeAllHandlers
|
|
ioExcept (e :: Control.Exception.IOException) = error $ show $ e -- print e >> pure 1
|
|
someExcept (e :: Control.Exception.SomeException) = error $ show $ e -- print e >> pure 1
|
|
|
|
-- ---------------------------------------------------------------------
|
|
|
|
|
|
-- | sets the output logger.
|
|
-- | if no filename is provided then logger is disabled, if input is string `[OUTPUT]` then log goes to stderr,
|
|
-- | which then redirects inside VSCode to the output pane of the plugin.
|
|
setupLogger :: Maybe FilePath -> IO () -- TODO: ADD verbosity
|
|
setupLogger Nothing = pure ()
|
|
setupLogger (Just "[OUTPUT]") = LSP.Core.setupLogger Nothing [] System.Log.Logger.DEBUG
|
|
setupLogger file = LSP.Core.setupLogger file [] System.Log.Logger.DEBUG
|
|
|
|
|
|
|
|
syncOptions :: J.TextDocumentSyncOptions
|
|
syncOptions = J.TextDocumentSyncOptions
|
|
{ J._openClose = Just True
|
|
, J._change = Just J.TdSyncNone--J.TdSyncIncremental
|
|
, J._willSave = Just False
|
|
, J._willSaveWaitUntil = Just False
|
|
, J._save = Just $ J.SaveOptions $ Just False
|
|
}
|
|
|
|
-- Capabilities entry point
|
|
lspOptions :: LSP.Core.Options
|
|
lspOptions = def { LSP.Core.textDocumentSync = Just syncOptions
|
|
-- , Core.executeCommandProvider = Just (J.ExecuteCommandOptions (J.List ["lsp-hello-command"]))
|
|
-- , Core.codeLensProvider = Just (J.CodeLensOptions (Just False))
|
|
}
|
|
|
|
lspHandlers :: TChan FromClientMessage -> LSP.Core.Handlers
|
|
lspHandlers rin
|
|
= def { LSP.Core.initializedHandler = Just $ passHandler rin NotInitialized
|
|
-- , Core.renameHandler = Just $ passHandler rin ReqRename
|
|
-- , Core.hoverHandler = Just $ passHandler rin ReqHover
|
|
, LSP.Core.didOpenTextDocumentNotificationHandler = Just $ passHandler rin NotDidOpenTextDocument
|
|
, LSP.Core.didSaveTextDocumentNotificationHandler = Just $ passHandler rin NotDidSaveTextDocument
|
|
, LSP.Core.didChangeTextDocumentNotificationHandler = Just $ passHandler rin NotDidChangeTextDocument
|
|
, LSP.Core.didCloseTextDocumentNotificationHandler = Just $ passHandler rin NotDidCloseTextDocument
|
|
, LSP.Core.cancelNotificationHandler = Just $ passHandler rin NotCancelRequestFromClient
|
|
, LSP.Core.responseHandler = Just $ responseHandlerCb rin
|
|
-- , Core.codeActionHandler = Just $ passHandler rin ReqCodeAction
|
|
, LSP.Core.executeCommandHandler = Just $ passHandler rin ReqExecuteCommand
|
|
}
|
|
|
|
-- ---------------------------------------------------------------------
|
|
|
|
passHandler :: TChan FromClientMessage -> (a -> FromClientMessage) -> LSP.Core.Handler a
|
|
passHandler rin convert notification =
|
|
atomically $ writeTChan rin (convert notification)
|
|
|
|
-- ---------------------------------------------------------------------
|
|
|
|
responseHandlerCb :: TChan FromClientMessage -> LSP.Core.Handler J.BareResponseMessage
|
|
responseHandlerCb _rin resp =
|
|
LSP.Utility.logs $ ">>> got ignoring ResponseMessage:" ++ show resp
|
|
|
|
-- ---------------------------------------------------------------------
|
|
|
|
|