Update part1

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

View File

@@ -16,8 +16,7 @@
"elm/url": "1.0.0", "elm/url": "1.0.0",
"elm-explorations/markdown": "1.0.0", "elm-explorations/markdown": "1.0.0",
"lukewestby/elm-http-builder": "6.0.0", "lukewestby/elm-http-builder": "6.0.0",
"rtfeldman/elm-iso8601": "1.0.1", "rtfeldman/elm-iso8601": "1.0.1"
"rtfeldman/elm-validate": "4.0.0"
}, },
"indirect": { "indirect": {
"elm/parser": "1.0.0", "elm/parser": "1.0.0",
@@ -26,7 +25,11 @@
} }
}, },
"test-dependencies": { "test-dependencies": {
"direct": {}, "direct": {
"indirect": {} "elm-explorations/test": "1.0.0"
},
"indirect": {
"elm/random": "1.0.0"
}
} }
} }

View File

@@ -1,4 +1,4 @@
module Api exposing (addServerError, listErrors, optionalError, url) module Api exposing (addServerError, decodeErrors, url)
import Http import Http
import Json.Decode as Decode exposing (Decoder, decodeString, field, string) 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. {-| Many API endpoints include an "errors" field in their BadStatus responses.
-} -}
listErrors : Decoder (List String) -> Http.Error -> List String decodeErrors : Http.Error -> List String
listErrors decoder error = decodeErrors error =
case error of case error of
Http.BadStatus response -> Http.BadStatus response ->
response.body response.body
|> decodeString (field "errors" decoder) |> decodeString (field "errors" errorsDecoder)
|> Result.withDefault [ "Server error" ] |> Result.withDefault [ "Server error" ]
err -> err ->
[ "Server error" ] [ "Server error" ]
optionalError : String -> Decoder (List String -> a) -> Decoder a errorsDecoder : Decoder (List String)
optionalError fieldName = errorsDecoder =
let Decode.keyValuePairs (Decode.list Decode.string)
errorToString errorMessage = |> Decode.map (List.concatMap fromPair)
String.join " " [ fieldName, errorMessage ]
in
optional fieldName (Decode.list (Decode.map errorToString string)) [] fromPair : ( String, List String ) -> List String
fromPair ( field, errors ) =
List.map (\error -> field ++ " " ++ error) errors

View File

