aboutsummaryrefslogtreecommitdiff
path: root/server/lib/Uplcg
diff options
context:
space:
mode:
authorJasper Van der Jeugt2020-08-14 10:49:36 +0200
committerJasper Van der Jeugt2020-08-14 10:49:36 +0200
commitb250aa81e332c612551803d0d156246b853b3fd3 (patch)
tree05248dda2bc71df3858b93e352facc2b6848cd5d /server/lib/Uplcg
parentce06b07d6dae781fe09e4b0512a9b6d41ba687a6 (diff)
Actually list rooms
Diffstat (limited to 'server/lib/Uplcg')
-rw-r--r--server/lib/Uplcg/Main/Server.hs5
-rw-r--r--server/lib/Uplcg/Views.hs7
2 files changed, 11 insertions, 1 deletions
diff --git a/server/lib/Uplcg/Main/Server.hs b/server/lib/Uplcg/Main/Server.hs
index 72d9614..bd2b3ec 100644
--- a/server/lib/Uplcg/Main/Server.hs
+++ b/server/lib/Uplcg/Main/Server.hs
@@ -23,6 +23,7 @@ import Data.String (fromString)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
+import qualified Data.Text.Lazy as TL
import qualified Data.Vector as V
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
@@ -82,6 +83,10 @@ parseRoomId txt
scottyApp :: Server -> IO Wai.Application
scottyApp server = Scotty.scottyApp $ do
+ Scotty.get "/" $
+ Scotty.redirect $ TL.fromStrict $
+ BaseUrl.render (serverBaseUrl server) <> "/rooms"
+
Scotty.get "/rooms" $ do
rooms <- liftIO . MVar.readMVar $ serverRooms server
Scotty.html . renderHtml . Views.rooms (serverBaseUrl server) $
diff --git a/server/lib/Uplcg/Views.hs b/server/lib/Uplcg/Views.hs
index 91b03ff..90716c1 100644
--- a/server/lib/Uplcg/Views.hs
+++ b/server/lib/Uplcg/Views.hs
@@ -3,6 +3,7 @@ module Uplcg.Views
( rooms
) where
+import Data.Foldable (for_)
import Data.Text (Text)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
@@ -10,10 +11,14 @@ import Uplcg.BaseUrl (BaseUrl)
import qualified Uplcg.BaseUrl as BaseUrl
rooms :: BaseUrl -> [Text] -> H.Html
-rooms base _ids = H.docTypeHtml $ do
+rooms base rids = H.docTypeHtml $ do
H.head $ do
H.meta H.! A.charset "UTF-8"
H.link H.! A.rel "stylesheet" H.! A.type_ "text/css"
H.! A.href (H.toValue $ BaseUrl.render base <> "/assets/style.css")
H.body $ do
+ H.h1 "Rooms"
+ H.ul $ for_ rids $ \rid -> H.li $
+ H.a H.! A.href (H.toValue $ BaseUrl.render base <> "/rooms/" <> rid) $
+ H.toHtml rid
H.footer $ "Untitled PL Card Game"