X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=lib%2FLanguage%2FHaskell%2FLSP%2FTest%2FMachine.hs;fp=lib%2FLanguage%2FHaskell%2FLSP%2FTest%2FMachine.hs;h=f407c7d7d44e5a4359c42972b4c0de9356a30f25;hb=ae334dce13ab47fd20b976a17b1f296e082c7531;hp=0000000000000000000000000000000000000000;hpb=92f1ae3d69a580eee74755a38a647e27c4f164ff;p=lsp-test.git

diff --git a/lib/Language/Haskell/LSP/Test/Machine.hs b/lib/Language/Haskell/LSP/Test/Machine.hs
new file mode 100644
index 0000000..f407c7d
--- /dev/null
+++ b/lib/Language/Haskell/LSP/Test/Machine.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Language.Haskell.LSP.Test.Machine where
+
+import Control.Monad.IO.Class
+import Language.Haskell.LSP.Messages
+import Language.Haskell.LSP.Test
+
+data State = State String (FromServerMessage -> Bool) [Session ()] State
+           | Passed
+           | Failed
+
+data Event = Timeout | Received FromServerMessage
+
+advance :: State -> Event -> Session State
+advance _ Timeout = return Failed
+advance s@(State name f actions next) (Received msg)
+  | f msg = do
+    liftIO $ putStrLn name
+    sequence_ actions
+    return next
+  | otherwise = return s
+advance s _ = return s
+
+mkStates [] = Passed
+mkStates ((n, f, msgs):xs) = State n f msgs (mkStates xs)
+
+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"
+      _ -> return "failed"
+