@@ -1,11 +1,7 @@
module Article.Feed module Article.Feed
exposing exposing
( FeedConfig ( Model
, ListConfig
, Model
, Msg , Msg
, defaultFeedConfig
, defaultListConfig
, init , init
, selectTag , selectTag
, update , update
@@ -16,9 +12,10 @@ module Article.Feed
import Api import Api
import Article exposing (Article, Preview) import Article exposing (Article, Preview)
import Article.FeedSources as FeedSources exposing (FeedSources, Source(..)) import Article.FeedSources as FeedSources exposing (FeedSources, Source(..))
import Article.Preview
import Article.Slug as ArticleSlug exposing (Slug) import Article.Slug as ArticleSlug exposing (Slug)
import Article.Tag as Tag exposing (Tag) import Article.Tag as Tag exposing (Tag)
import Author
import Avatar exposing (Avatar)
import Browser.Dom as Dom import Browser.Dom as Dom
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (attribute, class, classList, href, id, placeholder, src) import Html.Attributes exposing (attribute, class, classList, href, id, placeholder, src)
@@ -30,9 +27,11 @@ import Json.Decode.Pipeline exposing (required)
import Page import Page
import PaginatedList exposing (PaginatedList) import PaginatedList exposing (PaginatedList)
import Profile import Profile
import Route exposing (Route)
import Session exposing (Session) import Session exposing (Session)
import Task exposing (Task) import Task exposing (Task)
import Time import Time
import Timestamp
import Username exposing (Username) import Username exposing (Username)
import Viewer exposing (Viewer) import Viewer exposing (Viewer)
import Viewer.Cred as Cred exposing (Cred) import Viewer.Cred as Cred exposing (Cred)
@@ -122,19 +121,54 @@ viewPreview maybeCred timeZone article =
slug = slug =
Article.slug article 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 case maybeCred of
Just cred -> Just cred ->
Just let
{ cred = cred { favoritesCount, favorited } =
, favorite = ClickedFavorite cred slug Article.metadata article
, unfavorite = ClickedUnfavorite cred slug
} 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 ->
Nothing text ""
in 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 viewFeedSources : Model -> Html Msg
@@ -305,33 +339,41 @@ fetch maybeCred page feedSource =
offset = offset =
(page - 1) * articlesPerPage (page - 1) * articlesPerPage
listConfig = params =
{ defaultListConfig | offset = offset, limit = articlesPerPage } [ ( "limit", String.fromInt articlesPerPage )
, ( "offset", String.fromInt offset )
]
in in
Task.map (PaginatedList.mapPage (\_ -> page)) <| Task.map (PaginatedList.mapPage (\_ -> page)) <|
case feedSource of case feedSource of
YourFeed cred -> YourFeed cred ->
let params
feedConfig = |> buildFromQueryParams (Just cred) (Api.url [ "articles", "feed" ])
{ defaultFeedConfig | offset = offset, limit = articlesPerPage } |> Cred.addHeader cred
in |> HttpBuilder.toRequest
feed feedConfig cred
|> Http.toTask |> Http.toTask
GlobalFeed -> GlobalFeed ->
list listConfig maybeCred list maybeCred params
|> Http.toTask
TagFeed tagName -> TagFeed tagName ->
list { listConfig | tag = Just tagName } maybeCred list maybeCred (( "tag", Tag.toString tagName ) :: params)
|> Http.toTask
FavoritedFeed username -> FavoritedFeed username ->
list { listConfig | favorited = Just username } maybeCred list maybeCred (( "favorited", Username.toString username ) :: params)
|> Http.toTask
AuthorFeed username -> 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 |> Http.toTask
@@ -345,70 +387,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 -- SERIALIZATION

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

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.) {-| Assets, such as images, videos, and audio. (We only have images for now.)
@@ -21,7 +21,22 @@ type Image
error : Image error : Image
error = 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)

View File

@@ -169,19 +169,19 @@ requestHelp builderFromUrl uname cred =
|> HttpBuilder.toRequest |> HttpBuilder.toRequest
followButton : (UnfollowedAuthor -> msg) -> UnfollowedAuthor -> Html msg followButton : (Cred -> UnfollowedAuthor -> msg) -> Cred -> UnfollowedAuthor -> Html msg
followButton toMsg ((UnfollowedAuthor uname _) as author) = followButton toMsg cred ((UnfollowedAuthor uname _) as author) =
toggleFollowButton "Follow" toggleFollowButton "Follow"
[ "btn-outline-secondary" ] [ "btn-outline-secondary" ]
(toMsg author) (toMsg cred author)
uname uname
unfollowButton : (FollowedAuthor -> msg) -> FollowedAuthor -> Html msg unfollowButton : (Cred -> FollowedAuthor -> msg) -> Cred -> FollowedAuthor -> Html msg
unfollowButton toMsg ((FollowedAuthor uname _) as author) = unfollowButton toMsg cred ((FollowedAuthor uname _) as author) =
toggleFollowButton "Unfollow" toggleFollowButton "Unfollow"
[ "btn-secondary" ] [ "btn-secondary" ]
(toMsg author) (toMsg cred author)
uname uname

View File

@@ -1,5 +1,6 @@
module Avatar exposing (Avatar, decoder, encode, src, toMaybeString) module Avatar exposing (Avatar, decoder, encode, src, toMaybeString)
import Asset
import Html exposing (Attribute) import Html exposing (Attribute)
import Html.Attributes import Html.Attributes
import Json.Decode as Decode exposing (Decoder) import Json.Decode as Decode exposing (Decoder)
@@ -29,38 +30,27 @@ decoder =
encode : Avatar -> Value encode : Avatar -> Value
encode (Avatar maybeUrl) = encode (Avatar maybeUrl) =
maybeUrl case maybeUrl of
|> Maybe.map Encode.string Just url ->
|> Maybe.withDefault Encode.null Encode.string url
Nothing ->
Encode.null
src : Avatar -> Attribute msg src : Avatar -> Attribute msg
src avatar = src (Avatar maybeUrl) =
Html.Attributes.src (avatarToUrl avatar) case maybeUrl of
Nothing ->
Asset.src Asset.defaultAvatar
Just "" ->
Asset.src Asset.defaultAvatar
Just url ->
Html.Attributes.src url
toMaybeString : Avatar -> Maybe String toMaybeString : Avatar -> Maybe String
toMaybeString (Avatar maybeUrl) = toMaybeString (Avatar maybeUrl) =
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"

View File

@@ -1,21 +1,25 @@
module Loading exposing (error, icon) module Loading exposing (error, icon, slowThreshold)
{-| A loading spinner icon. {-| A loading spinner icon.
-} -}
import Html exposing (Attribute, Html, div, li) import Asset
import Html.Attributes exposing (class, style) import Html exposing (Attribute, Html)
import Html.Attributes exposing (alt, height, src, width)
import Process
import Task exposing (Task)
icon : Html msg icon : Html msg
icon = icon =
li [ class "sk-three-bounce", style "float" "left", style "margin" "8px" ] Html.img [ Asset.src Asset.loading, width 64, height 64, alt "Loading..." ] []
[ div [ class "sk-child sk-bounce1" ] []
, div [ class "sk-child sk-bounce2" ] []
, div [ class "sk-child sk-bounce3" ] []
]
error : String -> Html msg error : String -> Html msg
error str = error str =
Html.text ("Error loading " ++ str ++ ".") Html.text ("Error loading " ++ str ++ ".")
slowThreshold : Task x ()
slowThreshold =
Process.sleep 500

View File

@@ -32,7 +32,7 @@ import Viewer.Cred as Cred exposing (Cred)
-- Avoid putting things in here unless there is no alternative! -- Avoid putting things in here unless there is no alternative!
type ViewingPage type Model
= Redirect Session = Redirect Session
| NotFound Session | NotFound Session
| Home Home.Model | Home Home.Model
@@ -48,18 +48,10 @@ type ViewingPage
-- MODEL -- MODEL
type alias Model =
{ navKey : Nav.Key
, page : ViewingPage
}
init : Value -> Url -> Nav.Key -> ( Model, Cmd Msg ) init : Value -> Url -> Nav.Key -> ( Model, Cmd Msg )
init flags url navKey = init flags url navKey =
changeRouteTo (Route.fromUrl url) changeRouteTo (Route.fromUrl url)
{ navKey = navKey (Redirect (Session.decode navKey flags))
, page = Redirect (Session.decode navKey flags)
}
@@ -72,13 +64,13 @@ view model =
viewPage page toMsg config = viewPage page toMsg config =
let let
{ title, body } = { title, body } =
Page.view (Session.viewer (toSession model.page)) page config Page.view (Session.viewer (toSession model)) page config
in in
{ title = title { title = title
, body = List.map (Html.map toMsg) body , body = List.map (Html.map toMsg) body
} }
in in
case model.page of case model of
Redirect _ -> Redirect _ ->
viewPage Page.Other (\_ -> Ignored) Blank.view viewPage Page.Other (\_ -> Ignored) Blank.view
@@ -126,9 +118,10 @@ type Msg
| GotProfileMsg Profile.Msg | GotProfileMsg Profile.Msg
| GotArticleMsg Article.Msg | GotArticleMsg Article.Msg
| GotEditorMsg Editor.Msg | GotEditorMsg Editor.Msg
| GotSession Session
toSession : ViewingPage -> Session toSession : Model -> Session
toSession page = toSession page =
case page of case page of
Redirect session -> Redirect session ->
@@ -163,14 +156,14 @@ changeRouteTo : Maybe Route -> Model -> ( Model, Cmd Msg )
changeRouteTo maybeRoute model = changeRouteTo maybeRoute model =
let let
session = session =
toSession model.page toSession model
in in
case maybeRoute of case maybeRoute of
Nothing -> Nothing ->
( { model | page = NotFound session }, Cmd.none ) ( NotFound session, Cmd.none )
Just Route.Root -> Just Route.Root ->
( model, Route.replaceUrl model.navKey Route.Home ) ( model, Route.replaceUrl (Session.navKey session) Route.Home )
Just Route.Logout -> Just Route.Logout ->
( model, Session.logout ) ( model, Session.logout )
@@ -210,7 +203,7 @@ changeRouteTo maybeRoute model =
update : Msg -> Model -> ( Model, Cmd Msg ) update : Msg -> Model -> ( Model, Cmd Msg )
update msg model = update msg model =
case ( msg, model.page ) of case ( msg, model ) of
( Ignored, _ ) -> ( Ignored, _ ) ->
( model, Cmd.none ) ( model, Cmd.none )
@@ -231,7 +224,7 @@ update msg model =
Just _ -> Just _ ->
( model ( model
, Nav.pushUrl model.navKey (Url.toString url) , Nav.pushUrl (Session.navKey (toSession model)) (Url.toString url)
) )
Browser.External href -> Browser.External href ->
@@ -273,14 +266,19 @@ update msg model =
Editor.update subMsg editor Editor.update subMsg editor
|> updateWith (Editor slug) GotEditorMsg model |> 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. -- Disregard messages that arrived for the wrong page.
( model, Cmd.none ) ( model, Cmd.none )
updateWith : (subModel -> ViewingPage) -> (subMsg -> Msg) -> Model -> ( subModel, Cmd subMsg ) -> ( Model, Cmd Msg ) updateWith : (subModel -> Model) -> (subMsg -> Msg) -> Model -> ( subModel, Cmd subMsg ) -> ( Model, Cmd Msg )
updateWith toViewingPage toMsg model ( subModel, subCmd ) = updateWith toModel toMsg model ( subModel, subCmd ) =
( { model | page = toViewingPage subModel } ( toModel subModel
, Cmd.map toMsg subCmd , Cmd.map toMsg subCmd
) )
@@ -291,12 +289,12 @@ updateWith toViewingPage toMsg model ( subModel, subCmd ) =
subscriptions : Model -> Sub Msg subscriptions : Model -> Sub Msg
subscriptions model = subscriptions model =
case model.page of case model of
NotFound _ -> NotFound _ ->
Sub.none Sub.none
Redirect _ -> Redirect _ ->
Sub.none Session.changes GotSession (Session.navKey (toSession model))
Settings settings -> Settings settings ->
Sub.map GotSettingsMsg (Settings.subscriptions settings) Sub.map GotSettingsMsg (Settings.subscriptions settings)

View File

@@ -7,7 +7,6 @@ import Api
import Article exposing (Article, Full, Preview) import Article exposing (Article, Full, Preview)
import Article.Body exposing (Body) import Article.Body exposing (Body)
import Article.Comment as Comment exposing (Comment) import Article.Comment as Comment exposing (Comment)
import Article.Preview
import Article.Slug as Slug exposing (Slug) import Article.Slug as Slug exposing (Slug)
import Author exposing (Author(..), FollowedAuthor, UnfollowedAuthor) import Author exposing (Author(..), FollowedAuthor, UnfollowedAuthor)
import Avatar import Avatar
@@ -49,6 +48,7 @@ type alias Model =
type Status a type Status a
= Loading = Loading
| LoadingSlowly
| Loaded a | Loaded a
| Failed | Failed
@@ -76,6 +76,7 @@ init session slug =
, Comment.list maybeCred slug , Comment.list maybeCred slug
|> Http.send CompletedLoadComments |> Http.send CompletedLoadComments
, Task.perform GotTimeZone Time.here , 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! -- Don't render the comments until the article has loaded!
case model.comments of case model.comments of
Loading -> Loading ->
[]
LoadingSlowly ->
[ Loading.icon ] [ Loading.icon ]
Loaded ( commentText, comments ) -> Loaded ( commentText, comments ) ->
@@ -172,6 +176,9 @@ view model =
} }
Loading -> Loading ->
{ title = "Article", content = text "" }
LoadingSlowly ->
{ title = "Article", content = Loading.icon } { title = "Article", content = Loading.icon }
Failed -> Failed ->
@@ -228,13 +235,13 @@ viewButtons : Cred -> Article Full -> Author -> List (Html Msg)
viewButtons cred article author = viewButtons cred article author =
case author of case author of
IsFollowing followedAuthor -> IsFollowing followedAuthor ->
[ Author.unfollowButton (ClickedUnfollow cred) followedAuthor [ Author.unfollowButton ClickedUnfollow cred followedAuthor
, text " " , text " "
, favoriteButton cred article , favoriteButton cred article
] ]
IsNotFollowing unfollowedAuthor -> IsNotFollowing unfollowedAuthor ->
[ Author.followButton (ClickedFollow cred) unfollowedAuthor [ Author.followButton ClickedFollow cred unfollowedAuthor
, text " " , text " "
, favoriteButton cred article , favoriteButton cred article
] ]
@@ -318,6 +325,7 @@ type Msg
| CompletedPostComment (Result Http.Error Comment) | CompletedPostComment (Result Http.Error Comment)
| GotTimeZone Time.Zone | GotTimeZone Time.Zone
| GotSession Session | GotSession Session
| PassedSlowLoadThreshold
update : Msg -> Model -> ( Model, Cmd Msg ) update : Msg -> Model -> ( Model, Cmd Msg )
@@ -468,7 +476,31 @@ update msg model =
( { model | timeZone = tz }, Cmd.none ) ( { model | timeZone = tz }, Cmd.none )
GotSession session -> 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 )

