module Language.LSP.Test.Exceptions where

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

-- | 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