Add part4

advanced/part4/src/Page/Article.elm

@@ -0,0 +1,556 @@
+module Page.Article exposing (Model, Msg, init, subscriptions, toSession, update, view)
+
+{-| Viewing an individual article.
+-}
+
+import Api
+import Article exposing (Article, Full, Preview)
+import Article.Body exposing (Body)
+import Article.Comment as Comment exposing (Comment)
+import Article.Preview
+import Article.Slug as Slug exposing (Slug)
+import Author exposing (Author(..), FollowedAuthor, UnfollowedAuthor)
+import Avatar
+import Browser.Navigation as Nav
+import CommentId exposing (CommentId)
+import Html exposing (..)
+import Html.Attributes exposing (attribute, class, disabled, href, id, placeholder)
+import Html.Events exposing (onClick, onInput, onSubmit)
+import Http
+import HttpBuilder exposing (RequestBuilder, withBody, withExpect, withQueryParams)
+import Loading
+import Log
+import Page
+import Profile exposing (Profile)
+import Route
+import Session exposing (Session)
+import Task exposing (Task)
+import Time
+import Timestamp
+import Username exposing (Username)
+import Viewer exposing (Viewer)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- MODEL
+
+
+type alias Model =
+    { session : Session
+    , timeZone : Time.Zone
+    , errors : List String
+
+    -- Loaded independently from server
+    , comments : Status ( CommentText, List Comment )
+    , article : Status (Article Full)
+    }
+
+
+type Status a
+    = Loading
+    | Loaded a
+    | Failed
+
+
+type CommentText
+    = Editing String
+    | Sending String
+
+
+init : Session -> Slug -> ( Model, Cmd Msg )
+init session slug =
+    let
+        maybeCred =
+            Session.cred session
+    in
+    ( { session = session
+      , timeZone = Time.utc
+      , errors = []
+      , comments = Loading
+      , article = Loading
+      }
+    , Cmd.batch
+        [ Article.fetch maybeCred slug
+            |> Http.send CompletedLoadArticle
+        , Comment.list maybeCred slug
+            |> Http.send CompletedLoadComments
+        , Task.perform GotTimeZone Time.here
+        ]
+    )
+
+
+
+-- VIEW
+
+
+view : Model -> { title : String, content : Html Msg }
+view model =
+    case model.article of
+        Loaded article ->
+            let
+                { title } =
+                    Article.metadata article
+
+                author =
+                    Article.author article
+
+                avatar =
+                    Profile.avatar (Author.profile author)
+
+                slug =
+                    Article.slug article
+
+                profile =
+                    Author.profile author
+
+                buttons =
+                    case Session.cred model.session of
+                        Just cred ->
+                            viewButtons cred article author
+
+                        Nothing ->
+                            []
+            in
+            { title = title
+            , content =
+                div [ class "article-page" ]
+                    [ div [ class "banner" ]
+                        [ div [ class "container" ]
+                            [ h1 [] [ text title ]
+                            , div [ class "article-meta" ] <|
+                                List.append
+                                    [ a [ Route.href (Route.Profile (Author.username author)) ]
+                                        [ img [ Avatar.src (Profile.avatar profile) ] [] ]
+                                    , div [ class "info" ]
+                                        [ Author.view (Author.username author)
+                                        , Timestamp.view model.timeZone (Article.metadata article).createdAt
+                                        ]
+                                    ]
+                                    buttons
+                            , Page.viewErrors ClickedDismissErrors model.errors
+                            ]
+                        ]
+                    , div [ class "container page" ]
+                        [ div [ class "row article-content" ]
+                            [ div [ class "col-md-12" ]
+                                [ Article.Body.toHtml (Article.body article) [] ]
+                            ]
+                        , hr [] []
+                        , div [ class "article-actions" ]
+                            [ div [ class "article-meta" ] <|
+                                List.append
+                                    [ a [ Route.href (Route.Profile (Author.username author)) ]
+                                        [ img [ Avatar.src avatar ] [] ]
+                                    , div [ class "info" ]
+                                        [ Author.view (Author.username author)
+                                        , Timestamp.view model.timeZone (Article.metadata article).createdAt
+                                        ]
+                                    ]
+                                    buttons
+                            ]
+                        , div [ class "row" ]
+                            [ div [ class "col-xs-12 col-md-8 offset-md-2" ] <|
+                                -- Don't render the comments until the article has loaded!
+                                case model.comments of
+                                    Loading ->
+                                        [ Loading.icon ]
+
+                                    Loaded ( commentText, comments ) ->
+                                        -- Don't let users add comments until they can
+                                        -- see the existing comments! Otherwise you
+                                        -- may be about to repeat something that's
+                                        -- already been said.
+                                        viewAddComment slug commentText (Session.viewer model.session)
+                                            :: List.map (viewComment model.timeZone slug) comments
+
+                                    Failed ->
+                                        [ Loading.error "comments" ]
+                            ]
+                        ]
+                    ]
+            }
+
+        Loading ->
+            { title = "Article", content = Loading.icon }
+
+        Failed ->
+            { title = "Article", content = Loading.error "article" }
+
+
+viewAddComment : Slug -> CommentText -> Maybe Viewer -> Html Msg
+viewAddComment slug commentText maybeViewer =
+    case maybeViewer of
+        Just viewer ->
+            let
+                avatar =
+                    Profile.avatar (Viewer.profile viewer)
+
+                cred =
+                    Viewer.cred viewer
+
+                ( commentStr, buttonAttrs ) =
+                    case commentText of
+                        Editing str ->
+                            ( str, [] )
+
+                        Sending str ->
+                            ( str, [ disabled True ] )
+            in
+            Html.form [ class "card comment-form", onSubmit (ClickedPostComment cred slug) ]
+                [ div [ class "card-block" ]
+                    [ textarea
+                        [ class "form-control"
+                        , placeholder "Write a comment..."
+                        , attribute "rows" "3"
+                        , onInput EnteredCommentText
+                        ]
+                        []
+                    ]
+                , div [ class "card-footer" ]
+                    [ img [ class "comment-author-img", Avatar.src avatar ] []
+                    , button
+                        (class "btn btn-sm btn-primary" :: buttonAttrs)
+                        [ text "Post Comment" ]
+                    ]
+                ]
+
+        Nothing ->
+            p []
+                [ a [ Route.href Route.Login ] [ text "Sign in" ]
+                , text " or "
+                , a [ Route.href Route.Register ] [ text "sign up" ]
+                , text " to comment."
+                ]
+
+
+viewButtons : Cred -> Article Full -> Author -> List (Html Msg)
+viewButtons cred article author =
+    case author of
+        IsFollowing followedAuthor ->
+            [ Author.unfollowButton (ClickedUnfollow cred) followedAuthor
+            , text " "
+            , favoriteButton cred article
+            ]
+
+        IsNotFollowing unfollowedAuthor ->
+            [ Author.followButton (ClickedFollow cred) unfollowedAuthor
+            , text " "
+            , favoriteButton cred article
+            ]
+
+        IsViewer _ _ ->
+            [ editButton article
+            , text " "
+            , deleteButton cred article
+            ]
+
+
+viewComment : Time.Zone -> Slug -> Comment -> Html Msg
+viewComment timeZone slug comment =
+    let
+        author =
+            Comment.author comment
+
+        profile =
+            Author.profile author
+
+        authorUsername =
+            Author.username author
+
+        deleteCommentButton =
+            case author of
+                IsViewer cred _ ->
+                    let
+                        msg =
+                            ClickedDeleteComment cred slug (Comment.id comment)
+                    in
+                    span
+                        [ class "mod-options"
+                        , onClick msg
+                        ]
+                        [ i [ class "ion-trash-a" ] [] ]
+
+                _ ->
+                    -- You can't delete other peoples' comments!
+                    text ""
+
+        timestamp =
+            Timestamp.format timeZone (Comment.createdAt comment)
+    in
+    div [ class "card" ]
+        [ div [ class "card-block" ]
+            [ p [ class "card-text" ] [ text (Comment.body comment) ] ]
+        , div [ class "card-footer" ]
+            [ a [ class "comment-author", href "" ]
+                [ img [ class "comment-author-img", Avatar.src (Profile.avatar profile) ] []
+                , text " "
+                ]
+            , text " "
+            , a [ class "comment-author", Route.href (Route.Profile authorUsername) ]
+                [ text (Username.toString authorUsername) ]
+            , span [ class "date-posted" ] [ text timestamp ]
+            , deleteCommentButton
+            ]
+        ]
+
+
+
+-- UPDATE
+
+
+type Msg
+    = ClickedDeleteArticle Cred Slug
+    | ClickedDeleteComment Cred Slug CommentId
+    | ClickedDismissErrors
+    | ClickedFavorite Cred Slug Body
+    | ClickedUnfavorite Cred Slug Body
+    | ClickedFollow Cred UnfollowedAuthor
+    | ClickedUnfollow Cred FollowedAuthor
+    | ClickedPostComment Cred Slug
+    | EnteredCommentText String
+    | CompletedLoadArticle (Result Http.Error (Article Full))
+    | CompletedLoadComments (Result Http.Error (List Comment))
+    | CompletedDeleteArticle (Result Http.Error ())
+    | CompletedDeleteComment CommentId (Result Http.Error ())
+    | CompletedFavoriteChange (Result Http.Error (Article Full))
+    | CompletedFollowChange (Result Http.Error Author)
+    | CompletedPostComment (Result Http.Error Comment)
+    | GotTimeZone Time.Zone
+    | GotSession Session
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        ClickedDismissErrors ->
+            ( { model | errors = [] }, Cmd.none )
+
+        ClickedFavorite cred slug body ->
+            ( model, fave Article.favorite cred slug body )
+
+        ClickedUnfavorite cred slug body ->
+            ( model, fave Article.unfavorite cred slug body )
+
+        CompletedLoadArticle (Ok article) ->
+            ( { model | article = Loaded article }, Cmd.none )
+
+        CompletedLoadArticle (Err error) ->
+            ( { model | article = Failed }
+            , Log.error
+            )
+
+        CompletedLoadComments (Ok comments) ->
+            ( { model | comments = Loaded ( Editing "", comments ) }, Cmd.none )
+
+        CompletedLoadComments (Err error) ->
+            ( { model | article = Failed }, Log.error )
+
+        CompletedFavoriteChange (Ok newArticle) ->
+            ( { model | article = Loaded newArticle }, Cmd.none )
+
+        CompletedFavoriteChange (Err error) ->
+            ( { model | errors = Api.addServerError model.errors }
+            , Log.error
+            )
+
+        ClickedUnfollow cred followedAuthor ->
+            ( model
+            , Author.requestUnfollow followedAuthor cred
+                |> Http.send CompletedFollowChange
+            )
+
+        ClickedFollow cred unfollowedAuthor ->
+            ( model
+            , Author.requestFollow unfollowedAuthor cred
+                |> Http.send CompletedFollowChange
+            )
+
+        CompletedFollowChange (Ok newAuthor) ->
+            case model.article of
+                Loaded article ->
+                    ( { model | article = Loaded (Article.mapAuthor (\_ -> newAuthor) article) }, Cmd.none )
+
+                _ ->
+                    ( model, Log.error )
+
+        CompletedFollowChange (Err error) ->
+            ( { model | errors = Api.addServerError model.errors }
+            , Log.error
+            )
+
+        EnteredCommentText str ->
+            case model.comments of
+                Loaded ( Editing _, comments ) ->
+                    -- You can only edit comment text once comments have loaded
+                    -- successfully, and when the comment is not currently
+                    -- being submitted.
+                    ( { model | comments = Loaded ( Editing str, comments ) }
+                    , Cmd.none
+                    )
+
+                _ ->
+                    ( model, Log.error )
+
+        ClickedPostComment cred slug ->
+            case model.comments of
+                Loaded ( Editing "", comments ) ->
+                    -- No posting empty comments!
+                    -- We don't use Log.error here because this isn't an error,
+                    -- it just doesn't do anything.
+                    ( model, Cmd.none )
+
+                Loaded ( Editing str, comments ) ->
+                    ( { model | comments = Loaded ( Sending str, comments ) }
+                    , cred
+                        |> Comment.post slug str
+                        |> Http.send CompletedPostComment
+                    )
+
+                _ ->
+                    -- Either we have no comment to post, or there's already
+                    -- one in the process of being posted, or we don't have
+                    -- a valid article, in which case how did we post this?
+                    ( model, Log.error )
+
+        CompletedPostComment (Ok comment) ->
+            case model.comments of
+                Loaded ( _, comments ) ->
+                    ( { model | comments = Loaded ( Editing "", comment :: comments ) }
+                    , Cmd.none
+                    )
+
+                _ ->
+                    ( model, Log.error )
+
+        CompletedPostComment (Err error) ->
+            ( { model | errors = Api.addServerError model.errors }
+            , Log.error
+            )
+
+        ClickedDeleteComment cred slug id ->
+            ( model
+            , cred
+                |> Comment.delete slug id
+                |> Http.send (CompletedDeleteComment id)
+            )
+
+        CompletedDeleteComment id (Ok ()) ->
+            case model.comments of
+                Loaded ( commentText, comments ) ->
+                    ( { model | comments = Loaded ( commentText, withoutComment id comments ) }
+                    , Cmd.none
+                    )
+
+                _ ->
+                    ( model, Log.error )
+
+        CompletedDeleteComment id (Err error) ->
+            ( { model | errors = Api.addServerError model.errors }
+            , Log.error
+            )
+
+        ClickedDeleteArticle cred slug ->
+            ( model
+            , delete slug cred
+                |> Http.send CompletedDeleteArticle
+            )
+
+        CompletedDeleteArticle (Ok ()) ->
+            ( model, Route.replaceUrl (Session.navKey model.session) Route.Home )
+
+        CompletedDeleteArticle (Err error) ->
+            ( { model | errors = Api.addServerError model.errors }
+            , Log.error
+            )
+
+        GotTimeZone tz ->
+            ( { model | timeZone = tz }, Cmd.none )
+
+        GotSession session ->
+            ( { model | session = session }, Cmd.none )
+
+
+
+-- SUBSCRIPTIONS
+
+
+subscriptions : Model -> Sub Msg
+subscriptions model =
+    Session.changes GotSession (Session.navKey model.session)
+
+
+
+-- HTTP
+
+
+delete : Slug -> Cred -> Http.Request ()
+delete slug cred =
+    Article.url slug []
+        |> HttpBuilder.delete
+        |> Cred.addHeader cred
+        |> HttpBuilder.toRequest
+
+
+
+-- EXPORT
+
+
+toSession : Model -> Session
+toSession model =
+    model.session
+
+
+
+-- INTERNAL
+
+
+fave : (Slug -> Cred -> Http.Request (Article Preview)) -> Cred -> Slug -> Body -> Cmd Msg
+fave toRequest cred slug body =
+    toRequest slug cred
+        |> Http.toTask
+        |> Task.map (Article.fromPreview body)
+        |> Task.attempt CompletedFavoriteChange
+
+
+withoutComment : CommentId -> List Comment -> List Comment
+withoutComment id list =
+    List.filter (\comment -> Comment.id comment /= id) list
+
+
+favoriteButton : Cred -> Article Full -> Html Msg
+favoriteButton cred article =
+    let
+        { favoritesCount, favorited } =
+            Article.metadata article
+
+        slug =
+            Article.slug article
+
+        body =
+            Article.body article
+
+        kids =
+            [ text (" Favorite Article (" ++ String.fromInt favoritesCount ++ ")") ]
+    in
+    if favorited then
+        Article.unfavoriteButton cred (ClickedUnfavorite cred slug body) [] kids
+
+    else
+        Article.favoriteButton cred (ClickedFavorite cred slug body) [] kids
+
+
+deleteButton : Cred -> Article a -> Html Msg
+deleteButton cred article =
+    let
+        msg =
+            ClickedDeleteArticle cred (Article.slug article)
+    in
+    button [ class "btn btn-outline-danger btn-sm", onClick msg ]
+        [ i [ class "ion-trash-a" ] [], text " Delete Article" ]
+
+
+editButton : Article a -> Html Msg
+editButton article =
+    a [ class "btn btn-outline-secondary btn-sm", Route.href (Route.EditArticle (Article.slug article)) ]
+        [ i [ class "ion-edit" ] [], text " Edit Article" ]

