lib/Language/Haskell/LSP/Test/Machine.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Language.Haskell.LSP.Test.Machine where
   3
   4 import Control.Monad.IO.Class
   5 import Language.Haskell.LSP.Messages
   6 import Language.Haskell.LSP.Test
   7
   8 data State = State String (FromServerMessage -> Bool) [Session ()] State
   9            | Passed
  10            | Failed
  11
  12 data Event = Timeout | Received FromServerMessage
  13
  14 advance :: State -> Event -> Session State
  15 advance _ Timeout = return Failed
  16 advance s@(State name f actions next) (Received msg)
  17   | f msg = do
  18     liftIO $ putStrLn name
  19     sequence_ actions
  20     return next
  21   | otherwise = return s
  22 advance s _ = return s
  23
  24 mkStates [] = Passed
  25 mkStates ((n, f, msgs):xs) = State n f msgs (mkStates xs)
  26
  27 runMachine :: String -> [(String, FromServerMessage -> Bool, [Session ()])] -> IO String
  28 runMachine rootDir encodedStates =
  29   runSession "hie --lsp" rootDir $ do
  30     let f Passed = return Passed
  31         f s = Received <$> anyMessage >>= advance s >>= f
  32         initState = mkStates encodedStates
  33     res <- f initState
  34     case res of
  35       Passed -> return "passed"
  36       _ -> return "failed"
  37