Events.hs

{-# LANGUAGE OverloadedStrings #-}
module Handler.Events where

import Control.Concurrent.STM
import Data.Text as T
import Import
import Network.Wai
import Network.Wai.EventSource (ServerEvent (..), eventSourceAppIO)

getEventsR :: Handler ()
getEventsR = do
  $(logDebug) "EVENTS"
  chan0 <- getEventsChan <$> getYesod
  chan <- liftIO $ atomically $ dupTChan chan0
  req <- waiRequest
  runInnerHandler <- handlerToIO
  res <- lift $ (eventSourceAppIO (runInnerHandler $ readCh chan)) req
  sendWaiResponse res

readCh :: TChan ServerEvent -> Handler ServerEvent
readCh chan = do
  $(logDebug) "------READING CHANNEL------"
  liftIO $ atomically $ readTChan chan