module Language.LSP.Test.Exceptions where

import Control.Exception
import Data.Aeson
import Data.Aeson.Encode.Pretty
import Data.Algorithm.Diff
import Data.Algorithm.DiffOutput
import Data.ByteString.Lazy.Char8 qualified as B
import Data.List
import Language.LSP.Protocol.Message

-- | An exception that can be thrown during a 'Haskell.LSP.Test.Session.Session'
data SessionException
  = Timeout (Maybe FromServerMessage)
  | NoContentLengthHeader
  | UnexpectedMessage String FromServerMessage
  | ReplayOutOfOrder FromServerMessage [FromServerMessage]
  | UnexpectedDiagnostics
  | IncorrectApplyEditRequest String
  | forall m. Show (ErrorData m) => UnexpectedResponseError (LspId m) (TResponseError m)
  | UnexpectedServerTermination
  | IllegalInitSequenceMessage FromServerMessage
  | MessageSendError Value IOError

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
B.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
B.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 = String -> [String]
lines (String -> [String])
-> (FromServerMessage -> String) -> FromServerMessage -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.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
exp =
          ByteString -> String
B.unpack (FromServerMessage -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty FromServerMessage
exp)
            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
exp))
     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
B.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
B.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 LspId m
lid TResponseError m
e) =
    String
"Received an expected error in a response for id "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ LspId m -> String
forall a. Show a => a -> String
show LspId m
lid
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ TResponseError m -> String
forall a. Show a => a -> String
show TResponseError m
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
B.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
B.unpack (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Value
msg)

-- | A predicate that matches on any 'SessionException'
anySessionException :: SessionException -> Bool
anySessionException :: SessionException -> Bool
anySessionException = Bool -> SessionException -> Bool
forall a b. a -> b -> a
const Bool
True