Move 'Register' to the page stack

src/Main.elm

@@ -40,7 +40,6 @@ import Viewer exposing (Viewer)
 type Model
     = Redirect Session
     | NotFound Session
-    | Register Register.Model
     | Article Article.Model
     | Editor (Maybe Slug) Editor.Model
     | Stack Session StackModel
@@ -55,20 +54,24 @@ type alias StackModel =
 
 
 type alias StackCurrentModel =
-    Login.Model
+    Register.Model
 
 
 type alias StackPreviousModel =
     Spa.PageStack.Model
         Never
-        Profile.Model
+        Login.Model
         (Spa.PageStack.Model
             Never
-            Settings.Model
+            Profile.Model
             (Spa.PageStack.Model
                 Never
-                Home.Model
-                (Spa.PageStack.Model Never () ())
+                Settings.Model
+                (Spa.PageStack.Model
+                    Never
+                    Home.Model
+                    (Spa.PageStack.Model Never () ())
+                )
             )
         )
 
@@ -78,17 +81,21 @@ type alias StackMsg =
 
 
 type alias StackCurrentMsg =
-    Login.Msg
+    Register.Msg
 
 
 type alias StackPreviousMsg =
     Spa.PageStack.Msg
         Route
-        Profile.Msg
+        Login.Msg
         (Spa.PageStack.Msg
             Route
-            Settings.Msg
-            (Spa.PageStack.Msg Route Home.Msg (Spa.PageStack.Msg Route () ()))
+            Profile.Msg
+            (Spa.PageStack.Msg
+                Route
+                Settings.Msg
+                (Spa.PageStack.Msg Route Home.Msg (Spa.PageStack.Msg Route () ()))
+            )
         )
 
 
@@ -103,6 +110,7 @@ stack =
         |> Spa.PageStack.add ( View.map, View.map ) Route.matchSettings (Settings.page >> Ok)
         |> Spa.PageStack.add ( View.map, View.map ) Route.matchProfile (Profile.page >> Ok)
         |> Spa.PageStack.add ( View.map, View.map ) Route.matchLogin (Login.page >> Ok)
+        |> Spa.PageStack.add ( View.map, View.map ) Route.matchRegister (Register.page >> Ok)
 
 
 
@@ -141,9 +149,6 @@ view model =
         NotFound _ ->
             Page.view viewer Page.Other NotFound.view
 
-        Register register ->
-            viewPage Page.Other GotRegisterMsg (Register.view register)
-
         Article article ->
             viewPage Page.Other GotArticleMsg (Article.view article)
 
@@ -168,7 +173,6 @@ view model =
 type Msg
     = ChangedUrl Url
     | ClickedLink Browser.UrlRequest
-    | GotRegisterMsg Register.Msg
     | GotArticleMsg Article.Msg
     | GotEditorMsg Editor.Msg
     | GotSession Session
@@ -186,9 +190,6 @@ toSession page =
         NotFound session ->
             session
 
-        Register register ->
-            Register.toSession register
-
         Article article ->
             Article.toSession article
 
@@ -223,10 +224,6 @@ changeRouteTo maybeRoute model =
             Editor.initEdit session slug
                 |> updateWith (Editor (Just slug)) GotEditorMsg model
 
-        Just Route.Register ->
-            Register.init session
-                |> updateWith Register GotRegisterMsg model
-
         Just (Route.Article slug) ->
             Article.init session slug
                 |> updateWith Article GotArticleMsg model
@@ -275,10 +272,6 @@ update msg model =
         ( ChangedUrl url, _ ) ->
             changeRouteTo (Route.fromUrl url) model
 
-        ( GotRegisterMsg subMsg, Register register ) ->
-            Register.update subMsg register
-                |> updateWith Register GotRegisterMsg model
-
         ( GotArticleMsg subMsg, Article article ) ->
             Article.update subMsg article
                 |> updateWith Article GotArticleMsg model
@@ -329,9 +322,6 @@ subscriptions model =
         Redirect _ ->
             Session.changes GotSession (Session.navKey (toSession model))
 
-        Register register ->
-            Sub.map GotRegisterMsg (Register.subscriptions register)
-
         Article article ->
             Sub.map GotArticleMsg (Article.subscriptions article)
 

src/Page/Register.elm

