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

Update part4

Browse Source
This commit is contained in:
Richard Feldman
2018-08-13 06:07:16 -04:00
parent bd72768e6f
commit fd3ceff2d2
19 changed files with 885 additions and 536 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
advanced/part4/src/Api.elm
View File

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

168
advanced/part4/src/Article/Feed.elm
View File

@@ -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,33 +378,41 @@ 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
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
@@ -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

72
advanced/part4/src/Article/Preview.elm
View File

@@ -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..." ]
]
]

10
advanced/part4/src/Article/Tag.elm
View File

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

19
advanced/part4/src/Assets.elm → advanced/part4/src/Asset.elm
View File

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

12
advanced/part4/src/Author.elm
View File

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

50
advanced/part4/src/Avatar.elm
View File

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

20
advanced/part4/src/Loading.elm
View File

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

44
advanced/part4/src/Main.elm
View File

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

40
advanced/part4/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 )

235
advanced/part4/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
, 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 )
formValidator : Validator Error Form
formValidator =
Validate.all
[ ifBlank .title ( Title, "title can't be blank." )
, ifBlank .body ( Body, "body can't be blank." )
fieldsToValidate : List ValidatedField
fieldsToValidate =
[ Title
, Body
]
{-| 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

40
advanced/part4/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,19 +90,26 @@ view model =
viewFeed model.timeZone feed
Loading ->
[]
LoadingSlowly ->
[ Loading.icon ]
Failed ->
[ Loading.error "feed" ]
, div [ class "col-md-3" ]
[ div [ class "sidebar" ] <|
, div [ class "col-md-3" ] <|
case model.tags of
Loaded tags ->
[ div [ class "sidebar" ] <|
[ p [] [ text "Popular Tags" ]
, viewTags tags
]
]
Loading ->
[]
LoadingSlowly ->
[ Loading.icon ]
Failed ->
@@ -108,7 +117,6 @@ view model =
]
]
]
]
}
@@ -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

186
advanced/part4/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.
I implemented it this way out of habit, then realized the spec called for
displaying all the errors at the top. I thought about simplifying it, but then
figured it'd be useful to show how I would normally model this data - assuming
the intended UX was to render errors per field.
(The other part of this is having a view function like this:
viewFormErrors : Field -> List Error -> Html msg
...and it filters the list of errors to render only the ones for the given
Field. This way you can call this:
viewFormErrors Email model.errors
...next to the `email` field, and call `viewFormErrors Password model.errors`
next to the `password` field, and so on.
-}
type alias Error =
( ErrorSource, String )
formValidator : Validator Error Form
formValidator =
Validate.all
[ ifBlank .email ( Email, "email can't be blank." )
, ifBlank .password ( Password, "password can't be blank." )
fieldsToValidate : List ValidatedField
fieldsToValidate =
[ Email
, Password
]
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"
{-| 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
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
[]
{-| 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/part4/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/part4/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 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 )

153
advanced/part4/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 )
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
fieldsToValidate : List ValidatedField
fieldsToValidate =
[ Username
, Email
, Password
]
minPasswordChars : Int
minPasswordChars =
6
{-| 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
passwordLength : Form -> List Error
passwordLength { password } =
if String.length password < minPasswordChars then
[ ( Password, "password must be at least " ++ String.fromInt minPasswordChars ++ " characters long." ) ]
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
[]
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 )

234
advanced/part4/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 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 )
formValidator : Validator Error Form
formValidator =
Validate.all
[ ifBlank .username ( Username, "username can't be blank." )
, ifBlank .email ( Email, "email can't be blank." )
fieldsToValidate : List ValidatedField
fieldsToValidate =
[ Username
, Email
, Password
]
errorsDecoder : Decoder (List String)
errorsDecoder =
Decode.succeed (\email username password -> List.concat [ email, username, password ])
|> optionalError "email"
|> optionalError "username"
|> optionalError "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
}
@@ -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

7
advanced/part4/src/Session.elm
View File

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

18
advanced/part4/src/Viewer.elm
View File

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