module Language.LSP.Client.Exceptions where

import Control.Exception (Exception)
import Data.Aeson (Value, encode)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Algorithm.Diff (getGroupedDiff)
import Data.Algorithm.DiffOutput (ppDiff)
import Data.ByteString.Lazy.Char8 qualified as LazyByteString
import Data.List (nub)
import Language.LSP.Protocol.Message
    ( FromServerMessage
    , ResponseError
    , SomeLspId
    )
import Prelude

-- | An exception that can be thrown during a 'Language.LSP.Client.Session'
data SessionException
    = Timeout (Maybe FromServerMessage)
    | NoContentLengthHeader
    | UnexpectedMessage String FromServerMessage
    | ReplayOutOfOrder FromServerMessage [FromServerMessage]
    | UnexpectedDiagnostics
    | IncorrectApplyEditRequest String
    | UnexpectedResponseError SomeLspId ResponseError
    | UnexpectedServerTermination
    | IllegalInitSequenceMessage FromServerMessage
    | MessageSendError Value IOError
    deriving stock (SessionException -> SessionException -> Bool
(SessionException -> SessionException -> Bool)
-> (SessionException -> SessionException -> Bool)
-> Eq SessionException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SessionException -> SessionException -> Bool
== :: SessionException -> SessionException -> Bool
$c/= :: SessionException -> SessionException -> Bool
/= :: SessionException -> SessionException -> Bool
Eq)

instance Exception SessionException

instance Show SessionException where
    show :: SessionException -> String
show (Timeout Maybe FromServerMessage
lastMsg) =
        String
"Timed out waiting to receive a message from the server."
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ case Maybe FromServerMessage
lastMsg of
                Just FromServerMessage
msg -> String
"\nLast message received:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
LazyByteString.unpack (FromServerMessage -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty FromServerMessage
msg)
                Maybe FromServerMessage
Nothing -> String
forall a. Monoid a => a
mempty
    show SessionException
NoContentLengthHeader = String
"Couldn't read Content-Length header from the server."
    show (UnexpectedMessage String
expected FromServerMessage
lastMsg) =
        String
"Received an unexpected message from the server:\n"
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Was parsing: "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
expected
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"But the last message received was:\n"
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
LazyByteString.unpack (FromServerMessage -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty FromServerMessage
lastMsg)
    show (ReplayOutOfOrder FromServerMessage
received [FromServerMessage]
expected) =
        let expected' :: [FromServerMessage]
expected' = [FromServerMessage] -> [FromServerMessage]
forall a. Eq a => [a] -> [a]
nub [FromServerMessage]
expected
            getJsonDiff :: FromServerMessage -> [String]
            getJsonDiff :: FromServerMessage -> [String]
getJsonDiff = String -> [String]
lines (String -> [String])
-> (FromServerMessage -> String) -> FromServerMessage -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
LazyByteString.unpack (ByteString -> String)
-> (FromServerMessage -> ByteString) -> FromServerMessage -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromServerMessage -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty
            showExp :: FromServerMessage -> String
showExp FromServerMessage
e =
                ByteString -> String
LazyByteString.unpack (FromServerMessage -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty FromServerMessage
e)
                    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nDiff:\n"
                    String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Diff [String]] -> String
ppDiff ([String] -> [String] -> [Diff [String]]
forall a. Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff (FromServerMessage -> [String]
getJsonDiff FromServerMessage
received) (FromServerMessage -> [String]
getJsonDiff FromServerMessage
e))
         in String
"Replay is out of order:\n"
                String -> ShowS
forall a. [a] -> [a] -> [a]
++
                -- Print json so its a bit easier to update the session logs
                String
"Received from server:\n"
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
LazyByteString.unpack (FromServerMessage -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty FromServerMessage
received)
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Raw from server:\n"
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
LazyByteString.unpack (FromServerMessage -> ByteString
forall a. ToJSON a => a -> ByteString
encode FromServerMessage
received)
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Expected one of:\n"
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines ((FromServerMessage -> String) -> [FromServerMessage] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FromServerMessage -> String
showExp [FromServerMessage]
expected')
    show SessionException
UnexpectedDiagnostics = String
"Unexpectedly received diagnostics from the server."
    show (IncorrectApplyEditRequest String
msgStr) =
        String
"ApplyEditRequest didn't contain document, instead received:\n"
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msgStr
    show (UnexpectedResponseError SomeLspId
lid ResponseError
e) =
        String
"Received an expected error in a response for id "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeLspId -> String
forall a. Show a => a -> String
show SomeLspId
lid
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n"
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ ResponseError -> String
forall a. Show a => a -> String
show ResponseError
e
    show SessionException
UnexpectedServerTermination = String
"Language server unexpectedly terminated"
    show (IllegalInitSequenceMessage FromServerMessage
msg) =
        String
"Received an illegal message between the initialize request and response:\n"
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
LazyByteString.unpack (FromServerMessage -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty FromServerMessage
msg)
    show (MessageSendError Value
msg IOError
e) =
        String
"IO exception:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ IOError -> String
forall a. Show a => a -> String
show IOError
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\narose while trying to send message:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
LazyByteString.unpack (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Value
msg)