Rename part5 to part8
This commit is contained in:
Richard Feldman
@@ -1,588 +0,0 @@
|
||||
module Page.Article exposing (Model, Msg, init, subscriptions, toSession, update, view)
|
||||
|
||||
{-| Viewing an individual article.
|
||||
-}
|
||||
|
||||
import Api
|
||||
import Article exposing (Article, Full, Preview)
|
||||
import Article.Body exposing (Body)
|
||||
import Article.Comment as Comment exposing (Comment)
|
||||
import Article.Slug as Slug exposing (Slug)
|
||||
import Author exposing (Author(..), FollowedAuthor, UnfollowedAuthor)
|
||||
import Avatar
|
||||
import Browser.Navigation as Nav
|
||||
import CommentId exposing (CommentId)
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (attribute, class, disabled, href, id, placeholder)
|
||||
import Html.Events exposing (onClick, onInput, onSubmit)
|
||||
import Http
|
||||
import HttpBuilder exposing (RequestBuilder, withBody, withExpect, withQueryParams)
|
||||
import Loading
|
||||
import Log
|
||||
import Page
|
||||
import Profile exposing (Profile)
|
||||
import 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)
|
||||
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ session : Session
|
||||
, timeZone : Time.Zone
|
||||
, errors : List String
|
||||
|
||||
-- Loaded independently from server
|
||||
, comments : Status ( CommentText, List Comment )
|
||||
, article : Status (Article Full)
|
||||
}
|
||||
|
||||
|
||||
type Status a
|
||||
= Loading
|
||||
| LoadingSlowly
|
||||
| Loaded a
|
||||
| Failed
|
||||
|
||||
|
||||
type CommentText
|
||||
= Editing String
|
||||
| Sending String
|
||||
|
||||
|
||||
init : Session -> Slug -> ( Model, Cmd Msg )
|
||||
init session slug =
|
||||
let
|
||||
maybeCred =
|
||||
Session.cred session
|
||||
in
|
||||
( { session = session
|
||||
, timeZone = Time.utc
|
||||
, errors = []
|
||||
, comments = Loading
|
||||
, article = Loading
|
||||
}
|
||||
, Cmd.batch
|
||||
[ Article.fetch maybeCred slug
|
||||
|> Http.send CompletedLoadArticle
|
||||
, Comment.list maybeCred slug
|
||||
|> Http.send CompletedLoadComments
|
||||
, Task.perform GotTimeZone Time.here
|
||||
, Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
view : Model -> { title : String, content : Html Msg }
|
||||
view model =
|
||||
case model.article of
|
||||
Loaded article ->
|
||||
let
|
||||
{ title } =
|
||||
Article.metadata article
|
||||
|
||||
author =
|
||||
Article.author article
|
||||
|
||||
avatar =
|
||||
Profile.avatar (Author.profile author)
|
||||
|
||||
slug =
|
||||
Article.slug article
|
||||
|
||||
profile =
|
||||
Author.profile author
|
||||
|
||||
buttons =
|
||||
case Session.cred model.session of
|
||||
Just cred ->
|
||||
viewButtons cred article author
|
||||
|
||||
Nothing ->
|
||||
[]
|
||||
in
|
||||
{ title = title
|
||||
, content =
|
||||
div [ class "article-page" ]
|
||||
[ div [ class "banner" ]
|
||||
[ div [ class "container" ]
|
||||
[ h1 [] [ text title ]
|
||||
, div [ class "article-meta" ] <|
|
||||
List.append
|
||||
[ a [ Route.href (Route.Profile (Author.username author)) ]
|
||||
[ img [ Avatar.src (Profile.avatar profile) ] [] ]
|
||||
, div [ class "info" ]
|
||||
[ Author.view (Author.username author)
|
||||
, Timestamp.view model.timeZone (Article.metadata article).createdAt
|
||||
]
|
||||
]
|
||||
buttons
|
||||
, Page.viewErrors ClickedDismissErrors model.errors
|
||||
]
|
||||
]
|
||||
, div [ class "container page" ]
|
||||
[ div [ class "row article-content" ]
|
||||
[ div [ class "col-md-12" ]
|
||||
[ Article.Body.toHtml (Article.body article) [] ]
|
||||
]
|
||||
, hr [] []
|
||||
, div [ class "article-actions" ]
|
||||
[ div [ class "article-meta" ] <|
|
||||
List.append
|
||||
[ a [ Route.href (Route.Profile (Author.username author)) ]
|
||||
[ img [ Avatar.src avatar ] [] ]
|
||||
, div [ class "info" ]
|
||||
[ Author.view (Author.username author)
|
||||
, Timestamp.view model.timeZone (Article.metadata article).createdAt
|
||||
]
|
||||
]
|
||||
buttons
|
||||
]
|
||||
, div [ class "row" ]
|
||||
[ div [ class "col-xs-12 col-md-8 offset-md-2" ] <|
|
||||
-- Don't render the comments until the article has loaded!
|
||||
case model.comments of
|
||||
Loading ->
|
||||
[]
|
||||
|
||||
LoadingSlowly ->
|
||||
[ Loading.icon ]
|
||||
|
||||
Loaded ( commentText, comments ) ->
|
||||
-- Don't let users add comments until they can
|
||||
-- see the existing comments! Otherwise you
|
||||
-- may be about to repeat something that's
|
||||
-- already been said.
|
||||
viewAddComment slug commentText (Session.viewer model.session)
|
||||
:: List.map (viewComment model.timeZone slug) comments
|
||||
|
||||
Failed ->
|
||||
[ Loading.error "comments" ]
|
||||
]
|
||||
]
|
||||
]
|
||||
}
|
||||
|
||||
Loading ->
|
||||
{ title = "Article", content = text "" }
|
||||
|
||||
LoadingSlowly ->
|
||||
{ title = "Article", content = Loading.icon }
|
||||
|
||||
Failed ->
|
||||
{ title = "Article", content = Loading.error "article" }
|
||||
|
||||
|
||||
viewAddComment : Slug -> CommentText -> Maybe Viewer -> Html Msg
|
||||
viewAddComment slug commentText maybeViewer =
|
||||
case maybeViewer of
|
||||
Just viewer ->
|
||||
let
|
||||
avatar =
|
||||
Profile.avatar (Viewer.profile viewer)
|
||||
|
||||
cred =
|
||||
Viewer.cred viewer
|
||||
|
||||
( commentStr, buttonAttrs ) =
|
||||
case commentText of
|
||||
Editing str ->
|
||||
( str, [] )
|
||||
|
||||
Sending str ->
|
||||
( str, [ disabled True ] )
|
||||
in
|
||||
Html.form [ class "card comment-form", onSubmit (ClickedPostComment cred slug) ]
|
||||
[ div [ class "card-block" ]
|
||||
[ textarea
|
||||
[ class "form-control"
|
||||
, placeholder "Write a comment..."
|
||||
, attribute "rows" "3"
|
||||
, onInput EnteredCommentText
|
||||
]
|
||||
[]
|
||||
]
|
||||
, div [ class "card-footer" ]
|
||||
[ img [ class "comment-author-img", Avatar.src avatar ] []
|
||||
, button
|
||||
(class "btn btn-sm btn-primary" :: buttonAttrs)
|
||||
[ text "Post Comment" ]
|
||||
]
|
||||
]
|
||||
|
||||
Nothing ->
|
||||
p []
|
||||
[ a [ Route.href Route.Login ] [ text "Sign in" ]
|
||||
, text " or "
|
||||
, a [ Route.href Route.Register ] [ text "sign up" ]
|
||||
, text " to comment."
|
||||
]
|
||||
|
||||
|
||||
viewButtons : Cred -> Article Full -> Author -> List (Html Msg)
|
||||
viewButtons cred article author =
|
||||
case author of
|
||||
IsFollowing followedAuthor ->
|
||||
[ Author.unfollowButton ClickedUnfollow cred followedAuthor
|
||||
, text " "
|
||||
, favoriteButton cred article
|
||||
]
|
||||
|
||||
IsNotFollowing unfollowedAuthor ->
|
||||
[ Author.followButton ClickedFollow cred unfollowedAuthor
|
||||
, text " "
|
||||
, favoriteButton cred article
|
||||
]
|
||||
|
||||
IsViewer _ _ ->
|
||||
[ editButton article
|
||||
, text " "
|
||||
, deleteButton cred article
|
||||
]
|
||||
|
||||
|
||||
viewComment : Time.Zone -> Slug -> Comment -> Html Msg
|
||||
viewComment timeZone slug comment =
|
||||
let
|
||||
author =
|
||||
Comment.author comment
|
||||
|
||||
profile =
|
||||
Author.profile author
|
||||
|
||||
authorUsername =
|
||||
Author.username author
|
||||
|
||||
deleteCommentButton =
|
||||
case author of
|
||||
IsViewer cred _ ->
|
||||
let
|
||||
msg =
|
||||
ClickedDeleteComment cred slug (Comment.id comment)
|
||||
in
|
||||
span
|
||||
[ class "mod-options"
|
||||
, onClick msg
|
||||
]
|
||||
[ i [ class "ion-trash-a" ] [] ]
|
||||
|
||||
_ ->
|
||||
-- You can't delete other peoples' comments!
|
||||
text ""
|
||||
|
||||
timestamp =
|
||||
Timestamp.format timeZone (Comment.createdAt comment)
|
||||
in
|
||||
div [ class "card" ]
|
||||
[ div [ class "card-block" ]
|
||||
[ p [ class "card-text" ] [ text (Comment.body comment) ] ]
|
||||
, div [ class "card-footer" ]
|
||||
[ a [ class "comment-author", href "" ]
|
||||
[ img [ class "comment-author-img", Avatar.src (Profile.avatar profile) ] []
|
||||
, text " "
|
||||
]
|
||||
, text " "
|
||||
, a [ class "comment-author", Route.href (Route.Profile authorUsername) ]
|
||||
[ text (Username.toString authorUsername) ]
|
||||
, span [ class "date-posted" ] [ text timestamp ]
|
||||
, deleteCommentButton
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- UPDATE
|
||||
|
||||
|
||||
type Msg
|
||||
= ClickedDeleteArticle Cred Slug
|
||||
| ClickedDeleteComment Cred Slug CommentId
|
||||
| ClickedDismissErrors
|
||||
| ClickedFavorite Cred Slug Body
|
||||
| ClickedUnfavorite Cred Slug Body
|
||||
| ClickedFollow Cred UnfollowedAuthor
|
||||
| ClickedUnfollow Cred FollowedAuthor
|
||||
| ClickedPostComment Cred Slug
|
||||
| EnteredCommentText String
|
||||
| CompletedLoadArticle (Result Http.Error (Article Full))
|
||||
| CompletedLoadComments (Result Http.Error (List Comment))
|
||||
| CompletedDeleteArticle (Result Http.Error ())
|
||||
| CompletedDeleteComment CommentId (Result Http.Error ())
|
||||
| CompletedFavoriteChange (Result Http.Error (Article Full))
|
||||
| CompletedFollowChange (Result Http.Error Author)
|
||||
| CompletedPostComment (Result Http.Error Comment)
|
||||
| GotTimeZone Time.Zone
|
||||
| GotSession Session
|
||||
| PassedSlowLoadThreshold
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
update msg model =
|
||||
case msg of
|
||||
ClickedDismissErrors ->
|
||||
( { model | errors = [] }, Cmd.none )
|
||||
|
||||
ClickedFavorite cred slug body ->
|
||||
( model, fave Article.favorite cred slug body )
|
||||
|
||||
ClickedUnfavorite cred slug body ->
|
||||
( model, fave Article.unfavorite cred slug body )
|
||||
|
||||
CompletedLoadArticle (Ok article) ->
|
||||
( { model | article = Loaded article }, Cmd.none )
|
||||
|
||||
CompletedLoadArticle (Err error) ->
|
||||
( { model | article = Failed }
|
||||
, Log.error
|
||||
)
|
||||
|
||||
CompletedLoadComments (Ok comments) ->
|
||||
( { model | comments = Loaded ( Editing "", comments ) }, Cmd.none )
|
||||
|
||||
CompletedLoadComments (Err error) ->
|
||||
( { model | article = Failed }, Log.error )
|
||||
|
||||
CompletedFavoriteChange (Ok newArticle) ->
|
||||
( { model | article = Loaded newArticle }, Cmd.none )
|
||||
|
||||
CompletedFavoriteChange (Err error) ->
|
||||
( { model | errors = Api.addServerError model.errors }
|
||||
, Log.error
|
||||
)
|
||||
|
||||
ClickedUnfollow cred followedAuthor ->
|
||||
( model
|
||||
, Author.requestUnfollow followedAuthor cred
|
||||
|> Http.send CompletedFollowChange
|
||||
)
|
||||
|
||||
ClickedFollow cred unfollowedAuthor ->
|
||||
( model
|
||||
, Author.requestFollow unfollowedAuthor cred
|
||||
|> Http.send CompletedFollowChange
|
||||
)
|
||||
|
||||
CompletedFollowChange (Ok newAuthor) ->
|
||||
case model.article of
|
||||
Loaded article ->
|
||||
( { model | article = Loaded (Article.mapAuthor (\_ -> newAuthor) article) }, Cmd.none )
|
||||
|
||||
_ ->
|
||||
( model, Log.error )
|
||||
|
||||
CompletedFollowChange (Err error) ->
|
||||
( { model | errors = Api.addServerError model.errors }
|
||||
, Log.error
|
||||
)
|
||||
|
||||
EnteredCommentText str ->
|
||||
case model.comments of
|
||||
Loaded ( Editing _, comments ) ->
|
||||
-- You can only edit comment text once comments have loaded
|
||||
-- successfully, and when the comment is not currently
|
||||
-- being submitted.
|
||||
( { model | comments = Loaded ( Editing str, comments ) }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
_ ->
|
||||
( model, Log.error )
|
||||
|
||||
ClickedPostComment cred slug ->
|
||||
case model.comments of
|
||||
Loaded ( Editing "", comments ) ->
|
||||
-- No posting empty comments!
|
||||
-- We don't use Log.error here because this isn't an error,
|
||||
-- it just doesn't do anything.
|
||||
( model, Cmd.none )
|
||||
|
||||
Loaded ( Editing str, comments ) ->
|
||||
( { model | comments = Loaded ( Sending str, comments ) }
|
||||
, cred
|
||||
|> Comment.post slug str
|
||||
|> Http.send CompletedPostComment
|
||||
)
|
||||
|
||||
_ ->
|
||||
-- Either we have no comment to post, or there's already
|
||||
-- one in the process of being posted, or we don't have
|
||||
-- a valid article, in which case how did we post this?
|
||||
( model, Log.error )
|
||||
|
||||
CompletedPostComment (Ok comment) ->
|
||||
case model.comments of
|
||||
Loaded ( _, comments ) ->
|
||||
( { model | comments = Loaded ( Editing "", comment :: comments ) }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
_ ->
|
||||
( model, Log.error )
|
||||
|
||||
CompletedPostComment (Err error) ->
|
||||
( { model | errors = Api.addServerError model.errors }
|
||||
, Log.error
|
||||
)
|
||||
|
||||
ClickedDeleteComment cred slug id ->
|
||||
( model
|
||||
, cred
|
||||
|> Comment.delete slug id
|
||||
|> Http.send (CompletedDeleteComment id)
|
||||
)
|
||||
|
||||
CompletedDeleteComment id (Ok ()) ->
|
||||
case model.comments of
|
||||
Loaded ( commentText, comments ) ->
|
||||
( { model | comments = Loaded ( commentText, withoutComment id comments ) }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
_ ->
|
||||
( model, Log.error )
|
||||
|
||||
CompletedDeleteComment id (Err error) ->
|
||||
( { model | errors = Api.addServerError model.errors }
|
||||
, Log.error
|
||||
)
|
||||
|
||||
ClickedDeleteArticle cred slug ->
|
||||
( model
|
||||
, delete slug cred
|
||||
|> Http.send CompletedDeleteArticle
|
||||
)
|
||||
|
||||
CompletedDeleteArticle (Ok ()) ->
|
||||
( model, Route.replaceUrl (Session.navKey model.session) Route.Home )
|
||||
|
||||
CompletedDeleteArticle (Err error) ->
|
||||
( { model | errors = Api.addServerError model.errors }
|
||||
, Log.error
|
||||
)
|
||||
|
||||
GotTimeZone tz ->
|
||||
( { model | timeZone = tz }, Cmd.none )
|
||||
|
||||
GotSession session ->
|
||||
( { 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 )
|
||||
|
||||
|
||||
|
||||
-- SUBSCRIPTIONS
|
||||
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions model =
|
||||
Session.changes GotSession (Session.navKey model.session)
|
||||
|
||||
|
||||
|
||||
-- HTTP
|
||||
|
||||
|
||||
delete : Slug -> Cred -> Http.Request ()
|
||||
delete slug cred =
|
||||
Article.url slug []
|
||||
|> HttpBuilder.delete
|
||||
|> Cred.addHeader cred
|
||||
|> HttpBuilder.toRequest
|
||||
|
||||
|
||||
|
||||
-- EXPORT
|
||||
|
||||
|
||||
toSession : Model -> Session
|
||||
toSession model =
|
||||
model.session
|
||||
|
||||
|
||||
|
||||
-- INTERNAL
|
||||
|
||||
|
||||
fave : (Slug -> Cred -> Http.Request (Article Preview)) -> Cred -> Slug -> Body -> Cmd Msg
|
||||
fave toRequest cred slug body =
|
||||
toRequest slug cred
|
||||
|> Http.toTask
|
||||
|> Task.map (Article.fromPreview body)
|
||||
|> Task.attempt CompletedFavoriteChange
|
||||
|
||||
|
||||
withoutComment : CommentId -> List Comment -> List Comment
|
||||
withoutComment id list =
|
||||
List.filter (\comment -> Comment.id comment /= id) list
|
||||
|
||||
|
||||
favoriteButton : Cred -> Article Full -> Html Msg
|
||||
favoriteButton cred article =
|
||||
let
|
||||
{ favoritesCount, favorited } =
|
||||
Article.metadata article
|
||||
|
||||
slug =
|
||||
Article.slug article
|
||||
|
||||
body =
|
||||
Article.body article
|
||||
|
||||
kids =
|
||||
[ text (" Favorite Article (" ++ String.fromInt favoritesCount ++ ")") ]
|
||||
in
|
||||
if favorited then
|
||||
Article.unfavoriteButton cred (ClickedUnfavorite cred slug body) [] kids
|
||||
|
||||
else
|
||||
Article.favoriteButton cred (ClickedFavorite cred slug body) [] kids
|
||||
|
||||
|
||||
deleteButton : Cred -> Article a -> Html Msg
|
||||
deleteButton cred article =
|
||||
let
|
||||
msg =
|
||||
ClickedDeleteArticle cred (Article.slug article)
|
||||
in
|
||||
button [ class "btn btn-outline-danger btn-sm", onClick msg ]
|
||||
[ i [ class "ion-trash-a" ] [], text " Delete Article" ]
|
||||
|
||||
|
||||
editButton : Article a -> Html Msg
|
||||
editButton article =
|
||||
a [ class "btn btn-outline-secondary btn-sm", Route.href (Route.EditArticle (Article.slug article)) ]
|
||||
[ i [ class "ion-edit" ] [], text " Edit Article" ]
|
||||
@@ -1,641 +0,0 @@
|
||||
module Page.Article.Editor exposing (Model, Msg, initEdit, initNew, subscriptions, toSession, update, view)
|
||||
|
||||
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)
|
||||
import Html.Events exposing (onInput, onSubmit)
|
||||
import Http
|
||||
import HttpBuilder exposing (withBody, withExpect)
|
||||
import Json.Decode as Decode
|
||||
import Json.Encode as Encode
|
||||
import Loading
|
||||
import Page
|
||||
import Profile exposing (Profile)
|
||||
import Route
|
||||
import Session exposing (Session)
|
||||
import Task exposing (Task)
|
||||
import Time
|
||||
import Viewer exposing (Viewer)
|
||||
import Viewer.Cred as Cred exposing (Cred)
|
||||
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ session : Session
|
||||
, status : Status
|
||||
}
|
||||
|
||||
|
||||
type
|
||||
Status
|
||||
-- Edit Article
|
||||
= Loading Slug
|
||||
| LoadingSlowly Slug
|
||||
| LoadingFailed Slug
|
||||
| Saving Slug Form
|
||||
| Editing Slug (List Problem) Form
|
||||
-- New Article
|
||||
| EditingNew (List Problem) Form
|
||||
| Creating Form
|
||||
|
||||
|
||||
type Problem
|
||||
= InvalidEntry ValidatedField String
|
||||
| ServerError String
|
||||
|
||||
|
||||
type alias Form =
|
||||
{ title : String
|
||||
, body : String
|
||||
, description : String
|
||||
, tags : String
|
||||
}
|
||||
|
||||
|
||||
initNew : Session -> ( Model, Cmd msg )
|
||||
initNew session =
|
||||
( { session = session
|
||||
, status =
|
||||
EditingNew []
|
||||
{ title = ""
|
||||
, body = ""
|
||||
, description = ""
|
||||
, tags = ""
|
||||
}
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
|
||||
initEdit : Session -> Slug -> ( Model, Cmd Msg )
|
||||
initEdit session slug =
|
||||
( { session = session
|
||||
, status = Loading 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
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
view : Model -> { title : String, content : Html Msg }
|
||||
view model =
|
||||
{ title =
|
||||
case getSlug model.status of
|
||||
Just slug ->
|
||||
"Edit Article - " ++ Slug.toString slug
|
||||
|
||||
Nothing ->
|
||||
"New Article"
|
||||
, content =
|
||||
case Session.cred model.session of
|
||||
Just cred ->
|
||||
viewAuthenticated cred model
|
||||
|
||||
Nothing ->
|
||||
text "Sign in to edit this article."
|
||||
}
|
||||
|
||||
|
||||
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 ->
|
||||
[ viewForm cred form (editArticleSaveButton [ disabled True ]) ]
|
||||
|
||||
Creating form ->
|
||||
[ viewForm cred form (newArticleSaveButton [ disabled True ]) ]
|
||||
|
||||
Editing slug problems form ->
|
||||
[ viewProblems problems
|
||||
, viewForm cred form (editArticleSaveButton [])
|
||||
]
|
||||
|
||||
EditingNew problems form ->
|
||||
[ viewProblems problems
|
||||
, viewForm cred form (newArticleSaveButton [])
|
||||
]
|
||||
|
||||
LoadingFailed _ ->
|
||||
[ text "Article failed to load." ]
|
||||
in
|
||||
div [ class "editor-page" ]
|
||||
[ div [ class "container page" ]
|
||||
[ div [ class "row" ]
|
||||
[ div [ class "col-md-10 offset-md-1 col-xs-12" ]
|
||||
formHtml
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewForm : Cred -> Form -> Html Msg -> Html Msg
|
||||
viewForm cred fields saveButton =
|
||||
Html.form [ onSubmit (ClickedSave cred) ]
|
||||
[ fieldset []
|
||||
[ fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control form-control-lg"
|
||||
, placeholder "Article Title"
|
||||
, onInput EnteredTitle
|
||||
, value fields.title
|
||||
]
|
||||
[]
|
||||
]
|
||||
, fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control"
|
||||
, placeholder "What's this article about?"
|
||||
, onInput EnteredDescription
|
||||
, value fields.description
|
||||
]
|
||||
[]
|
||||
]
|
||||
, fieldset [ class "form-group" ]
|
||||
[ textarea
|
||||
[ class "form-control"
|
||||
, placeholder "Write your article (in markdown)"
|
||||
, attribute "rows" "8"
|
||||
, onInput EnteredBody
|
||||
, value fields.body
|
||||
]
|
||||
[]
|
||||
]
|
||||
, fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control"
|
||||
, placeholder "Enter tags"
|
||||
, onInput EnteredTags
|
||||
, value fields.tags
|
||||
]
|
||||
[]
|
||||
]
|
||||
, saveButton
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
editArticleSaveButton : List (Attribute msg) -> Html msg
|
||||
editArticleSaveButton extraAttrs =
|
||||
saveArticleButton "Update Article" extraAttrs
|
||||
|
||||
|
||||
newArticleSaveButton : List (Attribute msg) -> Html msg
|
||||
newArticleSaveButton extraAttrs =
|
||||
saveArticleButton "Publish Article" extraAttrs
|
||||
|
||||
|
||||
saveArticleButton : String -> List (Attribute msg) -> Html msg
|
||||
saveArticleButton caption extraAttrs =
|
||||
button (class "btn btn-lg pull-xs-right btn-primary" :: extraAttrs)
|
||||
[ text caption ]
|
||||
|
||||
|
||||
|
||||
-- UPDATE
|
||||
|
||||
|
||||
type Msg
|
||||
= ClickedSave Cred
|
||||
| EnteredBody String
|
||||
| EnteredDescription String
|
||||
| EnteredTags String
|
||||
| EnteredTitle String
|
||||
| CompletedCreate (Result Http.Error (Article Full))
|
||||
| CompletedEdit (Result Http.Error (Article Full))
|
||||
| CompletedArticleLoad (Result ( Slug, Http.Error ) (Article Full))
|
||||
| GotSession Session
|
||||
| PassedSlowLoadThreshold
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
update msg model =
|
||||
case msg of
|
||||
ClickedSave cred ->
|
||||
model.status
|
||||
|> save cred
|
||||
|> Tuple.mapFirst (\status -> { model | status = status })
|
||||
|
||||
EnteredTitle title ->
|
||||
updateForm (\form -> { form | title = title }) model
|
||||
|
||||
EnteredDescription description ->
|
||||
updateForm (\form -> { form | description = description }) model
|
||||
|
||||
EnteredTags tags ->
|
||||
updateForm (\form -> { form | tags = tags }) model
|
||||
|
||||
EnteredBody body ->
|
||||
updateForm (\form -> { form | body = body }) model
|
||||
|
||||
CompletedCreate (Ok article) ->
|
||||
( model
|
||||
, Route.Article (Article.slug article)
|
||||
|> Route.replaceUrl (Session.navKey model.session)
|
||||
)
|
||||
|
||||
CompletedCreate (Err error) ->
|
||||
( { model | status = savingError error model.status }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
CompletedEdit (Ok article) ->
|
||||
( model
|
||||
, Route.Article (Article.slug article)
|
||||
|> Route.replaceUrl (Session.navKey model.session)
|
||||
)
|
||||
|
||||
CompletedEdit (Err error) ->
|
||||
( { model | status = savingError error model.status }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
CompletedArticleLoad (Err ( slug, error )) ->
|
||||
( { model | status = LoadingFailed slug }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
CompletedArticleLoad (Ok article) ->
|
||||
let
|
||||
{ title, description, tags } =
|
||||
Article.metadata article
|
||||
|
||||
status =
|
||||
Editing (Article.slug article)
|
||||
[]
|
||||
{ title = title
|
||||
, body = Article.Body.toMarkdownString (Article.body article)
|
||||
, description = description
|
||||
, tags = String.join " " tags
|
||||
}
|
||||
in
|
||||
( { model | status = status }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
GotSession session ->
|
||||
( { 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 _ form ->
|
||||
case validate form of
|
||||
Ok validForm ->
|
||||
( Saving slug form
|
||||
, edit slug validForm cred
|
||||
|> Http.send CompletedEdit
|
||||
)
|
||||
|
||||
Err problems ->
|
||||
( Editing slug problems form
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
EditingNew _ form ->
|
||||
case validate form of
|
||||
Ok validForm ->
|
||||
( Creating form
|
||||
, create validForm cred
|
||||
|> Http.send CompletedCreate
|
||||
)
|
||||
|
||||
Err problems ->
|
||||
( EditingNew problems form
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
_ ->
|
||||
-- We're in a state where saving is not allowed.
|
||||
-- We tried to prevent getting here by disabling the Save
|
||||
-- button, but somehow the user got here anyway!
|
||||
--
|
||||
-- If we had an error logging service, we would send
|
||||
-- something to it here!
|
||||
( status, Cmd.none )
|
||||
|
||||
|
||||
savingError : Http.Error -> Status -> Status
|
||||
savingError error status =
|
||||
let
|
||||
problems =
|
||||
[ ServerError "Error saving article" ]
|
||||
in
|
||||
case status of
|
||||
Saving slug form ->
|
||||
Editing slug problems form
|
||||
|
||||
Creating form ->
|
||||
EditingNew problems form
|
||||
|
||||
_ ->
|
||||
status
|
||||
|
||||
|
||||
{-| Helper function for `update`. Updates the form, if there is one,
|
||||
and returns Cmd.none.
|
||||
|
||||
Useful for recording form fields!
|
||||
|
||||
This could also log errors to the server if we are trying to record things in
|
||||
the form and we don't actually have a form.
|
||||
|
||||
-}
|
||||
updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
|
||||
updateForm transform model =
|
||||
let
|
||||
newModel =
|
||||
case model.status of
|
||||
Loading _ ->
|
||||
model
|
||||
|
||||
LoadingSlowly _ ->
|
||||
model
|
||||
|
||||
LoadingFailed _ ->
|
||||
model
|
||||
|
||||
Saving slug form ->
|
||||
{ model | status = Saving slug (transform form) }
|
||||
|
||||
Editing slug errors form ->
|
||||
{ model | status = Editing slug errors (transform form) }
|
||||
|
||||
EditingNew errors form ->
|
||||
{ model | status = EditingNew errors (transform form) }
|
||||
|
||||
Creating form ->
|
||||
{ model | status = Creating (transform form) }
|
||||
in
|
||||
( newModel, Cmd.none )
|
||||
|
||||
|
||||
|
||||
-- SUBSCRIPTIONS
|
||||
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions model =
|
||||
Session.changes GotSession (Session.navKey model.session)
|
||||
|
||||
|
||||
|
||||
-- FORM
|
||||
|
||||
|
||||
{-| Marks that we've trimmed the form's fields, so we don't accidentally send
|
||||
it to the server without having trimmed it!
|
||||
-}
|
||||
type TrimmedForm
|
||||
= Trimmed Form
|
||||
|
||||
|
||||
{-| When adding a variant here, add it to `fieldsToValidate` too!
|
||||
-}
|
||||
type ValidatedField
|
||||
= Title
|
||||
| Body
|
||||
|
||||
|
||||
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 : TrimmedForm -> Cred -> Http.Request (Article Full)
|
||||
create (Trimmed form) cred =
|
||||
let
|
||||
expect =
|
||||
Article.fullDecoder (Just cred)
|
||||
|> Decode.field "article"
|
||||
|> Http.expectJson
|
||||
|
||||
article =
|
||||
Encode.object
|
||||
[ ( "title", Encode.string form.title )
|
||||
, ( "description", Encode.string form.description )
|
||||
, ( "body", Encode.string form.body )
|
||||
, ( "tagList", Encode.list Encode.string (toTagList form.tags) )
|
||||
]
|
||||
|
||||
jsonBody =
|
||||
Encode.object [ ( "article", article ) ]
|
||||
|> Http.jsonBody
|
||||
in
|
||||
Api.url [ "articles" ]
|
||||
|> HttpBuilder.post
|
||||
|> Cred.addHeader cred
|
||||
|> withBody jsonBody
|
||||
|> withExpect expect
|
||||
|> HttpBuilder.toRequest
|
||||
|
||||
|
||||
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
|
||||
|
||||
|
||||
edit : Slug -> TrimmedForm -> Cred -> Http.Request (Article Full)
|
||||
edit articleSlug (Trimmed form) cred =
|
||||
let
|
||||
expect =
|
||||
Article.fullDecoder (Just cred)
|
||||
|> Decode.field "article"
|
||||
|> Http.expectJson
|
||||
|
||||
article =
|
||||
Encode.object
|
||||
[ ( "title", Encode.string form.title )
|
||||
, ( "description", Encode.string form.description )
|
||||
, ( "body", Encode.string form.body )
|
||||
]
|
||||
|
||||
jsonBody =
|
||||
Encode.object [ ( "article", article ) ]
|
||||
|> Http.jsonBody
|
||||
in
|
||||
Article.url articleSlug []
|
||||
|> HttpBuilder.put
|
||||
|> Cred.addHeader cred
|
||||
|> withBody jsonBody
|
||||
|> withExpect expect
|
||||
|> HttpBuilder.toRequest
|
||||
|
||||
|
||||
|
||||
-- EXPORT
|
||||
|
||||
|
||||
toSession : Model -> Session
|
||||
toSession model =
|
||||
model.session
|
||||
|
||||
|
||||
|
||||
-- INTERNAL
|
||||
|
||||
|
||||
{-| Used for setting the page's title.
|
||||
-}
|
||||
getSlug : Status -> Maybe Slug
|
||||
getSlug status =
|
||||
case status of
|
||||
Loading slug ->
|
||||
Just slug
|
||||
|
||||
LoadingSlowly slug ->
|
||||
Just slug
|
||||
|
||||
LoadingFailed slug ->
|
||||
Just slug
|
||||
|
||||
Saving slug _ ->
|
||||
Just slug
|
||||
|
||||
Editing slug _ _ ->
|
||||
Just slug
|
||||
|
||||
EditingNew _ _ ->
|
||||
Nothing
|
||||
|
||||
Creating _ ->
|
||||
Nothing
|
||||
@@ -1,10 +0,0 @@
|
||||
module Page.Blank exposing (view)
|
||||
|
||||
import Html exposing (Html)
|
||||
|
||||
|
||||
view : { title : String, content : Html msg }
|
||||
view =
|
||||
{ title = ""
|
||||
, content = Html.text ""
|
||||
}
|
||||
@@ -1,259 +0,0 @@
|
||||
module Page.Home exposing (Model, Msg, init, subscriptions, toSession, update, view)
|
||||
|
||||
{-| The homepage. You can get here via either the / or /#/ routes.
|
||||
-}
|
||||
|
||||
import Article
|
||||
import Article.Feed as Feed
|
||||
import Article.FeedSources as FeedSources exposing (FeedSources, Source(..))
|
||||
import Article.Tag as Tag exposing (Tag)
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (attribute, class, classList, href, id, placeholder)
|
||||
import Html.Events exposing (onClick)
|
||||
import Http
|
||||
import Loading
|
||||
import Log
|
||||
import Page
|
||||
import Session exposing (Session)
|
||||
import Task exposing (Task)
|
||||
import Time
|
||||
import Viewer.Cred as Cred exposing (Cred)
|
||||
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ session : Session
|
||||
, timeZone : Time.Zone
|
||||
|
||||
-- Loaded independently from server
|
||||
, tags : Status (List Tag)
|
||||
, feed : Status Feed.Model
|
||||
}
|
||||
|
||||
|
||||
type Status a
|
||||
= Loading
|
||||
| LoadingSlowly
|
||||
| Loaded a
|
||||
| Failed
|
||||
|
||||
|
||||
init : Session -> ( Model, Cmd Msg )
|
||||
init session =
|
||||
let
|
||||
feedSources =
|
||||
case Session.cred session of
|
||||
Just cred ->
|
||||
FeedSources.fromLists (YourFeed cred) [ GlobalFeed ]
|
||||
|
||||
Nothing ->
|
||||
FeedSources.fromLists GlobalFeed []
|
||||
|
||||
loadTags =
|
||||
Tag.list
|
||||
|> Http.toTask
|
||||
in
|
||||
( { session = session
|
||||
, timeZone = Time.utc
|
||||
, tags = Loading
|
||||
, feed = Loading
|
||||
}
|
||||
, Cmd.batch
|
||||
[ Feed.init session feedSources
|
||||
|> Task.attempt CompletedFeedLoad
|
||||
, Tag.list
|
||||
|> Http.send CompletedTagsLoad
|
||||
, Task.perform GotTimeZone Time.here
|
||||
, Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
view : Model -> { title : String, content : Html Msg }
|
||||
view model =
|
||||
{ title = "Conduit"
|
||||
, content =
|
||||
div [ class "home-page" ]
|
||||
[ viewBanner
|
||||
, div [ class "container page" ]
|
||||
[ div [ class "row" ]
|
||||
[ div [ class "col-md-9" ] <|
|
||||
case model.feed of
|
||||
Loaded feed ->
|
||||
viewFeed model.timeZone feed
|
||||
|
||||
Loading ->
|
||||
[]
|
||||
|
||||
LoadingSlowly ->
|
||||
[ Loading.icon ]
|
||||
|
||||
Failed ->
|
||||
[ Loading.error "feed" ]
|
||||
, 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 ->
|
||||
[ Loading.error "tags" ]
|
||||
]
|
||||
]
|
||||
]
|
||||
}
|
||||
|
||||
|
||||
viewBanner : Html msg
|
||||
viewBanner =
|
||||
div [ class "banner" ]
|
||||
[ div [ class "container" ]
|
||||
[ h1 [ class "logo-font" ] [ text "conduit" ]
|
||||
, p [] [ text "A place to share your knowledge." ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewFeed : Time.Zone -> Feed.Model -> List (Html Msg)
|
||||
viewFeed timeZone feed =
|
||||
div [ class "feed-toggle" ]
|
||||
[ Feed.viewFeedSources feed |> Html.map GotFeedMsg ]
|
||||
:: (Feed.viewArticles timeZone feed |> List.map (Html.map GotFeedMsg))
|
||||
|
||||
|
||||
viewTags : List Tag -> Html Msg
|
||||
viewTags tags =
|
||||
div [ class "tag-list" ] (List.map viewTag tags)
|
||||
|
||||
|
||||
viewTag : Tag -> Html Msg
|
||||
viewTag tagName =
|
||||
a
|
||||
[ class "tag-pill tag-default"
|
||||
, onClick (ClickedTag tagName)
|
||||
|
||||
-- The RealWorld CSS requires an href to work properly.
|
||||
, href ""
|
||||
]
|
||||
[ text (Tag.toString tagName) ]
|
||||
|
||||
|
||||
|
||||
-- UPDATE
|
||||
|
||||
|
||||
type Msg
|
||||
= ClickedTag Tag
|
||||
| CompletedFeedLoad (Result Http.Error Feed.Model)
|
||||
| CompletedTagsLoad (Result Http.Error (List Tag))
|
||||
| GotTimeZone Time.Zone
|
||||
| GotFeedMsg Feed.Msg
|
||||
| GotSession Session
|
||||
| PassedSlowLoadThreshold
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
update msg model =
|
||||
case msg of
|
||||
ClickedTag tagName ->
|
||||
let
|
||||
subCmd =
|
||||
Feed.selectTag (Session.cred model.session) tagName
|
||||
in
|
||||
( model, Cmd.map GotFeedMsg subCmd )
|
||||
|
||||
CompletedFeedLoad (Ok feed) ->
|
||||
( { model | feed = Loaded feed }, Cmd.none )
|
||||
|
||||
CompletedFeedLoad (Err error) ->
|
||||
( { model | feed = Failed }, Cmd.none )
|
||||
|
||||
CompletedTagsLoad (Ok tags) ->
|
||||
( { model | tags = Loaded tags }, Cmd.none )
|
||||
|
||||
CompletedTagsLoad (Err error) ->
|
||||
( { model | tags = Failed }
|
||||
, Log.error
|
||||
)
|
||||
|
||||
GotFeedMsg subMsg ->
|
||||
case model.feed of
|
||||
Loaded feed ->
|
||||
let
|
||||
( newFeed, subCmd ) =
|
||||
Feed.update (Session.cred model.session) subMsg feed
|
||||
in
|
||||
( { model | feed = Loaded newFeed }
|
||||
, Cmd.map GotFeedMsg subCmd
|
||||
)
|
||||
|
||||
Loading ->
|
||||
( model, Log.error )
|
||||
|
||||
LoadingSlowly ->
|
||||
( model, Log.error )
|
||||
|
||||
Failed ->
|
||||
( model, Log.error )
|
||||
|
||||
GotTimeZone tz ->
|
||||
( { model | timeZone = tz }, Cmd.none )
|
||||
|
||||
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
|
||||
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions model =
|
||||
Session.changes GotSession (Session.navKey model.session)
|
||||
|
||||
|
||||
|
||||
-- EXPORT
|
||||
|
||||
|
||||
toSession : Model -> Session
|
||||
toSession model =
|
||||
model.session
|
||||
@@ -1,317 +0,0 @@
|
||||
module Page.Login exposing (Model, Msg, init, subscriptions, toSession, update, view)
|
||||
|
||||
{-| The login page.
|
||||
-}
|
||||
|
||||
import Api
|
||||
import Browser.Navigation as Nav
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (..)
|
||||
import Http
|
||||
import Json.Decode as Decode exposing (Decoder, decodeString, field, string)
|
||||
import Json.Decode.Pipeline exposing (optional)
|
||||
import Json.Encode as Encode
|
||||
import Route exposing (Route)
|
||||
import Session exposing (Session)
|
||||
import Viewer exposing (Viewer)
|
||||
import Viewer.Cred as Cred exposing (Cred)
|
||||
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ session : Session
|
||||
, 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
|
||||
}
|
||||
|
||||
|
||||
init : Session -> ( Model, Cmd msg )
|
||||
init session =
|
||||
( { session = session
|
||||
, problems = []
|
||||
, form =
|
||||
{ email = ""
|
||||
, password = ""
|
||||
}
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
view : Model -> { title : String, content : Html Msg }
|
||||
view model =
|
||||
{ title = "Login"
|
||||
, content =
|
||||
div [ class "cred-page" ]
|
||||
[ div [ class "container page" ]
|
||||
[ div [ class "row" ]
|
||||
[ div [ class "col-md-6 offset-md-3 col-xs-12" ]
|
||||
[ h1 [ class "text-xs-center" ] [ text "Sign in" ]
|
||||
, p [ class "text-xs-center" ]
|
||||
[ a [ Route.href Route.Register ]
|
||||
[ text "Need an account?" ]
|
||||
]
|
||||
, ul [ class "error-messages" ]
|
||||
(List.map viewProblem model.problems)
|
||||
, viewForm model.form
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
}
|
||||
|
||||
|
||||
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 ]
|
||||
[ fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control form-control-lg"
|
||||
, placeholder "Email"
|
||||
, onInput EnteredEmail
|
||||
, value form.email
|
||||
]
|
||||
[]
|
||||
]
|
||||
, fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control form-control-lg"
|
||||
, type_ "password"
|
||||
, placeholder "Password"
|
||||
, onInput EnteredPassword
|
||||
, value form.password
|
||||
]
|
||||
[]
|
||||
]
|
||||
, button [ class "btn btn-lg btn-primary pull-xs-right" ]
|
||||
[ text "Sign in" ]
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- UPDATE
|
||||
|
||||
|
||||
type Msg
|
||||
= SubmittedForm
|
||||
| EnteredEmail String
|
||||
| EnteredPassword String
|
||||
| CompletedLogin (Result Http.Error Viewer)
|
||||
| GotSession Session
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
update msg model =
|
||||
case msg of
|
||||
SubmittedForm ->
|
||||
case validate model.form of
|
||||
Ok validForm ->
|
||||
( { model | problems = [] }
|
||||
, Http.send CompletedLogin (login validForm)
|
||||
)
|
||||
|
||||
Err problems ->
|
||||
( { model | problems = problems }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
EnteredEmail email ->
|
||||
updateForm (\form -> { form | email = email }) model
|
||||
|
||||
EnteredPassword password ->
|
||||
updateForm (\form -> { form | password = password }) model
|
||||
|
||||
CompletedLogin (Err error) ->
|
||||
let
|
||||
serverErrors =
|
||||
Api.decodeErrors error
|
||||
|> List.map ServerError
|
||||
in
|
||||
( { model | problems = List.append model.problems serverErrors }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
CompletedLogin (Ok viewer) ->
|
||||
( model
|
||||
, Session.login viewer
|
||||
)
|
||||
|
||||
GotSession session ->
|
||||
( { model | session = session }
|
||||
, Route.replaceUrl (Session.navKey session) Route.Home
|
||||
)
|
||||
|
||||
|
||||
{-| Helper function for `update`. Updates the form and returns Cmd.none and
|
||||
Ignored. Useful for recording form fields!
|
||||
-}
|
||||
updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
|
||||
updateForm transform model =
|
||||
( { model | form = transform model.form }, Cmd.none )
|
||||
|
||||
|
||||
|
||||
-- SUBSCRIPTIONS
|
||||
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions model =
|
||||
Session.changes GotSession (Session.navKey model.session)
|
||||
|
||||
|
||||
|
||||
-- FORM
|
||||
|
||||
|
||||
{-| Marks that we've trimmed the form's fields, so we don't accidentally send
|
||||
it to the server without having trimmed it!
|
||||
-}
|
||||
type TrimmedForm
|
||||
= Trimmed Form
|
||||
|
||||
|
||||
{-| When adding a variant here, add it to `fieldsToValidate` too!
|
||||
-}
|
||||
type ValidatedField
|
||||
= Email
|
||||
| Password
|
||||
|
||||
|
||||
fieldsToValidate : List ValidatedField
|
||||
fieldsToValidate =
|
||||
[ Email
|
||||
, Password
|
||||
]
|
||||
|
||||
|
||||
{-| Trim the form and validate its fields. If there are problems, report them!
|
||||
-}
|
||||
validate : Form -> Result (List Problem) TrimmedForm
|
||||
validate form =
|
||||
let
|
||||
trimmedForm =
|
||||
trimFields form
|
||||
in
|
||||
case List.concatMap (validateField trimmedForm) fieldsToValidate of
|
||||
[] ->
|
||||
Ok trimmedForm
|
||||
|
||||
problems ->
|
||||
Err problems
|
||||
|
||||
|
||||
validateField : TrimmedForm -> ValidatedField -> List Problem
|
||||
validateField (Trimmed form) field =
|
||||
List.map (InvalidEntry field) <|
|
||||
case field of
|
||||
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 : TrimmedForm -> Http.Request Viewer
|
||||
login (Trimmed form) =
|
||||
let
|
||||
user =
|
||||
Encode.object
|
||||
[ ( "email", Encode.string form.email )
|
||||
, ( "password", Encode.string form.password )
|
||||
]
|
||||
|
||||
body =
|
||||
Encode.object [ ( "user", user ) ]
|
||||
|> Http.jsonBody
|
||||
in
|
||||
Decode.field "user" Viewer.decoder
|
||||
|> Http.post (Api.url [ "users", "login" ]) body
|
||||
|
||||
|
||||
|
||||
-- EXPORT
|
||||
|
||||
|
||||
toSession : Model -> Session
|
||||
toSession model =
|
||||
model.session
|
||||
@@ -1,21 +0,0 @@
|
||||
module Page.NotFound exposing (view)
|
||||
|
||||
import Asset
|
||||
import Html exposing (Html, div, h1, img, main_, text)
|
||||
import Html.Attributes exposing (alt, class, id, src, tabindex)
|
||||
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
view : { title : String, content : Html msg }
|
||||
view =
|
||||
{ title = "Page Not Found"
|
||||
, content =
|
||||
main_ [ id "content", class "container", tabindex -1 ]
|
||||
[ h1 [] [ text "Not Found" ]
|
||||
, div [ class "row" ]
|
||||
[ img [ Asset.src Asset.error ] [] ]
|
||||
]
|
||||
}
|
||||
@@ -1,346 +0,0 @@
|
||||
module Page.Profile exposing (Model, Msg, init, subscriptions, toSession, update, view)
|
||||
|
||||
{-| An Author's profile.
|
||||
-}
|
||||
|
||||
import Article.Feed as Feed
|
||||
import Article.FeedSources as FeedSources exposing (FeedSources, Source(..))
|
||||
import Author exposing (Author(..), FollowedAuthor, UnfollowedAuthor)
|
||||
import Avatar exposing (Avatar)
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Http
|
||||
import Loading
|
||||
import Log
|
||||
import Page
|
||||
import Profile exposing (Profile)
|
||||
import Route
|
||||
import Session exposing (Session)
|
||||
import Task exposing (Task)
|
||||
import Time
|
||||
import Username exposing (Username)
|
||||
import Viewer exposing (Viewer)
|
||||
import Viewer.Cred as Cred exposing (Cred)
|
||||
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ session : Session
|
||||
, timeZone : Time.Zone
|
||||
, errors : List String
|
||||
|
||||
-- Loaded independently from server
|
||||
, author : Status Author
|
||||
, feed : Status Feed.Model
|
||||
}
|
||||
|
||||
|
||||
type Status a
|
||||
= Loading Username
|
||||
| LoadingSlowly Username
|
||||
| Loaded a
|
||||
| Failed Username
|
||||
|
||||
|
||||
init : Session -> Username -> ( Model, Cmd Msg )
|
||||
init session username =
|
||||
let
|
||||
maybeCred =
|
||||
Session.cred session
|
||||
in
|
||||
( { session = session
|
||||
, timeZone = Time.utc
|
||||
, errors = []
|
||||
, author = Loading username
|
||||
, feed = Loading username
|
||||
}
|
||||
, Cmd.batch
|
||||
[ Author.fetch username maybeCred
|
||||
|> Http.toTask
|
||||
|> Task.mapError (Tuple.pair username)
|
||||
|> Task.attempt CompletedAuthorLoad
|
||||
, defaultFeedSources username
|
||||
|> Feed.init session
|
||||
|> Task.mapError (Tuple.pair username)
|
||||
|> Task.attempt CompletedFeedLoad
|
||||
, Task.perform GotTimeZone Time.here
|
||||
, Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
view : Model -> { title : String, content : Html Msg }
|
||||
view model =
|
||||
let
|
||||
title =
|
||||
case model.author of
|
||||
Loaded (IsViewer _ _) ->
|
||||
myProfileTitle
|
||||
|
||||
Loaded ((IsFollowing followedAuthor) as author) ->
|
||||
titleForOther (Author.username author)
|
||||
|
||||
Loaded ((IsNotFollowing unfollowedAuthor) as author) ->
|
||||
titleForOther (Author.username author)
|
||||
|
||||
Loading username ->
|
||||
titleForMe (Session.cred model.session) username
|
||||
|
||||
LoadingSlowly username ->
|
||||
titleForMe (Session.cred model.session) username
|
||||
|
||||
Failed username ->
|
||||
titleForMe (Session.cred model.session) username
|
||||
in
|
||||
{ title = title
|
||||
, content =
|
||||
case model.author of
|
||||
Loaded author ->
|
||||
let
|
||||
profile =
|
||||
Author.profile author
|
||||
|
||||
username =
|
||||
Author.username author
|
||||
|
||||
followButton =
|
||||
case Session.cred model.session of
|
||||
Just cred ->
|
||||
case author of
|
||||
IsViewer _ _ ->
|
||||
-- We can't follow ourselves!
|
||||
text ""
|
||||
|
||||
IsFollowing followedAuthor ->
|
||||
Author.unfollowButton ClickedUnfollow cred followedAuthor
|
||||
|
||||
IsNotFollowing unfollowedAuthor ->
|
||||
Author.followButton ClickedFollow cred unfollowedAuthor
|
||||
|
||||
Nothing ->
|
||||
-- We can't follow if we're logged out
|
||||
text ""
|
||||
in
|
||||
div [ class "profile-page" ]
|
||||
[ Page.viewErrors ClickedDismissErrors model.errors
|
||||
, div [ class "user-info" ]
|
||||
[ div [ class "container" ]
|
||||
[ div [ class "row" ]
|
||||
[ div [ class "col-xs-12 col-md-10 offset-md-1" ]
|
||||
[ img [ class "user-img", Avatar.src (Profile.avatar profile) ] []
|
||||
, h4 [] [ Username.toHtml username ]
|
||||
, p [] [ text (Maybe.withDefault "" (Profile.bio profile)) ]
|
||||
, followButton
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
, case model.feed of
|
||||
Loaded feed ->
|
||||
div [ class "container" ]
|
||||
[ div [ class "row" ] [ viewFeed model.timeZone feed ] ]
|
||||
|
||||
Loading _ ->
|
||||
text ""
|
||||
|
||||
LoadingSlowly _ ->
|
||||
Loading.icon
|
||||
|
||||
Failed _ ->
|
||||
Loading.error "feed"
|
||||
]
|
||||
|
||||
Loading _ ->
|
||||
text ""
|
||||
|
||||
LoadingSlowly _ ->
|
||||
Loading.icon
|
||||
|
||||
Failed _ ->
|
||||
Loading.error "profile"
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- PAGE TITLE
|
||||
|
||||
|
||||
titleForOther : Username -> String
|
||||
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"
|
||||
|
||||
|
||||
defaultTitle : String
|
||||
defaultTitle =
|
||||
"Profile"
|
||||
|
||||
|
||||
|
||||
-- FEED
|
||||
|
||||
|
||||
viewFeed : Time.Zone -> Feed.Model -> Html Msg
|
||||
viewFeed timeZone feed =
|
||||
div [ class "col-xs-12 col-md-10 offset-md-1" ] <|
|
||||
div [ class "articles-toggle" ]
|
||||
[ Feed.viewFeedSources feed |> Html.map GotFeedMsg ]
|
||||
:: (Feed.viewArticles timeZone feed |> List.map (Html.map GotFeedMsg))
|
||||
|
||||
|
||||
|
||||
-- UPDATE
|
||||
|
||||
|
||||
type Msg
|
||||
= ClickedDismissErrors
|
||||
| ClickedFollow Cred UnfollowedAuthor
|
||||
| ClickedUnfollow Cred FollowedAuthor
|
||||
| CompletedFollowChange (Result Http.Error Author)
|
||||
| CompletedAuthorLoad (Result ( Username, Http.Error ) Author)
|
||||
| CompletedFeedLoad (Result ( Username, Http.Error ) Feed.Model)
|
||||
| GotTimeZone Time.Zone
|
||||
| GotFeedMsg Feed.Msg
|
||||
| GotSession Session
|
||||
| PassedSlowLoadThreshold
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
update msg model =
|
||||
case msg of
|
||||
ClickedDismissErrors ->
|
||||
( { model | errors = [] }, Cmd.none )
|
||||
|
||||
ClickedUnfollow cred followedAuthor ->
|
||||
( model
|
||||
, Author.requestUnfollow followedAuthor cred
|
||||
|> Http.send CompletedFollowChange
|
||||
)
|
||||
|
||||
ClickedFollow cred unfollowedAuthor ->
|
||||
( model
|
||||
, Author.requestFollow unfollowedAuthor cred
|
||||
|> Http.send CompletedFollowChange
|
||||
)
|
||||
|
||||
CompletedFollowChange (Ok newAuthor) ->
|
||||
( { model | author = Loaded newAuthor }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
CompletedFollowChange (Err error) ->
|
||||
( model
|
||||
, Log.error
|
||||
)
|
||||
|
||||
CompletedAuthorLoad (Ok author) ->
|
||||
( { model | author = Loaded author }, Cmd.none )
|
||||
|
||||
CompletedAuthorLoad (Err ( username, err )) ->
|
||||
( { model | author = Failed username }
|
||||
, Log.error
|
||||
)
|
||||
|
||||
CompletedFeedLoad (Ok feed) ->
|
||||
( { model | feed = Loaded feed }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
CompletedFeedLoad (Err ( username, err )) ->
|
||||
( { model | feed = Failed username }
|
||||
, Log.error
|
||||
)
|
||||
|
||||
GotFeedMsg subMsg ->
|
||||
case model.feed of
|
||||
Loaded feed ->
|
||||
let
|
||||
( newFeed, subCmd ) =
|
||||
Feed.update (Session.cred model.session) subMsg feed
|
||||
in
|
||||
( { model | feed = Loaded newFeed }
|
||||
, Cmd.map GotFeedMsg subCmd
|
||||
)
|
||||
|
||||
Loading _ ->
|
||||
( model, Log.error )
|
||||
|
||||
LoadingSlowly _ ->
|
||||
( model, Log.error )
|
||||
|
||||
Failed _ ->
|
||||
( model, Log.error )
|
||||
|
||||
GotTimeZone tz ->
|
||||
( { model | timeZone = tz }, Cmd.none )
|
||||
|
||||
GotSession session ->
|
||||
( { 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 )
|
||||
|
||||
|
||||
|
||||
-- SUBSCRIPTIONS
|
||||
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions model =
|
||||
Session.changes GotSession (Session.navKey model.session)
|
||||
|
||||
|
||||
|
||||
-- EXPORT
|
||||
|
||||
|
||||
toSession : Model -> Session
|
||||
toSession model =
|
||||
model.session
|
||||
|
||||
|
||||
|
||||
-- INTERNAL
|
||||
|
||||
|
||||
defaultFeedSources : Username -> FeedSources
|
||||
defaultFeedSources username =
|
||||
FeedSources.fromLists (AuthorFeed username) [ FavoritedFeed username ]
|
||||
@@ -1,319 +0,0 @@
|
||||
module Page.Register exposing (Model, Msg, init, subscriptions, toSession, update, view)
|
||||
|
||||
import Api
|
||||
import Browser.Navigation as Nav
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (..)
|
||||
import Http
|
||||
import Json.Decode as Decode exposing (Decoder, decodeString, field, string)
|
||||
import Json.Decode.Pipeline exposing (optional)
|
||||
import Json.Encode as Encode
|
||||
import Route exposing (Route)
|
||||
import Session exposing (Session)
|
||||
import Viewer exposing (Viewer)
|
||||
import Viewer.Cred as Cred exposing (Cred)
|
||||
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ session : Session
|
||||
, problems : List Problem
|
||||
, form : Form
|
||||
}
|
||||
|
||||
|
||||
type alias Form =
|
||||
{ email : String
|
||||
, username : String
|
||||
, password : String
|
||||
}
|
||||
|
||||
|
||||
type Problem
|
||||
= InvalidEntry ValidatedField String
|
||||
| ServerError String
|
||||
|
||||
|
||||
init : Session -> ( Model, Cmd msg )
|
||||
init session =
|
||||
( { session = session
|
||||
, problems = []
|
||||
, form =
|
||||
{ email = ""
|
||||
, username = ""
|
||||
, password = ""
|
||||
}
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
view : Model -> { title : String, content : Html Msg }
|
||||
view model =
|
||||
{ title = "Register"
|
||||
, content =
|
||||
div [ class "cred-page" ]
|
||||
[ div [ class "container page" ]
|
||||
[ div [ class "row" ]
|
||||
[ div [ class "col-md-6 offset-md-3 col-xs-12" ]
|
||||
[ h1 [ class "text-xs-center" ] [ text "Sign up" ]
|
||||
, p [ class "text-xs-center" ]
|
||||
[ a [ Route.href Route.Login ]
|
||||
[ text "Have an account?" ]
|
||||
]
|
||||
, ul [ class "error-messages" ]
|
||||
(List.map viewProblem model.problems)
|
||||
, viewForm model.form
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
}
|
||||
|
||||
|
||||
viewForm : Form -> Html Msg
|
||||
viewForm form =
|
||||
Html.form [ onSubmit SubmittedForm ]
|
||||
[ fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control form-control-lg"
|
||||
, placeholder "Username"
|
||||
, onInput EnteredUsername
|
||||
, value form.username
|
||||
]
|
||||
[]
|
||||
]
|
||||
, fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control form-control-lg"
|
||||
, placeholder "Email"
|
||||
, onInput EnteredEmail
|
||||
, value form.email
|
||||
]
|
||||
[]
|
||||
]
|
||||
, fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control form-control-lg"
|
||||
, type_ "password"
|
||||
, placeholder "Password"
|
||||
, onInput EnteredPassword
|
||||
, value form.password
|
||||
]
|
||||
[]
|
||||
]
|
||||
, button [ class "btn btn-lg btn-primary pull-xs-right" ]
|
||||
[ text "Sign up" ]
|
||||
]
|
||||
|
||||
|
||||
viewProblem : Problem -> Html msg
|
||||
viewProblem problem =
|
||||
let
|
||||
errorMessage =
|
||||
case problem of
|
||||
InvalidEntry _ str ->
|
||||
str
|
||||
|
||||
ServerError str ->
|
||||
str
|
||||
in
|
||||
li [] [ text errorMessage ]
|
||||
|
||||
|
||||
|
||||
-- UPDATE
|
||||
|
||||
|
||||
type Msg
|
||||
= SubmittedForm
|
||||
| EnteredEmail String
|
||||
| EnteredUsername String
|
||||
| EnteredPassword String
|
||||
| CompletedRegister (Result Http.Error Viewer)
|
||||
| GotSession Session
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
update msg model =
|
||||
case msg of
|
||||
SubmittedForm ->
|
||||
case validate model.form of
|
||||
Ok validForm ->
|
||||
( { model | problems = [] }
|
||||
, Http.send CompletedRegister (register validForm)
|
||||
)
|
||||
|
||||
Err problems ->
|
||||
( { model | problems = problems }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
EnteredUsername username ->
|
||||
updateForm (\form -> { form | username = username }) model
|
||||
|
||||
EnteredEmail email ->
|
||||
updateForm (\form -> { form | email = email }) model
|
||||
|
||||
EnteredPassword password ->
|
||||
updateForm (\form -> { form | password = password }) model
|
||||
|
||||
CompletedRegister (Err error) ->
|
||||
let
|
||||
serverErrors =
|
||||
Api.decodeErrors error
|
||||
|> List.map ServerError
|
||||
in
|
||||
( { model | problems = List.append model.problems serverErrors }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
CompletedRegister (Ok viewer) ->
|
||||
( model
|
||||
, Session.login viewer
|
||||
)
|
||||
|
||||
GotSession session ->
|
||||
( { model | session = session }
|
||||
, Route.replaceUrl (Session.navKey session) Route.Home
|
||||
)
|
||||
|
||||
|
||||
{-| Helper function for `update`. Updates the form and returns Cmd.none and
|
||||
Ignored. Useful for recording form fields!
|
||||
-}
|
||||
updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
|
||||
updateForm transform model =
|
||||
( { model | form = transform model.form }, Cmd.none )
|
||||
|
||||
|
||||
|
||||
-- SUBSCRIPTIONS
|
||||
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions model =
|
||||
Session.changes GotSession (Session.navKey model.session)
|
||||
|
||||
|
||||
|
||||
-- EXPORT
|
||||
|
||||
|
||||
toSession : Model -> Session
|
||||
toSession model =
|
||||
model.session
|
||||
|
||||
|
||||
|
||||
-- FORM
|
||||
|
||||
|
||||
{-| Marks that we've trimmed the form's fields, so we don't accidentally send
|
||||
it to the server without having trimmed it!
|
||||
-}
|
||||
type TrimmedForm
|
||||
= Trimmed Form
|
||||
|
||||
|
||||
{-| When adding a variant here, add it to `fieldsToValidate` too!
|
||||
-}
|
||||
type ValidatedField
|
||||
= Username
|
||||
| Email
|
||||
| Password
|
||||
|
||||
|
||||
fieldsToValidate : List ValidatedField
|
||||
fieldsToValidate =
|
||||
[ Username
|
||||
, Email
|
||||
, Password
|
||||
]
|
||||
|
||||
|
||||
{-| Trim the form and validate its fields. If there are problems, report them!
|
||||
-}
|
||||
validate : Form -> Result (List Problem) TrimmedForm
|
||||
validate form =
|
||||
let
|
||||
trimmedForm =
|
||||
trimFields form
|
||||
in
|
||||
case List.concatMap (validateField trimmedForm) fieldsToValidate of
|
||||
[] ->
|
||||
Ok trimmedForm
|
||||
|
||||
problems ->
|
||||
Err problems
|
||||
|
||||
|
||||
validateField : TrimmedForm -> ValidatedField -> List Problem
|
||||
validateField (Trimmed form) field =
|
||||
List.map (InvalidEntry field) <|
|
||||
case field of
|
||||
Username ->
|
||||
if String.isEmpty form.username then
|
||||
[ "username can't be blank." ]
|
||||
|
||||
else
|
||||
[]
|
||||
|
||||
Email ->
|
||||
if String.isEmpty form.email then
|
||||
[ "email can't be blank." ]
|
||||
|
||||
else
|
||||
[]
|
||||
|
||||
Password ->
|
||||
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
|
||||
[]
|
||||
|
||||
|
||||
{-| 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 : TrimmedForm -> Http.Request Viewer
|
||||
register (Trimmed form) =
|
||||
let
|
||||
user =
|
||||
Encode.object
|
||||
[ ( "username", Encode.string form.username )
|
||||
, ( "email", Encode.string form.email )
|
||||
, ( "password", Encode.string form.password )
|
||||
]
|
||||
|
||||
body =
|
||||
Encode.object [ ( "user", user ) ]
|
||||
|> Http.jsonBody
|
||||
in
|
||||
Decode.field "user" Viewer.decoder
|
||||
|> Http.post (Api.url [ "users" ]) body
|
||||
@@ -1,434 +0,0 @@
|
||||
module Page.Settings exposing (Model, Msg, init, subscriptions, toSession, update, view)
|
||||
|
||||
import Api
|
||||
import Avatar
|
||||
import Browser.Navigation as Nav
|
||||
import Email exposing (Email)
|
||||
import Html exposing (Html, button, div, fieldset, h1, input, li, text, textarea, ul)
|
||||
import Html.Attributes exposing (attribute, class, placeholder, type_, value)
|
||||
import Html.Events exposing (onInput, onSubmit)
|
||||
import Http
|
||||
import HttpBuilder
|
||||
import Json.Decode as Decode exposing (Decoder, decodeString, field, list, string)
|
||||
import Json.Decode.Pipeline exposing (optional)
|
||||
import Json.Encode as Encode
|
||||
import Profile exposing (Profile)
|
||||
import Route
|
||||
import Session exposing (Session)
|
||||
import Username as Username exposing (Username)
|
||||
import Viewer exposing (Viewer)
|
||||
import Viewer.Cred as Cred exposing (Cred)
|
||||
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ session : Session
|
||||
, problems : List Problem
|
||||
, form : Form
|
||||
}
|
||||
|
||||
|
||||
type alias Form =
|
||||
{ avatar : String
|
||||
, bio : String
|
||||
, email : String
|
||||
, username : String
|
||||
, password : String
|
||||
}
|
||||
|
||||
|
||||
type Problem
|
||||
= InvalidEntry ValidatedField String
|
||||
| ServerError String
|
||||
|
||||
|
||||
init : Session -> ( Model, Cmd msg )
|
||||
init session =
|
||||
( { session = session
|
||||
, problems = []
|
||||
, form =
|
||||
case Session.viewer session of
|
||||
Just viewer ->
|
||||
let
|
||||
profile =
|
||||
Viewer.profile viewer
|
||||
|
||||
cred =
|
||||
Viewer.cred viewer
|
||||
in
|
||||
{ avatar = Maybe.withDefault "" (Avatar.toMaybeString (Profile.avatar profile))
|
||||
, email = Email.toString (Viewer.email viewer)
|
||||
, bio = Maybe.withDefault "" (Profile.bio profile)
|
||||
, username = Username.toString (Cred.username cred)
|
||||
, password = ""
|
||||
}
|
||||
|
||||
Nothing ->
|
||||
-- It's fine to store a blank form here. You won't be
|
||||
-- able to submit it if you're not logged in anyway.
|
||||
{ avatar = ""
|
||||
, email = ""
|
||||
, bio = ""
|
||||
, username = ""
|
||||
, password = ""
|
||||
}
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
|
||||
{-| A form that has been validated. Only the `edit` function uses this. Its
|
||||
purpose is to prevent us from forgetting to validate the form before passing
|
||||
it to `edit`.
|
||||
|
||||
This doesn't create any guarantees that the form was actually validated. If
|
||||
we wanted to do that, we'd need to move the form data into a separate module!
|
||||
|
||||
-}
|
||||
type ValidForm
|
||||
= Valid Form
|
||||
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
view : Model -> { title : String, content : Html Msg }
|
||||
view model =
|
||||
{ title = "Settings"
|
||||
, content =
|
||||
case Session.cred model.session of
|
||||
Just cred ->
|
||||
div [ class "settings-page" ]
|
||||
[ div [ class "container page" ]
|
||||
[ div [ class "row" ]
|
||||
[ div [ class "col-md-6 offset-md-3 col-xs-12" ]
|
||||
[ h1 [ class "text-xs-center" ] [ text "Your Settings" ]
|
||||
, ul [ class "error-messages" ]
|
||||
(List.map viewProblem model.problems)
|
||||
, viewForm cred model.form
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
Nothing ->
|
||||
text "Sign in to view your settings."
|
||||
}
|
||||
|
||||
|
||||
viewForm : Cred -> Form -> Html Msg
|
||||
viewForm cred form =
|
||||
Html.form [ onSubmit (SubmittedForm cred) ]
|
||||
[ fieldset []
|
||||
[ fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control"
|
||||
, placeholder "URL of profile picture"
|
||||
, value form.avatar
|
||||
, onInput EnteredAvatar
|
||||
]
|
||||
[]
|
||||
]
|
||||
, fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control form-control-lg"
|
||||
, placeholder "Username"
|
||||
, value form.username
|
||||
, onInput EnteredUsername
|
||||
]
|
||||
[]
|
||||
]
|
||||
, fieldset [ class "form-group" ]
|
||||
[ textarea
|
||||
[ class "form-control form-control-lg"
|
||||
, placeholder "Short bio about you"
|
||||
, attribute "rows" "8"
|
||||
, value form.bio
|
||||
, onInput EnteredBio
|
||||
]
|
||||
[]
|
||||
]
|
||||
, fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control form-control-lg"
|
||||
, placeholder "Email"
|
||||
, value form.email
|
||||
, onInput EnteredEmail
|
||||
]
|
||||
[]
|
||||
]
|
||||
, fieldset [ class "form-group" ]
|
||||
[ input
|
||||
[ class "form-control form-control-lg"
|
||||
, type_ "password"
|
||||
, placeholder "Password"
|
||||
, value form.password
|
||||
, onInput EnteredPassword
|
||||
]
|
||||
[]
|
||||
]
|
||||
, button
|
||||
[ class "btn btn-lg btn-primary pull-xs-right" ]
|
||||
[ text "Update Settings" ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewProblem : Problem -> Html msg
|
||||
viewProblem problem =
|
||||
let
|
||||
errorMessage =
|
||||
case problem of
|
||||
InvalidEntry _ message ->
|
||||
message
|
||||
|
||||
ServerError message ->
|
||||
message
|
||||
in
|
||||
li [] [ text errorMessage ]
|
||||
|
||||
|
||||
|
||||
-- UPDATE
|
||||
|
||||
|
||||
type Msg
|
||||
= SubmittedForm Cred
|
||||
| EnteredEmail String
|
||||
| EnteredUsername String
|
||||
| EnteredPassword String
|
||||
| EnteredBio String
|
||||
| EnteredAvatar String
|
||||
| CompletedSave (Result Http.Error Viewer)
|
||||
| GotSession Session
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
update msg model =
|
||||
case msg of
|
||||
SubmittedForm cred ->
|
||||
case validate model.form of
|
||||
Ok validForm ->
|
||||
( { model | problems = [] }
|
||||
, edit cred validForm
|
||||
|> Http.send CompletedSave
|
||||
)
|
||||
|
||||
Err problems ->
|
||||
( { model | problems = problems }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
EnteredEmail email ->
|
||||
updateForm (\form -> { form | email = email }) model
|
||||
|
||||
EnteredUsername username ->
|
||||
updateForm (\form -> { form | username = username }) model
|
||||
|
||||
EnteredPassword password ->
|
||||
updateForm (\form -> { form | password = password }) model
|
||||
|
||||
EnteredBio bio ->
|
||||
updateForm (\form -> { form | bio = bio }) model
|
||||
|
||||
EnteredAvatar avatar ->
|
||||
updateForm (\form -> { form | avatar = avatar }) model
|
||||
|
||||
CompletedSave (Err error) ->
|
||||
let
|
||||
serverErrors =
|
||||
Api.decodeErrors error
|
||||
|> List.map ServerError
|
||||
in
|
||||
( { model | problems = List.append model.problems serverErrors }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
CompletedSave (Ok cred) ->
|
||||
( model
|
||||
, Session.login cred
|
||||
)
|
||||
|
||||
GotSession session ->
|
||||
( { model | session = session }
|
||||
, Route.replaceUrl (Session.navKey session) Route.Home
|
||||
)
|
||||
|
||||
|
||||
{-| Helper function for `update`. Updates the form and returns Cmd.none and
|
||||
Ignored. Useful for recording form fields!
|
||||
-}
|
||||
updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
|
||||
updateForm transform model =
|
||||
( { model | form = transform model.form }, Cmd.none )
|
||||
|
||||
|
||||
|
||||
-- SUBSCRIPTIONS
|
||||
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions model =
|
||||
Session.changes GotSession (Session.navKey model.session)
|
||||
|
||||
|
||||
|
||||
-- EXPORT
|
||||
|
||||
|
||||
toSession : Model -> Session
|
||||
toSession model =
|
||||
model.session
|
||||
|
||||
|
||||
|
||||
-- FORM
|
||||
|
||||
|
||||
{-| Marks that we've trimmed the form's fields, so we don't accidentally send
|
||||
it to the server without having trimmed it!
|
||||
-}
|
||||
type TrimmedForm
|
||||
= Trimmed Form
|
||||
|
||||
|
||||
{-| When adding a variant here, add it to `fieldsToValidate` too!
|
||||
|
||||
NOTE: there are no ImageUrl or Bio variants here, because they aren't validated!
|
||||
|
||||
-}
|
||||
type ValidatedField
|
||||
= Username
|
||||
| Email
|
||||
| Password
|
||||
|
||||
|
||||
fieldsToValidate : List ValidatedField
|
||||
fieldsToValidate =
|
||||
[ Username
|
||||
, Email
|
||||
, Password
|
||||
]
|
||||
|
||||
|
||||
{-| Trim the form and validate its fields. If there are problems, report them!
|
||||
-}
|
||||
validate : Form -> Result (List Problem) TrimmedForm
|
||||
validate form =
|
||||
let
|
||||
trimmedForm =
|
||||
trimFields form
|
||||
in
|
||||
case List.concatMap (validateField trimmedForm) fieldsToValidate of
|
||||
[] ->
|
||||
Ok trimmedForm
|
||||
|
||||
problems ->
|
||||
Err problems
|
||||
|
||||
|
||||
validateField : TrimmedForm -> ValidatedField -> List Problem
|
||||
validateField (Trimmed form) field =
|
||||
List.map (InvalidEntry field) <|
|
||||
case field of
|
||||
Username ->
|
||||
if String.isEmpty form.username then
|
||||
[ "username can't be blank." ]
|
||||
|
||||
else
|
||||
[]
|
||||
|
||||
Email ->
|
||||
if String.isEmpty form.email then
|
||||
[ "email can't be blank." ]
|
||||
|
||||
else
|
||||
[]
|
||||
|
||||
Password ->
|
||||
let
|
||||
passwordLength =
|
||||
String.length form.password
|
||||
in
|
||||
if passwordLength > 0 && passwordLength < Viewer.minPasswordChars then
|
||||
[ "password must be at least " ++ String.fromInt Viewer.minPasswordChars ++ " characters long." ]
|
||||
|
||||
else
|
||||
[]
|
||||
|
||||
|
||||
{-| Don't trim while the user is typing! That would be super annoying.
|
||||
Instead, trim only on submit.
|
||||
-}
|
||||
trimFields : Form -> TrimmedForm
|
||||
trimFields form =
|
||||
Trimmed
|
||||
{ avatar = String.trim form.avatar
|
||||
, bio = String.trim form.bio
|
||||
, email = String.trim form.email
|
||||
, username = String.trim form.username
|
||||
, password = String.trim form.password
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- HTTP
|
||||
|
||||
|
||||
{-| This takes a Valid Form as a reminder that it needs to have been validated
|
||||
first.
|
||||
-}
|
||||
edit : Cred -> TrimmedForm -> Http.Request Viewer
|
||||
edit cred (Trimmed form) =
|
||||
let
|
||||
encodedAvatar =
|
||||
case form.avatar of
|
||||
"" ->
|
||||
Encode.null
|
||||
|
||||
avatar ->
|
||||
Encode.string avatar
|
||||
|
||||
updates =
|
||||
[ ( "username", Encode.string form.username )
|
||||
, ( "email", Encode.string form.email )
|
||||
, ( "bio", Encode.string form.bio )
|
||||
, ( "image", encodedAvatar )
|
||||
]
|
||||
|
||||
encodedUser =
|
||||
Encode.object <|
|
||||
case form.password of
|
||||
"" ->
|
||||
updates
|
||||
|
||||
password ->
|
||||
( "password", Encode.string password ) :: updates
|
||||
|
||||
body =
|
||||
Encode.object [ ( "user", encodedUser ) ]
|
||||
|> Http.jsonBody
|
||||
|
||||
expect =
|
||||
Decode.field "user" Viewer.decoder
|
||||
|> Http.expectJson
|
||||
in
|
||||
Api.url [ "user" ]
|
||||
|> HttpBuilder.put
|
||||
|> HttpBuilder.withExpect expect
|
||||
|> HttpBuilder.withBody body
|
||||
|> Cred.addHeader cred
|
||||
|> HttpBuilder.toRequest
|
||||
|
||||
|
||||
nothingIfEmpty : String -> Maybe String
|
||||
nothingIfEmpty str =
|
||||
if String.isEmpty str then
|
||||
Nothing
|
||||
|
||||
else
|
||||
Just str
|
||||
Reference in New Issue
Block a user