From 50abccd8a4243c561cc39c54f84ddfaae8c73120 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt
Date: Tue, 18 Aug 2020 14:40:10 +0200
Subject: Refactor: remove BaseUrl

---
 server/lib/Uplcg/Views.hs | 29 +++++++++++------------------
 1 file changed, 11 insertions(+), 18 deletions(-)

(limited to 'server/lib/Uplcg/Views.hs')

diff --git a/server/lib/Uplcg/Views.hs b/server/lib/Uplcg/Views.hs
index fc7042b..d25a9ce 100644
--- a/server/lib/Uplcg/Views.hs
+++ b/server/lib/Uplcg/Views.hs
@@ -13,34 +13,30 @@ import qualified Data.Text.Encoding           as T
 import qualified Network.HTTP.Types.URI       as HttpUri
 import qualified Text.Blaze.Html5             as H
 import qualified Text.Blaze.Html5.Attributes  as A
-import qualified Uplcg.BaseUrl                as BaseUrl
-import           Uplcg.Config
 import           Uplcg.Version                (version)
 
 data RoomView = RoomView Text Bool Int
 
-template :: Config -> Text -> H.Html -> H.Html
-template conf title body = H.docTypeHtml $ do
+template :: Text -> H.Html -> H.Html
+template title body = 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 (cBaseUrl conf) <> "/assets/style.css")
+            H.! A.href "/assets/style.css"
         H.title $ H.toHtml title
         H.meta H.! A.name "viewport" H.! A.content "width=device-width"
     H.body $ do
         body
         H.footer $ "Untitled PL Card Game version " <> H.toHtml version
 
-rooms :: Config -> [RoomView] -> H.Html
-rooms conf rids = template conf "Untitled PL Card Game" $
+rooms :: [RoomView] -> H.Html
+rooms rids = template "Untitled PL Card Game" $
     H.div H.! A.class_ "rooms" $ do
         H.h1 "Rooms"
         if null rids
             then H.p "No rooms online."
             else H.ul $ for_ rids $ \(RoomView rid lock num) -> H.li $ do
-                H.a H.! A.href (H.toValue $
-                        BaseUrl.render (cBaseUrl conf) <> "/rooms/" <> rid) $
+                H.a H.! A.href (H.toValue $ "/rooms/" <> rid) $
                     H.toHtml rid
                 when lock  " 🔒"
                 " ("
@@ -49,8 +45,7 @@ rooms conf rids = template conf "Untitled PL Card Game" $
 
         H.br
         H.h1 "Create Room"
-        H.form H.! A.method "POST" H.! A.action (H.toValue $
-                BaseUrl.render (cBaseUrl conf) <> "/rooms") $ do
+        H.form H.! A.method "POST" H.! A.action "/rooms" $ do
             H.label H.! A.for "name" $ "Room name: "
             H.input H.! A.type_ "text" H.! A.name "id"
             H.br
@@ -59,12 +54,11 @@ rooms conf rids = template conf "Untitled PL Card Game" $
             H.br
             H.input H.! A.type_ "submit" H.! A.value "Create room"
 
-client :: Config -> Text -> Maybe Text -> H.Html
-client conf roomId mbPassword = template conf "Untitled PL Card Game" $ do
+client :: Text -> Maybe Text -> H.Html
+client roomId mbPassword = template "Untitled PL Card Game" $ do
     H.div H.! A.id "main" $ ""
     H.script H.! A.type_ "text/JavaScript"
-        H.! A.src (H.toValue $
-            BaseUrl.render (cBaseUrl conf) <> "/assets/client.js") $ ""
+        H.! A.src "/assets/client.js" $ ""
     H.script H.! A.type_ "text/JavaScript" $ H.unsafeLazyByteString entryPoint
   where
     t2b = BLB.byteString . T.encodeUtf8
@@ -77,8 +71,7 @@ client conf roomId mbPassword = template conf "Untitled PL Card Game" $ do
       "    protocol = 'wss:'" <>
       "  }" <>
       "  var url = protocol + '//' + document.location.host +" <>
-      "    '" <> t2b (BaseUrl.render $ cBaseUrl conf) <> "/rooms/" <>
-          t2b roomId <> "/events" <>
+      "    '/rooms/" <> t2b roomId <> "/events" <>
           (case mbPassword of
               Nothing -> ""
               Just pwd -> BLB.byteString $ HttpUri.renderSimpleQuery True
-- 
cgit v1.2.3