Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Configurable I/O handles #1617

Merged
merged 3 commits into from
Mar 26, 2021
Merged

Configurable I/O handles #1617

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
caad5cf
Configurable I/O handles
pepeiborra Mar 24, 2021
b7581de
Merge branch 'master' into custom-handles
pepeiborra Mar 25, 2021
35a3792
Merge branch 'master' into custom-handles
pepeiborra Mar 25, 2021
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
22 changes: 5 additions & 17 deletions ghcide/src/Development/IDE/LSP/LanguageServer.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ import qualified Data.Text as T
import qualified Development.IDE.GHC.Util as Ghcide
import Development.IDE.LSP.Server
import Development.IDE.Session (runWithDb)
import GHC.IO.Handle (hDuplicate)
import Ide.Types (traceWithSpan)
import qualified Language.LSP.Server as LSP
import Language.LSP.Types
Expand All @@ -48,25 +47,14 @@ import System.IO.Unsafe (unsafeInterleaveIO)
runLanguageServer
:: forall config. (Show config)
=> LSP.Options
-> Handle -- input
-> Handle -- output
-> (FilePath -> IO FilePath) -- ^ Map root paths to the location of the hiedb for the project
-> (IdeState -> Value -> IO (Either T.Text config))
-> LSP.Handlers (ServerM config)
-> (LSP.LanguageContextEnv config -> VFSHandle -> Maybe FilePath -> HieDb -> IndexQueue -> IO IdeState)
-> IO ()
runLanguageServer options getHieDbLoc onConfigurationChange userHandlers getIdeState = do
-- Move stdout to another file descriptor and duplicate stderr
-- to stdout. This guards against stray prints from corrupting the JSON-RPC
-- message stream.
newStdout <- hDuplicate stdout
stderr `Ghcide.hDuplicateTo'` stdout
hSetBuffering stderr NoBuffering
hSetBuffering stdout NoBuffering

-- Print out a single space to assert that the above redirection works.
-- This is interleaved with the logger, hence we just print a space here in
-- order not to mess up the output too much. Verified that this breaks
-- the language server tests without the redirection.
putStr " " >> hFlush stdout
runLanguageServer options inH outH getHieDbLoc onConfigurationChange userHandlers getIdeState = do

-- These barriers are signaled when the threads reading from these chans exit.
-- This should not happen but if it does, we will make sure that the whole server
Expand Down Expand Up @@ -126,8 +114,8 @@ runLanguageServer options getHieDbLoc onConfigurationChange userHandlers getIdeS

void $ waitAnyCancel =<< traverse async
[ void $ LSP.runServerWithHandles
stdin
newStdout
inH
outH
serverDefinition
, void $ waitBarrier clientMsgBarrier
]
Expand Down
30 changes: 26 additions & 4 deletions ghcide/src/Development/IDE/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,8 @@ import Data.Maybe (catMaybes, fromMaybe,
isJust)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Development.IDE (Action, Rules)
import Development.IDE (Action, Rules,
hDuplicateTo')
import Development.IDE.Core.Debouncer (Debouncer,
newAsyncDebouncer)
import Development.IDE.Core.FileStore (makeVFSHandle)
Expand Down Expand Up @@ -54,6 +55,7 @@ import Development.IDE.Types.Options (IdeGhcSession,
import Development.IDE.Types.Shake (Key (Key))
import Development.Shake (action)
import GHC.IO.Encoding (setLocaleEncoding)
import GHC.IO.Handle (hDuplicate)
import HIE.Bios.Cradle (findCradle)
import Ide.Plugin.Config (CheckParents (NeverCheck),
Config,
Expand All @@ -68,11 +70,12 @@ import System.Exit (ExitCode (ExitFailure),
exitWith)
import System.FilePath (takeExtension,
takeFileName)
import System.IO (BufferMode (LineBuffering),
import System.IO (BufferMode (LineBuffering, NoBuffering),
Handle, hFlush,
hPutStrLn,
hSetBuffering,
hSetEncoding, stderr,
stdout, utf8)
stdin, stdout, utf8)
import System.Time.Extra (offsetTime,
showDuration)
import Text.Printf (printf)
Expand All @@ -90,6 +93,8 @@ data Arguments = Arguments
, argsDefaultHlsConfig :: Config
, argsGetHieDbLoc :: FilePath -> IO FilePath -- ^ Map project roots to the location of the hiedb for the project
, argsDebouncer :: IO (Debouncer NormalizedUri) -- ^ Debouncer used for diagnostics
, argsHandleIn :: IO Handle
, argsHandleOut :: IO Handle
}

instance Default Arguments where
Expand All @@ -106,6 +111,21 @@ instance Default Arguments where
, argsDefaultHlsConfig = def
, argsGetHieDbLoc = getHieDbLoc
, argsDebouncer = newAsyncDebouncer
, argsHandleIn = pure stdin
, argsHandleOut = do
-- Move stdout to another file descriptor and duplicate stderr
-- to stdout. This guards against stray prints from corrupting the JSON-RPC
-- message stream.
newStdout <- hDuplicate stdout
stderr `hDuplicateTo'` stdout
hSetBuffering stdout NoBuffering

-- Print out a single space to assert that the above redirection works.
-- This is interleaved with the logger, hence we just print a space here in
-- order not to mess up the output too much. Verified that this breaks
-- the language server tests without the redirection.
putStr " " >> hFlush stdout
return newStdout
}

-- | Cheap stderr logger that relies on LineBuffering
Expand All @@ -130,13 +150,15 @@ defaultMain Arguments{..} = do
rules = argsRules >> pluginRules plugins

debouncer <- argsDebouncer
inH <- argsHandleIn
outH <- argsHandleOut

case argFiles of
Nothing -> 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 argsGetHieDbLoc argsOnConfigChange (pluginHandlers plugins) $ \env vfs rootPath hiedb hieChan -> do
runLanguageServer options inH outH argsGetHieDbLoc argsOnConfigChange (pluginHandlers plugins) $ \env vfs rootPath hiedb hieChan -> do
t <- t
hPutStrLn stderr $ "Started LSP server in " ++ showDuration t

Expand Down