{-# LANGUAGE OverloadedStrings #-} module Main (main) where import GHC.RTS.Events.Loopback import Control.Monad import Debug.Trace import Data.IORef import Control.Concurrent import System.Exit import GHC.RTS.Events.Incremental import GHC.RTS.Events (EventInfo(UserMessage), evSpec) main :: IO () main = do state <- newIORef decodeEventLog events <- newIORef [] let go bs = do s <- readIORef state let s' = case s of Consume feed -> feed bs _ -> error "impossible" s'' <- produceAll s' writeIORef state $! s'' produceAll (Produce ev k) = modifyIORef' events (ev:) >> produceAll k produceAll (Error _ emsg) = error $ "Failed to parse: " ++ emsg produceAll k = pure k start void . forkIO . forever $ readEventLogChunk >>= go traceEventIO "foo bar baz" flushEventLog traceEventIO "foo bar baz" flushEventLog threadDelay 100 evs <- readIORef events case length . filter (findExpectedMessage . evSpec) $ evs of 2 -> putStrLn "Success" >> exitSuccess x -> do putStrLn $ "expected 2 but got " ++ show x exitFailure findExpectedMessage :: EventInfo -> Bool findExpectedMessage (UserMessage "foo bar baz") = True findExpectedMessage _ = False