diff options
Diffstat (limited to '')
| -rw-r--r-- | client/elm.json | 3 | ||||
| -rw-r--r-- | client/src/Client.elm | 19 | ||||
| -rw-r--r-- | client/src/Messages.elm | 4 | ||||
| -rw-r--r-- | server/cafp.cabal | 1 | ||||
| -rw-r--r-- | server/lib/Cafp/Main/GenerateElmTypes.hs | 9 | ||||
| -rw-r--r-- | server/lib/Cafp/Main/Server.hs | 5 | ||||
| -rw-r--r-- | server/lib/Cafp/Messages.hs | 6 |
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 |