advanced/part4/src/Page/Article/Editor.elm

@@ -0,0 +1,526 @@
+module Page.Article.Editor exposing (Model, Msg, initEdit, initNew, subscriptions, toSession, update, view)
+
+import Api
+import Article exposing (Article, Full)
+import Article.Body exposing (Body)
+import Article.Slug as Slug exposing (Slug)
+import Browser.Navigation as Nav
+import Html exposing (..)
+import Html.Attributes exposing (attribute, class, disabled, href, id, placeholder, type_, value)
+import Html.Events exposing (onInput, onSubmit)
+import Http
+import HttpBuilder exposing (withBody, withExpect)
+import Json.Decode as Decode
+import Json.Encode as Encode
+import Loading
+import Page
+import Profile exposing (Profile)
+import Route
+import Session exposing (Session)
+import Task exposing (Task)
+import Time
+import Validate exposing (Valid, Validator, fromValid, ifBlank, validate)
+import Viewer exposing (Viewer)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- MODEL
+
+
+type alias Model =
+    { session : Session
+    , status : Status
+    }
+
+
+type
+    Status
+    -- Edit Article
+    = Loading Slug
+    | LoadingFailed Slug
+    | Saving Slug Form
+    | Editing Slug (List Error) Form
+      -- New Article
+    | EditingNew (List Error) Form
+    | Creating Form
+
+
+type alias Form =
+    { title : String
+    , body : String
+    , description : String
+    , tags : String
+    }
+
+
+initNew : Session -> ( Model, Cmd msg )
+initNew session =
+    ( { session = session
+      , status =
+            EditingNew []
+                { title = ""
+                , body = ""
+                , description = ""
+                , tags = ""
+                }
+      }
+    , Cmd.none
+    )
+
+
+initEdit : Session -> Slug -> ( Model, Cmd Msg )
+initEdit session slug =
+    ( { session = session
+      , status = Loading slug
+      }
+    , Article.fetch (Session.cred session) slug
+        |> Http.toTask
+        -- If init fails, store the slug that failed in the msg, so we can
+        -- at least have it later to display the page's title properly!
+        |> Task.mapError (\httpError -> ( slug, httpError ))
+        |> Task.attempt CompletedArticleLoad
+    )
+
+
+
+-- VIEW
+
+
+view : Model -> { title : String, content : Html Msg }
+view model =
+    { title =
+        case getSlug model.status of
+            Just slug ->
+                "Edit Article - " ++ Slug.toString slug
+
+            Nothing ->
+                "New Article"
+    , content =
+        case Session.cred model.session of
+            Just cred ->
+                viewAuthenticated cred model
+
+            Nothing ->
+                text "Sign in to edit this article."
+    }
+
+
+viewAuthenticated : Cred -> Model -> Html Msg
+viewAuthenticated cred model =
+    let
+        formHtml =
+            case model.status of
+                Loading _ ->
+                    [ Loading.icon ]
+
+                Saving slug form ->
+                    [ viewForm cred form (editArticleSaveButton [ disabled True ]) ]
+
+                Creating form ->
+                    [ viewForm cred form (newArticleSaveButton [ disabled True ]) ]
+
+                Editing slug errors form ->
+                    [ errors
+                        |> List.map (\( _, error ) -> li [] [ text error ])
+                        |> ul [ class "error-messages" ]
+                    , viewForm cred form (editArticleSaveButton [])
+                    ]
+
+                EditingNew errors form ->
+                    [ errors
+                        |> List.map (\( _, error ) -> li [] [ text error ])
+                        |> ul [ class "error-messages" ]
+                    , viewForm cred form (newArticleSaveButton [])
+                    ]
+
+                LoadingFailed _ ->
+                    [ text "Article failed to load." ]
+    in
+    div [ class "editor-page" ]
+        [ div [ class "container page" ]
+            [ div [ class "row" ]
+                [ div [ class "col-md-10 offset-md-1 col-xs-12" ]
+                    formHtml
+                ]
+            ]
+        ]
+
+
+viewForm : Cred -> Form -> Html Msg -> Html Msg
+viewForm cred fields saveButton =
+    Html.form [ onSubmit (ClickedSave cred) ]
+        [ fieldset []
+            [ fieldset [ class "form-group" ]
+                [ input
+                    [ class "form-control form-control-lg"
+                    , placeholder "Article Title"
+                    , onInput EnteredTitle
+                    , value fields.title
+                    ]
+                    []
+                ]
+            , fieldset [ class "form-group" ]
+                [ input
+                    [ class "form-control"
+                    , placeholder "What's this article about?"
+                    , onInput EnteredDescription
+                    , value fields.description
+                    ]
+                    []
+                ]
+            , fieldset [ class "form-group" ]
+                [ textarea
+                    [ class "form-control"
+                    , placeholder "Write your article (in markdown)"
+                    , attribute "rows" "8"
+                    , onInput EnteredBody
+                    , value fields.body
+                    ]
+                    []
+                ]
+            , fieldset [ class "form-group" ]
+                [ input
+                    [ class "form-control"
+                    , placeholder "Enter tags"
+                    , onInput EnteredTags
+                    , value fields.tags
+                    ]
+                    []
+                ]
+            , saveButton
+            ]
+        ]
+
+
+editArticleSaveButton : List (Attribute msg) -> Html msg
+editArticleSaveButton extraAttrs =
+    saveArticleButton "Update Article" extraAttrs
+
+
+newArticleSaveButton : List (Attribute msg) -> Html msg
+newArticleSaveButton extraAttrs =
+    saveArticleButton "Publish Article" extraAttrs
+
+
+saveArticleButton : String -> List (Attribute msg) -> Html msg
+saveArticleButton caption extraAttrs =
+    button (class "btn btn-lg pull-xs-right btn-primary" :: extraAttrs)
+        [ text caption ]
+
+
+
+-- UPDATE
+
+
+type Msg
+    = ClickedSave Cred
+    | EnteredBody String
+    | EnteredDescription String
+    | EnteredTags String
+    | EnteredTitle String
+    | CompletedCreate (Result Http.Error (Article Full))
+    | CompletedEdit (Result Http.Error (Article Full))
+    | CompletedArticleLoad (Result ( Slug, Http.Error ) (Article Full))
+    | GotSession Session
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        ClickedSave cred ->
+            model.status
+                |> save cred
+                |> Tuple.mapFirst (\status -> { model | status = status })
+
+        EnteredTitle title ->
+            updateForm (\form -> { form | title = title }) model
+
+        EnteredDescription description ->
+            updateForm (\form -> { form | description = description }) model
+
+        EnteredTags tags ->
+            updateForm (\form -> { form | tags = tags }) model
+
+        EnteredBody body ->
+            updateForm (\form -> { form | body = body }) model
+
+        CompletedCreate (Ok article) ->
+            ( model
+            , Route.Article (Article.slug article)
+                |> Route.replaceUrl (Session.navKey model.session)
+            )
+
+        CompletedCreate (Err error) ->
+            ( { model | status = savingError model.status }
+            , Cmd.none
+            )
+
+        CompletedEdit (Ok article) ->
+            ( model
+            , Route.Article (Article.slug article)
+                |> Route.replaceUrl (Session.navKey model.session)
+            )
+
+        CompletedEdit (Err error) ->
+            ( { model | status = savingError model.status }
+            , Cmd.none
+            )
+
+        CompletedArticleLoad (Err ( slug, error )) ->
+            ( { model | status = LoadingFailed slug }
+            , Cmd.none
+            )
+
+        CompletedArticleLoad (Ok article) ->
+            let
+                { title, description, tags } =
+                    Article.metadata article
+
+                status =
+                    Editing (Article.slug article)
+                        []
+                        { title = title
+                        , body = Article.Body.toMarkdownString (Article.body article)
+                        , description = description
+                        , tags = String.join " " tags
+                        }
+            in
+            ( { model | status = status }
+            , Cmd.none
+            )
+
+        GotSession session ->
+            ( { model | session = session }, Cmd.none )
+
+
+save : Cred -> Status -> ( Status, Cmd Msg )
+save cred status =
+    case status of
+        Editing slug _ fields ->
+            case validate formValidator fields of
+                Ok validForm ->
+                    ( Saving slug fields
+                    , edit slug validForm cred
+                        |> Http.send CompletedEdit
+                    )
+
+                Err errors ->
+                    ( Editing slug errors fields
+                    , Cmd.none
+                    )
+
+        EditingNew _ fields ->
+            case validate formValidator fields of
+                Ok validForm ->
+                    ( Creating fields
+                    , create validForm cred
+                        |> Http.send CompletedCreate
+                    )
+
+                Err errors ->
+                    ( EditingNew errors fields
+                    , Cmd.none
+                    )
+
+        _ ->
+            -- We're in a state where saving is not allowed.
+            -- We tried to prevent getting here by disabling the Save
+            -- button, but somehow the user got here anyway!
+            --
+            -- If we had an error logging service, we would send
+            -- something to it here!
+            ( status, Cmd.none )
+
+
+savingError : Status -> Status
+savingError status =
+    let
+        errors =
+            [ ( Server, "Error saving article" ) ]
+    in
+    case status of
+        Saving slug form ->
+            Editing slug errors form
+
+        Creating form ->
+            EditingNew errors form
+
+        _ ->
+            status
+
+
+{-| Helper function for `update`. Updates the form, if there is one,
+and returns Cmd.none.
+
+Useful for recording form fields!
+
+This could also log errors to the server if we are trying to record things in
+the form and we don't actually have a form.
+
+-}
+updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
+updateForm transform model =
+    let
+        newModel =
+            case model.status of
+                Loading _ ->
+                    model
+
+                LoadingFailed _ ->
+                    model
+
+                Saving slug form ->
+                    { model | status = Saving slug (transform form) }
+
+                Editing slug errors form ->
+                    { model | status = Editing slug errors (transform form) }
+
+                EditingNew errors form ->
+                    { model | status = EditingNew errors (transform form) }
+
+                Creating form ->
+                    { model | status = Creating (transform form) }
+    in
+    ( newModel, Cmd.none )
+
+
+
+-- SUBSCRIPTIONS
+
+
+subscriptions : Model -> Sub Msg
+subscriptions model =
+    Session.changes GotSession (Session.navKey model.session)
+
+
+
+-- VALIDATION
+
+
+type ErrorSource
+    = Server
+    | Title
+    | Body
+
+
+type alias Error =
+    ( ErrorSource, String )
+
+
+formValidator : Validator Error Form
+formValidator =
+    Validate.all
+        [ ifBlank .title ( Title, "title can't be blank." )
+        , ifBlank .body ( Body, "body can't be blank." )
+        ]
+
+
+
+-- HTTP
+
+
+create : Valid Form -> Cred -> Http.Request (Article Full)
+create validForm cred =
+    let
+        form =
+            fromValid validForm
+
+        expect =
+            Article.fullDecoder (Just cred)
+                |> Decode.field "article"
+                |> Http.expectJson
+
+        article =
+            Encode.object
+                [ ( "title", Encode.string form.title )
+                , ( "description", Encode.string form.description )
+                , ( "body", Encode.string form.body )
+                , ( "tagList", Encode.list Encode.string (tagsFromString form.tags) )
+                ]
+
+        jsonBody =
+            Encode.object [ ( "article", article ) ]
+                |> Http.jsonBody
+    in
+    Api.url [ "articles" ]
+        |> HttpBuilder.post
+        |> Cred.addHeader cred
+        |> withBody jsonBody
+        |> withExpect expect
+        |> HttpBuilder.toRequest
+
+
+tagsFromString : String -> List String
+tagsFromString str =
+    str
+        |> String.split " "
+        |> List.map String.trim
+        |> List.filter (not << String.isEmpty)
+
+
+edit : Slug -> Valid Form -> Cred -> Http.Request (Article Full)
+edit articleSlug validForm cred =
+    let
+        form =
+            fromValid validForm
+
+        expect =
+            Article.fullDecoder (Just cred)
+                |> Decode.field "article"
+                |> Http.expectJson
+
+        article =
+            Encode.object
+                [ ( "title", Encode.string form.title )
+                , ( "description", Encode.string form.description )
+                , ( "body", Encode.string form.body )
+                ]
+
+        jsonBody =
+            Encode.object [ ( "article", article ) ]
+                |> Http.jsonBody
+    in
+    Article.url articleSlug []
+        |> HttpBuilder.put
+        |> Cred.addHeader cred
+        |> withBody jsonBody
+        |> withExpect expect
+        |> HttpBuilder.toRequest
+
+
+
+-- EXPORT
+
+
+toSession : Model -> Session
+toSession model =
+    model.session
+
+
+
+-- INTERNAL
+
+
+{-| Used for setting the page's title.
+-}
+getSlug : Status -> Maybe Slug
+getSlug status =
+    case status of
+        Loading slug ->
+            Just slug
+
+        LoadingFailed slug ->
+            Just slug
+
+        Saving slug _ ->
+            Just slug
+
+        Editing slug _ _ ->
+            Just slug
+
+        EditingNew _ _ ->
+            Nothing
+
+        Creating _ ->
+            Nothing

