Add part10

part10/src/Page/Article.elm

@@ -0,0 +1,406 @@
+module Page.Article exposing (Model, Msg, init, update, view)
+
+{-| Viewing an individual article.
+-}
+
+import Data.Article as Article exposing (Article, Body)
+import Data.Article.Author exposing (Author)
+import Data.Article.Comment exposing (Comment, CommentId)
+import Data.Session as Session exposing (Session)
+import Data.User as User exposing (User)
+import Data.UserPhoto as UserPhoto
+import Date exposing (Date)
+import Date.Format
+import Html exposing (..)
+import Html.Attributes exposing (attribute, class, disabled, href, id, placeholder)
+import Html.Events exposing (onClick, onInput, onSubmit)
+import Http
+import Page.Errored exposing (PageLoadError, pageLoadError)
+import Request.Article
+import Request.Article.Comments
+import Request.Profile
+import Route
+import Task exposing (Task)
+import Util exposing (pair, viewIf)
+import Views.Article
+import Views.Article.Favorite as Favorite
+import Views.Author
+import Views.Errors
+import Views.Page as Page
+import Views.User.Follow as Follow
+
+
+-- MODEL --
+
+
+type alias Model =
+    { errors : List String
+    , commentText : String
+    , commentInFlight : Bool
+    , article : Article Body
+    , comments : List Comment
+    }
+
+
+init : Session -> Article.Slug -> Task PageLoadError Model
+init session slug =
+    let
+        maybeAuthToken =
+            Maybe.map .token session.user
+
+        loadArticle =
+            Request.Article.get maybeAuthToken slug
+                |> Http.toTask
+
+        loadComments =
+            Request.Article.Comments.list maybeAuthToken slug
+                |> Http.toTask
+
+        handleLoadError _ =
+            pageLoadError Page.Other "Article is currently unavailable."
+    in
+    Task.map2 (Model [] "" False) loadArticle loadComments
+        |> Task.mapError handleLoadError
+
+
+
+-- VIEW --
+
+
+view : Session -> Model -> Html Msg
+view session model =
+    let
+        article =
+            model.article
+
+        author =
+            article.author
+
+        buttons =
+            viewButtons article author session.user
+
+        postingDisabled =
+            model.commentInFlight
+    in
+    div [ class "article-page" ]
+        [ viewBanner model.errors article author session.user
+        , div [ class "container page" ]
+            [ div [ class "row article-content" ]
+                [ div [ class "col-md-12" ]
+                    [ Article.bodyToHtml article.body [] ]
+                ]
+            , hr [] []
+            , div [ class "article-actions" ]
+                [ div [ class "article-meta" ] <|
+                    [ a [ Route.href (Route.Profile author.username) ]
+                        [ img [ UserPhoto.src author.image ] [] ]
+                    , div [ class "info" ]
+                        [ Views.Author.view author.username
+                        , Views.Article.viewTimestamp article
+                        ]
+                    ]
+                        ++ buttons
+                ]
+            , div [ class "row" ]
+                [ div [ class "col-xs-12 col-md-8 offset-md-2" ] <|
+                    viewAddComment postingDisabled session.user
+                        :: List.map (viewComment session.user) model.comments
+                ]
+            ]
+        ]
+
+
+viewBanner : List String -> Article a -> Author -> Maybe User -> Html Msg
+viewBanner errors article author maybeUser =
+    let
+        buttons =
+            viewButtons article author maybeUser
+    in
+    div [ class "banner" ]
+        [ div [ class "container" ]
+            [ h1 [] [ text article.title ]
+            , div [ class "article-meta" ] <|
+                [ a [ Route.href (Route.Profile author.username) ]
+                    [ img [ UserPhoto.src author.image ] [] ]
+                , div [ class "info" ]
+                    [ Views.Author.view author.username
+                    , Views.Article.viewTimestamp article
+                    ]
+                ]
+                    ++ buttons
+            , Views.Errors.view DismissErrors errors
+            ]
+        ]
+
+
+viewAddComment : Bool -> Maybe User -> Html Msg
+viewAddComment postingDisabled maybeUser =
+    case maybeUser of
+        Nothing ->
+            p []
+                [ a [ Route.href Route.Login ] [ text "Sign in" ]
+                , text " or "
+                , a [ Route.href Route.Register ] [ text "sign up" ]
+                , text " to add comments on this article."
+                ]
+
+        Just user ->
+            Html.form [ class "card comment-form", onSubmit PostComment ]
+                [ div [ class "card-block" ]
+                    [ textarea
+                        [ class "form-control"
+                        , placeholder "Write a comment..."
+                        , attribute "rows" "3"
+                        , onInput SetCommentText
+                        ]
+                        []
+                    ]
+                , div [ class "card-footer" ]
+                    [ img [ class "comment-author-img", UserPhoto.src user.image ] []
+                    , button
+                        [ class "btn btn-sm btn-primary"
+                        , disabled postingDisabled
+                        ]
+                        [ text "Post Comment" ]
+                    ]
+                ]
+
+
+viewButtons : Article a -> Author -> Maybe User -> List (Html Msg)
+viewButtons article author maybeUser =
+    let
+        isMyArticle =
+            Maybe.map .username maybeUser == Just author.username
+    in
+    if isMyArticle then
+        [ editButton article
+        , text " "
+        , deleteButton article
+        ]
+    else
+        [ followButton author
+        , text " "
+        , favoriteButton article
+        ]
+
+
+viewComment : Maybe User -> Comment -> Html Msg
+viewComment user comment =
+    let
+        author =
+            comment.author
+
+        isAuthor =
+            Maybe.map .username user == Just comment.author.username
+    in
+    div [ class "card" ]
+        [ div [ class "card-block" ]
+            [ p [ class "card-text" ] [ text comment.body ] ]
+        , div [ class "card-footer" ]
+            [ a [ class "comment-author", href "" ]
+                [ img [ class "comment-author-img", UserPhoto.src author.image ] []
+                , text " "
+                ]
+            , text " "
+            , a [ class "comment-author", Route.href (Route.Profile author.username) ]
+                [ text (User.usernameToString comment.author.username) ]
+            , span [ class "date-posted" ] [ text (formatCommentTimestamp comment.createdAt) ]
+            , viewIf isAuthor <|
+                span
+                    [ class "mod-options"
+                    , onClick (DeleteComment comment.id)
+                    ]
+                    [ i [ class "ion-trash-a" ] [] ]
+            ]
+        ]
+
+
+formatCommentTimestamp : Date -> String
+formatCommentTimestamp =
+    Date.Format.format "%B %e, %Y"
+
+
+
+-- UPDATE --
+
+
+type Msg
+    = DismissErrors
+    | ToggleFavorite
+    | FavoriteCompleted (Result Http.Error (Article Body))
+    | ToggleFollow
+    | FollowCompleted (Result Http.Error Author)
+    | SetCommentText String
+    | DeleteComment CommentId
+    | CommentDeleted CommentId (Result Http.Error ())
+    | PostComment
+    | CommentPosted (Result Http.Error Comment)
+    | DeleteArticle
+    | ArticleDeleted (Result Http.Error ())
+
+
+update : Session -> Msg -> Model -> ( Model, Cmd Msg )
+update session msg model =
+    let
+        article =
+            model.article
+
+        author =
+            article.author
+    in
+    case msg of
+        DismissErrors ->
+            ( { model | errors = [] }, Cmd.none )
+
+        ToggleFavorite ->
+            let
+                cmdFromAuth authToken =
+                    Request.Article.toggleFavorite model.article authToken
+                        |> Http.toTask
+                        |> Task.map (\newArticle -> { newArticle | body = article.body })
+                        |> Task.attempt FavoriteCompleted
+            in
+            session
+                |> Session.attempt "favorite" cmdFromAuth
+                |> Tuple.mapFirst (Util.appendErrors model)
+
+        FavoriteCompleted (Ok newArticle) ->
+            ( { model | article = newArticle }, Cmd.none )
+
+        FavoriteCompleted (Err error) ->
+            -- In a serious production application, we would log the error to
+            -- a logging service so we could investigate later.
+            ( [ "There was a server error trying to record your Favorite. Sorry!" ]
+                |> Util.appendErrors model
+            , Cmd.none
+            )
+
+        ToggleFollow ->
+            let
+                cmdFromAuth authToken =
+                    authToken
+                        |> Request.Profile.toggleFollow author.username author.following
+                        |> Http.send FollowCompleted
+            in
+            session
+                |> Session.attempt "follow" cmdFromAuth
+                |> Tuple.mapFirst (Util.appendErrors model)
+
+        FollowCompleted (Ok { following }) ->
+            let
+                newArticle =
+                    { article | author = { author | following = following } }
+            in
+            ( { model | article = newArticle }, Cmd.none )
+
+        FollowCompleted (Err error) ->
+            ( { model | errors = "Unable to follow user." :: model.errors }, Cmd.none )
+
+        SetCommentText commentText ->
+            ( { model | commentText = commentText }, Cmd.none )
+
+        PostComment ->
+            let
+                comment =
+                    model.commentText
+            in
+            if model.commentInFlight || String.isEmpty comment then
+                ( model, Cmd.none )
+            else
+                let
+                    cmdFromAuth authToken =
+                        authToken
+                            |> Request.Article.Comments.post model.article.slug comment
+                            |> Http.send CommentPosted
+                in
+                session
+                    |> Session.attempt "post a comment" cmdFromAuth
+                    |> Tuple.mapFirst (Util.appendErrors { model | commentInFlight = True })
+
+        CommentPosted (Ok comment) ->
+            ( { model
+                | commentInFlight = False
+                , comments = comment :: model.comments
+              }
+            , Cmd.none
+            )
+
+        CommentPosted (Err error) ->
+            ( { model | errors = model.errors ++ [ "Server error while trying to post comment." ] }
+            , Cmd.none
+            )
+
+        DeleteComment id ->
+            let
+                cmdFromAuth authToken =
+                    authToken
+                        |> Request.Article.Comments.delete model.article.slug id
+                        |> Http.send (CommentDeleted id)
+            in
+            session
+                |> Session.attempt "delete comments" cmdFromAuth
+                |> Tuple.mapFirst (Util.appendErrors model)
+
+        CommentDeleted id (Ok ()) ->
+            ( { model | comments = withoutComment id model.comments }
+            , Cmd.none
+            )
+
+        CommentDeleted id (Err error) ->
+            ( { model | errors = model.errors ++ [ "Server error while trying to delete comment." ] }
+            , Cmd.none
+            )
+
+        DeleteArticle ->
+            let
+                cmdFromAuth authToken =
+                    authToken
+                        |> Request.Article.delete model.article.slug
+                        |> Http.send ArticleDeleted
+            in
+            session
+                |> Session.attempt "delete articles" cmdFromAuth
+                |> Tuple.mapFirst (Util.appendErrors model)
+
+        ArticleDeleted (Ok ()) ->
+            ( model, Route.modifyUrl Route.Home )
+
+        ArticleDeleted (Err error) ->
+            ( { model | errors = model.errors ++ [ "Server error while trying to delete article." ] }
+            , Cmd.none
+            )
+
+
+
+-- INTERNAL --
+
+
+withoutComment : CommentId -> List Comment -> List Comment
+withoutComment id =
+    List.filter (\comment -> comment.id /= id)
+
+
+favoriteButton : Article a -> Html Msg
+favoriteButton article =
+    let
+        favoriteText =
+            " Favorite Article (" ++ toString article.favoritesCount ++ ")"
+    in
+    Favorite.button (\_ -> ToggleFavorite) article [] [ text favoriteText ]
+
+
+deleteButton : Article a -> Html Msg
+deleteButton article =
+    button [ class "btn btn-outline-danger btn-sm", onClick DeleteArticle ]
+        [ 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) ]
+        [ i [ class "ion-edit" ] [], text " Edit Article" ]
+
+
+followButton : Follow.State record -> Html Msg
+followButton =
+    Follow.button (\_ -> ToggleFollow)

