Last active
August 15, 2023 05:04
-
-
Save halogenandtoast/d29a2c44976fbeb6429bacec868c30d3 to your computer and use it in GitHub Desktop.
Simple Yesod Websocket Example
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# LANGUAGE OverloadedStrings #-} | |
| {-# LANGUAGE QuasiQuotes #-} | |
| {-# LANGUAGE TemplateHaskell #-} | |
| {-# LANGUAGE TypeFamilies #-} | |
| {-# OPTIONS_GHC -Wno-unused-top-binds #-} | |
| import Conduit | |
| import Control.Monad (forever) | |
| import Data.Text (Text) | |
| import UnliftIO.STM | |
| import Yesod.Core | |
| import Yesod.WebSockets | |
| newtype App = App | |
| { chan :: TChan Text | |
| } | |
| mkYesod | |
| "App" | |
| [parseRoutes| | |
| / HomeR GET | |
| |] | |
| instance Yesod App | |
| handleSocket :: WebSocketsT Handler () | |
| handleSocket = do | |
| writeChannel <- chan <$> lift getYesod | |
| readChannel <- atomically $ dupTChan writeChannel | |
| race_ | |
| (forever $ atomically (readTChan readChannel) >>= sendTextData) | |
| (runConduit $ sourceWS .| mapM_C (atomically . writeTChan writeChannel)) | |
| getHomeR :: Handler () | |
| getHomeR = do | |
| webSockets handleSocket | |
| pure () | |
| main :: IO () | |
| main = do | |
| c <- atomically newTChan | |
| warp 3000 (App c) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment