aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--client/elm.json3
-rw-r--r--client/src/Client.elm19
-rw-r--r--client/src/Messages.elm4
-rw-r--r--server/cafp.cabal1
-rw-r--r--server/lib/Cafp/Main/GenerateElmTypes.hs9
-rw-r--r--server/lib/Cafp/Main/Server.hs5
-rw-r--r--server/lib/Cafp/Messages.hs6
7 files changed, 31 insertions, 16 deletions
diff --git a/client/elm.json b/client/elm.json
index 4fdc946..aa05ace 100644
--- a/client/elm.json
+++ b/client/elm.json
@@ -6,13 +6,14 @@
"elm-version": "0.19.1",
"dependencies": {
"direct": {
+ "bartavelle/json-helpers": "2.0.2",
"elm/browser": "1.0.2",
"elm/core": "1.0.5",
"elm/html": "1.0.0",
+ "elm/json": "1.1.3",
"elm/url": "1.0.0"
},
"indirect": {
- "elm/json": "1.1.3",
"elm/time": "1.0.0",
"elm/virtual-dom": "1.0.2"
}
diff --git a/client/src/Client.elm b/client/src/Client.elm
index f4247f7..ffb2b0e 100644
--- a/client/src/Client.elm
+++ b/client/src/Client.elm
@@ -2,6 +2,8 @@ port module Client exposing (main)
import Browser
import Html exposing (Html)
+import Json.Decode
+import Messages
import Url exposing (Url)
port webSocketIn : (String -> msg) -> Sub msg
@@ -14,8 +16,8 @@ type Msg
type Model
= Error String
- | JoinRoom
- { id : String
+ | Connecting
+ { roomId : String
}
parseRoomId : Url -> Result String String
@@ -29,8 +31,9 @@ view model = case model of
[ Html.h1 [] [Html.text "Error"]
, Html.p [] [Html.text str]
]
- JoinRoom room ->
- [ Html.h1 [] [Html.text <| "Room " ++ room.id]
+ Connecting state ->
+ [ Html.h1 []
+ [Html.text <| "Connecting to room " ++ state.roomId ++ "..."]
]
subscriptions : Model -> Sub Msg
@@ -40,13 +43,17 @@ update : Msg -> Model -> (Model, Cmd Msg)
update msg model = case msg of
Ignore -> (model, Cmd.none)
Send -> (model, webSocketOut "Hi")
- WebSocketIn str -> Debug.log str (model, Cmd.none)
+ WebSocketIn json ->
+ case Json.Decode.decodeString Messages.jsonDecServerMessage json of
+ Err str -> (Error <| Json.Decode.errorToString str, Cmd.none)
+ Ok Messages.Welcome -> Debug.log "Welcome" (model, Cmd.none)
+ Ok Messages.Bye -> Debug.log "Bye" (model, Cmd.none)
main : Program () Model Msg
main = Browser.application
{ init = \() url key -> case parseRoomId url of
Err str -> (Error <| "Could not parse room ID: " ++ str, Cmd.none)
- Ok roomId -> (JoinRoom {id = roomId}, Cmd.none)
+ Ok roomId -> (Connecting {roomId = roomId}, Cmd.none)
, update = update
, subscriptions = subscriptions
, view = \model -> {title = "Client", body = view model}
diff --git a/client/src/Messages.elm b/client/src/Messages.elm
index da10d22..2510544 100644
--- a/client/src/Messages.elm
+++ b/client/src/Messages.elm
@@ -10,15 +10,17 @@ import Set exposing (Set)
type ServerMessage =
Welcome
+ | Bye
jsonDecServerMessage : Json.Decode.Decoder ( ServerMessage )
jsonDecServerMessage =
- let jsonDecDictServerMessage = Dict.fromList [("Welcome", Welcome)]
+ let jsonDecDictServerMessage = Dict.fromList [("Welcome", Welcome), ("Bye", Bye)]
in decodeSumUnaries "ServerMessage" jsonDecDictServerMessage
jsonEncServerMessage : ServerMessage -> Value
jsonEncServerMessage val =
case val of
Welcome -> Json.Encode.string "Welcome"
+ Bye -> Json.Encode.string "Bye"
diff --git a/server/cafp.cabal b/server/cafp.cabal
index f97f958..733c3e3 100644
--- a/server/cafp.cabal
+++ b/server/cafp.cabal
@@ -21,6 +21,7 @@ Library
Cafp.Main.Server
Build-depends:
+ aeson >= 1.4 && < 1.5,
base >= 4.9 && < 5,
elm-bridge >= 0.5 && < 0.6,
scotty >= 0.11 && < 0.12,
diff --git a/server/lib/Cafp/Main/GenerateElmTypes.hs b/server/lib/Cafp/Main/GenerateElmTypes.hs
index 0bd43c1..8d2c9c1 100644
--- a/server/lib/Cafp/Main/GenerateElmTypes.hs
+++ b/server/lib/Cafp/Main/GenerateElmTypes.hs
@@ -4,12 +4,9 @@ module Cafp.Main.GenerateElmTypes
( main
) where
-import Cafp.Messages
-import Elm.Derive
-import Elm.Module
-import Data.Proxy
-
-deriveBoth defaultOptions ''ServerMessage
+import Cafp.Messages
+import Data.Proxy
+import Elm.Module
main :: IO ()
main = putStrLn $ makeElmModule "Messages"
diff --git a/server/lib/Cafp/Main/Server.hs b/server/lib/Cafp/Main/Server.hs
index 6451e17..4b59135 100644
--- a/server/lib/Cafp/Main/Server.hs
+++ b/server/lib/Cafp/Main/Server.hs
@@ -7,6 +7,7 @@ import Cafp.Messages
import Control.Concurrent (threadDelay)
import Control.Concurrent.STM (STM, TVar, newTVar)
import Control.Monad (forever, when)
+import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HMS
import Data.Text (Text)
import qualified Data.Text as T
@@ -53,9 +54,9 @@ wsApp pc = case routePendingConnection pc of
Just roomId -> do
conn <- WS.acceptRequest pc
WS.forkPingThread conn 30
- WS.sendTextData conn $ "Welcome to room " <> roomId
+ WS.sendTextData conn $ Aeson.encode Welcome
forever $ do
- WS.sendTextData conn $ ("loop data" :: Text)
+ WS.sendTextData conn $ Aeson.encode Bye
threadDelay $ 1 * 1000000
main :: IO ()
diff --git a/server/lib/Cafp/Messages.hs b/server/lib/Cafp/Messages.hs
index e3c28fe..bde199d 100644
--- a/server/lib/Cafp/Messages.hs
+++ b/server/lib/Cafp/Messages.hs
@@ -1,7 +1,13 @@
+{-# LANGUAGE TemplateHaskell #-}
module Cafp.Messages
( ServerMessage (..)
) where
+import Elm.Derive
+
data ServerMessage
= Welcome
+ | Bye
deriving (Show)
+
+deriveBoth defaultOptions ''ServerMessage