diff --git a/public/style.css b/public/style.css index 093febc..c5a752e 100644 --- a/public/style.css +++ b/public/style.css @@ -92,12 +92,29 @@ body { margin-top: 2px; } -.username { +.status .username, +.current-user .username { font-weight: bold; margin-left: 65px; margin-bottom: 4px; } +.follow-entry { + min-height: 38px; +} + +.follow-entry .avatar { + width: 38px; + height: 38px; +} +.follow-entry .username { + font-weight: normal; + font-size: 97%; + margin-left: 50px; + overflow: hidden; + text-overflow: ellipsis; +} + .acct { font-size: 97%; font-weight: normal; @@ -334,6 +351,17 @@ body { padding: 15px; } +.account-infos a { + color: #c8c8c8; +} + +.account-infos a:hover, +.account-infos a:focus, +.account-infos a:active { + text-decoration: none; + color: #fff; +} + /* Viewer */ .viewer { diff --git a/src/Command.elm b/src/Command.elm new file mode 100644 index 0000000..20ef06d --- /dev/null +++ b/src/Command.elm @@ -0,0 +1,231 @@ +module Command + exposing + ( initCommands + , navigateToAuthUrl + , registerApp + , saveClient + , saveRegistration + , loadNotifications + , loadUserAccount + , loadAccount + , loadAccountInfo + , loadThread + , loadTimelines + , postStatus + , deleteStatus + , reblogStatus + , unreblogStatus + , favouriteStatus + , unfavouriteStatus + ) + +import Json.Encode as Encode +import Mastodon.Model exposing (..) +import Mastodon.Encoder +import Mastodon.Http +import Navigation +import Ports +import Types exposing (..) + + +initCommands : Maybe AppRegistration -> Maybe Client -> Maybe String -> Cmd Msg +initCommands registration client authCode = + Cmd.batch <| + case authCode of + Just authCode -> + case registration of + Just registration -> + [ Mastodon.Http.getAccessToken registration authCode + |> Mastodon.Http.send (MastodonEvent << AccessToken) + ] + + Nothing -> + [] + + Nothing -> + [ loadUserAccount client, loadTimelines client ] + + +navigateToAuthUrl : AppRegistration -> Cmd Msg +navigateToAuthUrl registration = + Navigation.load <| Mastodon.Http.getAuthorizationUrl registration + + +registerApp : Model -> Cmd Msg +registerApp { server, location } = + let + appUrl = + location.origin ++ location.pathname + + cleanServer = + if String.endsWith "/" server then + String.dropRight 1 server + else + server + in + Mastodon.Http.register + cleanServer + "tooty" + appUrl + "read write follow" + "https://github.com/n1k0/tooty" + |> Mastodon.Http.send (MastodonEvent << AppRegistered) + + +saveClient : Client -> Cmd Msg +saveClient client = + Mastodon.Encoder.clientEncoder client + |> Encode.encode 0 + |> Ports.saveClient + + +saveRegistration : AppRegistration -> Cmd Msg +saveRegistration registration = + Mastodon.Encoder.registrationEncoder registration + |> Encode.encode 0 + |> Ports.saveRegistration + + +loadNotifications : Maybe Client -> Cmd Msg +loadNotifications client = + case client of + Just client -> + Mastodon.Http.fetchNotifications client + |> Mastodon.Http.send (MastodonEvent << Notifications) + + Nothing -> + Cmd.none + + +loadUserAccount : Maybe Client -> Cmd Msg +loadUserAccount client = + case client of + Just client -> + Mastodon.Http.userAccount client + |> Mastodon.Http.send (MastodonEvent << CurrentUser) + + Nothing -> + Cmd.none + + +loadAccount : Maybe Client -> Int -> Cmd Msg +loadAccount client accountId = + case client of + Just client -> + Mastodon.Http.fetchAccount client accountId + |> Mastodon.Http.send (MastodonEvent << AccountReceived) + + Nothing -> + Cmd.none + + +loadAccountInfo : Maybe Client -> Int -> Cmd Msg +loadAccountInfo client accountId = + case client of + Just client -> + Cmd.batch + [ Mastodon.Http.fetchAccountTimeline client accountId + |> Mastodon.Http.send (MastodonEvent << AccountTimeline) + , Mastodon.Http.fetchAccountFollowers client accountId + |> Mastodon.Http.send (MastodonEvent << AccountFollowers) + , Mastodon.Http.fetchAccountFollowing client accountId + |> Mastodon.Http.send (MastodonEvent << AccountFollowing) + ] + + Nothing -> + Cmd.none + + +loadThread : Maybe Client -> Status -> Cmd Msg +loadThread client status = + case client of + Just client -> + Mastodon.Http.context client status.id + |> Mastodon.Http.send (MastodonEvent << (ContextLoaded status)) + + Nothing -> + Cmd.none + + +loadTimelines : Maybe Client -> Cmd Msg +loadTimelines client = + case client of + Just client -> + Cmd.batch + [ Mastodon.Http.fetchUserTimeline client + |> Mastodon.Http.send (MastodonEvent << UserTimeline) + , Mastodon.Http.fetchLocalTimeline client + |> Mastodon.Http.send (MastodonEvent << LocalTimeline) + , Mastodon.Http.fetchGlobalTimeline client + |> Mastodon.Http.send (MastodonEvent << GlobalTimeline) + , loadNotifications <| Just client + ] + + Nothing -> + Cmd.none + + +postStatus : Maybe Client -> StatusRequestBody -> Cmd Msg +postStatus client draft = + case client of + Just client -> + Mastodon.Http.postStatus client draft + |> Mastodon.Http.send (MastodonEvent << StatusPosted) + + Nothing -> + Cmd.none + + +deleteStatus : Maybe Client -> Int -> Cmd Msg +deleteStatus client id = + case client of + Just client -> + Mastodon.Http.deleteStatus client id + |> Mastodon.Http.send (MastodonEvent << StatusDeleted) + + Nothing -> + Cmd.none + + +reblogStatus : Maybe Client -> Int -> Cmd Msg +reblogStatus client statusId = + case client of + Just client -> + Mastodon.Http.reblog client statusId + |> Mastodon.Http.send (MastodonEvent << Reblogged) + + Nothing -> + Cmd.none + + +unreblogStatus : Maybe Client -> Int -> Cmd Msg +unreblogStatus client statusId = + case client of + Just client -> + Mastodon.Http.unreblog client statusId + |> Mastodon.Http.send (MastodonEvent << Unreblogged) + + Nothing -> + Cmd.none + + +favouriteStatus : Maybe Client -> Int -> Cmd Msg +favouriteStatus client statusId = + case client of + Just client -> + Mastodon.Http.favourite client statusId + |> Mastodon.Http.send (MastodonEvent << FavoriteAdded) + + Nothing -> + Cmd.none + + +unfavouriteStatus : Maybe Client -> Int -> Cmd Msg +unfavouriteStatus client statusId = + case client of + Just client -> + Mastodon.Http.unfavourite client statusId + |> Mastodon.Http.send (MastodonEvent << FavoriteRemoved) + + Nothing -> + Cmd.none diff --git a/src/Main.elm b/src/Main.elm index 1966601..c118e5b 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -2,7 +2,8 @@ module Main exposing (..) import Navigation import View exposing (view) -import Model exposing (Flags, Model, Msg(..), init, update, subscriptions) +import Model exposing (..) +import Types exposing (..) main : Program Flags Model Msg diff --git a/src/Mastodon/ApiUrl.elm b/src/Mastodon/ApiUrl.elm index cbcbc49..977b9f0 100644 --- a/src/Mastodon/ApiUrl.elm +++ b/src/Mastodon/ApiUrl.elm @@ -6,6 +6,8 @@ module Mastodon.ApiUrl , userAccount , account , accountTimeline + , followers + , following , status , homeTimeline , publicTimeline @@ -54,6 +56,16 @@ userAccount server = server ++ accounts ++ "verify_credentials" +followers : Int -> String +followers id = + (account id) ++ "/followers" + + +following : Int -> String +following id = + (account id) ++ "/following" + + homeTimeline : String homeTimeline = "/api/v1/timelines/home" diff --git a/src/Mastodon/Http.elm b/src/Mastodon/Http.elm index ce4e00e..8823d90 100644 --- a/src/Mastodon/Http.elm +++ b/src/Mastodon/Http.elm @@ -11,6 +11,8 @@ module Mastodon.Http , getAccessToken , fetchAccount , fetchAccountTimeline + , fetchAccountFollowers + , fetchAccountFollowing , fetchLocalTimeline , fetchNotifications , fetchGlobalTimeline @@ -134,6 +136,16 @@ fetchNotifications client = fetch client (ApiUrl.notifications) <| Decode.list notificationDecoder +fetchAccountFollowers : Client -> Int -> Request (List Account) +fetchAccountFollowers client accountId = + fetch client (ApiUrl.followers accountId) <| Decode.list accountDecoder + + +fetchAccountFollowing : Client -> Int -> Request (List Account) +fetchAccountFollowing client accountId = + fetch client (ApiUrl.following accountId) <| Decode.list accountDecoder + + userAccount : Client -> Request Account userAccount client = HttpBuilder.get (ApiUrl.userAccount client.server) diff --git a/src/Model.elm b/src/Model.elm index 51f62e1..8be3519 100644 --- a/src/Model.elm +++ b/src/Model.elm @@ -1,17 +1,15 @@ module Model exposing (..) +import Command import Dom -import Json.Encode as Encode +import Dom.Scroll import Navigation import Mastodon.Decoder -import Mastodon.Encoder import Mastodon.Helper -import Mastodon.Http -import Mastodon.Model +import Mastodon.Model exposing (..) import Mastodon.WebSocket -import Ports import Task -import Dom.Scroll +import Types exposing (..) maxBuffer : Int @@ -20,124 +18,6 @@ maxBuffer = 100 -type alias Flags = - { client : Maybe Mastodon.Model.Client - , registration : Maybe Mastodon.Model.AppRegistration - } - - -type DraftMsg - = ClearDraft - | UpdateSensitive Bool - | UpdateSpoiler String - | UpdateStatus String - | UpdateVisibility String - | UpdateReplyTo Mastodon.Model.Status - | ToggleSpoiler Bool - - -type ViewerMsg - = CloseViewer - | OpenViewer (List Mastodon.Model.Attachment) Mastodon.Model.Attachment - - -type MastodonMsg - = AccessToken (Result Mastodon.Model.Error Mastodon.Model.AccessTokenResult) - | AppRegistered (Result Mastodon.Model.Error Mastodon.Model.AppRegistration) - | ContextLoaded Mastodon.Model.Status (Result Mastodon.Model.Error Mastodon.Model.Context) - | CurrentUser (Result Mastodon.Model.Error Mastodon.Model.Account) - | FavoriteAdded (Result Mastodon.Model.Error Mastodon.Model.Status) - | FavoriteRemoved (Result Mastodon.Model.Error Mastodon.Model.Status) - | LocalTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status)) - | Notifications (Result Mastodon.Model.Error (List Mastodon.Model.Notification)) - | GlobalTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status)) - | Reblogged (Result Mastodon.Model.Error Mastodon.Model.Status) - | StatusDeleted (Result Mastodon.Model.Error Int) - | StatusPosted (Result Mastodon.Model.Error Mastodon.Model.Status) - | Unreblogged (Result Mastodon.Model.Error Mastodon.Model.Status) - | Account (Result Mastodon.Model.Error Mastodon.Model.Account) - | AccountTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status)) - | UserTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status)) - - -type WebSocketMsg - = NewWebsocketUserMessage String - | NewWebsocketGlobalMessage String - | NewWebsocketLocalMessage String - - -type Msg - = AddFavorite Int - | ClearOpenedAccount - | CloseThread - | DomResult (Result Dom.Error ()) - | DeleteStatus Int - | DraftEvent DraftMsg - | LoadAccount Int - | MastodonEvent MastodonMsg - | NoOp - | OpenThread Mastodon.Model.Status - | Reblog Int - | Register - | RemoveFavorite Int - | ServerChange String - | SubmitDraft - | UrlChange Navigation.Location - | UseGlobalTimeline Bool - | Unreblog Int - | ViewerEvent ViewerMsg - | WebSocketEvent WebSocketMsg - | ScrollColumn String - - -type alias Draft = - { status : String - , in_reply_to : Maybe Mastodon.Model.Status - , spoiler_text : Maybe String - , sensitive : Bool - , visibility : String - } - - -type alias Thread = - { status : Mastodon.Model.Status - , context : Mastodon.Model.Context - } - - -type alias Viewer = - { attachments : List Mastodon.Model.Attachment - , attachment : Mastodon.Model.Attachment - } - - -type CurrentView - = -- Basically, what we should be displaying in the fourth column - AccountView Mastodon.Model.Account - | ThreadView Thread - | LocalTimelineView - | GlobalTimelineView - - -type alias Model = - { server : String - , registration : Maybe Mastodon.Model.AppRegistration - , client : Maybe Mastodon.Model.Client - , userTimeline : List Mastodon.Model.Status - , localTimeline : List Mastodon.Model.Status - , globalTimeline : List Mastodon.Model.Status - , accountTimeline : List Mastodon.Model.Status - , notifications : List Mastodon.Model.NotificationAggregate - , draft : Draft - , errors : List String - , location : Navigation.Location - , useGlobalTimeline : Bool - , viewer : Maybe Viewer - , currentUser : Maybe Mastodon.Model.Account - , currentView : CurrentView - } - - extractAuthCode : Navigation.Location -> Maybe String extractAuthCode { search } = case (String.split "?code=" search) of @@ -171,6 +51,8 @@ init flags location = , localTimeline = [] , globalTimeline = [] , accountTimeline = [] + , accountFollowers = [] + , accountFollowing = [] , notifications = [] , draft = defaultDraft , errors = [] @@ -180,100 +62,7 @@ init flags location = , currentView = LocalTimelineView , currentUser = Nothing } - ! [ initCommands flags.registration flags.client authCode ] - - -initCommands : Maybe Mastodon.Model.AppRegistration -> Maybe Mastodon.Model.Client -> Maybe String -> Cmd Msg -initCommands registration client authCode = - Cmd.batch <| - case authCode of - Just authCode -> - case registration of - Just registration -> - [ Mastodon.Http.getAccessToken registration authCode - |> Mastodon.Http.send (MastodonEvent << AccessToken) - ] - - Nothing -> - [] - - Nothing -> - [ loadUserAccount client, loadTimelines client ] - - -registerApp : Model -> Cmd Msg -registerApp { server, location } = - let - appUrl = - location.origin ++ location.pathname - - cleanServer = - if String.endsWith "/" server then - String.dropRight 1 server - else - server - in - Mastodon.Http.register - cleanServer - "tooty" - appUrl - "read write follow" - "https://github.com/n1k0/tooty" - |> Mastodon.Http.send (MastodonEvent << AppRegistered) - - -saveClient : Mastodon.Model.Client -> Cmd Msg -saveClient client = - Mastodon.Encoder.clientEncoder client - |> Encode.encode 0 - |> Ports.saveClient - - -saveRegistration : Mastodon.Model.AppRegistration -> Cmd Msg -saveRegistration registration = - Mastodon.Encoder.registrationEncoder registration - |> Encode.encode 0 - |> Ports.saveRegistration - - -loadNotifications : Maybe Mastodon.Model.Client -> Cmd Msg -loadNotifications client = - case client of - Just client -> - Mastodon.Http.fetchNotifications client - |> Mastodon.Http.send (MastodonEvent << Notifications) - - Nothing -> - Cmd.none - - -loadUserAccount : Maybe Mastodon.Model.Client -> Cmd Msg -loadUserAccount client = - case client of - Just client -> - Mastodon.Http.userAccount client - |> Mastodon.Http.send (MastodonEvent << CurrentUser) - - Nothing -> - Cmd.none - - -loadTimelines : Maybe Mastodon.Model.Client -> Cmd Msg -loadTimelines client = - case client of - Just client -> - Cmd.batch - [ Mastodon.Http.fetchUserTimeline client - |> Mastodon.Http.send (MastodonEvent << UserTimeline) - , Mastodon.Http.fetchLocalTimeline client - |> Mastodon.Http.send (MastodonEvent << LocalTimeline) - , Mastodon.Http.fetchGlobalTimeline client - |> Mastodon.Http.send (MastodonEvent << GlobalTimeline) - , loadNotifications <| Just client - ] - - Nothing -> - Cmd.none + ! [ Command.initCommands flags.registration flags.client authCode ] preferredTimeline : Model -> CurrentView @@ -289,35 +78,23 @@ truncate entries = List.take maxBuffer entries -postStatus : Mastodon.Model.Client -> Mastodon.Model.StatusRequestBody -> Cmd Msg -postStatus client draft = - Mastodon.Http.postStatus client draft - |> Mastodon.Http.send (MastodonEvent << StatusPosted) - - -deleteStatus : Mastodon.Model.Client -> Int -> Cmd Msg -deleteStatus client id = - Mastodon.Http.deleteStatus client id - |> Mastodon.Http.send (MastodonEvent << StatusDeleted) - - -errorText : Mastodon.Model.Error -> String +errorText : Error -> String errorText error = case error of - Mastodon.Model.MastodonError statusCode statusMsg errorMsg -> + MastodonError statusCode statusMsg errorMsg -> "HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg - Mastodon.Model.ServerError statusCode statusMsg errorMsg -> + ServerError statusCode statusMsg errorMsg -> "HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg - Mastodon.Model.TimeoutError -> + TimeoutError -> "Request timed out." - Mastodon.Model.NetworkError -> + NetworkError -> "Unreachable host." -toStatusRequestBody : Draft -> Mastodon.Model.StatusRequestBody +toStatusRequestBody : Draft -> StatusRequestBody toStatusRequestBody draft = { status = draft.status , in_reply_to_id = @@ -333,7 +110,7 @@ toStatusRequestBody draft = } -updateTimelinesWithBoolFlag : Int -> Bool -> (Mastodon.Model.Status -> Mastodon.Model.Status) -> Model -> Model +updateTimelinesWithBoolFlag : Int -> Bool -> (Status -> Status) -> Model -> Model updateTimelinesWithBoolFlag statusId flag statusUpdater model = let update flag status = @@ -351,15 +128,17 @@ updateTimelinesWithBoolFlag statusId flag statusUpdater model = processFavourite : Int -> Bool -> Model -> Model processFavourite statusId flag model = + -- TODO: update notifications too updateTimelinesWithBoolFlag statusId flag (\s -> { s | favourited = Just flag }) model processReblog : Int -> Bool -> Model -> Model processReblog statusId flag model = + -- TODO: update notifications too updateTimelinesWithBoolFlag statusId flag (\s -> { s | reblogged = Just flag }) model -deleteStatusFromTimeline : Int -> List Mastodon.Model.Status -> List Mastodon.Model.Status +deleteStatusFromTimeline : Int -> List Status -> List Status deleteStatusFromTimeline statusId timeline = timeline |> List.filter @@ -371,7 +150,7 @@ deleteStatusFromTimeline statusId timeline = ) -updateDraft : DraftMsg -> Mastodon.Model.Account -> Draft -> ( Draft, Cmd Msg ) +updateDraft : DraftMsg -> Account -> Draft -> ( Draft, Cmd Msg ) updateDraft draftMsg currentUser draft = case draftMsg of ClearDraft -> @@ -432,12 +211,12 @@ processMastodonEvent msg model = Ok { server, accessToken } -> let client = - Mastodon.Model.Client server accessToken + Client server accessToken in { model | client = Just client } - ! [ loadTimelines <| Just client + ! [ Command.loadTimelines <| Just client , Navigation.modifyUrl model.location.pathname - , saveClient client + , Command.saveClient client ] Err error -> @@ -447,8 +226,8 @@ processMastodonEvent msg model = case result of Ok registration -> { model | registration = Just registration } - ! [ saveRegistration registration - , Navigation.load <| Mastodon.Http.getAuthorizationUrl registration + ! [ Command.saveRegistration registration + , Command.navigateToAuthUrl registration ] Err error -> @@ -457,11 +236,7 @@ processMastodonEvent msg model = ContextLoaded status result -> case result of Ok context -> - let - thread = - Thread status context - in - { model | currentView = ThreadView thread } ! [] + { model | currentView = ThreadView (Thread status context) } ! [] Err error -> { model @@ -481,7 +256,7 @@ processMastodonEvent msg model = FavoriteAdded result -> case result of Ok status -> - processFavourite status.id True model ! [ loadNotifications model.client ] + model ! [ Command.loadNotifications model.client ] Err error -> { model | errors = (errorText error) :: model.errors } ! [] @@ -489,7 +264,7 @@ processMastodonEvent msg model = FavoriteRemoved result -> case result of Ok status -> - processFavourite status.id False model ! [ loadNotifications model.client ] + model ! [ Command.loadNotifications model.client ] Err error -> { model | errors = (errorText error) :: model.errors } ! [] @@ -500,7 +275,7 @@ processMastodonEvent msg model = { model | localTimeline = localTimeline } ! [] Err error -> - { model | localTimeline = [], errors = (errorText error) :: model.errors } ! [] + { model | errors = (errorText error) :: model.errors } ! [] Notifications result -> case result of @@ -508,7 +283,7 @@ processMastodonEvent msg model = { model | notifications = Mastodon.Helper.aggregateNotifications notifications } ! [] Err error -> - { model | notifications = [], errors = (errorText error) :: model.errors } ! [] + { model | errors = (errorText error) :: model.errors } ! [] GlobalTimeline result -> case result of @@ -516,12 +291,12 @@ processMastodonEvent msg model = { model | globalTimeline = globalTimeline } ! [] Err error -> - { model | globalTimeline = [], errors = (errorText error) :: model.errors } ! [] + { model | errors = (errorText error) :: model.errors } ! [] Reblogged result -> case result of Ok status -> - model ! [ loadNotifications model.client ] + model ! [ Command.loadNotifications model.client ] Err error -> { model | errors = (errorText error) :: model.errors } ! [] @@ -545,15 +320,16 @@ processMastodonEvent msg model = Unreblogged result -> case result of Ok status -> - model ! [ loadNotifications model.client ] + model ! [ Command.loadNotifications model.client ] Err error -> { model | errors = (errorText error) :: model.errors } ! [] - Account result -> + AccountReceived result -> case result of Ok account -> - { model | currentView = AccountView account } ! [] + { model | currentView = AccountView account } + ! [ Command.loadAccountInfo model.client account.id ] Err error -> { model @@ -570,13 +346,29 @@ processMastodonEvent msg model = Err error -> { model | errors = (errorText error) :: model.errors } ! [] + AccountFollowers result -> + case result of + Ok statuses -> + { model | accountFollowers = statuses } ! [] + + Err error -> + { model | errors = (errorText error) :: model.errors } ! [] + + AccountFollowing result -> + case result of + Ok statuses -> + { model | accountFollowing = statuses } ! [] + + Err error -> + { model | errors = (errorText error) :: model.errors } ! [] + UserTimeline result -> case result of Ok userTimeline -> { model | userTimeline = userTimeline } ! [] Err error -> - { model | userTimeline = [], errors = (errorText error) :: model.errors } ! [] + { model | errors = (errorText error) :: model.errors } ! [] processWebSocketMsg : WebSocketMsg -> Model -> ( Model, Cmd Msg ) @@ -672,9 +464,6 @@ update msg model = NoOp -> model ! [] - DomResult result -> - model ! [] - MastodonEvent msg -> let ( newModel, commands ) = @@ -696,76 +485,28 @@ update msg model = model ! [] Register -> - model ! [ registerApp model ] + model ! [ Command.registerApp model ] OpenThread status -> - case model.client of - Just client -> - model - ! [ Mastodon.Http.context client status.id - |> Mastodon.Http.send (MastodonEvent << (ContextLoaded status)) - ] - - Nothing -> - model ! [] + model ! [ Command.loadThread model.client status ] CloseThread -> { model | currentView = preferredTimeline model } ! [] DeleteStatus id -> - case model.client of - Just client -> - model ! [ deleteStatus client id ] + model ! [ Command.deleteStatus model.client id ] - Nothing -> - model ! [] + ReblogStatus id -> + processReblog id True model ! [ Command.reblogStatus model.client id ] - Reblog id -> - -- Note: The case of reblogging is specific as it seems the server - -- response takes a lot of time to be received by the client, so we - -- perform optimistic updates here. - case model.client of - Just client -> - processReblog id True model - ! [ Mastodon.Http.reblog client id - |> Mastodon.Http.send (MastodonEvent << Reblogged) - ] - - Nothing -> - model ! [] - - Unreblog id -> - case model.client of - Just client -> - processReblog id False model - ! [ Mastodon.Http.unfavourite client id - |> Mastodon.Http.send (MastodonEvent << Unreblogged) - ] - - Nothing -> - model ! [] + UnreblogStatus id -> + processReblog id False model ! [ Command.unreblogStatus model.client id ] AddFavorite id -> - model - ! case model.client of - Just client -> - [ Mastodon.Http.favourite client id - |> Mastodon.Http.send (MastodonEvent << FavoriteAdded) - ] - - Nothing -> - [] + processFavourite id True model ! [ Command.favouriteStatus model.client id ] RemoveFavorite id -> - model - ! case model.client of - Just client -> - [ Mastodon.Http.unfavourite client id - |> Mastodon.Http.send (MastodonEvent << FavoriteRemoved) - ] - - Nothing -> - [] + processFavourite id False model ! [ Command.unfavouriteStatus model.client id ] DraftEvent draftMsg -> case model.currentUser of @@ -787,31 +528,20 @@ update msg model = { model | viewer = viewer } ! [ commands ] SubmitDraft -> - model - ! case model.client of - Just client -> - [ postStatus client <| toStatusRequestBody model.draft ] - - Nothing -> - [] + model ! [ Command.postStatus model.client <| toStatusRequestBody model.draft ] LoadAccount accountId -> - {- - @TODO - When requesting a user profile, we should load a new "page" - so that the URL in the browser matches the user displayed - -} { model | currentView = preferredTimeline model } - ! case model.client of - Just client -> - [ Mastodon.Http.fetchAccount client accountId - |> Mastodon.Http.send (MastodonEvent << Account) - , Mastodon.Http.fetchAccountTimeline client accountId - |> Mastodon.Http.send (MastodonEvent << AccountTimeline) - ] + ! [ Command.loadAccount model.client accountId ] - Nothing -> - [] + ViewAccountFollowers account -> + { model | currentView = AccountFollowersView account model.accountFollowers } ! [] + + ViewAccountFollowing account -> + { model | currentView = AccountFollowingView account model.accountFollowing } ! [] + + ViewAccountStatuses account -> + { model | currentView = AccountView account } ! [] UseGlobalTimeline flag -> let @@ -820,11 +550,17 @@ update msg model = in { model | currentView = preferredTimeline newModel } ! [] - ClearOpenedAccount -> - { model | currentView = preferredTimeline model } ! [] + CloseAccount -> + { model + | currentView = preferredTimeline model + , accountTimeline = [] + , accountFollowing = [] + , accountFollowers = [] + } + ! [] ScrollColumn context -> - model ! [ Task.attempt DomResult <| Dom.Scroll.toTop context ] + model ! [ Task.attempt (always NoOp) <| Dom.Scroll.toTop context ] subscriptions : Model -> Sub Msg diff --git a/src/Types.elm b/src/Types.elm new file mode 100644 index 0000000..f0143ef --- /dev/null +++ b/src/Types.elm @@ -0,0 +1,138 @@ +module Types exposing (..) + +import Mastodon.Model exposing (..) +import Navigation + + +type alias Flags = + { client : Maybe Client + , registration : Maybe AppRegistration + } + + +type DraftMsg + = ClearDraft + | UpdateSensitive Bool + | UpdateSpoiler String + | UpdateStatus String + | UpdateVisibility String + | UpdateReplyTo Status + | ToggleSpoiler Bool + + +type ViewerMsg + = CloseViewer + | OpenViewer (List Attachment) Attachment + + +type MastodonMsg + = AccessToken (Result Error AccessTokenResult) + | AccountFollowers (Result Error (List Account)) + | AccountFollowing (Result Error (List Account)) + | AccountReceived (Result Error Account) + | AccountTimeline (Result Error (List Status)) + | AppRegistered (Result Error AppRegistration) + | ContextLoaded Status (Result Error Context) + | CurrentUser (Result Error Account) + | FavoriteAdded (Result Error Status) + | FavoriteRemoved (Result Error Status) + | GlobalTimeline (Result Error (List Status)) + | LocalTimeline (Result Error (List Status)) + | Notifications (Result Error (List Notification)) + | Reblogged (Result Error Status) + | StatusDeleted (Result Error Int) + | StatusPosted (Result Error Status) + | Unreblogged (Result Error Status) + | UserTimeline (Result Error (List Status)) + + +type WebSocketMsg + = NewWebsocketGlobalMessage String + | NewWebsocketLocalMessage String + | NewWebsocketUserMessage String + + +type Msg + = AddFavorite Int + | CloseAccount + | CloseThread + | DeleteStatus Int + | DraftEvent DraftMsg + | LoadAccount Int + | MastodonEvent MastodonMsg + | NoOp + | OpenThread Status + | ReblogStatus Int + | Register + | RemoveFavorite Int + | ScrollColumn String + | ServerChange String + | SubmitDraft + | UrlChange Navigation.Location + | UseGlobalTimeline Bool + | UnreblogStatus Int + | ViewAccountFollowing Account + | ViewAccountFollowers Account + | ViewAccountStatuses Account + | ViewerEvent ViewerMsg + | WebSocketEvent WebSocketMsg + + +type alias AccountViewInfo = + { account : Account + , timeline : List Status + , folowers : List Account + , following : List Account + } + + +type alias Draft = + { status : String + , in_reply_to : Maybe Status + , spoiler_text : Maybe String + , sensitive : Bool + , visibility : String + } + + +type alias Thread = + { status : Status + , context : Context + } + + +type alias Viewer = + { attachments : List Attachment + , attachment : Attachment + } + + +type CurrentView + = -- Basically, what we should be displaying in the fourth column + AccountFollowersView Account (List Account) + | AccountFollowingView Account (List Account) + | AccountView Account + | GlobalTimelineView + | LocalTimelineView + | ThreadView Thread + + +type alias Model = + { server : String + , registration : Maybe AppRegistration + , client : Maybe Client + , userTimeline : List Status + , localTimeline : List Status + , globalTimeline : List Status + , accountTimeline : List Status + , accountFollowers : List Account + , accountFollowing : List Account + , notifications : List NotificationAggregate + , draft : Draft + , errors : List String + , location : Navigation.Location + , useGlobalTimeline : Bool + , viewer : Maybe Viewer + , currentUser : Maybe Account + , currentView : CurrentView + } diff --git a/src/View.elm b/src/View.elm index 96a8e68..f3f4d81 100644 --- a/src/View.elm +++ b/src/View.elm @@ -6,8 +6,8 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import List.Extra exposing (elemIndex, getAt) import Mastodon.Helper -import Mastodon.Model -import Model exposing (..) +import Mastodon.Model exposing (..) +import Types exposing (..) import ViewHelper exposing (..) import Date import Date.Extra.Config.Config_en_au as DateEn @@ -66,7 +66,7 @@ icon name = i [ class <| "glyphicon glyphicon-" ++ name ] [] -accountLink : Mastodon.Model.Account -> Html Msg +accountLink : Account -> Html Msg accountLink account = a [ href account.url @@ -75,7 +75,7 @@ accountLink account = [ text <| "@" ++ account.username ] -accountAvatarLink : Mastodon.Model.Account -> Html Msg +accountAvatarLink : Account -> Html Msg accountAvatarLink account = a [ href account.url @@ -85,12 +85,7 @@ accountAvatarLink account = [ img [ class "avatar", src account.avatar ] [] ] -attachmentPreview : - String - -> Maybe Bool - -> List Mastodon.Model.Attachment - -> Mastodon.Model.Attachment - -> Html Msg +attachmentPreview : String -> Maybe Bool -> List Attachment -> Attachment -> Html Msg attachmentPreview context sensitive attachments ({ url, preview_url } as attachment) = let nsfw = @@ -133,7 +128,7 @@ attachmentPreview context sensitive attachments ({ url, preview_url } as attachm [ media ] -attachmentListView : String -> Mastodon.Model.Status -> Html Msg +attachmentListView : String -> Status -> Html Msg attachmentListView context { media_attachments, sensitive } = case media_attachments of [] -> @@ -144,7 +139,7 @@ attachmentListView context { media_attachments, sensitive } = List.map (attachmentPreview context sensitive attachments) attachments -statusContentView : String -> Mastodon.Model.Status -> Html Msg +statusContentView : String -> Status -> Html Msg statusContentView context status = case status.spoiler_text of "" -> @@ -170,7 +165,7 @@ statusContentView context status = ] -statusView : String -> Mastodon.Model.Status -> Html Msg +statusView : String -> Status -> Html Msg statusView context ({ account, content, media_attachments, reblog, mentions } as status) = let accountLinkAttributes = @@ -183,7 +178,7 @@ statusView context ({ account, content, media_attachments, reblog, mentions } as ] in case reblog of - Just (Mastodon.Model.Reblog reblog) -> + Just (Reblog reblog) -> div [ class "reblog" ] [ p [ class "status-info" ] [ icon "fire" @@ -207,58 +202,94 @@ statusView context ({ account, content, media_attachments, reblog, mentions } as ] -accountTimelineView : - Mastodon.Model.Account - -> List Mastodon.Model.Status - -> String - -> String - -> Html Msg -accountTimelineView account statuses label iconName = - div [ class "col-md-3 column" ] - [ div [ class "panel panel-default" ] - [ closeablePanelheading iconName label ClearOpenedAccount - , div [ class "timeline" ] - [ div - [ class "account-detail" - , style [ ( "background-image", "url('" ++ account.header ++ "')" ) ] - ] - [ div [ class "opacity-layer" ] - [ img [ src account.avatar ] [] - , span [ class "account-display-name" ] [ text account.display_name ] - , span [ class "account-username" ] [ text ("@" ++ account.username) ] - , span [ class "account-note" ] (formatContent account.note []) - ] - ] - , div [ class "row account-infos" ] - [ div [ class "col-md-4" ] - [ text "Statuses" - , br [] [] - , text <| toString account.statuses_count - ] - , div [ class "col-md-4" ] - [ text "Following" - , br [] [] - , text <| toString account.following_count - ] - , div [ class "col-md-4" ] - [ text "Followers" - , br [] [] - , text <| toString account.followers_count - ] - ] - , ul [ class "list-group" ] <| - List.map - (\s -> - li [ class "list-group-item status" ] - [ statusView "account" s ] - ) - statuses +followView : Account -> Html Msg +followView account = + div [ class "follow-entry" ] + [ accountAvatarLink account + , div [ class "username" ] + [ strong [] + [ text <| + if account.display_name /= "" then + account.display_name + else + account.username ] + , br [] [] + , text <| "@" ++ account.acct ] ] -statusActionsView : Mastodon.Model.Status -> Mastodon.Model.Account -> Html Msg +accountCounterLink : String -> Int -> (Account -> Msg) -> Account -> Html Msg +accountCounterLink label count tagger account = + a + [ href "" + , class "col-md-4" + , onClickWithPreventAndStop <| tagger account + ] + [ text label + , br [] [] + , text <| toString count + ] + + +accountView : String -> String -> Account -> Html Msg -> Html Msg +accountView label iconName account panelContent = + let + { statuses_count, following_count, followers_count } = + account + in + div [ class "col-md-3 column" ] + [ div [ class "panel panel-default" ] + [ closeablePanelheading iconName label CloseAccount + , div [ class "timeline" ] + [ div + [ class "account-detail" + , style [ ( "background-image", "url('" ++ account.header ++ "')" ) ] + ] + [ div [ class "opacity-layer" ] + [ img [ src account.avatar ] [] + , span [ class "account-display-name" ] [ text account.display_name ] + , span [ class "account-username" ] [ text ("@" ++ account.username) ] + , span [ class "account-note" ] (formatContent account.note []) + ] + ] + , div [ class "row account-infos" ] + [ accountCounterLink "Statuses" statuses_count ViewAccountStatuses account + , accountCounterLink "Following" following_count ViewAccountFollowing account + , accountCounterLink "Followers" followers_count ViewAccountFollowers account + ] + , panelContent + ] + ] + ] + + +accountTimelineView : String -> List Status -> Account -> Html Msg +accountTimelineView label statuses account = + accountView label "user" account <| + ul [ class "list-group" ] <| + List.map + (\s -> + li [ class "list-group-item status" ] + [ statusView "account" s ] + ) + statuses + + +accountFollowView : String -> List Account -> Account -> Html Msg +accountFollowView label accounts account = + accountView label "user" account <| + ul [ class "list-group" ] <| + List.map + (\account -> + li [ class "list-group-item status" ] + [ followView account ] + ) + accounts + + +statusActionsView : Status -> Account -> Html Msg statusActionsView status currentUser = let sourceStatus = @@ -270,10 +301,10 @@ statusActionsView status currentUser = ( reblogClasses, reblogEvent ) = case status.reblogged of Just True -> - ( baseBtnClasses ++ " reblogged", Unreblog sourceStatus.id ) + ( baseBtnClasses ++ " reblogged", UnreblogStatus sourceStatus.id ) _ -> - ( baseBtnClasses, Reblog sourceStatus.id ) + ( baseBtnClasses, ReblogStatus sourceStatus.id ) ( favClasses, favEvent ) = case status.favourited of @@ -322,7 +353,7 @@ statusActionsView status currentUser = ] -statusEntryView : String -> String -> Mastodon.Model.Account -> Mastodon.Model.Status -> Html Msg +statusEntryView : String -> String -> Account -> Status -> Html Msg statusEntryView context className currentUser status = let nsfwClass = @@ -339,13 +370,7 @@ statusEntryView context className currentUser status = ] -timelineView : - String - -> String - -> String - -> Mastodon.Model.Account - -> List Mastodon.Model.Status - -> Html Msg +timelineView : String -> String -> String -> Account -> List Status -> Html Msg timelineView label iconName context currentUser statuses = div [ class "col-md-3 column" ] [ div [ class "panel panel-default" ] @@ -358,7 +383,7 @@ timelineView label iconName context currentUser statuses = ] -notificationHeading : List Mastodon.Model.Account -> String -> String -> Html Msg +notificationHeading : List Account -> String -> String -> Html Msg notificationHeading accounts str iconType = div [ class "status-info" ] [ div [ class "avatars" ] <| List.map accountAvatarLink accounts @@ -371,12 +396,7 @@ notificationHeading accounts str iconType = ] -notificationStatusView : - String - -> Mastodon.Model.Account - -> Mastodon.Model.Status - -> Mastodon.Model.NotificationAggregate - -> Html Msg +notificationStatusView : String -> Account -> Status -> NotificationAggregate -> Html Msg notificationStatusView context currentUser status { type_, accounts } = div [ class <| "notification " ++ type_ ] [ case type_ of @@ -393,7 +413,7 @@ notificationStatusView context currentUser status { type_, accounts } = ] -notificationFollowView : Mastodon.Model.Account -> Mastodon.Model.NotificationAggregate -> Html Msg +notificationFollowView : Account -> NotificationAggregate -> Html Msg notificationFollowView currentUser { accounts } = let profileView account = @@ -414,10 +434,7 @@ notificationFollowView currentUser { accounts } = ] -notificationEntryView : - Mastodon.Model.Account - -> Mastodon.Model.NotificationAggregate - -> Html Msg +notificationEntryView : Account -> NotificationAggregate -> Html Msg notificationEntryView currentUser notification = li [ class "list-group-item" ] [ case notification.status of @@ -429,7 +446,7 @@ notificationEntryView currentUser notification = ] -notificationListView : Mastodon.Model.Account -> List Mastodon.Model.NotificationAggregate -> Html Msg +notificationListView : Account -> List NotificationAggregate -> Html Msg notificationListView currentUser notifications = div [ class "col-md-3 column" ] [ div [ class "panel panel-default" ] @@ -465,7 +482,7 @@ draftReplyToView draft = text "" -currentUserView : Maybe Mastodon.Model.Account -> Html Msg +currentUserView : Maybe Account -> Html Msg currentUserView currentUser = case currentUser of Just currentUser -> @@ -594,7 +611,7 @@ draftView { draft, currentUser } = ] -threadView : Mastodon.Model.Account -> Thread -> Html Msg +threadView : Account -> Thread -> Html Msg threadView currentUser thread = let statuses = @@ -663,7 +680,7 @@ homepageView model = model.userTimeline , notificationListView currentUser model.notifications , case model.currentView of - Model.LocalTimelineView -> + LocalTimelineView -> timelineView "Local timeline" "th-large" @@ -671,7 +688,7 @@ homepageView model = currentUser model.localTimeline - Model.GlobalTimelineView -> + GlobalTimelineView -> timelineView "Global timeline" "globe" @@ -679,11 +696,16 @@ homepageView model = currentUser model.globalTimeline - Model.AccountView account -> - -- Todo: Load the user timeline - accountTimelineView account model.accountTimeline "Account" "user" + AccountView account -> + accountTimelineView "Account" model.accountTimeline account - Model.ThreadView thread -> + AccountFollowersView account followers -> + accountFollowView "Account followers" model.accountFollowers account + + AccountFollowingView account following -> + accountFollowView "Account following" model.accountFollowing account + + ThreadView thread -> threadView currentUser thread ] diff --git a/src/ViewHelper.elm b/src/ViewHelper.elm index 9f9211b..411c134 100644 --- a/src/ViewHelper.elm +++ b/src/ViewHelper.elm @@ -15,7 +15,7 @@ import HtmlParser import Json.Decode as Decode import String.Extra exposing (replace) import Mastodon.Model -import Model exposing (Msg(LoadAccount)) +import Types exposing (..) -- Custom Events @@ -83,7 +83,7 @@ createLinkNode attrs children mentions = Nothing -> Html.node "a" ((List.map toAttribute attrs) - ++ [ onClickWithStop Model.NoOp, target "_blank" ] + ++ [ onClickWithStop NoOp, target "_blank" ] ) (toVirtualDom mentions children) @@ -91,10 +91,8 @@ createLinkNode attrs children mentions = getHrefLink : List ( String, String ) -> Maybe String getHrefLink attrs = attrs - |> List.filter - (\( name, value ) -> (name == "href")) - |> List.map - (\( name, value ) -> value) + |> List.filter (\( name, value ) -> (name == "href")) + |> List.map (\( name, value ) -> value) |> List.head