From: Luke Lau <luke_lau@icloud.com>
Date: Fri, 6 Jul 2018 23:17:05 +0000 (+0100)
Subject: Add ability to replay from exe
X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=commitdiff_plain;h=54b23e6b7a8aa59e649a807ab286f0808908935a

Add ability to replay from exe
---

diff --git a/lib/Language/Haskell/LSP/Test/Machine.hs b/lib/Language/Haskell/LSP/Test/Machine.hs
index f407c7d..7e0a78d 100644
--- a/lib/Language/Haskell/LSP/Test/Machine.hs
+++ b/lib/Language/Haskell/LSP/Test/Machine.hs
@@ -24,14 +24,14 @@ 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
+runMachine :: String -> FilePath -> [(String, FromServerMessage -> Bool, [Session ()])] -> IO Bool
+runMachine cmd rootDir encodedStates =
+  runSession cmd 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"
+      Passed -> return True
+      _ -> return False
 
diff --git a/lsp-test/Main.hs b/lsp-test/Main.hs
index 6dc0690..ec9cfa4 100644
--- a/lsp-test/Main.hs
+++ b/lsp-test/Main.hs
@@ -9,20 +9,29 @@ import           Language.Haskell.LSP.Test.Script
 import           System.Environment
 import           System.FilePath
 import           System.Directory
+import           System.Exit
 import           Language.Haskell.LSP.Test.Machine
-import           Language.Haskell.LSP.Test.Parsing ( toJSONMsg )
+import           Language.Haskell.LSP.Test.Parsing
+                                                ( toJSONMsg )
+import           Language.Haskell.LSP.Test.Replay
 import           Language.Haskell.LSP.Messages
 import qualified Language.Haskell.LSP.Types    as LSP
 
 main = do
-  fileName <- head <$> getArgs
-  blocks <- parseScript <$> readFile fileName
-  print blocks
-  rootDir <- getCurrentDirectory
-  runBlocks rootDir blocks
-
-runBlocks :: FilePath -> [Block] -> IO ()
-runBlocks rootDir blocks = runMachine rootDir (map convertBlock blocks) >>= putStrLn
+  args <- getArgs
+  curDir <- getCurrentDirectory
+  case args of
+    ["replay", cmd] -> replaySession cmd curDir
+    [file, cmd] -> do
+      blocks <- parseScript <$> readFile file
+      success <- runBlocks cmd curDir blocks
+      if success
+        then putStrLn "Success ✅"
+        else putStrLn "Failed ❌" >> exitFailure
+    _ -> putStrLn "usage: lsp-test (replay <cmd>)|(<file> <cmd>)"
+
+runBlocks :: String -> FilePath -> [Block] -> IO Bool
+runBlocks cmd rootDir blocks = runMachine cmd rootDir (map convertBlock blocks)
   where
     convertBlock :: Block -> (String, FromServerMessage -> Bool, [Session ()])
     convertBlock (Block name w actions) = (name, mkWait w, map mkAction actions)
diff --git a/test/data/script/Test.hs b/test/data/script/Test.hs
new file mode 100644
index 0000000..c1ac06e
--- /dev/null
+++ b/test/data/script/Test.hs
@@ -0,0 +1,3 @@
+foo = 3
+bar = False
+baz = "hello"
diff --git a/test.lsp b/test/data/script/test.lsp
similarity index 59%
rename from test.lsp
rename to test/data/script/test.lsp
index 954ca5b..52c0a95 100644
--- a/test.lsp
+++ b/test/data/script/test.lsp
@@ -1,12 +1,12 @@
-"start" { wait for any then open "src/Lib.hs" "haskell" }
+"start" { wait for any then open "Test.hs" "haskell" }
 "get the symbols" {
   wait for
     method == "textDocument/publishDiagnostics"
   then
-    open "src/Lib.hs" "haskell"
+    open "Test.hs" "haskell"
     id1: request "textDocument/documentSymbol" {
       textDocument: {
-        uri: uri "src/Lib.hs"
+        uri: uri "Test.hs"
       }
     }
 }
@@ -14,5 +14,5 @@
   wait for
     id == 1
   then
-    open "src/Lib.hs" "haskell"
+    open "Test.hs" "haskell"
 }