part10/src/Page/Article/Editor.elm

@@ -0,0 +1,244 @@
+module Page.Article.Editor exposing (Model, Msg, initEdit, initNew, update, view)
+
+import Data.Article as Article exposing (Article, Body)
+import Data.Session exposing (Session)
+import Data.User exposing (User)
+import Html exposing (..)
+import Html.Attributes exposing (attribute, class, disabled, href, id, placeholder, type_, value)
+import Html.Events exposing (onInput, onSubmit)
+import Http
+import Page.Errored exposing (PageLoadError, pageLoadError)
+import Request.Article
+import Route
+import Task exposing (Task)
+import Util exposing (pair, viewIf)
+import Validate exposing (Validator, ifBlank, validate)
+import Views.Form as Form
+import Views.Page as Page
+
+
+-- MODEL --
+
+
+type alias Model =
+    { errors : List Error
+    , editingArticle : Maybe Article.Slug
+    , title : String
+    , body : String
+    , description : String
+    , tags : List String
+    , isSaving : Bool
+    }
+
+
+initNew : Model
+initNew =
+    { errors = []
+    , editingArticle = Nothing
+    , title = ""
+    , body = ""
+    , description = ""
+    , tags = []
+    , isSaving = False
+    }
+
+
+initEdit : Session -> Article.Slug -> Task PageLoadError Model
+initEdit session slug =
+    let
+        maybeAuthToken =
+            session.user
+                |> Maybe.map .token
+    in
+    Request.Article.get maybeAuthToken slug
+        |> Http.toTask
+        |> Task.mapError (\_ -> pageLoadError Page.Other "Article is currently unavailable.")
+        |> Task.map
+            (\article ->
+                { errors = []
+                , editingArticle = Just slug
+                , title = article.title
+                , body = Article.bodyToMarkdownString article.body
+                , description = article.description
+                , tags = article.tags
+                , isSaving = False
+                }
+            )
+
+
+
+-- VIEW --
+
+
+view : Model -> Html Msg
+view model =
+    div [ class "editor-page" ]
+        [ div [ class "container page" ]
+            [ div [ class "row" ]
+                [ div [ class "col-md-10 offset-md-1 col-xs-12" ]
+                    [ Form.viewErrors model.errors
+                    , viewForm model
+                    ]
+                ]
+            ]
+        ]
+
+
+viewForm : Model -> Html Msg
+viewForm model =
+    let
+        isEditing =
+            model.editingArticle /= Nothing
+
+        saveButtonText =
+            if isEditing then
+                "Update Article"
+            else
+                "Publish Article"
+    in
+    Html.form [ onSubmit Save ]
+        [ fieldset []
+            [ Form.input
+                [ class "form-control-lg"
+                , placeholder "Article Title"
+                , onInput SetTitle
+                , value model.title
+                ]
+                []
+            , Form.input
+                [ placeholder "What's this article about?"
+                , onInput SetDescription
+                , value model.description
+                ]
+                []
+            , Form.textarea
+                [ placeholder "Write your article (in markdown)"
+                , attribute "rows" "8"
+                , onInput SetBody
+                , value model.body
+                ]
+                []
+            , Form.input
+                [ placeholder "Enter tags"
+                , onInput SetTags
+                , value (String.join " " model.tags)
+                ]
+                []
+            , button [ class "btn btn-lg pull-xs-right btn-primary", disabled model.isSaving ]
+                [ text saveButtonText ]
+            ]
+        ]
+
+
+
+-- UPDATE --
+
+
+type Msg
+    = Save
+    | SetTitle String
+    | SetDescription String
+    | SetTags String
+    | SetBody String
+    | CreateCompleted (Result Http.Error (Article Body))
+    | EditCompleted (Result Http.Error (Article Body))
+
+
+update : User -> Msg -> Model -> ( Model, Cmd Msg )
+update user msg model =
+    case msg of
+        Save ->
+            case validate modelValidator model of
+                [] ->
+                    case model.editingArticle of
+                        Nothing ->
+                            user.token
+                                |> Request.Article.create model
+                                |> Http.send CreateCompleted
+                                |> pair { model | errors = [], isSaving = True }
+
+                        Just slug ->
+                            user.token
+                                |> Request.Article.update slug model
+                                |> Http.send EditCompleted
+                                |> pair { model | errors = [], isSaving = True }
+
+                errors ->
+                    ( { model | errors = errors }, Cmd.none )
+
+        SetTitle title ->
+            ( { model | title = title }, Cmd.none )
+
+        SetDescription description ->
+            ( { model | description = description }, Cmd.none )
+
+        SetTags tags ->
+            ( { model | tags = tagsFromString tags }, Cmd.none )
+
+        SetBody body ->
+            ( { model | body = body }, Cmd.none )
+
+        CreateCompleted (Ok article) ->
+            Route.Article article.slug
+                |> Route.modifyUrl
+                |> pair model
+
+        CreateCompleted (Err error) ->
+            ( { model
+                | errors = model.errors ++ [ ( Form, "Server error while attempting to publish article" ) ]
+                , isSaving = False
+              }
+            , Cmd.none
+            )
+
+        EditCompleted (Ok article) ->
+            Route.Article article.slug
+                |> Route.modifyUrl
+                |> pair model
+
+        EditCompleted (Err error) ->
+            ( { model
+                | errors = model.errors ++ [ ( Form, "Server error while attempting to save article" ) ]
+                , isSaving = False
+              }
+            , Cmd.none
+            )
+
+
+
+-- VALIDATION --
+
+
+type Field
+    = Form
+    | Title
+    | Body
+
+
+type alias Error =
+    ( Field, String )
+
+
+modelValidator : Validator Error Model
+modelValidator =
+    Validate.all
+        [ ifBlank .title ( Title, "title can't be blank." )
+        , ifBlank .body ( Body, "body can't be blank." )
+        ]
+
+
+
+-- INTERNAL --
+
+
+tagsFromString : String -> List String
+tagsFromString str =
+    str
+        |> String.split " "
+        |> List.map String.trim
+        |> List.filter (not << String.isEmpty)
+
+
+redirectToArticle : Article.Slug -> Cmd msg
+redirectToArticle =
+    Route.modifyUrl << Route.Article

