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
  | UnexpectedResponseError SomeLspId ResponseError
  | UnexpectedServerTermination
  | IllegalInitSequenceMessage FromServerMessage
  | MessageSendError Value IOError
  deriving (SessionException -> SessionException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionException -> SessionException -> Bool
$c/= :: SessionException -> SessionException -> Bool
== :: SessionException -> SessionException -> Bool
$c== :: 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."
      forall a. [a] -> [a] -> [a]
++ case Maybe FromServerMessage
lastMsg of
        Just FromServerMessage
msg -> String
"\nLast message received:\n" forall a. [a] -> [a] -> [a]
++ ByteString -> String
B.unpack (forall a. ToJSON a => a -> ByteString
encodePretty FromServerMessage
msg)
        Maybe FromServerMessage
Nothing -> 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"
      forall a. [a] -> [a] -> [a]
++ String
"Was parsing: "
      forall a. [a] -> [a] -> [a]
++ String
expected
      forall a. [a] -> [a] -> [a]
++ String
"\n"
      forall a. [a] -> [a] -> [a]
++ String
"But the last message received was:\n"
      forall a. [a] -> [a] -> [a]
++ ByteString -> String
B.unpack (forall a. ToJSON a => a -> ByteString
encodePretty FromServerMessage
lastMsg)
  show (ReplayOutOfOrder FromServerMessage
received [FromServerMessage]
expected) =
    let expected' :: [FromServerMessage]
expected' = forall a. Eq a => [a] -> [a]
nub [FromServerMessage]
expected
        getJsonDiff :: FromServerMessage -> [String]
getJsonDiff = String -> [String]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encodePretty
        showExp :: FromServerMessage -> String
showExp FromServerMessage
exp =
          ByteString -> String
B.unpack (forall a. ToJSON a => a -> ByteString
encodePretty FromServerMessage
exp)
            forall a. [a] -> [a] -> [a]
++ String
"\nDiff:\n"
            forall a. [a] -> [a] -> [a]
++ [Diff [String]] -> String
ppDiff (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"
          forall a. [a] -> [a] -> [a]
++
          -- Print json so its a bit easier to update the session logs
          String
"Received from server:\n"
          forall a. [a] -> [a] -> [a]
++ ByteString -> String
B.unpack (forall a. ToJSON a => a -> ByteString
encodePretty FromServerMessage
received)
          forall a. [a] -> [a] -> [a]
++ String
"\n"
          forall a. [a] -> [a] -> [a]
++ String
"Raw from server:\n"
          forall a. [a] -> [a] -> [a]
++ ByteString -> String
B.unpack (forall a. ToJSON a => a -> ByteString
encode FromServerMessage
received)
          forall a. [a] -> [a] -> [a]
++ String
"\n"
          forall a. [a] -> [a] -> [a]
++ String
"Expected one of:\n"
          forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (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"
      forall a. [a] -> [a] -> [a]
++ String
msgStr
  show (UnexpectedResponseError SomeLspId
lid ResponseError
e) =
    String
"Received an expected error in a response for id "
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SomeLspId
lid
      forall a. [a] -> [a] -> [a]
++ String
":\n"
      forall a. [a] -> [a] -> [a]
++ 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"
      forall a. [a] -> [a] -> [a]
++ ByteString -> String
B.unpack (forall a. ToJSON a => a -> ByteString
encodePretty FromServerMessage
msg)
  show (MessageSendError Value
msg IOError
e) =
    String
"IO exception:\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IOError
e forall a. [a] -> [a] -> [a]
++ String
"\narose while trying to send message:\n" forall a. [a] -> [a] -> [a]
++ ByteString -> String
B.unpack (forall a. ToJSON a => a -> ByteString
encodePretty Value
msg)

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