Rename more stuff
This commit is contained in:
154
intro/part10/src/Data/Article.elm
Normal file
154
intro/part10/src/Data/Article.elm
Normal file
@@ -0,0 +1,154 @@
|
||||
module Data.Article
|
||||
exposing
|
||||
( Article
|
||||
, Body
|
||||
, Slug
|
||||
, Tag
|
||||
, bodyToHtml
|
||||
, bodyToMarkdownString
|
||||
, decoder
|
||||
, decoderWithBody
|
||||
, slugParser
|
||||
, slugToString
|
||||
, tagDecoder
|
||||
, tagToString
|
||||
)
|
||||
|
||||
import Data.Article.Author as Author exposing (Author)
|
||||
import Date exposing (Date)
|
||||
import Html exposing (Attribute, Html)
|
||||
import Json.Decode as Decode exposing (Decoder)
|
||||
import Json.Decode.Extra
|
||||
import Json.Decode.Pipeline exposing (custom, decode, hardcoded, required)
|
||||
import Markdown
|
||||
import UrlParser
|
||||
|
||||
|
||||
{-| An article, optionally with an article body.
|
||||
|
||||
To see the difference between { body : body } and { body : Maybe Body },
|
||||
consider the difference between the "view individual article" page (which
|
||||
renders one article, including its body) and the "article feed" -
|
||||
which displays multiple articles, but without bodies.
|
||||
|
||||
This definition for `Article` means we can write:
|
||||
|
||||
viewArticle : Article Body -> Html msg
|
||||
viewFeed : List (Article ()) -> Html msg
|
||||
|
||||
This indicates that `viewArticle` requires an article _with a `body` present_,
|
||||
wereas `viewFeed` accepts articles with no bodies. (We could also have written
|
||||
it as `List (Article a)` to specify that feeds can accept either articles that
|
||||
have `body` present or not. Either work, given that feeds do not attempt to
|
||||
read the `body` field from articles.)
|
||||
|
||||
This is an important distinction, because in Request.Article, the `feed`
|
||||
function produces `List (Article ())` because the API does not return bodies.
|
||||
Those articles are useful to the feed, but not to the individual article view.
|
||||
|
||||
-}
|
||||
type alias Article a =
|
||||
{ description : String
|
||||
, slug : Slug
|
||||
, title : String
|
||||
, tags : List String
|
||||
, createdAt : Date
|
||||
, updatedAt : Date
|
||||
, favorited : Bool
|
||||
, favoritesCount : Int
|
||||
, author : Author
|
||||
, body : a
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- SERIALIZATION --
|
||||
|
||||
|
||||
decoder : Decoder (Article ())
|
||||
decoder =
|
||||
baseArticleDecoder
|
||||
|> hardcoded ()
|
||||
|
||||
|
||||
decoderWithBody : Decoder (Article Body)
|
||||
decoderWithBody =
|
||||
baseArticleDecoder
|
||||
|> required "body" bodyDecoder
|
||||
|
||||
|
||||
baseArticleDecoder : Decoder (a -> Article a)
|
||||
baseArticleDecoder =
|
||||
decode Article
|
||||
|> required "description" (Decode.map (Maybe.withDefault "") (Decode.nullable Decode.string))
|
||||
|> required "slug" (Decode.map Slug Decode.string)
|
||||
|> required "title" Decode.string
|
||||
|> required "tagList" (Decode.list Decode.string)
|
||||
|> required "createdAt" Json.Decode.Extra.date
|
||||
|> required "updatedAt" Json.Decode.Extra.date
|
||||
|> required "favorited" Decode.bool
|
||||
|> required "favoritesCount" Decode.int
|
||||
|> required "author" Author.decoder
|
||||
|
||||
|
||||
|
||||
-- IDENTIFIERS --
|
||||
|
||||
|
||||
type Slug
|
||||
= Slug String
|
||||
|
||||
|
||||
slugParser : UrlParser.Parser (Slug -> a) a
|
||||
slugParser =
|
||||
UrlParser.custom "SLUG" (Ok << Slug)
|
||||
|
||||
|
||||
slugToString : Slug -> String
|
||||
slugToString (Slug slug) =
|
||||
slug
|
||||
|
||||
|
||||
|
||||
-- TAGS --
|
||||
|
||||
|
||||
type Tag
|
||||
= Tag String
|
||||
|
||||
|
||||
tagToString : Tag -> String
|
||||
tagToString (Tag slug) =
|
||||
slug
|
||||
|
||||
|
||||
tagDecoder : Decoder Tag
|
||||
tagDecoder =
|
||||
Decode.map Tag Decode.string
|
||||
|
||||
|
||||
|
||||
-- BODY --
|
||||
|
||||
|
||||
type Body
|
||||
= Body Markdown
|
||||
|
||||
|
||||
type alias Markdown =
|
||||
String
|
||||
|
||||
|
||||
bodyToHtml : Body -> List (Attribute msg) -> Html msg
|
||||
bodyToHtml (Body markdown) attributes =
|
||||
Markdown.toHtml attributes markdown
|
||||
|
||||
|
||||
bodyToMarkdownString : Body -> String
|
||||
bodyToMarkdownString (Body markdown) =
|
||||
markdown
|
||||
|
||||
|
||||
bodyDecoder : Decoder Body
|
||||
bodyDecoder =
|
||||
Decode.map Body Decode.string
|
||||
23
intro/part10/src/Data/Article/Author.elm
Normal file
23
intro/part10/src/Data/Article/Author.elm
Normal file
@@ -0,0 +1,23 @@
|
||||
module Data.Article.Author exposing (Author, decoder)
|
||||
|
||||
import Data.User as User exposing (Username)
|
||||
import Data.UserPhoto as UserPhoto exposing (UserPhoto)
|
||||
import Json.Decode as Decode exposing (Decoder)
|
||||
import Json.Decode.Pipeline exposing (custom, decode, optional, required)
|
||||
|
||||
|
||||
decoder : Decoder Author
|
||||
decoder =
|
||||
decode Author
|
||||
|> required "username" User.usernameDecoder
|
||||
|> required "bio" (Decode.nullable Decode.string)
|
||||
|> required "image" UserPhoto.decoder
|
||||
|> optional "following" Decode.bool False
|
||||
|
||||
|
||||
type alias Author =
|
||||
{ username : Username
|
||||
, bio : Maybe String
|
||||
, image : UserPhoto
|
||||
, following : Bool
|
||||
}
|
||||
48
intro/part10/src/Data/Article/Comment.elm
Normal file
48
intro/part10/src/Data/Article/Comment.elm
Normal file
@@ -0,0 +1,48 @@
|
||||
module Data.Article.Comment exposing (Comment, CommentId, commentIdDecoder, decoder, idToString)
|
||||
|
||||
import Data.Article.Author as Author exposing (Author)
|
||||
import Date exposing (Date)
|
||||
import Json.Decode as Decode exposing (Decoder)
|
||||
import Json.Decode.Extra
|
||||
import Json.Decode.Pipeline exposing (custom, decode, required)
|
||||
|
||||
|
||||
type alias Comment =
|
||||
{ id : CommentId
|
||||
, body : String
|
||||
, createdAt : Date
|
||||
, updatedAt : Date
|
||||
, author : Author
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- SERIALIZATION --
|
||||
|
||||
|
||||
decoder : Decoder Comment
|
||||
decoder =
|
||||
decode Comment
|
||||
|> required "id" commentIdDecoder
|
||||
|> required "body" Decode.string
|
||||
|> required "createdAt" Json.Decode.Extra.date
|
||||
|> required "updatedAt" Json.Decode.Extra.date
|
||||
|> required "author" Author.decoder
|
||||
|
||||
|
||||
|
||||
-- IDENTIFIERS --
|
||||
|
||||
|
||||
type CommentId
|
||||
= CommentId Int
|
||||
|
||||
|
||||
idToString : CommentId -> String
|
||||
idToString (CommentId id) =
|
||||
toString id
|
||||
|
||||
|
||||
commentIdDecoder : Decoder CommentId
|
||||
commentIdDecoder =
|
||||
Decode.map CommentId Decode.int
|
||||
22
intro/part10/src/Data/Article/Feed.elm
Normal file
22
intro/part10/src/Data/Article/Feed.elm
Normal file
@@ -0,0 +1,22 @@
|
||||
module Data.Article.Feed exposing (Feed, decoder)
|
||||
|
||||
import Data.Article as Article exposing (Article)
|
||||
import Json.Decode as Decode exposing (Decoder)
|
||||
import Json.Decode.Pipeline exposing (decode, required)
|
||||
|
||||
|
||||
type alias Feed =
|
||||
{ articles : List (Article ())
|
||||
, articlesCount : Int
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- SERIALIZATION --
|
||||
|
||||
|
||||
decoder : Decoder Feed
|
||||
decoder =
|
||||
decode Feed
|
||||
|> required "articles" (Decode.list Article.decoder)
|
||||
|> required "articlesCount" Decode.int
|
||||
31
intro/part10/src/Data/AuthToken.elm
Normal file
31
intro/part10/src/Data/AuthToken.elm
Normal file
@@ -0,0 +1,31 @@
|
||||
module Data.AuthToken exposing (AuthToken, decoder, encode, withAuthorization)
|
||||
|
||||
import HttpBuilder exposing (RequestBuilder, withHeader)
|
||||
import Json.Decode as Decode exposing (Decoder)
|
||||
import Json.Encode as Encode exposing (Value)
|
||||
|
||||
|
||||
type AuthToken
|
||||
= AuthToken String
|
||||
|
||||
|
||||
encode : AuthToken -> Value
|
||||
encode (AuthToken token) =
|
||||
Encode.string token
|
||||
|
||||
|
||||
decoder : Decoder AuthToken
|
||||
decoder =
|
||||
Decode.string
|
||||
|> Decode.map AuthToken
|
||||
|
||||
|
||||
withAuthorization : Maybe AuthToken -> RequestBuilder a -> RequestBuilder a
|
||||
withAuthorization maybeToken builder =
|
||||
case maybeToken of
|
||||
Just (AuthToken token) ->
|
||||
builder
|
||||
|> withHeader "authorization" ("Token " ++ token)
|
||||
|
||||
Nothing ->
|
||||
builder
|
||||
23
intro/part10/src/Data/Profile.elm
Normal file
23
intro/part10/src/Data/Profile.elm
Normal file
@@ -0,0 +1,23 @@
|
||||
module Data.Profile exposing (Profile, decoder)
|
||||
|
||||
import Data.User as User exposing (Username)
|
||||
import Data.UserPhoto as UserPhoto exposing (UserPhoto)
|
||||
import Json.Decode as Decode exposing (Decoder)
|
||||
import Json.Decode.Pipeline exposing (decode, required)
|
||||
|
||||
|
||||
type alias Profile =
|
||||
{ username : Username
|
||||
, bio : Maybe String
|
||||
, image : UserPhoto
|
||||
, following : Bool
|
||||
}
|
||||
|
||||
|
||||
decoder : Decoder Profile
|
||||
decoder =
|
||||
decode Profile
|
||||
|> required "username" User.usernameDecoder
|
||||
|> required "bio" (Decode.nullable Decode.string)
|
||||
|> required "image" UserPhoto.decoder
|
||||
|> required "following" Decode.bool
|
||||
18
intro/part10/src/Data/Session.elm
Normal file
18
intro/part10/src/Data/Session.elm
Normal file
@@ -0,0 +1,18 @@
|
||||
module Data.Session exposing (Session, attempt)
|
||||
|
||||
import Data.AuthToken exposing (AuthToken)
|
||||
import Data.User exposing (User)
|
||||
|
||||
|
||||
type alias Session =
|
||||
{ user : Maybe User }
|
||||
|
||||
|
||||
attempt : String -> (AuthToken -> Cmd msg) -> Session -> ( List String, Cmd msg )
|
||||
attempt attemptedAction toCmd session =
|
||||
case Maybe.map .token session.user of
|
||||
Nothing ->
|
||||
( [ "You have been signed out. Please sign back in to " ++ attemptedAction ++ "." ], Cmd.none )
|
||||
|
||||
Just token ->
|
||||
( [], toCmd token )
|
||||
77
intro/part10/src/Data/User.elm
Normal file
77
intro/part10/src/Data/User.elm
Normal file
@@ -0,0 +1,77 @@
|
||||
module Data.User exposing (User, Username, decoder, encode, usernameDecoder, usernameParser, usernameToHtml, usernameToString)
|
||||
|
||||
import Data.AuthToken as AuthToken exposing (AuthToken)
|
||||
import Data.UserPhoto as UserPhoto exposing (UserPhoto)
|
||||
import Html exposing (Html)
|
||||
import Json.Decode as Decode exposing (Decoder)
|
||||
import Json.Decode.Pipeline exposing (decode, optional, required)
|
||||
import Json.Encode as Encode exposing (Value)
|
||||
import Json.Encode.Extra as EncodeExtra
|
||||
import UrlParser
|
||||
|
||||
|
||||
type alias User =
|
||||
{ email : String
|
||||
, token : AuthToken
|
||||
, username : Username
|
||||
, bio : Maybe String
|
||||
, image : UserPhoto
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- SERIALIZATION --
|
||||
|
||||
|
||||
decoder : Decoder User
|
||||
decoder =
|
||||
decode User
|
||||
|> required "email" Decode.string
|
||||
|> required "token" AuthToken.decoder
|
||||
|> required "username" usernameDecoder
|
||||
|> required "bio" (Decode.nullable Decode.string)
|
||||
|> required "image" UserPhoto.decoder
|
||||
|
||||
|
||||
encode : User -> Value
|
||||
encode user =
|
||||
Encode.object
|
||||
[ ( "email", Encode.string user.email )
|
||||
, ( "token", AuthToken.encode user.token )
|
||||
, ( "username", encodeUsername user.username )
|
||||
, ( "bio", EncodeExtra.maybe Encode.string user.bio )
|
||||
, ( "image", UserPhoto.encode user.image )
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- IDENTIFIERS --
|
||||
|
||||
|
||||
type Username
|
||||
= Username String
|
||||
|
||||
|
||||
usernameToString : Username -> String
|
||||
usernameToString (Username username) =
|
||||
username
|
||||
|
||||
|
||||
usernameParser : UrlParser.Parser (Username -> a) a
|
||||
usernameParser =
|
||||
UrlParser.custom "USERNAME" (Ok << Username)
|
||||
|
||||
|
||||
usernameDecoder : Decoder Username
|
||||
usernameDecoder =
|
||||
Decode.map Username Decode.string
|
||||
|
||||
|
||||
encodeUsername : Username -> Value
|
||||
encodeUsername (Username username) =
|
||||
Encode.string username
|
||||
|
||||
|
||||
usernameToHtml : Username -> Html msg
|
||||
usernameToHtml (Username username) =
|
||||
Html.text username
|
||||
53
intro/part10/src/Data/UserPhoto.elm
Normal file
53
intro/part10/src/Data/UserPhoto.elm
Normal file
@@ -0,0 +1,53 @@
|
||||
module Data.UserPhoto exposing (UserPhoto, decoder, encode, src, toMaybeString)
|
||||
|
||||
import Html exposing (Attribute)
|
||||
import Html.Attributes
|
||||
import Json.Decode as Decode exposing (Decoder)
|
||||
import Json.Encode as Encode exposing (Value)
|
||||
import Json.Encode.Extra as EncodeExtra
|
||||
|
||||
|
||||
type UserPhoto
|
||||
= UserPhoto (Maybe String)
|
||||
|
||||
|
||||
src : UserPhoto -> Attribute msg
|
||||
src =
|
||||
photoToUrl >> Html.Attributes.src
|
||||
|
||||
|
||||
decoder : Decoder UserPhoto
|
||||
decoder =
|
||||
Decode.map UserPhoto (Decode.nullable Decode.string)
|
||||
|
||||
|
||||
encode : UserPhoto -> Value
|
||||
encode (UserPhoto maybeUrl) =
|
||||
EncodeExtra.maybe Encode.string maybeUrl
|
||||
|
||||
|
||||
toMaybeString : UserPhoto -> Maybe String
|
||||
toMaybeString (UserPhoto maybeUrl) =
|
||||
maybeUrl
|
||||
|
||||
|
||||
|
||||
-- INTERNAL --
|
||||
|
||||
|
||||
photoToUrl : UserPhoto -> String
|
||||
photoToUrl (UserPhoto maybeUrl) =
|
||||
case maybeUrl of
|
||||
Nothing ->
|
||||
defaultPhotoUrl
|
||||
|
||||
Just "" ->
|
||||
defaultPhotoUrl
|
||||
|
||||
Just url ->
|
||||
url
|
||||
|
||||
|
||||
defaultPhotoUrl : String
|
||||
defaultPhotoUrl =
|
||||
"/assets/images/smiley-cyrus.jpg"
|
||||
476
intro/part10/src/Main.elm
Normal file
476
intro/part10/src/Main.elm
Normal file
@@ -0,0 +1,476 @@
|
||||
module Main exposing (main)
|
||||
|
||||
import Data.Article exposing (Slug)
|
||||
import Data.Session exposing (Session)
|
||||
import Data.User as User exposing (User, Username)
|
||||
import Html exposing (..)
|
||||
import Json.Decode as Decode exposing (Value)
|
||||
import Navigation exposing (Location)
|
||||
import Page.Article as Article
|
||||
import Page.Article.Editor as Editor
|
||||
import Page.Errored as Errored exposing (PageLoadError)
|
||||
import Page.Home as Home
|
||||
import Page.Login as Login
|
||||
import Page.NotFound as NotFound
|
||||
import Page.Profile as Profile
|
||||
import Page.Register as Register
|
||||
import Page.Settings as Settings
|
||||
import Ports
|
||||
import Route exposing (Route)
|
||||
import Task
|
||||
import Views.Page as Page exposing (ActivePage)
|
||||
|
||||
|
||||
-- WARNING: Based on discussions around how asset management features
|
||||
-- like code splitting and lazy loading have been shaping up, I expect
|
||||
-- most of this file to become unnecessary in a future release of Elm.
|
||||
-- Avoid putting things in here unless there is no alternative!
|
||||
|
||||
|
||||
type Page
|
||||
= Blank
|
||||
| NotFound
|
||||
| Errored PageLoadError
|
||||
| Home Home.Model
|
||||
| Settings Settings.Model
|
||||
| Login Login.Model
|
||||
| Register Register.Model
|
||||
| Profile Username Profile.Model
|
||||
| Article Article.Model
|
||||
| Editor (Maybe Slug) Editor.Model
|
||||
|
||||
|
||||
type PageState
|
||||
= Loaded Page
|
||||
| TransitioningFrom Page
|
||||
|
||||
|
||||
|
||||
-- MODEL --
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ session : Session
|
||||
, pageState : PageState
|
||||
}
|
||||
|
||||
|
||||
init : Value -> Location -> ( Model, Cmd Msg )
|
||||
init val location =
|
||||
setRoute (Route.fromLocation location)
|
||||
{ pageState = Loaded initialPage
|
||||
, session = { user = decodeUserFromJson val }
|
||||
}
|
||||
|
||||
|
||||
decodeUserFromJson : Value -> Maybe User
|
||||
decodeUserFromJson json =
|
||||
json
|
||||
|> Decode.decodeValue Decode.string
|
||||
|> Result.toMaybe
|
||||
|> Maybe.andThen (Decode.decodeString User.decoder >> Result.toMaybe)
|
||||
|
||||
|
||||
initialPage : Page
|
||||
initialPage =
|
||||
Blank
|
||||
|
||||
|
||||
|
||||
-- VIEW --
|
||||
|
||||
|
||||
view : Model -> Html Msg
|
||||
view model =
|
||||
case model.pageState of
|
||||
Loaded page ->
|
||||
viewPage model.session False page
|
||||
|
||||
TransitioningFrom page ->
|
||||
viewPage model.session True page
|
||||
|
||||
|
||||
viewPage : Session -> Bool -> Page -> Html Msg
|
||||
viewPage session isLoading page =
|
||||
let
|
||||
frame =
|
||||
Page.frame isLoading session.user
|
||||
in
|
||||
case page of
|
||||
NotFound ->
|
||||
NotFound.view session
|
||||
|> frame Page.Other
|
||||
|
||||
Blank ->
|
||||
-- This is for the very initial page load, while we are loading
|
||||
-- data via HTTP. We could also render a spinner here.
|
||||
Html.text ""
|
||||
|> frame Page.Other
|
||||
|
||||
Errored subModel ->
|
||||
Errored.view session subModel
|
||||
|> frame Page.Other
|
||||
|
||||
Settings subModel ->
|
||||
Settings.view session subModel
|
||||
|> frame Page.Other
|
||||
|> Html.map SettingsMsg
|
||||
|
||||
Home subModel ->
|
||||
Home.view session subModel
|
||||
|> frame Page.Home
|
||||
|> Html.map HomeMsg
|
||||
|
||||
Login subModel ->
|
||||
Login.view session subModel
|
||||
|> frame Page.Other
|
||||
|> Html.map LoginMsg
|
||||
|
||||
Register subModel ->
|
||||
Register.view session subModel
|
||||
|> frame Page.Other
|
||||
|> Html.map RegisterMsg
|
||||
|
||||
Profile username subModel ->
|
||||
Profile.view session subModel
|
||||
|> frame (Page.Profile username)
|
||||
|> Html.map ProfileMsg
|
||||
|
||||
Article subModel ->
|
||||
Article.view session subModel
|
||||
|> frame Page.Other
|
||||
|> Html.map ArticleMsg
|
||||
|
||||
Editor maybeSlug subModel ->
|
||||
let
|
||||
framePage =
|
||||
if maybeSlug == Nothing then
|
||||
Page.NewArticle
|
||||
else
|
||||
Page.Other
|
||||
in
|
||||
Editor.view subModel
|
||||
|> frame framePage
|
||||
|> Html.map EditorMsg
|
||||
|
||||
|
||||
|
||||
-- SUBSCRIPTIONS --
|
||||
-- Note: we aren't currently doing any page subscriptions, but I thought it would
|
||||
-- be a good idea to put this in here as an example. If I were actually
|
||||
-- maintaining this in production, I wouldn't bother until I needed this!
|
||||
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions model =
|
||||
Sub.batch
|
||||
[ pageSubscriptions (getPage model.pageState)
|
||||
, Sub.map SetUser sessionChange
|
||||
]
|
||||
|
||||
|
||||
sessionChange : Sub (Maybe User)
|
||||
sessionChange =
|
||||
Ports.onSessionChange (Decode.decodeValue User.decoder >> Result.toMaybe)
|
||||
|
||||
|
||||
getPage : PageState -> Page
|
||||
getPage pageState =
|
||||
case pageState of
|
||||
Loaded page ->
|
||||
page
|
||||
|
||||
TransitioningFrom page ->
|
||||
page
|
||||
|
||||
|
||||
pageSubscriptions : Page -> Sub Msg
|
||||
pageSubscriptions page =
|
||||
case page of
|
||||
Blank ->
|
||||
Sub.none
|
||||
|
||||
Errored _ ->
|
||||
Sub.none
|
||||
|
||||
NotFound ->
|
||||
Sub.none
|
||||
|
||||
Settings _ ->
|
||||
Sub.none
|
||||
|
||||
Home _ ->
|
||||
Sub.none
|
||||
|
||||
Login _ ->
|
||||
Sub.none
|
||||
|
||||
Register _ ->
|
||||
Sub.none
|
||||
|
||||
Profile _ _ ->
|
||||
Sub.none
|
||||
|
||||
Article _ ->
|
||||
Sub.none
|
||||
|
||||
Editor _ _ ->
|
||||
Sub.none
|
||||
|
||||
|
||||
|
||||
-- UPDATE --
|
||||
|
||||
|
||||
type Msg
|
||||
= SetRoute (Maybe Route)
|
||||
| HomeLoaded (Result PageLoadError Home.Model)
|
||||
| ArticleLoaded (Result PageLoadError Article.Model)
|
||||
| ProfileLoaded Username (Result PageLoadError Profile.Model)
|
||||
| EditArticleLoaded Slug (Result PageLoadError Editor.Model)
|
||||
| HomeMsg Home.Msg
|
||||
| SettingsMsg Settings.Msg
|
||||
| SetUser (Maybe User)
|
||||
| LoginMsg Login.Msg
|
||||
| RegisterMsg Register.Msg
|
||||
| ProfileMsg Profile.Msg
|
||||
| ArticleMsg Article.Msg
|
||||
| EditorMsg Editor.Msg
|
||||
|
||||
|
||||
setRoute : Maybe Route -> Model -> ( Model, Cmd Msg )
|
||||
setRoute maybeRoute model =
|
||||
let
|
||||
transition toMsg task =
|
||||
( { model | pageState = TransitioningFrom (getPage model.pageState) }
|
||||
, Task.attempt toMsg task
|
||||
)
|
||||
|
||||
errored =
|
||||
pageErrored model
|
||||
in
|
||||
case maybeRoute of
|
||||
Nothing ->
|
||||
( { model | pageState = Loaded NotFound }, Cmd.none )
|
||||
|
||||
Just Route.NewArticle ->
|
||||
case model.session.user of
|
||||
Just user ->
|
||||
( { model | pageState = Loaded (Editor Nothing Editor.initNew) }, Cmd.none )
|
||||
|
||||
Nothing ->
|
||||
errored Page.NewArticle "You must be signed in to post an article."
|
||||
|
||||
Just (Route.EditArticle slug) ->
|
||||
case model.session.user of
|
||||
Just user ->
|
||||
transition (EditArticleLoaded slug) (Editor.initEdit model.session slug)
|
||||
|
||||
Nothing ->
|
||||
errored Page.Other "You must be signed in to edit an article."
|
||||
|
||||
Just Route.Settings ->
|
||||
case model.session.user of
|
||||
Just user ->
|
||||
( { model | pageState = Loaded (Settings (Settings.init user)) }, Cmd.none )
|
||||
|
||||
Nothing ->
|
||||
errored Page.Settings "You must be signed in to access your settings."
|
||||
|
||||
Just Route.Home ->
|
||||
transition HomeLoaded (Home.init model.session)
|
||||
|
||||
Just Route.Root ->
|
||||
( model, Route.modifyUrl Route.Home )
|
||||
|
||||
Just Route.Login ->
|
||||
( { model | pageState = Loaded (Login Login.initialModel) }, Cmd.none )
|
||||
|
||||
Just Route.Logout ->
|
||||
let
|
||||
session =
|
||||
model.session
|
||||
in
|
||||
( { model | session = { session | user = Nothing } }
|
||||
, Cmd.batch
|
||||
[ Ports.storeSession Nothing
|
||||
, Route.modifyUrl Route.Home
|
||||
]
|
||||
)
|
||||
|
||||
Just Route.Register ->
|
||||
( { model | pageState = Loaded (Register Register.initialModel) }, Cmd.none )
|
||||
|
||||
Just (Route.Profile username) ->
|
||||
transition (ProfileLoaded username) (Profile.init model.session username)
|
||||
|
||||
Just (Route.Article slug) ->
|
||||
transition ArticleLoaded (Article.init model.session slug)
|
||||
|
||||
|
||||
pageErrored : Model -> ActivePage -> String -> ( Model, Cmd msg )
|
||||
pageErrored model activePage errorMessage =
|
||||
let
|
||||
error =
|
||||
Errored.pageLoadError activePage errorMessage
|
||||
in
|
||||
( { model | pageState = Loaded (Errored error) }, Cmd.none )
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
update msg model =
|
||||
updatePage (getPage model.pageState) msg model
|
||||
|
||||
|
||||
updatePage : Page -> Msg -> Model -> ( Model, Cmd Msg )
|
||||
updatePage page msg model =
|
||||
let
|
||||
session =
|
||||
model.session
|
||||
|
||||
toPage toModel toMsg subUpdate subMsg subModel =
|
||||
let
|
||||
( newModel, newCmd ) =
|
||||
subUpdate subMsg subModel
|
||||
in
|
||||
( { model | pageState = Loaded (toModel newModel) }, Cmd.map toMsg newCmd )
|
||||
|
||||
errored =
|
||||
pageErrored model
|
||||
in
|
||||
case ( msg, page ) of
|
||||
( SetRoute route, _ ) ->
|
||||
setRoute route model
|
||||
|
||||
( HomeLoaded (Ok subModel), _ ) ->
|
||||
( { model | pageState = Loaded (Home subModel) }, Cmd.none )
|
||||
|
||||
( HomeLoaded (Err error), _ ) ->
|
||||
( { model | pageState = Loaded (Errored error) }, Cmd.none )
|
||||
|
||||
( ProfileLoaded username (Ok subModel), _ ) ->
|
||||
( { model | pageState = Loaded (Profile username subModel) }, Cmd.none )
|
||||
|
||||
( ProfileLoaded username (Err error), _ ) ->
|
||||
( { model | pageState = Loaded (Errored error) }, Cmd.none )
|
||||
|
||||
( ArticleLoaded (Ok subModel), _ ) ->
|
||||
( { model | pageState = Loaded (Article subModel) }, Cmd.none )
|
||||
|
||||
( ArticleLoaded (Err error), _ ) ->
|
||||
( { model | pageState = Loaded (Errored error) }, Cmd.none )
|
||||
|
||||
( EditArticleLoaded slug (Ok subModel), _ ) ->
|
||||
( { model | pageState = Loaded (Editor (Just slug) subModel) }, Cmd.none )
|
||||
|
||||
( EditArticleLoaded slug (Err error), _ ) ->
|
||||
( { model | pageState = Loaded (Errored error) }, Cmd.none )
|
||||
|
||||
( SetUser user, _ ) ->
|
||||
let
|
||||
cmd =
|
||||
-- If we just signed out, then redirect to Home.
|
||||
if session.user /= Nothing && user == Nothing then
|
||||
Route.modifyUrl Route.Home
|
||||
else
|
||||
Cmd.none
|
||||
in
|
||||
( { model | session = { session | user = user } }
|
||||
, cmd
|
||||
)
|
||||
|
||||
( SettingsMsg subMsg, Settings subModel ) ->
|
||||
let
|
||||
( ( pageModel, cmd ), msgFromPage ) =
|
||||
Settings.update model.session subMsg subModel
|
||||
|
||||
newModel =
|
||||
case msgFromPage of
|
||||
Settings.NoOp ->
|
||||
model
|
||||
|
||||
Settings.SetUser user ->
|
||||
{ model | session = { user = Just user } }
|
||||
in
|
||||
( { newModel | pageState = Loaded (Settings pageModel) }
|
||||
, Cmd.map SettingsMsg cmd
|
||||
)
|
||||
|
||||
( LoginMsg subMsg, Login subModel ) ->
|
||||
let
|
||||
( ( pageModel, cmd ), msgFromPage ) =
|
||||
Login.update subMsg subModel
|
||||
|
||||
newModel =
|
||||
case msgFromPage of
|
||||
Login.NoOp ->
|
||||
model
|
||||
|
||||
Login.SetUser user ->
|
||||
{ model | session = { user = Just user } }
|
||||
in
|
||||
( { newModel | pageState = Loaded (Login pageModel) }
|
||||
, Cmd.map LoginMsg cmd
|
||||
)
|
||||
|
||||
( RegisterMsg subMsg, Register subModel ) ->
|
||||
let
|
||||
( ( pageModel, cmd ), msgFromPage ) =
|
||||
Register.update subMsg subModel
|
||||
|
||||
newModel =
|
||||
case msgFromPage of
|
||||
Register.NoOp ->
|
||||
model
|
||||
|
||||
Register.SetUser user ->
|
||||
{ model | session = { user = Just user } }
|
||||
in
|
||||
( { newModel | pageState = Loaded (Register pageModel) }
|
||||
, Cmd.map RegisterMsg cmd
|
||||
)
|
||||
|
||||
( HomeMsg subMsg, Home subModel ) ->
|
||||
toPage Home HomeMsg (Home.update session) subMsg subModel
|
||||
|
||||
( ProfileMsg subMsg, Profile username subModel ) ->
|
||||
toPage (Profile username) ProfileMsg (Profile.update model.session) subMsg subModel
|
||||
|
||||
( ArticleMsg subMsg, Article subModel ) ->
|
||||
toPage Article ArticleMsg (Article.update model.session) subMsg subModel
|
||||
|
||||
( EditorMsg subMsg, Editor slug subModel ) ->
|
||||
case model.session.user of
|
||||
Nothing ->
|
||||
if slug == Nothing then
|
||||
errored Page.NewArticle
|
||||
"You must be signed in to post articles."
|
||||
else
|
||||
errored Page.Other
|
||||
"You must be signed in to edit articles."
|
||||
|
||||
Just user ->
|
||||
toPage (Editor slug) EditorMsg (Editor.update user) subMsg subModel
|
||||
|
||||
( _, NotFound ) ->
|
||||
-- Disregard incoming messages when we're on the
|
||||
-- NotFound page.
|
||||
( model, Cmd.none )
|
||||
|
||||
( _, _ ) ->
|
||||
-- Disregard incoming messages that arrived for the wrong page
|
||||
( model, Cmd.none )
|
||||
|
||||
|
||||
|
||||
-- MAIN --
|
||||
|
||||
|
||||
main : Program Value Model Msg
|
||||
main =
|
||||
Navigation.programWithFlags (Route.fromLocation >> SetRoute)
|
||||
{ init = init
|
||||
, view = view
|
||||
, update = update
|
||||
, subscriptions = subscriptions
|
||||
}
|
||||
406
intro/part10/src/Page/Article.elm
Normal file
406
intro/part10/src/Page/Article.elm
Normal file
@@ -0,0 +1,406 @@
|
||||
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)
|
||||
244
intro/part10/src/Page/Article/Editor.elm
Normal file
244
intro/part10/src/Page/Article/Editor.elm
Normal file
@@ -0,0 +1,244 @@
|
||||
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, defaultValue, disabled, href, id, placeholder, type_)
|
||||
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
|
||||
, defaultValue model.title
|
||||
]
|
||||
[]
|
||||
, Form.input
|
||||
[ placeholder "What's this article about?"
|
||||
, onInput SetDescription
|
||||
, defaultValue model.description
|
||||
]
|
||||
[]
|
||||
, Form.textarea
|
||||
[ placeholder "Write your article (in markdown)"
|
||||
, attribute "rows" "8"
|
||||
, onInput SetBody
|
||||
, defaultValue model.body
|
||||
]
|
||||
[]
|
||||
, Form.input
|
||||
[ placeholder "Enter tags"
|
||||
, onInput SetTags
|
||||
, defaultValue (String.join " " model.tags)
|
||||
]
|
||||
[]
|
||||
, button [ class "btn btn-lg pull-xs-right btn-primary", disabled model.isSaving ]
|
||||
[ text saveButtonText ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- UPDATE --
|
||||
|
||||
|
||||
type Msg
|
||||
= Save
|
||||
| SetTitle String
|
||||
| SetDescription String
|
||||
| SetTags String
|
||||
| SetBody 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 )
|
||||
|
||||
SetTags tags ->
|
||||
( { model | tags = tagsFromString tags }, Cmd.none )
|
||||
|
||||
SetBody body ->
|
||||
( { model | body = body }, 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
|
||||
45
intro/part10/src/Page/Errored.elm
Normal file
45
intro/part10/src/Page/Errored.elm
Normal file
@@ -0,0 +1,45 @@
|
||||
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 ] ]
|
||||
]
|
||||
130
intro/part10/src/Page/Home.elm
Normal file
130
intro/part10/src/Page/Home.elm
Normal file
@@ -0,0 +1,130 @@
|
||||
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 )
|
||||
214
intro/part10/src/Page/Login.elm
Normal file
214
intro/part10/src/Page/Login.elm
Normal file
@@ -0,0 +1,214 @@
|
||||
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)) []
|
||||
18
intro/part10/src/Page/NotFound.elm
Normal file
18
intro/part10/src/Page/NotFound.elm
Normal file
@@ -0,0 +1,18 @@
|
||||
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" ] [] ]
|
||||
]
|
||||
168
intro/part10/src/Page/Profile.elm
Normal file
168
intro/part10/src/Page/Profile.elm
Normal file
@@ -0,0 +1,168 @@
|
||||
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 ]
|
||||
220
intro/part10/src/Page/Register.elm
Normal file
220
intro/part10/src/Page/Register.elm
Normal file
@@ -0,0 +1,220 @@
|
||||
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 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)) []
|
||||
266
intro/part10/src/Page/Settings.elm
Normal file
266
intro/part10/src/Page/Settings.elm
Normal file
@@ -0,0 +1,266 @@
|
||||
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)) []
|
||||
9
intro/part10/src/Ports.elm
Normal file
9
intro/part10/src/Ports.elm
Normal file
@@ -0,0 +1,9 @@
|
||||
port module Ports exposing (onSessionChange, storeSession)
|
||||
|
||||
import Json.Encode exposing (Value)
|
||||
|
||||
|
||||
port storeSession : Maybe String -> Cmd msg
|
||||
|
||||
|
||||
port onSessionChange : (Value -> msg) -> Sub msg
|
||||
271
intro/part10/src/Request/Article.elm
Normal file
271
intro/part10/src/Request/Article.elm
Normal file
@@ -0,0 +1,271 @@
|
||||
module Request.Article
|
||||
exposing
|
||||
( FeedConfig
|
||||
, ListConfig
|
||||
, create
|
||||
, defaultFeedConfig
|
||||
, defaultListConfig
|
||||
, delete
|
||||
, feed
|
||||
, get
|
||||
, list
|
||||
, tags
|
||||
, toggleFavorite
|
||||
, update
|
||||
)
|
||||
|
||||
import Data.Article as Article exposing (Article, Body, Tag, slugToString)
|
||||
import Data.Article.Feed as Feed exposing (Feed)
|
||||
import Data.AuthToken exposing (AuthToken, withAuthorization)
|
||||
import Data.User as User exposing (Username)
|
||||
import Http
|
||||
import HttpBuilder exposing (RequestBuilder, withBody, withExpect, withQueryParams)
|
||||
import Json.Decode as Decode
|
||||
import Json.Encode as Encode
|
||||
import Request.Helpers exposing (apiUrl)
|
||||
|
||||
|
||||
-- SINGLE --
|
||||
|
||||
|
||||
get : Maybe AuthToken -> Article.Slug -> Http.Request (Article Body)
|
||||
get maybeToken slug =
|
||||
let
|
||||
expect =
|
||||
Article.decoderWithBody
|
||||
|> Decode.field "article"
|
||||
|> Http.expectJson
|
||||
in
|
||||
apiUrl ("/articles/" ++ Article.slugToString slug)
|
||||
|> HttpBuilder.get
|
||||
|> HttpBuilder.withExpect expect
|
||||
|> withAuthorization maybeToken
|
||||
|> HttpBuilder.toRequest
|
||||
|
||||
|
||||
|
||||
-- LIST --
|
||||
|
||||
|
||||
type alias ListConfig =
|
||||
{ tag : Maybe Tag
|
||||
, author : Maybe Username
|
||||
, favorited : Maybe Username
|
||||
, limit : Int
|
||||
, offset : Int
|
||||
}
|
||||
|
||||
|
||||
defaultListConfig : ListConfig
|
||||
defaultListConfig =
|
||||
{ tag = Nothing
|
||||
, author = Nothing
|
||||
, favorited = Nothing
|
||||
, limit = 20
|
||||
, offset = 0
|
||||
}
|
||||
|
||||
|
||||
list : ListConfig -> Maybe AuthToken -> Http.Request Feed
|
||||
list config maybeToken =
|
||||
[ ( "tag", Maybe.map Article.tagToString config.tag )
|
||||
, ( "author", Maybe.map User.usernameToString config.author )
|
||||
, ( "favorited", Maybe.map User.usernameToString config.favorited )
|
||||
, ( "limit", Just (toString config.limit) )
|
||||
, ( "offset", Just (toString config.offset) )
|
||||
]
|
||||
|> List.filterMap maybeVal
|
||||
|> buildFromQueryParams "/articles"
|
||||
|> withAuthorization maybeToken
|
||||
|> HttpBuilder.toRequest
|
||||
|
||||
|
||||
|
||||
-- FEED --
|
||||
|
||||
|
||||
type alias FeedConfig =
|
||||
{ limit : Int
|
||||
, offset : Int
|
||||
}
|
||||
|
||||
|
||||
defaultFeedConfig : FeedConfig
|
||||
defaultFeedConfig =
|
||||
{ limit = 10
|
||||
, offset = 0
|
||||
}
|
||||
|
||||
|
||||
feed : FeedConfig -> AuthToken -> Http.Request Feed
|
||||
feed config token =
|
||||
[ ( "limit", Just (toString config.limit) )
|
||||
, ( "offset", Just (toString config.offset) )
|
||||
]
|
||||
|> List.filterMap maybeVal
|
||||
|> buildFromQueryParams "/articles/feed"
|
||||
|> withAuthorization (Just token)
|
||||
|> HttpBuilder.toRequest
|
||||
|
||||
|
||||
|
||||
-- TAGS --
|
||||
|
||||
|
||||
tags : Http.Request (List Tag)
|
||||
tags =
|
||||
Decode.field "tags" (Decode.list Article.tagDecoder)
|
||||
|> Http.get (apiUrl "/tags")
|
||||
|
||||
|
||||
|
||||
-- FAVORITE --
|
||||
|
||||
|
||||
toggleFavorite : Article a -> AuthToken -> Http.Request (Article ())
|
||||
toggleFavorite article authToken =
|
||||
if article.favorited then
|
||||
unfavorite article.slug authToken
|
||||
else
|
||||
favorite article.slug authToken
|
||||
|
||||
|
||||
favorite : Article.Slug -> AuthToken -> Http.Request (Article ())
|
||||
favorite =
|
||||
buildFavorite HttpBuilder.post
|
||||
|
||||
|
||||
unfavorite : Article.Slug -> AuthToken -> Http.Request (Article ())
|
||||
unfavorite =
|
||||
buildFavorite HttpBuilder.delete
|
||||
|
||||
|
||||
buildFavorite :
|
||||
(String -> RequestBuilder a)
|
||||
-> Article.Slug
|
||||
-> AuthToken
|
||||
-> Http.Request (Article ())
|
||||
buildFavorite builderFromUrl slug token =
|
||||
let
|
||||
expect =
|
||||
Article.decoder
|
||||
|> Decode.field "article"
|
||||
|> Http.expectJson
|
||||
in
|
||||
[ apiUrl "/articles", slugToString slug, "favorite" ]
|
||||
|> String.join "/"
|
||||
|> builderFromUrl
|
||||
|> withAuthorization (Just token)
|
||||
|> withExpect expect
|
||||
|> HttpBuilder.toRequest
|
||||
|
||||
|
||||
|
||||
-- CREATE --
|
||||
|
||||
|
||||
type alias CreateConfig record =
|
||||
{ record
|
||||
| title : String
|
||||
, description : String
|
||||
, body : String
|
||||
, tags : List String
|
||||
}
|
||||
|
||||
|
||||
type alias EditConfig record =
|
||||
{ record
|
||||
| title : String
|
||||
, description : String
|
||||
, body : String
|
||||
}
|
||||
|
||||
|
||||
create : CreateConfig record -> AuthToken -> Http.Request (Article Body)
|
||||
create config token =
|
||||
let
|
||||
expect =
|
||||
Article.decoderWithBody
|
||||
|> Decode.field "article"
|
||||
|> Http.expectJson
|
||||
|
||||
article =
|
||||
Encode.object
|
||||
[ ( "title", Encode.string config.title )
|
||||
, ( "description", Encode.string config.description )
|
||||
, ( "body", Encode.string config.body )
|
||||
, ( "tagList", Encode.list (List.map Encode.string config.tags) )
|
||||
]
|
||||
|
||||
body =
|
||||
Encode.object [ ( "article", article ) ]
|
||||
|> Http.jsonBody
|
||||
in
|
||||
apiUrl "/articles"
|
||||
|> HttpBuilder.post
|
||||
|> withAuthorization (Just token)
|
||||
|> withBody body
|
||||
|> withExpect expect
|
||||
|> HttpBuilder.toRequest
|
||||
|
||||
|
||||
update : Article.Slug -> EditConfig record -> AuthToken -> Http.Request (Article Body)
|
||||
update slug config token =
|
||||
let
|
||||
expect =
|
||||
Article.decoderWithBody
|
||||
|> Decode.field "article"
|
||||
|> Http.expectJson
|
||||
|
||||
article =
|
||||
Encode.object
|
||||
[ ( "title", Encode.string config.title )
|
||||
, ( "description", Encode.string config.description )
|
||||
, ( "body", Encode.string config.body )
|
||||
]
|
||||
|
||||
body =
|
||||
Encode.object [ ( "article", article ) ]
|
||||
|> Http.jsonBody
|
||||
in
|
||||
apiUrl ("/articles/" ++ slugToString slug)
|
||||
|> HttpBuilder.put
|
||||
|> withAuthorization (Just token)
|
||||
|> withBody body
|
||||
|> withExpect expect
|
||||
|> HttpBuilder.toRequest
|
||||
|
||||
|
||||
|
||||
-- DELETE --
|
||||
|
||||
|
||||
delete : Article.Slug -> AuthToken -> Http.Request ()
|
||||
delete slug token =
|
||||
apiUrl ("/articles/" ++ Article.slugToString slug)
|
||||
|> HttpBuilder.delete
|
||||
|> withAuthorization (Just token)
|
||||
|> HttpBuilder.toRequest
|
||||
|
||||
|
||||
|
||||
-- HELPERS --
|
||||
|
||||
|
||||
maybeVal : ( a, Maybe b ) -> Maybe ( a, b )
|
||||
maybeVal ( key, value ) =
|
||||
case value of
|
||||
Nothing ->
|
||||
Nothing
|
||||
|
||||
Just val ->
|
||||
Just ( key, val )
|
||||
|
||||
|
||||
buildFromQueryParams : String -> List ( String, String ) -> RequestBuilder Feed
|
||||
buildFromQueryParams url queryParams =
|
||||
url
|
||||
|> apiUrl
|
||||
|> HttpBuilder.get
|
||||
|> withExpect (Http.expectJson Feed.decoder)
|
||||
|> withQueryParams queryParams
|
||||
53
intro/part10/src/Request/Article/Comments.elm
Normal file
53
intro/part10/src/Request/Article/Comments.elm
Normal file
@@ -0,0 +1,53 @@
|
||||
module Request.Article.Comments exposing (delete, list, post)
|
||||
|
||||
import Data.Article as Article exposing (Article, Tag, slugToString)
|
||||
import Data.Article.Comment as Comment exposing (Comment, CommentId)
|
||||
import Data.AuthToken exposing (AuthToken, withAuthorization)
|
||||
import Http
|
||||
import HttpBuilder exposing (RequestBuilder, withExpect, withQueryParams)
|
||||
import Json.Decode as Decode
|
||||
import Json.Encode as Encode exposing (Value)
|
||||
import Request.Helpers exposing (apiUrl)
|
||||
|
||||
|
||||
-- LIST --
|
||||
|
||||
|
||||
list : Maybe AuthToken -> Article.Slug -> Http.Request (List Comment)
|
||||
list maybeToken slug =
|
||||
apiUrl ("/articles/" ++ Article.slugToString slug ++ "/comments")
|
||||
|> HttpBuilder.get
|
||||
|> HttpBuilder.withExpect (Http.expectJson (Decode.field "comments" (Decode.list Comment.decoder)))
|
||||
|> withAuthorization maybeToken
|
||||
|> HttpBuilder.toRequest
|
||||
|
||||
|
||||
|
||||
-- POST --
|
||||
|
||||
|
||||
post : Article.Slug -> String -> AuthToken -> Http.Request Comment
|
||||
post slug body token =
|
||||
apiUrl ("/articles/" ++ Article.slugToString slug ++ "/comments")
|
||||
|> HttpBuilder.post
|
||||
|> HttpBuilder.withBody (Http.jsonBody (encodeCommentBody body))
|
||||
|> HttpBuilder.withExpect (Http.expectJson (Decode.field "comment" Comment.decoder))
|
||||
|> withAuthorization (Just token)
|
||||
|> HttpBuilder.toRequest
|
||||
|
||||
|
||||
encodeCommentBody : String -> Value
|
||||
encodeCommentBody body =
|
||||
Encode.object [ ( "comment", Encode.object [ ( "body", Encode.string body ) ] ) ]
|
||||
|
||||
|
||||
|
||||
-- DELETE --
|
||||
|
||||
|
||||
delete : Article.Slug -> CommentId -> AuthToken -> Http.Request ()
|
||||
delete slug commentId token =
|
||||
apiUrl ("/articles/" ++ Article.slugToString slug ++ "/comments/" ++ Comment.idToString commentId)
|
||||
|> HttpBuilder.delete
|
||||
|> withAuthorization (Just token)
|
||||
|> HttpBuilder.toRequest
|
||||
6
intro/part10/src/Request/Helpers.elm
Normal file
6
intro/part10/src/Request/Helpers.elm
Normal file
@@ -0,0 +1,6 @@
|
||||
module Request.Helpers exposing (apiUrl)
|
||||
|
||||
|
||||
apiUrl : String -> String
|
||||
apiUrl str =
|
||||
"/api" ++ str
|
||||
57
intro/part10/src/Request/Profile.elm
Normal file
57
intro/part10/src/Request/Profile.elm
Normal file
@@ -0,0 +1,57 @@
|
||||
module Request.Profile exposing (get, toggleFollow)
|
||||
|
||||
import Data.AuthToken exposing (AuthToken, withAuthorization)
|
||||
import Data.Profile as Profile exposing (Profile)
|
||||
import Data.User as User exposing (Username)
|
||||
import Http
|
||||
import HttpBuilder exposing (RequestBuilder, withExpect, withQueryParams)
|
||||
import Json.Decode as Decode
|
||||
import Request.Helpers exposing (apiUrl)
|
||||
|
||||
|
||||
-- GET --
|
||||
|
||||
|
||||
get : Username -> Maybe AuthToken -> Http.Request Profile
|
||||
get username maybeToken =
|
||||
apiUrl ("/profiles/" ++ User.usernameToString username)
|
||||
|> HttpBuilder.get
|
||||
|> HttpBuilder.withExpect (Http.expectJson (Decode.field "profile" Profile.decoder))
|
||||
|> withAuthorization maybeToken
|
||||
|> HttpBuilder.toRequest
|
||||
|
||||
|
||||
|
||||
-- FOLLOWING --
|
||||
|
||||
|
||||
toggleFollow : Username -> Bool -> AuthToken -> Http.Request Profile
|
||||
toggleFollow username following authToken =
|
||||
if following then
|
||||
unfollow username authToken
|
||||
else
|
||||
follow username authToken
|
||||
|
||||
|
||||
follow : Username -> AuthToken -> Http.Request Profile
|
||||
follow =
|
||||
buildFollow HttpBuilder.post
|
||||
|
||||
|
||||
unfollow : Username -> AuthToken -> Http.Request Profile
|
||||
unfollow =
|
||||
buildFollow HttpBuilder.delete
|
||||
|
||||
|
||||
buildFollow :
|
||||
(String -> RequestBuilder a)
|
||||
-> Username
|
||||
-> AuthToken
|
||||
-> Http.Request Profile
|
||||
buildFollow builderFromUrl username token =
|
||||
[ apiUrl "/profiles", User.usernameToString username, "follow" ]
|
||||
|> String.join "/"
|
||||
|> builderFromUrl
|
||||
|> withAuthorization (Just token)
|
||||
|> withExpect (Http.expectJson (Decode.field "profile" Profile.decoder))
|
||||
|> HttpBuilder.toRequest
|
||||
94
intro/part10/src/Request/User.elm
Normal file
94
intro/part10/src/Request/User.elm
Normal file
@@ -0,0 +1,94 @@
|
||||
module Request.User exposing (edit, login, register, storeSession)
|
||||
|
||||
import Data.AuthToken exposing (AuthToken, withAuthorization)
|
||||
import Data.User as User exposing (User)
|
||||
import Http
|
||||
import HttpBuilder exposing (RequestBuilder, withExpect, withQueryParams)
|
||||
import Json.Decode as Decode
|
||||
import Json.Encode as Encode
|
||||
import Json.Encode.Extra as EncodeExtra
|
||||
import Ports
|
||||
import Request.Helpers exposing (apiUrl)
|
||||
|
||||
|
||||
storeSession : User -> Cmd msg
|
||||
storeSession user =
|
||||
User.encode user
|
||||
|> Encode.encode 0
|
||||
|> Just
|
||||
|> Ports.storeSession
|
||||
|
||||
|
||||
login : { r | email : String, password : String } -> Http.Request User
|
||||
login { email, password } =
|
||||
let
|
||||
user =
|
||||
Encode.object
|
||||
[ ( "email", Encode.string email )
|
||||
, ( "password", Encode.string password )
|
||||
]
|
||||
|
||||
body =
|
||||
Encode.object [ ( "user", user ) ]
|
||||
|> Http.jsonBody
|
||||
in
|
||||
Decode.field "user" User.decoder
|
||||
|> Http.post (apiUrl "/users/login") body
|
||||
|
||||
|
||||
register : { r | username : String, email : String, password : String } -> Http.Request User
|
||||
register { username, email, password } =
|
||||
let
|
||||
user =
|
||||
Encode.object
|
||||
[ ( "username", Encode.string username )
|
||||
, ( "email", Encode.string email )
|
||||
, ( "password", Encode.string password )
|
||||
]
|
||||
|
||||
body =
|
||||
Encode.object [ ( "user", user ) ]
|
||||
|> Http.jsonBody
|
||||
in
|
||||
Decode.field "user" User.decoder
|
||||
|> Http.post (apiUrl "/users") body
|
||||
|
||||
|
||||
edit :
|
||||
{ r
|
||||
| username : String
|
||||
, email : String
|
||||
, bio : String
|
||||
, password : Maybe String
|
||||
, image : Maybe String
|
||||
}
|
||||
-> Maybe AuthToken
|
||||
-> Http.Request User
|
||||
edit { username, email, bio, password, image } maybeToken =
|
||||
let
|
||||
updates =
|
||||
[ Just ( "username", Encode.string username )
|
||||
, Just ( "email", Encode.string email )
|
||||
, Just ( "bio", Encode.string bio )
|
||||
, Just ( "image", EncodeExtra.maybe Encode.string image )
|
||||
, Maybe.map (\pass -> ( "password", Encode.string pass )) password
|
||||
]
|
||||
|> List.filterMap identity
|
||||
|
||||
body =
|
||||
( "user", Encode.object updates )
|
||||
|> List.singleton
|
||||
|> Encode.object
|
||||
|> Http.jsonBody
|
||||
|
||||
expect =
|
||||
User.decoder
|
||||
|> Decode.field "user"
|
||||
|> Http.expectJson
|
||||
in
|
||||
apiUrl "/user"
|
||||
|> HttpBuilder.put
|
||||
|> HttpBuilder.withExpect expect
|
||||
|> HttpBuilder.withBody body
|
||||
|> withAuthorization maybeToken
|
||||
|> HttpBuilder.toRequest
|
||||
103
intro/part10/src/Route.elm
Normal file
103
intro/part10/src/Route.elm
Normal file
@@ -0,0 +1,103 @@
|
||||
module Route exposing (Route(..), fromLocation, href, modifyUrl)
|
||||
|
||||
import Data.Article as Article
|
||||
import Data.User as User exposing (Username)
|
||||
import Html exposing (Attribute)
|
||||
import Html.Attributes as Attr
|
||||
import Navigation exposing (Location)
|
||||
import UrlParser as Url exposing ((</>), Parser, oneOf, parseHash, s, string)
|
||||
|
||||
|
||||
-- ROUTING --
|
||||
|
||||
|
||||
type Route
|
||||
= Home
|
||||
| Root
|
||||
| Login
|
||||
| Logout
|
||||
| Register
|
||||
| Settings
|
||||
| Article Article.Slug
|
||||
| Profile Username
|
||||
| NewArticle
|
||||
| EditArticle Article.Slug
|
||||
|
||||
|
||||
route : Parser (Route -> a) a
|
||||
route =
|
||||
oneOf
|
||||
[ Url.map Home (s "")
|
||||
, Url.map Login (s "login")
|
||||
, Url.map Logout (s "logout")
|
||||
, Url.map Settings (s "settings")
|
||||
, Url.map Profile (s "profile" </> User.usernameParser)
|
||||
, Url.map Register (s "register")
|
||||
, Url.map Article (s "article" </> Article.slugParser)
|
||||
, Url.map NewArticle (s "editor")
|
||||
, Url.map EditArticle (s "editor" </> Article.slugParser)
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- INTERNAL --
|
||||
|
||||
|
||||
routeToString : Route -> String
|
||||
routeToString page =
|
||||
let
|
||||
pieces =
|
||||
case page of
|
||||
Home ->
|
||||
[]
|
||||
|
||||
Root ->
|
||||
[]
|
||||
|
||||
Login ->
|
||||
[ "login" ]
|
||||
|
||||
Logout ->
|
||||
[ "logout" ]
|
||||
|
||||
Register ->
|
||||
[ "register" ]
|
||||
|
||||
Settings ->
|
||||
[ "settings" ]
|
||||
|
||||
Article slug ->
|
||||
[ "article", Article.slugToString slug ]
|
||||
|
||||
Profile username ->
|
||||
[ "profile", User.usernameToString username ]
|
||||
|
||||
NewArticle ->
|
||||
[ "editor" ]
|
||||
|
||||
EditArticle slug ->
|
||||
[ "editor", Article.slugToString slug ]
|
||||
in
|
||||
"#/" ++ String.join "/" pieces
|
||||
|
||||
|
||||
|
||||
-- PUBLIC HELPERS --
|
||||
|
||||
|
||||
href : Route -> Attribute msg
|
||||
href route =
|
||||
Attr.href (routeToString route)
|
||||
|
||||
|
||||
modifyUrl : Route -> Cmd msg
|
||||
modifyUrl =
|
||||
routeToString >> Navigation.modifyUrl
|
||||
|
||||
|
||||
fromLocation : Location -> Maybe Route
|
||||
fromLocation location =
|
||||
if String.isEmpty location.hash then
|
||||
Just Root
|
||||
else
|
||||
parseHash route location
|
||||
39
intro/part10/src/Util.elm
Normal file
39
intro/part10/src/Util.elm
Normal file
@@ -0,0 +1,39 @@
|
||||
module Util exposing (appendErrors, onClickStopPropagation, pair, viewIf)
|
||||
|
||||
import Html exposing (Attribute, Html)
|
||||
import Html.Events exposing (defaultOptions, onWithOptions)
|
||||
import Json.Decode as Decode
|
||||
|
||||
|
||||
{-| Useful when building up a Cmd via a pipeline, and then pairing it with
|
||||
a model at the end.
|
||||
|
||||
session.user
|
||||
|> User.Request.foo
|
||||
|> Task.attempt Foo
|
||||
|> pair { model | something = blah }
|
||||
|
||||
-}
|
||||
pair : a -> b -> ( a, b )
|
||||
pair first second =
|
||||
( first, second )
|
||||
|
||||
|
||||
viewIf : Bool -> Html msg -> Html msg
|
||||
viewIf condition content =
|
||||
if condition then
|
||||
content
|
||||
else
|
||||
Html.text ""
|
||||
|
||||
|
||||
onClickStopPropagation : msg -> Attribute msg
|
||||
onClickStopPropagation msg =
|
||||
onWithOptions "click"
|
||||
{ defaultOptions | stopPropagation = True }
|
||||
(Decode.succeed msg)
|
||||
|
||||
|
||||
appendErrors : { model | errors : List error } -> List error -> { model | errors : List error }
|
||||
appendErrors model errors =
|
||||
{ model | errors = model.errors ++ errors }
|
||||
60
intro/part10/src/Views/Article.elm
Normal file
60
intro/part10/src/Views/Article.elm
Normal file
@@ -0,0 +1,60 @@
|
||||
module Views.Article exposing (view, viewTimestamp)
|
||||
|
||||
{-| Viewing a preview of an individual article, excluding its body.
|
||||
-}
|
||||
|
||||
import Data.Article exposing (Article)
|
||||
import Data.UserPhoto as UserPhoto exposing (UserPhoto)
|
||||
import Date.Format
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (attribute, class, classList, href, id, placeholder, src)
|
||||
import Route exposing (Route)
|
||||
import Views.Article.Favorite as Favorite
|
||||
import Views.Author
|
||||
|
||||
|
||||
-- VIEWS --
|
||||
|
||||
|
||||
{-| Some pages want to view just the timestamp, not the whole article.
|
||||
-}
|
||||
viewTimestamp : Article a -> Html msg
|
||||
viewTimestamp article =
|
||||
span [ class "date" ] [ text (formattedTimestamp article) ]
|
||||
|
||||
|
||||
view : (Article a -> msg) -> Article a -> Html msg
|
||||
view toggleFavorite article =
|
||||
let
|
||||
author =
|
||||
article.author
|
||||
in
|
||||
div [ class "article-preview" ]
|
||||
[ div [ class "article-meta" ]
|
||||
[ a [ Route.href (Route.Profile author.username) ]
|
||||
[ img [ UserPhoto.src author.image ] [] ]
|
||||
, div [ class "info" ]
|
||||
[ Views.Author.view author.username
|
||||
, span [ class "date" ] [ text (formattedTimestamp article) ]
|
||||
]
|
||||
, Favorite.button
|
||||
toggleFavorite
|
||||
article
|
||||
[ class "pull-xs-right" ]
|
||||
[ text (" " ++ toString article.favoritesCount) ]
|
||||
]
|
||||
, a [ class "preview-link", Route.href (Route.Article article.slug) ]
|
||||
[ h1 [] [ text article.title ]
|
||||
, p [] [ text article.description ]
|
||||
, span [] [ text "Read more..." ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- INTERNAL --
|
||||
|
||||
|
||||
formattedTimestamp : Article a -> String
|
||||
formattedTimestamp article =
|
||||
Date.Format.format "%B %e, %Y" article.createdAt
|
||||
42
intro/part10/src/Views/Article/Favorite.elm
Normal file
42
intro/part10/src/Views/Article/Favorite.elm
Normal file
@@ -0,0 +1,42 @@
|
||||
module Views.Article.Favorite exposing (button)
|
||||
|
||||
{-| The Favorite button.
|
||||
-}
|
||||
|
||||
import Data.Article exposing (Article)
|
||||
import Html exposing (Attribute, Html, i, text)
|
||||
import Html.Attributes exposing (class)
|
||||
import Util exposing (onClickStopPropagation)
|
||||
|
||||
|
||||
{-| This is a "build your own element" API.
|
||||
|
||||
You pass it some configuration, followed by a `List (Attribute msg)` and a
|
||||
`List (Html msg)`, just like any standard Html element.
|
||||
|
||||
-}
|
||||
button :
|
||||
(Article a -> msg)
|
||||
-> Article a
|
||||
-> List (Attribute msg)
|
||||
-> List (Html msg)
|
||||
-> Html msg
|
||||
button toggleFavorite article extraAttributes extraChildren =
|
||||
let
|
||||
favoriteButtonClass =
|
||||
if article.favorited then
|
||||
"btn-primary"
|
||||
else
|
||||
"btn-outline-primary"
|
||||
|
||||
attributes =
|
||||
[ class ("btn btn-sm " ++ favoriteButtonClass)
|
||||
, onClickStopPropagation (toggleFavorite article)
|
||||
]
|
||||
++ extraAttributes
|
||||
|
||||
children =
|
||||
[ i [ class "ion-heart" ] [] ]
|
||||
++ extraChildren
|
||||
in
|
||||
Html.button attributes children
|
||||
419
intro/part10/src/Views/Article/Feed.elm
Normal file
419
intro/part10/src/Views/Article/Feed.elm
Normal file
@@ -0,0 +1,419 @@
|
||||
module Views.Article.Feed exposing (FeedSource, Model, Msg, authorFeed, favoritedFeed, globalFeed, init, selectTag, tagFeed, update, viewArticles, viewFeedSources, yourFeed)
|
||||
|
||||
{-| NOTE: This module has its own Model, view, and update. This is not normal!
|
||||
If you find yourself doing this often, please watch <https://www.youtube.com/watch?v=DoA4Txr4GUs>
|
||||
|
||||
This is the reusable Article Feed that appears on both the Home page as well as
|
||||
on the Profile page. There's a lot of logic here, so it's more convenient to use
|
||||
the heavyweight approach of giving this its own Model, view, and update.
|
||||
|
||||
This means callers must use Html.map and Cmd.map to use this thing, but in
|
||||
this case that's totally worth it because of the amount of logic wrapped up
|
||||
in this thing.
|
||||
|
||||
For every other reusable view in this application, this API would be totally
|
||||
overkill, so we use simpler APIs instead.
|
||||
|
||||
-}
|
||||
|
||||
import Data.Article as Article exposing (Article, Tag)
|
||||
import Data.Article.Feed exposing (Feed)
|
||||
import Data.AuthToken exposing (AuthToken)
|
||||
import Data.Session exposing (Session)
|
||||
import Data.User exposing (Username)
|
||||
import Dom.Scroll
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (attribute, class, classList, href, id, placeholder, src)
|
||||
import Html.Events exposing (onClick)
|
||||
import Http
|
||||
import Request.Article
|
||||
import SelectList exposing (Position(..), SelectList)
|
||||
import Task exposing (Task)
|
||||
import Util exposing (onClickStopPropagation, pair, viewIf)
|
||||
import Views.Article
|
||||
import Views.Errors as Errors
|
||||
import Views.Page exposing (bodyId)
|
||||
import Views.Spinner exposing (spinner)
|
||||
|
||||
|
||||
-- MODEL --
|
||||
|
||||
|
||||
type Model
|
||||
= Model InternalModel
|
||||
|
||||
|
||||
{-| This should not be exposed! We want to benefit from the guarantee that only
|
||||
this module can create or alter this model. This way if it ever ends up in
|
||||
a surprising state, we know exactly where to look: this file.
|
||||
-}
|
||||
type alias InternalModel =
|
||||
{ errors : List String
|
||||
, feed : Feed
|
||||
, feedSources : SelectList FeedSource
|
||||
, activePage : Int
|
||||
, isLoading : Bool
|
||||
}
|
||||
|
||||
|
||||
init : Session -> SelectList FeedSource -> Task Http.Error Model
|
||||
init session feedSources =
|
||||
let
|
||||
source =
|
||||
SelectList.selected feedSources
|
||||
|
||||
toModel ( activePage, feed ) =
|
||||
Model
|
||||
{ errors = []
|
||||
, activePage = activePage
|
||||
, feed = feed
|
||||
, feedSources = feedSources
|
||||
, isLoading = False
|
||||
}
|
||||
in
|
||||
source
|
||||
|> fetch (Maybe.map .token session.user) 1
|
||||
|> Task.map toModel
|
||||
|
||||
|
||||
|
||||
-- VIEW --
|
||||
|
||||
|
||||
viewArticles : Model -> List (Html Msg)
|
||||
viewArticles (Model { activePage, feed, feedSources }) =
|
||||
List.map (Views.Article.view ToggleFavorite) feed.articles
|
||||
++ [ pagination activePage feed (SelectList.selected feedSources) ]
|
||||
|
||||
|
||||
viewFeedSources : Model -> Html Msg
|
||||
viewFeedSources (Model { feedSources, isLoading, errors }) =
|
||||
ul [ class "nav nav-pills outline-active" ] <|
|
||||
SelectList.toList (SelectList.mapBy viewFeedSource feedSources)
|
||||
++ [ Errors.view DismissErrors errors, viewIf isLoading spinner ]
|
||||
|
||||
|
||||
viewFeedSource : Position -> FeedSource -> Html Msg
|
||||
viewFeedSource position source =
|
||||
li [ class "nav-item" ]
|
||||
[ a
|
||||
[ classList [ ( "nav-link", True ), ( "active", position == Selected ) ]
|
||||
, href "javascript:void(0);"
|
||||
, onClick (SelectFeedSource source)
|
||||
]
|
||||
[ text (sourceName source) ]
|
||||
]
|
||||
|
||||
|
||||
selectTag : Maybe AuthToken -> Tag -> Cmd Msg
|
||||
selectTag maybeAuthToken tagName =
|
||||
let
|
||||
source =
|
||||
tagFeed tagName
|
||||
in
|
||||
source
|
||||
|> fetch maybeAuthToken 1
|
||||
|> Task.attempt (FeedLoadCompleted source)
|
||||
|
||||
|
||||
sourceName : FeedSource -> String
|
||||
sourceName source =
|
||||
case source of
|
||||
YourFeed ->
|
||||
"Your Feed"
|
||||
|
||||
GlobalFeed ->
|
||||
"Global Feed"
|
||||
|
||||
TagFeed tagName ->
|
||||
"#" ++ Article.tagToString tagName
|
||||
|
||||
FavoritedFeed username ->
|
||||
"Favorited Articles"
|
||||
|
||||
AuthorFeed username ->
|
||||
"My Articles"
|
||||
|
||||
|
||||
limit : FeedSource -> Int
|
||||
limit feedSource =
|
||||
case feedSource of
|
||||
YourFeed ->
|
||||
10
|
||||
|
||||
GlobalFeed ->
|
||||
10
|
||||
|
||||
TagFeed tagName ->
|
||||
10
|
||||
|
||||
FavoritedFeed username ->
|
||||
5
|
||||
|
||||
AuthorFeed username ->
|
||||
5
|
||||
|
||||
|
||||
pagination : Int -> Feed -> FeedSource -> Html Msg
|
||||
pagination activePage feed feedSource =
|
||||
let
|
||||
articlesPerPage =
|
||||
limit feedSource
|
||||
|
||||
totalPages =
|
||||
ceiling (toFloat feed.articlesCount / toFloat articlesPerPage)
|
||||
in
|
||||
if totalPages > 1 then
|
||||
List.range 1 totalPages
|
||||
|> List.map (\page -> pageLink page (page == activePage))
|
||||
|> ul [ class "pagination" ]
|
||||
else
|
||||
Html.text ""
|
||||
|
||||
|
||||
pageLink : Int -> Bool -> Html Msg
|
||||
pageLink page isActive =
|
||||
li [ classList [ ( "page-item", True ), ( "active", isActive ) ] ]
|
||||
[ a
|
||||
[ class "page-link"
|
||||
, href "javascript:void(0);"
|
||||
, onClick (SelectPage page)
|
||||
]
|
||||
[ text (toString page) ]
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- UPDATE --
|
||||
|
||||
|
||||
type Msg
|
||||
= DismissErrors
|
||||
| SelectFeedSource FeedSource
|
||||
| FeedLoadCompleted FeedSource (Result Http.Error ( Int, Feed ))
|
||||
| ToggleFavorite (Article ())
|
||||
| FavoriteCompleted (Result Http.Error (Article ()))
|
||||
| SelectPage Int
|
||||
|
||||
|
||||
update : Session -> Msg -> Model -> ( Model, Cmd Msg )
|
||||
update session msg (Model internalModel) =
|
||||
updateInternal session msg internalModel
|
||||
|> Tuple.mapFirst Model
|
||||
|
||||
|
||||
updateInternal : Session -> Msg -> InternalModel -> ( InternalModel, Cmd Msg )
|
||||
updateInternal session msg model =
|
||||
case msg of
|
||||
DismissErrors ->
|
||||
( { model | errors = [] }, Cmd.none )
|
||||
|
||||
SelectFeedSource source ->
|
||||
source
|
||||
|> fetch (Maybe.map .token session.user) 1
|
||||
|> Task.attempt (FeedLoadCompleted source)
|
||||
|> pair { model | isLoading = True }
|
||||
|
||||
FeedLoadCompleted source (Ok ( activePage, feed )) ->
|
||||
( { model
|
||||
| feed = feed
|
||||
, feedSources = selectFeedSource source model.feedSources
|
||||
, activePage = activePage
|
||||
, isLoading = False
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
FeedLoadCompleted _ (Err error) ->
|
||||
( { model
|
||||
| errors = model.errors ++ [ "Server error while trying to load feed" ]
|
||||
, isLoading = False
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
ToggleFavorite article ->
|
||||
case session.user of
|
||||
Nothing ->
|
||||
( { model | errors = model.errors ++ [ "You are currently signed out. You must sign in to favorite articles." ] }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
Just user ->
|
||||
Request.Article.toggleFavorite article user.token
|
||||
|> Http.send FavoriteCompleted
|
||||
|> pair model
|
||||
|
||||
FavoriteCompleted (Ok article) ->
|
||||
let
|
||||
feed =
|
||||
model.feed
|
||||
|
||||
newFeed =
|
||||
{ feed | articles = List.map (replaceArticle article) feed.articles }
|
||||
in
|
||||
( { model | feed = newFeed }, Cmd.none )
|
||||
|
||||
FavoriteCompleted (Err error) ->
|
||||
( { model | errors = model.errors ++ [ "Server error while trying to favorite article." ] }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
SelectPage page ->
|
||||
let
|
||||
source =
|
||||
SelectList.selected model.feedSources
|
||||
in
|
||||
source
|
||||
|> fetch (Maybe.map .token session.user) page
|
||||
|> Task.andThen (\feed -> Task.map (\_ -> feed) scrollToTop)
|
||||
|> Task.attempt (FeedLoadCompleted source)
|
||||
|> pair model
|
||||
|
||||
|
||||
scrollToTop : Task x ()
|
||||
scrollToTop =
|
||||
Dom.Scroll.toTop bodyId
|
||||
-- It's not worth showing the user anything special if scrolling fails.
|
||||
-- If anything, we'd log this to an error recording service.
|
||||
|> Task.onError (\_ -> Task.succeed ())
|
||||
|
||||
|
||||
fetch : Maybe AuthToken -> Int -> FeedSource -> Task Http.Error ( Int, Feed )
|
||||
fetch token page feedSource =
|
||||
let
|
||||
defaultListConfig =
|
||||
Request.Article.defaultListConfig
|
||||
|
||||
articlesPerPage =
|
||||
limit feedSource
|
||||
|
||||
offset =
|
||||
(page - 1) * articlesPerPage
|
||||
|
||||
listConfig =
|
||||
{ defaultListConfig | offset = offset, limit = articlesPerPage }
|
||||
|
||||
task =
|
||||
case feedSource of
|
||||
YourFeed ->
|
||||
let
|
||||
defaultFeedConfig =
|
||||
Request.Article.defaultFeedConfig
|
||||
|
||||
feedConfig =
|
||||
{ defaultFeedConfig | offset = offset, limit = articlesPerPage }
|
||||
in
|
||||
token
|
||||
|> Maybe.map (Request.Article.feed feedConfig >> Http.toTask)
|
||||
|> Maybe.withDefault (Task.fail (Http.BadUrl "You need to be signed in to view your feed."))
|
||||
|
||||
GlobalFeed ->
|
||||
Request.Article.list listConfig token
|
||||
|> Http.toTask
|
||||
|
||||
TagFeed tagName ->
|
||||
Request.Article.list { listConfig | tag = Just tagName } token
|
||||
|> Http.toTask
|
||||
|
||||
FavoritedFeed username ->
|
||||
Request.Article.list { listConfig | favorited = Just username } token
|
||||
|> Http.toTask
|
||||
|
||||
AuthorFeed username ->
|
||||
Request.Article.list { listConfig | author = Just username } token
|
||||
|> Http.toTask
|
||||
in
|
||||
task
|
||||
|> Task.map (\feed -> ( page, feed ))
|
||||
|
||||
|
||||
replaceArticle : Article a -> Article a -> Article a
|
||||
replaceArticle newArticle oldArticle =
|
||||
if newArticle.slug == oldArticle.slug then
|
||||
newArticle
|
||||
else
|
||||
oldArticle
|
||||
|
||||
|
||||
selectFeedSource : FeedSource -> SelectList FeedSource -> SelectList FeedSource
|
||||
selectFeedSource source sources =
|
||||
let
|
||||
withoutTags =
|
||||
sources
|
||||
|> SelectList.toList
|
||||
|> List.filter (not << isTagFeed)
|
||||
|
||||
newSources =
|
||||
case source of
|
||||
YourFeed ->
|
||||
withoutTags
|
||||
|
||||
GlobalFeed ->
|
||||
withoutTags
|
||||
|
||||
FavoritedFeed _ ->
|
||||
withoutTags
|
||||
|
||||
AuthorFeed _ ->
|
||||
withoutTags
|
||||
|
||||
TagFeed _ ->
|
||||
withoutTags ++ [ source ]
|
||||
in
|
||||
case newSources of
|
||||
[] ->
|
||||
-- This should never happen. If we had a logging service set up,
|
||||
-- we would definitely want to report if it somehow did happen!
|
||||
sources
|
||||
|
||||
first :: rest ->
|
||||
SelectList.fromLists [] first rest
|
||||
|> SelectList.select ((==) source)
|
||||
|
||||
|
||||
isTagFeed : FeedSource -> Bool
|
||||
isTagFeed source =
|
||||
case source of
|
||||
TagFeed _ ->
|
||||
True
|
||||
|
||||
_ ->
|
||||
False
|
||||
|
||||
|
||||
|
||||
-- FEEDSOURCE --
|
||||
|
||||
|
||||
type FeedSource
|
||||
= YourFeed
|
||||
| GlobalFeed
|
||||
| TagFeed Tag
|
||||
| FavoritedFeed Username
|
||||
| AuthorFeed Username
|
||||
|
||||
|
||||
yourFeed : FeedSource
|
||||
yourFeed =
|
||||
YourFeed
|
||||
|
||||
|
||||
globalFeed : FeedSource
|
||||
globalFeed =
|
||||
GlobalFeed
|
||||
|
||||
|
||||
tagFeed : Tag -> FeedSource
|
||||
tagFeed =
|
||||
TagFeed
|
||||
|
||||
|
||||
favoritedFeed : Username -> FeedSource
|
||||
favoritedFeed =
|
||||
FavoritedFeed
|
||||
|
||||
|
||||
authorFeed : Username -> FeedSource
|
||||
authorFeed =
|
||||
AuthorFeed
|
||||
33
intro/part10/src/Views/Assets.elm
Normal file
33
intro/part10/src/Views/Assets.elm
Normal file
@@ -0,0 +1,33 @@
|
||||
module Views.Assets exposing (error, src)
|
||||
|
||||
{-| Assets, such as images, videos, and audio. (We only have images for now.)
|
||||
|
||||
We should never expose asset URLs directly; this module should be in charge of
|
||||
all of them. One source of truth!
|
||||
|
||||
-}
|
||||
|
||||
import Html exposing (Attribute, Html)
|
||||
import Html.Attributes as Attr
|
||||
|
||||
|
||||
type Image
|
||||
= Image String
|
||||
|
||||
|
||||
|
||||
-- IMAGES --
|
||||
|
||||
|
||||
error : Image
|
||||
error =
|
||||
Image "/assets/images/error.jpg"
|
||||
|
||||
|
||||
|
||||
-- USING IMAGES --
|
||||
|
||||
|
||||
src : Image -> Attribute msg
|
||||
src (Image url) =
|
||||
Attr.src url
|
||||
16
intro/part10/src/Views/Author.elm
Normal file
16
intro/part10/src/Views/Author.elm
Normal file
@@ -0,0 +1,16 @@
|
||||
module Views.Author exposing (view)
|
||||
|
||||
{-| View an author. We basically render their username and a link to their
|
||||
profile, and that's it.
|
||||
-}
|
||||
|
||||
import Data.User as User exposing (Username)
|
||||
import Html exposing (Html, a)
|
||||
import Html.Attributes exposing (attribute, class, href, id, placeholder)
|
||||
import Route exposing (Route)
|
||||
|
||||
|
||||
view : Username -> Html msg
|
||||
view username =
|
||||
a [ class "author", Route.href (Route.Profile username) ]
|
||||
[ User.usernameToHtml username ]
|
||||
29
intro/part10/src/Views/Errors.elm
Normal file
29
intro/part10/src/Views/Errors.elm
Normal file
@@ -0,0 +1,29 @@
|
||||
module Views.Errors exposing (view)
|
||||
|
||||
{-| Render dismissable errors. We use this all over the place!
|
||||
-}
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (class, style)
|
||||
import Html.Events exposing (onClick)
|
||||
|
||||
|
||||
view : msg -> List String -> Html msg
|
||||
view dismissErrors errors =
|
||||
if List.isEmpty errors then
|
||||
Html.text ""
|
||||
else
|
||||
div [ class "error-messages", styles ] <|
|
||||
List.map (\error -> p [] [ text error ]) errors
|
||||
++ [ button [ onClick dismissErrors ] [ text "Ok" ] ]
|
||||
|
||||
|
||||
styles : Attribute msg
|
||||
styles =
|
||||
style
|
||||
[ ( "position", "fixed" )
|
||||
, ( "top", "0" )
|
||||
, ( "background", "rgb(250, 250, 250)" )
|
||||
, ( "padding", "20px" )
|
||||
, ( "border", "1px solid" )
|
||||
]
|
||||
40
intro/part10/src/Views/Form.elm
Normal file
40
intro/part10/src/Views/Form.elm
Normal file
@@ -0,0 +1,40 @@
|
||||
module Views.Form exposing (input, password, textarea, viewErrors)
|
||||
|
||||
import Html exposing (Attribute, Html, fieldset, li, text, ul)
|
||||
import Html.Attributes exposing (class, type_)
|
||||
|
||||
|
||||
password : List (Attribute msg) -> List (Html msg) -> Html msg
|
||||
password attrs =
|
||||
control Html.input ([ type_ "password" ] ++ attrs)
|
||||
|
||||
|
||||
input : List (Attribute msg) -> List (Html msg) -> Html msg
|
||||
input attrs =
|
||||
control Html.input ([ type_ "text" ] ++ attrs)
|
||||
|
||||
|
||||
textarea : List (Attribute msg) -> List (Html msg) -> Html msg
|
||||
textarea =
|
||||
control Html.textarea
|
||||
|
||||
|
||||
viewErrors : List ( a, String ) -> Html msg
|
||||
viewErrors errors =
|
||||
errors
|
||||
|> List.map (\( _, error ) -> li [] [ text error ])
|
||||
|> ul [ class "error-messages" ]
|
||||
|
||||
|
||||
|
||||
-- INTERNAL --
|
||||
|
||||
|
||||
control :
|
||||
(List (Attribute msg) -> List (Html msg) -> Html msg)
|
||||
-> List (Attribute msg)
|
||||
-> List (Html msg)
|
||||
-> Html msg
|
||||
control element attributes children =
|
||||
fieldset [ class "form-group" ]
|
||||
[ element (class "form-control" :: attributes) children ]
|
||||
142
intro/part10/src/Views/Page.elm
Normal file
142
intro/part10/src/Views/Page.elm
Normal file
@@ -0,0 +1,142 @@
|
||||
module Views.Page exposing (ActivePage(..), bodyId, frame)
|
||||
|
||||
{-| The frame around a typical page - that is, the header and footer.
|
||||
-}
|
||||
|
||||
import Data.User as User exposing (User, Username)
|
||||
import Data.UserPhoto as UserPhoto exposing (UserPhoto)
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Lazy exposing (lazy2)
|
||||
import Route exposing (Route)
|
||||
import Util
|
||||
import Views.Spinner exposing (spinner)
|
||||
|
||||
|
||||
{-| Determines which navbar link (if any) will be rendered as active.
|
||||
|
||||
Note that we don't enumerate every page here, because the navbar doesn't
|
||||
have links for every page. Anything that's not part of the navbar falls
|
||||
under Other.
|
||||
|
||||
-}
|
||||
type ActivePage
|
||||
= Other
|
||||
| Home
|
||||
| Login
|
||||
| Register
|
||||
| Settings
|
||||
| Profile Username
|
||||
| NewArticle
|
||||
|
||||
|
||||
{-| Take a page's Html and frame it with a header and footer.
|
||||
|
||||
The caller provides the current user, so we can display in either
|
||||
"signed in" (rendering username) or "signed out" mode.
|
||||
|
||||
isLoading is for determining whether we should show a loading spinner
|
||||
in the header. (This comes up during slow page transitions.)
|
||||
|
||||
-}
|
||||
frame : Bool -> Maybe User -> ActivePage -> Html msg -> Html msg
|
||||
frame isLoading user page content =
|
||||
div [ class "page-frame" ]
|
||||
[ viewHeader page user isLoading
|
||||
, content
|
||||
, viewFooter
|
||||
]
|
||||
|
||||
|
||||
viewHeader : ActivePage -> Maybe User -> Bool -> Html msg
|
||||
viewHeader page user isLoading =
|
||||
nav [ class "navbar navbar-light" ]
|
||||
[ div [ class "container" ]
|
||||
[ a [ class "navbar-brand", Route.href Route.Home ]
|
||||
[ text "conduit" ]
|
||||
, ul [ class "nav navbar-nav pull-xs-right" ] <|
|
||||
lazy2 Util.viewIf isLoading spinner
|
||||
:: navbarLink page Route.Home [ text "Home" ]
|
||||
:: viewSignIn page user
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewSignIn : ActivePage -> Maybe User -> List (Html msg)
|
||||
viewSignIn page user =
|
||||
let
|
||||
linkTo =
|
||||
navbarLink page
|
||||
in
|
||||
case user of
|
||||
Nothing ->
|
||||
[ linkTo Route.Login [ text "Sign in" ]
|
||||
, linkTo Route.Register [ text "Sign up" ]
|
||||
]
|
||||
|
||||
Just user ->
|
||||
[ linkTo Route.NewArticle [ i [ class "ion-compose" ] [], text " New Post" ]
|
||||
, linkTo Route.Settings [ i [ class "ion-gear-a" ] [], text " Settings" ]
|
||||
, linkTo
|
||||
(Route.Profile user.username)
|
||||
[ img [ class "user-pic", UserPhoto.src user.image ] []
|
||||
, User.usernameToHtml user.username
|
||||
]
|
||||
, linkTo Route.Logout [ text "Sign out" ]
|
||||
]
|
||||
|
||||
|
||||
viewFooter : Html msg
|
||||
viewFooter =
|
||||
footer []
|
||||
[ div [ class "container" ]
|
||||
[ a [ class "logo-font", href "/" ] [ text "conduit" ]
|
||||
, span [ class "attribution" ]
|
||||
[ text "An interactive learning project from "
|
||||
, a [ href "https://thinkster.io" ] [ text "Thinkster" ]
|
||||
, text ". Code & design licensed under MIT."
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
navbarLink : ActivePage -> Route -> List (Html msg) -> Html msg
|
||||
navbarLink page route linkContent =
|
||||
li [ classList [ ( "nav-item", True ), ( "active", isActive page route ) ] ]
|
||||
[ a [ class "nav-link", Route.href route ] linkContent ]
|
||||
|
||||
|
||||
isActive : ActivePage -> Route -> Bool
|
||||
isActive page route =
|
||||
case ( page, route ) of
|
||||
( Home, Route.Home ) ->
|
||||
True
|
||||
|
||||
( Login, Route.Login ) ->
|
||||
True
|
||||
|
||||
( Register, Route.Register ) ->
|
||||
True
|
||||
|
||||
( Settings, Route.Settings ) ->
|
||||
True
|
||||
|
||||
( Profile pageUsername, Route.Profile routeUsername ) ->
|
||||
pageUsername == routeUsername
|
||||
|
||||
( NewArticle, Route.NewArticle ) ->
|
||||
True
|
||||
|
||||
_ ->
|
||||
False
|
||||
|
||||
|
||||
{-| This id comes from index.html.
|
||||
|
||||
The Feed uses it to scroll to the top of the page (by ID) when switching pages
|
||||
in the pagination sense.
|
||||
|
||||
-}
|
||||
bodyId : String
|
||||
bodyId =
|
||||
"page-body"
|
||||
13
intro/part10/src/Views/Spinner.elm
Normal file
13
intro/part10/src/Views/Spinner.elm
Normal file
@@ -0,0 +1,13 @@
|
||||
module Views.Spinner exposing (spinner)
|
||||
|
||||
import Html exposing (Attribute, Html, div, li)
|
||||
import Html.Attributes exposing (class, style)
|
||||
|
||||
|
||||
spinner : Html msg
|
||||
spinner =
|
||||
li [ class "sk-three-bounce", style [ ( "float", "left" ), ( "margin", "8px" ) ] ]
|
||||
[ div [ class "sk-child sk-bounce1" ] []
|
||||
, div [ class "sk-child sk-bounce2" ] []
|
||||
, div [ class "sk-child sk-bounce3" ] []
|
||||
]
|
||||
41
intro/part10/src/Views/User/Follow.elm
Normal file
41
intro/part10/src/Views/User/Follow.elm
Normal file
@@ -0,0 +1,41 @@
|
||||
module Views.User.Follow exposing (State, button)
|
||||
|
||||
{-| The Follow button.
|
||||
|
||||
This API accepts a "toggle follow" message and the current state of whether
|
||||
the user is already being followed. It's very lightweight!
|
||||
|
||||
It would be overkill to give something this simple its own Model, Msg, and
|
||||
update. That would make it way more work to use than it needed to be,
|
||||
and for no benefit.
|
||||
|
||||
-}
|
||||
|
||||
import Data.User as User exposing (Username)
|
||||
import Html exposing (Html, i, text)
|
||||
import Html.Attributes exposing (class)
|
||||
import Html.Events exposing (onClick)
|
||||
|
||||
|
||||
type alias State record =
|
||||
{ record | following : Bool, username : Username }
|
||||
|
||||
|
||||
button : (Username -> msg) -> State record -> Html msg
|
||||
button toggleFollow { following, username } =
|
||||
let
|
||||
( prefix, secondaryClass ) =
|
||||
if following then
|
||||
( "Unfollow", "btn-secondary" )
|
||||
else
|
||||
( "Follow", "btn-outline-secondary" )
|
||||
|
||||
classes =
|
||||
[ "btn", "btn-sm", secondaryClass, "action-btn" ]
|
||||
|> String.join " "
|
||||
|> class
|
||||
in
|
||||
Html.button [ classes, onClick (toggleFollow username) ]
|
||||
[ i [ class "ion-plus-round" ] []
|
||||
, text (" " ++ prefix ++ " " ++ User.usernameToString username)
|
||||
]
|
||||
Reference in New Issue
Block a user