Add part6

intro/part6/src/Api.elm

@@ -0,0 +1,53 @@
+module Api exposing (addServerError, decodeErrors, url)
+
+import Http
+import Json.Decode as Decode exposing (Decoder, decodeString, field, string)
+import Json.Decode.Pipeline as Pipeline exposing (optional)
+import Url.Builder
+
+
+
+-- URL
+
+
+{-| Get a URL to the Conduit API.
+-}
+url : List String -> String
+url paths =
+    -- NOTE: Url.Builder takes care of percent-encoding special URL characters.
+    -- See https://package.elm-lang.org/packages/elm/url/latest/Url#percentEncode
+    Url.Builder.relative ("api" :: paths) []
+
+
+
+-- ERRORS
+
+
+addServerError : List String -> List String
+addServerError list =
+    "Server error" :: list
+
+
+{-| Many API endpoints include an "errors" field in their BadStatus responses.
+-}
+decodeErrors : Http.Error -> List String
+decodeErrors error =
+    case error of
+        Http.BadStatus response ->
+            response.body
+                |> decodeString (field "errors" errorsDecoder)
+                |> Result.withDefault [ "Server error" ]
+
+        err ->
+            [ "Server error" ]
+
+
+errorsDecoder : Decoder (List String)
+errorsDecoder =
+    Decode.keyValuePairs (Decode.list Decode.string)
+        |> Decode.map (List.concatMap fromPair)
+
+
+fromPair : ( String, List String ) -> List String
+fromPair ( field, errors ) =
+    List.map (\error -> field ++ " " ++ error) errors

intro/part6/src/Article.elm

@@ -0,0 +1,321 @@
+module Article
+    exposing
+        ( Article
+        , Full
+        , Preview
+        , author
+        , body
+        , favorite
+        , favoriteButton
+        , fetch
+        , fromPreview
+        , fullDecoder
+        , mapAuthor
+        , metadata
+        , previewDecoder
+        , slug
+        , unfavorite
+        , unfavoriteButton
+        , url
+        )
+
+{-| The interface to the Article data structure.
+
+This includes:
+
+  - The Article type itself
+  - Ways to make HTTP requests to retrieve and modify articles
+  - Ways to access information about an article
+  - Converting between various types
+
+-}
+
+import Api
+import Article.Body as Body exposing (Body)
+import Article.Slug as Slug exposing (Slug)
+import Article.Tag as Tag exposing (Tag)
+import Author exposing (Author)
+import Html exposing (Attribute, Html, i)
+import Html.Attributes exposing (class)
+import Html.Events exposing (stopPropagationOn)
+import Http
+import HttpBuilder exposing (RequestBuilder, withBody, withExpect, withQueryParams)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (custom, hardcoded, required)
+import Json.Encode as Encode
+import Markdown
+import Profile exposing (Profile)
+import Time
+import Timestamp
+import Username as Username exposing (Username)
+import Viewer exposing (Viewer)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- TYPES
+
+
+{-| An article, optionally with an article body.
+
+To see the difference between { extraInfo : a } and { extraInfo : Maybe Body },
+consider the difference between the "view individual article" page (which
+renders one article, including its body) and the "article feed" -
+which displays multiple articles, but without bodies.
+
+This definition for `Article` means we can write:
+
+viewArticle : Article Full -> Html msg
+viewFeed : List (Article Preview) -> Html msg
+
+This indicates that `viewArticle` requires an article _with a `body` present_,
+wereas `viewFeed` accepts articles with no bodies. (We could also have written
+it as `List (Article a)` to specify that feeds can accept either articles that
+have `body` present or not. Either work, given that feeds do not attempt to
+read the `body` field from articles.)
+
+This is an important distinction, because in Request.Article, the `feed`
+function produces `List (Article Preview)` because the API does not return bodies.
+Those articles are useful to the feed, but not to the individual article view.
+
+-}
+type Article a
+    = Article Internals a
+
+
+{-| Metadata about the article - its title, description, and so on.
+
+Importantly, this module's public API exposes a way to read this metadata, but
+not to alter it. This is read-only information!
+
+If we find ourselves using any particular piece of metadata often,
+for example `title`, we could expose a convenience function like this:
+
+Article.title : Article a -> String
+
+If you like, it's totally reasonable to expose a function like that for every one
+of these fields!
+
+(Okay, to be completely honest, exposing one function per field is how I prefer
+to do it, and that's how I originally wrote this module. However, I'm aware that
+this code base has become a common reference point for beginners, and I think it
+is _extremely important_ that slapping some "getters and setters" on a record
+does not become a habit for anyone who is getting started with Elm. The whole
+point of making the Article type opaque is to create guarantees through
+_selectively choosing boundaries_ around it. If you aren't selective about
+where those boundaries are, and instead expose a "getter and setter" for every
+field in the record, the result is an API with no more guarantees than if you'd
+exposed the entire record directly! It is so important to me that beginners not
+fall into the terrible "getters and setters" trap that I've exposed this
+Metadata record instead of exposing a single function for each of its fields,
+as I did originally. This record is not a bad way to do it, by any means,
+but if this seems at odds with <https://youtu.be/x1FU3e0sT1I> - now you know why!
+See commit c2640ae3abd60262cdaafe6adee3f41d84cd85c3 for how it looked before.
+)
+
+-}
+type alias Metadata =
+    { description : String
+    , title : String
+    , tags : List String
+    , createdAt : Time.Posix
+    , favorited : Bool
+    , favoritesCount : Int
+    }
+
+
+type alias Internals =
+    { slug : Slug
+    , author : Author
+    , metadata : Metadata
+    }
+
+
+type Preview
+    = Preview
+
+
+type Full
+    = Full Body
+
+
+
+-- INFO
+
+
+author : Article a -> Author
+author (Article internals _) =
+    internals.author
+
+
+metadata : Article a -> Metadata
+metadata (Article internals _) =
+    internals.metadata
+
+
+slug : Article a -> Slug
+slug (Article internals _) =
+    internals.slug
+
+
+body : Article Full -> Body
+body (Article _ (Full extraInfo)) =
+    extraInfo
+
+
+
+-- TRANSFORM
+
+
+{-| This is the only way you can transform an existing article:
+you can change its author (e.g. to follow or unfollow them).
+All other article data necessarily comes from the server!
+
+We can tell this for sure by looking at the types of the exposed functions
+in this module.
+
+-}
+mapAuthor : (Author -> Author) -> Article a -> Article a
+mapAuthor transform (Article info extras) =
+    Article { info | author = transform info.author } extras
+
+
+fromPreview : Body -> Article Preview -> Article Full
+fromPreview newBody (Article info Preview) =
+    Article info (Full newBody)
+
+
+
+-- SERIALIZATION
+
+
+previewDecoder : Maybe Cred -> Decoder (Article Preview)
+previewDecoder maybeCred =
+    Decode.succeed Article
+        |> custom (internalsDecoder maybeCred)
+        |> hardcoded Preview
+
+
+fullDecoder : Maybe Cred -> Decoder (Article Full)
+fullDecoder maybeCred =
+    Decode.succeed Article
+        |> custom (internalsDecoder maybeCred)
+        |> required "body" (Decode.map Full Body.decoder)
+
+
+internalsDecoder : Maybe Cred -> Decoder Internals
+internalsDecoder maybeCred =
+    Decode.succeed Internals
+        |> required "slug" Slug.decoder
+        |> required "author" (Author.decoder maybeCred)
+        |> custom metadataDecoder
+
+
+metadataDecoder : Decoder Metadata
+metadataDecoder =
+    Decode.succeed Metadata
+        |> required "description" (Decode.map (Maybe.withDefault "") (Decode.nullable Decode.string))
+        |> required "title" Decode.string
+        |> required "tagList" (Decode.list Decode.string)
+        |> required "createdAt" Timestamp.iso8601Decoder
+        |> required "favorited" Decode.bool
+        |> required "favoritesCount" Decode.int
+
+
+
+-- SINGLE
+
+
+fetch : Maybe Cred -> Slug -> Http.Request (Article Full)
+fetch maybeCred articleSlug =
+    let
+        expect =
+            fullDecoder maybeCred
+                |> Decode.field "article"
+                |> Http.expectJson
+    in
+    url articleSlug []
+        |> HttpBuilder.get
+        |> HttpBuilder.withExpect expect
+        |> Cred.addHeaderIfAvailable maybeCred
+        |> HttpBuilder.toRequest
+
+
+
+-- FAVORITE
+
+
+favorite : Slug -> Cred -> Http.Request (Article Preview)
+favorite articleSlug cred =
+    buildFavorite HttpBuilder.post articleSlug cred
+
+
+unfavorite : Slug -> Cred -> Http.Request (Article Preview)
+unfavorite articleSlug cred =
+    buildFavorite HttpBuilder.delete articleSlug cred
+
+
+buildFavorite :
+    (String -> RequestBuilder a)
+    -> Slug
+    -> Cred
+    -> Http.Request (Article Preview)
+buildFavorite builderFromUrl articleSlug cred =
+    let
+        expect =
+            previewDecoder (Just cred)
+                |> Decode.field "article"
+                |> Http.expectJson
+    in
+    builderFromUrl (url articleSlug [ "favorite" ])
+        |> Cred.addHeader cred
+        |> withExpect expect
+        |> HttpBuilder.toRequest
+
+
+{-| This is a "build your own element" API.
+
+You pass it some configuration, followed by a `List (Attribute msg)` and a
+`List (Html msg)`, just like any standard Html element.
+
+-}
+favoriteButton : Cred -> msg -> List (Attribute msg) -> List (Html msg) -> Html msg
+favoriteButton _ msg attrs kids =
+    toggleFavoriteButton "btn btn-sm btn-outline-primary" msg attrs kids
+
+
+unfavoriteButton : Cred -> msg -> List (Attribute msg) -> List (Html msg) -> Html msg
+unfavoriteButton _ msg attrs kids =
+    toggleFavoriteButton "btn btn-sm btn-primary" msg attrs kids
+
+
+toggleFavoriteButton :
+    String
+    -> msg
+    -> List (Attribute msg)
+    -> List (Html msg)
+    -> Html msg
+toggleFavoriteButton classStr msg attrs kids =
+    Html.button
+        (class classStr :: onClickStopPropagation msg :: attrs)
+        (i [ class "ion-heart" ] [] :: kids)
+
+
+onClickStopPropagation : msg -> Attribute msg
+onClickStopPropagation msg =
+    stopPropagationOn "click"
+        (Decode.succeed ( msg, True ))
+
+
+
+-- URLS
+
+
+url : Slug -> List String -> String
+url articleSlug paths =
+    allArticlesUrl (Slug.toString articleSlug :: paths)
+
+
+allArticlesUrl : List String -> String
+allArticlesUrl paths =
+    Api.url ("articles" :: paths)

intro/part6/src/Article/Body.elm

@@ -0,0 +1,38 @@
+module Article.Body exposing (Body, MarkdownString, decoder, toHtml, toMarkdownString)
+
+import Html exposing (Attribute, Html)
+import Json.Decode as Decode exposing (Decoder)
+import Markdown
+
+
+
+-- TYPES
+
+
+type Body
+    = Body MarkdownString
+
+
+{-| Internal use only. I want to remind myself that the string inside Body contains markdown.
+-}
+type alias MarkdownString =
+    String
+
+
+
+-- CONVERSIONS
+
+
+toHtml : Body -> List (Attribute msg) -> Html msg
+toHtml (Body markdown) attributes =
+    Markdown.toHtml attributes markdown
+
+
+toMarkdownString : Body -> MarkdownString
+toMarkdownString (Body markdown) =
+    markdown
+
+
+decoder : Decoder Body
+decoder =
+    Decode.map Body Decode.string

intro/part6/src/Article/Comment.elm

