From fd3ceff2d280295c5e9154ca9a3ea976e999ead1 Mon Sep 17 00:00:00 2001 From: Richard Feldman Date: Mon, 13 Aug 2018 06:07:16 -0400 Subject: [PATCH] Update part4 --- advanced/part4/src/Api.elm | 24 +- advanced/part4/src/Article/Feed.elm | 170 ++++++------- advanced/part4/src/Article/Preview.elm | 72 ------ advanced/part4/src/Article/Tag.elm | 10 +- advanced/part4/src/{Assets.elm => Asset.elm} | 19 +- advanced/part4/src/Author.elm | 12 +- advanced/part4/src/Avatar.elm | 50 ++-- advanced/part4/src/Loading.elm | 20 +- advanced/part4/src/Main.elm | 44 ++-- advanced/part4/src/Page/Article.elm | 40 ++- advanced/part4/src/Page/Article/Editor.elm | 243 ++++++++++++++----- advanced/part4/src/Page/Home.elm | 52 +++- advanced/part4/src/Page/Login.elm | 178 +++++++++----- advanced/part4/src/Page/NotFound.elm | 4 +- advanced/part4/src/Page/Profile.elm | 65 +++-- advanced/part4/src/Page/Register.elm | 161 +++++++----- advanced/part4/src/Page/Settings.elm | 232 ++++++++++++------ advanced/part4/src/Session.elm | 7 +- advanced/part4/src/Viewer.elm | 18 +- 19 files changed, 885 insertions(+), 536 deletions(-) delete mode 100644 advanced/part4/src/Article/Preview.elm rename advanced/part4/src/{Assets.elm => Asset.elm} (58%) diff --git a/advanced/part4/src/Api.elm b/advanced/part4/src/Api.elm index 2ac50a0..bed2e13 100644 --- a/advanced/part4/src/Api.elm +++ b/advanced/part4/src/Api.elm @@ -1,4 +1,4 @@ -module Api exposing (addServerError, listErrors, optionalError, url) +module Api exposing (addServerError, decodeErrors, url) import Http import Json.Decode as Decode exposing (Decoder, decodeString, field, string) @@ -30,22 +30,24 @@ addServerError list = {-| Many API endpoints include an "errors" field in their BadStatus responses. -} -listErrors : Decoder (List String) -> Http.Error -> List String -listErrors decoder error = +decodeErrors : Http.Error -> List String +decodeErrors error = case error of Http.BadStatus response -> response.body - |> decodeString (field "errors" decoder) + |> decodeString (field "errors" errorsDecoder) |> Result.withDefault [ "Server error" ] err -> [ "Server error" ] -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)) [] +errorsDecoder : Decoder (List String) +errorsDecoder = + Decode.keyValuePairs (Decode.list Decode.string) + |> Decode.map (List.concatMap fromPair) + + +fromPair : ( String, List String ) -> List String +fromPair ( field, errors ) = + List.map (\error -> field ++ " " ++ error) errors diff --git a/advanced/part4/src/Article/Feed.elm b/advanced/part4/src/Article/Feed.elm index 41b5614..2050db6 100644 --- a/advanced/part4/src/Article/Feed.elm +++ b/advanced/part4/src/Article/Feed.elm @@ -1,11 +1,7 @@ module Article.Feed exposing - ( FeedConfig - , ListConfig - , Model + ( Model , Msg - , defaultFeedConfig - , defaultListConfig , init , selectTag , update @@ -16,9 +12,10 @@ module Article.Feed import Api import Article exposing (Article, Preview) import Article.FeedSources as FeedSources exposing (FeedSources, Source(..)) -import Article.Preview import Article.Slug as ArticleSlug exposing (Slug) import Article.Tag as Tag exposing (Tag) +import Author +import Avatar exposing (Avatar) import Browser.Dom as Dom import Html exposing (..) import Html.Attributes exposing (attribute, class, classList, href, id, placeholder, src) @@ -30,9 +27,11 @@ import Json.Decode.Pipeline exposing (required) import Page import PaginatedList exposing (PaginatedList) import Profile +import Route exposing (Route) import Session exposing (Session) import Task exposing (Task) import Time +import Timestamp import Username exposing (Username) import Viewer exposing (Viewer) import Viewer.Cred as Cred exposing (Cred) @@ -118,9 +117,7 @@ viewArticles timeZone (Model { articles, sources, session }) = {-| 👉 TODO Move this logic into PaginatedList.view and make it reusable, so we can use it on other pages too! - 💡 HINT: Make `PaginatedList.view` return `Html msg` instead of `Html Msg`. (The function will need to accept an extra argument for this to work.) - -} viewPaginatedList : PaginatedList a -> Int -> Html Msg viewPaginatedList paginatedList resultsPerPage = @@ -132,7 +129,7 @@ viewPaginatedList paginatedList resultsPerPage = PaginatedList.page paginatedList viewPageLink currentPage = - pageLink ClickedFeedPage currentPage (currentPage == activePage) + pageLink currentPage (currentPage == activePage) in if totalPages > 1 then List.range 1 totalPages @@ -148,7 +145,7 @@ pageLink targetPage isActive = li [ classList [ ( "page-item", True ), ( "active", isActive ) ] ] [ a [ class "page-link" - , onClick (toMsg targetPage) + , onClick (ClickedFeedPage targetPage) -- The RealWorld CSS requires an href to work properly. , href "" @@ -163,19 +160,54 @@ viewPreview maybeCred timeZone article = slug = Article.slug article - config = + { title, description, createdAt } = + Article.metadata article + + author = + Article.author article + + profile = + Author.profile author + + username = + Author.username author + + faveButton = case maybeCred of Just cred -> - Just - { cred = cred - , favorite = ClickedFavorite cred slug - , unfavorite = ClickedUnfavorite cred slug - } + let + { favoritesCount, favorited } = + Article.metadata article + + viewButton = + if favorited then + Article.unfavoriteButton cred (ClickedUnfavorite cred slug) + + else + Article.favoriteButton cred (ClickedFavorite cred slug) + in + viewButton [ class "pull-xs-right" ] + [ text (" " ++ String.fromInt favoritesCount) ] Nothing -> - Nothing + text "" in - Article.Preview.view config timeZone article + div [ class "article-preview" ] + [ div [ class "article-meta" ] + [ a [ Route.href (Route.Profile username) ] + [ img [ Avatar.src (Profile.avatar profile) ] [] ] + , div [ class "info" ] + [ Author.view username + , Timestamp.view timeZone createdAt + ] + , faveButton + ] + , a [ class "preview-link", Route.href (Route.Article (Article.slug article)) ] + [ h1 [] [ text title ] + , p [] [ text description ] + , span [] [ text "Read more..." ] + ] + ] viewFeedSources : Model -> Html Msg @@ -346,34 +378,42 @@ fetch maybeCred page feedSource = offset = (page - 1) * articlesPerPage - listConfig = - { defaultListConfig | offset = offset, limit = articlesPerPage } + params = + [ ( "limit", String.fromInt articlesPerPage ) + , ( "offset", String.fromInt offset ) + ] in Task.map (PaginatedList.mapPage (\_ -> page)) <| case feedSource of YourFeed cred -> - let - feedConfig = - { defaultFeedConfig | offset = offset, limit = articlesPerPage } - in - feed feedConfig cred + params + |> buildFromQueryParams (Just cred) (Api.url [ "articles", "feed" ]) + |> Cred.addHeader cred + |> HttpBuilder.toRequest |> Http.toTask GlobalFeed -> - list listConfig maybeCred - |> Http.toTask + list maybeCred params TagFeed tagName -> - list { listConfig | tag = Just tagName } maybeCred - |> Http.toTask + list maybeCred (( "tag", Tag.toString tagName ) :: params) FavoritedFeed username -> - list { listConfig | favorited = Just username } maybeCred - |> Http.toTask + list maybeCred (( "favorited", Username.toString username ) :: params) AuthorFeed username -> - list { listConfig | author = Just username } maybeCred - |> Http.toTask + list maybeCred (( "author", Username.toString username ) :: params) + + +list : + Maybe Cred + -> List ( String, String ) + -> Task Http.Error (PaginatedList (Article Preview)) +list maybeCred params = + buildFromQueryParams maybeCred (Api.url [ "articles" ]) params + |> Cred.addHeaderIfAvailable maybeCred + |> HttpBuilder.toRequest + |> Http.toTask replaceArticle : Article a -> Article a -> Article a @@ -386,70 +426,6 @@ replaceArticle newArticle oldArticle = --- 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 Cred -> Http.Request (PaginatedList (Article Preview)) -list config maybeCred = - [ Maybe.map (\tag -> ( "tag", Tag.toString tag )) config.tag - , Maybe.map (\author -> ( "author", Username.toString author )) config.author - , Maybe.map (\favorited -> ( "favorited", Username.toString favorited )) config.favorited - , Just ( "limit", String.fromInt config.limit ) - , Just ( "offset", String.fromInt config.offset ) - ] - |> List.filterMap identity - |> buildFromQueryParams maybeCred (Api.url [ "articles" ]) - |> Cred.addHeaderIfAvailable maybeCred - |> HttpBuilder.toRequest - - - --- FEED - - -type alias FeedConfig = - { limit : Int - , offset : Int - } - - -defaultFeedConfig : FeedConfig -defaultFeedConfig = - { limit = 10 - , offset = 0 - } - - -feed : FeedConfig -> Cred -> Http.Request (PaginatedList (Article Preview)) -feed config cred = - [ ( "limit", String.fromInt config.limit ) - , ( "offset", String.fromInt config.offset ) - ] - |> buildFromQueryParams (Just cred) (Api.url [ "articles", "feed" ]) - |> Cred.addHeader cred - |> HttpBuilder.toRequest - - - -- SERIALIZATION diff --git a/advanced/part4/src/Article/Preview.elm b/advanced/part4/src/Article/Preview.elm deleted file mode 100644 index e51372a..0000000 --- a/advanced/part4/src/Article/Preview.elm +++ /dev/null @@ -1,72 +0,0 @@ -module Article.Preview exposing (view) - -{-| A preview of an individual article, excluding its body. --} - -import Article exposing (Article) -import Author -import Avatar exposing (Avatar) -import Html exposing (..) -import Html.Attributes exposing (attribute, class, classList, href, id, placeholder, src) -import Profile -import Route exposing (Route) -import Time -import Timestamp -import Viewer.Cred exposing (Cred) - - - --- VIEW - - -view : Maybe { cred : Cred, favorite : msg, unfavorite : msg } -> Time.Zone -> Article a -> Html msg -view config timeZone article = - let - { title, description, createdAt } = - Article.metadata article - - author = - Article.author article - - profile = - Author.profile author - - username = - Author.username author - - faveButton = - case config of - Just { favorite, unfavorite, cred } -> - let - { favoritesCount, favorited } = - Article.metadata article - - viewButton = - if favorited then - Article.unfavoriteButton cred unfavorite - - else - Article.favoriteButton cred favorite - in - viewButton [ class "pull-xs-right" ] - [ text (" " ++ String.fromInt favoritesCount) ] - - Nothing -> - text "" - in - div [ class "article-preview" ] - [ div [ class "article-meta" ] - [ a [ Route.href (Route.Profile username) ] - [ img [ Avatar.src (Profile.avatar profile) ] [] ] - , div [ class "info" ] - [ Author.view username - , Timestamp.view timeZone createdAt - ] - , faveButton - ] - , a [ class "preview-link", Route.href (Route.Article (Article.slug article)) ] - [ h1 [] [ text title ] - , p [] [ text description ] - , span [] [ text "Read more..." ] - ] - ] diff --git a/advanced/part4/src/Article/Tag.elm b/advanced/part4/src/Article/Tag.elm index 878733d..9fac80b 100644 --- a/advanced/part4/src/Article/Tag.elm +++ b/advanced/part4/src/Article/Tag.elm @@ -1,4 +1,4 @@ -module Article.Tag exposing (Tag, list, toString) +module Article.Tag exposing (Tag, list, toString, validate) import Api import Http @@ -32,6 +32,14 @@ list = |> Http.get (Api.url [ "tags" ]) +validate : String -> List String -> Bool +validate str = + String.split " " str + |> List.map String.trim + |> List.filter (not << String.isEmpty) + |> (==) + + -- SERIALIZATION diff --git a/advanced/part4/src/Assets.elm b/advanced/part4/src/Asset.elm similarity index 58% rename from advanced/part4/src/Assets.elm rename to advanced/part4/src/Asset.elm index 7ad57fb..72b396d 100644 --- a/advanced/part4/src/Assets.elm +++ b/advanced/part4/src/Asset.elm @@ -1,4 +1,4 @@ -module Assets exposing (error, src) +module Asset exposing (Image, defaultAvatar, error, loading, src) {-| Assets, such as images, videos, and audio. (We only have images for now.) @@ -21,7 +21,22 @@ type Image error : Image error = - Image "/assets/images/error.jpg" + image "error.jpg" + + +loading : Image +loading = + image "loading.svg" + + +defaultAvatar : Image +defaultAvatar = + image "smiley-cyrus.jpg" + + +image : String -> Image +image filename = + Image ("/assets/images/" ++ filename) diff --git a/advanced/part4/src/Author.elm b/advanced/part4/src/Author.elm index 6685cb7..e7de3c5 100644 --- a/advanced/part4/src/Author.elm +++ b/advanced/part4/src/Author.elm @@ -169,19 +169,19 @@ requestHelp builderFromUrl uname cred = |> HttpBuilder.toRequest -followButton : (UnfollowedAuthor -> msg) -> UnfollowedAuthor -> Html msg -followButton toMsg ((UnfollowedAuthor uname _) as author) = +followButton : (Cred -> UnfollowedAuthor -> msg) -> Cred -> UnfollowedAuthor -> Html msg +followButton toMsg cred ((UnfollowedAuthor uname _) as author) = toggleFollowButton "Follow" [ "btn-outline-secondary" ] - (toMsg author) + (toMsg cred author) uname -unfollowButton : (FollowedAuthor -> msg) -> FollowedAuthor -> Html msg -unfollowButton toMsg ((FollowedAuthor uname _) as author) = +unfollowButton : (Cred -> FollowedAuthor -> msg) -> Cred -> FollowedAuthor -> Html msg +unfollowButton toMsg cred ((FollowedAuthor uname _) as author) = toggleFollowButton "Unfollow" [ "btn-secondary" ] - (toMsg author) + (toMsg cred author) uname diff --git a/advanced/part4/src/Avatar.elm b/advanced/part4/src/Avatar.elm index 9317b79..6c2b123 100644 --- a/advanced/part4/src/Avatar.elm +++ b/advanced/part4/src/Avatar.elm @@ -1,5 +1,6 @@ module Avatar exposing (Avatar, decoder, encode, src, toMaybeString) +import Asset import Html exposing (Attribute) import Html.Attributes import Json.Decode as Decode exposing (Decoder) @@ -27,40 +28,31 @@ decoder = -- TRANSFORM +src : Avatar -> Attribute msg +src (Avatar maybeUrl) = + Html.Attributes.src (resolveAvatarUrl maybeUrl) + + +resolveAvatarUrl : Maybe String -> String +resolveAvatarUrl maybeUrl = + {- 👉 TODO #1 of 2: return the user's avatar from maybeUrl, if maybeUrl actually + contains one. If maybeUrl is Nothing, return this URL instead: + + https://static.productionready.io/images/smiley-cyrus.jpg + -} + "" + + encode : Avatar -> Value encode (Avatar maybeUrl) = - maybeUrl - |> Maybe.map Encode.string - |> Maybe.withDefault Encode.null + case maybeUrl of + Just url -> + Encode.string url - -src : Avatar -> Attribute msg -src avatar = - Html.Attributes.src (avatarToUrl avatar) + Nothing -> + Encode.null toMaybeString : Avatar -> Maybe String toMaybeString (Avatar maybeUrl) = maybeUrl - - - --- INTERNAL - - -avatarToUrl : Avatar -> String -avatarToUrl (Avatar maybeUrl) = - case maybeUrl of - Nothing -> - defaultPhotoUrl - - Just "" -> - defaultPhotoUrl - - Just url -> - url - - -defaultPhotoUrl : String -defaultPhotoUrl = - "http://localhost:3000/images/smiley-cyrus.jpg" diff --git a/advanced/part4/src/Loading.elm b/advanced/part4/src/Loading.elm index 42450c9..a1ded78 100644 --- a/advanced/part4/src/Loading.elm +++ b/advanced/part4/src/Loading.elm @@ -1,21 +1,25 @@ -module Loading exposing (error, icon) +module Loading exposing (error, icon, slowThreshold) {-| A loading spinner icon. -} -import Html exposing (Attribute, Html, div, li) -import Html.Attributes exposing (class, style) +import Asset +import Html exposing (Attribute, Html) +import Html.Attributes exposing (alt, height, src, width) +import Process +import Task exposing (Task) icon : Html msg icon = - li [ class "sk-three-bounce", style "float" "left", style "margin" "8px" ] - [ div [ class "sk-child sk-bounce1" ] [] - , div [ class "sk-child sk-bounce2" ] [] - , div [ class "sk-child sk-bounce3" ] [] - ] + Html.img [ Asset.src Asset.loading, width 64, height 64, alt "Loading..." ] [] error : String -> Html msg error str = Html.text ("Error loading " ++ str ++ ".") + + +slowThreshold : Task x () +slowThreshold = + Process.sleep 500 diff --git a/advanced/part4/src/Main.elm b/advanced/part4/src/Main.elm index 054da57..cf1c4cc 100644 --- a/advanced/part4/src/Main.elm +++ b/advanced/part4/src/Main.elm @@ -32,7 +32,7 @@ import Viewer.Cred as Cred exposing (Cred) -- Avoid putting things in here unless there is no alternative! -type ViewingPage +type Model = Redirect Session | NotFound Session | Home Home.Model @@ -48,18 +48,10 @@ type ViewingPage -- MODEL -type alias Model = - { navKey : Nav.Key - , page : ViewingPage - } - - init : Value -> Url -> Nav.Key -> ( Model, Cmd Msg ) init flags url navKey = changeRouteTo (Route.fromUrl url) - { navKey = navKey - , page = Redirect (Session.decode navKey flags) - } + (Redirect (Session.decode navKey flags)) @@ -72,13 +64,13 @@ view model = viewPage page toMsg config = let { title, body } = - Page.view (Session.viewer (toSession model.page)) page config + Page.view (Session.viewer (toSession model)) page config in { title = title , body = List.map (Html.map toMsg) body } in - case model.page of + case model of Redirect _ -> viewPage Page.Other (\_ -> Ignored) Blank.view @@ -126,9 +118,10 @@ type Msg | GotProfileMsg Profile.Msg | GotArticleMsg Article.Msg | GotEditorMsg Editor.Msg + | GotSession Session -toSession : ViewingPage -> Session +toSession : Model -> Session toSession page = case page of Redirect session -> @@ -163,14 +156,14 @@ changeRouteTo : Maybe Route -> Model -> ( Model, Cmd Msg ) changeRouteTo maybeRoute model = let session = - toSession model.page + toSession model in case maybeRoute of Nothing -> - ( { model | page = NotFound session }, Cmd.none ) + ( NotFound session, Cmd.none ) Just Route.Root -> - ( model, Route.replaceUrl model.navKey Route.Home ) + ( model, Route.replaceUrl (Session.navKey session) Route.Home ) Just Route.Logout -> ( model, Session.logout ) @@ -210,7 +203,7 @@ changeRouteTo maybeRoute model = update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = - case ( msg, model.page ) of + case ( msg, model ) of ( Ignored, _ ) -> ( model, Cmd.none ) @@ -231,7 +224,7 @@ update msg model = Just _ -> ( model - , Nav.pushUrl model.navKey (Url.toString url) + , Nav.pushUrl (Session.navKey (toSession model)) (Url.toString url) ) Browser.External href -> @@ -273,14 +266,19 @@ update msg model = Editor.update subMsg editor |> updateWith (Editor slug) GotEditorMsg model + ( GotSession session, Redirect _ ) -> + ( Redirect session + , Route.replaceUrl (Session.navKey session) Route.Home + ) + ( _, _ ) -> -- Disregard messages that arrived for the wrong page. ( model, Cmd.none ) -updateWith : (subModel -> ViewingPage) -> (subMsg -> Msg) -> Model -> ( subModel, Cmd subMsg ) -> ( Model, Cmd Msg ) -updateWith toViewingPage toMsg model ( subModel, subCmd ) = - ( { model | page = toViewingPage subModel } +updateWith : (subModel -> Model) -> (subMsg -> Msg) -> Model -> ( subModel, Cmd subMsg ) -> ( Model, Cmd Msg ) +updateWith toModel toMsg model ( subModel, subCmd ) = + ( toModel subModel , Cmd.map toMsg subCmd ) @@ -291,12 +289,12 @@ updateWith toViewingPage toMsg model ( subModel, subCmd ) = subscriptions : Model -> Sub Msg subscriptions model = - case model.page of + case model of NotFound _ -> Sub.none Redirect _ -> - Sub.none + Session.changes GotSession (Session.navKey (toSession model)) Settings settings -> Sub.map GotSettingsMsg (Settings.subscriptions settings) diff --git a/advanced/part4/src/Page/Article.elm b/advanced/part4/src/Page/Article.elm index 601184c..d454f5f 100644 --- a/advanced/part4/src/Page/Article.elm +++ b/advanced/part4/src/Page/Article.elm @@ -7,7 +7,6 @@ import Api import Article exposing (Article, Full, Preview) import Article.Body exposing (Body) import Article.Comment as Comment exposing (Comment) -import Article.Preview import Article.Slug as Slug exposing (Slug) import Author exposing (Author(..), FollowedAuthor, UnfollowedAuthor) import Avatar @@ -49,6 +48,7 @@ type alias Model = type Status a = Loading + | LoadingSlowly | Loaded a | Failed @@ -76,6 +76,7 @@ init session slug = , Comment.list maybeCred slug |> Http.send CompletedLoadComments , Task.perform GotTimeZone Time.here + , Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold ] ) @@ -154,6 +155,9 @@ view model = -- Don't render the comments until the article has loaded! case model.comments of Loading -> + [] + + LoadingSlowly -> [ Loading.icon ] Loaded ( commentText, comments ) -> @@ -172,6 +176,9 @@ view model = } Loading -> + { title = "Article", content = text "" } + + LoadingSlowly -> { title = "Article", content = Loading.icon } Failed -> @@ -228,13 +235,13 @@ viewButtons : Cred -> Article Full -> Author -> List (Html Msg) viewButtons cred article author = case author of IsFollowing followedAuthor -> - [ Author.unfollowButton (ClickedUnfollow cred) followedAuthor + [ Author.unfollowButton ClickedUnfollow cred followedAuthor , text " " , favoriteButton cred article ] IsNotFollowing unfollowedAuthor -> - [ Author.followButton (ClickedFollow cred) unfollowedAuthor + [ Author.followButton ClickedFollow cred unfollowedAuthor , text " " , favoriteButton cred article ] @@ -318,6 +325,7 @@ type Msg | CompletedPostComment (Result Http.Error Comment) | GotTimeZone Time.Zone | GotSession Session + | PassedSlowLoadThreshold update : Msg -> Model -> ( Model, Cmd Msg ) @@ -468,7 +476,31 @@ update msg model = ( { model | timeZone = tz }, Cmd.none ) GotSession session -> - ( { model | session = session }, Cmd.none ) + ( { model | session = session } + , Route.replaceUrl (Session.navKey session) Route.Home + ) + + PassedSlowLoadThreshold -> + let + -- If any data is still Loading, change it to LoadingSlowly + -- so `view` knows to render a spinner. + article = + case model.article of + Loading -> + LoadingSlowly + + other -> + other + + comments = + case model.comments of + Loading -> + LoadingSlowly + + other -> + other + in + ( { model | article = article, comments = comments }, Cmd.none ) diff --git a/advanced/part4/src/Page/Article/Editor.elm b/advanced/part4/src/Page/Article/Editor.elm index 960e0da..04a89e4 100644 --- a/advanced/part4/src/Page/Article/Editor.elm +++ b/advanced/part4/src/Page/Article/Editor.elm @@ -4,6 +4,7 @@ import Api import Article exposing (Article, Full) import Article.Body exposing (Body) import Article.Slug as Slug exposing (Slug) +import Article.Tag import Browser.Navigation as Nav import Html exposing (..) import Html.Attributes exposing (attribute, class, disabled, href, id, placeholder, type_, value) @@ -19,7 +20,6 @@ import Route import Session exposing (Session) import Task exposing (Task) import Time -import Validate exposing (Valid, Validator, fromValid, ifBlank, validate) import Viewer exposing (Viewer) import Viewer.Cred as Cred exposing (Cred) @@ -38,14 +38,20 @@ type Status -- Edit Article = Loading Slug + | LoadingSlowly Slug | LoadingFailed Slug | Saving Slug Form - | Editing Slug (List Error) Form + | Editing Slug (List Problem) Form -- New Article - | EditingNew (List Error) Form + | EditingNew (List Problem) Form | Creating Form +type Problem + = InvalidEntry ValidatedField String + | ServerError String + + type alias Form = { title : String , body : String @@ -74,12 +80,15 @@ initEdit session slug = ( { session = session , status = Loading slug } - , Article.fetch (Session.cred session) slug - |> Http.toTask - -- If init fails, store the slug that failed in the msg, so we can - -- at least have it later to display the page's title properly! - |> Task.mapError (\httpError -> ( slug, httpError )) - |> Task.attempt CompletedArticleLoad + , Cmd.batch + [ Article.fetch (Session.cred session) slug + |> Http.toTask + -- If init fails, store the slug that failed in the msg, so we can + -- at least have it later to display the page's title properly! + |> Task.mapError (\httpError -> ( slug, httpError )) + |> Task.attempt CompletedArticleLoad + , Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold + ] ) @@ -106,12 +115,35 @@ view model = } +viewProblems : List Problem -> Html msg +viewProblems problems = + ul [ class "error-messages" ] + (List.map viewProblem problems) + + +viewProblem : Problem -> Html msg +viewProblem problem = + let + errorMessage = + case problem of + InvalidEntry _ message -> + message + + ServerError message -> + message + in + li [] [ text errorMessage ] + + viewAuthenticated : Cred -> Model -> Html Msg viewAuthenticated cred model = let formHtml = case model.status of Loading _ -> + [] + + LoadingSlowly _ -> [ Loading.icon ] Saving slug form -> @@ -120,17 +152,13 @@ viewAuthenticated cred model = Creating form -> [ viewForm cred form (newArticleSaveButton [ disabled True ]) ] - Editing slug errors form -> - [ errors - |> List.map (\( _, error ) -> li [] [ text error ]) - |> ul [ class "error-messages" ] + Editing slug problems form -> + [ viewProblems problems , viewForm cred form (editArticleSaveButton []) ] - EditingNew errors form -> - [ errors - |> List.map (\( _, error ) -> li [] [ text error ]) - |> ul [ class "error-messages" ] + EditingNew problems form -> + [ viewProblems problems , viewForm cred form (newArticleSaveButton []) ] @@ -223,6 +251,7 @@ type Msg | CompletedEdit (Result Http.Error (Article Full)) | CompletedArticleLoad (Result ( Slug, Http.Error ) (Article Full)) | GotSession Session + | PassedSlowLoadThreshold update : Msg -> Model -> ( Model, Cmd Msg ) @@ -252,7 +281,7 @@ update msg model = ) CompletedCreate (Err error) -> - ( { model | status = savingError model.status } + ( { model | status = savingError error model.status } , Cmd.none ) @@ -263,7 +292,7 @@ update msg model = ) CompletedEdit (Err error) -> - ( { model | status = savingError model.status } + ( { model | status = savingError error model.status } , Cmd.none ) @@ -291,35 +320,51 @@ update msg model = ) GotSession session -> - ( { model | session = session }, Cmd.none ) + ( { model | session = session } + , Route.replaceUrl (Session.navKey session) Route.Home + ) + + PassedSlowLoadThreshold -> + let + -- If any data is still Loading, change it to LoadingSlowly + -- so `view` knows to render a spinner. + status = + case model.status of + Loading slug -> + LoadingSlowly slug + + other -> + other + in + ( { model | status = status }, Cmd.none ) save : Cred -> Status -> ( Status, Cmd Msg ) save cred status = case status of - Editing slug _ fields -> - case validate formValidator fields of + Editing slug _ form -> + case validate form of Ok validForm -> - ( Saving slug fields + ( Saving slug form , edit slug validForm cred |> Http.send CompletedEdit ) - Err errors -> - ( Editing slug errors fields + Err problems -> + ( Editing slug problems form , Cmd.none ) - EditingNew _ fields -> - case validate formValidator fields of + EditingNew _ form -> + case validate form of Ok validForm -> - ( Creating fields + ( Creating form , create validForm cred |> Http.send CompletedCreate ) - Err errors -> - ( EditingNew errors fields + Err problems -> + ( EditingNew problems form , Cmd.none ) @@ -333,18 +378,18 @@ save cred status = ( status, Cmd.none ) -savingError : Status -> Status -savingError status = +savingError : Http.Error -> Status -> Status +savingError error status = let - errors = - [ ( Server, "Error saving article" ) ] + problems = + [ ServerError "Error saving article" ] in case status of Saving slug form -> - Editing slug errors form + Editing slug problems form Creating form -> - EditingNew errors form + EditingNew problems form _ -> status @@ -367,6 +412,9 @@ updateForm transform model = Loading _ -> model + LoadingSlowly _ -> + model + LoadingFailed _ -> model @@ -395,37 +443,91 @@ subscriptions model = --- VALIDATION +-- FORM -type ErrorSource - = Server - | Title +{-| Marks that we've trimmed the form's fields, so we don't accidentally send +it to the server without having trimmed it! +-} +type TrimmedForm + = Trimmed Form + + +{-| When adding a variant here, add it to `fieldsToValidate` too! +-} +type ValidatedField + = Title | Body -type alias Error = - ( ErrorSource, String ) +fieldsToValidate : List ValidatedField +fieldsToValidate = + [ Title + , Body + ] -formValidator : Validator Error Form -formValidator = - Validate.all - [ ifBlank .title ( Title, "title can't be blank." ) - , ifBlank .body ( Body, "body can't be blank." ) - ] +{-| Trim the form and validate its fields. If there are problems, report them! +-} +validate : Form -> Result (List Problem) TrimmedForm +validate form = + let + trimmedForm = + trimFields form + in + case List.concatMap (validateField trimmedForm) fieldsToValidate of + [] -> + Ok trimmedForm + + problems -> + Err problems + + +validateField : TrimmedForm -> ValidatedField -> List Problem +validateField (Trimmed form) field = + List.map (InvalidEntry field) <| + case field of + Title -> + if String.isEmpty form.title then + [ "title can't be blank." ] + + else + [] + + Body -> + if String.isEmpty form.body then + [ "body can't be blank." ] + + else if String.trim form.tags /= "" && List.all String.isEmpty (toTagList form.tags) then + [ "close, but not quite! Is your filter condition returning True when it should be returning False?" ] + + else if Article.Tag.validate form.tags (toTagList form.tags) then + [] + + else + [ "some tags were empty." ] + + +{-| Don't trim while the user is typing! That would be super annoying. +Instead, trim only on submit. +-} +trimFields : Form -> TrimmedForm +trimFields form = + Trimmed + { title = String.trim form.title + , body = String.trim form.body + , description = String.trim form.description + , tags = String.trim form.tags + } -- HTTP -create : Valid Form -> Cred -> Http.Request (Article Full) -create validForm cred = +create : TrimmedForm -> Cred -> Http.Request (Article Full) +create (Trimmed form) cred = let - form = - fromValid validForm - expect = Article.fullDecoder (Just cred) |> Decode.field "article" @@ -436,7 +538,7 @@ create validForm cred = [ ( "title", Encode.string form.title ) , ( "description", Encode.string form.description ) , ( "body", Encode.string form.body ) - , ( "tagList", Encode.list Encode.string (tagsFromString form.tags) ) + , ( "tagList", Encode.list Encode.string (toTagList form.tags) ) ] jsonBody = @@ -451,20 +553,30 @@ create validForm cred = |> HttpBuilder.toRequest -tagsFromString : String -> List String -tagsFromString str = - str - |> String.split " " +toTagList : String -> List String +toTagList tagString = + {- 👉 TODO #2 of 2: add another |> to the end of this pipeline, + which filters out any remaining empty strings. + + To see if the bug is fixed, visit http://localhost:3000/#/editor + (you'll need to be logged in) and create an article with tags that have + multiple spaces between them, e.g. "tag1 tag2 tag3" + + If the bug has not been fixed, trying to save an article with those tags + will result in an error! If it has been fixed, saving will work and the + tags will be accepted. + + 💡 HINT: Here's how to remove all the "foo" strings from a list of strings: + + List.filter (\str -> str == "foo") listOfStrings + -} + String.split " " tagString |> List.map String.trim - |> List.filter (not << String.isEmpty) -edit : Slug -> Valid Form -> Cred -> Http.Request (Article Full) -edit articleSlug validForm cred = +edit : Slug -> TrimmedForm -> Cred -> Http.Request (Article Full) +edit articleSlug (Trimmed form) cred = let - form = - fromValid validForm - expect = Article.fullDecoder (Just cred) |> Decode.field "article" @@ -510,6 +622,9 @@ getSlug status = Loading slug -> Just slug + LoadingSlowly slug -> + Just slug + LoadingFailed slug -> Just slug diff --git a/advanced/part4/src/Page/Home.elm b/advanced/part4/src/Page/Home.elm index 9c38374..a4dea6d 100644 --- a/advanced/part4/src/Page/Home.elm +++ b/advanced/part4/src/Page/Home.elm @@ -36,6 +36,7 @@ type alias Model = type Status a = Loading + | LoadingSlowly | Loaded a | Failed @@ -66,6 +67,7 @@ init session = , Tag.list |> Http.send CompletedTagsLoad , Task.perform GotTimeZone Time.here + , Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold ] ) @@ -88,24 +90,30 @@ view model = viewFeed model.timeZone feed Loading -> + [] + + LoadingSlowly -> [ Loading.icon ] Failed -> [ Loading.error "feed" ] - , div [ class "col-md-3" ] - [ div [ class "sidebar" ] <| - case model.tags of - Loaded tags -> + , div [ class "col-md-3" ] <| + case model.tags of + Loaded tags -> + [ div [ class "sidebar" ] <| [ p [] [ text "Popular Tags" ] , viewTags tags ] + ] - Loading -> - [ Loading.icon ] + Loading -> + [] - Failed -> - [ Loading.error "tags" ] - ] + LoadingSlowly -> + [ Loading.icon ] + + Failed -> + [ Loading.error "tags" ] ] ] ] @@ -157,6 +165,7 @@ type Msg | GotTimeZone Time.Zone | GotFeedMsg Feed.Msg | GotSession Session + | PassedSlowLoadThreshold update : Msg -> Model -> ( Model, Cmd Msg ) @@ -197,6 +206,9 @@ update msg model = Loading -> ( model, Log.error ) + LoadingSlowly -> + ( model, Log.error ) + Failed -> ( model, Log.error ) @@ -206,6 +218,28 @@ update msg model = GotSession session -> ( { model | session = session }, Cmd.none ) + PassedSlowLoadThreshold -> + let + -- If any data is still Loading, change it to LoadingSlowly + -- so `view` knows to render a spinner. + feed = + case model.feed of + Loading -> + LoadingSlowly + + other -> + other + + tags = + case model.tags of + Loading -> + LoadingSlowly + + other -> + other + in + ( { model | feed = feed, tags = tags }, Cmd.none ) + -- SUBSCRIPTIONS diff --git a/advanced/part4/src/Page/Login.elm b/advanced/part4/src/Page/Login.elm index 134dfe0..c180017 100644 --- a/advanced/part4/src/Page/Login.elm +++ b/advanced/part4/src/Page/Login.elm @@ -3,7 +3,7 @@ module Page.Login exposing (Model, Msg, init, subscriptions, toSession, update, {-| The login page. -} -import Api exposing (optionalError) +import Api import Browser.Navigation as Nav import Html exposing (..) import Html.Attributes exposing (..) @@ -14,7 +14,6 @@ import Json.Decode.Pipeline exposing (optional) import Json.Encode as Encode import Route exposing (Route) import Session exposing (Session) -import Validate exposing (Valid, Validator, fromValid, ifBlank, validate) import Viewer exposing (Viewer) import Viewer.Cred as Cred exposing (Cred) @@ -25,11 +24,40 @@ import Viewer.Cred as Cred exposing (Cred) type alias Model = { session : Session - , errors : List Error + , problems : List Problem , form : Form } +{-| Recording validation problems on a per-field basis facilitates displaying +them inline next to the field where the error occurred. + +I implemented it this way out of habit, then realized the spec called for +displaying all the errors at the top. I thought about simplifying it, but then +figured it'd be useful to show how I would normally model this data - assuming +the intended UX was to render errors per field. + +(The other part of this is having a view function like this: + +viewFieldErrors : ValidatedField -> List Problem -> Html msg + +...and it filters the list of problems to render only InvalidEntry ones for the +given ValidatedField. That way you can call this: + +viewFieldErrors Email problems + +...next to the `email` field, and call `viewFieldErrors Password problems` +next to the `password` field, and so on. + +The `LoginError` should be displayed elsewhere, since it doesn't correspond to +a particular field. + +-} +type Problem + = InvalidEntry ValidatedField String + | ServerError String + + type alias Form = { email : String , password : String @@ -39,7 +67,7 @@ type alias Form = init : Session -> ( Model, Cmd msg ) init session = ( { session = session - , errors = [] + , problems = [] , form = { email = "" , password = "" @@ -66,8 +94,8 @@ view model = [ a [ Route.href Route.Register ] [ text "Need an account?" ] ] - , ul [ class "error-messages" ] <| - List.map (\( _, error ) -> li [] [ text error ]) model.errors + , ul [ class "error-messages" ] + (List.map viewProblem model.problems) , viewForm model.form ] ] @@ -76,6 +104,20 @@ view model = } +viewProblem : Problem -> Html msg +viewProblem problem = + let + errorMessage = + case problem of + InvalidEntry _ str -> + str + + ServerError str -> + str + in + li [] [ text errorMessage ] + + viewForm : Form -> Html Msg viewForm form = Html.form [ onSubmit SubmittedForm ] @@ -119,14 +161,14 @@ update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of SubmittedForm -> - case validate formValidator model.form of + case validate model.form of Ok validForm -> - ( { model | errors = [] } + ( { model | problems = [] } , Http.send CompletedLogin (login validForm) ) - Err errors -> - ( { model | errors = errors } + Err problems -> + ( { model | problems = problems } , Cmd.none ) @@ -139,22 +181,22 @@ update msg model = CompletedLogin (Err error) -> let serverErrors = - error - |> Api.listErrors errorsDecoder - |> List.map (\errorMessage -> ( Server, errorMessage )) - |> List.append model.errors + Api.decodeErrors error + |> List.map ServerError in - ( { model | errors = List.append model.errors serverErrors } + ( { model | problems = List.append model.problems serverErrors } , Cmd.none ) - CompletedLogin (Ok cred) -> + CompletedLogin (Ok viewer) -> ( model - , Session.login cred + , Session.login viewer ) GotSession session -> - ( { model | session = session }, Cmd.none ) + ( { model | session = session } + , Route.replaceUrl (Session.navKey session) Route.Home + ) {-| Helper function for `update`. Updates the form and returns Cmd.none and @@ -175,67 +217,83 @@ subscriptions model = --- VALIDATION +-- FORM -type ErrorSource - = Server - | Email +{-| Marks that we've trimmed the form's fields, so we don't accidentally send +it to the server without having trimmed it! +-} +type TrimmedForm + = Trimmed Form + + +{-| When adding a variant here, add it to `fieldsToValidate` too! +-} +type ValidatedField + = Email | Password -{-| Recording validation errors on a per-field basis facilitates displaying -them inline next to the field where the error occurred. +fieldsToValidate : List ValidatedField +fieldsToValidate = + [ Email + , Password + ] -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. +{-| Trim the form and validate its fields. If there are problems, report them! -} -type alias Error = - ( ErrorSource, String ) +validate : Form -> Result (List Problem) TrimmedForm +validate form = + let + trimmedForm = + trimFields form + in + case List.concatMap (validateField trimmedForm) fieldsToValidate of + [] -> + Ok trimmedForm + + problems -> + Err problems -formValidator : Validator Error Form -formValidator = - Validate.all - [ ifBlank .email ( Email, "email can't be blank." ) - , ifBlank .password ( Password, "password can't be blank." ) - ] +validateField : TrimmedForm -> ValidatedField -> List Problem +validateField (Trimmed form) field = + List.map (InvalidEntry field) <| + case field of + Email -> + if String.isEmpty form.email then + [ "email can't be blank." ] + + else + [] + + Password -> + if String.isEmpty form.password then + [ "password can't be blank." ] + + else + [] -errorsDecoder : Decoder (List String) -errorsDecoder = - Decode.succeed (\emailOrPassword email username password -> List.concat [ emailOrPassword, email, username, password ]) - |> optionalError "email or password" - |> optionalError "email" - |> optionalError "username" - |> optionalError "password" +{-| Don't trim while the user is typing! That would be super annoying. +Instead, trim only on submit. +-} +trimFields : Form -> TrimmedForm +trimFields form = + Trimmed + { email = String.trim form.email + , password = String.trim form.password + } -- HTTP -login : Valid Form -> Http.Request Viewer -login validForm = +login : TrimmedForm -> Http.Request Viewer +login (Trimmed form) = let - form = - fromValid validForm - user = Encode.object [ ( "email", Encode.string form.email ) diff --git a/advanced/part4/src/Page/NotFound.elm b/advanced/part4/src/Page/NotFound.elm index 35b03c5..e0c534b 100644 --- a/advanced/part4/src/Page/NotFound.elm +++ b/advanced/part4/src/Page/NotFound.elm @@ -1,6 +1,6 @@ module Page.NotFound exposing (view) -import Assets +import Asset import Html exposing (Html, div, h1, img, main_, text) import Html.Attributes exposing (alt, class, id, src, tabindex) @@ -16,6 +16,6 @@ view = main_ [ id "content", class "container", tabindex -1 ] [ h1 [] [ text "Not Found" ] , div [ class "row" ] - [ img [ Assets.src Assets.error ] [] ] + [ img [ Asset.src Asset.error ] [] ] ] } diff --git a/advanced/part4/src/Page/Profile.elm b/advanced/part4/src/Page/Profile.elm index a9d59b1..af86830 100644 --- a/advanced/part4/src/Page/Profile.elm +++ b/advanced/part4/src/Page/Profile.elm @@ -3,7 +3,7 @@ module Page.Profile exposing (Model, Msg, init, subscriptions, toSession, update {-| An Author's profile. -} -import Article.Feed as Feed exposing (ListConfig) +import Article.Feed as Feed import Article.FeedSources as FeedSources exposing (FeedSources, Source(..)) import Author exposing (Author(..), FollowedAuthor, UnfollowedAuthor) import Avatar exposing (Avatar) @@ -14,6 +14,7 @@ import Loading import Log import Page import Profile exposing (Profile) +import Route import Session exposing (Session) import Task exposing (Task) import Time @@ -39,6 +40,7 @@ type alias Model = type Status a = Loading Username + | LoadingSlowly Username | Loaded a | Failed Username @@ -65,6 +67,7 @@ init session username = |> Task.mapError (Tuple.pair username) |> Task.attempt CompletedFeedLoad , Task.perform GotTimeZone Time.here + , Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold ] ) @@ -88,19 +91,13 @@ view model = titleForOther (Author.username author) Loading username -> - if Just username == Maybe.map Cred.username (Session.cred model.session) then - myProfileTitle + titleForMe (Session.cred model.session) username - else - defaultTitle + LoadingSlowly username -> + titleForMe (Session.cred model.session) username Failed username -> - -- We can't follow if it hasn't finished loading yet - if Just username == Maybe.map Cred.username (Session.cred model.session) then - myProfileTitle - - else - defaultTitle + titleForMe (Session.cred model.session) username in { title = title , content = @@ -122,10 +119,10 @@ view model = text "" IsFollowing followedAuthor -> - Author.unfollowButton (ClickedUnfollow cred) followedAuthor + Author.unfollowButton ClickedUnfollow cred followedAuthor IsNotFollowing unfollowedAuthor -> - Author.followButton (ClickedFollow cred) unfollowedAuthor + Author.followButton ClickedFollow cred unfollowedAuthor Nothing -> -- We can't follow if we're logged out @@ -151,6 +148,9 @@ view model = [ div [ class "row" ] [ viewFeed model.timeZone feed ] ] Loading _ -> + text "" + + LoadingSlowly _ -> Loading.icon Failed _ -> @@ -158,6 +158,9 @@ view model = ] Loading _ -> + text "" + + LoadingSlowly _ -> Loading.icon Failed _ -> @@ -174,6 +177,20 @@ titleForOther otherUsername = "Profile — " ++ Username.toString otherUsername +titleForMe : Maybe Cred -> Username -> String +titleForMe maybeCred username = + case maybeCred of + Just cred -> + if username == Cred.username cred then + myProfileTitle + + else + defaultTitle + + Nothing -> + defaultTitle + + myProfileTitle : String myProfileTitle = "My Profile" @@ -210,6 +227,7 @@ type Msg | GotTimeZone Time.Zone | GotFeedMsg Feed.Msg | GotSession Session + | PassedSlowLoadThreshold update : Msg -> Model -> ( Model, Cmd Msg ) @@ -272,6 +290,9 @@ update msg model = Loading _ -> ( model, Log.error ) + LoadingSlowly _ -> + ( model, Log.error ) + Failed _ -> ( model, Log.error ) @@ -279,7 +300,23 @@ update msg model = ( { model | timeZone = tz }, Cmd.none ) GotSession session -> - ( { model | session = session }, Cmd.none ) + ( { model | session = session } + , Route.replaceUrl (Session.navKey session) Route.Home + ) + + PassedSlowLoadThreshold -> + let + -- If any data is still Loading, change it to LoadingSlowly + -- so `view` knows to render a spinner. + feed = + case model.feed of + Loading username -> + LoadingSlowly username + + other -> + other + in + ( { model | feed = feed }, Cmd.none ) diff --git a/advanced/part4/src/Page/Register.elm b/advanced/part4/src/Page/Register.elm index 05bd8c2..f2f31e2 100644 --- a/advanced/part4/src/Page/Register.elm +++ b/advanced/part4/src/Page/Register.elm @@ -1,6 +1,6 @@ module Page.Register exposing (Model, Msg, init, subscriptions, toSession, update, view) -import Api exposing (optionalError) +import Api import Browser.Navigation as Nav import Html exposing (..) import Html.Attributes exposing (..) @@ -11,7 +11,6 @@ import Json.Decode.Pipeline exposing (optional) import Json.Encode as Encode import Route exposing (Route) import Session exposing (Session) -import Validate exposing (Valid, Validator, fromValid, ifBlank, validate) import Viewer exposing (Viewer) import Viewer.Cred as Cred exposing (Cred) @@ -22,7 +21,7 @@ import Viewer.Cred as Cred exposing (Cred) type alias Model = { session : Session - , errors : List Error + , problems : List Problem , form : Form } @@ -34,10 +33,15 @@ type alias Form = } +type Problem + = InvalidEntry ValidatedField String + | ServerError String + + init : Session -> ( Model, Cmd msg ) init session = ( { session = session - , errors = [] + , problems = [] , form = { email = "" , username = "" @@ -65,9 +69,8 @@ view model = [ a [ Route.href Route.Login ] [ text "Have an account?" ] ] - , model.errors - |> List.map (\( _, error ) -> li [] [ text error ]) - |> ul [ class "error-messages" ] + , ul [ class "error-messages" ] + (List.map viewProblem model.problems) , viewForm model.form ] ] @@ -112,6 +115,20 @@ viewForm form = ] +viewProblem : Problem -> Html msg +viewProblem problem = + let + errorMessage = + case problem of + InvalidEntry _ str -> + str + + ServerError str -> + str + in + li [] [ text errorMessage ] + + -- UPDATE @@ -129,14 +146,14 @@ update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of SubmittedForm -> - case validate formValidator model.form of + case validate model.form of Ok validForm -> - ( { model | errors = [] } + ( { model | problems = [] } , Http.send CompletedRegister (register validForm) ) - Err errors -> - ( { model | errors = errors } + Err problems -> + ( { model | problems = problems } , Cmd.none ) @@ -152,21 +169,22 @@ update msg model = CompletedRegister (Err error) -> let serverErrors = - error - |> Api.listErrors errorsDecoder - |> List.map (\errorMessage -> ( Server, errorMessage )) + Api.decodeErrors error + |> List.map ServerError in - ( { model | errors = List.append model.errors serverErrors } + ( { model | problems = List.append model.problems serverErrors } , Cmd.none ) - CompletedRegister (Ok cred) -> + CompletedRegister (Ok viewer) -> ( model - , Session.login cred + , Session.login viewer ) GotSession session -> - ( { model | session = session }, Cmd.none ) + ( { model | session = session } + , Route.replaceUrl (Session.navKey session) Route.Home + ) {-| Helper function for `update`. Updates the form and returns Cmd.none and @@ -196,61 +214,96 @@ toSession model = --- VALIDATION +-- FORM -type ErrorSource - = Server - | Username +{-| Marks that we've trimmed the form's fields, so we don't accidentally send +it to the server without having trimmed it! +-} +type TrimmedForm + = Trimmed Form + + +{-| When adding a variant here, add it to `fieldsToValidate` too! +-} +type ValidatedField + = Username | Email | Password -type alias Error = - ( ErrorSource, String ) +fieldsToValidate : List ValidatedField +fieldsToValidate = + [ Username + , Email + , Password + ] -formValidator : Validator Error Form -formValidator = - Validate.all - [ ifBlank .username ( Username, "username can't be blank." ) - , ifBlank .email ( Email, "email can't be blank." ) - , Validate.fromErrors passwordLength - ] +{-| Trim the form and validate its fields. If there are problems, report them! +-} +validate : Form -> Result (List Problem) TrimmedForm +validate form = + let + trimmedForm = + trimFields form + in + case List.concatMap (validateField trimmedForm) fieldsToValidate of + [] -> + Ok trimmedForm + + problems -> + Err problems -minPasswordChars : Int -minPasswordChars = - 6 +validateField : TrimmedForm -> ValidatedField -> List Problem +validateField (Trimmed form) field = + List.map (InvalidEntry field) <| + case field of + Username -> + if String.isEmpty form.username then + [ "username can't be blank." ] + + else + [] + + Email -> + if String.isEmpty form.email then + [ "email can't be blank." ] + + else + [] + + Password -> + if String.isEmpty form.password then + [ "password can't be blank." ] + + else if String.length form.password < Viewer.minPasswordChars then + [ "password must be at least " ++ String.fromInt Viewer.minPasswordChars ++ " characters long." ] + + else + [] -passwordLength : Form -> List Error -passwordLength { password } = - if String.length password < minPasswordChars then - [ ( Password, "password must be at least " ++ String.fromInt minPasswordChars ++ " characters long." ) ] - - else - [] - - -errorsDecoder : Decoder (List String) -errorsDecoder = - Decode.succeed (\email username password -> List.concat [ email, username, password ]) - |> optionalError "email" - |> optionalError "username" - |> optionalError "password" +{-| Don't trim while the user is typing! That would be super annoying. +Instead, trim only on submit. +-} +trimFields : Form -> TrimmedForm +trimFields form = + Trimmed + { username = String.trim form.username + , email = String.trim form.email + , password = String.trim form.password + } -- HTTP -register : Valid Form -> Http.Request Viewer -register validForm = +register : TrimmedForm -> Http.Request Viewer +register (Trimmed form) = let - form = - fromValid validForm - user = Encode.object [ ( "username", Encode.string form.username ) diff --git a/advanced/part4/src/Page/Settings.elm b/advanced/part4/src/Page/Settings.elm index 87220d7..fdea129 100644 --- a/advanced/part4/src/Page/Settings.elm +++ b/advanced/part4/src/Page/Settings.elm @@ -1,6 +1,6 @@ module Page.Settings exposing (Model, Msg, init, subscriptions, toSession, update, view) -import Api exposing (optionalError) +import Api import Avatar import Browser.Navigation as Nav import Email exposing (Email) @@ -16,7 +16,6 @@ import Profile exposing (Profile) import Route import Session exposing (Session) import Username as Username exposing (Username) -import Validate exposing (Valid, Validator, fromValid, ifBlank, validate) import Viewer exposing (Viewer) import Viewer.Cred as Cred exposing (Cred) @@ -27,24 +26,29 @@ import Viewer.Cred as Cred exposing (Cred) type alias Model = { session : Session - , errors : List Error + , problems : List Problem , form : Form } type alias Form = - { avatar : Maybe String + { avatar : String , bio : String , email : String , username : String - , password : Maybe String + , password : String } +type Problem + = InvalidEntry ValidatedField String + | ServerError String + + init : Session -> ( Model, Cmd msg ) init session = ( { session = session - , errors = [] + , problems = [] , form = case Session.viewer session of Just viewer -> @@ -55,21 +59,21 @@ init session = cred = Viewer.cred viewer in - { avatar = Avatar.toMaybeString (Profile.avatar profile) + { avatar = Maybe.withDefault "" (Avatar.toMaybeString (Profile.avatar profile)) , email = Email.toString (Viewer.email viewer) , bio = Maybe.withDefault "" (Profile.bio profile) , username = Username.toString (Cred.username cred) - , password = Nothing + , password = "" } Nothing -> -- It's fine to store a blank form here. You won't be -- able to submit it if you're not logged in anyway. - { avatar = Nothing + { avatar = "" , email = "" , bio = "" , username = "" - , password = Nothing + , password = "" } } , Cmd.none @@ -103,9 +107,8 @@ view model = [ div [ class "row" ] [ div [ class "col-md-6 offset-md-3 col-xs-12" ] [ h1 [ class "text-xs-center" ] [ text "Your Settings" ] - , model.errors - |> List.map (\( _, error ) -> li [] [ text error ]) - |> ul [ class "error-messages" ] + , ul [ class "error-messages" ] + (List.map viewProblem model.problems) , viewForm cred model.form ] ] @@ -125,8 +128,8 @@ viewForm cred form = [ input [ class "form-control" , placeholder "URL of profile picture" - , value (Maybe.withDefault "" form.avatar) - , onInput EnteredImage + , value form.avatar + , onInput EnteredAvatar ] [] ] @@ -163,7 +166,7 @@ viewForm cred form = [ class "form-control form-control-lg" , type_ "password" , placeholder "Password" - , value (Maybe.withDefault "" form.password) + , value form.password , onInput EnteredPassword ] [] @@ -175,6 +178,20 @@ viewForm cred form = ] +viewProblem : Problem -> Html msg +viewProblem problem = + let + errorMessage = + case problem of + InvalidEntry _ message -> + message + + ServerError message -> + message + in + li [] [ text errorMessage ] + + -- UPDATE @@ -185,7 +202,7 @@ type Msg | EnteredUsername String | EnteredPassword String | EnteredBio String - | EnteredImage String + | EnteredAvatar String | CompletedSave (Result Http.Error Viewer) | GotSession Session @@ -194,15 +211,15 @@ update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of SubmittedForm cred -> - case validate formValidator model.form of + case validate model.form of Ok validForm -> - ( { model | errors = [] } + ( { model | problems = [] } , edit cred validForm |> Http.send CompletedSave ) - Err errors -> - ( { model | errors = errors } + Err problems -> + ( { model | problems = problems } , Cmd.none ) @@ -212,39 +229,22 @@ update msg model = EnteredUsername username -> updateForm (\form -> { form | username = username }) model - EnteredPassword passwordStr -> - let - password = - if String.isEmpty passwordStr then - Nothing - - else - Just passwordStr - in + EnteredPassword password -> updateForm (\form -> { form | password = password }) model EnteredBio bio -> updateForm (\form -> { form | bio = bio }) model - EnteredImage avatarStr -> - let - avatar = - if String.isEmpty avatarStr then - Nothing - - else - Just avatarStr - in + EnteredAvatar avatar -> updateForm (\form -> { form | avatar = avatar }) model CompletedSave (Err error) -> let serverErrors = - error - |> Api.listErrors errorsDecoder - |> List.map (\errorMessage -> ( Server, errorMessage )) + Api.decodeErrors error + |> List.map ServerError in - ( { model | errors = List.append model.errors serverErrors } + ( { model | problems = List.append model.problems serverErrors } , Cmd.none ) @@ -254,7 +254,9 @@ update msg model = ) GotSession session -> - ( { model | session = session }, Cmd.none ) + ( { model | session = session } + , Route.replaceUrl (Session.navKey session) Route.Home + ) {-| Helper function for `update`. Updates the form and returns Cmd.none and @@ -284,36 +286,93 @@ toSession model = --- VALIDATION +-- FORM -type ErrorSource - = Server - | Username +{-| Marks that we've trimmed the form's fields, so we don't accidentally send +it to the server without having trimmed it! +-} +type TrimmedForm + = Trimmed Form + + +{-| When adding a variant here, add it to `fieldsToValidate` too! + +NOTE: there are no ImageUrl or Bio variants here, because they aren't validated! + +-} +type ValidatedField + = Username | Email | Password - | ImageUrl - | Bio -type alias Error = - ( ErrorSource, String ) +fieldsToValidate : List ValidatedField +fieldsToValidate = + [ Username + , Email + , Password + ] -formValidator : Validator Error Form -formValidator = - Validate.all - [ ifBlank .username ( Username, "username can't be blank." ) - , ifBlank .email ( Email, "email can't be blank." ) - ] +{-| Trim the form and validate its fields. If there are problems, report them! +-} +validate : Form -> Result (List Problem) TrimmedForm +validate form = + let + trimmedForm = + trimFields form + in + case List.concatMap (validateField trimmedForm) fieldsToValidate of + [] -> + Ok trimmedForm + + problems -> + Err problems -errorsDecoder : Decoder (List String) -errorsDecoder = - Decode.succeed (\email username password -> List.concat [ email, username, password ]) - |> optionalError "email" - |> optionalError "username" - |> optionalError "password" +validateField : TrimmedForm -> ValidatedField -> List Problem +validateField (Trimmed form) field = + List.map (InvalidEntry field) <| + case field of + Username -> + if String.isEmpty form.username then + [ "username can't be blank." ] + + else + [] + + Email -> + if String.isEmpty form.email then + [ "email can't be blank." ] + + else + [] + + Password -> + let + passwordLength = + String.length form.password + in + if passwordLength > 0 && passwordLength < Viewer.minPasswordChars then + [ "password must be at least " ++ String.fromInt Viewer.minPasswordChars ++ " characters long." ] + + else + [] + + +{-| Don't trim while the user is typing! That would be super annoying. +Instead, trim only on submit. +-} +trimFields : Form -> TrimmedForm +trimFields form = + Trimmed + { avatar = String.trim form.avatar + , bio = String.trim form.bio + , email = String.trim form.email + , username = String.trim form.username + , password = String.trim form.password + } @@ -323,25 +382,35 @@ errorsDecoder = {-| This takes a Valid Form as a reminder that it needs to have been validated first. -} -edit : Cred -> Valid Form -> Http.Request Viewer -edit cred validForm = +edit : Cred -> TrimmedForm -> Http.Request Viewer +edit cred (Trimmed form) = let - form = - fromValid validForm + encodedAvatar = + case form.avatar of + "" -> + Encode.null + + avatar -> + Encode.string avatar updates = - [ Just ( "username", Encode.string form.username ) - , Just ( "email", Encode.string form.email ) - , Just ( "bio", Encode.string form.bio ) - , Just ( "image", Maybe.withDefault Encode.null (Maybe.map Encode.string form.avatar) ) - , Maybe.map (\pass -> ( "password", Encode.string pass )) form.password + [ ( "username", Encode.string form.username ) + , ( "email", Encode.string form.email ) + , ( "bio", Encode.string form.bio ) + , ( "image", encodedAvatar ) ] - |> List.filterMap identity + + encodedUser = + Encode.object <| + case form.password of + "" -> + updates + + password -> + ( "password", Encode.string password ) :: updates body = - ( "user", Encode.object updates ) - |> List.singleton - |> Encode.object + Encode.object [ ( "user", encodedUser ) ] |> Http.jsonBody expect = @@ -354,3 +423,12 @@ edit cred validForm = |> HttpBuilder.withBody body |> Cred.addHeader cred |> HttpBuilder.toRequest + + +nothingIfEmpty : String -> Maybe String +nothingIfEmpty str = + if String.isEmpty str then + Nothing + + else + Just str diff --git a/advanced/part4/src/Session.elm b/advanced/part4/src/Session.elm index 89c93e4..ee70a0c 100644 --- a/advanced/part4/src/Session.elm +++ b/advanced/part4/src/Session.elm @@ -45,7 +45,12 @@ viewer session = cred : Session -> Maybe Cred cred session = - Maybe.map Viewer.cred (viewer session) + case session of + LoggedIn _ val -> + Just (Viewer.cred val) + + Guest _ -> + Nothing navKey : Session -> Nav.Key diff --git a/advanced/part4/src/Viewer.elm b/advanced/part4/src/Viewer.elm index f8480c7..7ecfedb 100644 --- a/advanced/part4/src/Viewer.elm +++ b/advanced/part4/src/Viewer.elm @@ -1,4 +1,4 @@ -module Viewer exposing (Viewer, cred, decoder, email, encode, profile) +module Viewer exposing (Viewer, cred, decoder, email, encode, minPasswordChars, profile) {-| The logged-in user currently viewing this page. -} @@ -47,6 +47,13 @@ email (Viewer info) = info.email +{-| Passwords must be at least this many characters long! +-} +minPasswordChars : Int +minPasswordChars = + 6 + + -- SERIALIZATION @@ -56,9 +63,16 @@ encode (Viewer info) = Encode.object [ ( "email", Email.encode info.email ) , ( "username", Username.encode (Cred.username info.cred) ) - , ( "bio", Maybe.withDefault Encode.null (Maybe.map Encode.string (Profile.bio info.profile)) ) , ( "image", Avatar.encode (Profile.avatar info.profile) ) , ( "token", Cred.encodeToken info.cred ) + , ( "bio" + , case Profile.bio info.profile of + Just bio -> + Encode.string bio + + Nothing -> + Encode.null + ) ]