advanced/part4/src/Page/Blank.elm

@@ -0,0 +1,10 @@
+module Page.Blank exposing (view)
+
+import Html exposing (Html)
+
+
+view : { title : String, content : Html msg }
+view =
+    { title = ""
+    , content = Html.text ""
+    }

advanced/part4/src/Page/Home.elm

@@ -0,0 +1,225 @@
+module Page.Home exposing (Model, Msg, init, subscriptions, toSession, update, view)
+
+{-| The homepage. You can get here via either the / or /#/ routes.
+-}
+
+import Article
+import Article.Feed as Feed
+import Article.FeedSources as FeedSources exposing (FeedSources, Source(..))
+import Article.Tag as Tag exposing (Tag)
+import Html exposing (..)
+import Html.Attributes exposing (attribute, class, classList, href, id, placeholder)
+import Html.Events exposing (onClick)
+import Http
+import Loading
+import Log
+import Page
+import Session exposing (Session)
+import Task exposing (Task)
+import Time
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- MODEL
+
+
+type alias Model =
+    { session : Session
+    , timeZone : Time.Zone
+
+    -- Loaded independently from server
+    , tags : Status (List Tag)
+    , feed : Status Feed.Model
+    }
+
+
+type Status a
+    = Loading
+    | Loaded a
+    | Failed
+
+
+init : Session -> ( Model, Cmd Msg )
+init session =
+    let
+        feedSources =
+            case Session.cred session of
+                Just cred ->
+                    FeedSources.fromLists (YourFeed cred) [ GlobalFeed ]
+
+                Nothing ->
+                    FeedSources.fromLists GlobalFeed []
+
+        loadTags =
+            Tag.list
+                |> Http.toTask
+    in
+    ( { session = session
+      , timeZone = Time.utc
+      , tags = Loading
+      , feed = Loading
+      }
+    , Cmd.batch
+        [ Feed.init session feedSources
+            |> Task.attempt CompletedFeedLoad
+        , Tag.list
+            |> Http.send CompletedTagsLoad
+        , Task.perform GotTimeZone Time.here
+        ]
+    )
+
+
+
+-- VIEW
+
+
+view : Model -> { title : String, content : Html Msg }
+view model =
+    { title = "Conduit"
+    , content =
+        div [ class "home-page" ]
+            [ viewBanner
+            , div [ class "container page" ]
+                [ div [ class "row" ]
+                    [ div [ class "col-md-9" ] <|
+                        case model.feed of
+                            Loaded feed ->
+                                viewFeed model.timeZone feed
+
+                            Loading ->
+                                [ Loading.icon ]
+
+                            Failed ->
+                                [ Loading.error "feed" ]
+                    , div [ class "col-md-3" ]
+                        [ div [ class "sidebar" ] <|
+                            case model.tags of
+                                Loaded tags ->
+                                    [ p [] [ text "Popular Tags" ]
+                                    , viewTags tags
+                                    ]
+
+                                Loading ->
+                                    [ Loading.icon ]
+
+                                Failed ->
+                                    [ Loading.error "tags" ]
+                        ]
+                    ]
+                ]
+            ]
+    }
+
+
+viewBanner : Html msg
+viewBanner =
+    div [ class "banner" ]
+        [ div [ class "container" ]
+            [ h1 [ class "logo-font" ] [ text "conduit" ]
+            , p [] [ text "A place to share your knowledge." ]
+            ]
+        ]
+
+
+viewFeed : Time.Zone -> Feed.Model -> List (Html Msg)
+viewFeed timeZone feed =
+    div [ class "feed-toggle" ]
+        [ Feed.viewFeedSources feed |> Html.map GotFeedMsg ]
+        :: (Feed.viewArticles timeZone feed |> List.map (Html.map GotFeedMsg))
+
+
+viewTags : List Tag -> Html Msg
+viewTags tags =
+    div [ class "tag-list" ] (List.map viewTag tags)
+
+
+viewTag : Tag -> Html Msg
+viewTag tagName =
+    a
+        [ class "tag-pill tag-default"
+        , onClick (ClickedTag tagName)
+
+        -- The RealWorld CSS requires an href to work properly.
+        , href ""
+        ]
+        [ text (Tag.toString tagName) ]
+
+
+
+-- UPDATE
+
+
+type Msg
+    = ClickedTag Tag
+    | CompletedFeedLoad (Result Http.Error Feed.Model)
+    | CompletedTagsLoad (Result Http.Error (List Tag))
+    | GotTimeZone Time.Zone
+    | GotFeedMsg Feed.Msg
+    | GotSession Session
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        ClickedTag tagName ->
+            let
+                subCmd =
+                    Feed.selectTag (Session.cred model.session) tagName
+            in
+            ( model, Cmd.map GotFeedMsg subCmd )
+
+        CompletedFeedLoad (Ok feed) ->
+            ( { model | feed = Loaded feed }, Cmd.none )
+
+        CompletedFeedLoad (Err error) ->
+            ( { model | feed = Failed }, Cmd.none )
+
+        CompletedTagsLoad (Ok tags) ->
+            ( { model | tags = Loaded tags }, Cmd.none )
+
+        CompletedTagsLoad (Err error) ->
+            ( { model | tags = Failed }
+            , Log.error
+            )
+
+        GotFeedMsg subMsg ->
+            case model.feed of
+                Loaded feed ->
+                    let
+                        ( newFeed, subCmd ) =
+                            Feed.update (Session.cred model.session) subMsg feed
+                    in
+                    ( { model | feed = Loaded newFeed }
+                    , Cmd.map GotFeedMsg subCmd
+                    )
+
+                Loading ->
+                    ( model, Log.error )
+
+                Failed ->
+                    ( model, Log.error )
+
+        GotTimeZone tz ->
+            ( { model | timeZone = tz }, Cmd.none )
+
+        GotSession session ->
+            ( { model | session = session }, Cmd.none )
+
+
+
+-- SUBSCRIPTIONS
+
+
+subscriptions : Model -> Sub Msg
+subscriptions model =
+    Session.changes GotSession (Session.navKey model.session)
+
+
+
+-- EXPORT
+
+
+toSession : Model -> Session
+toSession model =
+    model.session