@@ -0,0 +1,139 @@
+module Article.Comment
+    exposing
+        ( Comment
+        , author
+        , body
+        , createdAt
+        , delete
+        , id
+        , list
+        , post
+        )
+
+import Api
+import Article exposing (Article)
+import Article.Slug as Slug exposing (Slug)
+import Author exposing (Author)
+import CommentId exposing (CommentId)
+import Http
+import HttpBuilder exposing (RequestBuilder, withExpect, withQueryParams)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (custom, required)
+import Json.Encode as Encode exposing (Value)
+import Profile exposing (Profile)
+import Time
+import Timestamp
+import Viewer exposing (Viewer)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- TYPES
+
+
+type Comment
+    = Comment Internals
+
+
+type alias Internals =
+    { id : CommentId
+    , body : String
+    , createdAt : Time.Posix
+    , author : Author
+    }
+
+
+
+-- INFO
+
+
+id : Comment -> CommentId
+id (Comment comment) =
+    comment.id
+
+
+body : Comment -> String
+body (Comment comment) =
+    comment.body
+
+
+createdAt : Comment -> Time.Posix
+createdAt (Comment comment) =
+    comment.createdAt
+
+
+author : Comment -> Author
+author (Comment comment) =
+    comment.author
+
+
+
+-- LIST
+
+
+list : Maybe Cred -> Slug -> Http.Request (List Comment)
+list maybeCred articleSlug =
+    allCommentsUrl articleSlug []
+        |> HttpBuilder.get
+        |> HttpBuilder.withExpect (Http.expectJson (Decode.field "comments" (Decode.list (decoder maybeCred))))
+        |> Cred.addHeaderIfAvailable maybeCred
+        |> HttpBuilder.toRequest
+
+
+
+-- POST
+
+
+post : Slug -> String -> Cred -> Http.Request Comment
+post articleSlug commentBody cred =
+    allCommentsUrl articleSlug []
+        |> HttpBuilder.post
+        |> HttpBuilder.withBody (Http.jsonBody (encodeCommentBody commentBody))
+        |> HttpBuilder.withExpect (Http.expectJson (Decode.field "comment" (decoder (Just cred))))
+        |> Cred.addHeader cred
+        |> HttpBuilder.toRequest
+
+
+encodeCommentBody : String -> Value
+encodeCommentBody str =
+    Encode.object [ ( "comment", Encode.object [ ( "body", Encode.string str ) ] ) ]
+
+
+
+-- DELETE
+
+
+delete : Slug -> CommentId -> Cred -> Http.Request ()
+delete articleSlug commentId cred =
+    commentUrl articleSlug commentId
+        |> HttpBuilder.delete
+        |> Cred.addHeader cred
+        |> HttpBuilder.toRequest
+
+
+
+-- SERIALIZATION
+
+
+decoder : Maybe Cred -> Decoder Comment
+decoder maybeCred =
+    Decode.succeed Internals
+        |> required "id" CommentId.decoder
+        |> required "body" Decode.string
+        |> required "createdAt" Timestamp.iso8601Decoder
+        |> required "author" (Author.decoder maybeCred)
+        |> Decode.map Comment
+
+
+
+-- URLS
+
+
+commentUrl : Slug -> CommentId -> String
+commentUrl articleSlug commentId =
+    allCommentsUrl articleSlug [ CommentId.toString commentId ]
+
+
+allCommentsUrl : Slug -> List String -> String
+allCommentsUrl articleSlug paths =
+    Api.url ([ "articles", Slug.toString articleSlug, "comments" ] ++ paths)

intro/part6/src/Article/Feed.elm

@@ -0,0 +1,421 @@
+module Article.Feed
+    exposing
+        ( Model
+        , Msg
+        , init
+        , selectTag
+        , update
+        , viewArticles
+        , viewFeedSources
+        )
+
+import Api
+import Article exposing (Article, Preview)
+import Article.FeedSources as FeedSources exposing (FeedSources, Source(..))
+import Article.Slug as ArticleSlug exposing (Slug)
+import Article.Tag as Tag exposing (Tag)
+import Author
+import Avatar exposing (Avatar)
+import Browser.Dom as Dom
+import Html exposing (..)
+import Html.Attributes exposing (attribute, class, classList, href, id, placeholder, src)
+import Html.Events exposing (onClick)
+import Http
+import HttpBuilder exposing (RequestBuilder, withExpect, withQueryParams)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (required)
+import Page
+import PaginatedList exposing (PaginatedList)
+import Profile
+import Route exposing (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)
+
+
+{-| NOTE: This module has its own Model, view, and update. This is not normal!
+If you find yourself doing this often, please watch <https://www.youtube.com/watch?v=DoA4Txr4GUs>
+
+This is the reusable Article Feed that appears on both the Home page as well as
+on the Profile page. There's a lot of logic here, so it's more convenient to use
+the heavyweight approach of giving this its own Model, view, and update.
+
+This means callers must use Html.map and Cmd.map to use this thing, but in
+this case that's totally worth it because of the amount of logic wrapped up
+in this thing.
+
+For every other reusable view in this application, this API would be totally
+overkill, so we use simpler APIs instead.
+
+-}
+
+
+
+-- MODEL
+
+
+type Model
+    = Model InternalModel
+
+
+{-| This should not be exposed! We want to benefit from the guarantee that only
+this module can create or alter this model. This way if it ever ends up in
+a surprising state, we know exactly where to look: this module.
+-}
+type alias InternalModel =
+    { session : Session
+    , errors : List String
+    , articles : PaginatedList (Article Preview)
+    , sources : FeedSources
+    , isLoading : Bool
+    }
+
+
+init : Session -> FeedSources -> Task Http.Error Model
+init session sources =
+    let
+        fromArticles articles =
+            Model
+                { session = session
+                , errors = []
+                , articles = articles
+                , sources = sources
+                , isLoading = False
+                }
+    in
+    FeedSources.selected sources
+        |> fetch (Session.cred session) 1
+        |> Task.map fromArticles
+
+
+
+-- VIEW
+
+
+viewArticles : Time.Zone -> Model -> List (Html Msg)
+viewArticles timeZone (Model { articles, sources, session }) =
+    let
+        maybeCred =
+            Session.cred session
+
+        articlesHtml =
+            PaginatedList.values articles
+                |> List.map (viewPreview maybeCred timeZone)
+
+        feedSource =
+            FeedSources.selected sources
+
+        pagination =
+            PaginatedList.view ClickedFeedPage articles (limit feedSource)
+    in
+    List.append articlesHtml [ pagination ]
+
+
+viewPreview : Maybe Cred -> Time.Zone -> Article Preview -> Html Msg
+viewPreview maybeCred timeZone article =
+    let
+        slug =
+            Article.slug article
+
+        { title, description, createdAt } =
+            Article.metadata article
+
+        author =
+            Article.author article
+
+        profile =
+            Author.profile author
+
+        username =
+            Author.username author
+
+        faveButton =
+            case maybeCred of
+                Just cred ->
+                    let
+                        { favoritesCount, favorited } =
+                            Article.metadata article
+
+                        viewButton =
+                            if favorited then
+                                Article.unfavoriteButton cred (ClickedUnfavorite cred slug)
+
+                            else
+                                Article.favoriteButton cred (ClickedFavorite cred slug)
+                    in
+                    viewButton [ class "pull-xs-right" ]
+                        [ text (" " ++ String.fromInt favoritesCount) ]
+
+                Nothing ->
+                    text ""
+    in
+    div [ class "article-preview" ]
+        [ div [ class "article-meta" ]
+            [ a [ Route.href (Route.Profile username) ]
+                [ img [ Avatar.src (Profile.avatar profile) ] [] ]
+            , div [ class "info" ]
+                [ Author.view username
+                , Timestamp.view timeZone createdAt
+                ]
+            , faveButton
+            ]
+        , a [ class "preview-link", Route.href (Route.Article (Article.slug article)) ]
+            [ h1 [] [ text title ]
+            , p [] [ text description ]
+            , span [] [ text "Read more..." ]
+            ]
+        ]
+
+
+viewFeedSources : Model -> Html Msg
+viewFeedSources (Model { sources, isLoading, errors }) =
+    let
+        errorsHtml =
+            Page.viewErrors ClickedDismissErrors errors
+    in
+    ul [ class "nav nav-pills outline-active" ] <|
+        List.concat
+            [ List.map (viewFeedSource False) (FeedSources.before sources)
+            , [ viewFeedSource True (FeedSources.selected sources) ]
+            , List.map (viewFeedSource False) (FeedSources.after sources)
+            , [ errorsHtml ]
+            ]
+
+
+viewFeedSource : Bool -> Source -> Html Msg
+viewFeedSource isSelected source =
+    li [ class "nav-item" ]
+        [ a
+            [ classList [ ( "nav-link", True ), ( "active", isSelected ) ]
+            , onClick (ClickedFeedSource source)
+
+            -- The RealWorld CSS requires an href to work properly.
+            , href ""
+            ]
+            [ text (sourceName source) ]
+        ]
+
+
+selectTag : Maybe Cred -> Tag -> Cmd Msg
+selectTag maybeCred tag =
+    let
+        source =
+            TagFeed tag
+    in
+    fetch maybeCred 1 source
+        |> Task.attempt (CompletedFeedLoad source)
+
+
+sourceName : Source -> String
+sourceName source =
+    case source of
+        YourFeed _ ->
+            "Your Feed"
+
+        GlobalFeed ->
+            "Global Feed"
+
+        TagFeed tagName ->
+            "#" ++ Tag.toString tagName
+
+        FavoritedFeed username ->
+            "Favorited Articles"
+
+        AuthorFeed username ->
+            "My Articles"
+
+
+limit : Source -> Int
+limit feedSource =
+    case feedSource of
+        YourFeed _ ->
+            10
+
+        GlobalFeed ->
+            10
+
+        TagFeed tagName ->
+            10
+
+        FavoritedFeed username ->
+            5
+
+        AuthorFeed username ->
+            5
+
+
+
+-- UPDATE
+
+
+type Msg
+    = ClickedDismissErrors
+    | ClickedFavorite Cred Slug
+    | ClickedUnfavorite Cred Slug
+    | ClickedFeedPage Int
+    | ClickedFeedSource Source
+    | CompletedFavorite (Result Http.Error (Article Preview))
+    | CompletedFeedLoad Source (Result Http.Error (PaginatedList (Article Preview)))
+
+
+update : Maybe Cred -> Msg -> Model -> ( Model, Cmd Msg )
+update maybeCred msg (Model model) =
+    case msg of
+        ClickedDismissErrors ->
+            ( Model { model | errors = [] }, Cmd.none )
+
+        ClickedFeedSource source ->
+            ( Model { model | isLoading = True }
+            , source
+                |> fetch maybeCred 1
+                |> Task.attempt (CompletedFeedLoad source)
+            )
+
+        CompletedFeedLoad source (Ok articles) ->
+            ( Model
+                { model
+                    | articles = articles
+                    , sources = FeedSources.select source model.sources
+                    , isLoading = False
+                }
+            , Cmd.none
+            )
+
+        CompletedFeedLoad _ (Err error) ->
+            ( Model
+                { model
+                    | errors = Api.addServerError model.errors
+                    , isLoading = False
+                }
+            , Cmd.none
+            )
+
+        ClickedFavorite cred slug ->
+            fave Article.favorite cred slug model
+
+        ClickedUnfavorite cred slug ->
+            fave Article.unfavorite cred slug model
+
+        CompletedFavorite (Ok article) ->
+            ( Model { model | articles = PaginatedList.map (replaceArticle article) model.articles }
+            , Cmd.none
+            )
+
+        CompletedFavorite (Err error) ->
+            ( Model { model | errors = Api.addServerError model.errors }
+            , Cmd.none
+            )
+
+        ClickedFeedPage page ->
+            let
+                source =
+                    FeedSources.selected model.sources
+            in
+            ( Model model
+            , fetch maybeCred page source
+                |> Task.andThen (\articles -> Task.map (\_ -> articles) scrollToTop)
+                |> Task.attempt (CompletedFeedLoad source)
+            )
+
+
+scrollToTop : Task x ()
+scrollToTop =
+    Dom.setViewport 0 0
+        -- It's not worth showing the user anything special if scrolling fails.
+        -- If anything, we'd log this to an error recording service.
+        |> Task.onError (\_ -> Task.succeed ())
+
+
+fetch : Maybe Cred -> Int -> Source -> Task Http.Error (PaginatedList (Article Preview))
+fetch maybeCred page feedSource =
+    let
+        articlesPerPage =
+            limit feedSource
+
+        offset =
+            (page - 1) * articlesPerPage
+
+        params =
+            [ ( "limit", String.fromInt articlesPerPage )
+            , ( "offset", String.fromInt offset )
+            ]
+    in
+    Task.map (PaginatedList.mapPage (\_ -> page)) <|
+        case feedSource of
+            YourFeed cred ->
+                params
+                    |> buildFromQueryParams (Just cred) (Api.url [ "articles", "feed" ])
+                    |> Cred.addHeader cred
+                    |> HttpBuilder.toRequest
+                    |> Http.toTask
+
+            GlobalFeed ->
+                list maybeCred params
+
+            TagFeed tagName ->
+                list maybeCred (( "tag", Tag.toString tagName ) :: params)
+
+            FavoritedFeed username ->
+                list maybeCred (( "favorited", Username.toString username ) :: params)
+
+            AuthorFeed username ->
+                list maybeCred (( "author", Username.toString username ) :: params)
+
+
+list :
+    Maybe Cred
+    -> List ( String, String )
+    -> Task Http.Error (PaginatedList (Article Preview))
+list maybeCred params =
+    buildFromQueryParams maybeCred (Api.url [ "articles" ]) params
+        |> Cred.addHeaderIfAvailable maybeCred
+        |> HttpBuilder.toRequest
+        |> Http.toTask
+
+
+replaceArticle : Article a -> Article a -> Article a
+replaceArticle newArticle oldArticle =
+    if Article.slug newArticle == Article.slug oldArticle then
+        newArticle
+
+    else
+        oldArticle
+
+
+
+-- SERIALIZATION
+
+
+decoder : Maybe Cred -> Decoder (PaginatedList (Article Preview))
+decoder maybeCred =
+    Decode.succeed PaginatedList.fromList
+        |> required "articlesCount" Decode.int
+        |> required "articles" (Decode.list (Article.previewDecoder maybeCred))
+
+
+
+-- REQUEST
+
+
+buildFromQueryParams : Maybe Cred -> String -> List ( String, String ) -> RequestBuilder (PaginatedList (Article Preview))
+buildFromQueryParams maybeCred url queryParams =
+    HttpBuilder.get url
+        |> withExpect (Http.expectJson (decoder maybeCred))
+        |> withQueryParams queryParams
+
+
+
+-- INTERNAL
+
+
+fave : (Slug -> Cred -> Http.Request (Article Preview)) -> Cred -> Slug -> InternalModel -> ( Model, Cmd Msg )
+fave toRequest cred slug model =
+    ( Model model
+    , toRequest slug cred
+        |> Http.toTask
+        |> Task.attempt CompletedFavorite
+    )

