Move stuff

intro-to-elm/part8/src/Views/Article.elm

@@ -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

intro-to-elm/part8/src/Views/Article/Favorite.elm

@@ -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

intro-to-elm/part8/src/Views/Article/Feed.elm

@@ -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

intro-to-elm/part8/src/Views/Assets.elm

@@ -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

intro-to-elm/part8/src/Views/Author.elm

@@ -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 ]

intro-to-elm/part8/src/Views/Errors.elm

@@ -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" )
+        ]

intro-to-elm/part8/src/Views/Form.elm

@@ -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 ]

intro-to-elm/part8/src/Views/Page.elm

@@ -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"

intro-to-elm/part8/src/Views/Spinner.elm

@@ -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" ] []
+        ]

intro-to-elm/part8/src/Views/User/Follow.elm

@@ -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)
+        ]