part10/src/Page/Errored.elm

@@ -0,0 +1,45 @@
+module Page.Errored exposing (PageLoadError, pageLoadError, view)
+
+{-| The page that renders when there was an error trying to load another page,
+for example a Page Not Found error.
+
+It includes a photo I took of a painting on a building in San Francisco,
+of a giant walrus exploding the golden gate bridge with laser beams. Pew pew!
+
+-}
+
+import Data.Session exposing (Session)
+import Html exposing (Html, div, h1, img, main_, p, text)
+import Html.Attributes exposing (alt, class, id, tabindex)
+import Views.Page exposing (ActivePage)
+
+
+-- MODEL --
+
+
+type PageLoadError
+    = PageLoadError Model
+
+
+type alias Model =
+    { activePage : ActivePage
+    , errorMessage : String
+    }
+
+
+pageLoadError : ActivePage -> String -> PageLoadError
+pageLoadError activePage errorMessage =
+    PageLoadError { activePage = activePage, errorMessage = errorMessage }
+
+
+
+-- VIEW --
+
+
+view : Session -> PageLoadError -> Html msg
+view session (PageLoadError model) =
+    main_ [ id "content", class "container", tabindex -1 ]
+        [ h1 [] [ text "Error Loading Page" ]
+        , div [ class "row" ]
+            [ p [] [ text model.errorMessage ] ]
+        ]