intro/part6/src/Article/FeedSources.elm

@@ -0,0 +1,109 @@
+module Article.FeedSources exposing (FeedSources, Source(..), after, before, fromLists, select, selected)
+
+import Article
+import Article.Tag as Tag exposing (Tag)
+import Username exposing (Username)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- TYPES
+
+
+type FeedSources
+    = FeedSources
+        { before : List Source
+        , selected : Source
+        , after : List Source
+        }
+
+
+type Source
+    = YourFeed Cred
+    | GlobalFeed
+    | TagFeed Tag
+    | FavoritedFeed Username
+    | AuthorFeed Username
+
+
+
+-- BUILDING
+
+
+fromLists : Source -> List Source -> FeedSources
+fromLists selectedSource afterSources =
+    FeedSources
+        { before = []
+        , selected = selectedSource
+        , after = afterSources
+        }
+
+
+
+-- SELECTING
+
+
+select : Source -> FeedSources -> FeedSources
+select selectedSource (FeedSources sources) =
+    let
+        ( newBefore, newAfter ) =
+            (sources.before ++ (sources.selected :: sources.after))
+                -- By design, tags can only be included if they're selected.
+                |> List.filter isNotTag
+                |> splitOn (\source -> source == selectedSource)
+    in
+    FeedSources
+        { before = List.reverse newBefore
+        , selected = selectedSource
+        , after = List.reverse newAfter
+        }
+
+
+splitOn : (Source -> Bool) -> List Source -> ( List Source, List Source )
+splitOn isSelected sources =
+    let
+        ( _, newBefore, newAfter ) =
+            List.foldl (splitOnHelp isSelected) ( False, [], [] ) sources
+    in
+    ( newBefore, newAfter )
+
+
+splitOnHelp : (Source -> Bool) -> Source -> ( Bool, List Source, List Source ) -> ( Bool, List Source, List Source )
+splitOnHelp isSelected source ( foundSelected, beforeSelected, afterSelected ) =
+    if isSelected source then
+        ( True, beforeSelected, afterSelected )
+
+    else if foundSelected then
+        ( foundSelected, beforeSelected, source :: afterSelected )
+
+    else
+        ( foundSelected, source :: beforeSelected, afterSelected )
+
+
+isNotTag : Source -> Bool
+isNotTag currentSource =
+    case currentSource of
+        TagFeed _ ->
+            False
+
+        _ ->
+            True
+
+
+
+-- INFO
+
+
+selected : FeedSources -> Source
+selected (FeedSources record) =
+    record.selected
+
+
+before : FeedSources -> List Source
+before (FeedSources record) =
+    record.before
+
+
+after : FeedSources -> List Source
+after (FeedSources record) =
+    record.after

intro/part6/src/Article/Slug.elm

@@ -0,0 +1,35 @@
+module Article.Slug exposing (Slug, decoder, toString, urlParser)
+
+import Json.Decode as Decode exposing (Decoder)
+import Url.Parser exposing (Parser)
+
+
+
+-- TYPES
+
+
+type Slug
+    = Slug String
+
+
+
+-- CREATE
+
+
+urlParser : Parser (Slug -> a) a
+urlParser =
+    Url.Parser.custom "SLUG" (\str -> Just (Slug str))
+
+
+decoder : Decoder Slug
+decoder =
+    Decode.map Slug Decode.string
+
+
+
+-- TRANSFORM
+
+
+toString : Slug -> String
+toString (Slug str) =
+    str

intro/part6/src/Article/Tag.elm

@@ -0,0 +1,49 @@
+module Article.Tag exposing (Tag, list, toString, validate)
+
+import Api
+import Http
+import Json.Decode as Decode exposing (Decoder)
+
+
+
+-- TYPES
+
+
+type Tag
+    = Tag String
+
+
+
+-- TRANSFORM
+
+
+toString : Tag -> String
+toString (Tag slug) =
+    slug
+
+
+
+-- LIST
+
+
+list : Http.Request (List Tag)
+list =
+    Decode.field "tags" (Decode.list decoder)
+        |> Http.get (Api.url [ "tags" ])
+
+
+validate : String -> List String -> Bool
+validate str =
+    String.split " " str
+        |> List.map String.trim
+        |> List.filter (not << String.isEmpty)
+        |> (==)
+
+
+
+-- SERIALIZATION
+
+
+decoder : Decoder Tag
+decoder =
+    Decode.map Tag Decode.string

intro/part6/src/Asset.elm

@@ -0,0 +1,48 @@
+module Asset exposing (Image, defaultAvatar, error, loading, src)
+
+{-| Assets, such as images, videos, and audio. (We only have images for now.)
+
+We should never expose asset URLs directly; this module should be in charge of
+all of them. One source of truth!
+
+-}
+
+import Html exposing (Attribute, Html)
+import Html.Attributes as Attr
+
+
+type Image
+    = Image String
+
+
+
+-- IMAGES
+
+
+error : Image
+error =
+    image "error.jpg"
+
+
+loading : Image
+loading =
+    image "loading.svg"
+
+
+defaultAvatar : Image
+defaultAvatar =
+    Image "smiley-cyrus.jpg"
+
+
+image : String -> Image
+image filename =
+    Image ("/assets/images/" ++ filename)
+
+
+
+-- USING IMAGES
+
+
+src : Image -> Attribute msg
+src (Image url) =
+    Attr.src url

intro/part6/src/Author.elm

@@ -0,0 +1,251 @@
+module Author
+    exposing
+        ( Author(..)
+        , FollowedAuthor
+        , UnfollowedAuthor
+        , decoder
+        , fetch
+        , follow
+        , followButton
+        , profile
+        , requestFollow
+        , requestUnfollow
+        , unfollow
+        , unfollowButton
+        , username
+        , view
+        )
+
+{-| The author of an Article. It includes a Profile.
+
+I designed this to make sure the compiler would help me keep these three
+possibilities straight when displaying follow buttons and such:
+
+  - I'm following this author.
+  - I'm not following this author.
+  - I _can't_ follow this author, because it's me!
+
+To do this, I defined `Author` a custom type with three variants, one for each
+of those possibilities.
+
+I also made separate types for FollowedAuthor and UnfollowedAuthor.
+They are custom type wrappers around Profile, and thier sole purpose is to
+help me keep track of which operations are supported.
+
+For example, consider these functions:
+
+requestFollow : UnfollowedAuthor -> Cred -> Http.Request Author
+requestUnfollow : FollowedAuthor -> Cred -> Http.Request Author
+
+These types help the compiler prevent several mistakes:
+
+  - Displaying a Follow button for an author the user already follows.
+  - Displaying an Unfollow button for an author the user already doesn't follow.
+  - Displaying either button when the author is ourself.
+
+There are still ways we could mess things up (e.g. make a button that calls Author.unfollow when you click it, but which displays "Follow" to the user) - but this rules out a bunch of potential problems.
+
+-}
+
+import Api
+import Html exposing (Html, a, i, text)
+import Html.Attributes exposing (attribute, class, href, id, placeholder)
+import Html.Events exposing (onClick)
+import Http
+import HttpBuilder exposing (RequestBuilder, withExpect)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (custom, required)
+import Json.Encode as Encode exposing (Value)
+import Profile exposing (Profile)
+import Route exposing (Route)
+import Username exposing (Username)
+import Viewer exposing (Viewer)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+{-| An author - either the current user, another user we're following, or
+another user we aren't following.
+
+These distinctions matter because we can only perform "follow" requests for
+users we aren't following, we can only perform "unfollow" requests for
+users we _are_ following, and we can't perform either for ourselves.
+
+-}
+type Author
+    = IsFollowing FollowedAuthor
+    | IsNotFollowing UnfollowedAuthor
+    | IsViewer Cred Profile
+
+
+{-| An author we're following.
+-}
+type FollowedAuthor
+    = FollowedAuthor Username Profile
+
+
+{-| An author we're not following.
+-}
+type UnfollowedAuthor
+    = UnfollowedAuthor Username Profile
+
+
+{-| Return an Author's username.
+-}
+username : Author -> Username
+username author =
+    case author of
+        IsViewer cred _ ->
+            Cred.username cred
+
+        IsFollowing (FollowedAuthor val _) ->
+            val
+
+        IsNotFollowing (UnfollowedAuthor val _) ->
+            val
+
+
+{-| Return an Author's profile.
+-}
+profile : Author -> Profile
+profile author =
+    case author of
+        IsViewer _ val ->
+            val
+
+        IsFollowing (FollowedAuthor _ val) ->
+            val
+
+        IsNotFollowing (UnfollowedAuthor _ val) ->
+            val
+
+
+
+-- FETCH
+
+
+fetch : Username -> Maybe Cred -> Http.Request Author
+fetch uname maybeCred =
+    Api.url [ "profiles", Username.toString uname ]
+        |> HttpBuilder.get
+        |> HttpBuilder.withExpect (Http.expectJson (Decode.field "profile" (decoder maybeCred)))
+        |> Cred.addHeaderIfAvailable maybeCred
+        |> HttpBuilder.toRequest
+
+
+
+-- FOLLOWING
+
+
+follow : UnfollowedAuthor -> FollowedAuthor
+follow (UnfollowedAuthor uname prof) =
+    FollowedAuthor uname prof
+
+
+unfollow : FollowedAuthor -> UnfollowedAuthor
+unfollow (FollowedAuthor uname prof) =
+    UnfollowedAuthor uname prof
+
+
+requestFollow : UnfollowedAuthor -> Cred -> Http.Request Author
+requestFollow (UnfollowedAuthor uname _) cred =
+    requestHelp HttpBuilder.post uname cred
+
+
+requestUnfollow : FollowedAuthor -> Cred -> Http.Request Author
+requestUnfollow (FollowedAuthor uname _) cred =
+    requestHelp HttpBuilder.delete uname cred
+
+
+requestHelp :
+    (String -> RequestBuilder a)
+    -> Username
+    -> Cred
+    -> Http.Request Author
+requestHelp builderFromUrl uname cred =
+    Api.url [ "profiles", Username.toString uname, "follow" ]
+        |> builderFromUrl
+        |> Cred.addHeader cred
+        |> withExpect (Http.expectJson (Decode.field "profile" (decoder Nothing)))
+        |> HttpBuilder.toRequest
+
+
+followButton : (Cred -> UnfollowedAuthor -> msg) -> Cred -> UnfollowedAuthor -> Html msg
+followButton toMsg cred ((UnfollowedAuthor uname _) as author) =
+    toggleFollowButton "Follow"
+        [ "btn-outline-secondary" ]
+        (toMsg cred author)
+        uname
+
+
+unfollowButton : (Cred -> FollowedAuthor -> msg) -> Cred -> FollowedAuthor -> Html msg
+unfollowButton toMsg cred ((FollowedAuthor uname _) as author) =
+    toggleFollowButton "Unfollow"
+        [ "btn-secondary" ]
+        (toMsg cred author)
+        uname
+
+
+toggleFollowButton : String -> List String -> msg -> Username -> Html msg
+toggleFollowButton txt extraClasses msgWhenClicked uname =
+    let
+        classStr =
+            "btn btn-sm " ++ String.join " " extraClasses ++ " action-btn"
+
+        caption =
+            " " ++ txt ++ " " ++ Username.toString uname
+    in
+    Html.button [ class classStr, onClick msgWhenClicked ]
+        [ i [ class "ion-plus-round" ] []
+        , text caption
+        ]
+
+
+
+-- SERIALIZATION
+
+
+decoder : Maybe Cred -> Decoder Author
+decoder maybeCred =
+    Decode.succeed Tuple.pair
+        |> custom Profile.decoder
+        |> required "username" Username.decoder
+        |> Decode.andThen (decodeFromPair maybeCred)
+
+
+decodeFromPair : Maybe Cred -> ( Profile, Username ) -> Decoder Author
+decodeFromPair maybeCred ( prof, uname ) =
+    case maybeCred of
+        Nothing ->
+            -- If you're logged out, you can't be following anyone!
+            Decode.succeed (IsNotFollowing (UnfollowedAuthor uname prof))
+
+        Just cred ->
+            if uname == Cred.username cred then
+                Decode.succeed (IsViewer cred prof)
+
+            else
+                nonViewerDecoder prof uname
+
+
+nonViewerDecoder : Profile -> Username -> Decoder Author
+nonViewerDecoder prof uname =
+    Decode.field "following" Decode.bool
+        |> Decode.map (authorFromFollowing prof uname)
+
+
+authorFromFollowing : Profile -> Username -> Bool -> Author
+authorFromFollowing prof uname isFollowing =
+    if isFollowing then
+        IsFollowing (FollowedAuthor uname prof)
+
+    else
+        IsNotFollowing (UnfollowedAuthor uname prof)
+
+
+{-| View an author. We basically render their username and a link to their
+profile, and that's it.
+-}
+view : Username -> Html msg
+view uname =
+    a [ class "author", Route.href (Route.Profile uname) ]
+        [ Username.toHtml uname ]