View File

@@ -19,7 +19,6 @@ import Route
import Session exposing (Session) import Session exposing (Session)
import Task exposing (Task) import Task exposing (Task)
import Time import Time
import Validate exposing (Valid, Validator, fromValid, ifBlank, validate)
import Viewer exposing (Viewer) import Viewer exposing (Viewer)
import Viewer.Cred as Cred exposing (Cred) import Viewer.Cred as Cred exposing (Cred)
@@ -38,14 +37,20 @@ type
Status Status
-- Edit Article -- Edit Article
= Loading Slug = Loading Slug
| LoadingSlowly Slug
| LoadingFailed Slug | LoadingFailed Slug
| Saving Slug Form | Saving Slug Form
| Editing Slug (List Error) Form | Editing Slug (List Problem) Form
-- New Article -- New Article
| EditingNew (List Error) Form | EditingNew (List Problem) Form
| Creating Form | Creating Form
type Problem
= InvalidEntry ValidatedField String
| ServerError String
type alias Form = type alias Form =
{ title : String { title : String
, body : String , body : String
@@ -74,12 +79,15 @@ initEdit session slug =
( { session = session ( { session = session
, status = Loading slug , status = Loading slug
} }
, Article.fetch (Session.cred session) slug , Cmd.batch
[ Article.fetch (Session.cred session) slug
|> Http.toTask |> Http.toTask
-- If init fails, store the slug that failed in the msg, so we can -- 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! -- at least have it later to display the page's title properly!
|> Task.mapError (\httpError -> ( slug, httpError )) |> Task.mapError (\httpError -> ( slug, httpError ))
|> Task.attempt CompletedArticleLoad |> 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 -> Html Msg
viewAuthenticated cred model = viewAuthenticated cred model =
let let
formHtml = formHtml =
case model.status of case model.status of
Loading _ -> Loading _ ->
[]
LoadingSlowly _ ->
[ Loading.icon ] [ Loading.icon ]
Saving slug form -> Saving slug form ->
@@ -120,17 +151,13 @@ viewAuthenticated cred model =
Creating form -> Creating form ->
[ viewForm cred form (newArticleSaveButton [ disabled True ]) ] [ viewForm cred form (newArticleSaveButton [ disabled True ]) ]
Editing slug errors form -> Editing slug problems form ->
[ errors [ viewProblems problems
|> List.map (\( _, error ) -> li [] [ text error ])
|> ul [ class "error-messages" ]
, viewForm cred form (editArticleSaveButton []) , viewForm cred form (editArticleSaveButton [])
] ]
EditingNew errors form -> EditingNew problems form ->
[ errors [ viewProblems problems
|> List.map (\( _, error ) -> li [] [ text error ])
|> ul [ class "error-messages" ]
, viewForm cred form (newArticleSaveButton []) , viewForm cred form (newArticleSaveButton [])
] ]
@@ -223,6 +250,7 @@ type Msg
| CompletedEdit (Result Http.Error (Article Full)) | CompletedEdit (Result Http.Error (Article Full))
| CompletedArticleLoad (Result ( Slug, Http.Error ) (Article Full)) | CompletedArticleLoad (Result ( Slug, Http.Error ) (Article Full))
| GotSession Session | GotSession Session
| PassedSlowLoadThreshold
update : Msg -> Model -> ( Model, Cmd Msg ) update : Msg -> Model -> ( Model, Cmd Msg )
@@ -252,7 +280,7 @@ update msg model =
) )
CompletedCreate (Err error) -> CompletedCreate (Err error) ->
( { model | status = savingError model.status } ( { model | status = savingError error model.status }
, Cmd.none , Cmd.none
) )
@@ -263,7 +291,7 @@ update msg model =
) )
CompletedEdit (Err error) -> CompletedEdit (Err error) ->
( { model | status = savingError model.status } ( { model | status = savingError error model.status }
, Cmd.none , Cmd.none
) )
@@ -291,35 +319,51 @@ update msg model =
) )
GotSession session -> 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 -> ( Status, Cmd Msg )
save cred status = save cred status =
case status of case status of
Editing slug _ fields -> Editing slug _ form ->
case validate formValidator fields of case validate form of
Ok validForm -> Ok validForm ->
( Saving slug fields ( Saving slug form
, edit slug validForm cred , edit slug validForm cred
|> Http.send CompletedEdit |> Http.send CompletedEdit
) )
Err errors -> Err problems ->
( Editing slug errors fields ( Editing slug problems form
, Cmd.none , Cmd.none
) )
EditingNew _ fields -> EditingNew _ form ->
case validate formValidator fields of case validate form of
Ok validForm -> Ok validForm ->
( Creating fields ( Creating form
, create validForm cred , create validForm cred
|> Http.send CompletedCreate |> Http.send CompletedCreate
) )
Err errors -> Err problems ->
( EditingNew errors fields ( EditingNew problems form
, Cmd.none , Cmd.none
) )
@@ -333,18 +377,18 @@ save cred status =
( status, Cmd.none ) ( status, Cmd.none )
savingError : Status -> Status savingError : Http.Error -> Status -> Status
savingError status = savingError error status =
let let
errors = problems =
[ ( Server, "Error saving article" ) ] [ ServerError "Error saving article" ]
in in
case status of case status of
Saving slug form -> Saving slug form ->
Editing slug errors form Editing slug problems form
Creating form -> Creating form ->
EditingNew errors form EditingNew problems form
_ -> _ ->
status status
@@ -367,6 +411,9 @@ updateForm transform model =
Loading _ -> Loading _ ->
model model
LoadingSlowly _ ->
model
LoadingFailed _ -> LoadingFailed _ ->
model model
@@ -395,37 +442,85 @@ subscriptions model =
-- VALIDATION -- FORM
type ErrorSource {-| Marks that we've trimmed the form's fields, so we don't accidentally send
= Server it to the server without having trimmed it!
| Title -}
type TrimmedForm
= Trimmed Form
{-| When adding a variant here, add it to `fieldsToValidate` too!
-}
type ValidatedField
= Title
| Body | Body
type alias Error = fieldsToValidate : List ValidatedField
( ErrorSource, String ) 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 -- HTTP
create : Valid Form -> Cred -> Http.Request (Article Full) create : TrimmedForm -> Cred -> Http.Request (Article Full)
create validForm cred = create (Trimmed form) cred =
let let
form =
fromValid validForm
expect = expect =
Article.fullDecoder (Just cred) Article.fullDecoder (Just cred)
|> Decode.field "article" |> Decode.field "article"
@@ -459,12 +554,9 @@ tagsFromString str =
|> List.filter (not << String.isEmpty) |> List.filter (not << String.isEmpty)
edit : Slug -> Valid Form -> Cred -> Http.Request (Article Full) edit : Slug -> TrimmedForm -> Cred -> Http.Request (Article Full)
edit articleSlug validForm cred = edit articleSlug (Trimmed form) cred =
let let
form =
fromValid validForm
expect = expect =
Article.fullDecoder (Just cred) Article.fullDecoder (Just cred)
|> Decode.field "article" |> Decode.field "article"
@@ -510,6 +602,9 @@ getSlug status =
Loading slug -> Loading slug ->
Just slug Just slug
LoadingSlowly slug ->
Just slug
LoadingFailed slug -> LoadingFailed slug ->
Just slug Just slug

