diff --git a/elm.json b/elm.json index 7384334f6b..2a32f8ab5c 100644 --- a/elm.json +++ b/elm.json @@ -1,7 +1,8 @@ { "type": "application", "source-directories": [ - "src" + "src", + "../elm-spa/src" ], "elm-version": "0.19.1", "dependencies": { @@ -15,6 +16,7 @@ "elm/time": "1.0.0", "elm/url": "1.0.0", "elm-explorations/markdown": "1.0.0", + "orus-io/elm-spa": "2.0.0", "rtfeldman/elm-iso8601-date-strings": "1.1.0" }, "indirect": { diff --git a/src/Api.elm b/src/Api.elm index adce6e82be..b60c3e9cdb 100644 --- a/src/Api.elm +++ b/src/Api.elm @@ -1,4 +1,4 @@ -port module Api exposing (Cred, addServerError, application, decodeErrors, delete, get, login, logout, post, put, register, settings, storeCredWith, username, viewerChanges) +port module Api exposing (Cred, addServerError, application, decodeErrors, delete, get, login, logout, post, put, register, settings, storageDecoder, storeCredWith, username, viewerChanges) {-| This module is responsible for communicating to the Conduit API. diff --git a/src/Article/Feed.elm b/src/Article/Feed.elm index 8e4f4bd1a0..dfca51861d 100644 --- a/src/Article/Feed.elm +++ b/src/Article/Feed.elm @@ -22,6 +22,7 @@ import Time import Timestamp import Url exposing (Url) import Username exposing (Username) +import View {-| NOTE: This module has its own Model, view, and update. This is not normal! @@ -85,7 +86,7 @@ viewArticles timeZone (Model { articles, session, errors }) = PaginatedList.values articles |> List.map (viewPreview maybeCred timeZone) in - Page.viewErrors ClickedDismissErrors errors :: articlesHtml + View.viewErrors ClickedDismissErrors errors :: articlesHtml viewPreview : Maybe Cred -> Time.Zone -> Article Preview -> Html Msg diff --git a/src/Main.elm b/src/Main.elm index 70c62ad026..9e82adb962 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -5,6 +5,7 @@ import Article.Slug exposing (Slug) import Avatar exposing (Avatar) import Browser exposing (Document) import Browser.Navigation as Nav +import Effect import Html exposing (..) import Json.Decode as Decode exposing (Value) import Page exposing (Page) @@ -13,319 +14,142 @@ import Page.Article.Editor as Editor import Page.Blank as Blank import Page.Home as Home import Page.Login as Login +import Page.Logout as Logout import Page.NotFound as NotFound import Page.Profile as Profile import Page.Register as Register import Page.Settings as Settings import Route exposing (Route) import Session exposing (Session) +import Spa +import Spa.PageStack import Task import Time import Url exposing (Url) import Username exposing (Username) +import View exposing (View) import Viewer exposing (Viewer) --- NOTE: Based on discussions around how asset management features --- like code splitting and lazy loading have been shaping up, it's possible --- that most of this file may become unnecessary in a future release of Elm. --- Avoid putting things in this module unless there is no alternative! --- See https://discourse.elm-lang.org/t/elm-spa-in-0-19/1800/2 for more. +-- Elm SPA pages -type Model - = Redirect Session - | NotFound Session - | 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 alias StackModel = + Spa.PageStack.Model Never StackCurrentModel StackPreviousModel +type alias StackCurrentModel = + Logout.Model --- MODEL - -init : Maybe Viewer -> Url -> Nav.Key -> ( Model, Cmd Msg ) -init maybeViewer url navKey = - changeRouteTo (Route.fromUrl url) - (Redirect (Session.fromViewer navKey maybeViewer)) - - - --- VIEW - - -view : Model -> Document Msg -view model = - let - viewer = - Session.viewer (toSession model) - - viewPage page toMsg config = - let - { title, body } = - Page.view viewer page config - in - { title = title - , body = List.map (Html.map toMsg) body - } - in - case model of - Redirect _ -> - Page.view viewer Page.Other Blank.view - - NotFound _ -> - Page.view viewer Page.Other NotFound.view - - Settings settings -> - viewPage Page.Other GotSettingsMsg (Settings.view settings) - - Home home -> - viewPage Page.Home GotHomeMsg (Home.view home) - - Login login -> - viewPage Page.Other GotLoginMsg (Login.view login) - - Register register -> - viewPage Page.Other GotRegisterMsg (Register.view register) - - Profile username profile -> - viewPage (Page.Profile username) GotProfileMsg (Profile.view profile) - - Article article -> - viewPage Page.Other GotArticleMsg (Article.view article) - - Editor Nothing editor -> - viewPage Page.NewArticle GotEditorMsg (Editor.view editor) - - Editor (Just _) editor -> - viewPage Page.Other GotEditorMsg (Editor.view editor) - - - --- UPDATE - - -type Msg - = ChangedUrl Url - | ClickedLink Browser.UrlRequest - | GotHomeMsg Home.Msg - | GotSettingsMsg Settings.Msg - | GotLoginMsg Login.Msg - | GotRegisterMsg Register.Msg - | GotProfileMsg Profile.Msg - | GotArticleMsg Article.Msg - | GotEditorMsg Editor.Msg - | GotSession Session - - -toSession : Model -> Session -toSession page = - case page of - Redirect session -> - session - - NotFound session -> - session - - Home home -> - Home.toSession home - - Settings settings -> - Settings.toSession settings - - Login login -> - Login.toSession login - - Register register -> - Register.toSession register - - Profile _ profile -> - Profile.toSession profile - - Article article -> - Article.toSession article - - Editor _ editor -> - Editor.toSession editor - - -changeRouteTo : Maybe Route -> Model -> ( Model, Cmd Msg ) -changeRouteTo maybeRoute model = - let - session = - toSession model - in - case maybeRoute of - Nothing -> - ( NotFound session, Cmd.none ) - - Just Route.Root -> - ( model, Route.replaceUrl (Session.navKey session) Route.Home ) - - Just Route.Logout -> - ( model, Api.logout ) - - Just Route.NewArticle -> - Editor.initNew session - |> updateWith (Editor Nothing) GotEditorMsg model - - Just (Route.EditArticle slug) -> - Editor.initEdit session slug - |> updateWith (Editor (Just slug)) GotEditorMsg model - - Just Route.Settings -> - Settings.init session - |> updateWith Settings GotSettingsMsg model - - Just Route.Home -> - Home.init session - |> updateWith Home GotHomeMsg model - - Just Route.Login -> - Login.init session - |> updateWith Login GotLoginMsg model - - Just Route.Register -> - Register.init session - |> updateWith Register GotRegisterMsg model - - Just (Route.Profile username) -> - Profile.init session username - |> updateWith (Profile username) GotProfileMsg model - - Just (Route.Article slug) -> - Article.init session slug - |> updateWith Article GotArticleMsg model - - -update : Msg -> Model -> ( Model, Cmd Msg ) -update msg model = - case ( msg, model ) of - ( ClickedLink urlRequest, _ ) -> - case urlRequest of - Browser.Internal url -> - case url.fragment of - Nothing -> - -- If we got a link that didn't include a fragment, - -- it's from one of those (href "") attributes that - -- we have to include to make the RealWorld CSS work. - -- - -- In an application doing path routing instead of - -- fragment-based routing, this entire - -- `case url.fragment of` expression this comment - -- is inside would be unnecessary. - ( model, Cmd.none ) - - Just _ -> - ( model - , Nav.pushUrl (Session.navKey (toSession model)) (Url.toString url) +type alias StackPreviousModel = + Spa.PageStack.Model + Never + Editor.Model + (Spa.PageStack.Model + Never + Article.Model + (Spa.PageStack.Model + Never + Register.Model + (Spa.PageStack.Model + Never + Login.Model + (Spa.PageStack.Model + Never + Profile.Model + (Spa.PageStack.Model + Never + Settings.Model + (Spa.PageStack.Model + Never + Home.Model + (Spa.PageStack.Model Never () ()) ) - - Browser.External href -> - ( model - , Nav.load href + ) ) - - ( ChangedUrl url, _ ) -> - changeRouteTo (Route.fromUrl url) model - - ( GotSettingsMsg subMsg, Settings settings ) -> - Settings.update subMsg settings - |> updateWith Settings GotSettingsMsg model - - ( GotLoginMsg subMsg, Login login ) -> - Login.update subMsg login - |> updateWith Login GotLoginMsg model - - ( GotRegisterMsg subMsg, Register register ) -> - Register.update subMsg register - |> updateWith Register GotRegisterMsg model - - ( GotHomeMsg subMsg, Home home ) -> - Home.update subMsg home - |> updateWith Home GotHomeMsg model - - ( GotProfileMsg subMsg, Profile username profile ) -> - Profile.update subMsg profile - |> updateWith (Profile username) GotProfileMsg model - - ( GotArticleMsg subMsg, Article article ) -> - Article.update subMsg article - |> updateWith Article GotArticleMsg model - - ( GotEditorMsg subMsg, Editor slug editor ) -> - Editor.update subMsg editor - |> updateWith (Editor slug) GotEditorMsg model - - ( GotSession session, Redirect _ ) -> - ( Redirect session - , Route.replaceUrl (Session.navKey session) Route.Home + ) ) + ) + + +type alias StackMsg = + Spa.PageStack.Msg Route StackCurrentMsg StackPreviousMsg + + +type alias StackCurrentMsg = + Logout.Msg + + +type alias StackPreviousMsg = + Spa.PageStack.Msg + Route + Editor.Msg + (Spa.PageStack.Msg + Route + Article.Msg + (Spa.PageStack.Msg + Route + Register.Msg + (Spa.PageStack.Msg + Route + Login.Msg + (Spa.PageStack.Msg + Route + Profile.Msg + (Spa.PageStack.Msg + Route + Settings.Msg + (Spa.PageStack.Msg Route Home.Msg (Spa.PageStack.Msg Route () ())) + ) + ) + ) + ) + ) - ( _, _ ) -> - -- Disregard messages that arrived for the wrong page. - ( model, Cmd.none ) - - -updateWith : (subModel -> Model) -> (subMsg -> Msg) -> Model -> ( subModel, Cmd subMsg ) -> ( Model, Cmd Msg ) -updateWith toModel toMsg model ( subModel, subCmd ) = - ( toModel subModel - , Cmd.map toMsg subCmd - ) - - - --- SUBSCRIPTIONS - - -subscriptions : Model -> Sub Msg -subscriptions model = - case model of - NotFound _ -> - Sub.none - Redirect _ -> - Session.changes GotSession (Session.navKey (toSession model)) +type alias Stack = + Spa.PageStack.Stack Never Session Session.Msg Route (View StackMsg) StackCurrentModel StackPreviousModel StackCurrentMsg StackPreviousMsg - Settings settings -> - Sub.map GotSettingsMsg (Settings.subscriptions settings) - Home home -> - Sub.map GotHomeMsg (Home.subscriptions home) +type alias Msg = + Spa.Msg Session.Msg StackMsg - Login login -> - Sub.map GotLoginMsg (Login.subscriptions login) - Register register -> - Sub.map GotRegisterMsg (Register.subscriptions register) - Profile _ profile -> - Sub.map GotProfileMsg (Profile.subscriptions profile) +-- VIEW - Article article -> - Sub.map GotArticleMsg (Article.subscriptions article) - Editor _ editor -> - Sub.map GotEditorMsg (Editor.subscriptions editor) +toDocument : Session -> View Msg -> Browser.Document Msg +toDocument session view = + View.view (Session.viewer session) view -- MAIN -main : Program Value Model Msg main = - Api.application Viewer.decoder - { init = init - , onUrlChange = ChangedUrl - , onUrlRequest = ClickedLink - , subscriptions = subscriptions - , update = update - , view = view + Spa.init + { defaultView = View.default + , extractIdentity = Session.viewer } + |> Spa.addPublicPage ( View.map, View.map ) Route.matchHome Home.page + |> Spa.addPublicPage ( View.map, View.map ) Route.matchSettings Settings.page + |> Spa.addPublicPage ( View.map, View.map ) Route.matchProfile Profile.page + |> Spa.addPublicPage ( View.map, View.map ) Route.matchLogin Login.page + |> Spa.addPublicPage ( View.map, View.map ) Route.matchRegister Register.page + |> Spa.addPublicPage ( View.map, View.map ) Route.matchArticle Article.page + |> Spa.addPublicPage ( View.map, View.map ) Route.matchEditor Editor.page + |> Spa.addPublicPage ( View.map, View.map ) Route.matchLogout Logout.page + |> Spa.application View.map + { init = Session.init + , subscriptions = Session.subscriptions + , update = Session.update + , toRoute = Route.fromUrl >> Maybe.withDefault Route.Home + , toDocument = toDocument + , protectPage = always (Route.toString Route.Home) + } + |> Spa.onUrlRequest Session.ClickedLink + |> Browser.application diff --git a/src/Page.elm b/src/Page.elm index f1790bff6f..e7dba6646c 100644 --- a/src/Page.elm +++ b/src/Page.elm @@ -1,4 +1,4 @@ -module Page exposing (Page(..), view, viewErrors) +module Page exposing (Page(..)) import Api exposing (Cred) import Avatar @@ -28,129 +28,3 @@ type Page | Settings | Profile Username | NewArticle - - -{-| Take a page's Html and frames 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.) - --} -view : Maybe Viewer -> Page -> { title : String, content : Html msg } -> Document msg -view maybeViewer page { title, content } = - { title = title ++ " - Conduit" - , body = viewHeader page maybeViewer :: content :: [ viewFooter ] - } - - -viewHeader : Page -> Maybe Viewer -> Html msg -viewHeader page maybeViewer = - 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" ] <| - navbarLink page Route.Home [ text "Home" ] - :: viewMenu page maybeViewer - ] - ] - - -viewMenu : Page -> Maybe Viewer -> List (Html msg) -viewMenu page maybeViewer = - let - linkTo = - navbarLink page - in - case maybeViewer of - Just viewer -> - let - username = - Viewer.username viewer - - avatar = - Viewer.avatar viewer - in - [ linkTo Route.NewArticle [ i [ class "ion-compose" ] [], text "\u{00A0}New Post" ] - , linkTo Route.Settings [ i [ class "ion-gear-a" ] [], text "\u{00A0}Settings" ] - , linkTo - (Route.Profile username) - [ img [ class "user-pic", Avatar.src avatar ] [] - , Username.toHtml username - ] - , linkTo Route.Logout [ text "Sign out" ] - ] - - Nothing -> - [ linkTo Route.Login [ text "Sign in" ] - , linkTo Route.Register [ text "Sign up" ] - ] - - -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 : Page -> 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 : Page -> 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 - - -{-| Render dismissable errors. We use this all over the place! --} -viewErrors : msg -> List String -> Html msg -viewErrors dismissErrors errors = - if List.isEmpty errors then - Html.text "" - - else - div - [ class "error-messages" - , style "position" "fixed" - , style "top" "0" - , style "background" "rgb(250, 250, 250)" - , style "padding" "20px" - , style "border" "1px solid" - ] - <| - List.map (\error -> p [] [ text error ]) errors - ++ [ button [ onClick dismissErrors ] [ text "Ok" ] ] diff --git a/src/Page/Article.elm b/src/Page/Article.elm index 1ef0d6e16f..07acf84dc8 100644 --- a/src/Page/Article.elm +++ b/src/Page/Article.elm @@ -1,4 +1,4 @@ -module Page.Article exposing (Model, Msg, init, subscriptions, toSession, update, view) +module Page.Article exposing (Model, Msg, page) {-| Viewing an individual article. -} @@ -13,6 +13,7 @@ import Author exposing (Author(..), FollowedAuthor, UnfollowedAuthor) import Avatar import Browser.Navigation as Nav import CommentId exposing (CommentId) +import Effect exposing (Effect) import Html exposing (..) import Html.Attributes exposing (attribute, class, disabled, href, id, placeholder, value) import Html.Events exposing (onClick, onInput, onSubmit) @@ -24,20 +25,30 @@ import Page import Profile exposing (Profile) import Route import Session exposing (Session) +import Spa.Page import Task exposing (Task) import Time import Timestamp import Username exposing (Username) +import View exposing (View) import Viewer exposing (Viewer) +page session = + Spa.Page.element + { init = init session + , update = update session + , subscriptions = subscriptions + , view = view session + } + + -- MODEL type alias Model = - { session : Session - , timeZone : Time.Zone + { timeZone : Time.Zone , errors : List String -- Loaded independently from server @@ -58,25 +69,26 @@ type CommentText | Sending String -init : Session -> Slug -> ( Model, Cmd Msg ) +init : Session -> Slug -> ( Model, Effect Session.Msg Msg ) init session slug = let maybeCred = Session.cred session in - ( { session = session - , timeZone = Time.utc + ( { timeZone = Time.utc , errors = [] , comments = Loading , article = Loading } - , Cmd.batch + , Effect.batch [ Article.fetch maybeCred slug |> Http.send CompletedLoadArticle + |> Effect.fromCmd , Comment.list maybeCred slug |> Http.send CompletedLoadComments - , Task.perform GotTimeZone Time.here - , Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold + |> Effect.fromCmd + , Effect.perform GotTimeZone Time.here + , Effect.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold ] ) @@ -85,8 +97,8 @@ init session slug = -- VIEW -view : Model -> { title : String, content : Html Msg } -view model = +view : Session -> Model -> View Msg +view session model = case model.article of Loaded article -> let @@ -106,7 +118,7 @@ view model = Author.profile author buttons = - case Session.cred model.session of + case Session.cred session of Just cred -> viewButtons cred article author @@ -114,6 +126,7 @@ view model = [] in { title = title + , page = Page.Other , content = div [ class "article-page" ] [ div [ class "banner" ] @@ -129,7 +142,7 @@ view model = ] ] buttons - , Page.viewErrors ClickedDismissErrors model.errors + , View.viewErrors ClickedDismissErrors model.errors ] ] , div [ class "container page" ] @@ -165,7 +178,7 @@ view model = -- see the existing comments! Otherwise you -- may be about to repeat something that's -- already been said. - viewAddComment slug commentText (Session.viewer model.session) + viewAddComment slug commentText (Session.viewer session) :: List.map (viewComment model.timeZone slug) comments Failed -> @@ -176,13 +189,13 @@ view model = } Loading -> - { title = "Article", content = text "" } + { title = "Article", page = Page.Other, content = text "" } LoadingSlowly -> - { title = "Article", content = Loading.icon } + { title = "Article", page = Page.Other, content = Loading.icon } Failed -> - { title = "Article", content = Loading.error "article" } + { title = "Article", page = Page.Other, content = Loading.error "article" } viewAddComment : Slug -> CommentText -> Maybe Viewer -> Html Msg @@ -325,15 +338,14 @@ type Msg | CompletedFollowChange (Result Http.Error Author) | CompletedPostComment (Result Http.Error Comment) | GotTimeZone Time.Zone - | GotSession Session | PassedSlowLoadThreshold -update : Msg -> Model -> ( Model, Cmd Msg ) -update msg model = +update : Session -> Msg -> Model -> ( Model, Effect Session.Msg Msg ) +update session msg model = case msg of ClickedDismissErrors -> - ( { model | errors = [] }, Cmd.none ) + ( { model | errors = [] }, Effect.none ) ClickedFavorite cred slug body -> ( model, fave Article.favorite cred slug body ) @@ -342,50 +354,52 @@ update msg model = ( model, fave Article.unfavorite cred slug body ) CompletedLoadArticle (Ok article) -> - ( { model | article = Loaded article }, Cmd.none ) + ( { model | article = Loaded article }, Effect.none ) CompletedLoadArticle (Err error) -> ( { model | article = Failed } - , Log.error + , Log.error |> Effect.fromCmd ) CompletedLoadComments (Ok comments) -> - ( { model | comments = Loaded ( Editing "", comments ) }, Cmd.none ) + ( { model | comments = Loaded ( Editing "", comments ) }, Effect.none ) CompletedLoadComments (Err error) -> - ( { model | article = Failed }, Log.error ) + ( { model | article = Failed }, Log.error |> Effect.fromCmd ) CompletedFavoriteChange (Ok newArticle) -> - ( { model | article = Loaded newArticle }, Cmd.none ) + ( { model | article = Loaded newArticle }, Effect.none ) CompletedFavoriteChange (Err error) -> ( { model | errors = Api.addServerError model.errors } - , Log.error + , Log.error |> Effect.fromCmd ) ClickedUnfollow cred followedAuthor -> ( model , Author.requestUnfollow followedAuthor cred |> Http.send CompletedFollowChange + |> Effect.fromCmd ) ClickedFollow cred unfollowedAuthor -> ( model , Author.requestFollow unfollowedAuthor cred |> Http.send CompletedFollowChange + |> Effect.fromCmd ) CompletedFollowChange (Ok newAuthor) -> case model.article of Loaded article -> - ( { model | article = Loaded (Article.mapAuthor (\_ -> newAuthor) article) }, Cmd.none ) + ( { model | article = Loaded (Article.mapAuthor (\_ -> newAuthor) article) }, Effect.none ) _ -> - ( model, Log.error ) + ( model, Log.error |> Effect.fromCmd ) CompletedFollowChange (Err error) -> ( { model | errors = Api.addServerError model.errors } - , Log.error + , Log.error |> Effect.fromCmd ) EnteredCommentText str -> @@ -395,11 +409,11 @@ update msg model = -- successfully, and when the comment is not currently -- being submitted. ( { model | comments = Loaded ( Editing str, comments ) } - , Cmd.none + , Effect.none ) _ -> - ( model, Log.error ) + ( model, Log.error |> Effect.fromCmd ) ClickedPostComment cred slug -> case model.comments of @@ -407,34 +421,35 @@ update msg model = -- No posting empty comments! -- We don't use Log.error here because this isn't an error, -- it just doesn't do anything. - ( model, Cmd.none ) + ( model, Effect.none ) Loaded ( Editing str, comments ) -> ( { model | comments = Loaded ( Sending str, comments ) } , cred |> Comment.post slug str |> Http.send CompletedPostComment + |> Effect.fromCmd ) _ -> -- Either we have no comment to post, or there's already -- one in the process of being posted, or we don't have -- a valid article, in which case how did we post this? - ( model, Log.error ) + ( model, Log.error |> Effect.fromCmd ) CompletedPostComment (Ok comment) -> case model.comments of Loaded ( _, comments ) -> ( { model | comments = Loaded ( Editing "", comment :: comments ) } - , Cmd.none + , Effect.none ) _ -> - ( model, Log.error ) + ( model, Log.error |> Effect.fromCmd ) CompletedPostComment (Err error) -> ( { model | errors = Api.addServerError model.errors } - , Log.error + , Log.error |> Effect.fromCmd ) ClickedDeleteComment cred slug id -> @@ -442,44 +457,41 @@ update msg model = , cred |> Comment.delete slug id |> Http.send (CompletedDeleteComment id) + |> Effect.fromCmd ) CompletedDeleteComment id (Ok ()) -> case model.comments of Loaded ( commentText, comments ) -> ( { model | comments = Loaded ( commentText, withoutComment id comments ) } - , Cmd.none + , Effect.none ) _ -> - ( model, Log.error ) + ( model, Log.error |> Effect.fromCmd ) CompletedDeleteComment id (Err error) -> ( { model | errors = Api.addServerError model.errors } - , Log.error + , Log.error |> Effect.fromCmd ) ClickedDeleteArticle cred slug -> ( model , delete slug cred |> Http.send CompletedDeleteArticle + |> Effect.fromCmd ) CompletedDeleteArticle (Ok ()) -> - ( model, Route.replaceUrl (Session.navKey model.session) Route.Home ) + ( model, Route.replaceUrl (Session.navKey session) Route.Home |> Effect.fromCmd ) CompletedDeleteArticle (Err error) -> ( { model | errors = Api.addServerError model.errors } - , Log.error + , Log.error |> Effect.fromCmd ) GotTimeZone tz -> - ( { model | timeZone = tz }, Cmd.none ) - - GotSession session -> - ( { model | session = session } - , Route.replaceUrl (Session.navKey session) Route.Home - ) + ( { model | timeZone = tz }, Effect.none ) PassedSlowLoadThreshold -> let @@ -501,7 +513,7 @@ update msg model = other -> other in - ( { model | article = article, comments = comments }, Cmd.none ) + ( { model | article = article, comments = comments }, Effect.none ) @@ -509,8 +521,8 @@ update msg model = subscriptions : Model -> Sub Msg -subscriptions model = - Session.changes GotSession (Session.navKey model.session) +subscriptions _ = + Sub.none @@ -523,24 +535,15 @@ delete slug cred = --- EXPORT - - -toSession : Model -> Session -toSession model = - model.session - - - -- INTERNAL -fave : (Slug -> Cred -> Http.Request (Article Preview)) -> Cred -> Slug -> Body -> Cmd Msg +fave : (Slug -> Cred -> Http.Request (Article Preview)) -> Cred -> Slug -> Body -> Effect Session.Msg Msg fave toRequest cred slug body = toRequest slug cred |> Http.toTask |> Task.map (Article.fromPreview body) - |> Task.attempt CompletedFavoriteChange + |> Effect.attempt CompletedFavoriteChange withoutComment : CommentId -> List Comment -> List Comment diff --git a/src/Page/Article/Editor.elm b/src/Page/Article/Editor.elm index d339cbfd26..2a39678bef 100644 --- a/src/Page/Article/Editor.elm +++ b/src/Page/Article/Editor.elm @@ -1,4 +1,4 @@ -module Page.Article.Editor exposing (Model, Msg, initEdit, initNew, subscriptions, toSession, update, view) +module Page.Article.Editor exposing (Model, Msg, page) import Api exposing (Cred) import Api.Endpoint as Endpoint @@ -6,6 +6,7 @@ import Article exposing (Article, Full) import Article.Body exposing (Body) import Article.Slug as Slug exposing (Slug) import Browser.Navigation as Nav +import Effect exposing (Effect) import Html exposing (..) import Html.Attributes exposing (attribute, class, disabled, href, id, placeholder, type_, value) import Html.Events exposing (onInput, onSubmit) @@ -17,8 +18,19 @@ import Page import Profile exposing (Profile) import Route import Session exposing (Session) +import Spa.Page import Task exposing (Task) import Time +import View exposing (View) + + +page session = + Spa.Page.element + { init = init session + , update = update session + , subscriptions = subscriptions + , view = view session + } @@ -26,8 +38,7 @@ import Time type alias Model = - { session : Session - , status : Status + { status : Status } @@ -57,10 +68,19 @@ type alias Form = } -initNew : Session -> ( Model, Cmd msg ) +init : Session -> Maybe Slug -> ( Model, Effect Session.Msg Msg ) +init session slug = + case slug of + Just s -> + initEdit session s + + Nothing -> + initNew session + + +initNew : Session -> ( Model, Effect Session.Msg Msg ) initNew session = - ( { session = session - , status = + ( { status = EditingNew [] { title = "" , body = "" @@ -68,23 +88,22 @@ initNew session = , tags = "" } } - , Cmd.none + , Effect.none ) -initEdit : Session -> Slug -> ( Model, Cmd Msg ) +initEdit : Session -> Slug -> ( Model, Effect Session.Msg Msg ) initEdit session slug = - ( { session = session - , status = Loading slug + ( { status = Loading slug } - , Cmd.batch + , Effect.batch [ Article.fetch (Session.cred session) slug |> Http.toTask -- If init fails, store the slug that failed in the msg, so we can -- at least have it later to display the page's title properly! |> Task.mapError (\httpError -> ( slug, httpError )) - |> Task.attempt CompletedArticleLoad - , Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold + |> Effect.attempt CompletedArticleLoad + , Effect.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold ] ) @@ -93,8 +112,8 @@ initEdit session slug = -- VIEW -view : Model -> { title : String, content : Html Msg } -view model = +view : Session -> Model -> View Msg +view session model = { title = case getSlug model.status of Just slug -> @@ -102,8 +121,15 @@ view model = Nothing -> "New Article" + , page = + case getSlug model.status of + Just slug -> + Page.Other + + Nothing -> + Page.NewArticle , content = - case Session.cred model.session of + case Session.cred session of Just cred -> viewAuthenticated cred model @@ -247,12 +273,11 @@ type Msg | CompletedCreate (Result Http.Error (Article Full)) | CompletedEdit (Result Http.Error (Article Full)) | CompletedArticleLoad (Result ( Slug, Http.Error ) (Article Full)) - | GotSession Session | PassedSlowLoadThreshold -update : Msg -> Model -> ( Model, Cmd Msg ) -update msg model = +update : Session -> Msg -> Model -> ( Model, Effect Session.Msg Msg ) +update session msg model = case msg of ClickedSave cred -> model.status @@ -274,28 +299,30 @@ update msg model = CompletedCreate (Ok article) -> ( model , Route.Article (Article.slug article) - |> Route.replaceUrl (Session.navKey model.session) + |> Route.replaceUrl (Session.navKey session) + |> Effect.fromCmd ) CompletedCreate (Err error) -> ( { model | status = savingError error model.status } - , Cmd.none + , Effect.none ) CompletedEdit (Ok article) -> ( model , Route.Article (Article.slug article) - |> Route.replaceUrl (Session.navKey model.session) + |> Route.replaceUrl (Session.navKey session) + |> Effect.fromCmd ) CompletedEdit (Err error) -> ( { model | status = savingError error model.status } - , Cmd.none + , Effect.none ) CompletedArticleLoad (Err ( slug, error )) -> ( { model | status = LoadingFailed slug } - , Cmd.none + , Effect.none ) CompletedArticleLoad (Ok article) -> @@ -313,12 +340,7 @@ update msg model = } in ( { model | status = status } - , Cmd.none - ) - - GotSession session -> - ( { model | session = session } - , Route.replaceUrl (Session.navKey session) Route.Home + , Effect.none ) PassedSlowLoadThreshold -> @@ -333,10 +355,10 @@ update msg model = other -> other in - ( { model | status = status }, Cmd.none ) + ( { model | status = status }, Effect.none ) -save : Cred -> Status -> ( Status, Cmd Msg ) +save : Cred -> Status -> ( Status, Effect Session.Msg Msg ) save cred status = case status of Editing slug _ form -> @@ -345,11 +367,12 @@ save cred status = ( Saving slug form , edit slug validForm cred |> Http.send CompletedEdit + |> Effect.fromCmd ) Err problems -> ( Editing slug problems form - , Cmd.none + , Effect.none ) EditingNew _ form -> @@ -358,11 +381,12 @@ save cred status = ( Creating form , create validForm cred |> Http.send CompletedCreate + |> Effect.fromCmd ) Err problems -> ( EditingNew problems form - , Cmd.none + , Effect.none ) _ -> @@ -372,7 +396,7 @@ save cred status = -- -- If we had an error logging service, we would send -- something to it here! - ( status, Cmd.none ) + ( status, Effect.none ) savingError : Http.Error -> Status -> Status @@ -393,7 +417,7 @@ savingError error status = {-| Helper function for `update`. Updates the form, if there is one, -and returns Cmd.none. +and returns Effect.none. Useful for recording form fields! @@ -401,7 +425,7 @@ This could also log errors to the server if we are trying to record things in the form and we don't actually have a form. -} -updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg ) +updateForm : (Form -> Form) -> Model -> ( Model, Effect Session.Msg Msg ) updateForm transform model = let newModel = @@ -427,7 +451,7 @@ updateForm transform model = Creating form -> { model | status = Creating (transform form) } in - ( newModel, Cmd.none ) + ( newModel, Effect.none ) @@ -435,8 +459,8 @@ updateForm transform model = subscriptions : Model -> Sub Msg -subscriptions model = - Session.changes GotSession (Session.navKey model.session) +subscriptions _ = + Sub.none @@ -561,15 +585,6 @@ edit articleSlug (Trimmed form) cred = --- EXPORT - - -toSession : Model -> Session -toSession model = - model.session - - - -- INTERNAL diff --git a/src/Page/Home.elm b/src/Page/Home.elm index 9008a8311c..ce3ff64daf 100644 --- a/src/Page/Home.elm +++ b/src/Page/Home.elm @@ -1,4 +1,4 @@ -module Page.Home exposing (Model, Msg, init, subscriptions, toSession, update, view) +module Page.Home exposing (Model, Msg, page) {-| The homepage. You can get here via either the / or /#/ routes. -} @@ -9,6 +9,7 @@ import Article exposing (Article, Preview) import Article.Feed as Feed import Article.Tag as Tag exposing (Tag) import Browser.Dom as Dom +import Effect exposing (Effect) import Html exposing (..) import Html.Attributes exposing (attribute, class, classList, href, id, placeholder) import Html.Events exposing (onClick) @@ -18,10 +19,21 @@ import Log import Page import PaginatedList exposing (PaginatedList) import Session exposing (Session) +import Spa.Page import Task exposing (Task) import Time import Url.Builder import Username exposing (Username) +import View exposing (View) + + +page session = + Spa.Page.element + { init = init session + , update = update session + , subscriptions = subscriptions + , view = view session + } @@ -29,8 +41,7 @@ import Username exposing (Username) type alias Model = - { session : Session - , timeZone : Time.Zone + { timeZone : Time.Zone , feedTab : FeedTab , feedPage : Int @@ -53,8 +64,8 @@ type FeedTab | TagFeed Tag -init : Session -> ( Model, Cmd Msg ) -init session = +init : Session -> () -> ( Model, Effect Session.Msg Msg ) +init session _ = let feedTab = case Session.cred session of @@ -67,20 +78,20 @@ init session = loadTags = Http.toTask Tag.list in - ( { session = session - , timeZone = Time.utc + ( { timeZone = Time.utc , feedTab = feedTab , feedPage = 1 , tags = Loading , feed = Loading } - , Cmd.batch + , Effect.batch [ fetchFeed session feedTab 1 - |> Task.attempt CompletedFeedLoad + |> Effect.attempt CompletedFeedLoad , Tag.list |> Http.send CompletedTagsLoad - , Task.perform GotTimeZone Time.here - , Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold + |> Effect.fromCmd + , Effect.perform GotTimeZone Time.here + , Effect.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold ] ) @@ -89,9 +100,10 @@ init session = -- VIEW -view : Model -> { title : String, content : Html Msg } -view model = +view : Session -> Model -> View Msg +view session model = { title = "Conduit" + , page = Page.Home , content = div [ class "home-page" ] [ viewBanner @@ -103,7 +115,7 @@ view model = [ div [ class "feed-toggle" ] <| List.concat [ [ viewTabs - (Session.cred model.session) + (Session.cred session) model.feedTab ] , Feed.viewArticles model.timeZone feed @@ -236,12 +248,11 @@ type Msg | CompletedTagsLoad (Result Http.Error (List Tag)) | GotTimeZone Time.Zone | GotFeedMsg Feed.Msg - | GotSession Session | PassedSlowLoadThreshold -update : Msg -> Model -> ( Model, Cmd Msg ) -update msg model = +update : Session -> Msg -> Model -> ( Model, Effect Session.Msg Msg ) +update session msg model = case msg of ClickedTag tag -> let @@ -249,35 +260,35 @@ update msg model = TagFeed tag in ( { model | feedTab = feedTab } - , fetchFeed model.session feedTab 1 - |> Task.attempt CompletedFeedLoad + , fetchFeed session feedTab 1 + |> Effect.attempt CompletedFeedLoad ) ClickedTab tab -> ( { model | feedTab = tab } - , fetchFeed model.session tab 1 - |> Task.attempt CompletedFeedLoad + , fetchFeed session tab 1 + |> Effect.attempt CompletedFeedLoad ) - ClickedFeedPage page -> - ( { model | feedPage = page } - , fetchFeed model.session model.feedTab page + ClickedFeedPage feedPage -> + ( { model | feedPage = feedPage } + , fetchFeed session model.feedTab feedPage |> Task.andThen (\feed -> Task.map (\_ -> feed) scrollToTop) - |> Task.attempt CompletedFeedLoad + |> Effect.attempt CompletedFeedLoad ) CompletedFeedLoad (Ok feed) -> - ( { model | feed = Loaded feed }, Cmd.none ) + ( { model | feed = Loaded feed }, Effect.none ) CompletedFeedLoad (Err error) -> - ( { model | feed = Failed }, Cmd.none ) + ( { model | feed = Failed }, Effect.none ) CompletedTagsLoad (Ok tags) -> - ( { model | tags = Loaded tags }, Cmd.none ) + ( { model | tags = Loaded tags }, Effect.none ) CompletedTagsLoad (Err error) -> ( { model | tags = Failed } - , Log.error + , Log.error |> Effect.fromCmd ) GotFeedMsg subMsg -> @@ -285,26 +296,23 @@ update msg model = Loaded feed -> let ( newFeed, subCmd ) = - Feed.update (Session.cred model.session) subMsg feed + Feed.update (Session.cred session) subMsg feed in ( { model | feed = Loaded newFeed } - , Cmd.map GotFeedMsg subCmd + , Cmd.map GotFeedMsg subCmd |> Effect.fromCmd ) Loading -> - ( model, Log.error ) + ( model, Log.error |> Effect.fromCmd ) LoadingSlowly -> - ( model, Log.error ) + ( model, Log.error |> Effect.fromCmd ) Failed -> - ( model, Log.error ) + ( model, Log.error |> Effect.fromCmd ) GotTimeZone tz -> - ( { model | timeZone = tz }, Cmd.none ) - - GotSession session -> - ( { model | session = session }, Cmd.none ) + ( { model | timeZone = tz }, Effect.none ) PassedSlowLoadThreshold -> let @@ -326,7 +334,7 @@ update msg model = other -> other in - ( { model | feed = feed, tags = tags }, Cmd.none ) + ( { model | feed = feed, tags = tags }, Effect.none ) @@ -334,7 +342,7 @@ update msg model = fetchFeed : Session -> FeedTab -> Int -> Task Http.Error Feed.Model -fetchFeed session feedTabs page = +fetchFeed session feedTabs feedPage = let maybeCred = Session.cred session @@ -343,7 +351,7 @@ fetchFeed session feedTabs page = Feed.decoder maybeCred articlesPerPage params = - PaginatedList.params { page = page, resultsPerPage = articlesPerPage } + PaginatedList.params { page = feedPage, resultsPerPage = articlesPerPage } request = case feedTabs of @@ -382,14 +390,5 @@ scrollToTop = subscriptions : Model -> Sub Msg -subscriptions model = - Session.changes GotSession (Session.navKey model.session) - - - --- EXPORT - - -toSession : Model -> Session -toSession model = - model.session +subscriptions _ = + Sub.none diff --git a/src/Page/Login.elm b/src/Page/Login.elm index 31bab51450..cfcd50c74e 100644 --- a/src/Page/Login.elm +++ b/src/Page/Login.elm @@ -1,10 +1,11 @@ -module Page.Login exposing (Model, Msg, init, subscriptions, toSession, update, view) +module Page.Login exposing (Model, Msg, page) {-| The login page. -} import Api exposing (Cred) import Browser.Navigation as Nav +import Effect exposing (Effect) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) @@ -12,18 +13,29 @@ import Http import Json.Decode as Decode exposing (Decoder, decodeString, field, string) import Json.Decode.Pipeline exposing (optional) import Json.Encode as Encode +import Page import Route exposing (Route) import Session exposing (Session) +import Spa.Page +import View exposing (View) import Viewer exposing (Viewer) +page session = + Spa.Page.element + { init = init session + , update = update + , subscriptions = subscriptions + , view = view + } + + -- MODEL type alias Model = - { session : Session - , problems : List Problem + { problems : List Problem , form : Form } @@ -63,16 +75,15 @@ type alias Form = } -init : Session -> ( Model, Cmd msg ) -init session = - ( { session = session - , problems = [] +init : Session -> () -> ( Model, Effect Session.Msg msg ) +init session _ = + ( { problems = [] , form = { email = "" , password = "" } } - , Cmd.none + , Effect.none ) @@ -80,9 +91,10 @@ init session = -- VIEW -view : Model -> { title : String, content : Html Msg } +view : Model -> View Msg view model = { title = "Login" + , page = Page.Login , content = div [ class "cred-page" ] [ div [ class "container page" ] @@ -153,10 +165,9 @@ type Msg | EnteredEmail String | EnteredPassword String | CompletedLogin (Result Http.Error Viewer) - | GotSession Session -update : Msg -> Model -> ( Model, Cmd Msg ) +update : Msg -> Model -> ( Model, Effect Session.Msg Msg ) update msg model = case msg of SubmittedForm -> @@ -164,11 +175,12 @@ update msg model = Ok validForm -> ( { model | problems = [] } , Http.send CompletedLogin (login validForm) + |> Effect.fromCmd ) Err problems -> ( { model | problems = problems } - , Cmd.none + , Effect.none ) EnteredEmail email -> @@ -184,26 +196,22 @@ update msg model = |> List.map ServerError in ( { model | problems = List.append model.problems serverErrors } - , Cmd.none + , Effect.none ) CompletedLogin (Ok viewer) -> ( model , Viewer.store viewer - ) - - GotSession session -> - ( { model | session = session } - , Route.replaceUrl (Session.navKey session) Route.Home + |> Effect.fromCmd ) {-| Helper function for `update`. Updates the form and returns Cmd.none. Useful for recording form fields! -} -updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg ) +updateForm : (Form -> Form) -> Model -> ( Model, Effect Session.Msg Msg ) updateForm transform model = - ( { model | form = transform model.form }, Cmd.none ) + ( { model | form = transform model.form }, Effect.none ) @@ -211,8 +219,8 @@ updateForm transform model = subscriptions : Model -> Sub Msg -subscriptions model = - Session.changes GotSession (Session.navKey model.session) +subscriptions _ = + Sub.none @@ -304,12 +312,3 @@ login (Trimmed form) = |> Http.jsonBody in Api.login body Viewer.decoder - - - --- EXPORT - - -toSession : Model -> Session -toSession model = - model.session diff --git a/src/Page/Logout.elm b/src/Page/Logout.elm new file mode 100644 index 0000000000..e60802eafa --- /dev/null +++ b/src/Page/Logout.elm @@ -0,0 +1,49 @@ +module Page.Logout exposing (Model, Msg, page) + +import Api +import Effect exposing (Effect) +import Html +import Page +import Session exposing (Session) +import Spa.Page +import View exposing (View) + + +page session = + Spa.Page.element + { init = init + , update = update + , subscriptions = subscriptions + , view = view + } + + +type alias Model = + () + + +type alias Msg = + () + + +init : () -> ( Model, Effect Session.Msg Msg ) +init _ = + ( (), Effect.fromCmd Api.logout ) + + +update : Msg -> Model -> ( Model, Effect Session.Msg Msg ) +update _ model = + ( model, Effect.none ) + + +subscriptions : Model -> Sub Msg +subscriptions _ = + Sub.none + + +view : Model -> View Msg +view _ = + { title = "Logout" + , page = Page.Other + , content = Html.text "Logout in progress" + } diff --git a/src/Page/Profile.elm b/src/Page/Profile.elm index 906b5270d2..be95f0746a 100644 --- a/src/Page/Profile.elm +++ b/src/Page/Profile.elm @@ -1,4 +1,4 @@ -module Page.Profile exposing (Model, Msg, init, subscriptions, toSession, update, view) +module Page.Profile exposing (Model, Msg, page) {-| An Author's profile. -} @@ -9,6 +9,7 @@ import Article exposing (Article, Preview) import Article.Feed as Feed import Author exposing (Author(..), FollowedAuthor, UnfollowedAuthor) import Avatar exposing (Avatar) +import Effect exposing (Effect) import Html exposing (..) import Html.Attributes exposing (..) import Http @@ -19,23 +20,34 @@ import PaginatedList exposing (PaginatedList) import Profile exposing (Profile) import Route import Session exposing (Session) +import Spa.Page import Task exposing (Task) import Time import Url.Builder import Username exposing (Username) +import View exposing (View) import Viewer exposing (Viewer) +page session = + Spa.Page.element + { init = init session + , update = update session + , subscriptions = subscriptions + , view = view session + } + + -- MODEL type alias Model = - { session : Session - , timeZone : Time.Zone + { timeZone : Time.Zone , errors : List String , feedTab : FeedTab , feedPage : Int + , username : Username -- Loaded independently from server , author : Status Author @@ -55,28 +67,28 @@ type Status a | Failed Username -init : Session -> Username -> ( Model, Cmd Msg ) +init : Session -> Username -> ( Model, Effect Session.Msg Msg ) init session username = let maybeCred = Session.cred session in - ( { session = session - , timeZone = Time.utc + ( { timeZone = Time.utc , errors = [] , feedTab = defaultFeedTab , feedPage = 1 + , username = username , author = Loading username , feed = Loading username } - , Cmd.batch + , Effect.batch [ Author.fetch username maybeCred |> Http.toTask |> Task.mapError (Tuple.pair username) - |> Task.attempt CompletedAuthorLoad + |> Effect.attempt CompletedAuthorLoad , fetchFeed session defaultFeedTab username 1 - , Task.perform GotTimeZone Time.here - , Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold + , Effect.perform GotTimeZone Time.here + , Effect.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold ] ) @@ -106,8 +118,8 @@ defaultFeedTab = -- HTTP -fetchFeed : Session -> FeedTab -> Username -> Int -> Cmd Msg -fetchFeed session feedTabs username page = +fetchFeed : Session -> FeedTab -> Username -> Int -> Effect Session.Msg Msg +fetchFeed session feedTabs username feedPage = let maybeCred = Session.cred session @@ -121,7 +133,7 @@ fetchFeed session feedTabs username page = Url.Builder.string "favorited" (Username.toString username) params = - firstParam :: PaginatedList.params { page = page, resultsPerPage = articlesPerPage } + firstParam :: PaginatedList.params { page = feedPage, resultsPerPage = articlesPerPage } expect = Feed.decoder maybeCred articlesPerPage @@ -130,7 +142,7 @@ fetchFeed session feedTabs username page = |> Http.toTask |> Task.map (Feed.init session) |> Task.mapError (Tuple.pair username) - |> Task.attempt CompletedFeedLoad + |> Effect.attempt CompletedFeedLoad articlesPerPage : Int @@ -142,8 +154,8 @@ articlesPerPage = -- VIEW -view : Model -> { title : String, content : Html Msg } -view model = +view : Session -> Model -> View Msg +view session model = let title = case model.author of @@ -157,15 +169,16 @@ view model = titleForOther (Author.username author) Loading username -> - titleForMe (Session.cred model.session) username + titleForMe (Session.cred session) username LoadingSlowly username -> - titleForMe (Session.cred model.session) username + titleForMe (Session.cred session) username Failed username -> - titleForMe (Session.cred model.session) username + titleForMe (Session.cred session) username in { title = title + , page = Page.Profile model.username , content = case model.author of Loaded author -> @@ -177,7 +190,7 @@ view model = Author.username author followButton = - case Session.cred model.session of + case Session.cred session of Just cred -> case author of IsViewer _ _ -> @@ -195,7 +208,7 @@ view model = text "" in div [ class "profile-page" ] - [ Page.viewErrors ClickedDismissErrors model.errors + [ View.viewErrors ClickedDismissErrors model.errors , div [ class "user-info" ] [ div [ class "container" ] [ div [ class "row" ] @@ -317,64 +330,65 @@ type Msg | CompletedFeedLoad (Result ( Username, Http.Error ) Feed.Model) | GotTimeZone Time.Zone | GotFeedMsg Feed.Msg - | GotSession Session | PassedSlowLoadThreshold -update : Msg -> Model -> ( Model, Cmd Msg ) -update msg model = +update : Session -> Msg -> Model -> ( Model, Effect Session.Msg Msg ) +update session msg model = case msg of ClickedDismissErrors -> - ( { model | errors = [] }, Cmd.none ) + ( { model | errors = [] }, Effect.none ) ClickedUnfollow cred followedAuthor -> ( model , Author.requestUnfollow followedAuthor cred |> Http.send CompletedFollowChange + |> Effect.fromCmd ) ClickedFollow cred unfollowedAuthor -> ( model , Author.requestFollow unfollowedAuthor cred |> Http.send CompletedFollowChange + |> Effect.fromCmd ) ClickedTab tab -> ( { model | feedTab = tab } - , fetchFeed model.session tab (currentUsername model) 1 + , fetchFeed session tab (currentUsername model) 1 ) - ClickedFeedPage page -> - ( { model | feedPage = page } - , fetchFeed model.session model.feedTab (currentUsername model) page + ClickedFeedPage feedPage -> + ( { model | feedPage = feedPage } + , fetchFeed session model.feedTab (currentUsername model) feedPage ) CompletedFollowChange (Ok newAuthor) -> ( { model | author = Loaded newAuthor } - , Cmd.none + , Effect.none ) CompletedFollowChange (Err error) -> ( model - , Log.error + , Log.error |> Effect.fromCmd ) CompletedAuthorLoad (Ok author) -> - ( { model | author = Loaded author }, Cmd.none ) + ( { model | author = Loaded author }, Effect.none ) CompletedAuthorLoad (Err ( username, err )) -> ( { model | author = Failed username } - , Log.error + , Log.error |> Effect.fromCmd ) CompletedFeedLoad (Ok feed) -> ( { model | feed = Loaded feed } - , Cmd.none + , Effect.none ) CompletedFeedLoad (Err ( username, err )) -> ( { model | feed = Failed username } - , Log.error + , Log.error |> Effect.fromCmd ) GotFeedMsg subMsg -> @@ -382,28 +396,24 @@ update msg model = Loaded feed -> let ( newFeed, subCmd ) = - Feed.update (Session.cred model.session) subMsg feed + Feed.update (Session.cred session) subMsg feed in ( { model | feed = Loaded newFeed } , Cmd.map GotFeedMsg subCmd + |> Effect.fromCmd ) Loading _ -> - ( model, Log.error ) + ( model, Log.error |> Effect.fromCmd ) LoadingSlowly _ -> - ( model, Log.error ) + ( model, Log.error |> Effect.fromCmd ) Failed _ -> - ( model, Log.error ) + ( model, Log.error |> Effect.fromCmd ) GotTimeZone tz -> - ( { model | timeZone = tz }, Cmd.none ) - - GotSession session -> - ( { model | session = session } - , Route.replaceUrl (Session.navKey session) Route.Home - ) + ( { model | timeZone = tz }, Effect.none ) PassedSlowLoadThreshold -> let @@ -417,7 +427,7 @@ update msg model = other -> other in - ( { model | feed = feed }, Cmd.none ) + ( { model | feed = feed }, Effect.none ) @@ -425,14 +435,5 @@ update msg model = subscriptions : Model -> Sub Msg -subscriptions model = - Session.changes GotSession (Session.navKey model.session) - - - --- EXPORT - - -toSession : Model -> Session -toSession model = - model.session +subscriptions _ = + Sub.none diff --git a/src/Page/Register.elm b/src/Page/Register.elm index f1078e9329..d0adac1761 100644 --- a/src/Page/Register.elm +++ b/src/Page/Register.elm @@ -1,7 +1,8 @@ -module Page.Register exposing (Model, Msg, init, subscriptions, toSession, update, view) +module Page.Register exposing (Model, Msg, page) import Api exposing (Cred) import Browser.Navigation as Nav +import Effect exposing (Effect) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) @@ -9,18 +10,29 @@ import Http import Json.Decode as Decode exposing (Decoder, decodeString, field, string) import Json.Decode.Pipeline exposing (optional) import Json.Encode as Encode +import Page import Route exposing (Route) import Session exposing (Session) +import Spa.Page +import View exposing (View) import Viewer exposing (Viewer) +page session = + Spa.Page.element + { init = init session + , update = update + , subscriptions = subscriptions + , view = view + } + + -- MODEL type alias Model = - { session : Session - , problems : List Problem + { problems : List Problem , form : Form } @@ -37,17 +49,16 @@ type Problem | ServerError String -init : Session -> ( Model, Cmd msg ) -init session = - ( { session = session - , problems = [] +init : Session -> () -> ( Model, Effect Session.Msg msg ) +init session _ = + ( { problems = [] , form = { email = "" , username = "" , password = "" } } - , Cmd.none + , Effect.none ) @@ -55,9 +66,10 @@ init session = -- VIEW -view : Model -> { title : String, content : Html Msg } +view : Model -> View Msg view model = { title = "Register" + , page = Page.Register , content = div [ class "cred-page" ] [ div [ class "container page" ] @@ -138,10 +150,9 @@ type Msg | EnteredUsername String | EnteredPassword String | CompletedRegister (Result Http.Error Viewer) - | GotSession Session -update : Msg -> Model -> ( Model, Cmd Msg ) +update : Msg -> Model -> ( Model, Effect Session.Msg Msg ) update msg model = case msg of SubmittedForm -> @@ -149,11 +160,12 @@ update msg model = Ok validForm -> ( { model | problems = [] } , Http.send CompletedRegister (register validForm) + |> Effect.fromCmd ) Err problems -> ( { model | problems = problems } - , Cmd.none + , Effect.none ) EnteredUsername username -> @@ -172,26 +184,22 @@ update msg model = |> List.map ServerError in ( { model | problems = List.append model.problems serverErrors } - , Cmd.none + , Effect.none ) CompletedRegister (Ok viewer) -> ( model , Viewer.store viewer - ) - - GotSession session -> - ( { model | session = session } - , Route.replaceUrl (Session.navKey session) Route.Home + |> Effect.fromCmd ) {-| Helper function for `update`. Updates the form and returns Cmd.none. Useful for recording form fields! -} -updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg ) +updateForm : (Form -> Form) -> Model -> ( Model, Effect Session.Msg Msg ) updateForm transform model = - ( { model | form = transform model.form }, Cmd.none ) + ( { model | form = transform model.form }, Effect.none ) @@ -199,17 +207,8 @@ updateForm transform model = subscriptions : Model -> Sub Msg -subscriptions model = - Session.changes GotSession (Session.navKey model.session) - - - --- EXPORT - - -toSession : Model -> Session -toSession model = - model.session +subscriptions _ = + Sub.none diff --git a/src/Page/Settings.elm b/src/Page/Settings.elm index dc188a905d..b4a6548294 100644 --- a/src/Page/Settings.elm +++ b/src/Page/Settings.elm @@ -1,9 +1,10 @@ -module Page.Settings exposing (Model, Msg, init, subscriptions, toSession, update, view) +module Page.Settings exposing (Model, Msg, page) import Api exposing (Cred) import Api.Endpoint as Endpoint import Avatar import Browser.Navigation as Nav +import Effect exposing (Effect) import Email exposing (Email) import Html exposing (Html, button, div, fieldset, h1, input, li, text, textarea, ul) import Html.Attributes exposing (attribute, class, placeholder, type_, value) @@ -14,21 +15,32 @@ import Json.Decode.Pipeline exposing (hardcoded, required) import Json.Encode as Encode import Loading import Log +import Page import Profile exposing (Profile) import Route import Session exposing (Session) +import Spa.Page import Task import Username as Username exposing (Username) +import View exposing (View) import Viewer exposing (Viewer) +page session = + Spa.Page.element + { init = init session + , update = update + , subscriptions = subscriptions + , view = view session + } + + -- MODEL type alias Model = - { session : Session - , problems : List Problem + { problems : List Problem , status : Status } @@ -54,16 +66,16 @@ type Problem | ServerError String -init : Session -> ( Model, Cmd Msg ) -init session = - ( { session = session - , problems = [] +init : Session -> () -> ( Model, Effect Session.Msg Msg ) +init session _ = + ( { problems = [] , status = Loading } - , Cmd.batch + , Effect.batch [ Api.get Endpoint.user (Session.cred session) (Decode.field "user" formDecoder) |> Http.send CompletedFormLoad - , Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold + |> Effect.fromCmd + , Effect.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold ] ) @@ -94,11 +106,12 @@ type ValidForm -- VIEW -view : Model -> { title : String, content : Html Msg } -view model = +view : Session -> Model -> View Msg +view session model = { title = "Settings" + , page = Page.Settings , content = - case Session.cred model.session of + case Session.cred session of Just cred -> div [ class "settings-page" ] [ div [ class "container page" ] @@ -214,21 +227,20 @@ type Msg | EnteredAvatar String | CompletedFormLoad (Result Http.Error Form) | CompletedSave (Result Http.Error Viewer) - | GotSession Session | PassedSlowLoadThreshold -update : Msg -> Model -> ( Model, Cmd Msg ) +update : Msg -> Model -> ( Model, Effect Session.Msg Msg ) update msg model = case msg of CompletedFormLoad (Ok form) -> ( { model | status = Loaded form } - , Cmd.none + , Effect.none ) CompletedFormLoad (Err _) -> ( { model | status = Failed } - , Cmd.none + , Effect.none ) SubmittedForm cred form -> @@ -237,11 +249,12 @@ update msg model = ( { model | status = Loaded form } , edit cred validForm |> Http.send CompletedSave + |> Effect.fromCmd ) Err problems -> ( { model | problems = problems } - , Cmd.none + , Effect.none ) EnteredEmail email -> @@ -266,41 +279,37 @@ update msg model = |> List.map ServerError in ( { model | problems = List.append model.problems serverErrors } - , Cmd.none + , Effect.none ) CompletedSave (Ok viewer) -> ( model , Viewer.store viewer - ) - - GotSession session -> - ( { model | session = session } - , Route.replaceUrl (Session.navKey session) Route.Home + |> Effect.fromCmd ) PassedSlowLoadThreshold -> case model.status of Loading -> ( { model | status = LoadingSlowly } - , Cmd.none + , Effect.none ) _ -> - ( model, Cmd.none ) + ( model, Effect.none ) {-| Helper function for `update`. Updates the form and returns Cmd.none. Useful for recording form fields! -} -updateForm : (Form -> Form) -> Model -> ( Model, Cmd msg ) +updateForm : (Form -> Form) -> Model -> ( Model, Effect Session.Msg msg ) updateForm transform model = case model.status of Loaded form -> - ( { model | status = Loaded (transform form) }, Cmd.none ) + ( { model | status = Loaded (transform form) }, Effect.none ) _ -> - ( model, Log.error ) + ( model, Log.error |> Effect.fromCmd ) @@ -309,16 +318,7 @@ updateForm transform model = subscriptions : Model -> Sub Msg subscriptions model = - Session.changes GotSession (Session.navKey model.session) - - - --- EXPORT - - -toSession : Model -> Session -toSession model = - model.session + Sub.none diff --git a/src/Route.elm b/src/Route.elm index 03568fbb4d..6adad2e59b 100644 --- a/src/Route.elm +++ b/src/Route.elm @@ -1,4 +1,4 @@ -module Route exposing (Route(..), fromUrl, href, replaceUrl) +module Route exposing (Route(..), fromUrl, href, matchArticle, matchEditor, matchHome, matchLogin, matchLogout, matchProfile, matchRegister, matchSettings, replaceUrl, toString) import Article.Slug as Slug exposing (Slug) import Browser.Navigation as Nav @@ -65,6 +65,11 @@ fromUrl url = |> Parser.parse parser +toString : Route -> String +toString = + routeToString + + -- INTERNAL @@ -106,3 +111,74 @@ routeToPieces page = EditArticle slug -> [ "editor", Slug.toString slug ] + + + +-- Route Matchers + + +matchBasic : Route -> Route -> Maybe () +matchBasic route value = + if value == route then + Just () + + else + Nothing + + +matchHome : Route -> Maybe () +matchHome = + matchBasic Home + + +matchSettings : Route -> Maybe () +matchSettings = + matchBasic Settings + + +matchLogin : Route -> Maybe () +matchLogin = + matchBasic Login + + +matchProfile : Route -> Maybe Username +matchProfile route = + case route of + Profile username -> + Just username + + _ -> + Nothing + + +matchRegister : Route -> Maybe () +matchRegister = + matchBasic Register + + +matchArticle : Route -> Maybe Slug +matchArticle route = + case route of + Article slug -> + Just slug + + _ -> + Nothing + + +matchEditor : Route -> Maybe (Maybe Slug) +matchEditor route = + case route of + NewArticle -> + Just Nothing + + EditArticle slug -> + Just (Just slug) + + _ -> + Nothing + + +matchLogout : Route -> Maybe () +matchLogout = + matchBasic Logout diff --git a/src/Session.elm b/src/Session.elm index 8b5436e504..c3d7f0e553 100644 --- a/src/Session.elm +++ b/src/Session.elm @@ -1,13 +1,16 @@ -module Session exposing (Session, changes, cred, fromViewer, navKey, viewer) +module Session exposing (Msg(..), Session, changes, cred, fromViewer, init, navKey, subscriptions, update, viewer) import Api exposing (Cred) import Avatar exposing (Avatar) +import Browser import Browser.Navigation as Nav import Json.Decode as Decode exposing (Decoder) import Json.Decode.Pipeline exposing (custom, required) import Json.Encode as Encode exposing (Value) import Profile exposing (Profile) +import Route import Time +import Url import Viewer exposing (Viewer) @@ -20,6 +23,60 @@ type Session | Guest Nav.Key +type Msg + = GotSession Session + | ClickedLink Browser.UrlRequest + + +init : Value -> Nav.Key -> ( Session, Cmd Msg ) +init flags key = + ( Decode.decodeValue Decode.string flags + |> Result.andThen (Decode.decodeString (Api.storageDecoder Viewer.decoder)) + |> Result.toMaybe + |> fromViewer key + , Cmd.none + ) + + +update : Msg -> Session -> ( Session, Cmd Msg ) +update msg session = + case msg of + GotSession newSession -> + ( newSession + , Route.replaceUrl (navKey session) Route.Home + ) + + ClickedLink urlRequest -> + case urlRequest of + Browser.Internal url -> + case url.fragment of + Nothing -> + -- If we got a link that didn't include a fragment, + -- it's from one of those (href "") attributes that + -- we have to include to make the RealWorld CSS work. + -- + -- In an application doing path routing instead of + -- fragment-based routing, this entire + -- `case url.fragment of` expression this comment + -- is inside would be unnecessary. + ( session, Cmd.none ) + + Just _ -> + ( session + , Nav.pushUrl (navKey session) (Url.toString url) + ) + + Browser.External href -> + ( session + , Nav.load href + ) + + +subscriptions : Session -> Sub Msg +subscriptions session = + changes GotSession (navKey session) + + -- INFO diff --git a/src/View.elm b/src/View.elm new file mode 100644 index 0000000000..e0ab040743 --- /dev/null +++ b/src/View.elm @@ -0,0 +1,163 @@ +module View exposing (..) + +import Api exposing (Cred) +import Avatar +import Browser exposing (Document) +import Html exposing (Html, a, button, div, footer, i, img, li, nav, p, span, text, ul) +import Html.Attributes exposing (class, classList, href, style) +import Html.Events exposing (onClick) +import Page exposing (Page(..)) +import Profile +import Route exposing (Route) +import Session exposing (Session) +import Username exposing (Username) +import Viewer exposing (Viewer) + + +type alias View msg = + { title : String + , page : Page + , content : Html msg + } + + +map : (msg -> msg1) -> View msg -> View msg1 +map fn v = + { title = v.title + , page = v.page + , content = Html.map fn v.content + } + + +default : View msg +default = + { title = "" + , page = Page.Other + , content = Html.text "" + } + + +{-| Take a page's Html and frames 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.) + +-} +view : Maybe Viewer -> View msg -> Document msg +view maybeViewer { title, page, content } = + { title = title ++ " - Conduit" + , body = viewHeader page maybeViewer :: content :: [ viewFooter ] + } + + +viewHeader : Page -> Maybe Viewer -> Html msg +viewHeader page maybeViewer = + 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" ] <| + navbarLink page Route.Home [ text "Home" ] + :: viewMenu page maybeViewer + ] + ] + + +viewMenu : Page -> Maybe Viewer -> List (Html msg) +viewMenu page maybeViewer = + let + linkTo = + navbarLink page + in + case maybeViewer of + Just viewer -> + let + username = + Viewer.username viewer + + avatar = + Viewer.avatar viewer + in + [ linkTo Route.NewArticle [ i [ class "ion-compose" ] [], text "\u{00A0}New Post" ] + , linkTo Route.Settings [ i [ class "ion-gear-a" ] [], text "\u{00A0}Settings" ] + , linkTo + (Route.Profile username) + [ img [ class "user-pic", Avatar.src avatar ] [] + , Username.toHtml username + ] + , linkTo Route.Logout [ text "Sign out" ] + ] + + Nothing -> + [ linkTo Route.Login [ text "Sign in" ] + , linkTo Route.Register [ text "Sign up" ] + ] + + +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 : Page -> 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 : Page -> 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 + + +{-| Render dismissable errors. We use this all over the place! +-} +viewErrors : msg -> List String -> Html msg +viewErrors dismissErrors errors = + if List.isEmpty errors then + Html.text "" + + else + div + [ class "error-messages" + , style "position" "fixed" + , style "top" "0" + , style "background" "rgb(250, 250, 250)" + , style "padding" "20px" + , style "border" "1px solid" + ] + <| + List.map (\error -> p [] [ text error ]) errors + ++ [ button [ onClick dismissErrors ] [ text "Ok" ] ]