intro/part6/src/Avatar.elm

@@ -0,0 +1,58 @@
+module Avatar exposing (Avatar, decoder, encode, src, toMaybeString)
+
+import Asset
+import Html exposing (Attribute)
+import Html.Attributes
+import Json.Decode as Decode exposing (Decoder)
+import Json.Encode as Encode exposing (Value)
+
+
+
+-- TYPES
+
+
+type Avatar
+    = Avatar (Maybe String)
+
+
+
+-- CREATE
+
+
+decoder : Decoder Avatar
+decoder =
+    Decode.map Avatar (Decode.nullable Decode.string)
+
+
+
+-- TRANSFORM
+
+
+src : Avatar -> Attribute msg
+src (Avatar maybeUrl) =
+    Html.Attributes.src (resolveAvatarUrl maybeUrl)
+
+
+resolveAvatarUrl : Maybe String -> String
+resolveAvatarUrl maybeUrl =
+    {- 👉 TODO #1 of 2: return the user's avatar from maybeUrl, if maybeUrl actually
+       contains one. If maybeUrl is Nothing, return this URL instead:
+
+          https://static.productionready.io/images/smiley-cyrus.jpg
+    -}
+    ""
+
+
+encode : Avatar -> Value
+encode (Avatar maybeUrl) =
+    case maybeUrl of
+        Just url ->
+            Encode.string url
+
+        Nothing ->
+            Encode.null
+
+
+toMaybeString : Avatar -> Maybe String
+toMaybeString (Avatar maybeUrl) =
+    maybeUrl

intro/part6/src/CommentId.elm

@@ -0,0 +1,29 @@
+module CommentId exposing (CommentId, decoder, toString)
+
+import Json.Decode as Decode exposing (Decoder)
+
+
+
+-- TYPES
+
+
+type CommentId
+    = CommentId Int
+
+
+
+-- CREATE
+
+
+decoder : Decoder CommentId
+decoder =
+    Decode.map CommentId Decode.int
+
+
+
+-- TRANSFORM
+
+
+toString : CommentId -> String
+toString (CommentId id) =
+    String.fromInt id

intro/part6/src/Email.elm

@@ -0,0 +1,45 @@
+module Email exposing (Email, decoder, encode, toString)
+
+import Json.Decode as Decode exposing (Decoder)
+import Json.Encode as Encode exposing (Value)
+
+
+{-| An email address.
+
+Having this as a custom type that's separate from String makes certain
+mistakes impossible. Consider this function:
+
+updateEmailAddress : Email -> String -> Http.Request
+updateEmailAddress email password = ...
+
+(The server needs your password to confirm that you should be allowed
+to update the email address.)
+
+Because Email is not a type alias for String, but is instead a separate
+custom type, it is now impossible to mix up the argument order of the
+email and the password. If we do, it won't compile!
+
+If Email were instead defined as `type alias Email = String`, we could
+call updateEmailAddress password email and it would compile (and never
+work properly).
+
+This way, we make it impossible for a bug like that to compile!
+
+-}
+type Email
+    = Email String
+
+
+toString : Email -> String
+toString (Email str) =
+    str
+
+
+encode : Email -> Value
+encode (Email str) =
+    Encode.string str
+
+
+decoder : Decoder Email
+decoder =
+    Decode.map Email Decode.string

intro/part6/src/Loading.elm

@@ -0,0 +1,25 @@
+module Loading exposing (error, icon, slowThreshold)
+
+{-| A loading spinner icon.
+-}
+
+import Asset
+import Html exposing (Attribute, Html)
+import Html.Attributes exposing (alt, height, src, width)
+import Process
+import Task exposing (Task)
+
+
+icon : Html msg
+icon =
+    Html.img [ Asset.src Asset.loading, width 64, height 64, alt "Loading..." ] []
+
+
+error : String -> Html msg
+error str =
+    Html.text ("Error loading " ++ str ++ ".")
+
+
+slowThreshold : Task x ()
+slowThreshold =
+    Process.sleep 500

intro/part6/src/Log.elm

@@ -0,0 +1,20 @@
+module Log exposing (error)
+
+{-| This is a placeholder API for how we might do logging through
+some service like <http://rollbar.com> (which is what we use at work).
+
+Whenever you see Log.error used in this code base, it means
+"Something unexpected happened. This is where we would log an
+error to our server with some diagnostic info so we could investigate
+what happened later."
+
+(Since this is outside the scope of the RealWorld spec, and is only
+a placeholder anyway, I didn't bother making this function accept actual
+diagnostic info, authentication tokens, etc.)
+
+-}
+
+
+error : Cmd msg
+error =
+    Cmd.none

intro/part6/src/Main.elm

@@ -0,0 +1,334 @@
+module Main exposing (main)
+
+import Article.FeedSources as FeedSources
+import Article.Slug exposing (Slug)
+import Browser exposing (Document)
+import Browser.Navigation as Nav
+import Html exposing (..)
+import Json.Decode as Decode exposing (Value)
+import Page exposing (Page)
+import Page.Article as Article
+import Page.Article.Editor as Editor
+import Page.Blank as Blank
+import Page.Home as Home
+import Page.Login as Login
+import Page.NotFound as NotFound
+import Page.Profile as Profile
+import Page.Register as Register
+import Page.Settings as Settings
+import Route exposing (Route)
+import Session exposing (Session)
+import Task
+import Time
+import Url exposing (Url)
+import Username exposing (Username)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- WARNING: Based on discussions around how asset management features
+-- like code splitting and lazy loading have been shaping up, I expect
+-- most of this file to become unnecessary in a future release of Elm.
+-- Avoid putting things in here unless there is no alternative!
+
+
+type Model
+    = Redirect Session
+    | NotFound Session
+    | Home Home.Model
+    | Settings Settings.Model
+    | Login Login.Model
+    | Register Register.Model
+    | Profile Username Profile.Model
+    | Article Article.Model
+    | Editor (Maybe Slug) Editor.Model
+
+
+
+-- MODEL
+
+
+init : Value -> Url -> Nav.Key -> ( Model, Cmd Msg )
+init flags url navKey =
+    changeRouteTo (Route.fromUrl url)
+        (Redirect (Session.decode navKey flags))
+
+
+
+-- VIEW
+
+
+view : Model -> Document Msg
+view model =
+    let
+        viewPage page toMsg config =
+            let
+                { title, body } =
+                    Page.view (Session.viewer (toSession model)) page config
+            in
+            { title = title
+            , body = List.map (Html.map toMsg) body
+            }
+    in
+    case model of
+        Redirect _ ->
+            viewPage Page.Other (\_ -> Ignored) Blank.view
+
+        NotFound _ ->
+            viewPage Page.Other (\_ -> Ignored) NotFound.view
+
+        Settings settings ->
+            viewPage Page.Other GotSettingsMsg (Settings.view settings)
+
+        Home home ->
+            viewPage Page.Home GotHomeMsg (Home.view home)
+
+        Login login ->
+            viewPage Page.Other GotLoginMsg (Login.view login)
+
+        Register register ->
+            viewPage Page.Other GotRegisterMsg (Register.view register)
+
+        Profile username profile ->
+            viewPage (Page.Profile username) GotProfileMsg (Profile.view profile)
+
+        Article article ->
+            viewPage Page.Other GotArticleMsg (Article.view article)
+
+        Editor Nothing editor ->
+            viewPage Page.NewArticle GotEditorMsg (Editor.view editor)
+
+        Editor (Just _) editor ->
+            viewPage Page.Other GotEditorMsg (Editor.view editor)
+
+
+
+-- UPDATE
+
+
+type Msg
+    = Ignored
+    | ChangedRoute (Maybe Route)
+    | ChangedUrl Url
+    | ClickedLink Browser.UrlRequest
+    | GotHomeMsg Home.Msg
+    | GotSettingsMsg Settings.Msg
+    | GotLoginMsg Login.Msg
+    | GotRegisterMsg Register.Msg
+    | GotProfileMsg Profile.Msg
+    | GotArticleMsg Article.Msg
+    | GotEditorMsg Editor.Msg
+    | GotSession Session
+
+
+toSession : Model -> Session
+toSession page =
+    case page of
+        Redirect session ->
+            session
+
+        NotFound session ->
+            session
+
+        Home home ->
+            Home.toSession home
+
+        Settings settings ->
+            Settings.toSession settings
+
+        Login login ->
+            Login.toSession login
+
+        Register register ->
+            Register.toSession register
+
+        Profile _ profile ->
+            Profile.toSession profile
+
+        Article article ->
+            Article.toSession article
+
+        Editor _ editor ->
+            Editor.toSession editor
+
+
+changeRouteTo : Maybe Route -> Model -> ( Model, Cmd Msg )
+changeRouteTo maybeRoute model =
+    let
+        session =
+            toSession model
+    in
+    case maybeRoute of
+        Nothing ->
+            ( NotFound session, Cmd.none )
+
+        Just Route.Root ->
+            ( model, Route.replaceUrl (Session.navKey session) Route.Home )
+
+        Just Route.Logout ->
+            ( model, Session.logout )
+
+        Just Route.NewArticle ->
+            Editor.initNew session
+                |> updateWith (Editor Nothing) GotEditorMsg model
+
+        Just (Route.EditArticle slug) ->
+            Editor.initEdit session slug
+                |> updateWith (Editor (Just slug)) GotEditorMsg model
+
+        Just Route.Settings ->
+            Settings.init session
+                |> updateWith Settings GotSettingsMsg model
+
+        Just Route.Home ->
+            Home.init session
+                |> updateWith Home GotHomeMsg model
+
+        Just Route.Login ->
+            Login.init session
+                |> updateWith Login GotLoginMsg model
+
+        Just Route.Register ->
+            Register.init session
+                |> updateWith Register GotRegisterMsg model
+
+        Just (Route.Profile username) ->
+            Profile.init session username
+                |> updateWith (Profile username) GotProfileMsg model
+
+        Just (Route.Article slug) ->
+            Article.init session slug
+                |> updateWith Article GotArticleMsg model
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case ( msg, model ) of
+        ( Ignored, _ ) ->
+            ( model, Cmd.none )
+
+        ( ClickedLink urlRequest, _ ) ->
+            case urlRequest of
+                Browser.Internal url ->
+                    case url.fragment of
+                        Nothing ->
+                            -- If we got a link that didn't include a fragment,
+                            -- it's from one of those (href "") attributes that
+                            -- we have to include to make the RealWorld CSS work.
+                            --
+                            -- In an application doing path routing instead of
+                            -- fragment-based routing, this entire
+                            -- `case url.fragment of` expression this comment
+                            -- is inside would be unnecessary.
+                            ( model, Cmd.none )
+
+                        Just _ ->
+                            ( model
+                            , Nav.pushUrl (Session.navKey (toSession model)) (Url.toString url)
+                            )
+
+                Browser.External href ->
+                    ( model
+                    , Nav.load href
+                    )
+
+        ( ChangedUrl url, _ ) ->
+            changeRouteTo (Route.fromUrl url) model
+
+        ( ChangedRoute route, _ ) ->
+            changeRouteTo route model
+
+        ( GotSettingsMsg subMsg, Settings settings ) ->
+            Settings.update subMsg settings
+                |> updateWith Settings GotSettingsMsg model
+
+        ( GotLoginMsg subMsg, Login login ) ->
+            Login.update subMsg login
+                |> updateWith Login GotLoginMsg model
+
+        ( GotRegisterMsg subMsg, Register register ) ->
+            Register.update subMsg register
+                |> updateWith Register GotRegisterMsg model
+
+        ( GotHomeMsg subMsg, Home home ) ->
+            Home.update subMsg home
+                |> updateWith Home GotHomeMsg model
+
+        ( GotProfileMsg subMsg, Profile username profile ) ->
+            Profile.update subMsg profile
+                |> updateWith (Profile username) GotProfileMsg model
+
+        ( GotArticleMsg subMsg, Article article ) ->
+            Article.update subMsg article
+                |> updateWith Article GotArticleMsg model
+
+        ( GotEditorMsg subMsg, Editor slug editor ) ->
+            Editor.update subMsg editor
+                |> updateWith (Editor slug) GotEditorMsg model
+
+        ( GotSession session, Redirect _ ) ->
+            ( Redirect session
+            , Route.replaceUrl (Session.navKey session) Route.Home
+            )
+
+        ( _, _ ) ->
+            -- Disregard messages that arrived for the wrong page.
+            ( model, Cmd.none )
+
+
+updateWith : (subModel -> Model) -> (subMsg -> Msg) -> Model -> ( subModel, Cmd subMsg ) -> ( Model, Cmd Msg )
+updateWith toModel toMsg model ( subModel, subCmd ) =
+    ( toModel subModel
+    , Cmd.map toMsg subCmd
+    )
+
+
+
+-- SUBSCRIPTIONS
+
+
+subscriptions : Model -> Sub Msg
+subscriptions model =
+    case model of
+        NotFound _ ->
+            Sub.none
+
+        Redirect _ ->
+            Session.changes GotSession (Session.navKey (toSession model))
+
+        Settings settings ->
+            Sub.map GotSettingsMsg (Settings.subscriptions settings)
+
+        Home home ->
+            Sub.map GotHomeMsg (Home.subscriptions home)
+
+        Login login ->
+            Sub.map GotLoginMsg (Login.subscriptions login)
+
+        Register register ->
+            Sub.map GotRegisterMsg (Register.subscriptions register)
+
+        Profile _ profile ->
+            Sub.map GotProfileMsg (Profile.subscriptions profile)
+
+        Article article ->
+            Sub.map GotArticleMsg (Article.subscriptions article)
+
+        Editor _ editor ->
+            Sub.map GotEditorMsg (Editor.subscriptions editor)
+
+
+
+-- MAIN
+
+
+main : Program Value Model Msg
+main =
+    Browser.application
+        { init = init
+        , onUrlChange = ChangedUrl
+        , onUrlRequest = ClickedLink
+        , subscriptions = subscriptions
+        , update = update
+        , view = view
+        }