advanced/part4/src/Page/Login.elm

@@ -0,0 +1,259 @@
+module Page.Login exposing (Model, Msg, init, subscriptions, toSession, update, view)
+
+{-| The login page.
+-}
+
+import Api exposing (optionalError)
+import Browser.Navigation as Nav
+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 Route exposing (Route)
+import Session exposing (Session)
+import Validate exposing (Valid, Validator, fromValid, ifBlank, validate)
+import Viewer exposing (Viewer)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- MODEL
+
+
+type alias Model =
+    { session : Session
+    , errors : List Error
+    , form : Form
+    }
+
+
+type alias Form =
+    { email : String
+    , password : String
+    }
+
+
+init : Session -> ( Model, Cmd msg )
+init session =
+    ( { session = session
+      , errors = []
+      , form =
+            { email = ""
+            , password = ""
+            }
+      }
+    , Cmd.none
+    )
+
+
+
+-- VIEW
+
+
+view : Model -> { title : String, content : Html Msg }
+view model =
+    { title = "Login"
+    , content =
+        div [ class "cred-page" ]
+            [ div [ class "container page" ]
+                [ div [ class "row" ]
+                    [ div [ class "col-md-6 offset-md-3 col-xs-12" ]
+                        [ h1 [ class "text-xs-center" ] [ text "Sign in" ]
+                        , p [ class "text-xs-center" ]
+                            [ a [ Route.href Route.Register ]
+                                [ text "Need an account?" ]
+                            ]
+                        , ul [ class "error-messages" ] <|
+                            List.map (\( _, error ) -> li [] [ text error ]) model.errors
+                        , viewForm model.form
+                        ]
+                    ]
+                ]
+            ]
+    }
+
+
+viewForm : Form -> Html Msg
+viewForm form =
+    Html.form [ onSubmit SubmittedForm ]
+        [ fieldset [ class "form-group" ]
+            [ input
+                [ class "form-control form-control-lg"
+                , placeholder "Email"
+                , onInput EnteredEmail
+                , value form.email
+                ]
+                []
+            ]
+        , fieldset [ class "form-group" ]
+            [ input
+                [ class "form-control form-control-lg"
+                , type_ "password"
+                , placeholder "Password"
+                , onInput EnteredPassword
+                , value form.password
+                ]
+                []
+            ]
+        , button [ class "btn btn-lg btn-primary pull-xs-right" ]
+            [ text "Sign in" ]
+        ]
+
+
+
+-- UPDATE
+
+
+type Msg
+    = SubmittedForm
+    | EnteredEmail String
+    | EnteredPassword String
+    | CompletedLogin (Result Http.Error Viewer)
+    | GotSession Session
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        SubmittedForm ->
+            case validate formValidator model.form of
+                Ok validForm ->
+                    ( { model | errors = [] }
+                    , Http.send CompletedLogin (login validForm)
+                    )
+
+                Err errors ->
+                    ( { model | errors = errors }
+                    , Cmd.none
+                    )
+
+        EnteredEmail email ->
+            updateForm (\form -> { form | email = email }) model
+
+        EnteredPassword password ->
+            updateForm (\form -> { form | password = password }) model
+
+        CompletedLogin (Err error) ->
+            let
+                serverErrors =
+                    error
+                        |> Api.listErrors errorsDecoder
+                        |> List.map (\errorMessage -> ( Server, errorMessage ))
+                        |> List.append model.errors
+            in
+            ( { model | errors = List.append model.errors serverErrors }
+            , Cmd.none
+            )
+
+        CompletedLogin (Ok cred) ->
+            ( model
+            , Session.login cred
+            )
+
+        GotSession session ->
+            ( { model | session = session }, Cmd.none )
+
+
+{-| Helper function for `update`. Updates the form and returns Cmd.none and
+Ignored. Useful for recording form fields!
+-}
+updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
+updateForm transform model =
+    ( { model | form = transform model.form }, Cmd.none )
+
+
+
+-- SUBSCRIPTIONS
+
+
+subscriptions : Model -> Sub Msg
+subscriptions model =
+    Session.changes GotSession (Session.navKey model.session)
+
+
+
+-- VALIDATION
+
+
+type ErrorSource
+    = Server
+    | Email
+    | Password
+
+
+{-| Recording validation errors on a per-field basis facilitates displaying
+them inline next to the field where the error occurred.
+
+I implemented it this way out of habit, then realized the spec called for
+displaying all the errors at the top. I thought about simplifying it, but then
+figured it'd be useful to show how I would normally model this data - assuming
+the intended UX was to render errors per field.
+
+(The other part of this is having a view function like this:
+
+viewFormErrors : Field -> List Error -> Html msg
+
+...and it filters the list of errors to render only the ones for the given
+Field. This way you can call this:
+
+viewFormErrors Email model.errors
+
+...next to the `email` field, and call `viewFormErrors Password model.errors`
+next to the `password` field, and so on.
+
+-}
+type alias Error =
+    ( ErrorSource, String )
+
+
+formValidator : Validator Error Form
+formValidator =
+    Validate.all
+        [ ifBlank .email ( Email, "email can't be blank." )
+        , ifBlank .password ( Password, "password can't be blank." )
+        ]
+
+
+errorsDecoder : Decoder (List String)
+errorsDecoder =
+    Decode.succeed (\emailOrPassword email username password -> List.concat [ emailOrPassword, email, username, password ])
+        |> optionalError "email or password"
+        |> optionalError "email"
+        |> optionalError "username"
+        |> optionalError "password"
+
+
+
+-- HTTP
+
+
+login : Valid Form -> Http.Request Viewer
+login validForm =
+    let
+        form =
+            fromValid validForm
+
+        user =
+            Encode.object
+                [ ( "email", Encode.string form.email )
+                , ( "password", Encode.string form.password )
+                ]
+
+        body =
+            Encode.object [ ( "user", user ) ]
+                |> Http.jsonBody
+    in
+    Decode.field "user" Viewer.decoder
+        |> Http.post (Api.url [ "users", "login" ]) body
+
+
+
+-- EXPORT
+
+
+toSession : Model -> Session
+toSession model =
+    model.session

advanced/part4/src/Page/NotFound.elm

@@ -0,0 +1,21 @@
+module Page.NotFound exposing (view)
+
+import Assets
+import Html exposing (Html, div, h1, img, main_, text)
+import Html.Attributes exposing (alt, class, id, src, tabindex)
+
+
+
+-- VIEW
+
+
+view : { title : String, content : Html msg }
+view =
+    { title = "Page Not Found"
+    , content =
+        main_ [ id "content", class "container", tabindex -1 ]
+            [ h1 [] [ text "Not Found" ]
+            , div [ class "row" ]
+                [ img [ Assets.src Assets.error ] [] ]
+            ]
+    }

advanced/part4/src/Page/Profile.elm

@@ -0,0 +1,309 @@
+module Page.Profile exposing (Model, Msg, init, subscriptions, toSession, update, view)
+
+{-| An Author's profile.
+-}
+
+import Article.Feed as Feed exposing (ListConfig)
+import Article.FeedSources as FeedSources exposing (FeedSources, Source(..))
+import Author exposing (Author(..), FollowedAuthor, UnfollowedAuthor)
+import Avatar exposing (Avatar)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Http
+import Loading
+import Log
+import Page
+import Profile exposing (Profile)
+import Session exposing (Session)
+import Task exposing (Task)
+import Time
+import Username exposing (Username)
+import Viewer exposing (Viewer)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- MODEL
+
+
+type alias Model =
+    { session : Session
+    , timeZone : Time.Zone
+    , errors : List String
+
+    -- Loaded independently from server
+    , author : Status Author
+    , feed : Status Feed.Model
+    }
+
+
+type Status a
+    = Loading Username
+    | Loaded a
+    | Failed Username
+
+
+init : Session -> Username -> ( Model, Cmd Msg )
+init session username =
+    let
+        maybeCred =
+            Session.cred session
+    in
+    ( { session = session
+      , timeZone = Time.utc
+      , errors = []
+      , author = Loading username
+      , feed = Loading username
+      }
+    , Cmd.batch
+        [ Author.fetch username maybeCred
+            |> Http.toTask
+            |> Task.mapError (Tuple.pair username)
+            |> Task.attempt CompletedAuthorLoad
+        , defaultFeedSources username
+            |> Feed.init session
+            |> Task.mapError (Tuple.pair username)
+            |> Task.attempt CompletedFeedLoad
+        , Task.perform GotTimeZone Time.here
+        ]
+    )
+
+
+
+-- VIEW
+
+
+view : Model -> { title : String, content : Html Msg }
+view model =
+    let
+        title =
+            case model.author of
+                Loaded (IsViewer _ _) ->
+                    myProfileTitle
+
+                Loaded ((IsFollowing followedAuthor) as author) ->
+                    titleForOther (Author.username author)
+
+                Loaded ((IsNotFollowing unfollowedAuthor) as author) ->
+                    titleForOther (Author.username author)
+
+                Loading username ->
+                    if Just username == Maybe.map Cred.username (Session.cred model.session) then
+                        myProfileTitle
+
+                    else
+                        defaultTitle
+
+                Failed username ->
+                    -- We can't follow if it hasn't finished loading yet
+                    if Just username == Maybe.map Cred.username (Session.cred model.session) then
+                        myProfileTitle
+
+                    else
+                        defaultTitle
+    in
+    { title = title
+    , content =
+        case model.author of
+            Loaded author ->
+                let
+                    profile =
+                        Author.profile author
+
+                    username =
+                        Author.username author
+
+                    followButton =
+                        case Session.cred model.session of
+                            Just cred ->
+                                case author of
+                                    IsViewer _ _ ->
+                                        -- We can't follow ourselves!
+                                        text ""
+
+                                    IsFollowing followedAuthor ->
+                                        Author.unfollowButton (ClickedUnfollow cred) followedAuthor
+
+                                    IsNotFollowing unfollowedAuthor ->
+                                        Author.followButton (ClickedFollow cred) unfollowedAuthor
+
+                            Nothing ->
+                                -- We can't follow if we're logged out
+                                text ""
+                in
+                div [ class "profile-page" ]
+                    [ Page.viewErrors ClickedDismissErrors model.errors
+                    , div [ class "user-info" ]
+                        [ div [ class "container" ]
+                            [ div [ class "row" ]
+                                [ div [ class "col-xs-12 col-md-10 offset-md-1" ]
+                                    [ img [ class "user-img", Avatar.src (Profile.avatar profile) ] []
+                                    , h4 [] [ Username.toHtml username ]
+                                    , p [] [ text (Maybe.withDefault "" (Profile.bio profile)) ]
+                                    , followButton
+                                    ]
+                                ]
+                            ]
+                        ]
+                    , case model.feed of
+                        Loaded feed ->
+                            div [ class "container" ]
+                                [ div [ class "row" ] [ viewFeed model.timeZone feed ] ]
+
+                        Loading _ ->
+                            Loading.icon
+
+                        Failed _ ->
+                            Loading.error "feed"
+                    ]
+
+            Loading _ ->
+                Loading.icon
+
+            Failed _ ->
+                Loading.error "profile"
+    }
+
+
+
+-- PAGE TITLE
+
+
+titleForOther : Username -> String
+titleForOther otherUsername =
+    "Profile — " ++ Username.toString otherUsername
+
+
+myProfileTitle : String
+myProfileTitle =
+    "My Profile"
+
+
+defaultTitle : String
+defaultTitle =
+    "Profile"
+
+
+
+-- FEED
+
+
+viewFeed : Time.Zone -> Feed.Model -> Html Msg
+viewFeed timeZone feed =
+    div [ class "col-xs-12 col-md-10 offset-md-1" ] <|
+        div [ class "articles-toggle" ]
+            [ Feed.viewFeedSources feed |> Html.map GotFeedMsg ]
+            :: (Feed.viewArticles timeZone feed |> List.map (Html.map GotFeedMsg))
+
+
+
+-- UPDATE
+
+
+type Msg
+    = ClickedDismissErrors
+    | ClickedFollow Cred UnfollowedAuthor
+    | ClickedUnfollow Cred FollowedAuthor
+    | CompletedFollowChange (Result Http.Error Author)
+    | CompletedAuthorLoad (Result ( Username, Http.Error ) Author)
+    | CompletedFeedLoad (Result ( Username, Http.Error ) Feed.Model)
+    | GotTimeZone Time.Zone
+    | GotFeedMsg Feed.Msg
+    | GotSession Session
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        ClickedDismissErrors ->
+            ( { model | errors = [] }, Cmd.none )
+
+        ClickedUnfollow cred followedAuthor ->
+            ( model
+            , Author.requestUnfollow followedAuthor cred
+                |> Http.send CompletedFollowChange
+            )
+
+        ClickedFollow cred unfollowedAuthor ->
+            ( model
+            , Author.requestFollow unfollowedAuthor cred
+                |> Http.send CompletedFollowChange
+            )
+
+        CompletedFollowChange (Ok newAuthor) ->
+            ( { model | author = Loaded newAuthor }
+            , Cmd.none
+            )
+
+        CompletedFollowChange (Err error) ->
+            ( model
+            , Log.error
+            )
+
+        CompletedAuthorLoad (Ok author) ->
+            ( { model | author = Loaded author }, Cmd.none )
+
+        CompletedAuthorLoad (Err ( username, err )) ->
+            ( { model | author = Failed username }
+            , Log.error
+            )
+
+        CompletedFeedLoad (Ok feed) ->
+            ( { model | feed = Loaded feed }
+            , Cmd.none
+            )
+
+        CompletedFeedLoad (Err ( username, err )) ->
+            ( { model | feed = Failed username }
+            , Log.error
+            )
+
+        GotFeedMsg subMsg ->
+            case model.feed of
+                Loaded feed ->
+                    let
+                        ( newFeed, subCmd ) =
+                            Feed.update (Session.cred model.session) subMsg feed
+                    in
+                    ( { model | feed = Loaded newFeed }
+                    , Cmd.map GotFeedMsg subCmd
+                    )
+
+                Loading _ ->
+                    ( model, Log.error )
+
+                Failed _ ->
+                    ( model, Log.error )
+
+        GotTimeZone tz ->
+            ( { model | timeZone = tz }, Cmd.none )
+
+        GotSession session ->
+            ( { model | session = session }, Cmd.none )
+
+
+
+-- SUBSCRIPTIONS
+
+
+subscriptions : Model -> Sub Msg
+subscriptions model =
+    Session.changes GotSession (Session.navKey model.session)
+
+
+
+-- EXPORT
+
+
+toSession : Model -> Session
+toSession model =
+    model.session
+
+
+
+-- INTERNAL
+
+
+defaultFeedSources : Username -> FeedSources
+defaultFeedSources username =
+    FeedSources.fromLists (AuthorFeed username) [ FavoritedFeed username ]

advanced/part4/src/Page/Register.elm

@@ -0,0 +1,266 @@
+module Page.Register exposing (Model, Msg, init, subscriptions, toSession, update, view)
+
+import Api exposing (optionalError)
+import Browser.Navigation as Nav
+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 Route exposing (Route)
+import Session exposing (Session)
+import Validate exposing (Valid, Validator, fromValid, ifBlank, validate)
+import Viewer exposing (Viewer)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- MODEL
+
+
+type alias Model =
+    { session : Session
+    , errors : List Error
+    , form : Form
+    }
+
+
+type alias Form =
+    { email : String
+    , username : String
+    , password : String
+    }
+
+
+init : Session -> ( Model, Cmd msg )
+init session =
+    ( { session = session
+      , errors = []
+      , form =
+            { email = ""
+            , username = ""
+            , password = ""
+            }
+      }
+    , Cmd.none
+    )
+
+
+
+-- VIEW
+
+
+view : Model -> { title : String, content : Html Msg }
+view model =
+    { title = "Register"
+    , content =
+        div [ class "cred-page" ]
+            [ div [ class "container page" ]
+                [ div [ class "row" ]
+                    [ div [ class "col-md-6 offset-md-3 col-xs-12" ]
+                        [ h1 [ class "text-xs-center" ] [ text "Sign up" ]
+                        , p [ class "text-xs-center" ]
+                            [ a [ Route.href Route.Login ]
+                                [ text "Have an account?" ]
+                            ]
+                        , model.errors
+                            |> List.map (\( _, error ) -> li [] [ text error ])
+                            |> ul [ class "error-messages" ]
+                        , viewForm model.form
+                        ]
+                    ]
+                ]
+            ]
+    }
+
+
+viewForm : Form -> Html Msg
+viewForm form =
+    Html.form [ onSubmit SubmittedForm ]
+        [ fieldset [ class "form-group" ]
+            [ input
+                [ class "form-control form-control-lg"
+                , placeholder "Username"
+                , onInput EnteredUsername
+                , value form.username
+                ]
+                []
+            ]
+        , fieldset [ class "form-group" ]
+            [ input
+                [ class "form-control form-control-lg"
+                , placeholder "Email"
+                , onInput EnteredEmail
+                , value form.email
+                ]
+                []
+            ]
+        , fieldset [ class "form-group" ]
+            [ input
+                [ class "form-control form-control-lg"
+                , type_ "password"
+                , placeholder "Password"
+                , onInput EnteredPassword
+                , value form.password
+                ]
+                []
+            ]
+        , button [ class "btn btn-lg btn-primary pull-xs-right" ]
+            [ text "Sign up" ]
+        ]
+
+
+
+-- UPDATE
+
+
+type Msg
+    = SubmittedForm
+    | EnteredEmail String
+    | EnteredUsername String
+    | EnteredPassword String
+    | CompletedRegister (Result Http.Error Viewer)
+    | GotSession Session
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        SubmittedForm ->
+            case validate formValidator model.form of
+                Ok validForm ->
+                    ( { model | errors = [] }
+                    , Http.send CompletedRegister (register validForm)
+                    )
+
+                Err errors ->
+                    ( { model | errors = errors }
+                    , Cmd.none
+                    )
+
+        EnteredUsername username ->
+            updateForm (\form -> { form | username = username }) model
+
+        EnteredEmail email ->
+            updateForm (\form -> { form | email = email }) model
+
+        EnteredPassword password ->
+            updateForm (\form -> { form | password = password }) model
+
+        CompletedRegister (Err error) ->
+            let
+                serverErrors =
+                    error
+                        |> Api.listErrors errorsDecoder
+                        |> List.map (\errorMessage -> ( Server, errorMessage ))
+            in
+            ( { model | errors = List.append model.errors serverErrors }
+            , Cmd.none
+            )
+
+        CompletedRegister (Ok cred) ->
+            ( model
+            , Session.login cred
+            )
+
+        GotSession session ->
+            ( { model | session = session }, Cmd.none )
+
+
+{-| Helper function for `update`. Updates the form and returns Cmd.none and
+Ignored. Useful for recording form fields!
+-}
+updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
+updateForm transform model =
+    ( { model | form = transform model.form }, Cmd.none )
+
+
+
+-- SUBSCRIPTIONS
+
+
+subscriptions : Model -> Sub Msg
+subscriptions model =
+    Session.changes GotSession (Session.navKey model.session)
+
+
+
+-- EXPORT
+
+
+toSession : Model -> Session
+toSession model =
+    model.session
+
+
+
+-- VALIDATION
+
+
+type ErrorSource
+    = Server
+    | Username
+    | Email
+    | Password
+
+
+type alias Error =
+    ( ErrorSource, String )
+
+
+formValidator : Validator Error Form
+formValidator =
+    Validate.all
+        [ ifBlank .username ( Username, "username can't be blank." )
+        , ifBlank .email ( Email, "email can't be blank." )
+        , Validate.fromErrors passwordLength
+        ]
+
+
+minPasswordChars : Int
+minPasswordChars =
+    6
+
+
+passwordLength : Form -> List Error
+passwordLength { password } =
+    if String.length password < minPasswordChars then
+        [ ( Password, "password must be at least " ++ String.fromInt minPasswordChars ++ " characters long." ) ]
+
+    else
+        []
+
+
+errorsDecoder : Decoder (List String)
+errorsDecoder =
+    Decode.succeed (\email username password -> List.concat [ email, username, password ])
+        |> optionalError "email"
+        |> optionalError "username"
+        |> optionalError "password"
+
+
+
+-- HTTP
+
+
+register : Valid Form -> Http.Request Viewer
+register validForm =
+    let
+        form =
+            fromValid validForm
+
+        user =
+            Encode.object
+                [ ( "username", Encode.string form.username )
+                , ( "email", Encode.string form.email )
+                , ( "password", Encode.string form.password )
+                ]
+
+        body =
+            Encode.object [ ( "user", user ) ]
+                |> Http.jsonBody
+    in
+    Decode.field "user" Viewer.decoder
+        |> Http.post (Api.url [ "users" ]) body

advanced/part4/src/Page/Settings.elm

@@ -0,0 +1,356 @@
+module Page.Settings exposing (Model, Msg, init, subscriptions, toSession, update, view)
+
+import Api exposing (optionalError)
+import Avatar
+import Browser.Navigation as Nav
+import Email exposing (Email)
+import Html exposing (Html, button, div, fieldset, h1, input, li, text, textarea, ul)
+import Html.Attributes exposing (attribute, class, placeholder, type_, value)
+import Html.Events exposing (onInput, onSubmit)
+import Http
+import HttpBuilder
+import Json.Decode as Decode exposing (Decoder, decodeString, field, list, string)
+import Json.Decode.Pipeline exposing (optional)
+import Json.Encode as Encode
+import Profile exposing (Profile)
+import Route
+import Session exposing (Session)
+import Username as Username exposing (Username)
+import Validate exposing (Valid, Validator, fromValid, ifBlank, validate)
+import Viewer exposing (Viewer)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- MODEL
+
+
+type alias Model =
+    { session : Session
+    , errors : List Error
+    , form : Form
+    }
+
+
+type alias Form =
+    { avatar : Maybe String
+    , bio : String
+    , email : String
+    , username : String
+    , password : Maybe String
+    }
+
+
+init : Session -> ( Model, Cmd msg )
+init session =
+    ( { session = session
+      , errors = []
+      , form =
+            case Session.viewer session of
+                Just viewer ->
+                    let
+                        profile =
+                            Viewer.profile viewer
+
+                        cred =
+                            Viewer.cred viewer
+                    in
+                    { avatar = Avatar.toMaybeString (Profile.avatar profile)
+                    , email = Email.toString (Viewer.email viewer)
+                    , bio = Maybe.withDefault "" (Profile.bio profile)
+                    , username = Username.toString (Cred.username cred)
+                    , password = Nothing
+                    }
+
+                Nothing ->
+                    -- It's fine to store a blank form here. You won't be
+                    -- able to submit it if you're not logged in anyway.
+                    { avatar = Nothing
+                    , email = ""
+                    , bio = ""
+                    , username = ""
+                    , password = Nothing
+                    }
+      }
+    , Cmd.none
+    )
+
+
+{-| A form that has been validated. Only the `edit` function uses this. Its
+purpose is to prevent us from forgetting to validate the form before passing
+it to `edit`.
+
+This doesn't create any guarantees that the form was actually validated. If
+we wanted to do that, we'd need to move the form data into a separate module!
+
+-}
+type ValidForm
+    = Valid Form
+
+
+
+-- VIEW
+
+
+view : Model -> { title : String, content : Html Msg }
+view model =
+    { title = "Settings"
+    , content =
+        case Session.cred model.session of
+            Just cred ->
+                div [ class "settings-page" ]
+                    [ div [ class "container page" ]
+                        [ div [ class "row" ]
+                            [ div [ class "col-md-6 offset-md-3 col-xs-12" ]
+                                [ h1 [ class "text-xs-center" ] [ text "Your Settings" ]
+                                , model.errors
+                                    |> List.map (\( _, error ) -> li [] [ text error ])
+                                    |> ul [ class "error-messages" ]
+                                , viewForm cred model.form
+                                ]
+                            ]
+                        ]
+                    ]
+
+            Nothing ->
+                text "Sign in to view your settings."
+    }
+
+
+viewForm : Cred -> Form -> Html Msg
+viewForm cred form =
+    Html.form [ onSubmit (SubmittedForm cred) ]
+        [ fieldset []
+            [ fieldset [ class "form-group" ]
+                [ input
+                    [ class "form-control"
+                    , placeholder "URL of profile picture"
+                    , value (Maybe.withDefault "" form.avatar)
+                    , onInput EnteredImage
+                    ]
+                    []
+                ]
+            , fieldset [ class "form-group" ]
+                [ input
+                    [ class "form-control form-control-lg"
+                    , placeholder "Username"
+                    , value form.username
+                    , onInput EnteredUsername
+                    ]
+                    []
+                ]
+            , fieldset [ class "form-group" ]
+                [ textarea
+                    [ class "form-control form-control-lg"
+                    , placeholder "Short bio about you"
+                    , attribute "rows" "8"
+                    , value form.bio
+                    , onInput EnteredBio
+                    ]
+                    []
+                ]
+            , fieldset [ class "form-group" ]
+                [ input
+                    [ class "form-control form-control-lg"
+                    , placeholder "Email"
+                    , value form.email
+                    , onInput EnteredEmail
+                    ]
+                    []
+                ]
+            , fieldset [ class "form-group" ]
+                [ input
+                    [ class "form-control form-control-lg"
+                    , type_ "password"
+                    , placeholder "Password"
+                    , value (Maybe.withDefault "" form.password)
+                    , onInput EnteredPassword
+                    ]
+                    []
+                ]
+            , button
+                [ class "btn btn-lg btn-primary pull-xs-right" ]
+                [ text "Update Settings" ]
+            ]
+        ]
+
+
+
+-- UPDATE
+
+
+type Msg
+    = SubmittedForm Cred
+    | EnteredEmail String
+    | EnteredUsername String
+    | EnteredPassword String
+    | EnteredBio String
+    | EnteredImage String
+    | CompletedSave (Result Http.Error Viewer)
+    | GotSession Session
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        SubmittedForm cred ->
+            case validate formValidator model.form of
+                Ok validForm ->
+                    ( { model | errors = [] }
+                    , edit cred validForm
+                        |> Http.send CompletedSave
+                    )
+
+                Err errors ->
+                    ( { model | errors = errors }
+                    , Cmd.none
+                    )
+
+        EnteredEmail email ->
+            updateForm (\form -> { form | email = email }) model
+
+        EnteredUsername username ->
+            updateForm (\form -> { form | username = username }) model
+
+        EnteredPassword passwordStr ->
+            let
+                password =
+                    if String.isEmpty passwordStr then
+                        Nothing
+
+                    else
+                        Just passwordStr
+            in
+            updateForm (\form -> { form | password = password }) model
+
+        EnteredBio bio ->
+            updateForm (\form -> { form | bio = bio }) model
+
+        EnteredImage avatarStr ->
+            let
+                avatar =
+                    if String.isEmpty avatarStr then
+                        Nothing
+
+                    else
+                        Just avatarStr
+            in
+            updateForm (\form -> { form | avatar = avatar }) model
+
+        CompletedSave (Err error) ->
+            let
+                serverErrors =
+                    error
+                        |> Api.listErrors errorsDecoder
+                        |> List.map (\errorMessage -> ( Server, errorMessage ))
+            in
+            ( { model | errors = List.append model.errors serverErrors }
+            , Cmd.none
+            )
+
+        CompletedSave (Ok cred) ->
+            ( model
+            , Session.login cred
+            )
+
+        GotSession session ->
+            ( { model | session = session }, Cmd.none )
+
+
+{-| Helper function for `update`. Updates the form and returns Cmd.none and
+Ignored. Useful for recording form fields!
+-}
+updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
+updateForm transform model =
+    ( { model | form = transform model.form }, Cmd.none )
+
+
+
+-- SUBSCRIPTIONS
+
+
+subscriptions : Model -> Sub Msg
+subscriptions model =
+    Session.changes GotSession (Session.navKey model.session)
+
+
+
+-- EXPORT
+
+
+toSession : Model -> Session
+toSession model =
+    model.session
+
+
+
+-- VALIDATION
+
+
+type ErrorSource
+    = Server
+    | Username
+    | Email
+    | Password
+    | ImageUrl
+    | Bio
+
+
+type alias Error =
+    ( ErrorSource, String )
+
+
+formValidator : Validator Error Form
+formValidator =
+    Validate.all
+        [ ifBlank .username ( Username, "username can't be blank." )
+        , ifBlank .email ( Email, "email can't be blank." )
+        ]
+
+
+errorsDecoder : Decoder (List String)
+errorsDecoder =
+    Decode.succeed (\email username password -> List.concat [ email, username, password ])
+        |> optionalError "email"
+        |> optionalError "username"
+        |> optionalError "password"
+
+
+
+-- HTTP
+
+
+{-| This takes a Valid Form as a reminder that it needs to have been validated
+first.
+-}
+edit : Cred -> Valid Form -> Http.Request Viewer
+edit cred validForm =
+    let
+        form =
+            fromValid validForm
+
+        updates =
+            [ Just ( "username", Encode.string form.username )
+            , Just ( "email", Encode.string form.email )
+            , Just ( "bio", Encode.string form.bio )
+            , Just ( "image", Maybe.withDefault Encode.null (Maybe.map Encode.string form.avatar) )
+            , Maybe.map (\pass -> ( "password", Encode.string pass )) form.password
+            ]
+                |> List.filterMap identity
+
+        body =
+            ( "user", Encode.object updates )
+                |> List.singleton
+                |> Encode.object
+                |> Http.jsonBody
+
+        expect =
+            Decode.field "user" Viewer.decoder
+                |> Http.expectJson
+    in
+    Api.url [ "user" ]
+        |> HttpBuilder.put
+        |> HttpBuilder.withExpect expect
+        |> HttpBuilder.withBody body
+        |> Cred.addHeader cred
+        |> HttpBuilder.toRequest