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

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