cerchez07/elm-0.19-workshop
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Update part3

Browse Source
This commit is contained in:
Richard Feldman
2018-08-13 05:49:56 -04:00
parent 50da3881b1
commit bd72768e6f
21 changed files with 954 additions and 593 deletions
Download Patch File Download Diff File Expand all files Collapse all files

106
advanced/part3/src/Page/Article.elm
View File

@@ -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
]
)
@@ -86,10 +87,6 @@ init session slug =
view : Model -> { title : String, content : Html Msg }
view model =
let
buttons =
viewButtons model
in
case model.article of
Loaded article ->
let
@@ -107,6 +104,14 @@ view model =
profile =
Author.profile author
buttons =
case Session.cred model.session of
Just cred ->
viewButtons cred article author
Nothing ->
[]
in
{ title = title
, content =
@@ -150,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 ) ->
@@ -168,6 +176,9 @@ view model =
}
Loading ->
{ title = "Article", content = text "" }
LoadingSlowly ->
{ title = "Article", content = Loading.icon }
Failed ->
@@ -220,48 +231,26 @@ viewAddComment slug commentText maybeViewer =
]
{-| 👉 TODO refactor this to accept narrower types than the entire Model.
viewButtons : Cred -> Article Full -> Author -> List (Html Msg)
viewButtons cred article author =
case author of
IsFollowing followedAuthor ->
[ Author.unfollowButton ClickedUnfollow cred followedAuthor
, text " "
, favoriteButton cred article
]
💡 HINT: It may end up with multiple arguments!
IsNotFollowing unfollowedAuthor ->
[ Author.followButton ClickedFollow cred unfollowedAuthor
, text " "
, favoriteButton cred article
]
-}
viewButtons : Model -> List (Html Msg)
viewButtons model =
case Session.cred model.session of
Just cred ->
case model.article of
Loaded article ->
let
author =
Article.author article
in
case author of
IsFollowing followedAuthor ->
[ Author.unfollowButton (ClickedUnfollow cred) followedAuthor
, text " "
, favoriteButton cred article
]
IsNotFollowing unfollowedAuthor ->
[ Author.followButton (ClickedFollow cred) unfollowedAuthor
, text " "
, favoriteButton cred article
]
IsViewer _ _ ->
[ editButton article
, text " "
, deleteButton cred article
]
Loading ->
[]
Failed ->
[]
Nothing ->
[]
IsViewer _ _ ->
[ editButton article
, text " "
, deleteButton cred article
]
viewComment : Time.Zone -> Slug -> Comment -> Html Msg
@@ -336,6 +325,7 @@ type Msg
| CompletedPostComment (Result Http.Error Comment)
| GotTimeZone Time.Zone
| GotSession Session
| PassedSlowLoadThreshold
update : Msg -> Model -> ( Model, Cmd Msg )
@@ -486,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 )

243
advanced/part3/src/Page/Article/Editor.elm
View File

@@ -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

54
advanced/part3/src/Page/Home.elm
View File

@@ -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
]
)
@@ -84,20 +86,23 @@ view model =
[ div [ class "row" ]
[ div [ class "col-md-9" ]
(viewFeed model)
, 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" ]
]
]
]
@@ -115,9 +120,7 @@ viewBanner =
{-| 👉 TODO refactor this to accept narrower types than the entire Model.
💡 HINT: It may end up with multiple arguments!
-}
viewFeed : Model -> List (Html Msg)
viewFeed model =
@@ -128,6 +131,9 @@ viewFeed model =
:: (Feed.viewArticles model.timeZone feed |> List.map (Html.map GotFeedMsg))
Loading ->
[]
LoadingSlowly ->
[ Loading.icon ]
Failed ->
@@ -162,6 +168,7 @@ type Msg
| GotTimeZone Time.Zone
| GotFeedMsg Feed.Msg
| GotSession Session
| PassedSlowLoadThreshold
update : Msg -> Model -> ( Model, Cmd Msg )
@@ -202,6 +209,9 @@ update msg model =
Loading ->
( model, Log.error )
LoadingSlowly ->
( model, Log.error )
Failed ->
( model, Log.error )
@@ -211,6 +221,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

178
advanced/part3/src/Page/Login.elm
View File

@@ -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 )

4
advanced/part3/src/Page/NotFound.elm
View File

@@ -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 ] [] ]
]
}

65
advanced/part3/src/Page/Profile.elm
View File

@@ -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 .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 .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 )

161
advanced/part3/src/Page/Register.elm
View File

@@ -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 )

236
advanced/part3/src/Page/Settings.elm
View File

@@ -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
, password = Nothing
, username = Username.toString (Cred.username cred)
, password = ""
}
Nothing ->
-- It's fine to store a blank form here. You won't be
-- able to submit it if you're not logged in anyway.
{ avatar = Nothing
{ avatar = ""
, email = ""
, bio = ""
, username = ""
, password = Nothing
, password = ""
}
}
, Cmd.none
@@ -107,9 +111,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)
, form
]
]
@@ -122,9 +125,7 @@ view model =
{-| 👉 TODO refactor this to accept narrower types than the entire Model.
💡 HINT: It may end up with multiple arguments!
-}
viewForm : Model -> Html Msg
viewForm model =
@@ -143,8 +144,8 @@ viewForm model =
[ input
[ class "form-control"
, placeholder "URL of profile picture"
, value (Maybe.withDefault "" form.avatar)
, onInput EnteredImage
, value form.avatar
, onInput EnteredAvatar
]
[]
]
@@ -181,7 +182,7 @@ viewForm model =
[ class "form-control form-control-lg"
, type_ "password"
, placeholder "Password"
, value (Maybe.withDefault "" form.password)
, value form.password
, onInput EnteredPassword
]
[]
@@ -193,6 +194,20 @@ viewForm model =
]
viewProblem : Problem -> Html msg
viewProblem problem =
let
errorMessage =
case problem of
InvalidEntry _ message ->
message
ServerError message ->
message
in
li [] [ text errorMessage ]
-- UPDATE
@@ -203,7 +218,7 @@ type Msg
| EnteredUsername String
| EnteredPassword String
| EnteredBio String
| EnteredImage String
| EnteredAvatar String
| CompletedSave (Result Http.Error Viewer)
| GotSession Session
@@ -212,15 +227,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
)
@@ -230,39 +245,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
)
@@ -272,7 +270,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
@@ -302,36 +302,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
}
@@ -341,25 +398,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 =
@@ -372,3 +439,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