upgrade element to routable

examples/basic/package/Application/Element.elm

@@ -32,6 +32,7 @@ module Application.Element exposing
 import Application.Internals.Element.Bundle as Bundle
 import Application.Internals.Element.Init as Init
 import Application.Internals.Element.Page as Page
+import Application.Internals.Element.Routing as Routing
 import Application.Internals.Element.Update as Update
 import Browser
 
@@ -40,25 +41,42 @@ import Browser
 -- APPLICATION
 
 
-type alias Application flags model msg =
-    Platform.Program flags model msg
+type alias Application route flags model msg =
+    Platform.Program flags (Routing.Model route model msg) (Routing.Msg route msg)
 
 
 create :
-    { route : route
+    { routing :
+        { initial : route
+        , routes : List ( String, route )
+        }
     , pages :
         { init : route -> Init flags model msg
         , update : msg -> model -> Update model msg
         , bundle : model -> Bundle model msg
         }
     }
-    -> Application flags model msg
+    -> Application route flags model msg
 create config =
     Browser.element
-        { init = Init.create (config.pages.init config.route)
-        , update = Update.create config.pages.update
-        , view = Bundle.createView config.pages.bundle
-        , subscriptions = Bundle.createSubscriptions config.pages.bundle
+        { init =
+            Routing.init
+                { init = Init.create config.pages.init
+                , route = config.routing.initial
+                }
+        , update =
+            Routing.update
+                { update = Update.create config.pages.update
+                }
+        , view =
+            Routing.view
+                { view = Bundle.createView config.pages.bundle
+                , routes = config.routing.routes
+                }
+        , subscriptions =
+            Routing.subscriptions
+                { subscriptions = Bundle.createSubscriptions config.pages.bundle
+                }
         }
 
 

examples/basic/package/Application/Internals/Element/Init.elm

@@ -31,8 +31,9 @@ init page =
 
 
 create :
-    Init flags model msg
+    (route -> Init flags model msg)
+    -> route
     -> flags
     -> ( model, Cmd msg )
-create (Init fn) =
-    fn
+create fn route flags =
+    fn route |> (\(Init g) -> g flags)

examples/basic/package/Application/Internals/Element/Routing.elm

@@ -0,0 +1,101 @@
+module Application.Internals.Element.Routing exposing
+    ( Model
+    , Msg
+    , init
+    , subscriptions
+    , update
+    , view
+    )
+
+import Html exposing (..)
+import Html.Events as Events
+
+
+type alias Model route model msg =
+    { init : route -> ( model, Cmd msg )
+    , page : model
+    }
+
+
+type Msg route msg
+    = RouteChange route
+    | PageMsg msg
+
+
+
+-- INIT
+
+
+init :
+    { init : route -> flags -> ( model, Cmd msg )
+    , route : route
+    }
+    -> flags
+    -> ( Model route model msg, Cmd (Msg route msg) )
+init config flags =
+    let
+        ( model, cmd ) =
+            config.init config.route flags
+    in
+    ( { init = \r -> config.init r flags
+      , page = model
+      }
+    , Cmd.map PageMsg cmd
+    )
+
+
+
+-- UPDATE
+
+
+update :
+    { update : msg -> model -> ( model, Cmd msg ) }
+    -> Msg route msg
+    -> Model route model msg
+    -> ( Model route model msg, Cmd (Msg route msg) )
+update config msg model =
+    case msg of
+        RouteChange route ->
+            Tuple.mapBoth
+                (\page -> { model | page = page })
+                (Cmd.map PageMsg)
+                (model.init route)
+
+        PageMsg pageMsg ->
+            Tuple.mapBoth
+                (\page -> { model | page = page })
+                (Cmd.map PageMsg)
+                (config.update pageMsg model.page)
+
+
+
+-- VIEW
+
+
+view :
+    { routes : List ( String, route ), view : model -> Html msg }
+    -> Model route model msg
+    -> Html (Msg route msg)
+view config model =
+    div []
+        [ p []
+            (List.map
+                (\( label, route ) ->
+                    button [ Events.onClick (RouteChange route) ] [ text label ]
+                )
+                config.routes
+            )
+        , Html.map PageMsg (config.view model.page)
+        ]
+
+
+
+-- SUBSCRIPTIONS
+
+
+subscriptions :
+    { subscriptions : model -> Sub msg }
+    -> Model route model msg
+    -> Sub (Msg route msg)
+subscriptions config model =
+    Sub.map PageMsg (config.subscriptions model.page)

examples/basic/src/Element/Main.elm

@@ -1,6 +1,6 @@
 module Element.Main exposing (main)
 
-import Application.Element as Application
+import Application.Element as Application exposing (Application)
 import Element.Pages.Counter as Counter
 import Element.Pages.Homepage as Homepage
 import Element.Pages.NotFound as NotFound
@@ -18,10 +18,18 @@ type alias Flags =
     ()
 
 
-main : Program Flags Model Msg
+main : Application Route Flags Model Msg
 main =
     Application.create
-        { route = Random
+        { routing =
+            { initial = Random
+            , routes =
+                [ ( "Homepage", Homepage )
+                , ( "Counter", Counter )
+                , ( "Random", Random )
+                , ( "Not Found", NotFound )
+                ]
+            }
         , pages =
             { init = init
             , update = update