rm -rf intro
This commit is contained in:
Richard Feldman
@@ -1,406 +0,0 @@
|
||||
module Page.Article exposing (Model, Msg, init, update, view)
|
||||
|
||||
{-| Viewing an individual article.
|
||||
-}
|
||||
|
||||
import Data.Article as Article exposing (Article, Body)
|
||||
import Data.Article.Author exposing (Author)
|
||||
import Data.Article.Comment exposing (Comment, CommentId)
|
||||
import Data.Session as Session exposing (Session)
|
||||
import Data.User as User exposing (User)
|
||||
import Data.UserPhoto as UserPhoto
|
||||
import Date exposing (Date)
|
||||
import Date.Format
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (attribute, class, disabled, href, id, placeholder)
|
||||
import Html.Events exposing (onClick, onInput, onSubmit)
|
||||
import Http
|
||||
import Page.Errored exposing (PageLoadError, pageLoadError)
|
||||
import Request.Article
|
||||
import Request.Article.Comments
|
||||
import Request.Profile
|
||||
import Route
|
||||
import Task exposing (Task)
|
||||
import Util exposing (pair, viewIf)
|
||||
import Views.Article
|
||||
import Views.Article.Favorite as Favorite
|
||||
import Views.Author
|
||||
import Views.Errors
|
||||
import Views.Page as Page
|
||||
import Views.User.Follow as Follow
|
||||
|
||||
|
||||
-- MODEL --
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ errors : List String
|
||||
, commentText : String
|
||||
, commentInFlight : Bool
|
||||
, article : Article Body
|
||||
, comments : List Comment
|
||||
}
|
||||
|
||||
|
||||
init : Session -> Article.Slug -> Task PageLoadError Model
|
||||
init session slug =
|
||||
let
|
||||
maybeAuthToken =
|
||||
Maybe.map .token session.user
|
||||
|
||||
loadArticle =
|
||||
Request.Article.get maybeAuthToken slug
|
||||
|> Http.toTask
|
||||
|
||||
loadComments =
|
||||
Request.Article.Comments.list maybeAuthToken slug
|
||||
|> Http.toTask
|
||||
|
||||
handleLoadError _ =
|
||||
pageLoadError Page.Other "Article is currently unavailable."
|
||||
in
|
||||
Task.map2 (Model [] "" False) loadArticle loadComments
|
||||
|> Task.mapError handleLoadError
|
||||
|
||||
|
||||
|
||||
-- VIEW --
|
||||
|
||||
|
||||
view : Session -> Model -> Html Msg
|
||||
view session model =
|
||||
let
|
||||
article =
|
||||
model.article
|
||||
|
||||
author =
|
||||
article.author
|
||||
|
||||
buttons =
|
||||
viewButtons article author session.user
|
||||
|
||||
postingDisabled =
|
||||
model.commentInFlight
|
||||
in
|
||||
div [ class "article-page" ]
|
||||
[ viewBanner model.errors article author session.user
|
||||
, div [ class "container page" ]
|
||||
[ div [ class "row article-content" ]
|
||||
[ div [ class "col-md-12" ]
|
||||
[ Article.bodyToHtml article.body [] ]
|
||||
]
|
||||
, hr [] []
|
||||
, div [ class "article-actions" ]
|
||||
[ div [ class "article-meta" ] <|
|
||||
[ a [ Route.href (Route.Profile author.username) ]
|
||||
[ img [ UserPhoto.src author.image ] [] ]
|
||||
, div [ class "info" ]
|
||||
[ Views.Author.view author.username
|
||||
, Views.Article.viewTimestamp article
|
||||
]
|
||||
]
|
||||
++ buttons
|
||||
]
|
||||
, div [ class "row" ]
|
||||
[ div [ class "col-xs-12 col-md-8 offset-md-2" ] <|
|
||||
viewAddComment postingDisabled session.user
|
||||
:: List.map (viewComment session.user) model.comments
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewBanner : List String -> Article a -> Author -> Maybe User -> Html Msg
|
||||
viewBanner errors article author maybeUser =
|
||||
let
|
||||
buttons =
|
||||
viewButtons article author maybeUser
|
||||
in
|
||||
div [ class "banner" ]
|
||||
[ div [ class "container" ]
|
||||
[ h1 [] [ text article.title ]
|
||||
, div [ class "article-meta" ] <|
|
||||
[ a [ Route.href (Route.Profile author.username) ]
|
||||
[ img [ UserPhoto.src author.image ] [] ]
|
||||
, div [ class "info" ]
|
||||
[ Views.Author.view author.username
|
||||
, Views.Article.viewTimestamp article
|
||||
]
|
||||
]
|
||||
++ buttons
|
||||
, Views.Errors.view DismissErrors errors
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewAddComment : Bool -> Maybe User -> Html Msg
|
||||
viewAddComment postingDisabled maybeUser =
|
||||
case maybeUser of
|
||||
Nothing ->
|
||||
p []
|
||||
[ a [ Route.href Route.Login ] [ text "Sign in" ]
|
||||
, text " or "
|
||||
, a [ Route.href Route.Register ] [ text "sign up" ]
|
||||
, text " to add comments on this article."
|
||||
]
|
||||
|
||||
Just user ->
|
||||
Html.form [ class "card comment-form", onSubmit PostComment ]
|
||||
[ div [ class "card-block" ]
|
||||
[ textarea
|
||||
[ class "form-control"
|
||||
, placeholder "Write a comment..."
|
||||
, attribute "rows" "3"
|
||||
, onInput SetCommentText
|
||||
]
|
||||
[]
|
||||
]
|
||||
, div [ class "card-footer" ]
|
||||
[ img [ class "comment-author-img", UserPhoto.src user.image ] []
|
||||
, button
|
||||
[ class "btn btn-sm btn-primary"
|
||||
, disabled postingDisabled
|
||||
]
|
||||
[ text "Post Comment" ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewButtons : Article a -> Author -> Maybe User -> List (Html Msg)
|
||||
viewButtons article author maybeUser =
|
||||
let
|
||||
isMyArticle =
|
||||
Maybe.map .username maybeUser == Just author.username
|
||||
in
|
||||
if isMyArticle then
|
||||
[ editButton article
|
||||
, text " "
|
||||
, deleteButton article
|
||||
]
|
||||
else
|
||||
[ followButton author
|
||||
, text " "
|
||||
, favoriteButton article
|
||||
]
|
||||
|
||||
|
||||
viewComment : Maybe User -> Comment -> Html Msg
|
||||
viewComment user comment =
|
||||
let
|
||||
author =
|
||||
comment.author
|
||||
|
||||
isAuthor =
|
||||
Maybe.map .username user == Just comment.author.username
|
||||
in
|
||||
div [ class "card" ]
|
||||
[ div [ class "card-block" ]
|
||||
[ p [ class "card-text" ] [ text comment.body ] ]
|
||||
, div [ class "card-footer" ]
|
||||
[ a [ class "comment-author", href "" ]
|
||||
[ img [ class "comment-author-img", UserPhoto.src author.image ] []
|
||||
, text " "
|
||||
]
|
||||
, text " "
|
||||
, a [ class "comment-author", Route.href (Route.Profile author.username) ]
|
||||
[ text (User.usernameToString comment.author.username) ]
|
||||
, span [ class "date-posted" ] [ text (formatCommentTimestamp comment.createdAt) ]
|
||||
, viewIf isAuthor <|
|
||||
span
|
||||
[ class "mod-options"
|
||||
, onClick (DeleteComment comment.id)
|
||||
]
|
||||
[ i [ class "ion-trash-a" ] [] ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
formatCommentTimestamp : Date -> String
|
||||
formatCommentTimestamp =
|
||||
Date.Format.format "%B %e, %Y"
|
||||
|
||||
|
||||
|
||||
-- UPDATE --
|
||||
|
||||
|
||||
type Msg
|
||||
= DismissErrors
|
||||
| ToggleFavorite
|
||||
| FavoriteCompleted (Result Http.Error (Article Body))
|
||||
| ToggleFollow
|
||||
| FollowCompleted (Result Http.Error Author)
|
||||
| SetCommentText String
|
||||
| DeleteComment CommentId
|
||||
| CommentDeleted CommentId (Result Http.Error ())
|
||||
| PostComment
|
||||
| CommentPosted (Result Http.Error Comment)
|
||||
| DeleteArticle
|
||||
| ArticleDeleted (Result Http.Error ())
|
||||
|
||||
|
||||
update : Session -> Msg -> Model -> ( Model, Cmd Msg )
|
||||
update session msg model =
|
||||
let
|
||||
article =
|
||||
model.article
|
||||
|
||||
author =
|
||||
article.author
|
||||
in
|
||||
case msg of
|
||||
DismissErrors ->
|
||||
( { model | errors = [] }, Cmd.none )
|
||||
|
||||
ToggleFavorite ->
|
||||
let
|
||||
cmdFromAuth authToken =
|
||||
Request.Article.toggleFavorite model.article authToken
|
||||
|> Http.toTask
|
||||
|> Task.map (\newArticle -> { newArticle | body = article.body })
|
||||
|> Task.attempt FavoriteCompleted
|
||||
in
|
||||
session
|
||||
|> Session.attempt "favorite" cmdFromAuth
|
||||
|> Tuple.mapFirst (Util.appendErrors model)
|
||||
|
||||
FavoriteCompleted (Ok newArticle) ->
|
||||
( { model | article = newArticle }, Cmd.none )
|
||||
|
||||
FavoriteCompleted (Err error) ->
|
||||
-- In a serious production application, we would log the error to
|
||||
-- a logging service so we could investigate later.
|
||||
( [ "There was a server error trying to record your Favorite. Sorry!" ]
|
||||
|> Util.appendErrors model
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
ToggleFollow ->
|
||||
let
|
||||
cmdFromAuth authToken =
|
||||
authToken
|
||||
|> Request.Profile.toggleFollow author.username author.following
|
||||
|> Http.send FollowCompleted
|
||||
in
|
||||
session
|
||||
|> Session.attempt "follow" cmdFromAuth
|
||||
|> Tuple.mapFirst (Util.appendErrors model)
|
||||
|
||||
FollowCompleted (Ok { following }) ->
|
||||
let
|
||||
newArticle =
|
||||
{ article | author = { author | following = following } }
|
||||
in
|
||||
( { model | article = newArticle }, Cmd.none )
|
||||
|
||||
FollowCompleted (Err error) ->
|
||||
( { model | errors = "Unable to follow user." :: model.errors }, Cmd.none )
|
||||
|
||||
SetCommentText commentText ->
|
||||
( { model | commentText = commentText }, Cmd.none )
|
||||
|
||||
PostComment ->
|
||||
let
|
||||
comment =
|
||||
model.commentText
|
||||
in
|
||||
if model.commentInFlight || String.isEmpty comment then
|
||||
( model, Cmd.none )
|
||||
else
|
||||
let
|
||||
cmdFromAuth authToken =
|
||||
authToken
|
||||
|> Request.Article.Comments.post model.article.slug comment
|
||||
|> Http.send CommentPosted
|
||||
in
|
||||
session
|
||||
|> Session.attempt "post a comment" cmdFromAuth
|
||||
|> Tuple.mapFirst (Util.appendErrors { model | commentInFlight = True })
|
||||
|
||||
CommentPosted (Ok comment) ->
|
||||
( { model
|
||||
| commentInFlight = False
|
||||
, comments = comment :: model.comments
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
CommentPosted (Err error) ->
|
||||
( { model | errors = model.errors ++ [ "Server error while trying to post comment." ] }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
DeleteComment id ->
|
||||
let
|
||||
cmdFromAuth authToken =
|
||||
authToken
|
||||
|> Request.Article.Comments.delete model.article.slug id
|
||||
|> Http.send (CommentDeleted id)
|
||||
in
|
||||
session
|
||||
|> Session.attempt "delete comments" cmdFromAuth
|
||||
|> Tuple.mapFirst (Util.appendErrors model)
|
||||
|
||||
CommentDeleted id (Ok ()) ->
|
||||
( { model | comments = withoutComment id model.comments }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
CommentDeleted id (Err error) ->
|
||||
( { model | errors = model.errors ++ [ "Server error while trying to delete comment." ] }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
DeleteArticle ->
|
||||
let
|
||||
cmdFromAuth authToken =
|
||||
authToken
|
||||
|> Request.Article.delete model.article.slug
|
||||
|> Http.send ArticleDeleted
|
||||
in
|
||||
session
|
||||
|> Session.attempt "delete articles" cmdFromAuth
|
||||
|> Tuple.mapFirst (Util.appendErrors model)
|
||||
|
||||
ArticleDeleted (Ok ()) ->
|
||||
( model, Route.modifyUrl Route.Home )
|
||||
|
||||
ArticleDeleted (Err error) ->
|
||||
( { model | errors = model.errors ++ [ "Server error while trying to delete article." ] }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- INTERNAL --
|
||||
|
||||
|
||||
withoutComment : CommentId -> List Comment -> List Comment
|
||||
withoutComment id =
|
||||
List.filter (\comment -> comment.id /= id)
|
||||
|
||||
|
||||
favoriteButton : Article a -> Html Msg
|
||||
favoriteButton article =
|
||||
let
|
||||
favoriteText =
|
||||
" Favorite Article (" ++ toString article.favoritesCount ++ ")"
|
||||
in
|
||||
Favorite.button (\_ -> ToggleFavorite) article [] [ text favoriteText ]
|
||||
|
||||
|
||||
deleteButton : Article a -> Html Msg
|
||||
deleteButton article =
|
||||
button [ class "btn btn-outline-danger btn-sm", onClick DeleteArticle ]
|
||||
[ 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) ]
|
||||
[ i [ class "ion-edit" ] [], text " Edit Article" ]
|
||||
|
||||
|
||||
followButton : Follow.State record -> Html Msg
|
||||
followButton =
|
||||
Follow.button (\_ -> ToggleFollow)
|
||||
@@ -1,244 +0,0 @@
|
||||
module Page.Article.Editor exposing (Model, Msg, initEdit, initNew, update, view)
|
||||
|
||||
import Data.Article as Article exposing (Article, Body)
|
||||
import Data.Session exposing (Session)
|
||||
import Data.User exposing (User)
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (attribute, class, disabled, href, id, placeholder, type_, value)
|
||||
import Html.Events exposing (onInput, onSubmit)
|
||||
import Http
|
||||
import Page.Errored exposing (PageLoadError, pageLoadError)
|
||||
import Request.Article
|
||||
import Route
|
||||
import Task exposing (Task)
|
||||
import Util exposing (pair, viewIf)
|
||||
import Validate exposing (Validator, ifBlank, validate)
|
||||
import Views.Form as Form
|
||||
import Views.Page as Page
|
||||
|
||||
|
||||
-- MODEL --
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ errors : List Error
|
||||
, editingArticle : Maybe Article.Slug
|
||||
, title : String
|
||||
, body : String
|
||||
, description : String
|
||||
, tags : List String
|
||||
, isSaving : Bool
|
||||
}
|
||||
|
||||
|
||||
initNew : Model
|
||||
initNew =
|
||||
{ errors = []
|
||||
, editingArticle = Nothing
|
||||
, title = ""
|
||||
, body = ""
|
||||
, description = ""
|
||||
, tags = []
|
||||
, isSaving = False
|
||||
}
|
||||
|
||||
|
||||
initEdit : Session -> Article.Slug -> Task PageLoadError Model
|
||||
initEdit session slug =
|
||||
let
|
||||
maybeAuthToken =
|
||||
session.user
|
||||
|> Maybe.map .token
|
||||
in
|
||||
Request.Article.get maybeAuthToken slug
|
||||
|> Http.toTask
|
||||
|> Task.mapError (\_ -> pageLoadError Page.Other "Article is currently unavailable.")
|
||||
|> Task.map
|
||||
(\article ->
|
||||
{ errors = []
|
||||
, editingArticle = Just slug
|
||||
, title = article.title
|
||||
, body = Article.bodyToMarkdownString article.body
|
||||
, description = article.description
|
||||
, tags = article.tags
|
||||
, isSaving = False
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- VIEW --
|
||||
|
||||
|
||||
view : Model -> Html Msg
|
||||
view model =
|
||||
div [ class "editor-page" ]
|
||||
[ div [ class "container page" ]
|
||||
[ div [ class "row" ]
|
||||
[ div [ class "col-md-10 offset-md-1 col-xs-12" ]
|
||||
[ Form.viewErrors model.errors
|
||||
, viewForm model
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewForm : Model -> Html Msg
|
||||
viewForm model =
|
||||
let
|
||||
isEditing =
|
||||
model.editingArticle /= Nothing
|
||||
|
||||
saveButtonText =
|
||||
if isEditing then
|
||||
"Update Article"
|
||||
else
|
||||
"Publish Article"
|
||||
in
|
||||
Html.form [ onSubmit Save ]
|
||||
[ fieldset []
|
||||
[ Form.input
|
||||
[ class "form-control-lg"
|
||||
, placeholder "Article Title"
|
||||
, onInput SetTitle
|
||||
, value model.title
|
||||
]
|
||||
[]
|
||||
, Form.input
|
||||
[ placeholder "What's this article about?"
|
||||
, onInput SetDescription
|
||||
, value model.description
|
||||
]
|
||||
[]
|
||||
, Form.textarea
|
||||
[ placeholder "Write your article (in markdown)"
|
||||
, attribute "rows" "8"
|
||||
, onInput SetBody
|
||||
, value model.body
|
||||
]
|
||||
[]
|
||||
, Form.input
|
||||
[ placeholder "Enter tags"
|
||||
, onInput SetTags
|
||||
, value (String.join " " model.tags)
|
||||
]
|
||||
[]
|
||||
, button [ class "btn btn-lg pull-xs-right btn-primary", disabled model.isSaving ]
|
||||
[ text saveButtonText ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- UPDATE --
|
||||
|
||||
|
||||
type Msg
|
||||
= Save
|
||||
| SetDescription String
|
||||
| SetTitle String
|
||||
| SetBody String
|
||||
| SetTags String
|
||||
| CreateCompleted (Result Http.Error (Article Body))
|
||||
| EditCompleted (Result Http.Error (Article Body))
|
||||
|
||||
|
||||
update : User -> Msg -> Model -> ( Model, Cmd Msg )
|
||||
update user msg model =
|
||||
case msg of
|
||||
Save ->
|
||||
case validate modelValidator model of
|
||||
[] ->
|
||||
case model.editingArticle of
|
||||
Nothing ->
|
||||
user.token
|
||||
|> Request.Article.create model
|
||||
|> Http.send CreateCompleted
|
||||
|> pair { model | errors = [], isSaving = True }
|
||||
|
||||
Just slug ->
|
||||
user.token
|
||||
|> Request.Article.update slug model
|
||||
|> Http.send EditCompleted
|
||||
|> pair { model | errors = [], isSaving = True }
|
||||
|
||||
errors ->
|
||||
( { model | errors = errors }, Cmd.none )
|
||||
|
||||
SetTitle title ->
|
||||
( { model | title = title }, Cmd.none )
|
||||
|
||||
SetDescription description ->
|
||||
( { model | description = description }, Cmd.none )
|
||||
|
||||
SetBody body ->
|
||||
( { model | body = body }, Cmd.none )
|
||||
|
||||
SetTags tagsStr ->
|
||||
( { model | tags = tagsFromString tagsStr }, Cmd.none )
|
||||
|
||||
CreateCompleted (Ok article) ->
|
||||
Route.Article article.slug
|
||||
|> Route.modifyUrl
|
||||
|> pair model
|
||||
|
||||
CreateCompleted (Err error) ->
|
||||
( { model
|
||||
| errors = model.errors ++ [ ( Form, "Server error while attempting to publish article" ) ]
|
||||
, isSaving = False
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
EditCompleted (Ok article) ->
|
||||
Route.Article article.slug
|
||||
|> Route.modifyUrl
|
||||
|> pair model
|
||||
|
||||
EditCompleted (Err error) ->
|
||||
( { model
|
||||
| errors = model.errors ++ [ ( Form, "Server error while attempting to save article" ) ]
|
||||
, isSaving = False
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- VALIDATION --
|
||||
|
||||
|
||||
type Field
|
||||
= Form
|
||||
| Title
|
||||
| Body
|
||||
|
||||
|
||||
type alias Error =
|
||||
( Field, String )
|
||||
|
||||
|
||||
modelValidator : Validator Error Model
|
||||
modelValidator =
|
||||
Validate.all
|
||||
[ ifBlank .title ( Title, "title can't be blank." )
|
||||
, ifBlank .body ( Body, "body can't be blank." )
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- INTERNAL --
|
||||
|
||||
|
||||
tagsFromString : String -> List String
|
||||
tagsFromString str =
|
||||
str
|
||||
|> String.split " "
|
||||
|> List.map String.trim
|
||||
|> List.filter (not << String.isEmpty)
|
||||
|
||||
|
||||
redirectToArticle : Article.Slug -> Cmd msg
|
||||
redirectToArticle =
|
||||
Route.modifyUrl << Route.Article
|
||||
@@ -1,45 +0,0 @@
|
||||
module Page.Errored exposing (PageLoadError, pageLoadError, view)
|
||||
|
||||
{-| The page that renders when there was an error trying to load another page,
|
||||
for example a Page Not Found error.
|
||||
|
||||
It includes a photo I took of a painting on a building in San Francisco,
|
||||
of a giant walrus exploding the golden gate bridge with laser beams. Pew pew!
|
||||
|
||||
-}
|
||||
|
||||
import Data.Session exposing (Session)
|
||||
import Html exposing (Html, div, h1, img, main_, p, text)
|
||||
import Html.Attributes exposing (alt, class, id, tabindex)
|
||||
import Views.Page exposing (ActivePage)
|
||||
|
||||
|
||||
-- MODEL --
|
||||
|
||||
|
||||
type PageLoadError
|
||||
= PageLoadError Model
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ activePage : ActivePage
|
||||
, errorMessage : String
|
||||
}
|
||||
|
||||
|
||||
pageLoadError : ActivePage -> String -> PageLoadError
|
||||
pageLoadError activePage errorMessage =
|
||||
PageLoadError { activePage = activePage, errorMessage = errorMessage }
|
||||
|
||||
|
||||
|
||||
-- VIEW --
|
||||
|
||||
|
||||
view : Session -> PageLoadError -> Html msg
|
||||
view session (PageLoadError model) =
|
||||
main_ [ id "content", class "container", tabindex -1 ]
|
||||
[ h1 [] [ text "Error Loading Page" ]
|
||||
, div [ class "row" ]
|
||||
[ p [] [ text model.errorMessage ] ]
|
||||
]
|
||||
@@ -1,130 +0,0 @@
|
||||
module Page.Home exposing (Model, Msg, init, update, view)
|
||||
|
||||
{-| The homepage. You can get here via either the / or /#/ routes.
|
||||
-}
|
||||
|
||||
import Data.Article as Article exposing (Tag)
|
||||
import Data.Session exposing (Session)
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (attribute, class, classList, href, id, placeholder)
|
||||
import Html.Events exposing (onClick)
|
||||
import Http
|
||||
import Page.Errored exposing (PageLoadError, pageLoadError)
|
||||
import Request.Article
|
||||
import SelectList exposing (SelectList)
|
||||
import Task exposing (Task)
|
||||
import Views.Article.Feed as Feed exposing (FeedSource, globalFeed, tagFeed, yourFeed)
|
||||
import Views.Page as Page
|
||||
|
||||
|
||||
-- MODEL --
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ tags : List Tag
|
||||
, feed : Feed.Model
|
||||
}
|
||||
|
||||
|
||||
init : Session -> Task PageLoadError Model
|
||||
init session =
|
||||
let
|
||||
feedSources =
|
||||
if session.user == Nothing then
|
||||
SelectList.singleton globalFeed
|
||||
else
|
||||
SelectList.fromLists [] globalFeed [ yourFeed ]
|
||||
|
||||
loadTags =
|
||||
Request.Article.tags
|
||||
|> Http.toTask
|
||||
|
||||
loadSources =
|
||||
Feed.init session feedSources
|
||||
|
||||
handleLoadError _ =
|
||||
pageLoadError Page.Home "Homepage is currently unavailable."
|
||||
in
|
||||
Task.map2 Model loadTags loadSources
|
||||
|> Task.mapError handleLoadError
|
||||
|
||||
|
||||
|
||||
-- VIEW --
|
||||
|
||||
|
||||
view : Session -> Model -> Html Msg
|
||||
view session model =
|
||||
div [ class "home-page" ]
|
||||
[ viewBanner
|
||||
, div [ class "container page" ]
|
||||
[ div [ class "row" ]
|
||||
[ div [ class "col-md-9" ] (viewFeed model.feed)
|
||||
, div [ class "col-md-3" ]
|
||||
[ div [ class "sidebar" ]
|
||||
[ p [] [ text "Popular Tags" ]
|
||||
, viewTags model.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 : Feed.Model -> List (Html Msg)
|
||||
viewFeed feed =
|
||||
div [ class "feed-toggle" ]
|
||||
[ Feed.viewFeedSources feed |> Html.map FeedMsg ]
|
||||
:: (Feed.viewArticles feed |> List.map (Html.map FeedMsg))
|
||||
|
||||
|
||||
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"
|
||||
, href "javascript:void(0)"
|
||||
, onClick (SelectTag tagName)
|
||||
]
|
||||
[ text (Article.tagToString tagName) ]
|
||||
|
||||
|
||||
|
||||
-- UPDATE --
|
||||
|
||||
|
||||
type Msg
|
||||
= FeedMsg Feed.Msg
|
||||
| SelectTag Tag
|
||||
|
||||
|
||||
update : Session -> Msg -> Model -> ( Model, Cmd Msg )
|
||||
update session msg model =
|
||||
case msg of
|
||||
FeedMsg subMsg ->
|
||||
let
|
||||
( newFeed, subCmd ) =
|
||||
Feed.update session subMsg model.feed
|
||||
in
|
||||
( { model | feed = newFeed }, Cmd.map FeedMsg subCmd )
|
||||
|
||||
SelectTag tagName ->
|
||||
let
|
||||
subCmd =
|
||||
Feed.selectTag (Maybe.map .token session.user) tagName
|
||||
in
|
||||
( model, Cmd.map FeedMsg subCmd )
|
||||
@@ -1,214 +0,0 @@
|
||||
module Page.Login exposing (ExternalMsg(..), Model, Msg, initialModel, update, view)
|
||||
|
||||
{-| The login page.
|
||||
-}
|
||||
|
||||
import Data.Session exposing (Session)
|
||||
import Data.User exposing (User)
|
||||
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 (decode, optional)
|
||||
import Request.User exposing (storeSession)
|
||||
import Route exposing (Route)
|
||||
import Validate exposing (Validator, ifBlank, validate)
|
||||
import Views.Form as Form
|
||||
|
||||
|
||||
-- MODEL --
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ errors : List Error
|
||||
, email : String
|
||||
, password : String
|
||||
}
|
||||
|
||||
|
||||
initialModel : Model
|
||||
initialModel =
|
||||
{ errors = []
|
||||
, email = ""
|
||||
, password = ""
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- VIEW --
|
||||
|
||||
|
||||
view : Session -> Model -> Html Msg
|
||||
view session model =
|
||||
div [ class "auth-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?" ]
|
||||
]
|
||||
, Form.viewErrors model.errors
|
||||
, viewForm
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewForm : Html Msg
|
||||
viewForm =
|
||||
Html.form [ onSubmit SubmitForm ]
|
||||
[ Form.input
|
||||
[ class "form-control-lg"
|
||||
, placeholder "Email"
|
||||
, onInput SetEmail
|
||||
]
|
||||
[]
|
||||
, Form.password
|
||||
[ class "form-control-lg"
|
||||
, placeholder "Password"
|
||||
, onInput SetPassword
|
||||
]
|
||||
[]
|
||||
, button [ class "btn btn-lg btn-primary pull-xs-right" ]
|
||||
[ text "Sign in" ]
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- UPDATE --
|
||||
|
||||
|
||||
type Msg
|
||||
= SubmitForm
|
||||
| SetEmail String
|
||||
| SetPassword String
|
||||
| LoginCompleted (Result Http.Error User)
|
||||
|
||||
|
||||
type ExternalMsg
|
||||
= NoOp
|
||||
| SetUser User
|
||||
|
||||
|
||||
update : Msg -> Model -> ( ( Model, Cmd Msg ), ExternalMsg )
|
||||
update msg model =
|
||||
case msg of
|
||||
SubmitForm ->
|
||||
case validate modelValidator model of
|
||||
[] ->
|
||||
( ( { model | errors = [] }
|
||||
, Http.send LoginCompleted (Request.User.login model)
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
errors ->
|
||||
( ( { model | errors = errors }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
SetEmail email ->
|
||||
( ( { model | email = email }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
SetPassword password ->
|
||||
( ( { model | password = password }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
LoginCompleted (Err error) ->
|
||||
let
|
||||
errorMessages =
|
||||
case error of
|
||||
Http.BadStatus response ->
|
||||
response.body
|
||||
|> decodeString (field "errors" errorsDecoder)
|
||||
|> Result.withDefault []
|
||||
|
||||
_ ->
|
||||
[ "unable to perform login" ]
|
||||
in
|
||||
( ( { model | errors = List.map (\errorMessage -> ( Form, errorMessage )) errorMessages }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
LoginCompleted (Ok user) ->
|
||||
( ( model
|
||||
, Cmd.batch [ storeSession user, Route.modifyUrl Route.Home ]
|
||||
)
|
||||
, SetUser user
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- VALIDATION --
|
||||
|
||||
|
||||
type Field
|
||||
= Form
|
||||
| Email
|
||||
| Password
|
||||
|
||||
|
||||
{-| Recording validation errors on a per-field basis facilitates displaying
|
||||
them inline next to the field where the error occurred.
|
||||
|
||||
I implemented it this way out of habit, then realized the spec called for
|
||||
displaying all the errors at the top. I thought about simplifying it, but then
|
||||
figured it'd be useful to show how I would normally model this data - assuming
|
||||
the intended UX was to render errors per field.
|
||||
|
||||
(The other part of this is having a view function like this:
|
||||
|
||||
viewFormErrors : Field -> List Error -> Html msg
|
||||
|
||||
...and it filters the list of errors to render only the ones for the given
|
||||
Field. This way you can call this:
|
||||
|
||||
viewFormErrors Email model.errors
|
||||
|
||||
...next to the `email` field, and call `viewFormErrors Password model.errors`
|
||||
next to the `password` field, and so on.
|
||||
|
||||
-}
|
||||
type alias Error =
|
||||
( Field, String )
|
||||
|
||||
|
||||
modelValidator : Validator Error Model
|
||||
modelValidator =
|
||||
Validate.all
|
||||
[ ifBlank .email ( Email, "email can't be blank." )
|
||||
, ifBlank .password ( Password, "password can't be blank." )
|
||||
]
|
||||
|
||||
|
||||
errorsDecoder : Decoder (List String)
|
||||
errorsDecoder =
|
||||
decode (\emailOrPassword email username password -> List.concat [ emailOrPassword, email, username, password ])
|
||||
|> optionalError "email or password"
|
||||
|> optionalError "email"
|
||||
|> optionalError "username"
|
||||
|> optionalError "password"
|
||||
|
||||
|
||||
optionalError : String -> Decoder (List String -> a) -> Decoder a
|
||||
optionalError fieldName =
|
||||
let
|
||||
errorToString errorMessage =
|
||||
String.join " " [ fieldName, errorMessage ]
|
||||
in
|
||||
optional fieldName (Decode.list (Decode.map errorToString string)) []
|
||||
@@ -1,18 +0,0 @@
|
||||
module Page.NotFound exposing (view)
|
||||
|
||||
import Data.Session exposing (Session)
|
||||
import Html exposing (Html, div, h1, img, main_, text)
|
||||
import Html.Attributes exposing (alt, class, id, src, tabindex)
|
||||
import Views.Assets as Assets
|
||||
|
||||
|
||||
-- VIEW --
|
||||
|
||||
|
||||
view : Session -> Html msg
|
||||
view session =
|
||||
main_ [ id "content", class "container", tabindex -1 ]
|
||||
[ h1 [] [ text "Not Found" ]
|
||||
, div [ class "row" ]
|
||||
[ img [ Assets.src Assets.error, alt "giant laser walrus wreaking havoc" ] [] ]
|
||||
]
|
||||
@@ -1,168 +0,0 @@
|
||||
module Page.Profile exposing (Model, Msg, init, update, view)
|
||||
|
||||
{-| Viewing a user's profile.
|
||||
-}
|
||||
|
||||
import Data.Profile exposing (Profile)
|
||||
import Data.Session exposing (Session)
|
||||
import Data.User as User exposing (Username)
|
||||
import Data.UserPhoto as UserPhoto exposing (UserPhoto)
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Http
|
||||
import Page.Errored exposing (PageLoadError, pageLoadError)
|
||||
import Request.Article exposing (ListConfig, defaultListConfig)
|
||||
import Request.Profile
|
||||
import SelectList exposing (SelectList)
|
||||
import Task exposing (Task)
|
||||
import Util exposing (pair, viewIf)
|
||||
import Views.Article.Feed as Feed exposing (FeedSource, authorFeed, favoritedFeed)
|
||||
import Views.Errors as Errors
|
||||
import Views.Page as Page
|
||||
import Views.User.Follow as Follow
|
||||
|
||||
|
||||
-- MODEL --
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ errors : List String
|
||||
, profile : Profile
|
||||
, feed : Feed.Model
|
||||
}
|
||||
|
||||
|
||||
init : Session -> Username -> Task PageLoadError Model
|
||||
init session username =
|
||||
let
|
||||
config : ListConfig
|
||||
config =
|
||||
{ defaultListConfig | limit = 5, author = Just username }
|
||||
|
||||
maybeAuthToken =
|
||||
session.user
|
||||
|> Maybe.map .token
|
||||
|
||||
loadProfile =
|
||||
Request.Profile.get username maybeAuthToken
|
||||
|> Http.toTask
|
||||
|
||||
loadFeedSources =
|
||||
Feed.init session (defaultFeedSources username)
|
||||
|
||||
handleLoadError _ =
|
||||
"Profile is currently unavailable."
|
||||
|> pageLoadError (Page.Profile username)
|
||||
in
|
||||
Task.map2 (Model []) loadProfile loadFeedSources
|
||||
|> Task.mapError handleLoadError
|
||||
|
||||
|
||||
|
||||
-- VIEW --
|
||||
|
||||
|
||||
view : Session -> Model -> Html Msg
|
||||
view session model =
|
||||
let
|
||||
profile =
|
||||
model.profile
|
||||
|
||||
isMyProfile =
|
||||
session.user
|
||||
|> Maybe.map (\{ username } -> username == profile.username)
|
||||
|> Maybe.withDefault False
|
||||
in
|
||||
div [ class "profile-page" ]
|
||||
[ Errors.view DismissErrors model.errors
|
||||
, div [ class "user-info" ]
|
||||
[ div [ class "container" ]
|
||||
[ div [ class "row" ]
|
||||
[ viewProfileInfo isMyProfile profile ]
|
||||
]
|
||||
]
|
||||
, div [ class "container" ]
|
||||
[ div [ class "row" ] [ viewFeed model.feed ] ]
|
||||
]
|
||||
|
||||
|
||||
viewProfileInfo : Bool -> Profile -> Html Msg
|
||||
viewProfileInfo isMyProfile profile =
|
||||
div [ class "col-xs-12 col-md-10 offset-md-1" ]
|
||||
[ img [ class "user-img", UserPhoto.src profile.image ] []
|
||||
, h4 [] [ User.usernameToHtml profile.username ]
|
||||
, p [] [ text (Maybe.withDefault "" profile.bio) ]
|
||||
, viewIf (not isMyProfile) (followButton profile)
|
||||
]
|
||||
|
||||
|
||||
viewFeed : Feed.Model -> Html Msg
|
||||
viewFeed feed =
|
||||
div [ class "col-xs-12 col-md-10 offset-md-1" ] <|
|
||||
div [ class "articles-toggle" ]
|
||||
[ Feed.viewFeedSources feed |> Html.map FeedMsg ]
|
||||
:: (Feed.viewArticles feed |> List.map (Html.map FeedMsg))
|
||||
|
||||
|
||||
|
||||
-- UPDATE --
|
||||
|
||||
|
||||
type Msg
|
||||
= DismissErrors
|
||||
| ToggleFollow
|
||||
| FollowCompleted (Result Http.Error Profile)
|
||||
| FeedMsg Feed.Msg
|
||||
|
||||
|
||||
update : Session -> Msg -> Model -> ( Model, Cmd Msg )
|
||||
update session msg model =
|
||||
let
|
||||
profile =
|
||||
model.profile
|
||||
in
|
||||
case msg of
|
||||
DismissErrors ->
|
||||
( { model | errors = [] }, Cmd.none )
|
||||
|
||||
ToggleFollow ->
|
||||
case session.user of
|
||||
Nothing ->
|
||||
( { model | errors = model.errors ++ [ "You are currently signed out. You must be signed in to follow people." ] }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
Just user ->
|
||||
user.token
|
||||
|> Request.Profile.toggleFollow
|
||||
profile.username
|
||||
profile.following
|
||||
|> Http.send FollowCompleted
|
||||
|> pair model
|
||||
|
||||
FollowCompleted (Ok newProfile) ->
|
||||
( { model | profile = newProfile }, Cmd.none )
|
||||
|
||||
FollowCompleted (Err error) ->
|
||||
( model, Cmd.none )
|
||||
|
||||
FeedMsg subMsg ->
|
||||
let
|
||||
( newFeed, subCmd ) =
|
||||
Feed.update session subMsg model.feed
|
||||
in
|
||||
( { model | feed = newFeed }, Cmd.map FeedMsg subCmd )
|
||||
|
||||
|
||||
followButton : Profile -> Html Msg
|
||||
followButton =
|
||||
Follow.button (\_ -> ToggleFollow)
|
||||
|
||||
|
||||
|
||||
-- INTERNAL --
|
||||
|
||||
|
||||
defaultFeedSources : Username -> SelectList FeedSource
|
||||
defaultFeedSources username =
|
||||
SelectList.fromLists [] (authorFeed username) [ favoritedFeed username ]
|
||||
@@ -1,220 +0,0 @@
|
||||
module Page.Register exposing (ExternalMsg(..), Model, Msg, initialModel, update, view)
|
||||
|
||||
import Data.Session exposing (Session)
|
||||
import Data.User exposing (User)
|
||||
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 (decode, optional)
|
||||
import Request.User exposing (storeSession)
|
||||
import Route exposing (Route)
|
||||
import Validate exposing (Validator, ifBlank, validate)
|
||||
import Views.Form as Form
|
||||
|
||||
|
||||
-- MODEL --
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ errors : List Error
|
||||
, email : String
|
||||
, username : String
|
||||
, password : String
|
||||
}
|
||||
|
||||
|
||||
initialModel : Model
|
||||
initialModel =
|
||||
{ errors = []
|
||||
, email = ""
|
||||
, username = ""
|
||||
, password = ""
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- VIEW --
|
||||
|
||||
|
||||
view : Session -> Model -> Html Msg
|
||||
view session model =
|
||||
div [ class "auth-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?" ]
|
||||
]
|
||||
, Form.viewErrors model.errors
|
||||
, viewForm
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewForm : Html Msg
|
||||
viewForm =
|
||||
Html.form [ onSubmit SubmitForm ]
|
||||
[ Form.input
|
||||
[ class "form-control-lg"
|
||||
, placeholder "Username"
|
||||
, onInput SetUsername
|
||||
]
|
||||
[]
|
||||
, Form.input
|
||||
[ class "form-control-lg"
|
||||
, placeholder "Email"
|
||||
, onInput SetEmail
|
||||
]
|
||||
[]
|
||||
, Form.password
|
||||
[ class "form-control-lg"
|
||||
, placeholder "Password"
|
||||
, onInput SetPassword
|
||||
]
|
||||
[]
|
||||
, button [ class "btn btn-lg btn-primary pull-xs-right" ]
|
||||
[ text "Sign up" ]
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- UPDATE --
|
||||
|
||||
|
||||
type Msg
|
||||
= SubmitForm
|
||||
| SetEmail String
|
||||
| SetUsername String
|
||||
| SetPassword String
|
||||
| RegisterCompleted (Result Http.Error User)
|
||||
|
||||
|
||||
type ExternalMsg
|
||||
= NoOp
|
||||
| SetUser User
|
||||
|
||||
|
||||
update : Msg -> Model -> ( ( Model, Cmd Msg ), ExternalMsg )
|
||||
update msg model =
|
||||
case msg of
|
||||
SubmitForm ->
|
||||
case validate modelValidator model of
|
||||
[] ->
|
||||
( ( { model | errors = [] }
|
||||
, Http.send RegisterCompleted (Request.User.register model)
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
errors ->
|
||||
( ( { model | errors = errors }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
SetEmail email ->
|
||||
( ( { model | email = email }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
SetUsername username ->
|
||||
( ( { model | username = username }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
SetPassword password ->
|
||||
( ( { model | password = password }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
RegisterCompleted (Err error) ->
|
||||
let
|
||||
errorMessages =
|
||||
case Debug.log "ERROR:" error of
|
||||
Http.BadStatus response ->
|
||||
response.body
|
||||
|> decodeString (field "errors" errorsDecoder)
|
||||
|> Result.withDefault []
|
||||
|
||||
_ ->
|
||||
[ "unable to process registration" ]
|
||||
in
|
||||
( ( { model | errors = List.map (\errorMessage -> ( Form, errorMessage )) errorMessages }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
RegisterCompleted (Ok user) ->
|
||||
( ( model
|
||||
, Cmd.batch [ storeSession user, Route.modifyUrl Route.Home ]
|
||||
)
|
||||
, SetUser user
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- VALIDATION --
|
||||
|
||||
|
||||
type Field
|
||||
= Form
|
||||
| Username
|
||||
| Email
|
||||
| Password
|
||||
|
||||
|
||||
type alias Error =
|
||||
( Field, String )
|
||||
|
||||
|
||||
modelValidator : Validator Error Model
|
||||
modelValidator =
|
||||
Validate.all
|
||||
[ ifBlank .username ( Username, "username can't be blank." )
|
||||
, ifBlank .email ( Email, "email can't be blank." )
|
||||
, Validate.fromErrors passwordLength
|
||||
]
|
||||
|
||||
|
||||
minPasswordChars : Int
|
||||
minPasswordChars =
|
||||
6
|
||||
|
||||
|
||||
passwordLength : Model -> List Error
|
||||
passwordLength { password } =
|
||||
if String.length password < minPasswordChars then
|
||||
[ ( Password, "password must be at least " ++ toString minPasswordChars ++ " characters long." ) ]
|
||||
else
|
||||
[]
|
||||
|
||||
|
||||
errorsDecoder : Decoder (List String)
|
||||
errorsDecoder =
|
||||
decode (\email username password -> List.concat [ email, username, password ])
|
||||
|> optionalError "email"
|
||||
|> optionalError "username"
|
||||
|> optionalError "password"
|
||||
|
||||
|
||||
optionalError : String -> Decoder (List String -> a) -> Decoder a
|
||||
optionalError fieldName =
|
||||
let
|
||||
errorToString errorMessage =
|
||||
String.join " " [ fieldName, errorMessage ]
|
||||
in
|
||||
optional fieldName (Decode.list (Decode.map errorToString string)) []
|
||||
@@ -1,266 +0,0 @@
|
||||
module Page.Settings exposing (ExternalMsg(..), Model, Msg, init, update, view)
|
||||
|
||||
import Data.Session exposing (Session)
|
||||
import Data.User as User exposing (User)
|
||||
import Data.UserPhoto as UserPhoto
|
||||
import Html exposing (Html, button, div, fieldset, h1, input, text, textarea)
|
||||
import Html.Attributes exposing (attribute, class, value, placeholder, type_)
|
||||
import Html.Events exposing (onInput, onSubmit)
|
||||
import Http
|
||||
import Json.Decode as Decode exposing (Decoder, decodeString, field, list, string)
|
||||
import Json.Decode.Pipeline exposing (decode, optional)
|
||||
import Request.User exposing (storeSession)
|
||||
import Route
|
||||
import Util exposing (pair)
|
||||
import Validate exposing (Validator, ifBlank, validate)
|
||||
import Views.Form as Form
|
||||
|
||||
|
||||
-- MODEL --
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ errors : List Error
|
||||
, image : Maybe String
|
||||
, email : String
|
||||
, bio : String
|
||||
, username : String
|
||||
, password : Maybe String
|
||||
}
|
||||
|
||||
|
||||
init : User -> Model
|
||||
init user =
|
||||
{ errors = []
|
||||
, image = UserPhoto.toMaybeString user.image
|
||||
, email = user.email
|
||||
, bio = Maybe.withDefault "" user.bio
|
||||
, username = User.usernameToString user.username
|
||||
, password = Nothing
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- VIEW --
|
||||
|
||||
|
||||
view : Session -> Model -> Html Msg
|
||||
view session model =
|
||||
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" ]
|
||||
, Form.viewErrors model.errors
|
||||
, viewForm model
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewForm : Model -> Html Msg
|
||||
viewForm model =
|
||||
Html.form [ onSubmit SubmitForm ]
|
||||
[ fieldset []
|
||||
[ Form.input
|
||||
[ placeholder "URL of profile picture"
|
||||
, value (Maybe.withDefault "" model.image)
|
||||
, onInput SetImage
|
||||
]
|
||||
[]
|
||||
, Form.input
|
||||
[ class "form-control-lg"
|
||||
, placeholder "Username"
|
||||
, value model.username
|
||||
, onInput SetUsername
|
||||
]
|
||||
[]
|
||||
, Form.textarea
|
||||
[ class "form-control-lg"
|
||||
, placeholder "Short bio about you"
|
||||
, attribute "rows" "8"
|
||||
, value model.bio
|
||||
, onInput SetBio
|
||||
]
|
||||
[]
|
||||
, Form.input
|
||||
[ class "form-control-lg"
|
||||
, placeholder "Email"
|
||||
, value model.email
|
||||
, onInput SetEmail
|
||||
]
|
||||
[]
|
||||
, Form.password
|
||||
[ class "form-control-lg"
|
||||
, placeholder "Password"
|
||||
, value (Maybe.withDefault "" model.password)
|
||||
, onInput SetPassword
|
||||
]
|
||||
[]
|
||||
, button
|
||||
[ class "btn btn-lg btn-primary pull-xs-right" ]
|
||||
[ text "Update Settings" ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- UPDATE --
|
||||
|
||||
|
||||
type Msg
|
||||
= SubmitForm
|
||||
| SetEmail String
|
||||
| SetUsername String
|
||||
| SetPassword String
|
||||
| SetBio String
|
||||
| SetImage String
|
||||
| SaveCompleted (Result Http.Error User)
|
||||
|
||||
|
||||
type ExternalMsg
|
||||
= NoOp
|
||||
| SetUser User
|
||||
|
||||
|
||||
update : Session -> Msg -> Model -> ( ( Model, Cmd Msg ), ExternalMsg )
|
||||
update session msg model =
|
||||
case msg of
|
||||
SubmitForm ->
|
||||
case validate modelValidator model of
|
||||
[] ->
|
||||
( session.user
|
||||
|> Maybe.map .token
|
||||
|> Request.User.edit model
|
||||
|> Http.send SaveCompleted
|
||||
|> pair { model | errors = [] }
|
||||
, NoOp
|
||||
)
|
||||
|
||||
errors ->
|
||||
( ( { model | errors = errors }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
SetEmail email ->
|
||||
( ( { model | email = email }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
SetUsername username ->
|
||||
( ( { model | username = username }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
SetPassword passwordStr ->
|
||||
let
|
||||
password =
|
||||
if String.isEmpty passwordStr then
|
||||
Nothing
|
||||
else
|
||||
Just passwordStr
|
||||
in
|
||||
( ( { model | password = password }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
SetBio bio ->
|
||||
( ( { model | bio = bio }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
SetImage imageStr ->
|
||||
let
|
||||
image =
|
||||
if String.isEmpty imageStr then
|
||||
Nothing
|
||||
else
|
||||
Just imageStr
|
||||
in
|
||||
( ( { model | image = image }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
SaveCompleted (Err error) ->
|
||||
let
|
||||
errorMessages =
|
||||
case error of
|
||||
Http.BadStatus response ->
|
||||
response.body
|
||||
|> decodeString (field "errors" errorsDecoder)
|
||||
|> Result.withDefault []
|
||||
|
||||
_ ->
|
||||
[ "unable to save changes" ]
|
||||
|
||||
errors =
|
||||
errorMessages
|
||||
|> List.map (\errorMessage -> ( Form, errorMessage ))
|
||||
in
|
||||
( ( { model | errors = errors }
|
||||
, Cmd.none
|
||||
)
|
||||
, NoOp
|
||||
)
|
||||
|
||||
SaveCompleted (Ok user) ->
|
||||
( ( model
|
||||
, Cmd.batch [ storeSession user, Route.modifyUrl Route.Home ]
|
||||
)
|
||||
, SetUser user
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- VALIDATION --
|
||||
|
||||
|
||||
type Field
|
||||
= Form
|
||||
| Username
|
||||
| Email
|
||||
| Password
|
||||
| ImageUrl
|
||||
| Bio
|
||||
|
||||
|
||||
type alias Error =
|
||||
( Field, String )
|
||||
|
||||
|
||||
modelValidator : Validator Error Model
|
||||
modelValidator =
|
||||
Validate.all
|
||||
[ ifBlank .username ( Username, "username can't be blank." )
|
||||
, ifBlank .email ( Email, "email can't be blank." )
|
||||
]
|
||||
|
||||
|
||||
errorsDecoder : Decoder (List String)
|
||||
errorsDecoder =
|
||||
decode (\email username password -> List.concat [ email, username, password ])
|
||||
|> optionalError "email"
|
||||
|> optionalError "username"
|
||||
|> optionalError "password"
|
||||
|
||||
|
||||
optionalError : String -> Decoder (List String -> a) -> Decoder a
|
||||
optionalError fieldName =
|
||||
let
|
||||
errorToString errorMessage =
|
||||
String.join " " [ fieldName, errorMessage ]
|
||||
in
|
||||
optional fieldName (list (Decode.map errorToString string)) []
|
||||
Reference in New Issue
Block a user