Add "load older messages" button
This commit is contained in:
parent
c88f2f3b3c
commit
130b964d29
22
src/Main.elm
22
src/Main.elm
|
@ -78,7 +78,27 @@ update msg model = case msg of
|
|||
ReceiveCompletedTypingIndicator r -> (model, Cmd.none)
|
||||
ReceiveStoreData d -> updateStoreData model d
|
||||
TypingTick _ -> updateTypingTick model
|
||||
History r -> updateHistory model r
|
||||
ReceiveHistoryResponse r hr -> updateHistoryResponse model r hr
|
||||
|
||||
updateHistoryResponse : Model -> RoomId -> Result Http.Error HistoryResponse -> (Model, Cmd Msg)
|
||||
updateHistoryResponse m r hr = case hr of
|
||||
Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, Cmd.none)
|
||||
Err _ -> (m, Cmd.none)
|
||||
|
||||
updateHistory : Model -> RoomId -> (Model, Cmd Msg)
|
||||
updateHistory m r =
|
||||
let
|
||||
prevBatch = Maybe.andThen .prevBatch
|
||||
<| Maybe.andThen .timeline
|
||||
<| Maybe.andThen (Dict.get r)
|
||||
<| Maybe.andThen .join
|
||||
<| m.sync.rooms
|
||||
command = case prevBatch of
|
||||
Just pv -> getHistory m.apiUrl (Maybe.withDefault "" m.token) r pv
|
||||
Nothing -> Cmd.none
|
||||
in
|
||||
(m, command)
|
||||
|
||||
updateChangeRoomText : Model -> RoomId -> String -> (Model, Cmd Msg)
|
||||
updateChangeRoomText m roomId text =
|
||||
|
@ -191,7 +211,7 @@ updateSyncResponse model r notify =
|
|||
token = Maybe.withDefault "" model.token
|
||||
nextBatch = Result.withDefault model.sync.nextBatch
|
||||
<| Result.map .nextBatch r
|
||||
syncCmd = sync nextBatch model.apiUrl token
|
||||
syncCmd = sync model.apiUrl token nextBatch
|
||||
newUsers sr = List.filter (\s -> not <| Dict.member s model.userData) <| roomsUsers sr
|
||||
newUserCmd sr = Cmd.batch
|
||||
<| List.map (userData model.apiUrl
|
||||
|
|
|
@ -2,7 +2,7 @@ module Scylla.Http exposing (..)
|
|||
import Scylla.Model exposing (..)
|
||||
import Scylla.Api exposing (..)
|
||||
import Scylla.Route exposing (RoomId)
|
||||
import Scylla.Sync exposing (syncResponseDecoder)
|
||||
import Scylla.Sync exposing (syncResponseDecoder, historyResponseDecoder)
|
||||
import Scylla.Login exposing (loginResponseDecoder, Username, Password)
|
||||
import Scylla.UserData exposing (userDataDecoder, UserData)
|
||||
import Json.Encode exposing (object, string, int, bool)
|
||||
|
@ -26,8 +26,8 @@ firstSync apiUrl token = request
|
|||
, tracker = Nothing
|
||||
}
|
||||
|
||||
sync : String -> ApiUrl -> ApiToken -> Cmd Msg
|
||||
sync nextBatch apiUrl token = request
|
||||
sync : ApiUrl -> ApiToken -> String -> Cmd Msg
|
||||
sync apiUrl token nextBatch = request
|
||||
{ method = "GET"
|
||||
, headers = authenticatedHeaders token
|
||||
, url = (fullClientUrl apiUrl) ++ "/sync" ++ "?since=" ++ (nextBatch) ++ "&timeout=10000"
|
||||
|
@ -37,6 +37,17 @@ sync nextBatch apiUrl token = request
|
|||
, tracker = Nothing
|
||||
}
|
||||
|
||||
getHistory : ApiUrl -> ApiToken -> RoomId -> String -> Cmd Msg
|
||||
getHistory apiUrl token room prevBatch = request
|
||||
{ method = "GET"
|
||||
, headers = authenticatedHeaders token
|
||||
, url = (fullClientUrl apiUrl) ++ "/rooms/" ++ room ++ "/messages" ++ "?from=" ++ prevBatch ++ "&dir=" ++ "b"
|
||||
, body = emptyBody
|
||||
, expect = expectJson (ReceiveHistoryResponse room) historyResponseDecoder
|
||||
, timeout = Nothing
|
||||
, tracker = Nothing
|
||||
}
|
||||
|
||||
sendTextMessage : ApiUrl -> ApiToken -> Int -> String -> String -> Cmd Msg
|
||||
sendTextMessage apiUrl token transactionId room message = request
|
||||
{ method = "PUT"
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
module Scylla.Model exposing (..)
|
||||
import Scylla.Api exposing (..)
|
||||
import Scylla.Sync exposing (SyncResponse, JoinedRoom, senderName)
|
||||
import Scylla.Sync exposing (SyncResponse, HistoryResponse, JoinedRoom, senderName)
|
||||
import Scylla.Login exposing (LoginResponse, Username, Password)
|
||||
import Scylla.UserData exposing (UserData)
|
||||
import Scylla.Route exposing (Route(..), RoomId)
|
||||
|
@ -50,6 +50,8 @@ type Msg =
|
|||
| ReceiveCompletedTypingIndicator (Result Http.Error ()) -- HTTP, typing indicator request completed
|
||||
| ReceiveStoreData Json.Decode.Value -- We are send back a value on request from localStorage.
|
||||
| TypingTick Posix -- Tick for updating the typing status
|
||||
| History RoomId -- Load history for a room
|
||||
| ReceiveHistoryResponse RoomId (Result Http.Error HistoryResponse) -- HTTP, receive history
|
||||
|
||||
displayName : Model -> Username -> String
|
||||
displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData
|
||||
|
|
|
@ -2,6 +2,7 @@ module Scylla.Sync exposing (..)
|
|||
import Scylla.Api exposing (..)
|
||||
import Scylla.Notification exposing (..)
|
||||
import Scylla.Login exposing (Username)
|
||||
import Scylla.Route exposing (RoomId)
|
||||
import Dict exposing (Dict)
|
||||
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field)
|
||||
import Json.Decode.Pipeline exposing (required, optional)
|
||||
|
@ -258,6 +259,20 @@ presenceDecoder =
|
|||
Decode.succeed Presence
|
||||
|> maybeDecode "events" (list eventDecoder)
|
||||
|
||||
-- Room History Responses
|
||||
type alias HistoryResponse =
|
||||
{ start : String
|
||||
, end : String
|
||||
, chunk : List RoomEvent
|
||||
}
|
||||
|
||||
historyResponseDecoder : Decoder HistoryResponse
|
||||
historyResponseDecoder =
|
||||
Decode.succeed HistoryResponse
|
||||
|> required "start" string
|
||||
|> required "end" string
|
||||
|> required "chunk" (list roomEventDecoder)
|
||||
|
||||
-- Business Logic
|
||||
uniqueByRecursive : (a -> comparable) -> List a -> Set comparable -> List a
|
||||
uniqueByRecursive f l s = case l of
|
||||
|
@ -327,7 +342,7 @@ mergeState : State -> State -> State
|
|||
mergeState s1 s2 = State <| mergeMaybe mergeStateEvents s1.events s2.events
|
||||
|
||||
mergeTimeline : Timeline -> Timeline -> Timeline
|
||||
mergeTimeline t1 t2 = Timeline (mergeMaybe mergeRoomEvents t1.events t2.events) Nothing t2.prevBatch
|
||||
mergeTimeline t1 t2 = Timeline (mergeMaybe mergeRoomEvents t1.events t2.events) Nothing t1.prevBatch
|
||||
|
||||
mergeEphemeral : Ephemeral -> Ephemeral -> Ephemeral
|
||||
mergeEphemeral e1 e2 = Ephemeral <| mergeMaybe mergeEvents e1.events e2.events
|
||||
|
@ -374,6 +389,40 @@ mergeSyncResponse l r =
|
|||
, accountData = mergeMaybe mergeAccountData l.accountData r.accountData
|
||||
}
|
||||
|
||||
appendRoomHistoryResponse : JoinedRoom -> HistoryResponse -> JoinedRoom
|
||||
appendRoomHistoryResponse jr hr =
|
||||
let
|
||||
oldEvents = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
|
||||
newEvents = mergeRoomEvents (List.reverse hr.chunk) oldEvents
|
||||
newTimeline = case jr.timeline of
|
||||
Just t -> Just { t | events = Just newEvents, prevBatch = Just hr.end }
|
||||
Nothing -> Just { events = Just newEvents, prevBatch = Just hr.end, limited = Nothing }
|
||||
in
|
||||
{ jr | timeline = newTimeline }
|
||||
|
||||
appendHistoryResponse : SyncResponse -> RoomId -> HistoryResponse -> SyncResponse
|
||||
appendHistoryResponse sr r hr =
|
||||
let
|
||||
appendMaybeRoomHistoryResponse mr = Just <| case mr of
|
||||
Just jr -> appendRoomHistoryResponse jr hr
|
||||
Nothing ->
|
||||
{ state = Nothing
|
||||
, timeline = Just
|
||||
{ events = Just hr.chunk
|
||||
, limited = Nothing
|
||||
, prevBatch = Just hr.end
|
||||
}
|
||||
, ephemeral = Nothing
|
||||
, accountData = Nothing
|
||||
, unreadNotifications = Nothing
|
||||
}
|
||||
newRooms = Just <| case sr.rooms of
|
||||
Just rs -> { rs | join = newJoin rs.join }
|
||||
Nothing -> { join = newJoin Nothing, leave = Nothing, invite = Nothing }
|
||||
newJoin j = Maybe.map (Dict.update r appendMaybeRoomHistoryResponse) j
|
||||
in
|
||||
{ sr | rooms = newRooms }
|
||||
|
||||
-- Business Logic: Names
|
||||
senderName : String -> String
|
||||
senderName s =
|
||||
|
|
|
@ -109,12 +109,12 @@ loginView m = div [ class "login-wrapper" ]
|
|||
, button [ onClick AttemptLogin ] [ text "Log In" ]
|
||||
]
|
||||
|
||||
joinedRoomView : Model -> String -> JoinedRoom -> Html Msg
|
||||
joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg
|
||||
joinedRoomView m roomId jr =
|
||||
let
|
||||
events = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
|
||||
renderedEvents = List.filterMap (eventView m) events
|
||||
eventWrapper = eventWrapperView m renderedEvents
|
||||
eventWrapper = eventWrapperView m roomId renderedEvents
|
||||
typing = List.map (displayName m) <| roomTypingUsers jr
|
||||
typingText = String.join ", " typing
|
||||
typingSuffix = case List.length typing of
|
||||
|
@ -155,8 +155,11 @@ iconView name =
|
|||
[ Svg.Attributes.class "feather-icon"
|
||||
] [ Svg.use [ Svg.Attributes.xlinkHref (url ++ "#" ++ name) ] [] ]
|
||||
|
||||
eventWrapperView : Model -> List (Html Msg) -> Html Msg
|
||||
eventWrapperView m es = div [ class "events-wrapper", id "events-wrapper" ] [ table [ class "events-table" ] es ]
|
||||
eventWrapperView : Model -> RoomId -> List (Html Msg) -> Html Msg
|
||||
eventWrapperView m rid es = div [ class "events-wrapper", id "events-wrapper" ]
|
||||
[ a [ class "history-link", onClick <| History rid ] [ text "Load older messages" ]
|
||||
, table [ class "events-table" ] es
|
||||
]
|
||||
|
||||
eventView : Model -> RoomEvent -> Maybe (Html Msg)
|
||||
eventView m re =
|
||||
|
|
|
@ -148,6 +148,14 @@ div.message-wrapper {
|
|||
div.events-wrapper {
|
||||
overflow-y: scroll;
|
||||
flex-grow: 1;
|
||||
|
||||
a.history-link {
|
||||
display: block;
|
||||
width: 100%;
|
||||
text-align: center;
|
||||
box-sizing: border-box;
|
||||
padding: 5px;
|
||||
}
|
||||
}
|
||||
|
||||
table.events-table {
|
||||
|
|
Loading…
Reference in New Issue
Block a user