Start work on parser

[opengl.git] / src / Language / Haskell / LSP / Test / Parsing.hs

diff --git a/src/Language/Haskell/LSP/Test/Parsing.hs b/src/Language/Haskell/LSP/Test/Parsing.hs
index c29e0f3a2a44b69d875b823cea21d42a183c9fd5..de2ca860e65622c014ee0a85a8ecae9e8c2a1185 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Parsing.hs
+++ b/src/Language/Haskell/LSP/Test/Parsing.hs
@@ -1,39 +1,32 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Language.Haskell.LSP.Test.Parsing where
 
-import qualified Data.ByteString.Lazy.Char8    as B
-import System.IO
-
-getAllMessages :: Handle -> IO [B.ByteString]
-getAllMessages h = do
-  done <- hIsEOF h
-  if done
-    then return []
-    else do
-      msg <- getNextMessage h
-
-      (msg :) <$> getAllMessages h
-
--- | Fetches the next message bytes based on
--- the Content-Length header
-getNextMessage :: Handle -> IO B.ByteString
-getNextMessage h = do
-  headers <- getHeaders h
-  case read . init <$> lookup "Content-Length" headers of
-    Nothing   -> error "Couldn't read Content-Length header"
-    Just size -> B.hGet h size
-    
-addHeader :: B.ByteString -> B.ByteString
-addHeader content = B.concat
-  [ "Content-Length: "
-  , B.pack $ show $ B.length content
-  , "\r\n"
-  , "\r\n"
-  , content
-  ]
-
-getHeaders :: Handle -> IO [(String, String)]
-getHeaders h = do
-  l <- hGetLine h
-  let (name, val) = span (/= ':') l
-  if null val then return [] else ((name, drop 2 val) :) <$> getHeaders h
+import Language.Haskell.LSP.Messages
+import Language.Haskell.LSP.Types
+import Language.Haskell.LSP.Test.Messages
+import Text.Parsec hiding (satisfy)
+
+data MessageParserState = MessageParserState
+
+type MessageParser = Parsec [FromServerMessage] MessageParserState
+
+notification :: MessageParser FromServerMessage
+notification = satisfy isServerNotification
+
+request :: MessageParser FromServerMessage
+request = satisfy isServerRequest
+
+response :: MessageParser FromServerMessage
+response = satisfy isServerResponse
+
+satisfy :: (Stream s m a, Eq a, Show a) => (a -> Bool) -> ParsecT s u m a
+satisfy pred = tokenPrim show nextPos test
+  where nextPos x _ _ = x
+        test x = if pred x then Just x else Nothing
+
+testLog = NotLogMessage (NotificationMessage "2.0" WindowLogMessage (LogMessageParams MtLog "Hello world"))
+
+testSymbols = RspDocumentSymbols (ResponseMessage "2.0" (IdRspInt 0) (Just (List [])) Nothing)
+
+parseMessages :: MessageParser a -> [FromServerMessage] -> Either ParseError a
+parseMessages parser = runP parser MessageParserState ""
\ No newline at end of file