src/Language/Haskell/LSP/Test/Session.hs

   1 module Language.Haskell.LSP.Test.Session where
   2
   3 import Control.Concurrent
   4 import Control.Monad
   5 import Control.Monad.Trans.Class
   6 import Control.Monad.Trans.Reader
   7 import Control.Monad.Trans.State
   8 import Data.Conduit
   9 import Data.Conduit.Parser
  10 import Language.Haskell.LSP.Messages
  11 import Language.Haskell.LSP.Types
  12 import Language.Haskell.LSP.VFS
  13 import Language.Haskell.LSP.Test.Compat
  14 import Language.Haskell.LSP.Test.Decoding
  15 import System.Directory
  16 import System.IO
  17
  18 data SessionContext = SessionContext
  19   {
  20     serverIn :: Handle
  21   , rootDir :: FilePath
  22   , messageChan :: Chan FromServerMessage
  23   , requestMap :: MVar RequestMap
  24   , initRsp :: MVar InitializeResponse
  25   }
  26
  27 data SessionState = SessionState
  28   {
  29     curReqId :: LspId
  30   , vfs :: VFS
  31   }
  32
  33 type ParserStateReader a s r m = ConduitParser a (StateT s (ReaderT r m))
  34
  35 -- | A session representing one instance of launching and connecting to a server.
  36 --
  37 -- You can send and receive messages to the server within 'Session' via 'getMessage',
  38 -- 'sendRequest' and 'sendNotification'.
  39 --
  40 -- @
  41 -- runSession \"path\/to\/root\/dir\" $ do
  42 --   docItem <- getDocItem "Desktop/simple.hs" "haskell"
  43 --   sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams docItem)
  44 --   diagnostics <- getMessage :: Session PublishDiagnosticsNotification
  45 -- @
  46 type Session = ParserStateReader FromServerMessage SessionState SessionContext IO
  47
  48
  49 runSession' :: Chan FromServerMessage -> SessionContext -> SessionState -> Session a -> IO (a, SessionState)
  50 runSession' chan context state session = runReaderT (runStateT conduit state) context
  51   where conduit = runConduit $ chanSource chan .| runConduitParser session
  52
  53 get :: Monad m => ParserStateReader a s r m s
  54 get = lift Control.Monad.Trans.State.get
  55
  56 put :: Monad m => s -> ParserStateReader a s r m ()
  57 put = lift . Control.Monad.Trans.State.put
  58
  59 modify :: Monad m => (s -> s) -> ParserStateReader a s r m ()
  60 modify = lift . Control.Monad.Trans.State.modify
  61
  62 ask :: Monad m => ParserStateReader a s r m r
  63 ask = lift $ lift Control.Monad.Trans.Reader.ask
  64
  65
  66
  67 -- | An internal version of 'runSession' that allows for a custom handler to listen to the server.
  68 -- It also does not automatically send initialize and exit messages.
  69 runSessionWithHandles :: Handle -- ^ Server in
  70                       -> Handle -- ^ Server out
  71                       -> (Handle -> Session ()) -- ^ Server listener
  72                       -> FilePath
  73                       -> Session a
  74                       -> IO a
  75 runSessionWithHandles serverIn serverOut serverHandler rootDir session = do
  76   absRootDir <- canonicalizePath rootDir
  77
  78   hSetBuffering serverIn  NoBuffering
  79   hSetBuffering serverOut NoBuffering
  80
  81   reqMap <- newMVar newRequestMap
  82   messageChan <- newChan
  83   meaninglessChan <- newChan
  84   initRsp <- newEmptyMVar
  85
  86   let context = SessionContext serverIn absRootDir messageChan reqMap initRsp
  87       initState = SessionState (IdInt 9) mempty
  88
  89   threadId <- forkIO $ void $ runSession' meaninglessChan context initState (serverHandler serverOut)
  90   (result, _) <- runSession' messageChan context initState session
  91
  92   killThread threadId
  93
  94   return result