Update advanced/part3

This commit is contained in:
Richard Feldman
2018-08-13 22:03:17 -04:00
parent e672b06038
commit d3d71508a7
4 changed files with 338 additions and 257 deletions

View File

@@ -2,11 +2,12 @@ module Article.Feed
exposing
( Model
, Msg
, decoder
, init
, selectTag
, update
, viewArticles
, viewFeedSources
, viewPagination
, viewTabs
)
import Api
@@ -16,12 +17,11 @@ import Article.Slug as ArticleSlug exposing (Slug)
import Article.Tag as Tag exposing (Tag)
import Author
import Avatar exposing (Avatar)
import Browser.Dom as Dom
import Html exposing (..)
import Html.Attributes exposing (attribute, class, classList, href, id, placeholder, src)
import Html.Events exposing (onClick)
import Http
import HttpBuilder exposing (RequestBuilder, withExpect, withQueryParams)
import HttpBuilder exposing (RequestBuilder)
import Json.Decode as Decode exposing (Decoder)
import Json.Decode.Pipeline exposing (required)
import Page
@@ -32,6 +32,7 @@ import Session exposing (Session)
import Task exposing (Task)
import Time
import Timestamp
import Url exposing (Url)
import Username exposing (Username)
import Viewer exposing (Viewer)
import Viewer.Cred as Cred exposing (Cred)
@@ -59,37 +60,29 @@ overkill, so we use simpler APIs instead.
type Model
= Model InternalModel
= Model Internals
{-| 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 module.
-}
type alias InternalModel =
type alias Internals =
{ session : Session
, errors : List String
, articles : PaginatedList (Article Preview)
, sources : FeedSources
, isLoading : Bool
}
init : Session -> FeedSources -> Task Http.Error Model
init session sources =
let
fromArticles articles =
Model
{ session = session
, errors = []
, articles = articles
, sources = sources
, isLoading = False
}
in
FeedSources.selected sources
|> fetch (Session.cred session) 1
|> Task.map fromArticles
init : Session -> PaginatedList (Article Preview) -> Model
init session articles =
Model
{ session = session
, errors = []
, articles = articles
, isLoading = False
}
@@ -97,7 +90,7 @@ init session sources =
viewArticles : Time.Zone -> Model -> List (Html Msg)
viewArticles timeZone (Model { articles, sources, session }) =
viewArticles timeZone (Model { articles, session, errors }) =
let
maybeCred =
Session.cred session
@@ -105,14 +98,8 @@ viewArticles timeZone (Model { articles, sources, session }) =
articlesHtml =
PaginatedList.values articles
|> List.map (viewPreview maybeCred timeZone)
feedSource =
FeedSources.selected sources
pagination =
PaginatedList.view ClickedFeedPage articles (limit feedSource)
in
List.append articlesHtml [ pagination ]
Page.viewErrors ClickedDismissErrors errors :: articlesHtml
viewPreview : Maybe Cred -> Time.Zone -> Article Preview -> Html Msg
@@ -167,85 +154,43 @@ viewPreview maybeCred timeZone article =
[ h1 [] [ text title ]
, p [] [ text description ]
, span [] [ text "Read more..." ]
, ul [ class "tag-list" ]
(List.map viewTag (Article.metadata article).tags)
]
]
viewFeedSources : Model -> Html Msg
viewFeedSources (Model { sources, isLoading, errors }) =
let
errorsHtml =
Page.viewErrors ClickedDismissErrors errors
in
viewTabs :
List ( String, msg )
-> ( String, msg )
-> List ( String, msg )
-> Html msg
viewTabs before selected after =
ul [ class "nav nav-pills outline-active" ] <|
List.concat
[ List.map (viewFeedSource False) (FeedSources.before sources)
, [ viewFeedSource True (FeedSources.selected sources) ]
, List.map (viewFeedSource False) (FeedSources.after sources)
, [ errorsHtml ]
[ List.map (viewTab []) before
, [ viewTab [ class "active" ] selected ]
, List.map (viewTab []) after
]
viewFeedSource : Bool -> Source -> Html Msg
viewFeedSource isSelected source =
viewTab : List (Attribute msg) -> ( String, msg ) -> Html msg
viewTab attrs ( name, msg ) =
li [ class "nav-item" ]
[ a
[ classList [ ( "nav-link", True ), ( "active", isSelected ) ]
, onClick (ClickedFeedSource source)
-- The RealWorld CSS requires an href to work properly.
, href ""
]
[ text (sourceName source) ]
[ -- Note: The RealWorld CSS requires an href to work properly.
a (class "nav-link" :: onClick msg :: href "" :: attrs)
[ text name ]
]
selectTag : Maybe Cred -> Tag -> Cmd Msg
selectTag maybeCred tag =
let
source =
TagFeed tag
in
fetch maybeCred 1 source
|> Task.attempt (CompletedFeedLoad source)
viewPagination : (Int -> msg) -> Model -> Html msg
viewPagination toMsg (Model feed) =
PaginatedList.view toMsg feed.articles
sourceName : Source -> String
sourceName source =
case source of
YourFeed _ ->
"Your Feed"
GlobalFeed ->
"Global Feed"
TagFeed tagName ->
"#" ++ Tag.toString tagName
FavoritedFeed username ->
"Favorited Articles"
AuthorFeed username ->
"My Articles"
limit : Source -> Int
limit feedSource =
case feedSource of
YourFeed _ ->
10
GlobalFeed ->
10
TagFeed tagName ->
10
FavoritedFeed username ->
5
AuthorFeed username ->
5
viewTag : String -> Html msg
viewTag tagName =
li [ class "tag-default tag-pill tag-outline" ] [ text tagName ]
@@ -256,10 +201,7 @@ type Msg
= ClickedDismissErrors
| ClickedFavorite Cred Slug
| ClickedUnfavorite Cred Slug
| ClickedFeedPage Int
| ClickedFeedSource Source
| CompletedFavorite (Result Http.Error (Article Preview))
| CompletedFeedLoad Source (Result Http.Error (PaginatedList (Article Preview)))
update : Maybe Cred -> Msg -> Model -> ( Model, Cmd Msg )
@@ -268,32 +210,6 @@ update maybeCred msg (Model model) =
ClickedDismissErrors ->
( Model { model | errors = [] }, Cmd.none )
ClickedFeedSource source ->
( Model { model | isLoading = True }
, source
|> fetch maybeCred 1
|> Task.attempt (CompletedFeedLoad source)
)
CompletedFeedLoad source (Ok articles) ->
( Model
{ model
| articles = articles
, sources = FeedSources.select source model.sources
, isLoading = False
}
, Cmd.none
)
CompletedFeedLoad _ (Err error) ->
( Model
{ model
| errors = Api.addServerError model.errors
, isLoading = False
}
, Cmd.none
)
ClickedFavorite cred slug ->
fave Article.favorite cred slug model
@@ -310,72 +226,6 @@ update maybeCred msg (Model model) =
, Cmd.none
)
ClickedFeedPage page ->
let
source =
FeedSources.selected model.sources
in
( Model model
, fetch maybeCred page source
|> Task.andThen (\articles -> Task.map (\_ -> articles) scrollToTop)
|> Task.attempt (CompletedFeedLoad source)
)
scrollToTop : Task x ()
scrollToTop =
Dom.setViewport 0 0
-- 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 Cred -> Int -> Source -> Task Http.Error (PaginatedList (Article Preview))
fetch maybeCred page feedSource =
let
articlesPerPage =
limit feedSource
offset =
(page - 1) * articlesPerPage
params =
[ ( "limit", String.fromInt articlesPerPage )
, ( "offset", String.fromInt offset )
]
in
Task.map (PaginatedList.mapPage (\_ -> page)) <|
case feedSource of
YourFeed cred ->
params
|> buildFromQueryParams (Just cred) (Api.url [ "articles", "feed" ])
|> Cred.addHeader cred
|> HttpBuilder.toRequest
|> Http.toTask
GlobalFeed ->
list maybeCred params
TagFeed tagName ->
list maybeCred (( "tag", Tag.toString tagName ) :: params)
FavoritedFeed username ->
list maybeCred (( "favorited", Username.toString username ) :: params)
AuthorFeed username ->
list maybeCred (( "author", Username.toString username ) :: params)
list :
Maybe Cred
-> List ( String, String )
-> Task Http.Error (PaginatedList (Article Preview))
list maybeCred params =
buildFromQueryParams maybeCred (Api.url [ "articles" ]) params
|> Cred.addHeaderIfAvailable maybeCred
|> HttpBuilder.toRequest
|> Http.toTask
replaceArticle : Article a -> Article a -> Article a
replaceArticle newArticle oldArticle =
@@ -390,29 +240,24 @@ replaceArticle newArticle oldArticle =
-- SERIALIZATION
decoder : Maybe Cred -> Decoder (PaginatedList (Article Preview))
decoder maybeCred =
decoder : Maybe Cred -> Int -> Decoder (PaginatedList (Article Preview))
decoder maybeCred resultsPerPage =
Decode.succeed PaginatedList.fromList
|> required "articlesCount" Decode.int
|> required "articlesCount" (pageCountDecoder resultsPerPage)
|> required "articles" (Decode.list (Article.previewDecoder maybeCred))
-- REQUEST
buildFromQueryParams : Maybe Cred -> String -> List ( String, String ) -> RequestBuilder (PaginatedList (Article Preview))
buildFromQueryParams maybeCred url queryParams =
HttpBuilder.get url
|> withExpect (Http.expectJson (decoder maybeCred))
|> withQueryParams queryParams
pageCountDecoder : Int -> Decoder Int
pageCountDecoder resultsPerPage =
Decode.int
|> Decode.map (\total -> ceiling (toFloat total / toFloat resultsPerPage))
-- INTERNAL
fave : (Slug -> Cred -> Http.Request (Article Preview)) -> Cred -> Slug -> InternalModel -> ( Model, Cmd Msg )
fave : (Slug -> Cred -> Http.Request (Article Preview)) -> Cred -> Slug -> Internals -> ( Model, Cmd Msg )
fave toRequest cred slug model =
( Model model
, toRequest slug cred