@@ -1,26 +1,38 @@
-module Page.Register exposing (Model, Msg, init, subscriptions, toSession, update, view)
+module Page.Register exposing (Model, Msg, page)
 
 import Api exposing (Cred)
 import Browser.Navigation as Nav
+import Effect exposing (Effect)
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 import Http
 import Json.Decode as Decode exposing (Decoder, decodeString, field, string)
 import Json.Decode.Pipeline exposing (optional)
 import Json.Encode as Encode
+import Page
 import Route exposing (Route)
 import Session exposing (Session)
+import Spa.Page
+import View exposing (View)
 import Viewer exposing (Viewer)
 
 
+page session =
+    Spa.Page.element
+        { init = init session
+        , update = update
+        , subscriptions = subscriptions
+        , view = view
+        }
+
+
 
 -- MODEL
 
 
 type alias Model =
-    { session : Session
-    , problems : List Problem
+    { problems : List Problem
     , form : Form
     }
 
@@ -37,27 +49,27 @@ type Problem
     | ServerError String
 
 
-init : Session -> ( Model, Cmd msg )
-init session =
-    ( { session = session
-      , problems = []
+init : Session -> () -> ( Model, Effect Session.Msg msg )
+init session _ =
+    ( { problems = []
       , form =
             { email = ""
             , username = ""
             , password = ""
             }
       }
-    , Cmd.none
+    , Effect.none
     )
 
 
 
 -- VIEW
 
 
-view : Model -> { title : String, content : Html Msg }
+view : Model -> View Msg
 view model =
     { title = "Register"
+    , page = Page.Register
     , content =
         div [ class "cred-page" ]
             [ div [ class "container page" ]
@@ -138,22 +150,22 @@ type Msg
     | EnteredUsername String
     | EnteredPassword String
     | CompletedRegister (Result Http.Error Viewer)
-    | GotSession Session
 
 
-update : Msg -> Model -> ( Model, Cmd Msg )
+update : Msg -> Model -> ( Model, Effect Session.Msg Msg )
 update msg model =
     case msg of
         SubmittedForm ->
             case validate model.form of
                 Ok validForm ->
                     ( { model | problems = [] }
                     , Http.send CompletedRegister (register validForm)
+                        |> Effect.fromCmd
                     )
 
                 Err problems ->
                     ( { model | problems = problems }
-                    , Cmd.none
+                    , Effect.none
                     )
 
         EnteredUsername username ->
@@ -172,44 +184,31 @@ update msg model =
                         |> List.map ServerError
             in
             ( { model | problems = List.append model.problems serverErrors }
-            , Cmd.none
+            , Effect.none
             )
 
         CompletedRegister (Ok viewer) ->
             ( model
             , Viewer.store viewer
-            )
-
-        GotSession session ->
-            ( { model | session = session }
-            , Route.replaceUrl (Session.navKey session) Route.Home
+                |> Effect.fromCmd
             )
 
 
 {-| Helper function for `update`. Updates the form and returns Cmd.none.
 Useful for recording form fields!
 -}
-updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
+updateForm : (Form -> Form) -> Model -> ( Model, Effect Session.Msg Msg )
 updateForm transform model =
-    ( { model | form = transform model.form }, Cmd.none )
+    ( { model | form = transform model.form }, Effect.none )
 
 
 
 -- SUBSCRIPTIONS
 
 
 subscriptions : Model -> Sub Msg
-subscriptions model =
-    Session.changes GotSession (Session.navKey model.session)
-
-
-
--- EXPORT
-
-
-toSession : Model -> Session
-toSession model =
-    model.session
+subscriptions _ =
+    Sub.none
 
 
 

src/Route.elm

@@ -1,4 +1,4 @@
-module Route exposing (Route(..), fromUrl, href, matchHome, matchLogin, matchProfile, matchSettings, replaceUrl)
+module Route exposing (Route(..), fromUrl, href, matchHome, matchLogin, matchProfile, matchRegister, matchSettings, replaceUrl)
 
 import Article.Slug as Slug exposing (Slug)
 import Browser.Navigation as Nav
@@ -144,3 +144,8 @@ matchProfile route =
 
         _ ->
             Nothing
+
+
+matchRegister : Route -> Maybe ()
+matchRegister =
+    matchBasic Register