X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FMachine.hs;fp=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FMachine.hs;h=f407c7d7d44e5a4359c42972b4c0de9356a30f25;hp=f3055701ad0567cd51fb83a2c3b4cfabd8a1be36;hb=92f1ae3d69a580eee74755a38a647e27c4f164ff;hpb=4ad648fac174ce2b8475d24c2e4f215105e10e94 diff --git a/src/Language/Haskell/LSP/Test/Machine.hs b/src/Language/Haskell/LSP/Test/Machine.hs index f305570..f407c7d 100644 --- 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"