Add SPA routing

assets/elm.json

@@ -9,12 +9,12 @@
             "elm/browser": "1.0.2",
             "elm/core": "1.0.5",
             "elm/html": "1.0.0",
+            "elm/url": "1.0.0",
             "mdgriffith/elm-ui": "1.1.5"
         },
         "indirect": {
             "elm/json": "1.1.3",
             "elm/time": "1.0.0",
-            "elm/url": "1.0.0",
             "elm/virtual-dom": "1.0.2"
         }
     },

assets/src/Main.elm

@@ -1,116 +1,122 @@
 module Main exposing (main)
 
-import Browser
+import Browser exposing (Document)
-import Element exposing (..)
+import Browser.Navigation as Nav
-import Element.Background as Background
+import Html
-import Element.Border as Border
+import PlanningPokerEntry as Entry
-import Element.Font as Font
+import PlanningPokerNotFound as NotFound
-import Element.Input as Input
+import PlanningPokerRoom as Room
-import Html exposing (Html)
+import Url exposing (Url)
-
+import Url.Parser as Parser exposing ((</>), Parser, s, string)
-
-type User
-    = Moderator { name : String }
 
 
 type alias Model =
-    { name : String
+    { page : Page
-    , user : Maybe User
+    , key : Nav.Key
-    , error : Maybe String
     }
 
 
+type Page
+    = EntryPage Entry.Model
+    | RoomPage Room.Model
+    | NotFound
+
+
+type Route
+    = Entry
+    | Room String
+
+
 type Msg
-    = NameChanged String
+    = ChangedUrl Url
-    | CreateRoom
+    | ClickedLink Browser.UrlRequest
+    | EntryMsg Entry.Msg
+    | RoomMsg Room.Msg
 
 
-init : () -> ( Model, Cmd Msg )
+init : () -> Url -> Nav.Key -> ( Model, Cmd Msg )
-init _ =
+init _ url key =
-    ( { name = ""
+    updateUrl url { page = NotFound, key = key }
-      , user = Nothing
-      , error = Nothing
-      }
-    , Cmd.none
-    )
-
-
-main =
-    Browser.element
-        { init = init
-        , view = view
-        , update = update
-        , subscriptions = \_ -> Sub.none
-        }
 
 
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
-    case msg of
+    case ( msg, model.page ) of
-        NameChanged newName ->
+        ( ClickedLink urlRequest, _ ) ->
-            ( { model | name = newName }, Cmd.none )
+            ( model, Cmd.none )
 
-        CreateRoom ->
+        ( ChangedUrl url, _ ) ->
-            ( { model | error = Just "Oops." }, Cmd.none )
+            updateUrl url model
+
+        ( EntryMsg entryMsg, EntryPage entryModel ) ->
+            toEntry model (Entry.update model.key entryMsg entryModel)
+
+        ( RoomMsg roomMsg, RoomPage roomModel ) ->
+            toRoom model (Room.update model.key roomMsg roomModel)
+
+        _ ->
+            ( model, Cmd.none )
 
 
-view : Model -> Html Msg
+toEntry : Model -> ( Entry.Model, Cmd Entry.Msg ) -> ( Model, Cmd Msg )
+toEntry model ( entryModel, entryCmd ) =
+    ( { model | page = EntryPage entryModel }
+    , Cmd.map EntryMsg entryCmd
+    )
+
+
+toRoom : Model -> ( Room.Model, Cmd Room.Msg ) -> ( Model, Cmd Msg )
+toRoom model ( roomModel, roomCmd ) =
+    ( { model | page = RoomPage roomModel }
+    , Cmd.map RoomMsg roomCmd
+    )
+
+
+updateUrl : Url -> Model -> ( Model, Cmd Msg )
+updateUrl url model =
+    case Parser.parse parser url of
+        Just Entry ->
+            toEntry model (Entry.init ())
+
+        Just (Room id) ->
+            toRoom model (Room.init ())
+
+        Nothing ->
+            ( model, Cmd.none )
+
+
+parser : Parser (Route -> a) a
+parser =
+    Parser.oneOf
+        [ Parser.map Entry Parser.top
+        , Parser.map Room (s "room" </> string)
+        ]
+
+
+view : Model -> Document Msg
 view model =
-    Element.layout [] <|
+    let
-        column
+        mapDocument toMsg { title, body } =
-            [ width fill, centerY, spacing 30 ]
+            { title = title, body = List.map (Html.map toMsg) body }
-            [ el [ centerX ] (text "Oh, hey!")
+    in
-            , el [ centerX ] (text "Tell us who you are")
+    case model.page of
-            , Input.text [ centerX, width (px 300) ]
+        EntryPage entryModel ->
-                { onChange = NameChanged
+            mapDocument EntryMsg <| Entry.view entryModel
-                , text = model.name
-                , label = Input.labelHidden "Your name"
-                , placeholder = Just (Input.placeholder [] (text "Your name"))
-                }
-            , el [ centerX ] (text "then")
-            , let
-                ready =
-                    not (String.isEmpty model.name)
 
-                ( color, event ) =
+        RoomPage roomModel ->
-                    if ready then
+            mapDocument RoomMsg <| Room.view roomModel
-                        ( blue, Just CreateRoom )
 
-                    else
+        NotFound ->
-                        ( lightGrey, Nothing )
+            NotFound.view
-              in
-              Input.button
-                [ centerX
-                , padding 20
-                , Background.color color
-                , Font.color white
-                ]
-                { onPress = event
-                , label = text "Make a room!"
-                }
-            , el
-                [ centerX
-                , Background.color red
-                , padding 20
-                , Font.color white
-                , transparent (model.error == Nothing)
-                ]
-              <|
-                text (Maybe.withDefault " " model.error)
-            ]
 
 
-blue =
+main : Program () Model Msg
-    rgb255 100 100 255
+main =
-
+    Browser.application
-
+        { init = init
-red =
+        , view = view
-    rgb255 255 100 100
+        , update = update
-
+        , onUrlChange = ChangedUrl
-
+        , onUrlRequest = ClickedLink
-white =
+        , subscriptions = \_ -> Sub.none
-    rgb255 255 255 255
+        }
-
-
-lightGrey =
-    rgb255 200 200 200

assets/src/PlanningPokerEntry.elm

@@ -0,0 +1,115 @@
+module PlanningPokerEntry exposing (..)
+
+import Browser exposing (Document)
+import Browser.Navigation as Nav
+import Element exposing (..)
+import Element.Background as Background
+import Element.Border as Border
+import Element.Font as Font
+import Element.Input as Input
+import Html exposing (Html)
+
+
+type User
+    = Moderator { name : String }
+
+
+type alias Model =
+    { name : String
+    , user : Maybe User
+    , error : Maybe String
+    }
+
+
+type Msg
+    = NameChanged String
+    | CreateRoom
+
+
+init : () -> ( Model, Cmd Msg )
+init _ =
+    ( { name = ""
+      , user = Nothing
+      , error = Nothing
+      }
+    , Cmd.none
+    )
+
+
+update : Nav.Key -> Msg -> Model -> ( Model, Cmd Msg )
+update key msg model =
+    case msg of
+        NameChanged newName ->
+            ( { model | name = newName }, Cmd.none )
+
+        CreateRoom ->
+            ( model, Nav.pushUrl key "/room/a0fd1422-abd9-434e-9d7c-883294b2992c" )
+
+
+view : Model -> Document Msg
+view model =
+    { title = "Planning Poker"
+    , body = [ layout model ]
+    }
+
+
+layout : Model -> Html Msg
+layout model =
+    Element.layout [] <|
+        column
+            [ width fill, centerY, spacing 30 ]
+            [ el [ centerX ] (text "Oh, hey!")
+            , el [ centerX ] (text "Tell us who you are")
+            , Input.text [ centerX, width (px 300) ]
+                { onChange = NameChanged
+                , text = model.name
+                , label = Input.labelHidden "Your name"
+                , placeholder = Just (Input.placeholder [] (text "Your name"))
+                }
+            , el [ centerX ] (text "then")
+            , let
+                ready =
+                    not (String.isEmpty model.name)
+
+                ( color, event ) =
+                    if ready then
+                        ( blue, Just CreateRoom )
+
+                    else
+                        ( lightGrey, Nothing )
+              in
+              Input.button
+                [ centerX
+                , padding 20
+                , Background.color color
+                , Font.color white
+                ]
+                { onPress = event
+                , label = text "Make a room!"
+                }
+            , el
+                [ centerX
+                , Background.color red
+                , padding 20
+                , Font.color white
+                , transparent (model.error == Nothing)
+                ]
+              <|
+                text (Maybe.withDefault " " model.error)
+            ]
+
+
+blue =
+    rgb255 100 100 255
+
+
+red =
+    rgb255 255 100 100
+
+
+white =
+    rgb255 255 255 255
+
+
+lightGrey =
+    rgb255 200 200 200

assets/src/PlanningPokerNotFound.elm

@@ -0,0 +1,18 @@
+module PlanningPokerNotFound exposing (view)
+
+import Browser exposing (Document)
+import Element exposing (..)
+import Html exposing (Html)
+
+
+view : Document msg
+view =
+    { title = "Planning Poker - Page Not Found"
+    , body = []
+    }
+
+
+layout : Html msg
+layout =
+    Element.layout [] <|
+        text "404 Not Found"

assets/src/PlanningPokerRoom.elm

@@ -1,6 +1,7 @@
-module Room exposing (main)
+module PlanningPokerRoom exposing (Model, Msg, init, update, view)
 
-import Browser
+import Browser exposing (Document)
+import Browser.Navigation as Nav
 import Dict exposing (Dict)
 import Element exposing (..)
 import Element.Background as Background
@@ -55,8 +56,8 @@ init _ =
     )
 
 
-update : Msg -> Model -> ( Model, Cmd Msg )
+update : Nav.Key -> Msg -> Model -> ( Model, Cmd Msg )
-update msg model =
+update key msg model =
     case msg of
         Vote value ->
             ( { model
@@ -80,8 +81,15 @@ update msg model =
             )
 
 
-view : Model -> Html Msg
+view : Model -> Document Msg
 view model =
+    { title = model.name
+    , body = [ layout model ]
+    }
+
+
+layout : Model -> Html Msg
+layout model =
     let
         myVote =
             Dict.get model.player model.players
@@ -207,12 +215,3 @@ lightGrey =
 
 white =
     rgb255 255 255 255
-
-
-main =
-    Browser.element
-        { init = init
-        , view = view
-        , update = update
-        , subscriptions = \_ -> Sub.none
-        }

lib/planningpoker_web/router.ex

@@ -17,6 +17,7 @@ defmodule PlanningpokerWeb.Router do
     pipe_through :browser
 
     get "/", PageController, :index
+    get "/room/:id", PageController, :index
   end
 
   # Other scopes may use custom stacks.