Provides for a slightly more composable structure for websocket apps:
data Input = Increment | Decrement
deriving (FromJSON)
data Output = Value Int
deriving (ToJSON)
myApp :: MonadBaseControl IO m => m (WebSocketsApp m Input Output)
myApp = do
countRef <- liftIO $ newIORef 0
emitter <- liftIO $ newIORef (Nothing :: Async ())
let killEmitter = do
mThread <- liftIO $ readIORef emitter
case mThread of
Nothing -> pure ()
Just thread -> cancel thread
pure WebSocketsApp
{ onOpen = \WebSocketsAppParams{send} ->
liftBaseWith $ \runInBase -> do
thread <- async $ forever $ do
count <- readIORef countRef
runInBase $ send $ Value count
threadDelay 1000000 -- every second, emit the current value
writeIORef emitter (Just thread)
, onReceive = \WebSocketsAppParams{send,close} x -> do
count <- liftIO $
( modifyIORef countRef $ case x of
Increment -> (+ 1)
Decrement -> (-) 1
) *> readIORef countRef
if count >= 10 || count <= -10
then close
else send (Value count)
, onClose = \mReason -> do
killEmitter
case mReason of
Nothing -> liftIO $ writeIORef countRef 0
Just _ -> pure ()
}