X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FParsing.hs;h=3496322ca6ff0f8d95bd799fb23ffc219484c04e;hb=edee40c4aba2607c652cace2da780c373612665f;hp=49c24c9ae52715862a05baf0cfbe294ef04a6a82;hpb=f5e627c1912bc66b7b8bb2c1a389b59fb34de883;p=opengl.git diff --git a/src/Language/Haskell/LSP/Test/Parsing.hs b/src/Language/Haskell/LSP/Test/Parsing.hs index 49c24c9..3496322 100644 --- a/src/Language/Haskell/LSP/Test/Parsing.hs +++ b/src/Language/Haskell/LSP/Test/Parsing.hs @@ -8,7 +8,6 @@ import Control.Applicative import Control.Concurrent.Chan import Control.Concurrent.MVar import Control.Monad.Trans.Class -import Control.Monad.IO.Class import Control.Monad.Trans.Reader import Control.Monad.Trans.State import Data.Aeson @@ -17,7 +16,7 @@ import Data.Conduit hiding (await) import Data.Conduit.Parser import Data.Maybe import Language.Haskell.LSP.Messages -import Language.Haskell.LSP.Types +import Language.Haskell.LSP.Types hiding (error) import Language.Haskell.LSP.Test.Compat import Language.Haskell.LSP.Test.Decoding import Language.Haskell.LSP.Test.Messages @@ -59,7 +58,7 @@ notification :: forall m a. (Monad m, FromJSON a) => ConduitParser FromServerMes notification = do let parser = decode . encodeMsg :: FromServerMessage -> Maybe (NotificationMessage ServerMethod a) x <- satisfy (isJust . parser) - return $ fromJust $ decode $ encodeMsg x + return $ decodeMsg $ encodeMsg x -- | Matches if the message is a request. anyRequest :: Monad m => ConduitParser FromServerMessage m FromServerMessage @@ -69,7 +68,7 @@ request :: forall m a b. (Monad m, FromJSON a, FromJSON b) => ConduitParser From request = do let parser = decode . encodeMsg :: FromServerMessage -> Maybe (RequestMessage ServerMethod a b) x <- satisfy (isJust . parser) - return $ fromJust $ decode $ encodeMsg x + return $ decodeMsg $ encodeMsg x -- | Matches if the message is a response. anyResponse :: Monad m => ConduitParser FromServerMessage m FromServerMessage @@ -79,13 +78,17 @@ response :: forall m a. (Monad m, FromJSON a) => ConduitParser FromServerMessage response = do let parser = decode . encodeMsg :: FromServerMessage -> Maybe (ResponseMessage a) x <- satisfy (isJust . parser) - return $ fromJust $ decode $ encodeMsg x + return $ decodeMsg $ encodeMsg x -- | A version of encode that encodes FromServerMessages as if they -- weren't wrapped. encodeMsg :: FromServerMessage -> B.ByteString encodeMsg = encode . genericToJSON (defaultOptions { sumEncoding = UntaggedValue }) +decodeMsg :: FromJSON a => B.ByteString -> a +decodeMsg x = fromMaybe (error $ "Unexpected message type\nGot:\n " ++ show x) + (decode x) + -- | Matches if the message is a log message notification or a show message notification/request. loggingNotification :: Monad m => ConduitParser FromServerMessage m FromServerMessage loggingNotification = satisfy shouldSkip