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
  deriving SessionException -> SessionException -> Bool
(SessionException -> SessionException -> Bool)
-> (SessionException -> SessionException -> Bool)
-> Eq SessionException
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." 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 SomeLspId
lid ResponseError
e) = String
"Received an exepected 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
B.unpack (FromServerMessage -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty FromServerMessage
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