Rename more stuff

intro/part9/src/Data/Article.elm

@@ -0,0 +1,154 @@
+module Data.Article
+    exposing
+        ( Article
+        , Body
+        , Slug
+        , Tag
+        , bodyToHtml
+        , bodyToMarkdownString
+        , decoder
+        , decoderWithBody
+        , slugParser
+        , slugToString
+        , tagDecoder
+        , tagToString
+        )
+
+import Data.Article.Author as Author exposing (Author)
+import Date exposing (Date)
+import Html exposing (Attribute, Html)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Extra
+import Json.Decode.Pipeline exposing (custom, decode, hardcoded, required)
+import Markdown
+import UrlParser
+
+
+{-| An article, optionally with an article body.
+
+To see the difference between { body : body } and { body : 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 Body -> Html msg
+viewFeed : List (Article ()) -> 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 ())` because the API does not return bodies.
+Those articles are useful to the feed, but not to the individual article view.
+
+-}
+type alias Article a =
+    { description : String
+    , slug : Slug
+    , title : String
+    , tags : List String
+    , createdAt : Date
+    , updatedAt : Date
+    , favorited : Bool
+    , favoritesCount : Int
+    , author : Author
+    , body : a
+    }
+
+
+
+-- SERIALIZATION --
+
+
+decoder : Decoder (Article ())
+decoder =
+    baseArticleDecoder
+        |> hardcoded ()
+
+
+decoderWithBody : Decoder (Article Body)
+decoderWithBody =
+    baseArticleDecoder
+        |> required "body" bodyDecoder
+
+
+baseArticleDecoder : Decoder (a -> Article a)
+baseArticleDecoder =
+    decode Article
+        |> required "description" (Decode.map (Maybe.withDefault "") (Decode.nullable Decode.string))
+        |> required "slug" (Decode.map Slug Decode.string)
+        |> required "title" Decode.string
+        |> required "tagList" (Decode.list Decode.string)
+        |> required "createdAt" Json.Decode.Extra.date
+        |> required "updatedAt" Json.Decode.Extra.date
+        |> required "favorited" Decode.bool
+        |> required "favoritesCount" Decode.int
+        |> required "author" Author.decoder
+
+
+
+-- IDENTIFIERS --
+
+
+type Slug
+    = Slug String
+
+
+slugParser : UrlParser.Parser (Slug -> a) a
+slugParser =
+    UrlParser.custom "SLUG" (Ok << Slug)
+
+
+slugToString : Slug -> String
+slugToString (Slug slug) =
+    slug
+
+
+
+-- TAGS --
+
+
+type Tag
+    = Tag String
+
+
+tagToString : Tag -> String
+tagToString (Tag slug) =
+    slug
+
+
+tagDecoder : Decoder Tag
+tagDecoder =
+    Decode.map Tag Decode.string
+
+
+
+-- BODY --
+
+
+type Body
+    = Body Markdown
+
+
+type alias Markdown =
+    String
+
+
+bodyToHtml : Body -> List (Attribute msg) -> Html msg
+bodyToHtml (Body markdown) attributes =
+    Markdown.toHtml attributes markdown
+
+
+bodyToMarkdownString : Body -> String
+bodyToMarkdownString (Body markdown) =
+    markdown
+
+
+bodyDecoder : Decoder Body
+bodyDecoder =
+    Decode.map Body Decode.string

intro/part9/src/Data/Article/Author.elm

@@ -0,0 +1,23 @@
+module Data.Article.Author exposing (Author, decoder)
+
+import Data.User as User exposing (Username)
+import Data.UserPhoto as UserPhoto exposing (UserPhoto)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (custom, decode, optional, required)
+
+
+decoder : Decoder Author
+decoder =
+    decode Author
+        |> required "username" User.usernameDecoder
+        |> required "bio" (Decode.nullable Decode.string)
+        |> required "image" UserPhoto.decoder
+        |> optional "following" Decode.bool False
+
+
+type alias Author =
+    { username : Username
+    , bio : Maybe String
+    , image : UserPhoto
+    , following : Bool
+    }

intro/part9/src/Data/Article/Comment.elm

@@ -0,0 +1,48 @@
+module Data.Article.Comment exposing (Comment, CommentId, commentIdDecoder, decoder, idToString)
+
+import Data.Article.Author as Author exposing (Author)
+import Date exposing (Date)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Extra
+import Json.Decode.Pipeline exposing (custom, decode, required)
+
+
+type alias Comment =
+    { id : CommentId
+    , body : String
+    , createdAt : Date
+    , updatedAt : Date
+    , author : Author
+    }
+
+
+
+-- SERIALIZATION --
+
+
+decoder : Decoder Comment
+decoder =
+    decode Comment
+        |> required "id" commentIdDecoder
+        |> required "body" Decode.string
+        |> required "createdAt" Json.Decode.Extra.date
+        |> required "updatedAt" Json.Decode.Extra.date
+        |> required "author" Author.decoder
+
+
+
+-- IDENTIFIERS --
+
+
+type CommentId
+    = CommentId Int
+
+
+idToString : CommentId -> String
+idToString (CommentId id) =
+    toString id
+
+
+commentIdDecoder : Decoder CommentId
+commentIdDecoder =
+    Decode.map CommentId Decode.int

intro/part9/src/Data/Article/Feed.elm

@@ -0,0 +1,22 @@
+module Data.Article.Feed exposing (Feed, decoder)
+
+import Data.Article as Article exposing (Article)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (decode, required)
+
+
+type alias Feed =
+    { articles : List (Article ())
+    , articlesCount : Int
+    }
+
+
+
+-- SERIALIZATION --
+
+
+decoder : Decoder Feed
+decoder =
+    decode Feed
+        |> required "articles" (Decode.list Article.decoder)
+        |> required "articlesCount" Decode.int

intro/part9/src/Data/AuthToken.elm

@@ -0,0 +1,31 @@
+module Data.AuthToken exposing (AuthToken, decoder, encode, withAuthorization)
+
+import HttpBuilder exposing (RequestBuilder, withHeader)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Encode as Encode exposing (Value)
+
+
+type AuthToken
+    = AuthToken String
+
+
+encode : AuthToken -> Value
+encode (AuthToken token) =
+    Encode.string token
+
+
+decoder : Decoder AuthToken
+decoder =
+    Decode.string
+        |> Decode.map AuthToken
+
+
+withAuthorization : Maybe AuthToken -> RequestBuilder a -> RequestBuilder a
+withAuthorization maybeToken builder =
+    case maybeToken of
+        Just (AuthToken token) ->
+            builder
+                |> withHeader "authorization" ("Token " ++ token)
+
+        Nothing ->
+            builder

intro/part9/src/Data/Profile.elm

@@ -0,0 +1,23 @@
+module Data.Profile exposing (Profile, decoder)
+
+import Data.User as User exposing (Username)
+import Data.UserPhoto as UserPhoto exposing (UserPhoto)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (decode, required)
+
+
+type alias Profile =
+    { username : Username
+    , bio : Maybe String
+    , image : UserPhoto
+    , following : Bool
+    }
+
+
+decoder : Decoder Profile
+decoder =
+    decode Profile
+        |> required "username" User.usernameDecoder
+        |> required "bio" (Decode.nullable Decode.string)
+        |> required "image" UserPhoto.decoder
+        |> required "following" Decode.bool

intro/part9/src/Data/Session.elm

@@ -0,0 +1,18 @@
+module Data.Session exposing (Session, attempt)
+
+import Data.AuthToken exposing (AuthToken)
+import Data.User exposing (User)
+
+
+type alias Session =
+    { user : Maybe User }
+
+
+attempt : String -> (AuthToken -> Cmd msg) -> Session -> ( List String, Cmd msg )
+attempt attemptedAction toCmd session =
+    case Maybe.map .token session.user of
+        Nothing ->
+            ( [ "You have been signed out. Please sign back in to " ++ attemptedAction ++ "." ], Cmd.none )
+
+        Just token ->
+            ( [], toCmd token )

intro/part9/src/Data/User.elm

@@ -0,0 +1,77 @@
+module Data.User exposing (User, Username, decoder, encode, usernameDecoder, usernameParser, usernameToHtml, usernameToString)
+
+import Data.AuthToken as AuthToken exposing (AuthToken)
+import Data.UserPhoto as UserPhoto exposing (UserPhoto)
+import Html exposing (Html)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (decode, optional, required)
+import Json.Encode as Encode exposing (Value)
+import Json.Encode.Extra as EncodeExtra
+import UrlParser
+
+
+type alias User =
+    { email : String
+    , token : AuthToken
+    , username : Username
+    , bio : Maybe String
+    , image : UserPhoto
+    }
+
+
+
+-- SERIALIZATION --
+
+
+decoder : Decoder User
+decoder =
+    decode User
+        |> required "email" Decode.string
+        |> required "token" AuthToken.decoder
+        |> required "username" usernameDecoder
+        |> required "bio" (Decode.nullable Decode.string)
+        |> required "image" UserPhoto.decoder
+
+
+encode : User -> Value
+encode user =
+    Encode.object
+        [ ( "email", Encode.string user.email )
+        , ( "token", AuthToken.encode user.token )
+        , ( "username", encodeUsername user.username )
+        , ( "bio", EncodeExtra.maybe Encode.string user.bio )
+        , ( "image", UserPhoto.encode user.image )
+        ]
+
+
+
+-- IDENTIFIERS --
+
+
+type Username
+    = Username String
+
+
+usernameToString : Username -> String
+usernameToString (Username username) =
+    username
+
+
+usernameParser : UrlParser.Parser (Username -> a) a
+usernameParser =
+    UrlParser.custom "USERNAME" (Ok << Username)
+
+
+usernameDecoder : Decoder Username
+usernameDecoder =
+    Decode.map Username Decode.string
+
+
+encodeUsername : Username -> Value
+encodeUsername (Username username) =
+    Encode.string username
+
+
+usernameToHtml : Username -> Html msg
+usernameToHtml (Username username) =
+    Html.text username

intro/part9/src/Data/UserPhoto.elm

@@ -0,0 +1,53 @@
+module Data.UserPhoto exposing (UserPhoto, decoder, encode, src, toMaybeString)
+
+import Html exposing (Attribute)
+import Html.Attributes
+import Json.Decode as Decode exposing (Decoder)
+import Json.Encode as Encode exposing (Value)
+import Json.Encode.Extra as EncodeExtra
+
+
+type UserPhoto
+    = UserPhoto (Maybe String)
+
+
+src : UserPhoto -> Attribute msg
+src =
+    photoToUrl >> Html.Attributes.src
+
+
+decoder : Decoder UserPhoto
+decoder =
+    Decode.map UserPhoto (Decode.nullable Decode.string)
+
+
+encode : UserPhoto -> Value
+encode (UserPhoto maybeUrl) =
+    EncodeExtra.maybe Encode.string maybeUrl
+
+
+toMaybeString : UserPhoto -> Maybe String
+toMaybeString (UserPhoto maybeUrl) =
+    maybeUrl
+
+
+
+-- INTERNAL --
+
+
+photoToUrl : UserPhoto -> String
+photoToUrl (UserPhoto maybeUrl) =
+    case maybeUrl of
+        Nothing ->
+            defaultPhotoUrl
+
+        Just "" ->
+            defaultPhotoUrl
+
+        Just url ->
+            url
+
+
+defaultPhotoUrl : String
+defaultPhotoUrl =
+    "/assets/images/smiley-cyrus.jpg"

intro/part9/src/Main.elm

@@ -0,0 +1,476 @@
+module Main exposing (main)
+
+import Data.Article exposing (Slug)
+import Data.Session exposing (Session)
+import Data.User as User exposing (User, Username)
+import Html exposing (..)
+import Json.Decode as Decode exposing (Value)
+import Navigation exposing (Location)
+import Page.Article as Article
+import Page.Article.Editor as Editor
+import Page.Errored as Errored exposing (PageLoadError)
+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 Ports
+import Route exposing (Route)
+import Task
+import Views.Page as Page exposing (ActivePage)
+
+
+-- 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 Page
+    = Blank
+    | NotFound
+    | Errored PageLoadError
+    | Home Home.Model
+    | Settings Settings.Model
+    | Login Login.Model
+    | Register Register.Model
+    | Profile Username Profile.Model
+    | Article Article.Model
+    | Editor (Maybe Slug) Editor.Model
+
+
+type PageState
+    = Loaded Page
+    | TransitioningFrom Page
+
+
+
+-- MODEL --
+
+
+type alias Model =
+    { session : Session
+    , pageState : PageState
+    }
+
+
+init : Value -> Location -> ( Model, Cmd Msg )
+init val location =
+    setRoute (Route.fromLocation location)
+        { pageState = Loaded initialPage
+        , session = { user = decodeUserFromJson val }
+        }
+
+
+decodeUserFromJson : Value -> Maybe User
+decodeUserFromJson json =
+    json
+        |> Decode.decodeValue Decode.string
+        |> Result.toMaybe
+        |> Maybe.andThen (Decode.decodeString User.decoder >> Result.toMaybe)
+
+
+initialPage : Page
+initialPage =
+    Blank
+
+
+
+-- VIEW --
+
+
+view : Model -> Html Msg
+view model =
+    case model.pageState of
+        Loaded page ->
+            viewPage model.session False page
+
+        TransitioningFrom page ->
+            viewPage model.session True page
+
+
+viewPage : Session -> Bool -> Page -> Html Msg
+viewPage session isLoading page =
+    let
+        frame =
+            Page.frame isLoading session.user
+    in
+    case page of
+        NotFound ->
+            NotFound.view session
+                |> frame Page.Other
+
+        Blank ->
+            -- This is for the very initial page load, while we are loading
+            -- data via HTTP. We could also render a spinner here.
+            Html.text ""
+                |> frame Page.Other
+
+        Errored subModel ->
+            Errored.view session subModel
+                |> frame Page.Other
+
+        Settings subModel ->
+            Settings.view session subModel
+                |> frame Page.Other
+                |> Html.map SettingsMsg
+
+        Home subModel ->
+            Home.view session subModel
+                |> frame Page.Home
+                |> Html.map HomeMsg
+
+        Login subModel ->
+            Login.view session subModel
+                |> frame Page.Other
+                |> Html.map LoginMsg
+
+        Register subModel ->
+            Register.view session subModel
+                |> frame Page.Other
+                |> Html.map RegisterMsg
+
+        Profile username subModel ->
+            Profile.view session subModel
+                |> frame (Page.Profile username)
+                |> Html.map ProfileMsg
+
+        Article subModel ->
+            Article.view session subModel
+                |> frame Page.Other
+                |> Html.map ArticleMsg
+
+        Editor maybeSlug subModel ->
+            let
+                framePage =
+                    if maybeSlug == Nothing then
+                        Page.NewArticle
+                    else
+                        Page.Other
+            in
+            Editor.view subModel
+                |> frame framePage
+                |> Html.map EditorMsg
+
+
+
+-- SUBSCRIPTIONS --
+-- Note: we aren't currently doing any page subscriptions, but I thought it would
+-- be a good idea to put this in here as an example. If I were actually
+-- maintaining this in production, I wouldn't bother until I needed this!
+
+
+subscriptions : Model -> Sub Msg
+subscriptions model =
+    Sub.batch
+        [ pageSubscriptions (getPage model.pageState)
+        , Sub.map SetUser sessionChange
+        ]
+
+
+sessionChange : Sub (Maybe User)
+sessionChange =
+    Ports.onSessionChange (Decode.decodeValue User.decoder >> Result.toMaybe)
+
+
+getPage : PageState -> Page
+getPage pageState =
+    case pageState of
+        Loaded page ->
+            page
+
+        TransitioningFrom page ->
+            page
+
+
+pageSubscriptions : Page -> Sub Msg
+pageSubscriptions page =
+    case page of
+        Blank ->
+            Sub.none
+
+        Errored _ ->
+            Sub.none
+
+        NotFound ->
+            Sub.none
+
+        Settings _ ->
+            Sub.none
+
+        Home _ ->
+            Sub.none
+
+        Login _ ->
+            Sub.none
+
+        Register _ ->
+            Sub.none
+
+        Profile _ _ ->
+            Sub.none
+
+        Article _ ->
+            Sub.none
+
+        Editor _ _ ->
+            Sub.none
+
+
+
+-- UPDATE --
+
+
+type Msg
+    = SetRoute (Maybe Route)
+    | HomeLoaded (Result PageLoadError Home.Model)
+    | ArticleLoaded (Result PageLoadError Article.Model)
+    | ProfileLoaded Username (Result PageLoadError Profile.Model)
+    | EditArticleLoaded Slug (Result PageLoadError Editor.Model)
+    | HomeMsg Home.Msg
+    | SettingsMsg Settings.Msg
+    | SetUser (Maybe User)
+    | LoginMsg Login.Msg
+    | RegisterMsg Register.Msg
+    | ProfileMsg Profile.Msg
+    | ArticleMsg Article.Msg
+    | EditorMsg Editor.Msg
+
+
+setRoute : Maybe Route -> Model -> ( Model, Cmd Msg )
+setRoute maybeRoute model =
+    let
+        transition toMsg task =
+            ( { model | pageState = TransitioningFrom (getPage model.pageState) }
+            , Task.attempt toMsg task
+            )
+
+        errored =
+            pageErrored model
+    in
+    case maybeRoute of
+        Nothing ->
+            ( { model | pageState = Loaded NotFound }, Cmd.none )
+
+        Just Route.NewArticle ->
+            case model.session.user of
+                Just user ->
+                    ( { model | pageState = Loaded (Editor Nothing Editor.initNew) }, Cmd.none )
+
+                Nothing ->
+                    errored Page.NewArticle "You must be signed in to post an article."
+
+        Just (Route.EditArticle slug) ->
+            case model.session.user of
+                Just user ->
+                    transition (EditArticleLoaded slug) (Editor.initEdit model.session slug)
+
+                Nothing ->
+                    errored Page.Other "You must be signed in to edit an article."
+
+        Just Route.Settings ->
+            case model.session.user of
+                Just user ->
+                    ( { model | pageState = Loaded (Settings (Settings.init user)) }, Cmd.none )
+
+                Nothing ->
+                    errored Page.Settings "You must be signed in to access your settings."
+
+        Just Route.Home ->
+            transition HomeLoaded (Home.init model.session)
+
+        Just Route.Root ->
+            ( model, Route.modifyUrl Route.Home )
+
+        Just Route.Login ->
+            ( { model | pageState = Loaded (Login Login.initialModel) }, Cmd.none )
+
+        Just Route.Logout ->
+            let
+                session =
+                    model.session
+            in
+            ( { model | session = { session | user = Nothing } }
+            , Cmd.batch
+                [ Ports.storeSession Nothing
+                , Route.modifyUrl Route.Home
+                ]
+            )
+
+        Just Route.Register ->
+            ( { model | pageState = Loaded (Register Register.initialModel) }, Cmd.none )
+
+        Just (Route.Profile username) ->
+            transition (ProfileLoaded username) (Profile.init model.session username)
+
+        Just (Route.Article slug) ->
+            transition ArticleLoaded (Article.init model.session slug)
+
+
+pageErrored : Model -> ActivePage -> String -> ( Model, Cmd msg )
+pageErrored model activePage errorMessage =
+    let
+        error =
+            Errored.pageLoadError activePage errorMessage
+    in
+    ( { model | pageState = Loaded (Errored error) }, Cmd.none )
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    updatePage (getPage model.pageState) msg model
+
+
+updatePage : Page -> Msg -> Model -> ( Model, Cmd Msg )
+updatePage page msg model =
+    let
+        session =
+            model.session
+
+        toPage toModel toMsg subUpdate subMsg subModel =
+            let
+                ( newModel, newCmd ) =
+                    subUpdate subMsg subModel
+            in
+            ( { model | pageState = Loaded (toModel newModel) }, Cmd.map toMsg newCmd )
+
+        errored =
+            pageErrored model
+    in
+    case ( msg, page ) of
+        ( SetRoute route, _ ) ->
+            setRoute route model
+
+        ( HomeLoaded (Ok subModel), _ ) ->
+            ( { model | pageState = Loaded (Home subModel) }, Cmd.none )
+
+        ( HomeLoaded (Err error), _ ) ->
+            ( { model | pageState = Loaded (Errored error) }, Cmd.none )
+
+        ( ProfileLoaded username (Ok subModel), _ ) ->
+            ( { model | pageState = Loaded (Profile username subModel) }, Cmd.none )
+
+        ( ProfileLoaded username (Err error), _ ) ->
+            ( { model | pageState = Loaded (Errored error) }, Cmd.none )
+
+        ( ArticleLoaded (Ok subModel), _ ) ->
+            ( { model | pageState = Loaded (Article subModel) }, Cmd.none )
+
+        ( ArticleLoaded (Err error), _ ) ->
+            ( { model | pageState = Loaded (Errored error) }, Cmd.none )
+
+        ( EditArticleLoaded slug (Ok subModel), _ ) ->
+            ( { model | pageState = Loaded (Editor (Just slug) subModel) }, Cmd.none )
+
+        ( EditArticleLoaded slug (Err error), _ ) ->
+            ( { model | pageState = Loaded (Errored error) }, Cmd.none )
+
+        ( SetUser user, _ ) ->
+            let
+                cmd =
+                    -- If we just signed out, then redirect to Home.
+                    if session.user /= Nothing && user == Nothing then
+                        Route.modifyUrl Route.Home
+                    else
+                        Cmd.none
+            in
+            ( { model | session = { session | user = user } }
+            , cmd
+            )
+
+        ( SettingsMsg subMsg, Settings subModel ) ->
+            let
+                ( ( pageModel, cmd ), msgFromPage ) =
+                    Settings.update model.session subMsg subModel
+
+                newModel =
+                    case msgFromPage of
+                        Settings.NoOp ->
+                            model
+
+                        Settings.SetUser user ->
+                            { model | session = { user = Just user } }
+            in
+            ( { newModel | pageState = Loaded (Settings pageModel) }
+            , Cmd.map SettingsMsg cmd
+            )
+
+        ( LoginMsg subMsg, Login subModel ) ->
+            let
+                ( ( pageModel, cmd ), msgFromPage ) =
+                    Login.update subMsg subModel
+
+                newModel =
+                    case msgFromPage of
+                        Login.NoOp ->
+                            model
+
+                        Login.SetUser user ->
+                            { model | session = { user = Just user } }
+            in
+            ( { newModel | pageState = Loaded (Login pageModel) }
+            , Cmd.map LoginMsg cmd
+            )
+
+        ( RegisterMsg subMsg, Register subModel ) ->
+            let
+                ( ( pageModel, cmd ), msgFromPage ) =
+                    Register.update subMsg subModel
+
+                newModel =
+                    case msgFromPage of
+                        Register.NoOp ->
+                            model
+
+                        Register.SetUser user ->
+                            { model | session = { user = Just user } }
+            in
+            ( { newModel | pageState = Loaded (Register pageModel) }
+            , Cmd.map RegisterMsg cmd
+            )
+
+        ( HomeMsg subMsg, Home subModel ) ->
+            toPage Home HomeMsg (Home.update session) subMsg subModel
+
+        ( ProfileMsg subMsg, Profile username subModel ) ->
+            toPage (Profile username) ProfileMsg (Profile.update model.session) subMsg subModel
+
+        ( ArticleMsg subMsg, Article subModel ) ->
+            toPage Article ArticleMsg (Article.update model.session) subMsg subModel
+
+        ( EditorMsg subMsg, Editor slug subModel ) ->
+            case model.session.user of
+                Nothing ->
+                    if slug == Nothing then
+                        errored Page.NewArticle
+                            "You must be signed in to post articles."
+                    else
+                        errored Page.Other
+                            "You must be signed in to edit articles."
+
+                Just user ->
+                    toPage (Editor slug) EditorMsg (Editor.update user) subMsg subModel
+
+        ( _, NotFound ) ->
+            -- Disregard incoming messages when we're on the
+            -- NotFound page.
+            ( model, Cmd.none )
+
+        ( _, _ ) ->
+            -- Disregard incoming messages that arrived for the wrong page
+            ( model, Cmd.none )
+
+
+
+-- MAIN --
+
+
+main : Program Value Model Msg
+main =
+    Navigation.programWithFlags (Route.fromLocation >> SetRoute)
+        { init = init
+        , view = view
+        , update = update
+        , subscriptions = subscriptions
+        }

intro/part9/src/Page/Article.elm

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

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

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

intro/part9/src/Page/Errored.elm

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

intro/part9/src/Page/Home.elm

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

intro/part9/src/Page/Login.elm

@@ -0,0 +1,214 @@
+module Page.Login exposing (ExternalMsg(..), Model, Msg, initialModel, update, view)
+
+{-| The login page.
+-}
+
+import Data.Session exposing (Session)
+import Data.User exposing (User)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Http
+import Json.Decode as Decode exposing (Decoder, decodeString, field, string)
+import Json.Decode.Pipeline exposing (decode, optional)
+import Request.User exposing (storeSession)
+import Route exposing (Route)
+import Validate exposing (Validator, ifBlank, validate)
+import Views.Form as Form
+
+
+-- MODEL --
+
+
+type alias Model =
+    { errors : List Error
+    , email : String
+    , password : String
+    }
+
+
+initialModel : Model
+initialModel =
+    { errors = []
+    , email = ""
+    , password = ""
+    }
+
+
+
+-- VIEW --
+
+
+view : Session -> Model -> Html Msg
+view session model =
+    div [ class "auth-page" ]
+        [ div [ class "container page" ]
+            [ div [ class "row" ]
+                [ div [ class "col-md-6 offset-md-3 col-xs-12" ]
+                    [ h1 [ class "text-xs-center" ] [ text "Sign in" ]
+                    , p [ class "text-xs-center" ]
+                        [ a [ Route.href Route.Register ]
+                            [ text "Need an account?" ]
+                        ]
+                    , Form.viewErrors model.errors
+                    , viewForm
+                    ]
+                ]
+            ]
+        ]
+
+
+viewForm : Html Msg
+viewForm =
+    Html.form [ onSubmit SubmitForm ]
+        [ Form.input
+            [ class "form-control-lg"
+            , placeholder "Email"
+            , onInput SetEmail
+            ]
+            []
+        , Form.password
+            [ class "form-control-lg"
+            , placeholder "Password"
+            , onInput SetPassword
+            ]
+            []
+        , button [ class "btn btn-lg btn-primary pull-xs-right" ]
+            [ text "Sign in" ]
+        ]
+
+
+
+-- UPDATE --
+
+
+type Msg
+    = SubmitForm
+    | SetEmail String
+    | SetPassword String
+    | LoginCompleted (Result Http.Error User)
+
+
+type ExternalMsg
+    = NoOp
+    | SetUser User
+
+
+update : Msg -> Model -> ( ( Model, Cmd Msg ), ExternalMsg )
+update msg model =
+    case msg of
+        SubmitForm ->
+            case validate modelValidator model of
+                [] ->
+                    ( ( { model | errors = [] }
+                      , Http.send LoginCompleted (Request.User.login model)
+                      )
+                    , NoOp
+                    )
+
+                errors ->
+                    ( ( { model | errors = errors }
+                      , Cmd.none
+                      )
+                    , NoOp
+                    )
+
+        SetEmail email ->
+            ( ( { model | email = email }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        SetPassword password ->
+            ( ( { model | password = password }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        LoginCompleted (Err error) ->
+            let
+                errorMessages =
+                    case error of
+                        Http.BadStatus response ->
+                            response.body
+                                |> decodeString (field "errors" errorsDecoder)
+                                |> Result.withDefault []
+
+                        _ ->
+                            [ "unable to perform login" ]
+            in
+            ( ( { model | errors = List.map (\errorMessage -> ( Form, errorMessage )) errorMessages }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        LoginCompleted (Ok user) ->
+            ( ( model
+              , Cmd.batch [ storeSession user, Route.modifyUrl Route.Home ]
+              )
+            , SetUser user
+            )
+
+
+
+-- VALIDATION --
+
+
+type Field
+    = Form
+    | Email
+    | Password
+
+
+{-| Recording validation errors on a per-field basis facilitates displaying
+them inline next to the field where the error occurred.
+
+I implemented it this way out of habit, then realized the spec called for
+displaying all the errors at the top. I thought about simplifying it, but then
+figured it'd be useful to show how I would normally model this data - assuming
+the intended UX was to render errors per field.
+
+(The other part of this is having a view function like this:
+
+viewFormErrors : Field -> List Error -> Html msg
+
+...and it filters the list of errors to render only the ones for the given
+Field. This way you can call this:
+
+viewFormErrors Email model.errors
+
+...next to the `email` field, and call `viewFormErrors Password model.errors`
+next to the `password` field, and so on.
+
+-}
+type alias Error =
+    ( Field, String )
+
+
+modelValidator : Validator Error Model
+modelValidator =
+    Validate.all
+        [ ifBlank .email ( Email, "email can't be blank." )
+        , ifBlank .password ( Password, "password can't be blank." )
+        ]
+
+
+errorsDecoder : Decoder (List String)
+errorsDecoder =
+    decode (\emailOrPassword email username password -> List.concat [ emailOrPassword, email, username, password ])
+        |> optionalError "email or password"
+        |> optionalError "email"
+        |> optionalError "username"
+        |> optionalError "password"
+
+
+optionalError : String -> Decoder (List String -> a) -> Decoder a
+optionalError fieldName =
+    let
+        errorToString errorMessage =
+            String.join " " [ fieldName, errorMessage ]
+    in
+    optional fieldName (Decode.list (Decode.map errorToString string)) []

intro/part9/src/Page/NotFound.elm

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

intro/part9/src/Page/Profile.elm

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

intro/part9/src/Page/Register.elm

@@ -0,0 +1,220 @@
+module Page.Register exposing (ExternalMsg(..), Model, Msg, initialModel, update, view)
+
+import Data.Session exposing (Session)
+import Data.User exposing (User)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Http
+import Json.Decode as Decode exposing (Decoder, decodeString, field, string)
+import Json.Decode.Pipeline exposing (decode, optional)
+import Request.User exposing (storeSession)
+import Route exposing (Route)
+import Validate exposing (Validator, ifBlank, validate)
+import Views.Form as Form
+
+
+-- MODEL --
+
+
+type alias Model =
+    { errors : List Error
+    , email : String
+    , username : String
+    , password : String
+    }
+
+
+initialModel : Model
+initialModel =
+    { errors = []
+    , email = ""
+    , username = ""
+    , password = ""
+    }
+
+
+
+-- VIEW --
+
+
+view : Session -> Model -> Html Msg
+view session model =
+    div [ class "auth-page" ]
+        [ div [ class "container page" ]
+            [ div [ class "row" ]
+                [ div [ class "col-md-6 offset-md-3 col-xs-12" ]
+                    [ h1 [ class "text-xs-center" ] [ text "Sign up" ]
+                    , p [ class "text-xs-center" ]
+                        [ a [ Route.href Route.Login ]
+                            [ text "Have an account?" ]
+                        ]
+                    , Form.viewErrors model.errors
+                    , viewForm
+                    ]
+                ]
+            ]
+        ]
+
+
+viewForm : Html Msg
+viewForm =
+    Html.form [ onSubmit SubmitForm ]
+        [ Form.input
+            [ class "form-control-lg"
+            , placeholder "Username"
+            , onInput SetUsername
+            ]
+            []
+        , Form.input
+            [ class "form-control-lg"
+            , placeholder "Email"
+            , onInput SetEmail
+            ]
+            []
+        , Form.password
+            [ class "form-control-lg"
+            , placeholder "Password"
+            , onInput SetPassword
+            ]
+            []
+        , button [ class "btn btn-lg btn-primary pull-xs-right" ]
+            [ text "Sign up" ]
+        ]
+
+
+
+-- UPDATE --
+
+
+type Msg
+    = SubmitForm
+    | SetEmail String
+    | SetUsername String
+    | SetPassword String
+    | RegisterCompleted (Result Http.Error User)
+
+
+type ExternalMsg
+    = NoOp
+    | SetUser User
+
+
+update : Msg -> Model -> ( ( Model, Cmd Msg ), ExternalMsg )
+update msg model =
+    case msg of
+        SubmitForm ->
+            case validate modelValidator model of
+                [] ->
+                    ( ( { model | errors = [] }
+                      , Http.send RegisterCompleted (Request.User.register model)
+                      )
+                    , NoOp
+                    )
+
+                errors ->
+                    ( ( { model | errors = errors }
+                      , Cmd.none
+                      )
+                    , NoOp
+                    )
+
+        SetEmail email ->
+            ( ( { model | email = email }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        SetUsername username ->
+            ( ( { model | username = username }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        SetPassword password ->
+            ( ( { model | password = password }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        RegisterCompleted (Err error) ->
+            let
+                errorMessages =
+                    case error of
+                        Http.BadStatus response ->
+                            response.body
+                                |> decodeString (field "errors" errorsDecoder)
+                                |> Result.withDefault []
+
+                        _ ->
+                            [ "unable to process registration" ]
+            in
+            ( ( { model | errors = List.map (\errorMessage -> ( Form, errorMessage )) errorMessages }
+              , Cmd.none
+              )
+            , NoOp
+            )
+
+        RegisterCompleted (Ok user) ->
+            ( ( model
+              , Cmd.batch [ storeSession user, Route.modifyUrl Route.Home ]
+              )
+            , SetUser user
+            )
+
+
+
+-- VALIDATION --
+
+
+type Field
+    = Form
+    | Username
+    | Email
+    | Password
+
+
+type alias Error =
+    ( Field, String )
+
+
+modelValidator : Validator Error Model
+modelValidator =
+    Validate.all
+        [ ifBlank .username ( Username, "username can't be blank." )
+        , ifBlank .email ( Email, "email can't be blank." )
+        , Validate.fromErrors passwordLength
+        ]
+
+
+minPasswordChars : Int
+minPasswordChars =
+    6
+
+
+passwordLength : Model -> List Error
+passwordLength { password } =
+    if String.length password < minPasswordChars then
+        [ ( Password, "password must be at least " ++ toString minPasswordChars ++ " characters long." ) ]
+    else
+        []
+
+
+errorsDecoder : Decoder (List String)
+errorsDecoder =
+    decode (\email username password -> List.concat [ email, username, password ])
+        |> optionalError "email"
+        |> optionalError "username"
+        |> optionalError "password"
+
+
+optionalError : String -> Decoder (List String -> a) -> Decoder a
+optionalError fieldName =
+    let
+        errorToString errorMessage =
+            String.join " " [ fieldName, errorMessage ]
+    in
+    optional fieldName (Decode.list (Decode.map errorToString string)) []

intro/part9/src/Page/Settings.elm

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

intro/part9/src/Ports.elm

@@ -0,0 +1,19 @@
+port module Ports exposing (..)
+
+import Json.Encode exposing (Value)
+
+
+{- TODO This port is defined wrong!
+
+   See the compiler error to figure out what it should be.
+-}
+
+
+port storeBlah : String -> Cmd msg
+
+
+
+{- TODO Add another port here.
+
+   See the compiler error to figure out what it should be.
+-}

intro/part9/src/Request/Article.elm

@@ -0,0 +1,271 @@
+module Request.Article
+    exposing
+        ( FeedConfig
+        , ListConfig
+        , create
+        , defaultFeedConfig
+        , defaultListConfig
+        , delete
+        , feed
+        , get
+        , list
+        , tags
+        , toggleFavorite
+        , update
+        )
+
+import Data.Article as Article exposing (Article, Body, Tag, slugToString)
+import Data.Article.Feed as Feed exposing (Feed)
+import Data.AuthToken exposing (AuthToken, withAuthorization)
+import Data.User as User exposing (Username)
+import Http
+import HttpBuilder exposing (RequestBuilder, withBody, withExpect, withQueryParams)
+import Json.Decode as Decode
+import Json.Encode as Encode
+import Request.Helpers exposing (apiUrl)
+
+
+-- SINGLE --
+
+
+get : Maybe AuthToken -> Article.Slug -> Http.Request (Article Body)
+get maybeToken slug =
+    let
+        expect =
+            Article.decoderWithBody
+                |> Decode.field "article"
+                |> Http.expectJson
+    in
+    apiUrl ("/articles/" ++ Article.slugToString slug)
+        |> HttpBuilder.get
+        |> HttpBuilder.withExpect expect
+        |> withAuthorization maybeToken
+        |> HttpBuilder.toRequest
+
+
+
+-- LIST --
+
+
+type alias ListConfig =
+    { tag : Maybe Tag
+    , author : Maybe Username
+    , favorited : Maybe Username
+    , limit : Int
+    , offset : Int
+    }
+
+
+defaultListConfig : ListConfig
+defaultListConfig =
+    { tag = Nothing
+    , author = Nothing
+    , favorited = Nothing
+    , limit = 20
+    , offset = 0
+    }
+
+
+list : ListConfig -> Maybe AuthToken -> Http.Request Feed
+list config maybeToken =
+    [ ( "tag", Maybe.map Article.tagToString config.tag )
+    , ( "author", Maybe.map User.usernameToString config.author )
+    , ( "favorited", Maybe.map User.usernameToString config.favorited )
+    , ( "limit", Just (toString config.limit) )
+    , ( "offset", Just (toString config.offset) )
+    ]
+        |> List.filterMap maybeVal
+        |> buildFromQueryParams "/articles"
+        |> withAuthorization maybeToken
+        |> HttpBuilder.toRequest
+
+
+
+-- FEED --
+
+
+type alias FeedConfig =
+    { limit : Int
+    , offset : Int
+    }
+
+
+defaultFeedConfig : FeedConfig
+defaultFeedConfig =
+    { limit = 10
+    , offset = 0
+    }
+
+
+feed : FeedConfig -> AuthToken -> Http.Request Feed
+feed config token =
+    [ ( "limit", Just (toString config.limit) )
+    , ( "offset", Just (toString config.offset) )
+    ]
+        |> List.filterMap maybeVal
+        |> buildFromQueryParams "/articles/feed"
+        |> withAuthorization (Just token)
+        |> HttpBuilder.toRequest
+
+
+
+-- TAGS --
+
+
+tags : Http.Request (List Tag)
+tags =
+    Decode.field "tags" (Decode.list Article.tagDecoder)
+        |> Http.get (apiUrl "/tags")
+
+
+
+-- FAVORITE --
+
+
+toggleFavorite : Article a -> AuthToken -> Http.Request (Article ())
+toggleFavorite article authToken =
+    if article.favorited then
+        unfavorite article.slug authToken
+    else
+        favorite article.slug authToken
+
+
+favorite : Article.Slug -> AuthToken -> Http.Request (Article ())
+favorite =
+    buildFavorite HttpBuilder.post
+
+
+unfavorite : Article.Slug -> AuthToken -> Http.Request (Article ())
+unfavorite =
+    buildFavorite HttpBuilder.delete
+
+
+buildFavorite :
+    (String -> RequestBuilder a)
+    -> Article.Slug
+    -> AuthToken
+    -> Http.Request (Article ())
+buildFavorite builderFromUrl slug token =
+    let
+        expect =
+            Article.decoder
+                |> Decode.field "article"
+                |> Http.expectJson
+    in
+    [ apiUrl "/articles", slugToString slug, "favorite" ]
+        |> String.join "/"
+        |> builderFromUrl
+        |> withAuthorization (Just token)
+        |> withExpect expect
+        |> HttpBuilder.toRequest
+
+
+
+-- CREATE --
+
+
+type alias CreateConfig record =
+    { record
+        | title : String
+        , description : String
+        , body : String
+        , tags : List String
+    }
+
+
+type alias EditConfig record =
+    { record
+        | title : String
+        , description : String
+        , body : String
+    }
+
+
+create : CreateConfig record -> AuthToken -> Http.Request (Article Body)
+create config token =
+    let
+        expect =
+            Article.decoderWithBody
+                |> Decode.field "article"
+                |> Http.expectJson
+
+        article =
+            Encode.object
+                [ ( "title", Encode.string config.title )
+                , ( "description", Encode.string config.description )
+                , ( "body", Encode.string config.body )
+                , ( "tagList", Encode.list (List.map Encode.string config.tags) )
+                ]
+
+        body =
+            Encode.object [ ( "article", article ) ]
+                |> Http.jsonBody
+    in
+    apiUrl "/articles"
+        |> HttpBuilder.post
+        |> withAuthorization (Just token)
+        |> withBody body
+        |> withExpect expect
+        |> HttpBuilder.toRequest
+
+
+update : Article.Slug -> EditConfig record -> AuthToken -> Http.Request (Article Body)
+update slug config token =
+    let
+        expect =
+            Article.decoderWithBody
+                |> Decode.field "article"
+                |> Http.expectJson
+
+        article =
+            Encode.object
+                [ ( "title", Encode.string config.title )
+                , ( "description", Encode.string config.description )
+                , ( "body", Encode.string config.body )
+                ]
+
+        body =
+            Encode.object [ ( "article", article ) ]
+                |> Http.jsonBody
+    in
+    apiUrl ("/articles/" ++ slugToString slug)
+        |> HttpBuilder.put
+        |> withAuthorization (Just token)
+        |> withBody body
+        |> withExpect expect
+        |> HttpBuilder.toRequest
+
+
+
+-- DELETE --
+
+
+delete : Article.Slug -> AuthToken -> Http.Request ()
+delete slug token =
+    apiUrl ("/articles/" ++ Article.slugToString slug)
+        |> HttpBuilder.delete
+        |> withAuthorization (Just token)
+        |> HttpBuilder.toRequest
+
+
+
+-- HELPERS --
+
+
+maybeVal : ( a, Maybe b ) -> Maybe ( a, b )
+maybeVal ( key, value ) =
+    case value of
+        Nothing ->
+            Nothing
+
+        Just val ->
+            Just ( key, val )
+
+
+buildFromQueryParams : String -> List ( String, String ) -> RequestBuilder Feed
+buildFromQueryParams url queryParams =
+    url
+        |> apiUrl
+        |> HttpBuilder.get
+        |> withExpect (Http.expectJson Feed.decoder)
+        |> withQueryParams queryParams

intro/part9/src/Request/Article/Comments.elm

@@ -0,0 +1,53 @@
+module Request.Article.Comments exposing (delete, list, post)
+
+import Data.Article as Article exposing (Article, Tag, slugToString)
+import Data.Article.Comment as Comment exposing (Comment, CommentId)
+import Data.AuthToken exposing (AuthToken, withAuthorization)
+import Http
+import HttpBuilder exposing (RequestBuilder, withExpect, withQueryParams)
+import Json.Decode as Decode
+import Json.Encode as Encode exposing (Value)
+import Request.Helpers exposing (apiUrl)
+
+
+-- LIST --
+
+
+list : Maybe AuthToken -> Article.Slug -> Http.Request (List Comment)
+list maybeToken slug =
+    apiUrl ("/articles/" ++ Article.slugToString slug ++ "/comments")
+        |> HttpBuilder.get
+        |> HttpBuilder.withExpect (Http.expectJson (Decode.field "comments" (Decode.list Comment.decoder)))
+        |> withAuthorization maybeToken
+        |> HttpBuilder.toRequest
+
+
+
+-- POST --
+
+
+post : Article.Slug -> String -> AuthToken -> Http.Request Comment
+post slug body token =
+    apiUrl ("/articles/" ++ Article.slugToString slug ++ "/comments")
+        |> HttpBuilder.post
+        |> HttpBuilder.withBody (Http.jsonBody (encodeCommentBody body))
+        |> HttpBuilder.withExpect (Http.expectJson (Decode.field "comment" Comment.decoder))
+        |> withAuthorization (Just token)
+        |> HttpBuilder.toRequest
+
+
+encodeCommentBody : String -> Value
+encodeCommentBody body =
+    Encode.object [ ( "comment", Encode.object [ ( "body", Encode.string body ) ] ) ]
+
+
+
+-- DELETE --
+
+
+delete : Article.Slug -> CommentId -> AuthToken -> Http.Request ()
+delete slug commentId token =
+    apiUrl ("/articles/" ++ Article.slugToString slug ++ "/comments/" ++ Comment.idToString commentId)
+        |> HttpBuilder.delete
+        |> withAuthorization (Just token)
+        |> HttpBuilder.toRequest

intro/part9/src/Request/Helpers.elm

@@ -0,0 +1,6 @@
+module Request.Helpers exposing (apiUrl)
+
+
+apiUrl : String -> String
+apiUrl str =
+    "/api" ++ str

intro/part9/src/Request/Profile.elm

@@ -0,0 +1,57 @@
+module Request.Profile exposing (get, toggleFollow)
+
+import Data.AuthToken exposing (AuthToken, withAuthorization)
+import Data.Profile as Profile exposing (Profile)
+import Data.User as User exposing (Username)
+import Http
+import HttpBuilder exposing (RequestBuilder, withExpect, withQueryParams)
+import Json.Decode as Decode
+import Request.Helpers exposing (apiUrl)
+
+
+-- GET --
+
+
+get : Username -> Maybe AuthToken -> Http.Request Profile
+get username maybeToken =
+    apiUrl ("/profiles/" ++ User.usernameToString username)
+        |> HttpBuilder.get
+        |> HttpBuilder.withExpect (Http.expectJson (Decode.field "profile" Profile.decoder))
+        |> withAuthorization maybeToken
+        |> HttpBuilder.toRequest
+
+
+
+-- FOLLOWING --
+
+
+toggleFollow : Username -> Bool -> AuthToken -> Http.Request Profile
+toggleFollow username following authToken =
+    if following then
+        unfollow username authToken
+    else
+        follow username authToken
+
+
+follow : Username -> AuthToken -> Http.Request Profile
+follow =
+    buildFollow HttpBuilder.post
+
+
+unfollow : Username -> AuthToken -> Http.Request Profile
+unfollow =
+    buildFollow HttpBuilder.delete
+
+
+buildFollow :
+    (String -> RequestBuilder a)
+    -> Username
+    -> AuthToken
+    -> Http.Request Profile
+buildFollow builderFromUrl username token =
+    [ apiUrl "/profiles", User.usernameToString username, "follow" ]
+        |> String.join "/"
+        |> builderFromUrl
+        |> withAuthorization (Just token)
+        |> withExpect (Http.expectJson (Decode.field "profile" Profile.decoder))
+        |> HttpBuilder.toRequest

intro/part9/src/Request/User.elm

@@ -0,0 +1,94 @@
+module Request.User exposing (edit, login, register, storeSession)
+
+import Data.AuthToken exposing (AuthToken, withAuthorization)
+import Data.User as User exposing (User)
+import Http
+import HttpBuilder exposing (RequestBuilder, withExpect, withQueryParams)
+import Json.Decode as Decode
+import Json.Encode as Encode
+import Json.Encode.Extra as EncodeExtra
+import Ports
+import Request.Helpers exposing (apiUrl)
+
+
+storeSession : User -> Cmd msg
+storeSession user =
+    User.encode user
+        |> Encode.encode 0
+        |> Just
+        |> Ports.storeSession
+
+
+login : { r | email : String, password : String } -> Http.Request User
+login { email, password } =
+    let
+        user =
+            Encode.object
+                [ ( "email", Encode.string email )
+                , ( "password", Encode.string password )
+                ]
+
+        body =
+            Encode.object [ ( "user", user ) ]
+                |> Http.jsonBody
+    in
+    Decode.field "user" User.decoder
+        |> Http.post (apiUrl "/users/login") body
+
+
+register : { r | username : String, email : String, password : String } -> Http.Request User
+register { username, email, password } =
+    let
+        user =
+            Encode.object
+                [ ( "username", Encode.string username )
+                , ( "email", Encode.string email )
+                , ( "password", Encode.string password )
+                ]
+
+        body =
+            Encode.object [ ( "user", user ) ]
+                |> Http.jsonBody
+    in
+    Decode.field "user" User.decoder
+        |> Http.post (apiUrl "/users") body
+
+
+edit :
+    { r
+        | username : String
+        , email : String
+        , bio : String
+        , password : Maybe String
+        , image : Maybe String
+    }
+    -> Maybe AuthToken
+    -> Http.Request User
+edit { username, email, bio, password, image } maybeToken =
+    let
+        updates =
+            [ Just ( "username", Encode.string username )
+            , Just ( "email", Encode.string email )
+            , Just ( "bio", Encode.string bio )
+            , Just ( "image", EncodeExtra.maybe Encode.string image )
+            , Maybe.map (\pass -> ( "password", Encode.string pass )) password
+            ]
+                |> List.filterMap identity
+
+        body =
+            ( "user", Encode.object updates )
+                |> List.singleton
+                |> Encode.object
+                |> Http.jsonBody
+
+        expect =
+            User.decoder
+                |> Decode.field "user"
+                |> Http.expectJson
+    in
+    apiUrl "/user"
+        |> HttpBuilder.put
+        |> HttpBuilder.withExpect expect
+        |> HttpBuilder.withBody body
+        |> withAuthorization maybeToken
+        |> HttpBuilder.toRequest

intro/part9/src/Route.elm

@@ -0,0 +1,103 @@
+module Route exposing (Route(..), fromLocation, href, modifyUrl)
+
+import Data.Article as Article
+import Data.User as User exposing (Username)
+import Html exposing (Attribute)
+import Html.Attributes as Attr
+import Navigation exposing (Location)
+import UrlParser as Url exposing ((</>), Parser, oneOf, parseHash, s, string)
+
+
+-- ROUTING --
+
+
+type Route
+    = Home
+    | Root
+    | Login
+    | Logout
+    | Register
+    | Settings
+    | Article Article.Slug
+    | Profile Username
+    | NewArticle
+    | EditArticle Article.Slug
+
+
+route : Parser (Route -> a) a
+route =
+    oneOf
+        [ Url.map Home (s "")
+        , Url.map Login (s "login")
+        , Url.map Logout (s "logout")
+        , Url.map Settings (s "settings")
+        , Url.map Profile (s "profile" </> User.usernameParser)
+        , Url.map Register (s "register")
+        , Url.map Article (s "article" </> Article.slugParser)
+        , Url.map NewArticle (s "editor")
+        , Url.map EditArticle (s "editor" </> Article.slugParser)
+        ]
+
+
+
+-- INTERNAL --
+
+
+routeToString : Route -> String
+routeToString page =
+    let
+        pieces =
+            case page of
+                Home ->
+                    []
+
+                Root ->
+                    []
+
+                Login ->
+                    [ "login" ]
+
+                Logout ->
+                    [ "logout" ]
+
+                Register ->
+                    [ "register" ]
+
+                Settings ->
+                    [ "settings" ]
+
+                Article slug ->
+                    [ "article", Article.slugToString slug ]
+
+                Profile username ->
+                    [ "profile", User.usernameToString username ]
+
+                NewArticle ->
+                    [ "editor" ]
+
+                EditArticle slug ->
+                    [ "editor", Article.slugToString slug ]
+    in
+    "#/" ++ String.join "/" pieces
+
+
+
+-- PUBLIC HELPERS --
+
+
+href : Route -> Attribute msg
+href route =
+    Attr.href (routeToString route)
+
+
+modifyUrl : Route -> Cmd msg
+modifyUrl =
+    routeToString >> Navigation.modifyUrl
+
+
+fromLocation : Location -> Maybe Route
+fromLocation location =
+    if String.isEmpty location.hash then
+        Just Root
+    else
+        parseHash route location

intro/part9/src/Util.elm

@@ -0,0 +1,39 @@
+module Util exposing (appendErrors, onClickStopPropagation, pair, viewIf)
+
+import Html exposing (Attribute, Html)
+import Html.Events exposing (defaultOptions, onWithOptions)
+import Json.Decode as Decode
+
+
+{-| Useful when building up a Cmd via a pipeline, and then pairing it with
+a model at the end.
+
+    session.user
+        |> User.Request.foo
+        |> Task.attempt Foo
+        |> pair { model | something = blah }
+
+-}
+pair : a -> b -> ( a, b )
+pair first second =
+    ( first, second )
+
+
+viewIf : Bool -> Html msg -> Html msg
+viewIf condition content =
+    if condition then
+        content
+    else
+        Html.text ""
+
+
+onClickStopPropagation : msg -> Attribute msg
+onClickStopPropagation msg =
+    onWithOptions "click"
+        { defaultOptions | stopPropagation = True }
+        (Decode.succeed msg)
+
+
+appendErrors : { model | errors : List error } -> List error -> { model | errors : List error }
+appendErrors model errors =
+    { model | errors = model.errors ++ errors }

intro/part9/src/Views/Article.elm

@@ -0,0 +1,60 @@
+module Views.Article exposing (view, viewTimestamp)
+
+{-| Viewing a preview of an individual article, excluding its body.
+-}
+
+import Data.Article exposing (Article)
+import Data.UserPhoto as UserPhoto exposing (UserPhoto)
+import Date.Format
+import Html exposing (..)
+import Html.Attributes exposing (attribute, class, classList, href, id, placeholder, src)
+import Route exposing (Route)
+import Views.Article.Favorite as Favorite
+import Views.Author
+
+
+-- VIEWS --
+
+
+{-| Some pages want to view just the timestamp, not the whole article.
+-}
+viewTimestamp : Article a -> Html msg
+viewTimestamp article =
+    span [ class "date" ] [ text (formattedTimestamp article) ]
+
+
+view : (Article a -> msg) -> Article a -> Html msg
+view toggleFavorite article =
+    let
+        author =
+            article.author
+    in
+    div [ class "article-preview" ]
+        [ div [ class "article-meta" ]
+            [ a [ Route.href (Route.Profile author.username) ]
+                [ img [ UserPhoto.src author.image ] [] ]
+            , div [ class "info" ]
+                [ Views.Author.view author.username
+                , span [ class "date" ] [ text (formattedTimestamp article) ]
+                ]
+            , Favorite.button
+                toggleFavorite
+                article
+                [ class "pull-xs-right" ]
+                [ text (" " ++ toString article.favoritesCount) ]
+            ]
+        , a [ class "preview-link", Route.href (Route.Article article.slug) ]
+            [ h1 [] [ text article.title ]
+            , p [] [ text article.description ]
+            , span [] [ text "Read more..." ]
+            ]
+        ]
+
+
+
+-- INTERNAL --
+
+
+formattedTimestamp : Article a -> String
+formattedTimestamp article =
+    Date.Format.format "%B %e, %Y" article.createdAt

intro/part9/src/Views/Article/Favorite.elm

@@ -0,0 +1,42 @@
+module Views.Article.Favorite exposing (button)
+
+{-| The Favorite button.
+-}
+
+import Data.Article exposing (Article)
+import Html exposing (Attribute, Html, i, text)
+import Html.Attributes exposing (class)
+import Util exposing (onClickStopPropagation)
+
+
+{-| 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.
+
+-}
+button :
+    (Article a -> msg)
+    -> Article a
+    -> List (Attribute msg)
+    -> List (Html msg)
+    -> Html msg
+button toggleFavorite article extraAttributes extraChildren =
+    let
+        favoriteButtonClass =
+            if article.favorited then
+                "btn-primary"
+            else
+                "btn-outline-primary"
+
+        attributes =
+            [ class ("btn btn-sm " ++ favoriteButtonClass)
+            , onClickStopPropagation (toggleFavorite article)
+            ]
+                ++ extraAttributes
+
+        children =
+            [ i [ class "ion-heart" ] [] ]
+                ++ extraChildren
+    in
+    Html.button attributes children

intro/part9/src/Views/Article/Feed.elm

@@ -0,0 +1,419 @@
+module Views.Article.Feed exposing (FeedSource, Model, Msg, authorFeed, favoritedFeed, globalFeed, init, selectTag, tagFeed, update, viewArticles, viewFeedSources, yourFeed)
+
+{-| 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.
+
+-}
+
+import Data.Article as Article exposing (Article, Tag)
+import Data.Article.Feed exposing (Feed)
+import Data.AuthToken exposing (AuthToken)
+import Data.Session exposing (Session)
+import Data.User exposing (Username)
+import Dom.Scroll
+import Html exposing (..)
+import Html.Attributes exposing (attribute, class, classList, href, id, placeholder, src)
+import Html.Events exposing (onClick)
+import Http
+import Request.Article
+import SelectList exposing (Position(..), SelectList)
+import Task exposing (Task)
+import Util exposing (onClickStopPropagation, pair, viewIf)
+import Views.Article
+import Views.Errors as Errors
+import Views.Page exposing (bodyId)
+import Views.Spinner exposing (spinner)
+
+
+-- 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 file.
+-}
+type alias InternalModel =
+    { errors : List String
+    , feed : Feed
+    , feedSources : SelectList FeedSource
+    , activePage : Int
+    , isLoading : Bool
+    }
+
+
+init : Session -> SelectList FeedSource -> Task Http.Error Model
+init session feedSources =
+    let
+        source =
+            SelectList.selected feedSources
+
+        toModel ( activePage, feed ) =
+            Model
+                { errors = []
+                , activePage = activePage
+                , feed = feed
+                , feedSources = feedSources
+                , isLoading = False
+                }
+    in
+    source
+        |> fetch (Maybe.map .token session.user) 1
+        |> Task.map toModel
+
+
+
+-- VIEW --
+
+
+viewArticles : Model -> List (Html Msg)
+viewArticles (Model { activePage, feed, feedSources }) =
+    List.map (Views.Article.view ToggleFavorite) feed.articles
+        ++ [ pagination activePage feed (SelectList.selected feedSources) ]
+
+
+viewFeedSources : Model -> Html Msg
+viewFeedSources (Model { feedSources, isLoading, errors }) =
+    ul [ class "nav nav-pills outline-active" ] <|
+        SelectList.toList (SelectList.mapBy viewFeedSource feedSources)
+            ++ [ Errors.view DismissErrors errors, viewIf isLoading spinner ]
+
+
+viewFeedSource : Position -> FeedSource -> Html Msg
+viewFeedSource position source =
+    li [ class "nav-item" ]
+        [ a
+            [ classList [ ( "nav-link", True ), ( "active", position == Selected ) ]
+            , href "javascript:void(0);"
+            , onClick (SelectFeedSource source)
+            ]
+            [ text (sourceName source) ]
+        ]
+
+
+selectTag : Maybe AuthToken -> Tag -> Cmd Msg
+selectTag maybeAuthToken tagName =
+    let
+        source =
+            tagFeed tagName
+    in
+    source
+        |> fetch maybeAuthToken 1
+        |> Task.attempt (FeedLoadCompleted source)
+
+
+sourceName : FeedSource -> String
+sourceName source =
+    case source of
+        YourFeed ->
+            "Your Feed"
+
+        GlobalFeed ->
+            "Global Feed"
+
+        TagFeed tagName ->
+            "#" ++ Article.tagToString tagName
+
+        FavoritedFeed username ->
+            "Favorited Articles"
+
+        AuthorFeed username ->
+            "My Articles"
+
+
+limit : FeedSource -> Int
+limit feedSource =
+    case feedSource of
+        YourFeed ->
+            10
+
+        GlobalFeed ->
+            10
+
+        TagFeed tagName ->
+            10
+
+        FavoritedFeed username ->
+            5
+
+        AuthorFeed username ->
+            5
+
+
+pagination : Int -> Feed -> FeedSource -> Html Msg
+pagination activePage feed feedSource =
+    let
+        articlesPerPage =
+            limit feedSource
+
+        totalPages =
+            ceiling (toFloat feed.articlesCount / toFloat articlesPerPage)
+    in
+    if totalPages > 1 then
+        List.range 1 totalPages
+            |> List.map (\page -> pageLink page (page == activePage))
+            |> ul [ class "pagination" ]
+    else
+        Html.text ""
+
+
+pageLink : Int -> Bool -> Html Msg
+pageLink page isActive =
+    li [ classList [ ( "page-item", True ), ( "active", isActive ) ] ]
+        [ a
+            [ class "page-link"
+            , href "javascript:void(0);"
+            , onClick (SelectPage page)
+            ]
+            [ text (toString page) ]
+        ]
+
+
+
+-- UPDATE --
+
+
+type Msg
+    = DismissErrors
+    | SelectFeedSource FeedSource
+    | FeedLoadCompleted FeedSource (Result Http.Error ( Int, Feed ))
+    | ToggleFavorite (Article ())
+    | FavoriteCompleted (Result Http.Error (Article ()))
+    | SelectPage Int
+
+
+update : Session -> Msg -> Model -> ( Model, Cmd Msg )
+update session msg (Model internalModel) =
+    updateInternal session msg internalModel
+        |> Tuple.mapFirst Model
+
+
+updateInternal : Session -> Msg -> InternalModel -> ( InternalModel, Cmd Msg )
+updateInternal session msg model =
+    case msg of
+        DismissErrors ->
+            ( { model | errors = [] }, Cmd.none )
+
+        SelectFeedSource source ->
+            source
+                |> fetch (Maybe.map .token session.user) 1
+                |> Task.attempt (FeedLoadCompleted source)
+                |> pair { model | isLoading = True }
+
+        FeedLoadCompleted source (Ok ( activePage, feed )) ->
+            ( { model
+                | feed = feed
+                , feedSources = selectFeedSource source model.feedSources
+                , activePage = activePage
+                , isLoading = False
+              }
+            , Cmd.none
+            )
+
+        FeedLoadCompleted _ (Err error) ->
+            ( { model
+                | errors = model.errors ++ [ "Server error while trying to load feed" ]
+                , isLoading = False
+              }
+            , Cmd.none
+            )
+
+        ToggleFavorite article ->
+            case session.user of
+                Nothing ->
+                    ( { model | errors = model.errors ++ [ "You are currently signed out. You must sign in to favorite articles." ] }
+                    , Cmd.none
+                    )
+
+                Just user ->
+                    Request.Article.toggleFavorite article user.token
+                        |> Http.send FavoriteCompleted
+                        |> pair model
+
+        FavoriteCompleted (Ok article) ->
+            let
+                feed =
+                    model.feed
+
+                newFeed =
+                    { feed | articles = List.map (replaceArticle article) feed.articles }
+            in
+            ( { model | feed = newFeed }, Cmd.none )
+
+        FavoriteCompleted (Err error) ->
+            ( { model | errors = model.errors ++ [ "Server error while trying to favorite article." ] }
+            , Cmd.none
+            )
+
+        SelectPage page ->
+            let
+                source =
+                    SelectList.selected model.feedSources
+            in
+            source
+                |> fetch (Maybe.map .token session.user) page
+                |> Task.andThen (\feed -> Task.map (\_ -> feed) scrollToTop)
+                |> Task.attempt (FeedLoadCompleted source)
+                |> pair model
+
+
+scrollToTop : Task x ()
+scrollToTop =
+    Dom.Scroll.toTop bodyId
+        -- 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 AuthToken -> Int -> FeedSource -> Task Http.Error ( Int, Feed )
+fetch token page feedSource =
+    let
+        defaultListConfig =
+            Request.Article.defaultListConfig
+
+        articlesPerPage =
+            limit feedSource
+
+        offset =
+            (page - 1) * articlesPerPage
+
+        listConfig =
+            { defaultListConfig | offset = offset, limit = articlesPerPage }
+
+        task =
+            case feedSource of
+                YourFeed ->
+                    let
+                        defaultFeedConfig =
+                            Request.Article.defaultFeedConfig
+
+                        feedConfig =
+                            { defaultFeedConfig | offset = offset, limit = articlesPerPage }
+                    in
+                    token
+                        |> Maybe.map (Request.Article.feed feedConfig >> Http.toTask)
+                        |> Maybe.withDefault (Task.fail (Http.BadUrl "You need to be signed in to view your feed."))
+
+                GlobalFeed ->
+                    Request.Article.list listConfig token
+                        |> Http.toTask
+
+                TagFeed tagName ->
+                    Request.Article.list { listConfig | tag = Just tagName } token
+                        |> Http.toTask
+
+                FavoritedFeed username ->
+                    Request.Article.list { listConfig | favorited = Just username } token
+                        |> Http.toTask
+
+                AuthorFeed username ->
+                    Request.Article.list { listConfig | author = Just username } token
+                        |> Http.toTask
+    in
+    task
+        |> Task.map (\feed -> ( page, feed ))
+
+
+replaceArticle : Article a -> Article a -> Article a
+replaceArticle newArticle oldArticle =
+    if newArticle.slug == oldArticle.slug then
+        newArticle
+    else
+        oldArticle
+
+
+selectFeedSource : FeedSource -> SelectList FeedSource -> SelectList FeedSource
+selectFeedSource source sources =
+    let
+        withoutTags =
+            sources
+                |> SelectList.toList
+                |> List.filter (not << isTagFeed)
+
+        newSources =
+            case source of
+                YourFeed ->
+                    withoutTags
+
+                GlobalFeed ->
+                    withoutTags
+
+                FavoritedFeed _ ->
+                    withoutTags
+
+                AuthorFeed _ ->
+                    withoutTags
+
+                TagFeed _ ->
+                    withoutTags ++ [ source ]
+    in
+    case newSources of
+        [] ->
+            -- This should never happen. If we had a logging service set up,
+            -- we would definitely want to report if it somehow did happen!
+            sources
+
+        first :: rest ->
+            SelectList.fromLists [] first rest
+                |> SelectList.select ((==) source)
+
+
+isTagFeed : FeedSource -> Bool
+isTagFeed source =
+    case source of
+        TagFeed _ ->
+            True
+
+        _ ->
+            False
+
+
+
+-- FEEDSOURCE --
+
+
+type FeedSource
+    = YourFeed
+    | GlobalFeed
+    | TagFeed Tag
+    | FavoritedFeed Username
+    | AuthorFeed Username
+
+
+yourFeed : FeedSource
+yourFeed =
+    YourFeed
+
+
+globalFeed : FeedSource
+globalFeed =
+    GlobalFeed
+
+
+tagFeed : Tag -> FeedSource
+tagFeed =
+    TagFeed
+
+
+favoritedFeed : Username -> FeedSource
+favoritedFeed =
+    FavoritedFeed
+
+
+authorFeed : Username -> FeedSource
+authorFeed =
+    AuthorFeed

intro/part9/src/Views/Assets.elm

@@ -0,0 +1,33 @@
+module Views.Assets exposing (error, 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 "/assets/images/error.jpg"
+
+
+
+-- USING IMAGES --
+
+
+src : Image -> Attribute msg
+src (Image url) =
+    Attr.src url

intro/part9/src/Views/Author.elm

@@ -0,0 +1,16 @@
+module Views.Author exposing (view)
+
+{-| View an author. We basically render their username and a link to their
+profile, and that's it.
+-}
+
+import Data.User as User exposing (Username)
+import Html exposing (Html, a)
+import Html.Attributes exposing (attribute, class, href, id, placeholder)
+import Route exposing (Route)
+
+
+view : Username -> Html msg
+view username =
+    a [ class "author", Route.href (Route.Profile username) ]
+        [ User.usernameToHtml username ]

intro/part9/src/Views/Errors.elm

@@ -0,0 +1,29 @@
+module Views.Errors exposing (view)
+
+{-| Render dismissable errors. We use this all over the place!
+-}
+
+import Html exposing (..)
+import Html.Attributes exposing (class, style)
+import Html.Events exposing (onClick)
+
+
+view : msg -> List String -> Html msg
+view dismissErrors errors =
+    if List.isEmpty errors then
+        Html.text ""
+    else
+        div [ class "error-messages", styles ] <|
+            List.map (\error -> p [] [ text error ]) errors
+                ++ [ button [ onClick dismissErrors ] [ text "Ok" ] ]
+
+
+styles : Attribute msg
+styles =
+    style
+        [ ( "position", "fixed" )
+        , ( "top", "0" )
+        , ( "background", "rgb(250, 250, 250)" )
+        , ( "padding", "20px" )
+        , ( "border", "1px solid" )
+        ]

intro/part9/src/Views/Form.elm

@@ -0,0 +1,40 @@
+module Views.Form exposing (input, password, textarea, viewErrors)
+
+import Html exposing (Attribute, Html, fieldset, li, text, ul)
+import Html.Attributes exposing (class, type_)
+
+
+password : List (Attribute msg) -> List (Html msg) -> Html msg
+password attrs =
+    control Html.input ([ type_ "password" ] ++ attrs)
+
+
+input : List (Attribute msg) -> List (Html msg) -> Html msg
+input attrs =
+    control Html.input ([ type_ "text" ] ++ attrs)
+
+
+textarea : List (Attribute msg) -> List (Html msg) -> Html msg
+textarea =
+    control Html.textarea
+
+
+viewErrors : List ( a, String ) -> Html msg
+viewErrors errors =
+    errors
+        |> List.map (\( _, error ) -> li [] [ text error ])
+        |> ul [ class "error-messages" ]
+
+
+
+-- INTERNAL --
+
+
+control :
+    (List (Attribute msg) -> List (Html msg) -> Html msg)
+    -> List (Attribute msg)
+    -> List (Html msg)
+    -> Html msg
+control element attributes children =
+    fieldset [ class "form-group" ]
+        [ element (class "form-control" :: attributes) children ]

intro/part9/src/Views/Page.elm

@@ -0,0 +1,142 @@
+module Views.Page exposing (ActivePage(..), bodyId, frame)
+
+{-| The frame around a typical page - that is, the header and footer.
+-}
+
+import Data.User as User exposing (User, Username)
+import Data.UserPhoto as UserPhoto exposing (UserPhoto)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Lazy exposing (lazy2)
+import Route exposing (Route)
+import Util
+import Views.Spinner exposing (spinner)
+
+
+{-| 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 ActivePage
+    = Other
+    | Home
+    | Login
+    | Register
+    | Settings
+    | Profile Username
+    | NewArticle
+
+
+{-| Take a page's Html and frame 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.)
+
+-}
+frame : Bool -> Maybe User -> ActivePage -> Html msg -> Html msg
+frame isLoading user page content =
+    div [ class "page-frame" ]
+        [ viewHeader page user isLoading
+        , content
+        , viewFooter
+        ]
+
+
+viewHeader : ActivePage -> Maybe User -> Bool -> Html msg
+viewHeader page user isLoading =
+    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" ] <|
+                lazy2 Util.viewIf isLoading spinner
+                    :: navbarLink page Route.Home [ text "Home" ]
+                    :: viewSignIn page user
+            ]
+        ]
+
+
+viewSignIn : ActivePage -> Maybe User -> List (Html msg)
+viewSignIn page user =
+    let
+        linkTo =
+            navbarLink page
+    in
+    case user of
+        Nothing ->
+            [ linkTo Route.Login [ text "Sign in" ]
+            , linkTo Route.Register [ text "Sign up" ]
+            ]
+
+        Just user ->
+            [ linkTo Route.NewArticle [ i [ class "ion-compose" ] [], text " New Post" ]
+            , linkTo Route.Settings [ i [ class "ion-gear-a" ] [], text " Settings" ]
+            , linkTo
+                (Route.Profile user.username)
+                [ img [ class "user-pic", UserPhoto.src user.image ] []
+                , User.usernameToHtml user.username
+                ]
+            , linkTo Route.Logout [ text "Sign out" ]
+            ]
+
+
+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 : ActivePage -> 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 : ActivePage -> 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
+
+
+{-| This id comes from index.html.
+
+The Feed uses it to scroll to the top of the page (by ID) when switching pages
+in the pagination sense.
+
+-}
+bodyId : String
+bodyId =
+    "page-body"

intro/part9/src/Views/Spinner.elm

@@ -0,0 +1,13 @@
+module Views.Spinner exposing (spinner)
+
+import Html exposing (Attribute, Html, div, li)
+import Html.Attributes exposing (class, style)
+
+
+spinner : Html msg
+spinner =
+    li [ class "sk-three-bounce", style [ ( "float", "left" ), ( "margin", "8px" ) ] ]
+        [ div [ class "sk-child sk-bounce1" ] []
+        , div [ class "sk-child sk-bounce2" ] []
+        , div [ class "sk-child sk-bounce3" ] []
+        ]

intro/part9/src/Views/User/Follow.elm

@@ -0,0 +1,41 @@
+module Views.User.Follow exposing (State, button)
+
+{-| The Follow button.
+
+This API accepts a "toggle follow" message and the current state of whether
+the user is already being followed. It's very lightweight!
+
+It would be overkill to give something this simple its own Model, Msg, and
+update. That would make it way more work to use than it needed to be,
+and for no benefit.
+
+-}
+
+import Data.User as User exposing (Username)
+import Html exposing (Html, i, text)
+import Html.Attributes exposing (class)
+import Html.Events exposing (onClick)
+
+
+type alias State record =
+    { record | following : Bool, username : Username }
+
+
+button : (Username -> msg) -> State record -> Html msg
+button toggleFollow { following, username } =
+    let
+        ( prefix, secondaryClass ) =
+            if following then
+                ( "Unfollow", "btn-secondary" )
+            else
+                ( "Follow", "btn-outline-secondary" )
+
+        classes =
+            [ "btn", "btn-sm", secondaryClass, "action-btn" ]
+                |> String.join " "
+                |> class
+    in
+    Html.button [ classes, onClick (toggleFollow username) ]
+        [ i [ class "ion-plus-round" ] []
+        , text (" " ++ prefix ++ " " ++ User.usernameToString username)
+        ]