part10/src/Page/Home.elm

@@ -0,0 +1,130 @@
+module Page.Home exposing (Model, Msg, init, update, view)
+
+{-| The homepage. You can get here via either the / or /#/ routes.
+-}
+
+import Data.Article as Article exposing (Tag)
+import Data.Session exposing (Session)
+import Html exposing (..)
+import Html.Attributes exposing (attribute, class, classList, href, id, placeholder)
+import Html.Events exposing (onClick)
+import Http
+import Page.Errored exposing (PageLoadError, pageLoadError)
+import Request.Article
+import SelectList exposing (SelectList)
+import Task exposing (Task)
+import Views.Article.Feed as Feed exposing (FeedSource, globalFeed, tagFeed, yourFeed)
+import Views.Page as Page
+
+
+-- MODEL --
+
+
+type alias Model =
+    { tags : List Tag
+    , feed : Feed.Model
+    }
+
+
+init : Session -> Task PageLoadError Model
+init session =
+    let
+        feedSources =
+            if session.user == Nothing then
+                SelectList.singleton globalFeed
+            else
+                SelectList.fromLists [] yourFeed [ globalFeed ]
+
+        loadTags =
+            Request.Article.tags
+                |> Http.toTask
+
+        loadSources =
+            Feed.init session feedSources
+
+        handleLoadError _ =
+            pageLoadError Page.Home "Homepage is currently unavailable."
+    in
+    Task.map2 Model loadTags loadSources
+        |> Task.mapError handleLoadError
+
+
+
+-- VIEW --
+
+
+view : Session -> Model -> Html Msg
+view session model =
+    div [ class "home-page" ]
+        [ viewBanner
+        , div [ class "container page" ]
+            [ div [ class "row" ]
+                [ div [ class "col-md-9" ] (viewFeed model.feed)
+                , div [ class "col-md-3" ]
+                    [ div [ class "sidebar" ]
+                        [ p [] [ text "Popular Tags" ]
+                        , viewTags model.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 : Feed.Model -> List (Html Msg)
+viewFeed feed =
+    div [ class "feed-toggle" ]
+        [ Feed.viewFeedSources feed |> Html.map FeedMsg ]
+        :: (Feed.viewArticles feed |> List.map (Html.map FeedMsg))
+
+
+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"
+        , href "javascript:void(0)"
+        , onClick (SelectTag tagName)
+        ]
+        [ text (Article.tagToString tagName) ]
+
+
+
+-- UPDATE --
+
+
+type Msg
+    = FeedMsg Feed.Msg
+    | SelectTag Tag
+
+
+update : Session -> Msg -> Model -> ( Model, Cmd Msg )
+update session msg model =
+    case msg of
+        FeedMsg subMsg ->
+            let
+                ( newFeed, subCmd ) =
+                    Feed.update session subMsg model.feed
+            in
+            ( { model | feed = newFeed }, Cmd.map FeedMsg subCmd )
+
+        SelectTag tagName ->
+            let
+                subCmd =
+                    Feed.selectTag (Maybe.map .token session.user) tagName
+            in
+            ( model, Cmd.map FeedMsg subCmd )

part10/src/Page/Login.elm

@@ -0,0 +1,214 @@
+module Page.Login exposing (ExternalMsg(..), Model, Msg, initialModel, update, view)
+
+{-| The login page.
+-}
+
+import Data.Session exposing (Session)
+import Data.User exposing (User)
+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 (decode, optional)
+import Request.User exposing (storeSession)
+import Route exposing (Route)
+import Validate exposing (Validator, ifBlank, validate)
+import Views.Form as Form
+
+
+-- MODEL --
+
+
+type alias Model =
+    { errors : List Error
+    , email : String
+    , password : String
+    }
+
+
+initialModel : Model
+initialModel =
+    { errors = []
+    , email = ""
+    , password = ""
+    }
+
+
+
+-- VIEW --
+
+
+view : Session -> Model -> Html Msg
+view session model =
+    div [ class "auth-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?" ]
+                        ]
+                    , Form.viewErrors model.errors
+                    , viewForm
+                    ]
+                ]
+            ]
+        ]
+
+
+viewForm : Html Msg
+viewForm =
+    Html.form [ onSubmit SubmitForm ]
+        [ Form.input
+            [ class "form-control-lg"
+            , placeholder "Email"
+            , onInput SetEmail
+            ]
+            []
+        , Form.password
+            [ class "form-control-lg"
+            , placeholder "Password"
+            , onInput SetPassword
+            ]
+            []
+        , button [ class "btn btn-lg btn-primary pull-xs-right" ]
+            [ text "Sign in" ]
+        ]
+
+
+
+-- UPDATE --
+
+
+type Msg
+    = SubmitForm
+    | SetEmail String
+    | SetPassword String
+    | LoginCompleted (Result Http.Error User)
+
+
+type ExternalMsg
+    = NoOp
+    | SetUser User
+
+
+update : Msg -> Model -> ( ( Model, Cmd Msg ), ExternalMsg )
+update msg model =
+    case msg of
+        SubmitForm ->
+            case validate modelValidator model of
+                [] ->
+                    ( ( { model | errors = [] }
+                      , Http.send LoginCompleted (Request.User.login model)
+                      )
+                    , NoOp
+                    )
+
+                errors ->
+                    ( ( { model | errors = errors }
+                      , Cmd.none
+                      )
+                    , NoOp
+                    )
+
+        SetEmail email ->
+            ( ( { model | email = email }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        SetPassword password ->
+            ( ( { model | password = password }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        LoginCompleted (Err error) ->
+            let
+                errorMessages =
+                    case error of
+                        Http.BadStatus response ->
+                            response.body
+                                |> decodeString (field "errors" errorsDecoder)
+                                |> Result.withDefault []
+
+                        _ ->
+                            [ "unable to perform login" ]
+            in
+            ( ( { model | errors = List.map (\errorMessage -> ( Form, errorMessage )) errorMessages }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        LoginCompleted (Ok user) ->
+            ( ( model
+              , Cmd.batch [ storeSession user, Route.modifyUrl Route.Home ]
+              )
+            , SetUser user
+            )
+
+
+
+-- VALIDATION --
+
+
+type Field
+    = Form
+    | 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 =
+    ( Field, String )
+
+
+modelValidator : Validator Error Model
+modelValidator =
+    Validate.all
+        [ ifBlank .email ( Email, "email can't be blank." )
+        , ifBlank .password ( Password, "password can't be blank." )
+        ]
+
+
+errorsDecoder : Decoder (List String)
+errorsDecoder =
+    decode (\emailOrPassword email username password -> List.concat [ emailOrPassword, email, username, password ])
+        |> optionalError "email or password"
+        |> optionalError "email"
+        |> optionalError "username"
+        |> optionalError "password"
+
+
+optionalError : String -> Decoder (List String -> a) -> Decoder a
+optionalError fieldName =
+    let
+        errorToString errorMessage =
+            String.join " " [ fieldName, errorMessage ]
+    in
+    optional fieldName (Decode.list (Decode.map errorToString string)) []

part10/src/Page/NotFound.elm

@@ -0,0 +1,18 @@
+module Page.NotFound exposing (view)
+
+import Data.Session exposing (Session)
+import Html exposing (Html, div, h1, img, main_, text)
+import Html.Attributes exposing (alt, class, id, src, tabindex)
+import Views.Assets as Assets
+
+
+-- VIEW --
+
+
+view : Session -> Html msg
+view session =
+    main_ [ id "content", class "container", tabindex -1 ]
+        [ h1 [] [ text "Not Found" ]
+        , div [ class "row" ]
+            [ img [ Assets.src Assets.error, alt "giant laser walrus wreaking havoc" ] [] ]
+        ]

part10/src/Page/Profile.elm

@@ -0,0 +1,193 @@
+module Page.Profile exposing (Model, Msg, init, update, view)
+
+{-| Viewing a user's profile.
+-}
+
+import Data.Profile exposing (Profile)
+import Data.Session exposing (Session)
+import Data.User as User exposing (Username)
+import Data.UserPhoto as UserPhoto exposing (UserPhoto)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Http
+import Page.Errored exposing (PageLoadError, pageLoadError)
+import Request.Article exposing (ListConfig, defaultListConfig)
+import Request.Profile
+import SelectList exposing (SelectList)
+import Task exposing (Task)
+import Util exposing (pair, viewIf)
+import Views.Article.Feed as Feed exposing (FeedSource, authorFeed, favoritedFeed)
+import Views.Errors as Errors
+import Views.Page as Page
+import Views.User.Follow as Follow
+
+
+-- MODEL --
+
+
+type alias Model =
+    { errors : List String
+    , profile : Profile
+    , feed : Feed.Model
+    }
+
+
+init : Session -> Username -> Task PageLoadError Model
+init session username =
+    let
+        config : ListConfig
+        config =
+            { defaultListConfig | limit = 5, author = Just username }
+
+        maybeAuthToken =
+            session.user
+                |> Maybe.map .token
+
+        loadProfile =
+            Request.Profile.get username maybeAuthToken
+                |> Http.toTask
+
+        loadFeedSources =
+            Feed.init session (defaultFeedSources username)
+
+        handleLoadError _ =
+            "Profile is currently unavailable."
+                |> pageLoadError (Page.Profile username)
+    in
+    Task.map2 (Model []) loadProfile loadFeedSources
+        |> Task.mapError handleLoadError
+
+
+
+-- VIEW --
+
+
+view : Session -> Model -> Html Msg
+view session model =
+    let
+        profile =
+            model.profile
+
+        isMyProfile =
+            session.user
+                |> Maybe.map (\{ username } -> username == profile.username)
+                |> Maybe.withDefault False
+    in
+    div [ class "profile-page" ]
+        [ Errors.view DismissErrors model.errors
+        , div [ class "user-info" ]
+            [ div [ class "container" ]
+                [ div [ class "row" ]
+                    [ viewProfileInfo isMyProfile profile ]
+                ]
+            ]
+        , div [ class "container" ]
+            [ div [ class "row" ] [ viewFeed model.feed ] ]
+        ]
+
+
+viewProfileInfo : Bool -> Profile -> Html Msg
+viewProfileInfo isMyProfile profile =
+    div [ class "col-xs-12 col-md-10 offset-md-1" ]
+        [ img [ class "user-img", UserPhoto.src profile.image ] []
+        , h4 [] [ User.usernameToHtml profile.username ]
+        , p [] [ text (Maybe.withDefault "" profile.bio) ]
+        , viewIf (not isMyProfile) (followButton profile)
+        ]
+
+
+viewFeed : Feed.Model -> Html Msg
+viewFeed feed =
+    div [ class "col-xs-12 col-md-10 offset-md-1" ] <|
+        div [ class "articles-toggle" ]
+            [ Feed.viewFeedSources feed |> Html.map FeedMsg ]
+            :: (Feed.viewArticles feed |> List.map (Html.map FeedMsg))
+
+
+
+-- UPDATE --
+
+
+type Msg
+    = DismissErrors
+    | ToggleFollow
+    | FollowCompleted (Result Http.Error Profile)
+    | FeedMsg Feed.Msg
+
+
+update : Session -> Msg -> Model -> ( Model, Cmd Msg )
+update session msg model =
+    let
+        profile =
+            model.profile
+    in
+    case msg of
+        DismissErrors ->
+            ( { model | errors = [] }, Cmd.none )
+
+        ToggleFollow ->
+            case session.user of
+                Nothing ->
+                    ( { model | errors = model.errors ++ [ "You are currently signed out. You must be signed in to follow people." ] }
+                    , Cmd.none
+                    )
+
+                Just user ->
+                    let
+                        -- TODO
+                        -- 1) head over to the Request.Profile module and look up
+                        --    what arguments the `toggleFollow` function takes.
+                        --
+                        -- 2) call Request.Profile.toggleFollow here,
+                        --    to get back a Request.
+                        --
+                        -- 3) pass that Request to Http.send to get a Cmd.
+                        --    Use that Cmd here.
+                        --
+                        -- Here's the documentation for Http.send:
+                        -- http://package.elm-lang.org/packages/elm-lang/http/1.0.0/Http#send
+                        --
+                        -- Here are some hepful values that are in scope:
+                        --
+                        --     user.token : Maybe AuthToken
+                        --
+                        --     profile : Profile  [look in the Data.Profile module!]
+                        --
+                        --     FollowCompleted : Result Http.Error Profile -> Msg
+                        --
+                        cmd : Cmd Msg
+                        cmd =
+                            Request.Profile.toggleFollow
+                                profile.username
+                                profile.following
+                                user.token
+                                |> Http.send FollowCompleted
+                    in
+                    ( model, cmd )
+
+        FollowCompleted (Ok newProfile) ->
+            ( { model | profile = newProfile }, Cmd.none )
+
+        FollowCompleted (Err error) ->
+            ( model, Cmd.none )
+
+        FeedMsg subMsg ->
+            let
+                ( newFeed, subCmd ) =
+                    Feed.update session subMsg model.feed
+            in
+            ( { model | feed = newFeed }, Cmd.map FeedMsg subCmd )
+
+
+followButton : Profile -> Html Msg
+followButton =
+    Follow.button (\_ -> ToggleFollow)
+
+
+
+-- INTERNAL --
+
+
+defaultFeedSources : Username -> SelectList FeedSource
+defaultFeedSources username =
+    SelectList.fromLists [] (authorFeed username) [ favoritedFeed username ]

part10/src/Page/Register.elm

@@ -0,0 +1,207 @@
+module Page.Register exposing (ExternalMsg(..), Model, Msg, initialModel, update, view)
+
+import Data.Session exposing (Session)
+import Data.User exposing (User)
+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 (decode, optional)
+import Request.User exposing (storeSession)
+import Route exposing (Route)
+import Validate exposing (Validator, ifBlank, validate)
+import Views.Form as Form
+
+
+-- MODEL --
+
+
+type alias Model =
+    { errors : List Error
+    , email : String
+    , username : String
+    , password : String
+    }
+
+
+initialModel : Model
+initialModel =
+    { errors = []
+    , email = ""
+    , username = ""
+    , password = ""
+    }
+
+
+
+-- VIEW --
+
+
+view : Session -> Model -> Html Msg
+view session model =
+    div [ class "auth-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?" ]
+                        ]
+                    , Form.viewErrors model.errors
+                    , viewForm
+                    ]
+                ]
+            ]
+        ]
+
+
+viewForm : Html Msg
+viewForm =
+    Html.form [ onSubmit SubmitForm ]
+        [ Form.input
+            [ class "form-control-lg"
+            , placeholder "Username"
+            , onInput SetUsername
+            ]
+            []
+        , Form.input
+            [ class "form-control-lg"
+            , placeholder "Email"
+            , onInput SetEmail
+            ]
+            []
+        , Form.password
+            [ class "form-control-lg"
+            , placeholder "Password"
+            , onInput SetPassword
+            ]
+            []
+        , button [ class "btn btn-lg btn-primary pull-xs-right" ]
+            [ text "Sign up" ]
+        ]
+
+
+
+-- UPDATE --
+
+
+type Msg
+    = SubmitForm
+    | SetEmail String
+    | SetUsername String
+    | SetPassword String
+    | RegisterCompleted (Result Http.Error User)
+
+
+type ExternalMsg
+    = NoOp
+    | SetUser User
+
+
+update : Msg -> Model -> ( ( Model, Cmd Msg ), ExternalMsg )
+update msg model =
+    case msg of
+        SubmitForm ->
+            case validate modelValidator model of
+                [] ->
+                    ( ( { model | errors = [] }
+                      , Http.send RegisterCompleted (Request.User.register model)
+                      )
+                    , NoOp
+                    )
+
+                errors ->
+                    ( ( { model | errors = errors }
+                      , Cmd.none
+                      )
+                    , NoOp
+                    )
+
+        SetEmail email ->
+            ( ( { model | email = email }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        SetUsername username ->
+            ( ( { model | username = username }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        SetPassword password ->
+            ( ( { model | password = password }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        RegisterCompleted (Err error) ->
+            let
+                errorMessages =
+                    case error of
+                        Http.BadStatus response ->
+                            response.body
+                                |> decodeString (field "errors" errorsDecoder)
+                                |> Result.withDefault []
+
+                        _ ->
+                            [ "unable to process registration" ]
+            in
+            ( ( { model | errors = List.map (\errorMessage -> ( Form, errorMessage )) errorMessages }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        RegisterCompleted (Ok user) ->
+            ( ( model
+              , Cmd.batch [ storeSession user, Route.modifyUrl Route.Home ]
+              )
+            , SetUser user
+            )
+
+
+
+-- VALIDATION --
+
+
+type Field
+    = Form
+    | Username
+    | Email
+    | Password
+
+
+type alias Error =
+    ( Field, String )
+
+
+modelValidator : Validator Error Model
+modelValidator =
+    Validate.all
+        [ ifBlank .username ( Username, "username can't be blank." )
+        , ifBlank .email ( Email, "email can't be blank." )
+        , ifBlank .password ( Password, "password can't be blank." )
+        ]
+
+
+errorsDecoder : Decoder (List String)
+errorsDecoder =
+    decode (\email username password -> List.concat [ email, username, password ])
+        |> optionalError "email"
+        |> optionalError "username"
+        |> optionalError "password"
+
+
+optionalError : String -> Decoder (List String -> a) -> Decoder a
+optionalError fieldName =
+    let
+        errorToString errorMessage =
+            String.join " " [ fieldName, errorMessage ]
+    in
+    optional fieldName (Decode.list (Decode.map errorToString string)) []

part10/src/Page/Settings.elm

@@ -0,0 +1,266 @@
+module Page.Settings exposing (ExternalMsg(..), Model, Msg, init, update, view)
+
+import Data.Session exposing (Session)
+import Data.User as User exposing (User)
+import Data.UserPhoto as UserPhoto
+import Html exposing (Html, button, div, fieldset, h1, input, text, textarea)
+import Html.Attributes exposing (attribute, class, value, placeholder, type_)
+import Html.Events exposing (onInput, onSubmit)
+import Http
+import Json.Decode as Decode exposing (Decoder, decodeString, field, list, string)
+import Json.Decode.Pipeline exposing (decode, optional)
+import Request.User exposing (storeSession)
+import Route
+import Util exposing (pair)
+import Validate exposing (Validator, ifBlank, validate)
+import Views.Form as Form
+
+
+-- MODEL --
+
+
+type alias Model =
+    { errors : List Error
+    , image : Maybe String
+    , email : String
+    , bio : String
+    , username : String
+    , password : Maybe String
+    }
+
+
+init : User -> Model
+init user =
+    { errors = []
+    , image = UserPhoto.toMaybeString user.image
+    , email = user.email
+    , bio = Maybe.withDefault "" user.bio
+    , username = User.usernameToString user.username
+    , password = Nothing
+    }
+
+
+
+-- VIEW --
+
+
+view : Session -> Model -> Html Msg
+view session model =
+    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" ]
+                    , Form.viewErrors model.errors
+                    , viewForm model
+                    ]
+                ]
+            ]
+        ]
+
+
+viewForm : Model -> Html Msg
+viewForm model =
+    Html.form [ onSubmit SubmitForm ]
+        [ fieldset []
+            [ Form.input
+                [ placeholder "URL of profile picture"
+                , value (Maybe.withDefault "" model.image)
+                , onInput SetImage
+                ]
+                []
+            , Form.input
+                [ class "form-control-lg"
+                , placeholder "Username"
+                , value model.username
+                , onInput SetUsername
+                ]
+                []
+            , Form.textarea
+                [ class "form-control-lg"
+                , placeholder "Short bio about you"
+                , attribute "rows" "8"
+                , value model.bio
+                , onInput SetBio
+                ]
+                []
+            , Form.input
+                [ class "form-control-lg"
+                , placeholder "Email"
+                , value model.email
+                , onInput SetEmail
+                ]
+                []
+            , Form.password
+                [ class "form-control-lg"
+                , placeholder "Password"
+                , value (Maybe.withDefault "" model.password)
+                , onInput SetPassword
+                ]
+                []
+            , button
+                [ class "btn btn-lg btn-primary pull-xs-right" ]
+                [ text "Update Settings" ]
+            ]
+        ]
+
+
+
+-- UPDATE --
+
+
+type Msg
+    = SubmitForm
+    | SetEmail String
+    | SetUsername String
+    | SetPassword String
+    | SetBio String
+    | SetImage String
+    | SaveCompleted (Result Http.Error User)
+
+
+type ExternalMsg
+    = NoOp
+    | SetUser User
+
+
+update : Session -> Msg -> Model -> ( ( Model, Cmd Msg ), ExternalMsg )
+update session msg model =
+    case msg of
+        SubmitForm ->
+            case validate modelValidator model of
+                [] ->
+                    ( session.user
+                        |> Maybe.map .token
+                        |> Request.User.edit model
+                        |> Http.send SaveCompleted
+                        |> pair { model | errors = [] }
+                    , NoOp
+                    )
+
+                errors ->
+                    ( ( { model | errors = errors }
+                      , Cmd.none
+                      )
+                    , NoOp
+                    )
+
+        SetEmail email ->
+            ( ( { model | email = email }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        SetUsername username ->
+            ( ( { model | username = username }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        SetPassword passwordStr ->
+            let
+                password =
+                    if String.isEmpty passwordStr then
+                        Nothing
+                    else
+                        Just passwordStr
+            in
+            ( ( { model | password = password }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        SetBio bio ->
+            ( ( { model | bio = bio }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        SetImage imageStr ->
+            let
+                image =
+                    if String.isEmpty imageStr then
+                        Nothing
+                    else
+                        Just imageStr
+            in
+            ( ( { model | image = image }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        SaveCompleted (Err error) ->
+            let
+                errorMessages =
+                    case error of
+                        Http.BadStatus response ->
+                            response.body
+                                |> decodeString (field "errors" errorsDecoder)
+                                |> Result.withDefault []
+
+                        _ ->
+                            [ "unable to save changes" ]
+
+                errors =
+                    errorMessages
+                        |> List.map (\errorMessage -> ( Form, errorMessage ))
+            in
+            ( ( { model | errors = errors }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        SaveCompleted (Ok user) ->
+            ( ( model
+              , Cmd.batch [ storeSession user, Route.modifyUrl Route.Home ]
+              )
+            , SetUser user
+            )
+
+
+
+-- VALIDATION --
+
+
+type Field
+    = Form
+    | Username
+    | Email
+    | Password
+    | ImageUrl
+    | Bio
+
+
+type alias Error =
+    ( Field, String )
+
+
+modelValidator : Validator Error Model
+modelValidator =
+    Validate.all
+        [ ifBlank .username ( Username, "username can't be blank." )
+        , ifBlank .email ( Email, "email can't be blank." )
+        ]
+
+
+errorsDecoder : Decoder (List String)
+errorsDecoder =
+    decode (\email username password -> List.concat [ email, username, password ])
+        |> optionalError "email"
+        |> optionalError "username"
+        |> optionalError "password"
+
+
+optionalError : String -> Decoder (List String -> a) -> Decoder a
+optionalError fieldName =
+    let
+        errorToString errorMessage =
+            String.join " " [ fieldName, errorMessage ]
+    in
+    optional fieldName (list (Decode.map errorToString string)) []