content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE QuasiQuotes #-}
  {-# LANGUAGE TemplateHaskell #-}
  {-# LANGUAGE TypeFamilies #-}
  
  import Control.Concurrent (threadDelay)
  import Control.Concurrent.STM.Lifted
  import Control.Monad (forever)
  import Control.Monad.Trans.Reader
  import Data.Conduit
  import Data.Conduit.List qualified as CL
  import Data.Monoid ((<>))
  import Data.Text (Text)
  import Data.Text.Lazy qualified as TL
  import Data.Time
  import Yesod.Core
  import Yesod.WebSockets
  
  {-# ANN type App ("HLint: ignore Use newtype instead of data" :: String) #-}
  data App = App (TChan Text)
  
  mkYesod "App" [parseRoutes|
  / HomeR GET
  |]
  
  instance Yesod App
  
  chatApp :: WebSocketsT Handler ()
  chatApp = do
      sendTextData ("Welcome to the chat server, please enter your name." :: Text)
      name <- receiveData
      sendTextData $ "Welcome, " <> name
      App writeChan <- getYesod
      readChan <- atomically $ do
          writeTChan writeChan $ name <> " has joined the chat"
          dupTChan writeChan
      race_
          (forever $ atomically (readTChan readChan) >>= sendTextData)
          (runConduit $ sourceWS .| CL.mapM_ (\msg ->
              atomically $ writeTChan writeChan $ name <> ": " <> msg))
  
  getHomeR :: Handler Html
  getHomeR = do
      webSockets chatApp
      defaultLayout $ do
          [whamlet|
              <div #output>
              <form #form>
                  <input #input autofocus>
          |]
          toWidget [lucius|
              \#output {
                  width: 600px;
                  height: 400px;
                  border: 1px solid black;
                  margin-bottom: 1em;
                  p {
                      margin: 0 0 0.5em 0;
                      padding: 0 0 0.5em 0;
                      border-bottom: 1px dashed #99aa99;
                  }
              }
              \#input {
                  width: 600px;
                  display: block;
              }
          |]
          toWidget [julius|
              var url = document.URL,
                  output = document.getElementById("output"),
                  form = document.getElementById("form"),
                  input = document.getElementById("input"),
                  conn;
  
              url = url.replace("http:", "ws:").replace("https:", "wss:");
              conn = new WebSocket(url);
  
              conn.onmessage = function(e) {
                  var p = document.createElement("p");
                  p.appendChild(document.createTextNode(e.data));
                  output.appendChild(p);
              };
  
              form.addEventListener("submit", function(e){
                  conn.send(input.value);
                  input.value = "";
                  e.preventDefault();
              });
          |]
  
  main :: IO ()
  main = do
      chan <- atomically newBroadcastTChan
      warpEnv $ App chan
  