View File

@@ -36,6 +36,7 @@ type alias Model =
type Status a type Status a
= Loading = Loading
| LoadingSlowly
| Loaded a | Loaded a
| Failed | Failed
@@ -66,6 +67,7 @@ init session =
, Tag.list , Tag.list
|> Http.send CompletedTagsLoad |> Http.send CompletedTagsLoad
, Task.perform GotTimeZone Time.here , Task.perform GotTimeZone Time.here
, Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold
] ]
) )
@@ -88,19 +90,26 @@ view model =
viewFeed model.timeZone feed viewFeed model.timeZone feed
Loading -> Loading ->
[]
LoadingSlowly ->
[ Loading.icon ] [ Loading.icon ]
Failed -> Failed ->
[ Loading.error "feed" ] [ Loading.error "feed" ]
, div [ class "col-md-3" ] , div [ class "col-md-3" ] <|
[ div [ class "sidebar" ] <|
case model.tags of case model.tags of
Loaded tags -> Loaded tags ->
[ div [ class "sidebar" ] <|
[ p [] [ text "Popular Tags" ] [ p [] [ text "Popular Tags" ]
, viewTags tags , viewTags tags
] ]
]
Loading -> Loading ->
[]
LoadingSlowly ->
[ Loading.icon ] [ Loading.icon ]
Failed -> Failed ->
@@ -108,7 +117,6 @@ view model =
] ]
] ]
] ]
]
} }
@@ -157,6 +165,7 @@ type Msg
| GotTimeZone Time.Zone | GotTimeZone Time.Zone
| GotFeedMsg Feed.Msg | GotFeedMsg Feed.Msg
| GotSession Session | GotSession Session
| PassedSlowLoadThreshold
update : Msg -> Model -> ( Model, Cmd Msg ) update : Msg -> Model -> ( Model, Cmd Msg )
@@ -197,6 +206,9 @@ update msg model =
Loading -> Loading ->
( model, Log.error ) ( model, Log.error )
LoadingSlowly ->
( model, Log.error )
Failed -> Failed ->
( model, Log.error ) ( model, Log.error )
@@ -206,6 +218,28 @@ update msg model =
GotSession session -> GotSession session ->
( { model | session = session }, Cmd.none ) ( { 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 -- SUBSCRIPTIONS

View File

@@ -3,7 +3,7 @@ module Page.Login exposing (Model, Msg, init, subscriptions, toSession, update,
{-| The login page. {-| The login page.
-} -}
import Api exposing (optionalError) import Api
import Browser.Navigation as Nav import Browser.Navigation as Nav
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
@@ -14,7 +14,6 @@ import Json.Decode.Pipeline exposing (optional)
import Json.Encode as Encode import Json.Encode as Encode
import Route exposing (Route) import Route exposing (Route)
import Session exposing (Session) import Session exposing (Session)
import Validate exposing (Valid, Validator, fromValid, ifBlank, validate)
import Viewer exposing (Viewer) import Viewer exposing (Viewer)
import Viewer.Cred as Cred exposing (Cred) import Viewer.Cred as Cred exposing (Cred)
@@ -25,11 +24,40 @@ import Viewer.Cred as Cred exposing (Cred)
type alias Model = type alias Model =
{ session : Session { session : Session
, errors : List Error , problems : List Problem
, form : Form , 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 = type alias Form =
{ email : String { email : String
, password : String , password : String
@@ -39,7 +67,7 @@ type alias Form =
init : Session -> ( Model, Cmd msg ) init : Session -> ( Model, Cmd msg )
init session = init session =
( { session = session ( { session = session
, errors = [] , problems = []
, form = , form =
{ email = "" { email = ""
, password = "" , password = ""
@@ -66,8 +94,8 @@ view model =
[ a [ Route.href Route.Register ] [ a [ Route.href Route.Register ]
[ text "Need an account?" ] [ text "Need an account?" ]
] ]
, ul [ class "error-messages" ] <| , ul [ class "error-messages" ]
List.map (\( _, error ) -> li [] [ text error ]) model.errors (List.map viewProblem model.problems)
, viewForm model.form , 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 Msg
viewForm form = viewForm form =
Html.form [ onSubmit SubmittedForm ] Html.form [ onSubmit SubmittedForm ]
@@ -119,14 +161,14 @@ update : Msg -> Model -> ( Model, Cmd Msg )
update msg model = update msg model =
case msg of case msg of
SubmittedForm -> SubmittedForm ->
case validate formValidator model.form of case validate model.form of
Ok validForm -> Ok validForm ->
( { model | errors = [] } ( { model | problems = [] }
, Http.send CompletedLogin (login validForm) , Http.send CompletedLogin (login validForm)
) )
Err errors -> Err problems ->
( { model | errors = errors } ( { model | problems = problems }
, Cmd.none , Cmd.none
) )
@@ -139,22 +181,22 @@ update msg model =
CompletedLogin (Err error) -> CompletedLogin (Err error) ->
let let
serverErrors = serverErrors =
error Api.decodeErrors error
|> Api.listErrors errorsDecoder |> List.map ServerError
|> List.map (\errorMessage -> ( Server, errorMessage ))
|> List.append model.errors
in in
( { model | errors = List.append model.errors serverErrors } ( { model | problems = List.append model.problems serverErrors }
, Cmd.none , Cmd.none
) )
CompletedLogin (Ok cred) -> CompletedLogin (Ok viewer) ->
( model ( model
, Session.login cred , Session.login viewer
) )
GotSession session -> 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 {-| Helper function for `update`. Updates the form and returns Cmd.none and
@@ -175,67 +217,83 @@ subscriptions model =
-- VALIDATION -- FORM
type ErrorSource {-| Marks that we've trimmed the form's fields, so we don't accidentally send
= Server it to the server without having trimmed it!
| Email -}
type TrimmedForm
= Trimmed Form
{-| When adding a variant here, add it to `fieldsToValidate` too!
-}
type ValidatedField
= Email
| Password | Password
{-| Recording validation errors on a per-field basis facilitates displaying fieldsToValidate : List ValidatedField
them inline next to the field where the error occurred. fieldsToValidate =
[ Email
I implemented it this way out of habit, then realized the spec called for , Password
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." )
] ]
errorsDecoder : Decoder (List String) {-| Trim the form and validate its fields. If there are problems, report them!
errorsDecoder = -}
Decode.succeed (\emailOrPassword email username password -> List.concat [ emailOrPassword, email, username, password ]) validate : Form -> Result (List Problem) TrimmedForm
|> optionalError "email or password" validate form =
|> optionalError "email" let
|> optionalError "username" trimmedForm =
|> optionalError "password" 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 -- HTTP
login : Valid Form -> Http.Request Viewer login : TrimmedForm -> Http.Request Viewer
login validForm = login (Trimmed form) =
let let
form =
fromValid validForm
user = user =
Encode.object Encode.object
[ ( "email", Encode.string form.email ) [ ( "email", Encode.string form.email )

View File

@@ -1,6 +1,6 @@
module Page.NotFound exposing (view) module Page.NotFound exposing (view)
import Assets import Asset
import Html exposing (Html, div, h1, img, main_, text) import Html exposing (Html, div, h1, img, main_, text)
import Html.Attributes exposing (alt, class, id, src, tabindex) import Html.Attributes exposing (alt, class, id, src, tabindex)
@@ -16,6 +16,6 @@ view =
main_ [ id "content", class "container", tabindex -1 ] main_ [ id "content", class "container", tabindex -1 ]
[ h1 [] [ text "Not Found" ] [ h1 [] [ text "Not Found" ]
, div [ class "row" ] , div [ class "row" ]
[ img [ Assets.src Assets.error ] [] ] [ img [ Asset.src Asset.error ] [] ]
] ]
} }

View File

@@ -3,7 +3,7 @@ module Page.Profile exposing (Model, Msg, init, subscriptions, toSession, update
{-| An Author's profile. {-| 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 Article.FeedSources as FeedSources exposing (FeedSources, Source(..))
import Author exposing (Author(..), FollowedAuthor, UnfollowedAuthor) import Author exposing (Author(..), FollowedAuthor, UnfollowedAuthor)
import Avatar exposing (Avatar) import Avatar exposing (Avatar)
@@ -14,6 +14,7 @@ import Loading
import Log import Log
import Page import Page
import Profile exposing (Profile) import Profile exposing (Profile)
import Route
import Session exposing (Session) import Session exposing (Session)
import Task exposing (Task) import Task exposing (Task)
import Time import Time
@@ -39,6 +40,7 @@ type alias Model =
type Status a type Status a
= Loading Username = Loading Username
| LoadingSlowly Username
| Loaded a | Loaded a
| Failed Username | Failed Username
@@ -65,6 +67,7 @@ init session username =
|> Task.mapError (Tuple.pair username) |> Task.mapError (Tuple.pair username)
|> Task.attempt CompletedFeedLoad |> Task.attempt CompletedFeedLoad
, Task.perform GotTimeZone Time.here , Task.perform GotTimeZone Time.here
, Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold
] ]
) )
@@ -88,19 +91,13 @@ view model =
titleForOther (Author.username author) titleForOther (Author.username author)
Loading username -> Loading username ->
if Just username == Maybe.map .username (Session.cred model.session) then titleForMe (Session.cred model.session) username
myProfileTitle
else LoadingSlowly username ->
defaultTitle titleForMe (Session.cred model.session) username
Failed username -> Failed username ->
-- We can't follow if it hasn't finished loading yet titleForMe (Session.cred model.session) username
if Just username == Maybe.map .username (Session.cred model.session) then
myProfileTitle
else
defaultTitle
in in
{ title = title { title = title
, content = , content =
@@ -122,10 +119,10 @@ view model =
text "" text ""
IsFollowing followedAuthor -> IsFollowing followedAuthor ->
Author.unfollowButton (ClickedUnfollow cred) followedAuthor Author.unfollowButton ClickedUnfollow cred followedAuthor
IsNotFollowing unfollowedAuthor -> IsNotFollowing unfollowedAuthor ->
Author.followButton (ClickedFollow cred) unfollowedAuthor Author.followButton ClickedFollow cred unfollowedAuthor
Nothing -> Nothing ->
-- We can't follow if we're logged out -- We can't follow if we're logged out
@@ -151,6 +148,9 @@ view model =
[ div [ class "row" ] [ viewFeed model.timeZone feed ] ] [ div [ class "row" ] [ viewFeed model.timeZone feed ] ]
Loading _ -> Loading _ ->
text ""
LoadingSlowly _ ->
Loading.icon Loading.icon
Failed _ -> Failed _ ->
@@ -158,6 +158,9 @@ view model =
] ]
Loading _ -> Loading _ ->
text ""
LoadingSlowly _ ->
Loading.icon Loading.icon
Failed _ -> Failed _ ->
@@ -174,6 +177,20 @@ titleForOther otherUsername =
"Profile " ++ Username.toString 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 : String
myProfileTitle = myProfileTitle =
"My Profile" "My Profile"
@@ -210,6 +227,7 @@ type Msg
| GotTimeZone Time.Zone | GotTimeZone Time.Zone
| GotFeedMsg Feed.Msg | GotFeedMsg Feed.Msg
| GotSession Session | GotSession Session
| PassedSlowLoadThreshold
update : Msg -> Model -> ( Model, Cmd Msg ) update : Msg -> Model -> ( Model, Cmd Msg )
@@ -272,6 +290,9 @@ update msg model =
Loading _ -> Loading _ ->
( model, Log.error ) ( model, Log.error )
LoadingSlowly _ ->
( model, Log.error )
Failed _ -> Failed _ ->
( model, Log.error ) ( model, Log.error )
@@ -279,7 +300,23 @@ update msg model =
( { model | timeZone = tz }, Cmd.none ) ( { model | timeZone = tz }, Cmd.none )
GotSession session -> 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 )

View File

@@ -1,6 +1,6 @@
module Page.Register exposing (Model, Msg, init, subscriptions, toSession, update, view) module Page.Register exposing (Model, Msg, init, subscriptions, toSession, update, view)
import Api exposing (optionalError) import Api
import Browser.Navigation as Nav import Browser.Navigation as Nav
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
@@ -11,7 +11,6 @@ import Json.Decode.Pipeline exposing (optional)
import Json.Encode as Encode import Json.Encode as Encode
import Route exposing (Route) import Route exposing (Route)
import Session exposing (Session) import Session exposing (Session)
import Validate exposing (Valid, Validator, fromValid, ifBlank, validate)
import Viewer exposing (Viewer) import Viewer exposing (Viewer)
import Viewer.Cred as Cred exposing (Cred) import Viewer.Cred as Cred exposing (Cred)
@@ -22,7 +21,7 @@ import Viewer.Cred as Cred exposing (Cred)
type alias Model = type alias Model =
{ session : Session { session : Session
, errors : List Error , problems : List Problem
, form : Form , form : Form
} }
@@ -34,10 +33,15 @@ type alias Form =
} }
type Problem
= InvalidEntry ValidatedField String
| ServerError String
init : Session -> ( Model, Cmd msg ) init : Session -> ( Model, Cmd msg )
init session = init session =
( { session = session ( { session = session
, errors = [] , problems = []
, form = , form =
{ email = "" { email = ""
, username = "" , username = ""
@@ -65,9 +69,8 @@ view model =
[ a [ Route.href Route.Login ] [ a [ Route.href Route.Login ]
[ text "Have an account?" ] [ text "Have an account?" ]
] ]
, model.errors , ul [ class "error-messages" ]
|> List.map (\( _, error ) -> li [] [ text error ]) (List.map viewProblem model.problems)
|> ul [ class "error-messages" ]
, viewForm model.form , 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 -- UPDATE
@@ -129,14 +146,14 @@ update : Msg -> Model -> ( Model, Cmd Msg )
update msg model = update msg model =
case msg of case msg of
SubmittedForm -> SubmittedForm ->
case validate formValidator model.form of case validate model.form of
Ok validForm -> Ok validForm ->
( { model | errors = [] } ( { model | problems = [] }
, Http.send CompletedRegister (register validForm) , Http.send CompletedRegister (register validForm)
) )
Err errors -> Err problems ->
( { model | errors = errors } ( { model | problems = problems }
, Cmd.none , Cmd.none
) )
@@ -152,21 +169,22 @@ update msg model =
CompletedRegister (Err error) -> CompletedRegister (Err error) ->
let let
serverErrors = serverErrors =
error Api.decodeErrors error
|> Api.listErrors errorsDecoder |> List.map ServerError
|> List.map (\errorMessage -> ( Server, errorMessage ))
in in
( { model | errors = List.append model.errors serverErrors } ( { model | problems = List.append model.problems serverErrors }
, Cmd.none , Cmd.none
) )
CompletedRegister (Ok cred) -> CompletedRegister (Ok viewer) ->
( model ( model
, Session.login cred , Session.login viewer
) )
GotSession session -> 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 {-| Helper function for `update`. Updates the form and returns Cmd.none and
@@ -196,61 +214,96 @@ toSession model =
-- VALIDATION -- FORM
type ErrorSource {-| Marks that we've trimmed the form's fields, so we don't accidentally send
= Server it to the server without having trimmed it!
| Username -}
type TrimmedForm
= Trimmed Form
{-| When adding a variant here, add it to `fieldsToValidate` too!
-}
type ValidatedField
= Username
| Email | Email
| Password | Password
type alias Error = fieldsToValidate : List ValidatedField
( ErrorSource, String ) fieldsToValidate =
[ Username
, Email
formValidator : Validator Error Form , Password
formValidator =
Validate.all
[ ifBlank .username ( Username, "username can't be blank." )
, ifBlank .email ( Email, "email can't be blank." )
, Validate.fromErrors passwordLength
] ]
minPasswordChars : Int {-| Trim the form and validate its fields. If there are problems, report them!
minPasswordChars = -}
6 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 validateField : TrimmedForm -> ValidatedField -> List Problem
passwordLength { password } = validateField (Trimmed form) field =
if String.length password < minPasswordChars then List.map (InvalidEntry field) <|
[ ( Password, "password must be at least " ++ String.fromInt minPasswordChars ++ " characters long." ) ] 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 else
[] []
errorsDecoder : Decoder (List String) {-| Don't trim while the user is typing! That would be super annoying.
errorsDecoder = Instead, trim only on submit.
Decode.succeed (\email username password -> List.concat [ email, username, password ]) -}
|> optionalError "email" trimFields : Form -> TrimmedForm
|> optionalError "username" trimFields form =
|> optionalError "password" Trimmed
{ username = String.trim form.username
, email = String.trim form.email
, password = String.trim form.password
}
-- HTTP -- HTTP
register : Valid Form -> Http.Request Viewer register : TrimmedForm -> Http.Request Viewer
register validForm = register (Trimmed form) =
let let
form =
fromValid validForm
user = user =
Encode.object Encode.object
[ ( "username", Encode.string form.username ) [ ( "username", Encode.string form.username )

View File

@@ -1,6 +1,6 @@
module Page.Settings exposing (Model, Msg, init, subscriptions, toSession, update, view) module Page.Settings exposing (Model, Msg, init, subscriptions, toSession, update, view)
import Api exposing (optionalError) import Api
import Avatar import Avatar
import Browser.Navigation as Nav import Browser.Navigation as Nav
import Email exposing (Email) import Email exposing (Email)
@@ -16,7 +16,6 @@ import Profile exposing (Profile)
import Route import Route
import Session exposing (Session) import Session exposing (Session)
import Username as Username exposing (Username) import Username as Username exposing (Username)
import Validate exposing (Valid, Validator, fromValid, ifBlank, validate)
import Viewer exposing (Viewer) import Viewer exposing (Viewer)
import Viewer.Cred as Cred exposing (Cred) import Viewer.Cred as Cred exposing (Cred)
@@ -27,24 +26,29 @@ import Viewer.Cred as Cred exposing (Cred)
type alias Model = type alias Model =
{ session : Session { session : Session
, errors : List Error , problems : List Problem
, form : Form , form : Form
} }
type alias Form = type alias Form =
{ avatar : Maybe String { avatar : String
, bio : String , bio : String
, email : String , email : String
, username : String , username : String
, password : Maybe String , password : String
} }
type Problem
= InvalidEntry ValidatedField String
| ServerError String
init : Session -> ( Model, Cmd msg ) init : Session -> ( Model, Cmd msg )
init session = init session =
( { session = session ( { session = session
, errors = [] , problems = []
, form = , form =
case Session.viewer session of case Session.viewer session of
Just viewer -> Just viewer ->
@@ -55,21 +59,21 @@ init session =
cred = cred =
Viewer.cred viewer Viewer.cred viewer
in in
{ avatar = Avatar.toMaybeString (Profile.avatar profile) { avatar = Maybe.withDefault "" (Avatar.toMaybeString (Profile.avatar profile))
, email = Email.toString (Viewer.email viewer) , email = Email.toString (Viewer.email viewer)
, bio = Maybe.withDefault "" (Profile.bio profile) , bio = Maybe.withDefault "" (Profile.bio profile)
, username = Username.toString cred.username , username = Username.toString cred.username
, password = Nothing , password = ""
} }
Nothing -> Nothing ->
-- It's fine to store a blank form here. You won't be -- It's fine to store a blank form here. You won't be
-- able to submit it if you're not logged in anyway. -- able to submit it if you're not logged in anyway.
{ avatar = Nothing { avatar = ""
, email = "" , email = ""
, bio = "" , bio = ""
, username = "" , username = ""
, password = Nothing , password = ""
} }
} }
, Cmd.none , Cmd.none
@@ -103,9 +107,8 @@ view model =
[ div [ class "row" ] [ div [ class "row" ]
[ div [ class "col-md-6 offset-md-3 col-xs-12" ] [ div [ class "col-md-6 offset-md-3 col-xs-12" ]
[ h1 [ class "text-xs-center" ] [ text "Your Settings" ] [ h1 [ class "text-xs-center" ] [ text "Your Settings" ]
, model.errors , ul [ class "error-messages" ]
|> List.map (\( _, error ) -> li [] [ text error ]) (List.map viewProblem model.problems)
|> ul [ class "error-messages" ]
, viewForm cred model.form , viewForm cred model.form
] ]
] ]
@@ -125,8 +128,8 @@ viewForm cred form =
[ input [ input
[ class "form-control" [ class "form-control"
, placeholder "URL of profile picture" , placeholder "URL of profile picture"
, value (Maybe.withDefault "" form.avatar) , value form.avatar
, onInput EnteredImage , onInput EnteredAvatar
] ]
[] []
] ]
@@ -163,7 +166,7 @@ viewForm cred form =
[ class "form-control form-control-lg" [ class "form-control form-control-lg"
, type_ "password" , type_ "password"
, placeholder "Password" , placeholder "Password"
, value (Maybe.withDefault "" form.password) , value form.password
, onInput EnteredPassword , 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 -- UPDATE
@@ -185,7 +202,7 @@ type Msg
| EnteredUsername String | EnteredUsername String
| EnteredPassword String | EnteredPassword String
| EnteredBio String | EnteredBio String
| EnteredImage String | EnteredAvatar String
| CompletedSave (Result Http.Error Viewer) | CompletedSave (Result Http.Error Viewer)
| GotSession Session | GotSession Session
@@ -194,15 +211,15 @@ update : Msg -> Model -> ( Model, Cmd Msg )
update msg model = update msg model =
case msg of case msg of
SubmittedForm cred -> SubmittedForm cred ->
case validate formValidator model.form of case validate model.form of
Ok validForm -> Ok validForm ->
( { model | errors = [] } ( { model | problems = [] }
, edit cred validForm , edit cred validForm
|> Http.send CompletedSave |> Http.send CompletedSave
) )
Err errors -> Err problems ->
( { model | errors = errors } ( { model | problems = problems }
, Cmd.none , Cmd.none
) )
@@ -212,39 +229,22 @@ update msg model =
EnteredUsername username -> EnteredUsername username ->
updateForm (\form -> { form | username = username }) model updateForm (\form -> { form | username = username }) model
EnteredPassword passwordStr -> EnteredPassword password ->
let
password =
if String.isEmpty passwordStr then
Nothing
else
Just passwordStr
in
updateForm (\form -> { form | password = password }) model updateForm (\form -> { form | password = password }) model
EnteredBio bio -> EnteredBio bio ->
updateForm (\form -> { form | bio = bio }) model updateForm (\form -> { form | bio = bio }) model
EnteredImage avatarStr -> EnteredAvatar avatar ->
let
avatar =
if String.isEmpty avatarStr then
Nothing
else
Just avatarStr
in
updateForm (\form -> { form | avatar = avatar }) model updateForm (\form -> { form | avatar = avatar }) model
CompletedSave (Err error) -> CompletedSave (Err error) ->
let let
serverErrors = serverErrors =
error Api.decodeErrors error
|> Api.listErrors errorsDecoder |> List.map ServerError
|> List.map (\errorMessage -> ( Server, errorMessage ))
in in
( { model | errors = List.append model.errors serverErrors } ( { model | problems = List.append model.problems serverErrors }
, Cmd.none , Cmd.none
) )
@@ -254,7 +254,9 @@ update msg model =
) )
GotSession session -> 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 {-| Helper function for `update`. Updates the form and returns Cmd.none and
@@ -284,36 +286,93 @@ toSession model =
-- VALIDATION -- FORM
type ErrorSource {-| Marks that we've trimmed the form's fields, so we don't accidentally send
= Server it to the server without having trimmed it!
| Username -}
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 | Email
| Password | Password
| ImageUrl
| Bio
type alias Error = fieldsToValidate : List ValidatedField
( ErrorSource, String ) fieldsToValidate =
[ Username
, Email
formValidator : Validator Error Form , Password
formValidator =
Validate.all
[ ifBlank .username ( Username, "username can't be blank." )
, ifBlank .email ( Email, "email can't be blank." )
] ]
errorsDecoder : Decoder (List String) {-| Trim the form and validate its fields. If there are problems, report them!
errorsDecoder = -}
Decode.succeed (\email username password -> List.concat [ email, username, password ]) validate : Form -> Result (List Problem) TrimmedForm
|> optionalError "email" validate form =
|> optionalError "username" let
|> optionalError "password" 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 {-| This takes a Valid Form as a reminder that it needs to have been validated
first. first.
-} -}
edit : Cred -> Valid Form -> Http.Request Viewer edit : Cred -> TrimmedForm -> Http.Request Viewer
edit cred validForm = edit cred (Trimmed form) =
let let
form = encodedAvatar =
fromValid validForm case form.avatar of
"" ->
Encode.null
avatar ->
Encode.string avatar
updates = updates =
[ Just ( "username", Encode.string form.username ) [ ( "username", Encode.string form.username )
, Just ( "email", Encode.string form.email ) , ( "email", Encode.string form.email )
, Just ( "bio", Encode.string form.bio ) , ( "bio", Encode.string form.bio )
, Just ( "image", Maybe.withDefault Encode.null (Maybe.map Encode.string form.avatar) ) , ( "image", encodedAvatar )
, Maybe.map (\pass -> ( "password", Encode.string pass )) form.password
] ]
|> List.filterMap identity
encodedUser =
Encode.object <|
case form.password of
"" ->
updates
password ->
( "password", Encode.string password ) :: updates
body = body =
( "user", Encode.object updates ) Encode.object [ ( "user", encodedUser ) ]
|> List.singleton
|> Encode.object
|> Http.jsonBody |> Http.jsonBody
expect = expect =
@@ -354,3 +423,12 @@ edit cred validForm =
|> HttpBuilder.withBody body |> HttpBuilder.withBody body
|> Cred.addHeader cred |> Cred.addHeader cred
|> HttpBuilder.toRequest |> HttpBuilder.toRequest
nothingIfEmpty : String -> Maybe String
nothingIfEmpty str =
if String.isEmpty str then
Nothing
else
Just str

View File

@@ -45,7 +45,12 @@ viewer session =
cred : Session -> Maybe Cred cred : Session -> Maybe Cred
cred session = cred session =
Maybe.map Viewer.cred (viewer session) case session of
LoggedIn _ val ->
Just (Viewer.cred val)
Guest _ ->
Nothing
navKey : Session -> Nav.Key navKey : Session -> Nav.Key

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. {-| The logged-in user currently viewing this page.
-} -}
@@ -47,6 +47,13 @@ email (Viewer info) =
info.email info.email
{-| Passwords must be at least this many characters long!
-}
minPasswordChars : Int
minPasswordChars =
6
-- SERIALIZATION -- SERIALIZATION
@@ -56,9 +63,16 @@ encode (Viewer info) =
Encode.object Encode.object
[ ( "email", Email.encode info.email ) [ ( "email", Email.encode info.email )
, ( "username", Username.encode info.cred.username ) , ( "username", Username.encode info.cred.username )
, ( "bio", Maybe.withDefault Encode.null (Maybe.map Encode.string (Profile.bio info.profile)) )
, ( "image", Avatar.encode (Profile.avatar info.profile) ) , ( "image", Avatar.encode (Profile.avatar info.profile) )
, ( "token", Cred.encodeToken info.cred ) , ( "token", Cred.encodeToken info.cred )
, ( "bio"
, case Profile.bio info.profile of
Just bio ->
Encode.string bio
Nothing ->
Encode.null
)
] ]