Hook LSP script into haskell-lsp-test

[lsp-test.git] / src / Language / Haskell / LSP / Test / Machine.hs

diff --git a/src/Language/Haskell/LSP/Test/Machine.hs b/src/Language/Haskell/LSP/Test/Machine.hs
index f3055701ad0567cd51fb83a2c3b4cfabd8a1be36..f407c7d7d44e5a4359c42972b4c0de9356a30f25 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Machine.hs
+++ b/src/Language/Haskell/LSP/Test/Machine.hs
@@ -3,12 +3,9 @@ module Language.Haskell.LSP.Test.Machine where
 
 import Control.Monad.IO.Class
 import Language.Haskell.LSP.Messages
-import Language.Haskell.LSP.Types
 import Language.Haskell.LSP.Test
-import Language.Haskell.LSP.Test.Messages
-import Language.Haskell.LSP.Test.Session
 
-data State = State String (FromServerMessage -> Bool) [FromClientMessage] State
+data State = State String (FromServerMessage -> Bool) [Session ()] State
            | Passed
            | Failed
 
@@ -16,10 +13,10 @@ data Event = Timeout | Received FromServerMessage
 
 advance :: State -> Event -> Session State
 advance _ Timeout = return Failed
-advance s@(State name f outMsgs next) (Received msg)
+advance s@(State name f actions next) (Received msg)
   | f msg = do
     liftIO $ putStrLn name
-    mapM_ (handleClientMessage sendRequestMessage sendMessage sendMessage) outMsgs
+    sequence_ actions
     return next
   | otherwise = return s
 advance s _ = return s
@@ -27,18 +24,12 @@ advance s _ = return s
 mkStates [] = Passed
 mkStates ((n, f, msgs):xs) = State n f msgs (mkStates xs)
 
-main = let symbReq = ReqDocumentSymbols (RequestMessage "2.0" (IdInt 24) TextDocumentDocumentSymbol (DocumentSymbolParams (TextDocumentIdentifier (filePathToUri "/Users/luke/Desktop/test/src/Lib.hs"))))
-           barPred (RspDocumentSymbols _) = True
-           barPred _ = False
-           encoded = [("start", const True, [symbReq])
-                     ,("silent", barPred, [])
-                     ,("end", const True, [])]
-           initState = mkStates encoded
-        in
-          runSession "hie --lsp" "/Users/luke/Desktop/test" $ do
-            openDoc "src/Lib.hs" "haskell"
+runMachine :: String -> [(String, FromServerMessage -> Bool, [Session ()])] -> IO String
+runMachine rootDir encodedStates =
+  runSession "hie --lsp" rootDir $ do
     let f Passed = return Passed
         f s = Received <$> anyMessage >>= advance s >>= f
+        initState = mkStates encodedStates
     res <- f initState
     case res of
       Passed -> return "passed"