intro/part6/src/Page.elm

@@ -0,0 +1,159 @@
+module Page exposing (Page(..), view, viewErrors)
+
+import Avatar
+import Browser exposing (Document)
+import Html exposing (Html, a, button, div, footer, i, img, li, nav, p, span, text, ul)
+import Html.Attributes exposing (class, classList, href, style)
+import Html.Events exposing (onClick)
+import Profile
+import Route exposing (Route)
+import Session exposing (Session)
+import Username exposing (Username)
+import Viewer exposing (Viewer)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+{-| Determines which navbar link (if any) will be rendered as active.
+
+Note that we don't enumerate every page here, because the navbar doesn't
+have links for every page. Anything that's not part of the navbar falls
+under Other.
+
+-}
+type Page
+    = Other
+    | Home
+    | Login
+    | Register
+    | Settings
+    | Profile Username
+    | NewArticle
+
+
+{-| Take a page's Html and frames it with a header and footer.
+
+The caller provides the current user, so we can display in either
+"signed in" (rendering username) or "signed out" mode.
+
+isLoading is for determining whether we should show a loading spinner
+in the header. (This comes up during slow page transitions.)
+
+-}
+view : Maybe Viewer -> Page -> { title : String, content : Html msg } -> Document msg
+view maybeViewer page { title, content } =
+    { title = title ++ " - Conduit"
+    , body = viewHeader page maybeViewer :: content :: [ viewFooter ]
+    }
+
+
+viewHeader : Page -> Maybe Viewer -> Html msg
+viewHeader page maybeViewer =
+    nav [ class "navbar navbar-light" ]
+        [ div [ class "container" ]
+            [ a [ class "navbar-brand", Route.href Route.Home ]
+                [ text "conduit" ]
+            , ul [ class "nav navbar-nav pull-xs-right" ] <|
+                navbarLink page Route.Home [ text "Home" ]
+                    :: viewMenu page maybeViewer
+            ]
+        ]
+
+
+viewMenu : Page -> Maybe Viewer -> List (Html msg)
+viewMenu page maybeViewer =
+    let
+        linkTo =
+            navbarLink page
+    in
+    case maybeViewer of
+        Just viewer ->
+            let
+                cred =
+                    Viewer.cred viewer
+
+                username =
+                    Cred.username cred
+
+                avatar =
+                    Profile.avatar (Viewer.profile viewer)
+            in
+            [ linkTo Route.NewArticle [ i [ class "ion-compose" ] [], text " New Post" ]
+            , linkTo Route.Settings [ i [ class "ion-gear-a" ] [], text " Settings" ]
+            , linkTo
+                (Route.Profile username)
+                [ img [ class "user-pic", Avatar.src avatar ] []
+                , Username.toHtml username
+                ]
+            , linkTo Route.Logout [ text "Sign out" ]
+            ]
+
+        Nothing ->
+            [ linkTo Route.Login [ text "Sign in" ]
+            , linkTo Route.Register [ text "Sign up" ]
+            ]
+
+
+viewFooter : Html msg
+viewFooter =
+    footer []
+        [ div [ class "container" ]
+            [ a [ class "logo-font", href "/" ] [ text "conduit" ]
+            , span [ class "attribution" ]
+                [ text "An interactive learning project from "
+                , a [ href "https://thinkster.io" ] [ text "Thinkster" ]
+                , text ". Code & design licensed under MIT."
+                ]
+            ]
+        ]
+
+
+navbarLink : Page -> Route -> List (Html msg) -> Html msg
+navbarLink page route linkContent =
+    li [ classList [ ( "nav-item", True ), ( "active", isActive page route ) ] ]
+        [ a [ class "nav-link", Route.href route ] linkContent ]
+
+
+isActive : Page -> Route -> Bool
+isActive page route =
+    case ( page, route ) of
+        ( Home, Route.Home ) ->
+            True
+
+        ( Login, Route.Login ) ->
+            True
+
+        ( Register, Route.Register ) ->
+            True
+
+        ( Settings, Route.Settings ) ->
+            True
+
+        ( Profile pageUsername, Route.Profile routeUsername ) ->
+            pageUsername == routeUsername
+
+        ( NewArticle, Route.NewArticle ) ->
+            True
+
+        _ ->
+            False
+
+
+{-| Render dismissable errors. We use this all over the place!
+-}
+viewErrors : msg -> List String -> Html msg
+viewErrors dismissErrors errors =
+    if List.isEmpty errors then
+        Html.text ""
+
+    else
+        div
+            [ class "error-messages"
+            , style "position" "fixed"
+            , style "top" "0"
+            , style "background" "rgb(250, 250, 250)"
+            , style "padding" "20px"
+            , style "border" "1px solid"
+            ]
+        <|
+            List.map (\error -> p [] [ text error ]) errors
+                ++ [ button [ onClick dismissErrors ] [ text "Ok" ] ]

intro/part6/src/Page/Article.elm

@@ -0,0 +1,588 @@
+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.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
+    | LoadingSlowly
+    | 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
+        , Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold
+        ]
+    )
+
+
+
+-- 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 ->
+                                        []
+
+                                    LoadingSlowly ->
+                                        [ 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 = text "" }
+
+        LoadingSlowly ->
+            { 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
+    | PassedSlowLoadThreshold
+
+
+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 }
+            , Route.replaceUrl (Session.navKey session) Route.Home
+            )
+
+        PassedSlowLoadThreshold ->
+            let
+                -- If any data is still Loading, change it to LoadingSlowly
+                -- so `view` knows to render a spinner.
+                article =
+                    case model.article of
+                        Loading ->
+                            LoadingSlowly
+
+                        other ->
+                            other
+
+                comments =
+                    case model.comments of
+                        Loading ->
+                            LoadingSlowly
+
+                        other ->
+                            other
+            in
+            ( { model | article = article, comments = comments }, 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" ]

intro/part6/src/Page/Article/Editor.elm

@@ -0,0 +1,641 @@
+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 Article.Tag
+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 Viewer exposing (Viewer)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- MODEL
+
+
+type alias Model =
+    { session : Session
+    , status : Status
+    }
+
+
+type
+    Status
+    -- Edit Article
+    = Loading Slug
+    | LoadingSlowly Slug
+    | LoadingFailed Slug
+    | Saving Slug Form
+    | Editing Slug (List Problem) Form
+      -- New Article
+    | EditingNew (List Problem) Form
+    | Creating Form
+
+
+type Problem
+    = InvalidEntry ValidatedField String
+    | ServerError String
+
+
+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
+      }
+    , Cmd.batch
+        [ 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
+        , Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold
+        ]
+    )
+
+
+
+-- 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."
+    }
+
+
+viewProblems : List Problem -> Html msg
+viewProblems problems =
+    ul [ class "error-messages" ]
+        (List.map viewProblem problems)
+
+
+viewProblem : Problem -> Html msg
+viewProblem problem =
+    let
+        errorMessage =
+            case problem of
+                InvalidEntry _ message ->
+                    message
+
+                ServerError message ->
+                    message
+    in
+    li [] [ text errorMessage ]
+
+
+viewAuthenticated : Cred -> Model -> Html Msg
+viewAuthenticated cred model =
+    let
+        formHtml =
+            case model.status of
+                Loading _ ->
+                    []
+
+                LoadingSlowly _ ->
+                    [ Loading.icon ]
+
+                Saving slug form ->
+                    [ viewForm cred form (editArticleSaveButton [ disabled True ]) ]
+
+                Creating form ->
+                    [ viewForm cred form (newArticleSaveButton [ disabled True ]) ]
+
+                Editing slug problems form ->
+                    [ viewProblems problems
+                    , viewForm cred form (editArticleSaveButton [])
+                    ]
+
+                EditingNew problems form ->
+                    [ viewProblems problems
+                    , 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
+    | PassedSlowLoadThreshold
+
+
+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 error 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 error 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 }
+            , Route.replaceUrl (Session.navKey session) Route.Home
+            )
+
+        PassedSlowLoadThreshold ->
+            let
+                -- If any data is still Loading, change it to LoadingSlowly
+                -- so `view` knows to render a spinner.
+                status =
+                    case model.status of
+                        Loading slug ->
+                            LoadingSlowly slug
+
+                        other ->
+                            other
+            in
+            ( { model | status = status }, Cmd.none )
+
+
+save : Cred -> Status -> ( Status, Cmd Msg )
+save cred status =
+    case status of
+        Editing slug _ form ->
+            case validate form of
+                Ok validForm ->
+                    ( Saving slug form
+                    , edit slug validForm cred
+                        |> Http.send CompletedEdit
+                    )
+
+                Err problems ->
+                    ( Editing slug problems form
+                    , Cmd.none
+                    )
+
+        EditingNew _ form ->
+            case validate form of
+                Ok validForm ->
+                    ( Creating form
+                    , create validForm cred
+                        |> Http.send CompletedCreate
+                    )
+
+                Err problems ->
+                    ( EditingNew problems form
+                    , 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 : Http.Error -> Status -> Status
+savingError error status =
+    let
+        problems =
+            [ ServerError "Error saving article" ]
+    in
+    case status of
+        Saving slug form ->
+            Editing slug problems form
+
+        Creating form ->
+            EditingNew problems 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
+
+                LoadingSlowly _ ->
+                    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)
+
+
+
+-- FORM
+
+
+{-| Marks that we've trimmed the form's fields, so we don't accidentally send
+it to the server without having trimmed it!
+-}
+type TrimmedForm
+    = Trimmed Form
+
+
+{-| When adding a variant here, add it to `fieldsToValidate` too!
+-}
+type ValidatedField
+    = Title
+    | Body
+
+
+fieldsToValidate : List ValidatedField
+fieldsToValidate =
+    [ Title
+    , Body
+    ]
+
+
+{-| Trim the form and validate its fields. If there are problems, report them!
+-}
+validate : Form -> Result (List Problem) TrimmedForm
+validate form =
+    let
+        trimmedForm =
+            trimFields form
+    in
+    case List.concatMap (validateField trimmedForm) fieldsToValidate of
+        [] ->
+            Ok trimmedForm
+
+        problems ->
+            Err problems
+
+
+validateField : TrimmedForm -> ValidatedField -> List Problem
+validateField (Trimmed form) field =
+    List.map (InvalidEntry field) <|
+        case field of
+            Title ->
+                if String.isEmpty form.title then
+                    [ "title can't be blank." ]
+
+                else
+                    []
+
+            Body ->
+                if String.isEmpty form.body then
+                    [ "body can't be blank." ]
+
+                else if String.trim form.tags /= "" && List.all String.isEmpty (toTagList form.tags) then
+                    [ "close, but not quite! Is your filter condition returning True when it should be returning False?" ]
+
+                else if Article.Tag.validate form.tags (toTagList form.tags) then
+                    []
+
+                else
+                    [ "some tags were empty." ]
+
+
+{-| Don't trim while the user is typing! That would be super annoying.
+Instead, trim only on submit.
+-}
+trimFields : Form -> TrimmedForm
+trimFields form =
+    Trimmed
+        { title = String.trim form.title
+        , body = String.trim form.body
+        , description = String.trim form.description
+        , tags = String.trim form.tags
+        }
+
+
+
+-- HTTP
+
+
+create : TrimmedForm -> Cred -> Http.Request (Article Full)
+create (Trimmed form) cred =
+    let
+        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 (toTagList form.tags) )
+                ]
+
+        jsonBody =
+            Encode.object [ ( "article", article ) ]
+                |> Http.jsonBody
+    in
+    Api.url [ "articles" ]
+        |> HttpBuilder.post
+        |> Cred.addHeader cred
+        |> withBody jsonBody
+        |> withExpect expect
+        |> HttpBuilder.toRequest
+
+
+toTagList : String -> List String
+toTagList tagString =
+    {- 👉 TODO #2 of 2: add another |> to the end of this pipeline,
+       which filters out any remaining empty strings.
+
+       To see if the bug is fixed, visit http://localhost:3000/#/editor
+       (you'll need to be logged in) and create an article with tags that have
+       multiple spaces between them, e.g. "tag1     tag2     tag3"
+
+       If the bug has not been fixed, trying to save an article with those tags
+       will result in an error! If it has been fixed, saving will work and the
+       tags will be accepted.
+
+       💡 HINT: Here's how to remove all the "foo" strings from a list of strings:
+
+       List.filter (\str -> str == "foo") listOfStrings
+    -}
+    String.split " " tagString
+        |> List.map String.trim
+
+
+edit : Slug -> TrimmedForm -> Cred -> Http.Request (Article Full)
+edit articleSlug (Trimmed form) cred =
+    let
+        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
+
+        LoadingSlowly slug ->
+            Just slug
+
+        LoadingFailed slug ->
+            Just slug
+
+        Saving slug _ ->
+            Just slug
+
+        Editing slug _ _ ->
+            Just slug
+
+        EditingNew _ _ ->
+            Nothing
+
+        Creating _ ->
+            Nothing

intro/part6/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 ""
+    }

