{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Language.Haskell.LSP.Test.Session
( Session(..)
, SessionConfig(..)
, defaultConfig
, SessionMessage(..)
, SessionContext(..)
, SessionState(..)
, runSessionWithHandles
, get
, put
, modify
, modifyM
, ask
, asks
, sendMessage
, updateState
, withTimeout
, getCurTimeoutId
, bumpTimeoutId
, logMsg
, LogMsgType(..)
)
where
import Control.Applicative
import Control.Concurrent hiding (yield)
import Control.Exception
import Control.Lens hiding (List)
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Except
#if __GLASGOW_HASKELL__ == 806
import Control.Monad.Fail
#endif
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import qualified Control.Monad.Trans.Reader as Reader (ask)
import Control.Monad.Trans.State (StateT, runStateT)
import qualified Control.Monad.Trans.State as State
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Aeson
import Data.Aeson.Encode.Pretty
import Data.Conduit as Conduit
import Data.Conduit.Parser as Parser
import Data.Default
import Data.Foldable
import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe
import Data.Function
import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.Types.Capabilities
import Language.Haskell.LSP.Types
import Language.Haskell.LSP.Types.Lens
import qualified Language.Haskell.LSP.Types.Lens as LSP
import Language.Haskell.LSP.VFS
import Language.Haskell.LSP.Test.Compat
import Language.Haskell.LSP.Test.Decoding
import Language.Haskell.LSP.Test.Exceptions
import System.Console.ANSI
import System.Directory
import System.IO
import System.Process (ProcessHandle())
#ifndef mingw32_HOST_OS
import System.Process (waitForProcess)
#endif
import System.Timeout
newtype Session a = Session (ConduitParser FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) a)
deriving (a -> Session b -> Session a
(a -> b) -> Session a -> Session b
(forall a b. (a -> b) -> Session a -> Session b)
-> (forall a b. a -> Session b -> Session a) -> Functor Session
forall a b. a -> Session b -> Session a
forall a b. (a -> b) -> Session a -> Session b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Session b -> Session a
$c<$ :: forall a b. a -> Session b -> Session a
fmap :: (a -> b) -> Session a -> Session b
$cfmap :: forall a b. (a -> b) -> Session a -> Session b
Functor, Functor Session
a -> Session a
Functor Session
-> (forall a. a -> Session a)
-> (forall a b. Session (a -> b) -> Session a -> Session b)
-> (forall a b c.
(a -> b -> c) -> Session a -> Session b -> Session c)
-> (forall a b. Session a -> Session b -> Session b)
-> (forall a b. Session a -> Session b -> Session a)
-> Applicative Session
Session a -> Session b -> Session b
Session a -> Session b -> Session a
Session (a -> b) -> Session a -> Session b
(a -> b -> c) -> Session a -> Session b -> Session c
forall a. a -> Session a
forall a b. Session a -> Session b -> Session a
forall a b. Session a -> Session b -> Session b
forall a b. Session (a -> b) -> Session a -> Session b
forall a b c. (a -> b -> c) -> Session a -> Session b -> Session c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Session a -> Session b -> Session a
$c<* :: forall a b. Session a -> Session b -> Session a
*> :: Session a -> Session b -> Session b
$c*> :: forall a b. Session a -> Session b -> Session b
liftA2 :: (a -> b -> c) -> Session a -> Session b -> Session c
$cliftA2 :: forall a b c. (a -> b -> c) -> Session a -> Session b -> Session c
<*> :: Session (a -> b) -> Session a -> Session b
$c<*> :: forall a b. Session (a -> b) -> Session a -> Session b
pure :: a -> Session a
$cpure :: forall a. a -> Session a
$cp1Applicative :: Functor Session
Applicative, Applicative Session
a -> Session a
Applicative Session
-> (forall a b. Session a -> (a -> Session b) -> Session b)
-> (forall a b. Session a -> Session b -> Session b)
-> (forall a. a -> Session a)
-> Monad Session
Session a -> (a -> Session b) -> Session b
Session a -> Session b -> Session b
forall a. a -> Session a
forall a b. Session a -> Session b -> Session b
forall a b. Session a -> (a -> Session b) -> Session b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Session a
$creturn :: forall a. a -> Session a
>> :: Session a -> Session b -> Session b
$c>> :: forall a b. Session a -> Session b -> Session b
>>= :: Session a -> (a -> Session b) -> Session b
$c>>= :: forall a b. Session a -> (a -> Session b) -> Session b
$cp1Monad :: Applicative Session
Monad, Monad Session
Monad Session -> (forall a. IO a -> Session a) -> MonadIO Session
IO a -> Session a
forall a. IO a -> Session a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Session a
$cliftIO :: forall a. IO a -> Session a
$cp1MonadIO :: Monad Session
MonadIO, Applicative Session
Session a
Applicative Session
-> (forall a. Session a)
-> (forall a. Session a -> Session a -> Session a)
-> (forall a. Session a -> Session [a])
-> (forall a. Session a -> Session [a])
-> Alternative Session
Session a -> Session a -> Session a
Session a -> Session [a]
Session a -> Session [a]
forall a. Session a
forall a. Session a -> Session [a]
forall a. Session a -> Session a -> Session a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: Session a -> Session [a]
$cmany :: forall a. Session a -> Session [a]
some :: Session a -> Session [a]
$csome :: forall a. Session a -> Session [a]
<|> :: Session a -> Session a -> Session a
$c<|> :: forall a. Session a -> Session a -> Session a
empty :: Session a
$cempty :: forall a. Session a
$cp1Alternative :: Applicative Session
Alternative)
#if __GLASGOW_HASKELL__ >= 806
instance MonadFail Session where
fail :: String -> Session a
fail String
s = do
FromServerMessage
lastMsg <- Maybe FromServerMessage -> FromServerMessage
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe FromServerMessage -> FromServerMessage)
-> (SessionState -> Maybe FromServerMessage)
-> SessionState
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> Maybe FromServerMessage
lastReceivedMessage (SessionState -> FromServerMessage)
-> Session SessionState -> Session FromServerMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Session a) -> IO a -> Session a
forall a b. (a -> b) -> a -> b
$ SessionException -> IO a
forall a e. Exception e => e -> a
throw (String -> FromServerMessage -> SessionException
UnexpectedMessage String
s FromServerMessage
lastMsg)
#endif
data SessionConfig = SessionConfig
{ SessionConfig -> Int
messageTimeout :: Int
, SessionConfig -> Bool
logStdErr :: Bool
, SessionConfig -> Bool
logMessages :: Bool
, SessionConfig -> Bool
logColor :: Bool
, SessionConfig -> Maybe Value
lspConfig :: Maybe Value
, SessionConfig -> Bool
ignoreLogNotifications :: Bool
}
defaultConfig :: SessionConfig
defaultConfig :: SessionConfig
defaultConfig = Int -> Bool -> Bool -> Bool -> Maybe Value -> Bool -> SessionConfig
SessionConfig Int
60 Bool
False Bool
False Bool
True Maybe Value
forall a. Maybe a
Nothing Bool
False
instance Default SessionConfig where
def :: SessionConfig
def = SessionConfig
defaultConfig
data SessionMessage = ServerMessage FromServerMessage
| TimeoutMessage Int
deriving Int -> SessionMessage -> ShowS
[SessionMessage] -> ShowS
SessionMessage -> String
(Int -> SessionMessage -> ShowS)
-> (SessionMessage -> String)
-> ([SessionMessage] -> ShowS)
-> Show SessionMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SessionMessage] -> ShowS
$cshowList :: [SessionMessage] -> ShowS
show :: SessionMessage -> String
$cshow :: SessionMessage -> String
showsPrec :: Int -> SessionMessage -> ShowS
$cshowsPrec :: Int -> SessionMessage -> ShowS
Show
data SessionContext = SessionContext
{
SessionContext -> Handle
serverIn :: Handle
, SessionContext -> String
rootDir :: FilePath
, SessionContext -> Chan SessionMessage
messageChan :: Chan SessionMessage
, SessionContext -> MVar Int
curTimeoutId :: MVar Int
, SessionContext -> MVar RequestMap
requestMap :: MVar RequestMap
, SessionContext -> MVar InitializeResponse
initRsp :: MVar InitializeResponse
, SessionContext -> SessionConfig
config :: SessionConfig
, SessionContext -> ClientCapabilities
sessionCapabilities :: ClientCapabilities
}
class Monad m => HasReader r m where
ask :: m r
asks :: (r -> b) -> m b
asks r -> b
f = r -> b
f (r -> b) -> m r -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m r
forall r (m :: * -> *). HasReader r m => m r
ask
instance HasReader SessionContext Session where
ask :: Session SessionContext
ask = ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
SessionContext
-> Session SessionContext
forall a.
ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
a
-> Session a
Session (StateT SessionState (ReaderT SessionContext IO) SessionContext
-> ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
SessionContext
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT SessionState (ReaderT SessionContext IO) SessionContext
-> ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
SessionContext)
-> StateT SessionState (ReaderT SessionContext IO) SessionContext
-> ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
SessionContext
forall a b. (a -> b) -> a -> b
$ ReaderT SessionContext IO SessionContext
-> StateT SessionState (ReaderT SessionContext IO) SessionContext
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT SessionContext IO SessionContext
forall (m :: * -> *) r. Monad m => ReaderT r m r
Reader.ask)
instance Monad m => HasReader r (ConduitM a b (StateT s (ReaderT r m))) where
ask :: ConduitM a b (StateT s (ReaderT r m)) r
ask = StateT s (ReaderT r m) r -> ConduitM a b (StateT s (ReaderT r m)) r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT s (ReaderT r m) r
-> ConduitM a b (StateT s (ReaderT r m)) r)
-> StateT s (ReaderT r m) r
-> ConduitM a b (StateT s (ReaderT r m)) r
forall a b. (a -> b) -> a -> b
$ ReaderT r m r -> StateT s (ReaderT r m) r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT r m r
forall (m :: * -> *) r. Monad m => ReaderT r m r
Reader.ask
getCurTimeoutId :: (HasReader SessionContext m, MonadIO m) => m Int
getCurTimeoutId :: m Int
getCurTimeoutId = (SessionContext -> MVar Int) -> m (MVar Int)
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> MVar Int
curTimeoutId m (MVar Int) -> (MVar Int -> m Int) -> m Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> (MVar Int -> IO Int) -> MVar Int -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Int -> IO Int
forall a. MVar a -> IO a
readMVar
bumpTimeoutId :: (HasReader SessionContext m, MonadIO m) => Int -> m ()
bumpTimeoutId :: Int -> m ()
bumpTimeoutId Int
prev = do
MVar Int
v <- (SessionContext -> MVar Int) -> m (MVar Int)
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> MVar Int
curTimeoutId
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar Int -> (Int -> IO Int) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Int
v (\Int
x -> Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x (Int
prev Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)))
data SessionState = SessionState
{
SessionState -> LspId
curReqId :: LspId
, SessionState -> VFS
vfs :: VFS
, SessionState -> Map NormalizedUri [Diagnostic]
curDiagnostics :: Map.Map NormalizedUri [Diagnostic]
, SessionState -> Bool
overridingTimeout :: Bool
, SessionState -> Maybe FromServerMessage
lastReceivedMessage :: Maybe FromServerMessage
, SessionState -> Map Text Registration
curDynCaps :: Map.Map T.Text Registration
, SessionState -> Set ProgressToken
curProgressSessions :: Set.Set ProgressToken
}
class Monad m => HasState s m where
get :: m s
put :: s -> m ()
modify :: (s -> s) -> m ()
modify s -> s
f = m s
forall s (m :: * -> *). HasState s m => m s
get m s -> (s -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m ()
forall s (m :: * -> *). HasState s m => s -> m ()
put (s -> m ()) -> (s -> s) -> s -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
f
modifyM :: (HasState s m, Monad m) => (s -> m s) -> m ()
modifyM s -> m s
f = m s
forall s (m :: * -> *). HasState s m => m s
get m s -> (s -> m s) -> m s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m s
f m s -> (s -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m ()
forall s (m :: * -> *). HasState s m => s -> m ()
put
instance HasState SessionState Session where
get :: Session SessionState
get = ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
SessionState
-> Session SessionState
forall a.
ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
a
-> Session a
Session (StateT SessionState (ReaderT SessionContext IO) SessionState
-> ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
SessionState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT SessionState (ReaderT SessionContext IO) SessionState
forall (m :: * -> *) s. Monad m => StateT s m s
State.get)
put :: SessionState -> Session ()
put = ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
-> Session ()
forall a.
ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
a
-> Session a
Session (ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
-> Session ())
-> (SessionState
-> ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
())
-> SessionState
-> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT SessionState (ReaderT SessionContext IO) ()
-> ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT SessionState (ReaderT SessionContext IO) ()
-> ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
())
-> (SessionState
-> StateT SessionState (ReaderT SessionContext IO) ())
-> SessionState
-> ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> StateT SessionState (ReaderT SessionContext IO) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put
instance Monad m => HasState s (StateT s m) where
get :: StateT s m s
get = StateT s m s
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
put :: s -> StateT s m ()
put = s -> StateT s m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put
instance (Monad m, (HasState s m)) => HasState s (ConduitM a b m)
where
get :: ConduitM a b m s
get = m s -> ConduitM a b m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). HasState s m => m s
get
put :: s -> ConduitM a b m ()
put = m () -> ConduitM a b m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ConduitM a b m ())
-> (s -> m ()) -> s -> ConduitM a b m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). HasState s m => s -> m ()
put
instance (Monad m, (HasState s m)) => HasState s (ConduitParser a m)
where
get :: ConduitParser a m s
get = m s -> ConduitParser a m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). HasState s m => m s
get
put :: s -> ConduitParser a m ()
put = m () -> ConduitParser a m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ConduitParser a m ())
-> (s -> m ()) -> s -> ConduitParser a m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). HasState s m => s -> m ()
put
runSession :: SessionContext -> SessionState -> Session a -> IO (a, SessionState)
runSession :: SessionContext -> SessionState -> Session a -> IO (a, SessionState)
runSession SessionContext
context SessionState
state (Session ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
a
session) = ReaderT SessionContext IO (a, SessionState)
-> SessionContext -> IO (a, SessionState)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT SessionState (ReaderT SessionContext IO) a
-> SessionState -> ReaderT SessionContext IO (a, SessionState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT SessionState (ReaderT SessionContext IO) a
conduit SessionState
state) SessionContext
context
where
conduit :: StateT SessionState (ReaderT SessionContext IO) a
conduit = ConduitT
() Void (StateT SessionState (ReaderT SessionContext IO)) a
-> StateT SessionState (ReaderT SessionContext IO) a
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT
() Void (StateT SessionState (ReaderT SessionContext IO)) a
-> StateT SessionState (ReaderT SessionContext IO) a)
-> ConduitT
() Void (StateT SessionState (ReaderT SessionContext IO)) a
-> StateT SessionState (ReaderT SessionContext IO) a
forall a b. (a -> b) -> a -> b
$ ConduitT
()
SessionMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall i b.
ConduitT
i
SessionMessage
(StateT SessionState (ReaderT SessionContext IO))
b
chanSource ConduitT
()
SessionMessage
(StateT SessionState (ReaderT SessionContext IO))
()
-> ConduitM
SessionMessage
Void
(StateT SessionState (ReaderT SessionContext IO))
a
-> ConduitT
() Void (StateT SessionState (ReaderT SessionContext IO)) a
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
watchdog ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
-> ConduitM
FromServerMessage
Void
(StateT SessionState (ReaderT SessionContext IO))
a
-> ConduitM
SessionMessage
Void
(StateT SessionState (ReaderT SessionContext IO))
a
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM
FromServerMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
updateStateC ConduitM
FromServerMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
-> ConduitM
FromServerMessage
Void
(StateT SessionState (ReaderT SessionContext IO))
a
-> ConduitM
FromServerMessage
Void
(StateT SessionState (ReaderT SessionContext IO))
a
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
a
-> ConduitM
FromServerMessage
Void
(StateT SessionState (ReaderT SessionContext IO))
a
forall (m :: * -> *) i a.
MonadThrow m =>
ConduitParser i m a -> ConduitT i Void m a
runConduitParser (ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
a
-> (ConduitParserException
-> ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
a)
-> ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
a
session ConduitParserException
-> ConduitParser
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
a
forall (m :: * -> *) i b.
(HasState SessionState m, MonadIO m) =>
ConduitParserException -> ConduitParser i m b
handler)
handler :: ConduitParserException -> ConduitParser i m b
handler (Unexpected Text
"ConduitParser.empty") = do
FromServerMessage
lastMsg <- Maybe FromServerMessage -> FromServerMessage
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe FromServerMessage -> FromServerMessage)
-> (SessionState -> Maybe FromServerMessage)
-> SessionState
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> Maybe FromServerMessage
lastReceivedMessage (SessionState -> FromServerMessage)
-> ConduitParser i m SessionState
-> ConduitParser i m FromServerMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitParser i m SessionState
forall s (m :: * -> *). HasState s m => m s
get
Text
name <- ConduitParser i m Text
forall i (m :: * -> *). ConduitParser i m Text
getParserName
IO b -> ConduitParser i m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> ConduitParser i m b) -> IO b -> ConduitParser i m b
forall a b. (a -> b) -> a -> b
$ SessionException -> IO b
forall a e. Exception e => e -> a
throw (String -> FromServerMessage -> SessionException
UnexpectedMessage (Text -> String
T.unpack Text
name) FromServerMessage
lastMsg)
handler ConduitParserException
e = ConduitParserException -> ConduitParser i m b
forall a e. Exception e => e -> a
throw ConduitParserException
e
chanSource :: ConduitT
i
SessionMessage
(StateT SessionState (ReaderT SessionContext IO))
b
chanSource = do
SessionMessage
msg <- IO SessionMessage
-> ConduitT
i
SessionMessage
(StateT SessionState (ReaderT SessionContext IO))
SessionMessage
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SessionMessage
-> ConduitT
i
SessionMessage
(StateT SessionState (ReaderT SessionContext IO))
SessionMessage)
-> IO SessionMessage
-> ConduitT
i
SessionMessage
(StateT SessionState (ReaderT SessionContext IO))
SessionMessage
forall a b. (a -> b) -> a -> b
$ Chan SessionMessage -> IO SessionMessage
forall a. Chan a -> IO a
readChan (SessionContext -> Chan SessionMessage
messageChan SessionContext
context)
Bool
-> ConduitT
i
SessionMessage
(StateT SessionState (ReaderT SessionContext IO))
()
-> ConduitT
i
SessionMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SessionConfig -> Bool
ignoreLogNotifications (SessionContext -> SessionConfig
config SessionContext
context) Bool -> Bool -> Bool
&& SessionMessage -> Bool
isLogNotification SessionMessage
msg) (ConduitT
i
SessionMessage
(StateT SessionState (ReaderT SessionContext IO))
()
-> ConduitT
i
SessionMessage
(StateT SessionState (ReaderT SessionContext IO))
())
-> ConduitT
i
SessionMessage
(StateT SessionState (ReaderT SessionContext IO))
()
-> ConduitT
i
SessionMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall a b. (a -> b) -> a -> b
$
SessionMessage
-> ConduitT
i
SessionMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield SessionMessage
msg
ConduitT
i
SessionMessage
(StateT SessionState (ReaderT SessionContext IO))
b
chanSource
isLogNotification :: SessionMessage -> Bool
isLogNotification (ServerMessage (NotShowMessage ShowMessageNotification
_)) = Bool
True
isLogNotification (ServerMessage (NotLogMessage LogMessageNotification
_)) = Bool
True
isLogNotification SessionMessage
_ = Bool
False
watchdog :: ConduitM SessionMessage FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) ()
watchdog :: ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
watchdog = (SessionMessage
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
())
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
Conduit.awaitForever ((SessionMessage
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
())
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
())
-> (SessionMessage
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
())
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall a b. (a -> b) -> a -> b
$ \SessionMessage
msg -> do
Int
curId <- ConduitT
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
Int
forall (m :: * -> *).
(HasReader SessionContext m, MonadIO m) =>
m Int
getCurTimeoutId
case SessionMessage
msg of
ServerMessage FromServerMessage
sMsg -> FromServerMessage
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield FromServerMessage
sMsg
TimeoutMessage Int
tId -> Bool
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
curId Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
tId) (ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
())
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall a b. (a -> b) -> a -> b
$ SessionState -> Maybe FromServerMessage
lastReceivedMessage (SessionState -> Maybe FromServerMessage)
-> ConduitT
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
SessionState
-> ConduitT
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
(Maybe FromServerMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
SessionState
forall s (m :: * -> *). HasState s m => m s
get ConduitT
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
(Maybe FromServerMessage)
-> (Maybe FromServerMessage
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
())
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SessionException
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall a e. Exception e => e -> a
throw (SessionException
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
())
-> (Maybe FromServerMessage -> SessionException)
-> Maybe FromServerMessage
-> ConduitM
SessionMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FromServerMessage -> SessionException
Timeout
runSessionWithHandles :: Handle
-> Handle
-> ProcessHandle
-> (Handle -> SessionContext -> IO ())
-> SessionConfig
-> ClientCapabilities
-> FilePath
-> Session ()
-> Session a
-> IO a
runSessionWithHandles :: Handle
-> Handle
-> ProcessHandle
-> (Handle -> SessionContext -> IO ())
-> SessionConfig
-> ClientCapabilities
-> String
-> Session ()
-> Session a
-> IO a
runSessionWithHandles Handle
serverIn Handle
serverOut ProcessHandle
serverProc Handle -> SessionContext -> IO ()
serverHandler SessionConfig
config ClientCapabilities
caps String
rootDir Session ()
exitServer Session a
session = do
String
absRootDir <- String -> IO String
canonicalizePath String
rootDir
Handle -> BufferMode -> IO ()
hSetBuffering Handle
serverIn BufferMode
NoBuffering
Handle -> BufferMode -> IO ()
hSetBuffering Handle
serverOut BufferMode
NoBuffering
Handle -> Bool -> IO ()
hSetBinaryMode Handle
serverIn Bool
True
Handle -> Bool -> IO ()
hSetBinaryMode Handle
serverOut Bool
True
MVar RequestMap
reqMap <- RequestMap -> IO (MVar RequestMap)
forall a. a -> IO (MVar a)
newMVar RequestMap
newRequestMap
Chan SessionMessage
messageChan <- IO (Chan SessionMessage)
forall a. IO (Chan a)
newChan
MVar Int
timeoutIdVar <- Int -> IO (MVar Int)
forall a. a -> IO (MVar a)
newMVar Int
0
MVar InitializeResponse
initRsp <- IO (MVar InitializeResponse)
forall a. IO (MVar a)
newEmptyMVar
ThreadId
mainThreadId <- IO ThreadId
myThreadId
let context :: SessionContext
context = Handle
-> String
-> Chan SessionMessage
-> MVar Int
-> MVar RequestMap
-> MVar InitializeResponse
-> SessionConfig
-> ClientCapabilities
-> SessionContext
SessionContext Handle
serverIn String
absRootDir Chan SessionMessage
messageChan MVar Int
timeoutIdVar MVar RequestMap
reqMap MVar InitializeResponse
initRsp SessionConfig
config ClientCapabilities
caps
initState :: VFS -> SessionState
initState VFS
vfs = LspId
-> VFS
-> Map NormalizedUri [Diagnostic]
-> Bool
-> Maybe FromServerMessage
-> Map Text Registration
-> Set ProgressToken
-> SessionState
SessionState (Int -> LspId
IdInt Int
0) VFS
vfs Map NormalizedUri [Diagnostic]
forall a. Monoid a => a
mempty Bool
False Maybe FromServerMessage
forall a. Maybe a
Nothing Map Text Registration
forall a. Monoid a => a
mempty Set ProgressToken
forall a. Monoid a => a
mempty
runSession' :: Session a -> IO (a, SessionState)
runSession' Session a
ses = (VFS -> IO (a, SessionState)) -> IO (a, SessionState)
forall r. (VFS -> IO r) -> IO r
initVFS ((VFS -> IO (a, SessionState)) -> IO (a, SessionState))
-> (VFS -> IO (a, SessionState)) -> IO (a, SessionState)
forall a b. (a -> b) -> a -> b
$ \VFS
vfs -> SessionContext -> SessionState -> Session a -> IO (a, SessionState)
forall a.
SessionContext -> SessionState -> Session a -> IO (a, SessionState)
runSession SessionContext
context (VFS -> SessionState
initState VFS
vfs) Session a
ses
errorHandler :: SessionException -> IO ()
errorHandler = ThreadId -> SessionException -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
throwTo ThreadId
mainThreadId :: SessionException -> IO ()
serverListenerLauncher :: IO ThreadId
serverListenerLauncher =
IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> (SessionException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Handle -> SessionContext -> IO ()
serverHandler Handle
serverOut SessionContext
context) SessionException -> IO ()
errorHandler
server :: (Maybe Handle, Maybe Handle, Maybe a, ProcessHandle)
server = (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
serverIn, Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
serverOut, Maybe a
forall a. Maybe a
Nothing, ProcessHandle
serverProc)
msgTimeoutMs :: Int
msgTimeoutMs = SessionConfig -> Int
messageTimeout SessionConfig
config Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
6
serverAndListenerFinalizer :: ThreadId -> IO (Maybe ((), SessionState))
serverAndListenerFinalizer ThreadId
tid = do
IO (Maybe ((), SessionState))
-> IO () -> IO (Maybe ((), SessionState))
forall a b. IO a -> IO b -> IO a
finally (Int -> IO ((), SessionState) -> IO (Maybe ((), SessionState))
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
msgTimeoutMs (Session () -> IO ((), SessionState)
forall a. Session a -> IO (a, SessionState)
runSession' Session ()
exitServer)) (IO () -> IO (Maybe ((), SessionState)))
-> IO () -> IO (Maybe ((), SessionState))
forall a b. (a -> b) -> a -> b
$ do
ThreadId -> IO ()
killThread ThreadId
tid
#ifndef mingw32_HOST_OS
Int -> IO ExitCode -> IO (Maybe ExitCode)
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
msgTimeoutMs (ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
serverProc)
#endif
(Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupProcess (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a. (Maybe Handle, Maybe Handle, Maybe a, ProcessHandle)
server
(a
result, SessionState
_) <- IO ThreadId
-> (ThreadId -> IO (Maybe ((), SessionState)))
-> (ThreadId -> IO (a, SessionState))
-> IO (a, SessionState)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO ThreadId
serverListenerLauncher
ThreadId -> IO (Maybe ((), SessionState))
serverAndListenerFinalizer
(IO (a, SessionState) -> ThreadId -> IO (a, SessionState)
forall a b. a -> b -> a
const (IO (a, SessionState) -> ThreadId -> IO (a, SessionState))
-> IO (a, SessionState) -> ThreadId -> IO (a, SessionState)
forall a b. (a -> b) -> a -> b
$ Session a -> IO (a, SessionState)
forall a. Session a -> IO (a, SessionState)
runSession' Session a
session)
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
updateStateC :: ConduitM FromServerMessage FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) ()
updateStateC :: ConduitM
FromServerMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
updateStateC = (FromServerMessage
-> ConduitM
FromServerMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
())
-> ConduitM
FromServerMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ((FromServerMessage
-> ConduitM
FromServerMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
())
-> ConduitM
FromServerMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
())
-> (FromServerMessage
-> ConduitM
FromServerMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
())
-> ConduitM
FromServerMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall a b. (a -> b) -> a -> b
$ \FromServerMessage
msg -> do
FromServerMessage
-> ConduitM
FromServerMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState FromServerMessage
msg
FromServerMessage
-> ConduitM
FromServerMessage
FromServerMessage
(StateT SessionState (ReaderT SessionContext IO))
()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield FromServerMessage
msg
updateState :: (MonadIO m, HasReader SessionContext m, HasState SessionState m)
=> FromServerMessage -> m ()
updateState :: FromServerMessage -> m ()
updateState (NotWorkDoneProgressBegin WorkDoneProgressBeginNotification
req) =
(SessionState -> SessionState) -> m ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify ((SessionState -> SessionState) -> m ())
-> (SessionState -> SessionState) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionState
s -> SessionState
s { curProgressSessions :: Set ProgressToken
curProgressSessions = ProgressToken -> Set ProgressToken -> Set ProgressToken
forall a. Ord a => a -> Set a -> Set a
Set.insert (WorkDoneProgressBeginNotification
req WorkDoneProgressBeginNotification
-> Getting
ProgressToken WorkDoneProgressBeginNotification ProgressToken
-> ProgressToken
forall s a. s -> Getting a s a -> a
^. (ProgressParams WorkDoneProgressBeginParams
-> Const
ProgressToken (ProgressParams WorkDoneProgressBeginParams))
-> WorkDoneProgressBeginNotification
-> Const ProgressToken WorkDoneProgressBeginNotification
forall s a. HasParams s a => Lens' s a
params ((ProgressParams WorkDoneProgressBeginParams
-> Const
ProgressToken (ProgressParams WorkDoneProgressBeginParams))
-> WorkDoneProgressBeginNotification
-> Const ProgressToken WorkDoneProgressBeginNotification)
-> ((ProgressToken -> Const ProgressToken ProgressToken)
-> ProgressParams WorkDoneProgressBeginParams
-> Const
ProgressToken (ProgressParams WorkDoneProgressBeginParams))
-> Getting
ProgressToken WorkDoneProgressBeginNotification ProgressToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressToken -> Const ProgressToken ProgressToken)
-> ProgressParams WorkDoneProgressBeginParams
-> Const ProgressToken (ProgressParams WorkDoneProgressBeginParams)
forall s a. HasToken s a => Lens' s a
token) (Set ProgressToken -> Set ProgressToken)
-> Set ProgressToken -> Set ProgressToken
forall a b. (a -> b) -> a -> b
$ SessionState -> Set ProgressToken
curProgressSessions SessionState
s }
updateState (NotWorkDoneProgressEnd WorkDoneProgressEndNotification
req) =
(SessionState -> SessionState) -> m ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify ((SessionState -> SessionState) -> m ())
-> (SessionState -> SessionState) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionState
s -> SessionState
s { curProgressSessions :: Set ProgressToken
curProgressSessions = ProgressToken -> Set ProgressToken -> Set ProgressToken
forall a. Ord a => a -> Set a -> Set a
Set.delete (WorkDoneProgressEndNotification
req WorkDoneProgressEndNotification
-> Getting
ProgressToken WorkDoneProgressEndNotification ProgressToken
-> ProgressToken
forall s a. s -> Getting a s a -> a
^. (ProgressParams WorkDoneProgressEndParams
-> Const ProgressToken (ProgressParams WorkDoneProgressEndParams))
-> WorkDoneProgressEndNotification
-> Const ProgressToken WorkDoneProgressEndNotification
forall s a. HasParams s a => Lens' s a
params ((ProgressParams WorkDoneProgressEndParams
-> Const ProgressToken (ProgressParams WorkDoneProgressEndParams))
-> WorkDoneProgressEndNotification
-> Const ProgressToken WorkDoneProgressEndNotification)
-> ((ProgressToken -> Const ProgressToken ProgressToken)
-> ProgressParams WorkDoneProgressEndParams
-> Const ProgressToken (ProgressParams WorkDoneProgressEndParams))
-> Getting
ProgressToken WorkDoneProgressEndNotification ProgressToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressToken -> Const ProgressToken ProgressToken)
-> ProgressParams WorkDoneProgressEndParams
-> Const ProgressToken (ProgressParams WorkDoneProgressEndParams)
forall s a. HasToken s a => Lens' s a
token) (Set ProgressToken -> Set ProgressToken)
-> Set ProgressToken -> Set ProgressToken
forall a b. (a -> b) -> a -> b
$ SessionState -> Set ProgressToken
curProgressSessions SessionState
s }
updateState (ReqRegisterCapability RegisterCapabilityRequest
req) = do
let List [(Text, Registration)]
newRegs = (\Registration
r -> (Registration
r Registration -> Getting Text Registration Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Registration Text
forall s a. HasId s a => Lens' s a
LSP.id, Registration
r)) (Registration -> (Text, Registration))
-> List Registration -> List (Text, Registration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RegisterCapabilityRequest
req RegisterCapabilityRequest
-> Getting
(List Registration) RegisterCapabilityRequest (List Registration)
-> List Registration
forall s a. s -> Getting a s a -> a
^. (RegistrationParams
-> Const (List Registration) RegistrationParams)
-> RegisterCapabilityRequest
-> Const (List Registration) RegisterCapabilityRequest
forall s a. HasParams s a => Lens' s a
params ((RegistrationParams
-> Const (List Registration) RegistrationParams)
-> RegisterCapabilityRequest
-> Const (List Registration) RegisterCapabilityRequest)
-> ((List Registration
-> Const (List Registration) (List Registration))
-> RegistrationParams
-> Const (List Registration) RegistrationParams)
-> Getting
(List Registration) RegisterCapabilityRequest (List Registration)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Registration
-> Const (List Registration) (List Registration))
-> RegistrationParams
-> Const (List Registration) RegistrationParams
forall s a. HasRegistrations s a => Lens' s a
registrations
(SessionState -> SessionState) -> m ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify ((SessionState -> SessionState) -> m ())
-> (SessionState -> SessionState) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionState
s ->
SessionState
s { curDynCaps :: Map Text Registration
curDynCaps = Map Text Registration
-> Map Text Registration -> Map Text Registration
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ([(Text, Registration)] -> Map Text Registration
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Registration)]
newRegs) (SessionState -> Map Text Registration
curDynCaps SessionState
s) }
updateState (ReqUnregisterCapability UnregisterCapabilityRequest
req) = do
let List [Text]
unRegs = (Unregistration -> Getting Text Unregistration Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Unregistration Text
forall s a. HasId s a => Lens' s a
LSP.id) (Unregistration -> Text) -> List Unregistration -> List Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnregisterCapabilityRequest
req UnregisterCapabilityRequest
-> Getting
(List Unregistration)
UnregisterCapabilityRequest
(List Unregistration)
-> List Unregistration
forall s a. s -> Getting a s a -> a
^. (UnregistrationParams
-> Const (List Unregistration) UnregistrationParams)
-> UnregisterCapabilityRequest
-> Const (List Unregistration) UnregisterCapabilityRequest
forall s a. HasParams s a => Lens' s a
params ((UnregistrationParams
-> Const (List Unregistration) UnregistrationParams)
-> UnregisterCapabilityRequest
-> Const (List Unregistration) UnregisterCapabilityRequest)
-> ((List Unregistration
-> Const (List Unregistration) (List Unregistration))
-> UnregistrationParams
-> Const (List Unregistration) UnregistrationParams)
-> Getting
(List Unregistration)
UnregisterCapabilityRequest
(List Unregistration)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Unregistration
-> Const (List Unregistration) (List Unregistration))
-> UnregistrationParams
-> Const (List Unregistration) UnregistrationParams
forall s a. HasUnregistrations s a => Lens' s a
unregistrations
(SessionState -> SessionState) -> m ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify ((SessionState -> SessionState) -> m ())
-> (SessionState -> SessionState) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionState
s ->
let newCurDynCaps :: Map Text Registration
newCurDynCaps = (Text -> Map Text Registration -> Map Text Registration)
-> Map Text Registration -> [Text] -> Map Text Registration
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' Text -> Map Text Registration -> Map Text Registration
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (SessionState -> Map Text Registration
curDynCaps SessionState
s) [Text]
unRegs
in SessionState
s { curDynCaps :: Map Text Registration
curDynCaps = Map Text Registration
newCurDynCaps }
updateState (NotPublishDiagnostics PublishDiagnosticsNotification
n) = do
let List [Diagnostic]
diags = PublishDiagnosticsNotification
n PublishDiagnosticsNotification
-> Getting
(List Diagnostic) PublishDiagnosticsNotification (List Diagnostic)
-> List Diagnostic
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams)
-> PublishDiagnosticsNotification
-> Const (List Diagnostic) PublishDiagnosticsNotification
forall s a. HasParams s a => Lens' s a
params ((PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams)
-> PublishDiagnosticsNotification
-> Const (List Diagnostic) PublishDiagnosticsNotification)
-> ((List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
-> PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams)
-> Getting
(List Diagnostic) PublishDiagnosticsNotification (List Diagnostic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
-> PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams
forall s a. HasDiagnostics s a => Lens' s a
diagnostics
doc :: Uri
doc = PublishDiagnosticsNotification
n PublishDiagnosticsNotification
-> Getting Uri PublishDiagnosticsNotification Uri -> Uri
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
-> PublishDiagnosticsNotification
-> Const Uri PublishDiagnosticsNotification
forall s a. HasParams s a => Lens' s a
params ((PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
-> PublishDiagnosticsNotification
-> Const Uri PublishDiagnosticsNotification)
-> ((Uri -> Const Uri Uri)
-> PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
-> Getting Uri PublishDiagnosticsNotification Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams
forall s a. HasUri s a => Lens' s a
uri
(SessionState -> SessionState) -> m ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify ((SessionState -> SessionState) -> m ())
-> (SessionState -> SessionState) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionState
s ->
let newDiags :: Map NormalizedUri [Diagnostic]
newDiags = NormalizedUri
-> [Diagnostic]
-> Map NormalizedUri [Diagnostic]
-> Map NormalizedUri [Diagnostic]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Uri -> NormalizedUri
toNormalizedUri Uri
doc) [Diagnostic]
diags (SessionState -> Map NormalizedUri [Diagnostic]
curDiagnostics SessionState
s)
in SessionState
s { curDiagnostics :: Map NormalizedUri [Diagnostic]
curDiagnostics = Map NormalizedUri [Diagnostic]
newDiags }
updateState (ReqApplyWorkspaceEdit ApplyWorkspaceEditRequest
r) = do
[DidChangeTextDocumentParams]
allChangeParams <- case ApplyWorkspaceEditRequest
r ApplyWorkspaceEditRequest
-> Getting
(Maybe (List TextDocumentEdit))
ApplyWorkspaceEditRequest
(Maybe (List TextDocumentEdit))
-> Maybe (List TextDocumentEdit)
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams)
-> ApplyWorkspaceEditRequest
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditRequest
forall s a. HasParams s a => Lens' s a
params ((ApplyWorkspaceEditParams
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams)
-> ApplyWorkspaceEditRequest
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditRequest)
-> ((Maybe (List TextDocumentEdit)
-> Const
(Maybe (List TextDocumentEdit)) (Maybe (List TextDocumentEdit)))
-> ApplyWorkspaceEditParams
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams)
-> Getting
(Maybe (List TextDocumentEdit))
ApplyWorkspaceEditRequest
(Maybe (List TextDocumentEdit))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit
-> Const (Maybe (List TextDocumentEdit)) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
edit ((WorkspaceEdit
-> Const (Maybe (List TextDocumentEdit)) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams)
-> ((Maybe (List TextDocumentEdit)
-> Const
(Maybe (List TextDocumentEdit)) (Maybe (List TextDocumentEdit)))
-> WorkspaceEdit
-> Const (Maybe (List TextDocumentEdit)) WorkspaceEdit)
-> (Maybe (List TextDocumentEdit)
-> Const
(Maybe (List TextDocumentEdit)) (Maybe (List TextDocumentEdit)))
-> ApplyWorkspaceEditParams
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (List TextDocumentEdit)
-> Const
(Maybe (List TextDocumentEdit)) (Maybe (List TextDocumentEdit)))
-> WorkspaceEdit
-> Const (Maybe (List TextDocumentEdit)) WorkspaceEdit
forall s a. HasDocumentChanges s a => Lens' s a
documentChanges of
Just (List [TextDocumentEdit]
cs) -> do
(TextDocumentEdit -> m ()) -> [TextDocumentEdit] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Uri -> m ()
forall (m :: * -> *).
(HasState SessionState m, HasReader SessionContext m, MonadIO m) =>
Uri -> m ()
checkIfNeedsOpened (Uri -> m ())
-> (TextDocumentEdit -> Uri) -> TextDocumentEdit -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentEdit -> Getting Uri TextDocumentEdit Uri -> Uri
forall s a. s -> Getting a s a -> a
^. (VersionedTextDocumentIdentifier
-> Const Uri VersionedTextDocumentIdentifier)
-> TextDocumentEdit -> Const Uri TextDocumentEdit
forall s a. HasTextDocument s a => Lens' s a
textDocument ((VersionedTextDocumentIdentifier
-> Const Uri VersionedTextDocumentIdentifier)
-> TextDocumentEdit -> Const Uri TextDocumentEdit)
-> ((Uri -> Const Uri Uri)
-> VersionedTextDocumentIdentifier
-> Const Uri VersionedTextDocumentIdentifier)
-> Getting Uri TextDocumentEdit Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> VersionedTextDocumentIdentifier
-> Const Uri VersionedTextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
uri)) [TextDocumentEdit]
cs
[DidChangeTextDocumentParams] -> m [DidChangeTextDocumentParams]
forall (m :: * -> *) a. Monad m => a -> m a
return ([DidChangeTextDocumentParams] -> m [DidChangeTextDocumentParams])
-> [DidChangeTextDocumentParams] -> m [DidChangeTextDocumentParams]
forall a b. (a -> b) -> a -> b
$ (TextDocumentEdit -> DidChangeTextDocumentParams)
-> [TextDocumentEdit] -> [DidChangeTextDocumentParams]
forall a b. (a -> b) -> [a] -> [b]
map TextDocumentEdit -> DidChangeTextDocumentParams
getParams [TextDocumentEdit]
cs
Maybe (List TextDocumentEdit)
Nothing -> case ApplyWorkspaceEditRequest
r ApplyWorkspaceEditRequest
-> Getting
(Maybe (HashMap Uri (List TextEdit)))
ApplyWorkspaceEditRequest
(Maybe (HashMap Uri (List TextEdit)))
-> Maybe (HashMap Uri (List TextEdit))
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
-> Const
(Maybe (HashMap Uri (List TextEdit))) ApplyWorkspaceEditParams)
-> ApplyWorkspaceEditRequest
-> Const
(Maybe (HashMap Uri (List TextEdit))) ApplyWorkspaceEditRequest
forall s a. HasParams s a => Lens' s a
params ((ApplyWorkspaceEditParams
-> Const
(Maybe (HashMap Uri (List TextEdit))) ApplyWorkspaceEditParams)
-> ApplyWorkspaceEditRequest
-> Const
(Maybe (HashMap Uri (List TextEdit))) ApplyWorkspaceEditRequest)
-> ((Maybe (HashMap Uri (List TextEdit))
-> Const
(Maybe (HashMap Uri (List TextEdit)))
(Maybe (HashMap Uri (List TextEdit))))
-> ApplyWorkspaceEditParams
-> Const
(Maybe (HashMap Uri (List TextEdit))) ApplyWorkspaceEditParams)
-> Getting
(Maybe (HashMap Uri (List TextEdit)))
ApplyWorkspaceEditRequest
(Maybe (HashMap Uri (List TextEdit)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit
-> Const (Maybe (HashMap Uri (List TextEdit))) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const
(Maybe (HashMap Uri (List TextEdit))) ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
edit ((WorkspaceEdit
-> Const (Maybe (HashMap Uri (List TextEdit))) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const
(Maybe (HashMap Uri (List TextEdit))) ApplyWorkspaceEditParams)
-> ((Maybe (HashMap Uri (List TextEdit))
-> Const
(Maybe (HashMap Uri (List TextEdit)))
(Maybe (HashMap Uri (List TextEdit))))
-> WorkspaceEdit
-> Const (Maybe (HashMap Uri (List TextEdit))) WorkspaceEdit)
-> (Maybe (HashMap Uri (List TextEdit))
-> Const
(Maybe (HashMap Uri (List TextEdit)))
(Maybe (HashMap Uri (List TextEdit))))
-> ApplyWorkspaceEditParams
-> Const
(Maybe (HashMap Uri (List TextEdit))) ApplyWorkspaceEditParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (HashMap Uri (List TextEdit))
-> Const
(Maybe (HashMap Uri (List TextEdit)))
(Maybe (HashMap Uri (List TextEdit))))
-> WorkspaceEdit
-> Const (Maybe (HashMap Uri (List TextEdit))) WorkspaceEdit
forall s a. HasChanges s a => Lens' s a
changes of
Just HashMap Uri (List TextEdit)
cs -> do
(Uri -> m ()) -> [Uri] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Uri -> m ()
forall (m :: * -> *).
(HasState SessionState m, HasReader SessionContext m, MonadIO m) =>
Uri -> m ()
checkIfNeedsOpened (HashMap Uri (List TextEdit) -> [Uri]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap Uri (List TextEdit)
cs)
[[DidChangeTextDocumentParams]] -> [DidChangeTextDocumentParams]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[DidChangeTextDocumentParams]] -> [DidChangeTextDocumentParams])
-> m [[DidChangeTextDocumentParams]]
-> m [DidChangeTextDocumentParams]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Uri, List TextEdit) -> m [DidChangeTextDocumentParams])
-> [(Uri, List TextEdit)] -> m [[DidChangeTextDocumentParams]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Uri -> List TextEdit -> m [DidChangeTextDocumentParams])
-> (Uri, List TextEdit) -> m [DidChangeTextDocumentParams]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Uri -> List TextEdit -> m [DidChangeTextDocumentParams]
forall (f :: * -> *).
HasState SessionState f =>
Uri -> List TextEdit -> f [DidChangeTextDocumentParams]
getChangeParams) (HashMap Uri (List TextEdit) -> [(Uri, List TextEdit)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Uri (List TextEdit)
cs)
Maybe (HashMap Uri (List TextEdit))
Nothing ->
String -> m [DidChangeTextDocumentParams]
forall a. HasCallStack => String -> a
error String
"WorkspaceEdit contains neither documentChanges nor changes!"
(SessionState -> m SessionState) -> m ()
forall s (m :: * -> *).
(HasState s m, HasState s m, Monad m) =>
(s -> m s) -> m ()
modifyM ((SessionState -> m SessionState) -> m ())
-> (SessionState -> m SessionState) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionState
s -> do
VFS
newVFS <- IO VFS -> m VFS
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VFS -> m VFS) -> IO VFS -> m VFS
forall a b. (a -> b) -> a -> b
$ VFS -> ApplyWorkspaceEditRequest -> IO VFS
changeFromServerVFS (SessionState -> VFS
vfs SessionState
s) ApplyWorkspaceEditRequest
r
SessionState -> m SessionState
forall (m :: * -> *) a. Monad m => a -> m a
return (SessionState -> m SessionState) -> SessionState -> m SessionState
forall a b. (a -> b) -> a -> b
$ SessionState
s { vfs :: VFS
vfs = VFS
newVFS }
let groupedParams :: [[DidChangeTextDocumentParams]]
groupedParams = (DidChangeTextDocumentParams
-> DidChangeTextDocumentParams -> Bool)
-> [DidChangeTextDocumentParams] -> [[DidChangeTextDocumentParams]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\DidChangeTextDocumentParams
a DidChangeTextDocumentParams
b -> DidChangeTextDocumentParams
a DidChangeTextDocumentParams
-> Getting
VersionedTextDocumentIdentifier
DidChangeTextDocumentParams
VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier
forall s a. s -> Getting a s a -> a
^. Getting
VersionedTextDocumentIdentifier
DidChangeTextDocumentParams
VersionedTextDocumentIdentifier
forall s a. HasTextDocument s a => Lens' s a
textDocument VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
== DidChangeTextDocumentParams
b DidChangeTextDocumentParams
-> Getting
VersionedTextDocumentIdentifier
DidChangeTextDocumentParams
VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier
forall s a. s -> Getting a s a -> a
^. Getting
VersionedTextDocumentIdentifier
DidChangeTextDocumentParams
VersionedTextDocumentIdentifier
forall s a. HasTextDocument s a => Lens' s a
textDocument) [DidChangeTextDocumentParams]
allChangeParams
mergedParams :: [DidChangeTextDocumentParams]
mergedParams = ([DidChangeTextDocumentParams] -> DidChangeTextDocumentParams)
-> [[DidChangeTextDocumentParams]] -> [DidChangeTextDocumentParams]
forall a b. (a -> b) -> [a] -> [b]
map [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
mergeParams [[DidChangeTextDocumentParams]]
groupedParams
[DidChangeTextDocumentParams]
-> (DidChangeTextDocumentParams -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [DidChangeTextDocumentParams]
mergedParams (NotificationMessage ClientMethod DidChangeTextDocumentParams
-> m ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (NotificationMessage ClientMethod DidChangeTextDocumentParams
-> m ())
-> (DidChangeTextDocumentParams
-> NotificationMessage ClientMethod DidChangeTextDocumentParams)
-> DidChangeTextDocumentParams
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> ClientMethod
-> DidChangeTextDocumentParams
-> NotificationMessage ClientMethod DidChangeTextDocumentParams
forall m a. Text -> m -> a -> NotificationMessage m a
NotificationMessage Text
"2.0" ClientMethod
TextDocumentDidChange)
let sortedVersions :: [[DidChangeTextDocumentParams]]
sortedVersions = ([DidChangeTextDocumentParams] -> [DidChangeTextDocumentParams])
-> [[DidChangeTextDocumentParams]]
-> [[DidChangeTextDocumentParams]]
forall a b. (a -> b) -> [a] -> [b]
map ((DidChangeTextDocumentParams
-> DidChangeTextDocumentParams -> Ordering)
-> [DidChangeTextDocumentParams] -> [DidChangeTextDocumentParams]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (TextDocumentVersion -> TextDocumentVersion -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TextDocumentVersion -> TextDocumentVersion -> Ordering)
-> (DidChangeTextDocumentParams -> TextDocumentVersion)
-> DidChangeTextDocumentParams
-> DidChangeTextDocumentParams
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (DidChangeTextDocumentParams
-> Getting
TextDocumentVersion DidChangeTextDocumentParams TextDocumentVersion
-> TextDocumentVersion
forall s a. s -> Getting a s a -> a
^. (VersionedTextDocumentIdentifier
-> Const TextDocumentVersion VersionedTextDocumentIdentifier)
-> DidChangeTextDocumentParams
-> Const TextDocumentVersion DidChangeTextDocumentParams
forall s a. HasTextDocument s a => Lens' s a
textDocument ((VersionedTextDocumentIdentifier
-> Const TextDocumentVersion VersionedTextDocumentIdentifier)
-> DidChangeTextDocumentParams
-> Const TextDocumentVersion DidChangeTextDocumentParams)
-> ((TextDocumentVersion
-> Const TextDocumentVersion TextDocumentVersion)
-> VersionedTextDocumentIdentifier
-> Const TextDocumentVersion VersionedTextDocumentIdentifier)
-> Getting
TextDocumentVersion DidChangeTextDocumentParams TextDocumentVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentVersion
-> Const TextDocumentVersion TextDocumentVersion)
-> VersionedTextDocumentIdentifier
-> Const TextDocumentVersion VersionedTextDocumentIdentifier
forall s a. HasVersion s a => Lens' s a
version))) [[DidChangeTextDocumentParams]]
groupedParams
latestVersions :: [VersionedTextDocumentIdentifier]
latestVersions = ([DidChangeTextDocumentParams] -> VersionedTextDocumentIdentifier)
-> [[DidChangeTextDocumentParams]]
-> [VersionedTextDocumentIdentifier]
forall a b. (a -> b) -> [a] -> [b]
map ((DidChangeTextDocumentParams
-> Getting
VersionedTextDocumentIdentifier
DidChangeTextDocumentParams
VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier
forall s a. s -> Getting a s a -> a
^. Getting
VersionedTextDocumentIdentifier
DidChangeTextDocumentParams
VersionedTextDocumentIdentifier
forall s a. HasTextDocument s a => Lens' s a
textDocument) (DidChangeTextDocumentParams -> VersionedTextDocumentIdentifier)
-> ([DidChangeTextDocumentParams] -> DidChangeTextDocumentParams)
-> [DidChangeTextDocumentParams]
-> VersionedTextDocumentIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
forall a. [a] -> a
last) [[DidChangeTextDocumentParams]]
sortedVersions
bumpedVersions :: [VersionedTextDocumentIdentifier]
bumpedVersions = (VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier)
-> [VersionedTextDocumentIdentifier]
-> [VersionedTextDocumentIdentifier]
forall a b. (a -> b) -> [a] -> [b]
map ((TextDocumentVersion -> Identity TextDocumentVersion)
-> VersionedTextDocumentIdentifier
-> Identity VersionedTextDocumentIdentifier
forall s a. HasVersion s a => Lens' s a
version ((TextDocumentVersion -> Identity TextDocumentVersion)
-> VersionedTextDocumentIdentifier
-> Identity VersionedTextDocumentIdentifier)
-> ((Int -> Identity Int)
-> TextDocumentVersion -> Identity TextDocumentVersion)
-> (Int -> Identity Int)
-> VersionedTextDocumentIdentifier
-> Identity VersionedTextDocumentIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int)
-> TextDocumentVersion -> Identity TextDocumentVersion
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Int -> Identity Int)
-> VersionedTextDocumentIdentifier
-> Identity VersionedTextDocumentIdentifier)
-> Int
-> VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1) [VersionedTextDocumentIdentifier]
latestVersions
[VersionedTextDocumentIdentifier]
-> (VersionedTextDocumentIdentifier -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [VersionedTextDocumentIdentifier]
bumpedVersions ((VersionedTextDocumentIdentifier -> m ()) -> m ())
-> (VersionedTextDocumentIdentifier -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(VersionedTextDocumentIdentifier Uri
uri TextDocumentVersion
v) ->
(SessionState -> SessionState) -> m ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify ((SessionState -> SessionState) -> m ())
-> (SessionState -> SessionState) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionState
s ->
let oldVFS :: VFS
oldVFS = SessionState -> VFS
vfs SessionState
s
update :: VirtualFile -> VirtualFile
update (VirtualFile Int
oldV Int
file_ver Rope
t) = Int -> Int -> Rope -> VirtualFile
VirtualFile (Int -> TextDocumentVersion -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
oldV TextDocumentVersion
v) (Int
file_ver Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Rope
t
newVFS :: VFS
newVFS = (VFSMap -> VFSMap) -> VFS -> VFS
updateVFS ((VirtualFile -> VirtualFile) -> NormalizedUri -> VFSMap -> VFSMap
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust VirtualFile -> VirtualFile
update (Uri -> NormalizedUri
toNormalizedUri Uri
uri)) VFS
oldVFS
in SessionState
s { vfs :: VFS
vfs = VFS
newVFS }
where checkIfNeedsOpened :: Uri -> m ()
checkIfNeedsOpened Uri
uri = do
VFS
oldVFS <- SessionState -> VFS
vfs (SessionState -> VFS) -> m SessionState -> m VFS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SessionState
forall s (m :: * -> *). HasState s m => m s
get
SessionContext
ctx <- m SessionContext
forall r (m :: * -> *). HasReader r m => m r
ask
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Uri -> NormalizedUri
toNormalizedUri Uri
uri NormalizedUri -> VFSMap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` VFS -> VFSMap
vfsMap VFS
oldVFS) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let fp :: String
fp = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Uri -> Maybe String
uriToFilePath Uri
uri
Text
contents <- IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile String
fp
let item :: TextDocumentItem
item = Uri -> Text -> Int -> Text -> TextDocumentItem
TextDocumentItem (String -> Uri
filePathToUri String
fp) Text
"" Int
0 Text
contents
msg :: NotificationMessage ClientMethod DidOpenTextDocumentParams
msg = Text
-> ClientMethod
-> DidOpenTextDocumentParams
-> NotificationMessage ClientMethod DidOpenTextDocumentParams
forall m a. Text -> m -> a -> NotificationMessage m a
NotificationMessage Text
"2.0" ClientMethod
TextDocumentDidOpen (TextDocumentItem -> DidOpenTextDocumentParams
DidOpenTextDocumentParams TextDocumentItem
item)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
B.hPut (SessionContext -> Handle
serverIn SessionContext
ctx) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
addHeader (NotificationMessage ClientMethod DidOpenTextDocumentParams
-> ByteString
forall a. ToJSON a => a -> ByteString
encode NotificationMessage ClientMethod DidOpenTextDocumentParams
msg)
(SessionState -> m SessionState) -> m ()
forall s (m :: * -> *).
(HasState s m, HasState s m, Monad m) =>
(s -> m s) -> m ()
modifyM ((SessionState -> m SessionState) -> m ())
-> (SessionState -> m SessionState) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionState
s -> do
let (VFS
newVFS,[String]
_) = VFS
-> NotificationMessage ClientMethod DidOpenTextDocumentParams
-> (VFS, [String])
openVFS (SessionState -> VFS
vfs SessionState
s) NotificationMessage ClientMethod DidOpenTextDocumentParams
msg
SessionState -> m SessionState
forall (m :: * -> *) a. Monad m => a -> m a
return (SessionState -> m SessionState) -> SessionState -> m SessionState
forall a b. (a -> b) -> a -> b
$ SessionState
s { vfs :: VFS
vfs = VFS
newVFS }
getParams :: TextDocumentEdit -> DidChangeTextDocumentParams
getParams (TextDocumentEdit VersionedTextDocumentIdentifier
docId (List [TextEdit]
edits)) =
let changeEvents :: [TextDocumentContentChangeEvent]
changeEvents = (TextEdit -> TextDocumentContentChangeEvent)
-> [TextEdit] -> [TextDocumentContentChangeEvent]
forall a b. (a -> b) -> [a] -> [b]
map (\TextEdit
e -> Maybe Range
-> TextDocumentVersion -> Text -> TextDocumentContentChangeEvent
TextDocumentContentChangeEvent (Range -> Maybe Range
forall a. a -> Maybe a
Just (TextEdit
e TextEdit -> Getting Range TextEdit Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range TextEdit Range
forall s a. HasRange s a => Lens' s a
range)) TextDocumentVersion
forall a. Maybe a
Nothing (TextEdit
e TextEdit -> Getting Text TextEdit Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text TextEdit Text
forall s a. HasNewText s a => Lens' s a
newText)) [TextEdit]
edits
in VersionedTextDocumentIdentifier
-> List TextDocumentContentChangeEvent
-> DidChangeTextDocumentParams
DidChangeTextDocumentParams VersionedTextDocumentIdentifier
docId ([TextDocumentContentChangeEvent]
-> List TextDocumentContentChangeEvent
forall a. [a] -> List a
List [TextDocumentContentChangeEvent]
changeEvents)
textDocumentVersions :: Uri -> m [VersionedTextDocumentIdentifier]
textDocumentVersions Uri
uri = do
VFSMap
m <- VFS -> VFSMap
vfsMap (VFS -> VFSMap) -> (SessionState -> VFS) -> SessionState -> VFSMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> VFS
vfs (SessionState -> VFSMap) -> m SessionState -> m VFSMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SessionState
forall s (m :: * -> *). HasState s m => m s
get
let curVer :: Int
curVer = Int -> TextDocumentVersion -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (TextDocumentVersion -> Int) -> TextDocumentVersion -> Int
forall a b. (a -> b) -> a -> b
$
VirtualFile -> Int
_lsp_version (VirtualFile -> Int) -> Maybe VirtualFile -> TextDocumentVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VFSMap
m VFSMap -> NormalizedUri -> Maybe VirtualFile
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? (Uri -> NormalizedUri
toNormalizedUri Uri
uri)
[VersionedTextDocumentIdentifier]
-> m [VersionedTextDocumentIdentifier]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([VersionedTextDocumentIdentifier]
-> m [VersionedTextDocumentIdentifier])
-> [VersionedTextDocumentIdentifier]
-> m [VersionedTextDocumentIdentifier]
forall a b. (a -> b) -> a -> b
$ (Int -> VersionedTextDocumentIdentifier)
-> [Int] -> [VersionedTextDocumentIdentifier]
forall a b. (a -> b) -> [a] -> [b]
map (Uri -> TextDocumentVersion -> VersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier Uri
uri (TextDocumentVersion -> VersionedTextDocumentIdentifier)
-> (Int -> TextDocumentVersion)
-> Int
-> VersionedTextDocumentIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TextDocumentVersion
forall a. a -> Maybe a
Just) [Int
curVer Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1..]
textDocumentEdits :: Uri -> [TextEdit] -> m [TextDocumentEdit]
textDocumentEdits Uri
uri [TextEdit]
edits = do
[VersionedTextDocumentIdentifier]
vers <- Uri -> m [VersionedTextDocumentIdentifier]
forall (m :: * -> *).
HasState SessionState m =>
Uri -> m [VersionedTextDocumentIdentifier]
textDocumentVersions Uri
uri
[TextDocumentEdit] -> m [TextDocumentEdit]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TextDocumentEdit] -> m [TextDocumentEdit])
-> [TextDocumentEdit] -> m [TextDocumentEdit]
forall a b. (a -> b) -> a -> b
$ ((VersionedTextDocumentIdentifier, TextEdit) -> TextDocumentEdit)
-> [(VersionedTextDocumentIdentifier, TextEdit)]
-> [TextDocumentEdit]
forall a b. (a -> b) -> [a] -> [b]
map (\(VersionedTextDocumentIdentifier
v, TextEdit
e) -> VersionedTextDocumentIdentifier
-> List TextEdit -> TextDocumentEdit
TextDocumentEdit VersionedTextDocumentIdentifier
v ([TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit
e])) ([(VersionedTextDocumentIdentifier, TextEdit)]
-> [TextDocumentEdit])
-> [(VersionedTextDocumentIdentifier, TextEdit)]
-> [TextDocumentEdit]
forall a b. (a -> b) -> a -> b
$ [VersionedTextDocumentIdentifier]
-> [TextEdit] -> [(VersionedTextDocumentIdentifier, TextEdit)]
forall a b. [a] -> [b] -> [(a, b)]
zip [VersionedTextDocumentIdentifier]
vers [TextEdit]
edits
getChangeParams :: Uri -> List TextEdit -> f [DidChangeTextDocumentParams]
getChangeParams Uri
uri (List [TextEdit]
edits) =
(TextDocumentEdit -> DidChangeTextDocumentParams)
-> [TextDocumentEdit] -> [DidChangeTextDocumentParams]
forall a b. (a -> b) -> [a] -> [b]
map ((TextDocumentEdit -> DidChangeTextDocumentParams)
-> [TextDocumentEdit] -> [DidChangeTextDocumentParams])
-> f (TextDocumentEdit -> DidChangeTextDocumentParams)
-> f ([TextDocumentEdit] -> [DidChangeTextDocumentParams])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TextDocumentEdit -> DidChangeTextDocumentParams)
-> f (TextDocumentEdit -> DidChangeTextDocumentParams)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TextDocumentEdit -> DidChangeTextDocumentParams
getParams f ([TextDocumentEdit] -> [DidChangeTextDocumentParams])
-> f [TextDocumentEdit] -> f [DidChangeTextDocumentParams]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Uri -> [TextEdit] -> f [TextDocumentEdit]
forall (m :: * -> *).
HasState SessionState m =>
Uri -> [TextEdit] -> m [TextDocumentEdit]
textDocumentEdits Uri
uri ([TextEdit] -> [TextEdit]
forall a. [a] -> [a]
reverse [TextEdit]
edits)
mergeParams :: [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
mergeParams :: [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
mergeParams [DidChangeTextDocumentParams]
params = let events :: [TextDocumentContentChangeEvent]
events = [[TextDocumentContentChangeEvent]]
-> [TextDocumentContentChangeEvent]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TextDocumentContentChangeEvent]]
-> [[TextDocumentContentChangeEvent]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ((DidChangeTextDocumentParams -> [TextDocumentContentChangeEvent])
-> [DidChangeTextDocumentParams]
-> [[TextDocumentContentChangeEvent]]
forall a b. (a -> b) -> [a] -> [b]
map (List TextDocumentContentChangeEvent
-> [TextDocumentContentChangeEvent]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (List TextDocumentContentChangeEvent
-> [TextDocumentContentChangeEvent])
-> (DidChangeTextDocumentParams
-> List TextDocumentContentChangeEvent)
-> DidChangeTextDocumentParams
-> [TextDocumentContentChangeEvent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DidChangeTextDocumentParams
-> Getting
(List TextDocumentContentChangeEvent)
DidChangeTextDocumentParams
(List TextDocumentContentChangeEvent)
-> List TextDocumentContentChangeEvent
forall s a. s -> Getting a s a -> a
^. Getting
(List TextDocumentContentChangeEvent)
DidChangeTextDocumentParams
(List TextDocumentContentChangeEvent)
forall s a. HasContentChanges s a => Lens' s a
contentChanges)) [DidChangeTextDocumentParams]
params))
in VersionedTextDocumentIdentifier
-> List TextDocumentContentChangeEvent
-> DidChangeTextDocumentParams
DidChangeTextDocumentParams ([DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
forall a. [a] -> a
head [DidChangeTextDocumentParams]
params DidChangeTextDocumentParams
-> Getting
VersionedTextDocumentIdentifier
DidChangeTextDocumentParams
VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier
forall s a. s -> Getting a s a -> a
^. Getting
VersionedTextDocumentIdentifier
DidChangeTextDocumentParams
VersionedTextDocumentIdentifier
forall s a. HasTextDocument s a => Lens' s a
textDocument) ([TextDocumentContentChangeEvent]
-> List TextDocumentContentChangeEvent
forall a. [a] -> List a
List [TextDocumentContentChangeEvent]
events)
updateState FromServerMessage
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sendMessage :: (MonadIO m, HasReader SessionContext m, ToJSON a) => a -> m ()
sendMessage :: a -> m ()
sendMessage a
msg = do
Handle
h <- SessionContext -> Handle
serverIn (SessionContext -> Handle) -> m SessionContext -> m Handle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SessionContext
forall r (m :: * -> *). HasReader r m => m r
ask
LogMsgType -> a -> m ()
forall a (m :: * -> *).
(ToJSON a, MonadIO m, HasReader SessionContext m) =>
LogMsgType -> a -> m ()
logMsg LogMsgType
LogClient a
msg
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
B.hPut Handle
h (ByteString -> ByteString
addHeader (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
msg)
withTimeout :: Int -> Session a -> Session a
withTimeout :: Int -> Session a -> Session a
withTimeout Int
duration Session a
f = do
Chan SessionMessage
chan <- (SessionContext -> Chan SessionMessage)
-> Session (Chan SessionMessage)
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> Chan SessionMessage
messageChan
Int
timeoutId <- Session Int
forall (m :: * -> *).
(HasReader SessionContext m, MonadIO m) =>
m Int
getCurTimeoutId
(SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify ((SessionState -> SessionState) -> Session ())
-> (SessionState -> SessionState) -> Session ()
forall a b. (a -> b) -> a -> b
$ \SessionState
s -> SessionState
s { overridingTimeout :: Bool
overridingTimeout = Bool
True }
IO ThreadId -> Session ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> Session ThreadId)
-> IO ThreadId -> Session ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
Int -> IO ()
threadDelay (Int
duration Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000)
Chan SessionMessage -> SessionMessage -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan SessionMessage
chan (Int -> SessionMessage
TimeoutMessage Int
timeoutId)
a
res <- Session a
f
Int -> Session ()
forall (m :: * -> *).
(HasReader SessionContext m, MonadIO m) =>
Int -> m ()
bumpTimeoutId Int
timeoutId
(SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify ((SessionState -> SessionState) -> Session ())
-> (SessionState -> SessionState) -> Session ()
forall a b. (a -> b) -> a -> b
$ \SessionState
s -> SessionState
s { overridingTimeout :: Bool
overridingTimeout = Bool
False }
a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
data LogMsgType = LogServer | LogClient
deriving LogMsgType -> LogMsgType -> Bool
(LogMsgType -> LogMsgType -> Bool)
-> (LogMsgType -> LogMsgType -> Bool) -> Eq LogMsgType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogMsgType -> LogMsgType -> Bool
$c/= :: LogMsgType -> LogMsgType -> Bool
== :: LogMsgType -> LogMsgType -> Bool
$c== :: LogMsgType -> LogMsgType -> Bool
Eq
logMsg :: (ToJSON a, MonadIO m, HasReader SessionContext m)
=> LogMsgType -> a -> m ()
logMsg :: LogMsgType -> a -> m ()
logMsg LogMsgType
t a
msg = do
Bool
shouldLog <- (SessionContext -> Bool) -> m Bool
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks ((SessionContext -> Bool) -> m Bool)
-> (SessionContext -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ SessionConfig -> Bool
logMessages (SessionConfig -> Bool)
-> (SessionContext -> SessionConfig) -> SessionContext -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionContext -> SessionConfig
config
Bool
shouldColor <- (SessionContext -> Bool) -> m Bool
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks ((SessionContext -> Bool) -> m Bool)
-> (SessionContext -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ SessionConfig -> Bool
logColor (SessionConfig -> Bool)
-> (SessionContext -> SessionConfig) -> SessionContext -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionContext -> SessionConfig
config
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldLog (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldColor (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [SGR] -> IO ()
setSGR [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
color]
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
arrow String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
showPretty a
msg
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldColor (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [SGR] -> IO ()
setSGR [SGR
Reset]
where arrow :: String
arrow
| LogMsgType
t LogMsgType -> LogMsgType -> Bool
forall a. Eq a => a -> a -> Bool
== LogMsgType
LogServer = String
"<-- "
| Bool
otherwise = String
"--> "
color :: Color
color
| LogMsgType
t LogMsgType -> LogMsgType -> Bool
forall a. Eq a => a -> a -> Bool
== LogMsgType
LogServer = Color
Magenta
| Bool
otherwise = Color
Cyan
showPretty :: a -> String
showPretty = ByteString -> String
B.unpack (ByteString -> String) -> (a -> ByteString) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty