Update intro/part7

This commit is contained in:
Richard Feldman
2018-08-13 22:00:41 -04:00
parent f1fb34aaa4
commit 2978c6e193
4 changed files with 338 additions and 257 deletions

View File

@@ -3,20 +3,25 @@ module Page.Home exposing (Model, Msg, init, subscriptions, toSession, update, v
{-| The homepage. You can get here via either the / or /#/ routes.
-}
import Article
import Api
import Article exposing (Article, Preview)
import Article.Feed as Feed
import Article.FeedSources as FeedSources exposing (FeedSources, Source(..))
import Article.Tag as Tag exposing (Tag)
import Browser.Dom as Dom
import Html exposing (..)
import Html.Attributes exposing (attribute, class, classList, href, id, placeholder)
import Html.Events exposing (onClick)
import Http
import HttpBuilder
import Loading
import Log
import Page
import PaginatedList exposing (PaginatedList)
import Session exposing (Session)
import Task exposing (Task)
import Time
import Username exposing (Username)
import Viewer.Cred as Cred exposing (Cred)
@@ -27,6 +32,8 @@ import Viewer.Cred as Cred exposing (Cred)
type alias Model =
{ session : Session
, timeZone : Time.Zone
, feedTab : FeedTab
, feedPage : Int
-- Loaded independently from server
, tags : Status (List Tag)
@@ -41,28 +48,35 @@ type Status a
| Failed
type FeedTab
= YourFeed Cred
| GlobalFeed
| TagFeed Tag
init : Session -> ( Model, Cmd Msg )
init session =
let
feedSources =
feedTab =
case Session.cred session of
Just cred ->
FeedSources.fromLists (YourFeed cred) [ GlobalFeed ]
YourFeed cred
Nothing ->
FeedSources.fromLists GlobalFeed []
GlobalFeed
loadTags =
Tag.list
|> Http.toTask
Http.toTask Tag.list
in
( { session = session
, timeZone = Time.utc
, feedTab = feedTab
, feedPage = 1
, tags = Loading
, feed = Loading
}
, Cmd.batch
[ Feed.init session feedSources
[ fetchFeed session feedTab 1
|> Task.attempt CompletedFeedLoad
, Tag.list
|> Http.send CompletedTagsLoad
@@ -87,7 +101,17 @@ view model =
[ div [ class "col-md-9" ] <|
case model.feed of
Loaded feed ->
viewFeed model.timeZone feed
[ div [ class "feed-toggle" ] <|
List.concat
[ [ viewTabs
(Session.cred model.session)
model.feedTab
]
, Feed.viewArticles model.timeZone feed
|> List.map (Html.map GotFeedMsg)
, [ Feed.viewPagination ClickedFeedPage feed ]
]
]
Loading ->
[]
@@ -130,11 +154,58 @@ viewBanner =
]
viewFeed : Time.Zone -> Feed.Model -> List (Html Msg)
viewFeed timeZone feed =
div [ class "feed-toggle" ]
[ Feed.viewFeedSources feed |> Html.map GotFeedMsg ]
:: (Feed.viewArticles timeZone feed |> List.map (Html.map GotFeedMsg))
-- TABS
viewTabs : Maybe Cred -> FeedTab -> Html Msg
viewTabs maybeCred tab =
case tab of
YourFeed cred ->
Feed.viewTabs [] (yourFeed cred) [ globalFeed ]
GlobalFeed ->
let
otherTabs =
case maybeCred of
Just cred ->
[ yourFeed cred ]
Nothing ->
[]
in
Feed.viewTabs otherTabs globalFeed []
TagFeed tag ->
let
otherTabs =
case maybeCred of
Just cred ->
[ yourFeed cred, globalFeed ]
Nothing ->
[ globalFeed ]
in
Feed.viewTabs otherTabs (tagFeed tag) []
yourFeed : Cred -> ( String, Msg )
yourFeed cred =
( "Your Feed", ClickedTab (YourFeed cred) )
globalFeed : ( String, Msg )
globalFeed =
( "Global Feed", ClickedTab GlobalFeed )
tagFeed : Tag -> ( String, Msg )
tagFeed tag =
( "#" ++ Tag.toString tag, ClickedTab (TagFeed tag) )
-- TAGS
viewTags : List Tag -> Html Msg
@@ -160,6 +231,8 @@ viewTag tagName =
type Msg
= ClickedTag Tag
| ClickedTab FeedTab
| ClickedFeedPage Int
| CompletedFeedLoad (Result Http.Error Feed.Model)
| CompletedTagsLoad (Result Http.Error (List Tag))
| GotTimeZone Time.Zone
@@ -171,12 +244,28 @@ type Msg
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
ClickedTag tagName ->
ClickedTag tag ->
let
subCmd =
Feed.selectTag (Session.cred model.session) tagName
feedTab =
TagFeed tag
in
( model, Cmd.map GotFeedMsg subCmd )
( { model | feedTab = feedTab }
, fetchFeed model.session feedTab 1
|> Task.attempt CompletedFeedLoad
)
ClickedTab tab ->
( { model | feedTab = tab }
, fetchFeed model.session tab 1
|> Task.attempt CompletedFeedLoad
)
ClickedFeedPage page ->
( { model | feedPage = page }
, fetchFeed model.session model.feedTab page
|> Task.andThen (\feed -> Task.map (\_ -> feed) scrollToTop)
|> Task.attempt CompletedFeedLoad
)
CompletedFeedLoad (Ok feed) ->
( { model | feed = Loaded feed }, Cmd.none )
@@ -242,6 +331,53 @@ update msg model =
-- HTTP
fetchFeed : Session -> FeedTab -> Int -> Task Http.Error Feed.Model
fetchFeed session feedTabs page =
let
maybeCred =
Session.cred session
builder =
case feedTabs of
YourFeed cred ->
Api.url [ "articles", "feed" ]
|> HttpBuilder.get
|> Cred.addHeader cred
GlobalFeed ->
Api.url [ "articles" ]
|> HttpBuilder.get
|> Cred.addHeaderIfAvailable maybeCred
TagFeed tag ->
Api.url [ "articles" ]
|> HttpBuilder.get
|> Cred.addHeaderIfAvailable maybeCred
|> HttpBuilder.withQueryParam "tag" (Tag.toString tag)
in
builder
|> HttpBuilder.withExpect (Http.expectJson (Feed.decoder maybeCred articlesPerPage))
|> PaginatedList.fromRequestBuilder articlesPerPage page
|> Task.map (Feed.init session)
articlesPerPage : Int
articlesPerPage =
10
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 ())
-- SUBSCRIPTIONS