intro/part6/src/Page/Home.elm

@@ -0,0 +1,259 @@
+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
+    | LoadingSlowly
+    | 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
+        , Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold
+        ]
+    )
+
+
+
+-- 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 ->
+                                []
+
+                            LoadingSlowly ->
+                                [ Loading.icon ]
+
+                            Failed ->
+                                [ Loading.error "feed" ]
+                    , div [ class "col-md-3" ] <|
+                        case model.tags of
+                            Loaded tags ->
+                                [ div [ class "sidebar" ] <|
+                                    [ p [] [ text "Popular Tags" ]
+                                    , viewTags tags
+                                    ]
+                                ]
+
+                            Loading ->
+                                []
+
+                            LoadingSlowly ->
+                                [ 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
+    | PassedSlowLoadThreshold
+
+
+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 )
+
+                LoadingSlowly ->
+                    ( model, Log.error )
+
+                Failed ->
+                    ( model, Log.error )
+
+        GotTimeZone tz ->
+            ( { model | timeZone = tz }, Cmd.none )
+
+        GotSession session ->
+            ( { model | session = session }, Cmd.none )
+
+        PassedSlowLoadThreshold ->
+            let
+                -- If any data is still Loading, change it to LoadingSlowly
+                -- so `view` knows to render a spinner.
+                feed =
+                    case model.feed of
+                        Loading ->
+                            LoadingSlowly
+
+                        other ->
+                            other
+
+                tags =
+                    case model.tags of
+                        Loading ->
+                            LoadingSlowly
+
+                        other ->
+                            other
+            in
+            ( { model | feed = feed, tags = tags }, Cmd.none )
+
+
+
+-- SUBSCRIPTIONS
+
+
+subscriptions : Model -> Sub Msg
+subscriptions model =
+    Session.changes GotSession (Session.navKey model.session)
+
+
+
+-- EXPORT
+
+
+toSession : Model -> Session
+toSession model =
+    model.session

intro/part6/src/Page/Login.elm

@@ -0,0 +1,317 @@
+module Page.Login exposing (Model, Msg, init, subscriptions, toSession, update, view)
+
+{-| The login page.
+-}
+
+import Api
+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 Viewer exposing (Viewer)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- MODEL
+
+
+type alias Model =
+    { session : Session
+    , problems : List Problem
+    , form : Form
+    }
+
+
+{-| Recording validation problems 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:
+
+viewFieldErrors : ValidatedField -> List Problem -> Html msg
+
+...and it filters the list of problems to render only InvalidEntry ones for the
+given ValidatedField. That way you can call this:
+
+viewFieldErrors Email problems
+
+...next to the `email` field, and call `viewFieldErrors Password problems`
+next to the `password` field, and so on.
+
+The `LoginError` should be displayed elsewhere, since it doesn't correspond to
+a particular field.
+
+-}
+type Problem
+    = InvalidEntry ValidatedField String
+    | ServerError String
+
+
+type alias Form =
+    { email : String
+    , password : String
+    }
+
+
+init : Session -> ( Model, Cmd msg )
+init session =
+    ( { session = session
+      , problems = []
+      , 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 viewProblem model.problems)
+                        , viewForm model.form
+                        ]
+                    ]
+                ]
+            ]
+    }
+
+
+viewProblem : Problem -> Html msg
+viewProblem problem =
+    let
+        errorMessage =
+            case problem of
+                InvalidEntry _ str ->
+                    str
+
+                ServerError str ->
+                    str
+    in
+    li [] [ text errorMessage ]
+
+
+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 model.form of
+                Ok validForm ->
+                    ( { model | problems = [] }
+                    , Http.send CompletedLogin (login validForm)
+                    )
+
+                Err problems ->
+                    ( { model | problems = problems }
+                    , Cmd.none
+                    )
+
+        EnteredEmail email ->
+            updateForm (\form -> { form | email = email }) model
+
+        EnteredPassword password ->
+            updateForm (\form -> { form | password = password }) model
+
+        CompletedLogin (Err error) ->
+            let
+                serverErrors =
+                    Api.decodeErrors error
+                        |> List.map ServerError
+            in
+            ( { model | problems = List.append model.problems serverErrors }
+            , Cmd.none
+            )
+
+        CompletedLogin (Ok viewer) ->
+            ( model
+            , Session.login viewer
+            )
+
+        GotSession session ->
+            ( { model | session = session }
+            , Route.replaceUrl (Session.navKey session) Route.Home
+            )
+
+
+{-| 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)
+
+
+
+-- FORM
+
+
+{-| Marks that we've trimmed the form's fields, so we don't accidentally send
+it to the server without having trimmed it!
+-}
+type TrimmedForm
+    = Trimmed Form
+
+
+{-| When adding a variant here, add it to `fieldsToValidate` too!
+-}
+type ValidatedField
+    = Email
+    | Password
+
+
+fieldsToValidate : List ValidatedField
+fieldsToValidate =
+    [ Email
+    , Password
+    ]
+
+
+{-| Trim the form and validate its fields. If there are problems, report them!
+-}
+validate : Form -> Result (List Problem) TrimmedForm
+validate form =
+    let
+        trimmedForm =
+            trimFields form
+    in
+    case List.concatMap (validateField trimmedForm) fieldsToValidate of
+        [] ->
+            Ok trimmedForm
+
+        problems ->
+            Err problems
+
+
+validateField : TrimmedForm -> ValidatedField -> List Problem
+validateField (Trimmed form) field =
+    List.map (InvalidEntry field) <|
+        case field of
+            Email ->
+                if String.isEmpty form.email then
+                    [ "email can't be blank." ]
+
+                else
+                    []
+
+            Password ->
+                if String.isEmpty form.password then
+                    [ "password can't be blank." ]
+
+                else
+                    []
+
+
+{-| Don't trim while the user is typing! That would be super annoying.
+Instead, trim only on submit.
+-}
+trimFields : Form -> TrimmedForm
+trimFields form =
+    Trimmed
+        { email = String.trim form.email
+        , password = String.trim form.password
+        }
+
+
+
+-- HTTP
+
+
+login : TrimmedForm -> Http.Request Viewer
+login (Trimmed form) =
+    let
+        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

intro/part6/src/Page/NotFound.elm

@@ -0,0 +1,21 @@
+module Page.NotFound exposing (view)
+
+import Asset
+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 [ Asset.src Asset.error ] [] ]
+            ]
+    }

intro/part6/src/Page/Profile.elm

@@ -0,0 +1,346 @@
+module Page.Profile exposing (Model, Msg, init, subscriptions, toSession, update, view)
+
+{-| An Author's profile.
+-}
+
+import Article.Feed as Feed
+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 Route
+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
+    | LoadingSlowly 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
+        , Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold
+        ]
+    )
+
+
+
+-- 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 ->
+                    titleForMe (Session.cred model.session) username
+
+                LoadingSlowly username ->
+                    titleForMe (Session.cred model.session) username
+
+                Failed username ->
+                    titleForMe (Session.cred model.session) username
+    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 _ ->
+                            text ""
+
+                        LoadingSlowly _ ->
+                            Loading.icon
+
+                        Failed _ ->
+                            Loading.error "feed"
+                    ]
+
+            Loading _ ->
+                text ""
+
+            LoadingSlowly _ ->
+                Loading.icon
+
+            Failed _ ->
+                Loading.error "profile"
+    }
+
+
+
+-- PAGE TITLE
+
+
+titleForOther : Username -> String
+titleForOther otherUsername =
+    "Profile — " ++ Username.toString otherUsername
+
+
+titleForMe : Maybe Cred -> Username -> String
+titleForMe maybeCred username =
+    case maybeCred of
+        Just cred ->
+            if username == Cred.username cred then
+                myProfileTitle
+
+            else
+                defaultTitle
+
+        Nothing ->
+            defaultTitle
+
+
+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
+    | PassedSlowLoadThreshold
+
+
+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 )
+
+                LoadingSlowly _ ->
+                    ( model, Log.error )
+
+                Failed _ ->
+                    ( model, Log.error )
+
+        GotTimeZone tz ->
+            ( { model | timeZone = tz }, Cmd.none )
+
+        GotSession session ->
+            ( { model | session = session }
+            , Route.replaceUrl (Session.navKey session) Route.Home
+            )
+
+        PassedSlowLoadThreshold ->
+            let
+                -- If any data is still Loading, change it to LoadingSlowly
+                -- so `view` knows to render a spinner.
+                feed =
+                    case model.feed of
+                        Loading username ->
+                            LoadingSlowly username
+
+                        other ->
+                            other
+            in
+            ( { model | feed = feed }, 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 ]

intro/part6/src/Page/Register.elm

