From b250aa81e332c612551803d0d156246b853b3fd3 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt
Date: Fri, 14 Aug 2020 10:49:36 +0200
Subject: Actually list rooms

---
 server/lib/Uplcg/Main/Server.hs | 5 +++++
 server/lib/Uplcg/Views.hs       | 7 ++++++-
 2 files changed, 11 insertions(+), 1 deletion(-)

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"
-- 
cgit v1.2.3