Add part6
This commit is contained in:
Richard Feldman
434
advanced/part6/src/Page/Settings.elm
Normal file
434
advanced/part6/src/Page/Settings.elm
Normal file
@@ -0,0 +1,434 @@
|
||||
module Page.Settings exposing (Model, Msg, init, subscriptions, toSession, update, view)
|
||||
|
||||
import Api
|
||||
import Avatar
|
||||
import Browser.Navigation as Nav
|
||||
import Email exposing (Email)
|
||||
import Html exposing (Html, button, div, fieldset, h1, input, li, text, textarea, ul)
|
||||
import Html.Attributes exposing (attribute, class, placeholder, type_, value)
|
||||
import Html.Events exposing (onInput, onSubmit)
|
||||
import Http
|
||||
import HttpBuilder
|
||||
import Json.Decode as Decode exposing (Decoder, decodeString, field, list, string)
|
||||
import Json.Decode.Pipeline exposing (optional)
|
||||
import Json.Encode as Encode
|
||||
import Profile exposing (Profile)
|
||||
import Route
|
||||
import Session exposing (Session)
|
||||
import Username as Username exposing (Username)
|
||||
import Viewer exposing (Viewer)
|
||||
import Viewer.Cred as Cred exposing (Cred)
|
||||
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ session : Session
|
||||
, problems : List Problem
|
||||
, form : Form
|
||||
}
|
||||
|
||||
|
||||
type alias Form =
|
||||
{ avatar : String
|
||||
, bio : String
|
||||
, email : String
|
||||
, username : String
|
||||
, password : String
|
||||
}
|
||||
|
||||
|
||||
type Problem
|
||||
= InvalidEntry ValidatedField String
|
||||
| ServerError String
|
||||
|
||||
|
||||
init : Session -> ( Model, Cmd msg )
|
||||
init session =
|
||||
( { session = session
|
||||
, problems = []
|
||||
, form =
|
||||
case Session.viewer session of
|
||||
Just viewer ->
|
||||
let
|
||||
profile =
|
||||
Viewer.profile viewer
|
||||
|
||||
cred =
|
||||
Viewer.cred viewer
|
||||
in
|
||||
{ avatar = Maybe.withDefault "" (Avatar.toMaybeString (Profile.avatar profile))
|
||||
, email = Email.toString (Viewer.email viewer)
|
||||
, bio = Maybe.withDefault "" (Profile.bio profile)
|
||||
, username = Username.toString (Cred.username cred)
|
||||
, password = ""
|
||||
}
|
||||
|
||||
Nothing ->
|
||||
-- It's fine to store a blank form here. You won't be
|
||||
-- able to submit it if you're not logged in anyway.
|
||||
{ avatar = ""
|
||||
, email = ""
|
||||
, bio = ""
|
||||
, username = ""
|
||||
, password = ""
|
||||
}
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
|
||||
{-| A form that has been validated. Only the `edit` function uses this. Its
|
||||
purpose is to prevent us from forgetting to validate the form before passing
|
||||
it to `edit`.
|
||||
|
||||
This doesn't create any guarantees that the form was actually validated. If
|
||||
we wanted to do that, we'd need to move the form data into a separate module!
|
||||
|
||||
-}
|
||||
type ValidForm
|
||||
= Valid Form
|
||||
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
view : Model -> { title : String, content : Html Msg }
|
||||
view model =
|
||||
{ title = "Settings"
|
||||
, content =
|
||||
case Session.cred model.session of
|
||||
Just cred ->
|
||||
div [ class "settings-page" ]
|
||||
[ div [ class "container page" ]
|
||||
[ div [ class "row" ]
|
||||
[ div [ class "col-md-6 offset-md-3 col-xs-12" ]
|
||||
[ h1 [ class "text-xs-center" ] [ text "Your Settings" ]
|
||||
, ul [ class "error-messages" ]
|
||||
(List.map viewProblem model.problems)
|
||||
, viewForm cred model.form
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
Nothing ->
|
||||
text "Sign in to view your settings."
|
||||
}
|
||||
|
||||
|
||||
viewForm : Cred -> Form -> Html Msg
|
||||
viewForm cred form =
|
||||
Html.form [ onSubmit (SubmittedForm cred) ]
|
||||
[ fieldset []
|
||||
[ fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control"
|
||||
, placeholder "URL of profile picture"
|
||||
, value form.avatar
|
||||
, onInput EnteredAvatar
|
||||
]
|
||||
[]
|
||||
]
|
||||
, fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control form-control-lg"
|
||||
, placeholder "Username"
|
||||
, value form.username
|
||||
, onInput EnteredUsername
|
||||
]
|
||||
[]
|
||||
]
|
||||
, fieldset [ class "form-group" ]
|
||||
[ textarea
|
||||
[ class "form-control form-control-lg"
|
||||
, placeholder "Short bio about you"
|
||||
, attribute "rows" "8"
|
||||
, value form.bio
|
||||
, onInput EnteredBio
|
||||
]
|
||||
[]
|
||||
]
|
||||
, fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control form-control-lg"
|
||||
, placeholder "Email"
|
||||
, value form.email
|
||||
, onInput EnteredEmail
|
||||
]
|
||||
[]
|
||||
]
|
||||
, fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control form-control-lg"
|
||||
, type_ "password"
|
||||
, placeholder "Password"
|
||||
, value form.password
|
||||
, onInput EnteredPassword
|
||||
]
|
||||
[]
|
||||
]
|
||||
, button
|
||||
[ class "btn btn-lg btn-primary pull-xs-right" ]
|
||||
[ text "Update Settings" ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewProblem : Problem -> Html msg
|
||||
viewProblem problem =
|
||||
let
|
||||
errorMessage =
|
||||
case problem of
|
||||
InvalidEntry _ message ->
|
||||
message
|
||||
|
||||
ServerError message ->
|
||||
message
|
||||
in
|
||||
li [] [ text errorMessage ]
|
||||
|
||||
|
||||
|
||||
-- UPDATE
|
||||
|
||||
|
||||
type Msg
|
||||
= SubmittedForm Cred
|
||||
| EnteredEmail String
|
||||
| EnteredUsername String
|
||||
| EnteredPassword String
|
||||
| EnteredBio String
|
||||
| EnteredAvatar String
|
||||
| CompletedSave (Result Http.Error Viewer)
|
||||
| GotSession Session
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
update msg model =
|
||||
case msg of
|
||||
SubmittedForm cred ->
|
||||
case validate model.form of
|
||||
Ok validForm ->
|
||||
( { model | problems = [] }
|
||||
, edit cred validForm
|
||||
|> Http.send CompletedSave
|
||||
)
|
||||
|
||||
Err problems ->
|
||||
( { model | problems = problems }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
EnteredEmail email ->
|
||||
updateForm (\form -> { form | email = email }) model
|
||||
|
||||
EnteredUsername username ->
|
||||
updateForm (\form -> { form | username = username }) model
|
||||
|
||||
EnteredPassword password ->
|
||||
updateForm (\form -> { form | password = password }) model
|
||||
|
||||
EnteredBio bio ->
|
||||
updateForm (\form -> { form | bio = bio }) model
|
||||
|
||||
EnteredAvatar avatar ->
|
||||
updateForm (\form -> { form | avatar = avatar }) model
|
||||
|
||||
CompletedSave (Err error) ->
|
||||
let
|
||||
serverErrors =
|
||||
Api.decodeErrors error
|
||||
|> List.map ServerError
|
||||
in
|
||||
( { model | problems = List.append model.problems serverErrors }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
CompletedSave (Ok cred) ->
|
||||
( model
|
||||
, Session.login cred
|
||||
)
|
||||
|
||||
GotSession session ->
|
||||
( { model | session = session }
|
||||
, Route.replaceUrl (Session.navKey session) Route.Home
|
||||
)
|
||||
|
||||
|
||||
{-| Helper function for `update`. Updates the form and returns Cmd.none and
|
||||
Ignored. Useful for recording form fields!
|
||||
-}
|
||||
updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
|
||||
updateForm transform model =
|
||||
( { model | form = transform model.form }, Cmd.none )
|
||||
|
||||
|
||||
|
||||
-- SUBSCRIPTIONS
|
||||
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions model =
|
||||
Session.changes GotSession (Session.navKey model.session)
|
||||
|
||||
|
||||
|
||||
-- EXPORT
|
||||
|
||||
|
||||
toSession : Model -> Session
|
||||
toSession model =
|
||||
model.session
|
||||
|
||||
|
||||
|
||||
-- FORM
|
||||
|
||||
|
||||
{-| Marks that we've trimmed the form's fields, so we don't accidentally send
|
||||
it to the server without having trimmed it!
|
||||
-}
|
||||
type TrimmedForm
|
||||
= Trimmed Form
|
||||
|
||||
|
||||
{-| When adding a variant here, add it to `fieldsToValidate` too!
|
||||
|
||||
NOTE: there are no ImageUrl or Bio variants here, because they aren't validated!
|
||||
|
||||
-}
|
||||
type ValidatedField
|
||||
= Username
|
||||
| Email
|
||||
| Password
|
||||
|
||||
|
||||
fieldsToValidate : List ValidatedField
|
||||
fieldsToValidate =
|
||||
[ Username
|
||||
, Email
|
||||
, Password
|
||||
]
|
||||
|
||||
|
||||
{-| Trim the form and validate its fields. If there are problems, report them!
|
||||
-}
|
||||
validate : Form -> Result (List Problem) TrimmedForm
|
||||
validate form =
|
||||
let
|
||||
trimmedForm =
|
||||
trimFields form
|
||||
in
|
||||
case List.concatMap (validateField trimmedForm) fieldsToValidate of
|
||||
[] ->
|
||||
Ok trimmedForm
|
||||
|
||||
problems ->
|
||||
Err problems
|
||||
|
||||
|
||||
validateField : TrimmedForm -> ValidatedField -> List Problem
|
||||
validateField (Trimmed form) field =
|
||||
List.map (InvalidEntry field) <|
|
||||
case field of
|
||||
Username ->
|
||||
if String.isEmpty form.username then
|
||||
[ "username can't be blank." ]
|
||||
|
||||
else
|
||||
[]
|
||||
|
||||
Email ->
|
||||
if String.isEmpty form.email then
|
||||
[ "email can't be blank." ]
|
||||
|
||||
else
|
||||
[]
|
||||
|
||||
Password ->
|
||||
let
|
||||
passwordLength =
|
||||
String.length form.password
|
||||
in
|
||||
if passwordLength > 0 && passwordLength < Viewer.minPasswordChars then
|
||||
[ "password must be at least " ++ String.fromInt Viewer.minPasswordChars ++ " characters long." ]
|
||||
|
||||
else
|
||||
[]
|
||||
|
||||
|
||||
{-| Don't trim while the user is typing! That would be super annoying.
|
||||
Instead, trim only on submit.
|
||||
-}
|
||||
trimFields : Form -> TrimmedForm
|
||||
trimFields form =
|
||||
Trimmed
|
||||
{ avatar = String.trim form.avatar
|
||||
, bio = String.trim form.bio
|
||||
, email = String.trim form.email
|
||||
, username = String.trim form.username
|
||||
, password = String.trim form.password
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- HTTP
|
||||
|
||||
|
||||
{-| This takes a Valid Form as a reminder that it needs to have been validated
|
||||
first.
|
||||
-}
|
||||
edit : Cred -> TrimmedForm -> Http.Request Viewer
|
||||
edit cred (Trimmed form) =
|
||||
let
|
||||
encodedAvatar =
|
||||
case form.avatar of
|
||||
"" ->
|
||||
Encode.null
|
||||
|
||||
avatar ->
|
||||
Encode.string avatar
|
||||
|
||||
updates =
|
||||
[ ( "username", Encode.string form.username )
|
||||
, ( "email", Encode.string form.email )
|
||||
, ( "bio", Encode.string form.bio )
|
||||
, ( "image", encodedAvatar )
|
||||
]
|
||||
|
||||
encodedUser =
|
||||
Encode.object <|
|
||||
case form.password of
|
||||
"" ->
|
||||
updates
|
||||
|
||||
password ->
|
||||
( "password", Encode.string password ) :: updates
|
||||
|
||||
body =
|
||||
Encode.object [ ( "user", encodedUser ) ]
|
||||
|> Http.jsonBody
|
||||
|
||||
expect =
|
||||
Decode.field "user" Viewer.decoder
|
||||
|> Http.expectJson
|
||||
in
|
||||
Api.url [ "user" ]
|
||||
|> HttpBuilder.put
|
||||
|> HttpBuilder.withExpect expect
|
||||
|> HttpBuilder.withBody body
|
||||
|> Cred.addHeader cred
|
||||
|> HttpBuilder.toRequest
|
||||
|
||||
|
||||
nothingIfEmpty : String -> Maybe String
|
||||
nothingIfEmpty str =
|
||||
if String.isEmpty str then
|
||||
Nothing
|
||||
|
||||
else
|
||||
Just str
|
||||
Reference in New Issue
Block a user