#2 Implement room joining

src/Client/Index.fs

@@ -14,6 +14,8 @@ type Msg =
     | SetRoomIdInput of roomId:string
     | SubmitRoomId of roomId:string
     | HandleRoomIdValidation of roomIdOpt:RoomId option
+    | JoinRoom of roomId:RoomId * user:NamedUser
+    | HandleJoinRoomResult of Result<Room, string>
 
 type Page =
     | LandingPage
@@ -72,12 +74,22 @@ let update (msg: Msg) (model: Model): Model * Cmd<Msg> =
         model, Cmd.OfAsync.perform consequencesApi.validateRoomId s HandleRoomIdValidation
     | HandleRoomIdValidation roomIdOpt ->
         match roomIdOpt with
-        | Some _ ->
-            let action = fun _ -> failwith "Not yet implemented."
+        | Some roomId ->
+            let action = fun u -> JoinRoom (roomId, u)
             { model with ActivePage = UsernamePage action }, Cmd.none
         | None ->
             let error = sprintf "Room \"%s\" does not exist" model.RoomIdInput
             { model with RoomIdInputErrorOpt = Some error }, Cmd.none
+    | JoinRoom (roomId, user) ->
+        model, Cmd.OfAsync.perform consequencesApi.joinRoom (roomId, user) HandleJoinRoomResult
+    | HandleJoinRoomResult result ->
+        match result with
+        | Error msg ->
+            { model with RoomIdInputErrorOpt = Some msg
+                         ActivePage = RoomIdPage },
+            Cmd.none
+        | Ok room ->
+            { model with ActivePage = Lobby room }, Cmd.none
 
 open Fable.React
 open Fable.React.Props
@@ -178,9 +190,8 @@ let lobby (room : Room) (dispatch : Msg -> unit) =
                     str "Players"
                 ]
                 Content.content [ ] [
-                    ol [ ] [
-                        li [ ] [ str <| room.Owner.Name ]
-                    ]
+                    ol [ ]
+                        (Room.players room |> List.map (fun p -> li [ ] [ str p.Name ]))
                 ]
             ]
         ]

src/Server/Server.fs

@@ -22,6 +22,11 @@ type Storage () =
     member __.AddRoom (room: Room) =
         rooms.Add room
 
+    member __.UpdateRoom roomId room =
+        let i = rooms.FindIndex (fun r -> r.Id = roomId)
+        rooms.RemoveAt i
+        rooms.Add room
+
 let storage = Storage()
 
 module Room =
@@ -55,18 +60,46 @@ module Room =
     let create owner =
         let room =
             { Id = generateUniqueRoomId ()
-              Owner = owner}
+              Owner = owner
+              OtherPlayers = [] }
 
         storage.AddRoom room
         room
-
     let validateIdString s =
         storage.TryGetRoomById (RoomId s)
         |> Option.map (fun r -> r.Id)
 
+    let private addToRoom room (user : NamedUser) =
+        match Room.tryGetPlayerByUserId user.Id room with
+        | Some _ ->
+            let (RoomId rid) = room.Id
+            let (UserId uid) = user.Id
+            sprintf "%s (user %s) is already in room %s"
+                user.Name (string uid) rid
+            |> Error
+        | None ->
+            Ok { room with OtherPlayers = user :: room.OtherPlayers }
+
+    let join roomId (user : NamedUser) =
+        match storage.TryGetRoomById roomId with
+        | None ->
+            let (RoomId rid) = roomId
+            Error <| sprintf "No room with ID %s exists" rid
+        | Some room ->
+            // TODO: this is Result.tee. I tried installing
+            // FsToolkit.ErrorHandling, but encountered some difficulties.
+            // Revisit soon.
+            match addToRoom room user with
+            | Error msg ->
+                Error msg
+            | Ok newRoom ->
+                storage.UpdateRoom roomId newRoom
+                Ok newRoom
+
 let consequencesApi =
     { createRoom = fun owner -> async { return Room.create owner }
-      validateRoomId = fun s -> async { return Room.validateIdString s } }
+      validateRoomId = fun s -> async { return Room.validateIdString s }
+      joinRoom = fun (roomId, user) -> async { return Room.join roomId user } }
 
 let webApp =
     Remoting.createApi()

src/Shared/Shared.fs

@@ -33,12 +33,23 @@ module RoomId =
 
 type Room =
     { Id: RoomId
-      Owner: NamedUser }
+      Owner: NamedUser
+      OtherPlayers: NamedUser list }
+
+module Room =
+
+    // Use List.rev so that this list is shown in order players joined.
+    let players room = room.Owner :: List.rev room.OtherPlayers
+
+    let tryGetPlayerByUserId userId room =
+        room.OtherPlayers
+        |> List.tryFind (fun (u : NamedUser) -> u.Id = userId)
 
 module Route =
     let builder typeName methodName =
         sprintf "/api/%s/%s" typeName methodName
 
 type IConsequencesApi =
     { createRoom: NamedUser -> Async<Room>
-      validateRoomId: string -> Async<RoomId option> }
+      validateRoomId: string -> Async<RoomId option>
+      joinRoom: RoomId * NamedUser -> Async<Result<Room, string>> }