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

Update part1

Browse Source
This commit is contained in:
Richard Feldman
2018-08-13 05:11:14 -04:00
parent 493b5681d4
commit 1688e5ec38
19 changed files with 854 additions and 530 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
advanced/part1/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
]
)
@@ -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 )

211
advanced/part1/src/Page/Article/Editor.elm
View File

@@ -19,7 +19,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 +37,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 +79,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 +114,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 +151,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 +250,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 +280,7 @@ update msg model =
)
CompletedCreate (Err error) ->
( { model | status = savingError model.status }
( { model | status = savingError error model.status }
, Cmd.none
)
@@ -263,7 +291,7 @@ update msg model =
)
CompletedEdit (Err error) ->
( { model | status = savingError model.status }
( { model | status = savingError error model.status }
, Cmd.none
)
@@ -291,35 +319,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 +377,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 +411,9 @@ updateForm transform model =
Loading _ ->
model
LoadingSlowly _ ->
model
LoadingFailed _ ->
model
@@ -395,37 +442,85 @@ 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
[]
{-| 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"
@@ -459,12 +554,9 @@ tagsFromString str =
|> 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 +602,9 @@ getSlug status =
Loading slug ->
Just slug
LoadingSlowly slug ->
Just slug
LoadingFailed slug ->
Just slug

52
advanced/part1/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
]
)
@@ -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

178
advanced/part1/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/part1/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/part1/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 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/part1/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 )

232
advanced/part1/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
, 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