@@ -0,0 +1,319 @@
+module Page.Register exposing (Model, Msg, init, subscriptions, toSession, update, view)
+
+import Api
+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 Viewer exposing (Viewer)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- MODEL
+
+
+type alias Model =
+    { session : Session
+    , problems : List Problem
+    , form : Form
+    }
+
+
+type alias Form =
+    { email : String
+    , username : String
+    , password : String
+    }
+
+
+type Problem
+    = InvalidEntry ValidatedField String
+    | ServerError String
+
+
+init : Session -> ( Model, Cmd msg )
+init session =
+    ( { session = session
+      , problems = []
+      , 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?" ]
+                            ]
+                        , ul [ class "error-messages" ]
+                            (List.map viewProblem model.problems)
+                        , 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" ]
+        ]
+
+
+viewProblem : Problem -> Html msg
+viewProblem problem =
+    let
+        errorMessage =
+            case problem of
+                InvalidEntry _ str ->
+                    str
+
+                ServerError str ->
+                    str
+    in
+    li [] [ text errorMessage ]
+
+
+
+-- 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 model.form of
+                Ok validForm ->
+                    ( { model | problems = [] }
+                    , Http.send CompletedRegister (register validForm)
+                    )
+
+                Err problems ->
+                    ( { model | problems = problems }
+                    , 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 =
+                    Api.decodeErrors error
+                        |> List.map ServerError
+            in
+            ( { model | problems = List.append model.problems serverErrors }
+            , Cmd.none
+            )
+
+        CompletedRegister (Ok viewer) ->
+            ( model
+            , Session.login viewer
+            )
+
+        GotSession session ->
+            ( { model | session = session }
+            , Route.replaceUrl (Session.navKey session) Route.Home
+            )
+
+
+{-| 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
+
+
+
+-- FORM
+
+
+{-| Marks that we've trimmed the form's fields, so we don't accidentally send
+it to the server without having trimmed it!
+-}
+type TrimmedForm
+    = Trimmed Form
+
+
+{-| When adding a variant here, add it to `fieldsToValidate` too!
+-}
+type ValidatedField
+    = Username
+    | Email
+    | Password
+
+
+fieldsToValidate : List ValidatedField
+fieldsToValidate =
+    [ Username
+    , Email
+    , Password
+    ]
+
+
+{-| Trim the form and validate its fields. If there are problems, report them!
+-}
+validate : Form -> Result (List Problem) TrimmedForm
+validate form =
+    let
+        trimmedForm =
+            trimFields form
+    in
+    case List.concatMap (validateField trimmedForm) fieldsToValidate of
+        [] ->
+            Ok trimmedForm
+
+        problems ->
+            Err problems
+
+
+validateField : TrimmedForm -> ValidatedField -> List Problem
+validateField (Trimmed form) field =
+    List.map (InvalidEntry field) <|
+        case field of
+            Username ->
+                if String.isEmpty form.username then
+                    [ "username can't be blank." ]
+
+                else
+                    []
+
+            Email ->
+                if String.isEmpty form.email then
+                    [ "email can't be blank." ]
+
+                else
+                    []
+
+            Password ->
+                if String.isEmpty form.password then
+                    [ "password can't be blank." ]
+
+                else if String.length form.password < Viewer.minPasswordChars then
+                    [ "password must be at least " ++ String.fromInt Viewer.minPasswordChars ++ " characters long." ]
+
+                else
+                    []
+
+
+{-| Don't trim while the user is typing! That would be super annoying.
+Instead, trim only on submit.
+-}
+trimFields : Form -> TrimmedForm
+trimFields form =
+    Trimmed
+        { username = String.trim form.username
+        , email = String.trim form.email
+        , password = String.trim form.password
+        }
+
+
+
+-- HTTP
+
+
+register : TrimmedForm -> Http.Request Viewer
+register (Trimmed form) =
+    let
+        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

intro/part6/src/Page/Settings.elm

@@ -0,0 +1,434 @@
+module Page.Settings exposing (Model, Msg, init, subscriptions, toSession, update, view)
+
+import Api
+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 Viewer exposing (Viewer)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- MODEL
+
+
+type alias Model =
+    { session : Session
+    , problems : List Problem
+    , form : Form
+    }
+
+
+type alias Form =
+    { avatar : String
+    , bio : String
+    , email : String
+    , username : String
+    , password : String
+    }
+
+
+type Problem
+    = InvalidEntry ValidatedField String
+    | ServerError String
+
+
+init : Session -> ( Model, Cmd msg )
+init session =
+    ( { session = session
+      , problems = []
+      , form =
+            case Session.viewer session of
+                Just viewer ->
+                    let
+                        profile =
+                            Viewer.profile viewer
+
+                        cred =
+                            Viewer.cred viewer
+                    in
+                    { avatar = Maybe.withDefault "" (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 ->
+                    -- 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 = ""
+                    , email = ""
+                    , bio = ""
+                    , username = ""
+                    , password = ""
+                    }
+      }
+    , 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" ]
+                                , ul [ class "error-messages" ]
+                                    (List.map viewProblem model.problems)
+                                , 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 form.avatar
+                    , onInput EnteredAvatar
+                    ]
+                    []
+                ]
+            , 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 form.password
+                    , onInput EnteredPassword
+                    ]
+                    []
+                ]
+            , button
+                [ class "btn btn-lg btn-primary pull-xs-right" ]
+                [ text "Update Settings" ]
+            ]
+        ]
+
+
+viewProblem : Problem -> Html msg
+viewProblem problem =
+    let
+        errorMessage =
+            case problem of
+                InvalidEntry _ message ->
+                    message
+
+                ServerError message ->
+                    message
+    in
+    li [] [ text errorMessage ]
+
+
+
+-- UPDATE
+
+
+type Msg
+    = SubmittedForm Cred
+    | EnteredEmail String
+    | EnteredUsername String
+    | EnteredPassword String
+    | EnteredBio String
+    | EnteredAvatar String
+    | CompletedSave (Result Http.Error Viewer)
+    | GotSession Session
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        SubmittedForm cred ->
+            case validate model.form of
+                Ok validForm ->
+                    ( { model | problems = [] }
+                    , edit cred validForm
+                        |> Http.send CompletedSave
+                    )
+
+                Err problems ->
+                    ( { model | problems = problems }
+                    , Cmd.none
+                    )
+
+        EnteredEmail email ->
+            updateForm (\form -> { form | email = email }) model
+
+        EnteredUsername username ->
+            updateForm (\form -> { form | username = username }) model
+
+        EnteredPassword password ->
+            updateForm (\form -> { form | password = password }) model
+
+        EnteredBio bio ->
+            updateForm (\form -> { form | bio = bio }) model
+
+        EnteredAvatar avatar ->
+            updateForm (\form -> { form | avatar = avatar }) model
+
+        CompletedSave (Err error) ->
+            let
+                serverErrors =
+                    Api.decodeErrors error
+                        |> List.map ServerError
+            in
+            ( { model | problems = List.append model.problems serverErrors }
+            , Cmd.none
+            )
+
+        CompletedSave (Ok cred) ->
+            ( model
+            , Session.login cred
+            )
+
+        GotSession session ->
+            ( { model | session = session }
+            , Route.replaceUrl (Session.navKey session) Route.Home
+            )
+
+
+{-| 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
+
+
+
+-- FORM
+
+
+{-| Marks that we've trimmed the form's fields, so we don't accidentally send
+it to the server without having trimmed it!
+-}
+type TrimmedForm
+    = Trimmed Form
+
+
+{-| When adding a variant here, add it to `fieldsToValidate` too!
+
+NOTE: there are no ImageUrl or Bio variants here, because they aren't validated!
+
+-}
+type ValidatedField
+    = Username
+    | Email
+    | Password
+
+
+fieldsToValidate : List ValidatedField
+fieldsToValidate =
+    [ Username
+    , Email
+    , Password
+    ]
+
+
+{-| Trim the form and validate its fields. If there are problems, report them!
+-}
+validate : Form -> Result (List Problem) TrimmedForm
+validate form =
+    let
+        trimmedForm =
+            trimFields form
+    in
+    case List.concatMap (validateField trimmedForm) fieldsToValidate of
+        [] ->
+            Ok trimmedForm
+
+        problems ->
+            Err problems
+
+
+validateField : TrimmedForm -> ValidatedField -> List Problem
+validateField (Trimmed form) field =
+    List.map (InvalidEntry field) <|
+        case field of
+            Username ->
+                if String.isEmpty form.username then
+                    [ "username can't be blank." ]
+
+                else
+                    []
+
+            Email ->
+                if String.isEmpty form.email then
+                    [ "email can't be blank." ]
+
+                else
+                    []
+
+            Password ->
+                let
+                    passwordLength =
+                        String.length form.password
+                in
+                if passwordLength > 0 && passwordLength < Viewer.minPasswordChars then
+                    [ "password must be at least " ++ String.fromInt Viewer.minPasswordChars ++ " characters long." ]
+
+                else
+                    []
+
+
+{-| Don't trim while the user is typing! That would be super annoying.
+Instead, trim only on submit.
+-}
+trimFields : Form -> TrimmedForm
+trimFields form =
+    Trimmed
+        { avatar = String.trim form.avatar
+        , bio = String.trim form.bio
+        , email = String.trim form.email
+        , username = String.trim form.username
+        , password = String.trim form.password
+        }
+
+
+
+-- HTTP
+
+
+{-| This takes a Valid Form as a reminder that it needs to have been validated
+first.
+-}
+edit : Cred -> TrimmedForm -> Http.Request Viewer
+edit cred (Trimmed form) =
+    let
+        encodedAvatar =
+            case form.avatar of
+                "" ->
+                    Encode.null
+
+                avatar ->
+                    Encode.string avatar
+
+        updates =
+            [ ( "username", Encode.string form.username )
+            , ( "email", Encode.string form.email )
+            , ( "bio", Encode.string form.bio )
+            , ( "image", encodedAvatar )
+            ]
+
+        encodedUser =
+            Encode.object <|
+                case form.password of
+                    "" ->
+                        updates
+
+                    password ->
+                        ( "password", Encode.string password ) :: updates
+
+        body =
+            Encode.object [ ( "user", encodedUser ) ]
+                |> 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
+
+
+nothingIfEmpty : String -> Maybe String
+nothingIfEmpty str =
+    if String.isEmpty str then
+        Nothing
+
+    else
+        Just str

intro/part6/src/PaginatedList.elm

@@ -0,0 +1,98 @@
+module PaginatedList exposing (PaginatedList, fromList, map, mapPage, page, total, values, view)
+
+import Html exposing (Html, a, li, text, ul)
+import Html.Attributes exposing (class, classList, href)
+import Html.Events exposing (onClick)
+
+
+
+-- TYPES
+
+
+type PaginatedList a
+    = PaginatedList
+        { values : List a
+        , total : Int
+        , page : Int
+        }
+
+
+
+-- INFO
+
+
+values : PaginatedList a -> List a
+values (PaginatedList info) =
+    info.values
+
+
+total : PaginatedList a -> Int
+total (PaginatedList info) =
+    info.total
+
+
+page : PaginatedList a -> Int
+page (PaginatedList info) =
+    info.page
+
+
+
+-- CREATE
+
+
+fromList : Int -> List a -> PaginatedList a
+fromList totalCount list =
+    PaginatedList { values = list, total = totalCount, page = 1 }
+
+
+
+-- TRANSFORM
+
+
+map : (a -> a) -> PaginatedList a -> PaginatedList a
+map transform (PaginatedList info) =
+    PaginatedList { info | values = List.map transform info.values }
+
+
+mapPage : (Int -> Int) -> PaginatedList a -> PaginatedList a
+mapPage transform (PaginatedList info) =
+    PaginatedList { info | page = transform info.page }
+
+
+
+-- VIEW
+
+
+view : (Int -> msg) -> PaginatedList a -> Int -> Html msg
+view toMsg list resultsPerPage =
+    let
+        totalPages =
+            ceiling (toFloat (total list) / toFloat resultsPerPage)
+
+        activePage =
+            page list
+
+        viewPageLink currentPage =
+            pageLink toMsg currentPage (currentPage == activePage)
+    in
+    if totalPages > 1 then
+        List.range 1 totalPages
+            |> List.map viewPageLink
+            |> ul [ class "pagination" ]
+
+    else
+        Html.text ""
+
+
+pageLink : (Int -> msg) -> Int -> Bool -> Html msg
+pageLink toMsg targetPage isActive =
+    li [ classList [ ( "page-item", True ), ( "active", isActive ) ] ]
+        [ a
+            [ class "page-link"
+            , onClick (toMsg targetPage)
+
+            -- The RealWorld CSS requires an href to work properly.
+            , href ""
+            ]
+            [ text (String.fromInt targetPage) ]
+        ]

intro/part6/src/Profile.elm

@@ -0,0 +1,56 @@
+module Profile exposing (Profile, avatar, bio, decoder)
+
+{-| A user's profile - potentially your own!
+
+Contrast with Cred, which is the currently signed-in user.
+
+-}
+
+import Api
+import Avatar exposing (Avatar)
+import Http
+import HttpBuilder exposing (RequestBuilder, withExpect)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (required)
+import Username exposing (Username)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- TYPES
+
+
+type Profile
+    = Profile Internals
+
+
+type alias Internals =
+    { bio : Maybe String
+    , avatar : Avatar
+    }
+
+
+
+-- INFO
+
+
+bio : Profile -> Maybe String
+bio (Profile info) =
+    info.bio
+
+
+avatar : Profile -> Avatar
+avatar (Profile info) =
+    info.avatar
+
+
+
+-- SERIALIZATION
+
+
+decoder : Decoder Profile
+decoder =
+    Decode.succeed Internals
+        |> required "bio" (Decode.nullable Decode.string)
+        |> required "image" Avatar.decoder
+        |> Decode.map Profile

intro/part6/src/Route.elm

@@ -0,0 +1,107 @@
+module Route exposing (Route(..), fromUrl, href, replaceUrl)
+
+import Article.Slug as Slug exposing (Slug)
+import Browser.Navigation as Nav
+import Html exposing (Attribute)
+import Html.Attributes as Attr
+import Profile exposing (Profile)
+import Url exposing (Url)
+import Url.Parser as Parser exposing ((</>), Parser, oneOf, s, string)
+import Username exposing (Username)
+
+
+
+-- ROUTING
+
+
+type Route
+    = Home
+    | Root
+    | Login
+    | Logout
+    | Register
+    | Settings
+    | Article Slug
+    | Profile Username
+    | NewArticle
+    | EditArticle Slug
+
+
+parser : Parser (Route -> a) a
+parser =
+    oneOf
+        [ Parser.map Home Parser.top
+        , Parser.map Login (s "login")
+        , Parser.map Logout (s "logout")
+        , Parser.map Settings (s "settings")
+        , Parser.map Profile (s "profile" </> Username.urlParser)
+        , Parser.map Register (s "register")
+        , Parser.map Article (s "article" </> Slug.urlParser)
+        , Parser.map NewArticle (s "editor")
+        , Parser.map EditArticle (s "editor" </> Slug.urlParser)
+        ]
+
+
+
+-- PUBLIC HELPERS
+
+
+href : Route -> Attribute msg
+href targetRoute =
+    Attr.href (routeToString targetRoute)
+
+
+replaceUrl : Nav.Key -> Route -> Cmd msg
+replaceUrl key route =
+    Nav.replaceUrl key (routeToString route)
+
+
+fromUrl : Url -> Maybe Route
+fromUrl url =
+    -- The RealWorld spec treats the fragment like a path.
+    -- This makes it *literally* the path, so we can proceed
+    -- with parsing as if it had been a normal path all along.
+    { url | path = Maybe.withDefault "" url.fragment, fragment = Nothing }
+        |> Parser.parse parser
+
+
+
+-- INTERNAL
+
+
+routeToString : Route -> String
+routeToString page =
+    let
+        pieces =
+            case page of
+                Home ->
+                    []
+
+                Root ->
+                    []
+
+                Login ->
+                    [ "login" ]
+
+                Logout ->
+                    [ "logout" ]
+
+                Register ->
+                    [ "register" ]
+
+                Settings ->
+                    [ "settings" ]
+
+                Article slug ->
+                    [ "article", Slug.toString slug ]
+
+                Profile username ->
+                    [ "profile", Username.toString username ]
+
+                NewArticle ->
+                    [ "editor" ]
+
+                EditArticle slug ->
+                    [ "editor", Slug.toString slug ]
+    in
+    "#/" ++ String.join "/" pieces

intro/part6/src/Session.elm

@@ -0,0 +1,116 @@
+port module Session
+    exposing
+        ( Session
+        , changes
+        , cred
+        , decode
+        , login
+        , logout
+        , navKey
+        , viewer
+        )
+
+import Browser.Navigation as Nav
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (custom, required)
+import Json.Encode as Encode exposing (Value)
+import Profile exposing (Profile)
+import Time
+import Viewer exposing (Viewer)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- TYPES
+
+
+type Session
+    = LoggedIn Nav.Key Viewer
+    | Guest Nav.Key
+
+
+
+-- INFO
+
+
+viewer : Session -> Maybe Viewer
+viewer session =
+    case session of
+        LoggedIn _ val ->
+            Just val
+
+        Guest _ ->
+            Nothing
+
+
+cred : Session -> Maybe Cred
+cred session =
+    case session of
+        LoggedIn _ val ->
+            Just (Viewer.cred val)
+
+        Guest _ ->
+            Nothing
+
+
+navKey : Session -> Nav.Key
+navKey session =
+    case session of
+        LoggedIn key _ ->
+            key
+
+        Guest key ->
+            key
+
+
+
+-- LOGIN
+
+
+login : Viewer -> Cmd msg
+login newViewer =
+    Viewer.encode newViewer
+        |> Encode.encode 0
+        |> Just
+        |> storeSession
+
+
+
+-- LOGOUT
+
+
+logout : Cmd msg
+logout =
+    storeSession Nothing
+
+
+port storeSession : Maybe String -> Cmd msg
+
+
+
+-- CHANGES
+
+
+changes : (Session -> msg) -> Nav.Key -> Sub msg
+changes toMsg key =
+    onSessionChange (\val -> toMsg (decode key val))
+
+
+port onSessionChange : (Value -> msg) -> Sub msg
+
+
+decode : Nav.Key -> Value -> Session
+decode key value =
+    -- It's stored in localStorage as a JSON String;
+    -- first decode the Value as a String, then
+    -- decode that String as JSON.
+    case
+        Decode.decodeValue Decode.string value
+            |> Result.andThen (Decode.decodeString Viewer.decoder)
+            |> Result.toMaybe
+    of
+        Just decodedViewer ->
+            LoggedIn key decodedViewer
+
+        Nothing ->
+            Guest key

intro/part6/src/Timestamp.elm

@@ -0,0 +1,100 @@
+module Timestamp exposing (format, iso8601Decoder, view)
+
+import Html exposing (Html, span, text)
+import Html.Attributes exposing (class)
+import Iso8601
+import Json.Decode as Decode exposing (Decoder, fail, succeed)
+import Time exposing (Month(..))
+
+
+
+-- VIEW
+
+
+view : Time.Zone -> Time.Posix -> Html msg
+view timeZone timestamp =
+    span [ class "date" ] [ text (format timeZone timestamp) ]
+
+
+
+-- DECODE
+
+
+{-| Decode an ISO-8601 date string.
+-}
+iso8601Decoder : Decoder Time.Posix
+iso8601Decoder =
+    Decode.string
+        |> Decode.andThen fromString
+
+
+fromString : String -> Decoder Time.Posix
+fromString str =
+    case Iso8601.toTime str of
+        Ok successValue ->
+            succeed successValue
+
+        Err _ ->
+            fail ("Invalid date: " ++ str)
+
+
+
+-- FORMAT
+
+
+{-| Format a timestamp as a String, like so:
+
+    "February 14, 2018"
+
+For more complex date formatting scenarios, here's a nice package:
+<https://package.elm-lang.org/packages/ryannhg/date-format/latest/>
+
+-}
+format : Time.Zone -> Time.Posix -> String
+format zone time =
+    let
+        month =
+            case Time.toMonth zone time of
+                Jan ->
+                    "January"
+
+                Feb ->
+                    "February"
+
+                Mar ->
+                    "March"
+
+                Apr ->
+                    "April"
+
+                May ->
+                    "May"
+
+                Jun ->
+                    "June"
+
+                Jul ->
+                    "July"
+
+                Aug ->
+                    "August"
+
+                Sep ->
+                    "September"
+
+                Oct ->
+                    "October"
+
+                Nov ->
+                    "November"
+
+                Dec ->
+                    "December"
+
+        day =
+            String.fromInt (Time.toDay zone time)
+
+        year =
+            String.fromInt (Time.toYear zone time)
+    in
+    month ++ " " ++ day ++ ", " ++ year

intro/part6/src/Username.elm

@@ -0,0 +1,47 @@
+module Username exposing (Username, decoder, encode, toHtml, toString, urlParser)
+
+import Html exposing (Html)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Encode as Encode exposing (Value)
+import Url.Parser
+
+
+
+-- TYPES
+
+
+type Username
+    = Username String
+
+
+
+-- CREATE
+
+
+decoder : Decoder Username
+decoder =
+    Decode.map Username Decode.string
+
+
+
+-- TRANSFORM
+
+
+encode : Username -> Value
+encode (Username username) =
+    Encode.string username
+
+
+toString : Username -> String
+toString (Username username) =
+    username
+
+
+urlParser : Url.Parser.Parser (Username -> a) a
+urlParser =
+    Url.Parser.custom "USERNAME" (\str -> Just (Username str))
+
+
+toHtml : Username -> Html msg
+toHtml (Username username) =
+    Html.text username

intro/part6/src/Viewer.elm

@@ -0,0 +1,85 @@
+module Viewer exposing (Viewer, cred, decoder, email, encode, minPasswordChars, profile)
+
+{-| The logged-in user currently viewing this page.
+-}
+
+import Avatar exposing (Avatar)
+import Email exposing (Email)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (custom, required)
+import Json.Encode as Encode exposing (Value)
+import Profile exposing (Profile)
+import Username exposing (Username)
+import Viewer.Cred as Cred exposing (Cred)
+
+
+
+-- TYPES
+
+
+type Viewer
+    = Viewer Internals
+
+
+type alias Internals =
+    { cred : Cred
+    , profile : Profile
+    , email : Email
+    }
+
+
+
+-- INFO
+
+
+cred : Viewer -> Cred
+cred (Viewer info) =
+    info.cred
+
+
+profile : Viewer -> Profile
+profile (Viewer info) =
+    info.profile
+
+
+email : Viewer -> Email
+email (Viewer info) =
+    info.email
+
+
+{-| Passwords must be at least this many characters long!
+-}
+minPasswordChars : Int
+minPasswordChars =
+    6
+
+
+
+-- SERIALIZATION
+
+
+encode : Viewer -> Value
+encode (Viewer info) =
+    Encode.object
+        [ ( "email", Email.encode info.email )
+        , ( "username", Username.encode (Cred.username info.cred) )
+        , ( "image", Avatar.encode (Profile.avatar info.profile) )
+        , ( "token", Cred.encodeToken info.cred )
+        , ( "bio"
+          , case Profile.bio info.profile of
+                Just bio ->
+                    Encode.string bio
+
+                Nothing ->
+                    Encode.null
+          )
+        ]
+
+
+decoder : Decoder Viewer
+decoder =
+    Decode.succeed Internals
+        |> custom Cred.decoder
+        |> custom Profile.decoder
+        |> required "email" Email.decoder
+        |> Decode.map Viewer

intro/part6/src/Viewer/Cred.elm

@@ -0,0 +1,85 @@
+module Viewer.Cred exposing (Cred, addHeader, addHeaderIfAvailable, decoder, encodeToken, username)
+
+{-| The authentication credentials for the Viewer (that is, the currently logged-in user.)
+
+This includes:
+
+  - The cred's Username
+  - The cred's authentication token
+
+By design, there is no way to access the token directly as a String.
+It can be encoded for persistence, and it can be added to a header
+to a HttpBuilder for a request, but that's it.
+
+This token should never be rendered to the end user, and with this API, it
+can't be!
+
+-}
+
+import HttpBuilder exposing (RequestBuilder, withHeader)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (required)
+import Json.Encode as Encode exposing (Value)
+import Username exposing (Username)
+
+
+{-| The authentication token for the currently logged-in user.
+
+The token records the username associated with this token, which you can ask it for.
+
+By design, there is no way to access the token directly as a String. You can encode it for persistence, and you can add it to a header to a HttpBuilder for a request, but that's it.
+
+-}
+
+
+
+-- TYPES
+
+
+type Cred
+    = Cred Username String
+
+
+
+-- INFO
+
+
+username : Cred -> Username
+username (Cred val _) =
+    val
+
+
+
+-- SERIALIZATION
+
+
+decoder : Decoder Cred
+decoder =
+    Decode.succeed Cred
+        |> required "username" Username.decoder
+        |> required "token" Decode.string
+
+
+
+-- TRANSFORM
+
+
+encodeToken : Cred -> Value
+encodeToken (Cred _ str) =
+    Encode.string str
+
+
+addHeader : Cred -> RequestBuilder a -> RequestBuilder a
+addHeader (Cred _ str) builder =
+    builder
+        |> withHeader "authorization" ("Token " ++ str)
+
+
+addHeaderIfAvailable : Maybe Cred -> RequestBuilder a -> RequestBuilder a
+addHeaderIfAvailable maybeCred builder =
+    case maybeCred of
+        Just cred ->
+            addHeader cred builder
+
+        Nothing ->
+            builder