From ce06b07d6dae781fe09e4b0512a9b6d41ba687a6 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 14 Aug 2020 01:43:30 +0200 Subject: WIP --- server/lib/Uplcg/Views.hs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) create mode 100644 server/lib/Uplcg/Views.hs (limited to 'server/lib/Uplcg/Views.hs') diff --git a/server/lib/Uplcg/Views.hs b/server/lib/Uplcg/Views.hs new file mode 100644 index 0000000..91b03ff --- /dev/null +++ b/server/lib/Uplcg/Views.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} +module Uplcg.Views + ( rooms + ) where + +import Data.Text (Text) +import qualified Text.Blaze.Html5 as H +import qualified Text.Blaze.Html5.Attributes as A +import Uplcg.BaseUrl (BaseUrl) +import qualified Uplcg.BaseUrl as BaseUrl + +rooms :: BaseUrl -> [Text] -> H.Html +rooms base _ids = 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.footer $ "Untitled PL Card Game" -- cgit v1.2.3 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/Views.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'server/lib/Uplcg/Views.hs') 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 From 41622353bc3309921109f44bc0163e0987c20052 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 14 Aug 2020 17:32:00 +0200 Subject: List room num members --- server/lib/Uplcg/Views.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) (limited to 'server/lib/Uplcg/Views.hs') diff --git a/server/lib/Uplcg/Views.hs b/server/lib/Uplcg/Views.hs index 90716c1..ef4bc09 100644 --- a/server/lib/Uplcg/Views.hs +++ b/server/lib/Uplcg/Views.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Uplcg.Views - ( rooms + ( RoomView (..) + , rooms ) where import Data.Foldable (for_) @@ -10,7 +11,9 @@ import qualified Text.Blaze.Html5.Attributes as A import Uplcg.BaseUrl (BaseUrl) import qualified Uplcg.BaseUrl as BaseUrl -rooms :: BaseUrl -> [Text] -> H.Html +data RoomView = RoomView Text Int + +rooms :: BaseUrl -> [RoomView] -> H.Html rooms base rids = H.docTypeHtml $ do H.head $ do H.meta H.! A.charset "UTF-8" @@ -18,7 +21,10 @@ rooms base rids = H.docTypeHtml $ do 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.ul $ for_ rids $ \(RoomView rid num) -> H.li $ do H.a H.! A.href (H.toValue $ BaseUrl.render base <> "/rooms/" <> rid) $ H.toHtml rid + " (" + H.toHtml num + ")" H.footer $ "Untitled PL Card Game" -- cgit v1.2.3 From 9f2d12f0b098a365d7b0d4cc00b03fd2e5284740 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Sun, 16 Aug 2020 10:21:14 +0200 Subject: WIP --- server/lib/Uplcg/Views.hs | 80 ++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 68 insertions(+), 12 deletions(-) (limited to 'server/lib/Uplcg/Views.hs') diff --git a/server/lib/Uplcg/Views.hs b/server/lib/Uplcg/Views.hs index ef4bc09..3cb9ebe 100644 --- a/server/lib/Uplcg/Views.hs +++ b/server/lib/Uplcg/Views.hs @@ -8,23 +8,79 @@ import Data.Foldable (for_) import Data.Text (Text) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A -import Uplcg.BaseUrl (BaseUrl) +import qualified Data.ByteString.Lazy.Builder as BLB import qualified Uplcg.BaseUrl as BaseUrl +import Uplcg.Config data RoomView = RoomView Text Int -rooms :: BaseUrl -> [RoomView] -> H.Html -rooms base rids = H.docTypeHtml $ do +template :: Config -> Text -> H.Html -> H.Html +template conf 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 base <> "/assets/style.css") + H.! A.href (H.toValue $ + BaseUrl.render (cBaseUrl conf) <> "/assets/style.css") + H.title $ H.toHtml title + H.meta H.! A.name "viewport" H.! A.content "width=device-width" H.body $ do - H.h1 "Rooms" - H.ul $ for_ rids $ \(RoomView rid num) -> H.li $ do - H.a H.! A.href (H.toValue $ BaseUrl.render base <> "/rooms/" <> rid) $ - H.toHtml rid - " (" - H.toHtml num - ")" - H.footer $ "Untitled PL Card Game" + body + H.footer $ "Untitled PL Card Game version " <> H.toHtml (cVersion conf) + +rooms :: Config -> [RoomView] -> H.Html +rooms conf rids = template conf "Untitled PL Card Game" $ do + H.h1 "Rooms" + H.ul $ for_ rids $ \(RoomView rid num) -> H.li $ do + H.a H.! A.href (H.toValue $ + BaseUrl.render (cBaseUrl conf) <> "/rooms/" <> rid) $ + H.toHtml rid + " (" + H.toHtml num + ")" + +client :: Config -> Text -> H.Html +client conf roomId = template conf "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.script $ H.unsafeLazyByteString $ clientScript $ BLB.toLazyByteString $ + var app = Elm.Client.init({node: document.querySelector("main")}); + + function connect() { + var protocol = "ws:"; + if(document.location.protocol == "https:") { + protocol = "wss:" + } + var path = document.location.pathname; + if(path.startsWith("$UPLCG_BASE")) { + path = path.substr("$UPLCG_BASE".length); + } + var roomId = path.split("/")[2]; + var url = protocol + "//" + document.location.host + + "$UPLCG_BASE/rooms/" + roomId + "/events"; + + var socket = new WebSocket(url); + var socketSend = function(message) { + socket.send(message); + }; + app.ports.webSocketOut.subscribe(socketSend); + socket.onmessage = function(event) { + app.ports.webSocketIn.send(event.data); + }; + socket.onclose = function(event) { + app.ports.webSocketOut.unsubscribe(socketSend); + setTimeout(function() { + connect(); + }, 1000); + }; + socket.onerror = function(event) { + socket.close(); + }; + } + + connect(); + + + + -- cgit v1.2.3 From 5a3fc14c1a92b28423d1b64b64e12d0502a90219 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Sun, 16 Aug 2020 12:29:31 +0200 Subject: Move client to server --- server/lib/Uplcg/Views.hs | 88 ++++++++++++++++++++++------------------------- 1 file changed, 42 insertions(+), 46 deletions(-) (limited to 'server/lib/Uplcg/Views.hs') diff --git a/server/lib/Uplcg/Views.hs b/server/lib/Uplcg/Views.hs index 3cb9ebe..772c83b 100644 --- a/server/lib/Uplcg/Views.hs +++ b/server/lib/Uplcg/Views.hs @@ -2,15 +2,18 @@ module Uplcg.Views ( RoomView (..) , rooms + , client ) where -import Data.Foldable (for_) -import Data.Text (Text) -import qualified Text.Blaze.Html5 as H -import qualified Text.Blaze.Html5.Attributes as A import qualified Data.ByteString.Lazy.Builder as BLB -import qualified Uplcg.BaseUrl as BaseUrl +import Data.Foldable (for_) +import Data.Text (Text) +import qualified Data.Text.Encoding as T +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 Int @@ -25,7 +28,7 @@ template conf title body = H.docTypeHtml $ do 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 (cVersion conf) + H.footer $ "Untitled PL Card Game version " <> H.toHtml version rooms :: Config -> [RoomView] -> H.Html rooms conf rids = template conf "Untitled PL Card Game" $ do @@ -43,44 +46,37 @@ client conf roomId = template conf "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.script $ H.unsafeLazyByteString $ clientScript $ BLB.toLazyByteString $ - var app = Elm.Client.init({node: document.querySelector("main")}); + BaseUrl.render (cBaseUrl conf) <> "/assets/client.js") $ "" + H.script H.! A.type_ "text/JavaScript" $ H.unsafeLazyByteString entryPoint + where + t2b = BLB.byteString . T.encodeUtf8 + entryPoint = BLB.toLazyByteString $ + "var app = Elm.Client.init({node: document.querySelector('main')});" <> - function connect() { - var protocol = "ws:"; - if(document.location.protocol == "https:") { - protocol = "wss:" - } - var path = document.location.pathname; - if(path.startsWith("$UPLCG_BASE")) { - path = path.substr("$UPLCG_BASE".length); - } - var roomId = path.split("/")[2]; - var url = protocol + "//" + document.location.host + - "$UPLCG_BASE/rooms/" + roomId + "/events"; - - var socket = new WebSocket(url); - var socketSend = function(message) { - socket.send(message); - }; - app.ports.webSocketOut.subscribe(socketSend); - socket.onmessage = function(event) { - app.ports.webSocketIn.send(event.data); - }; - socket.onclose = function(event) { - app.ports.webSocketOut.unsubscribe(socketSend); - setTimeout(function() { - connect(); - }, 1000); - }; - socket.onerror = function(event) { - socket.close(); - }; - } - - connect(); - - - - + "function connect() {" <> + " var protocol = 'ws:';" <> + " if(document.location.protocol == 'https:') {" <> + " protocol = 'wss:'" <> + " }" <> + " var url = protocol + '//' + document.location.host +" <> + " '" <> t2b (BaseUrl.render $ cBaseUrl conf) <> "/rooms/" <> + t2b roomId <> "/events';" <> + " var socket = new WebSocket(url);" <> + " var socketSend = function(message) {" <> + " socket.send(message);" <> + " };" <> + " app.ports.webSocketOut.subscribe(socketSend);" <> + " socket.onmessage = function(event) {" <> + " app.ports.webSocketIn.send(event.data);" <> + " };" <> + " socket.onclose = function(event) {" <> + " app.ports.webSocketOut.unsubscribe(socketSend);" <> + " setTimeout(function() {" <> + " connect();" <> + " }, 1000);" <> + " };" <> + " socket.onerror = function(event) {" <> + " socket.close();" <> + " };" <> + "}" <> + "connect();" -- cgit v1.2.3 From d543ef8b1f68a23f9bc3706363fc3807ccbabf30 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Sun, 16 Aug 2020 12:33:21 +0200 Subject: Room list styling --- server/lib/Uplcg/Views.hs | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) (limited to 'server/lib/Uplcg/Views.hs') diff --git a/server/lib/Uplcg/Views.hs b/server/lib/Uplcg/Views.hs index 772c83b..8241158 100644 --- a/server/lib/Uplcg/Views.hs +++ b/server/lib/Uplcg/Views.hs @@ -31,15 +31,16 @@ template conf title body = H.docTypeHtml $ do H.footer $ "Untitled PL Card Game version " <> H.toHtml version rooms :: Config -> [RoomView] -> H.Html -rooms conf rids = template conf "Untitled PL Card Game" $ do - H.h1 "Rooms" - H.ul $ for_ rids $ \(RoomView rid num) -> H.li $ do - H.a H.! A.href (H.toValue $ - BaseUrl.render (cBaseUrl conf) <> "/rooms/" <> rid) $ - H.toHtml rid - " (" - H.toHtml num - ")" +rooms conf rids = template conf "Untitled PL Card Game" $ + H.div H.! A.class_ "rooms" $ do + H.h1 "Rooms" + H.ul $ for_ rids $ \(RoomView rid num) -> H.li $ do + H.a H.! A.href (H.toValue $ + BaseUrl.render (cBaseUrl conf) <> "/rooms/" <> rid) $ + H.toHtml rid + " (" + H.toHtml num + ")" client :: Config -> Text -> H.Html client conf roomId = template conf "Untitled PL Card Game" $ do -- cgit v1.2.3