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)
|
ReceiveCompletedTypingIndicator r -> (model, Cmd.none)
|
||||||
ReceiveStoreData d -> updateStoreData model d
|
ReceiveStoreData d -> updateStoreData model d
|
||||||
TypingTick _ -> updateTypingTick model
|
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 : Model -> RoomId -> String -> (Model, Cmd Msg)
|
||||||
updateChangeRoomText m roomId text =
|
updateChangeRoomText m roomId text =
|
||||||
|
@ -191,7 +211,7 @@ updateSyncResponse model r notify =
|
||||||
token = Maybe.withDefault "" model.token
|
token = Maybe.withDefault "" model.token
|
||||||
nextBatch = Result.withDefault model.sync.nextBatch
|
nextBatch = Result.withDefault model.sync.nextBatch
|
||||||
<| Result.map .nextBatch r
|
<| 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
|
newUsers sr = List.filter (\s -> not <| Dict.member s model.userData) <| roomsUsers sr
|
||||||
newUserCmd sr = Cmd.batch
|
newUserCmd sr = Cmd.batch
|
||||||
<| List.map (userData model.apiUrl
|
<| List.map (userData model.apiUrl
|
||||||
|
|
|
@ -2,7 +2,7 @@ module Scylla.Http exposing (..)
|
||||||
import Scylla.Model exposing (..)
|
import Scylla.Model exposing (..)
|
||||||
import Scylla.Api exposing (..)
|
import Scylla.Api exposing (..)
|
||||||
import Scylla.Route exposing (RoomId)
|
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.Login exposing (loginResponseDecoder, Username, Password)
|
||||||
import Scylla.UserData exposing (userDataDecoder, UserData)
|
import Scylla.UserData exposing (userDataDecoder, UserData)
|
||||||
import Json.Encode exposing (object, string, int, bool)
|
import Json.Encode exposing (object, string, int, bool)
|
||||||
|
@ -26,8 +26,8 @@ firstSync apiUrl token = request
|
||||||
, tracker = Nothing
|
, tracker = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
sync : String -> ApiUrl -> ApiToken -> Cmd Msg
|
sync : ApiUrl -> ApiToken -> String -> Cmd Msg
|
||||||
sync nextBatch apiUrl token = request
|
sync apiUrl token nextBatch = request
|
||||||
{ method = "GET"
|
{ method = "GET"
|
||||||
, headers = authenticatedHeaders token
|
, headers = authenticatedHeaders token
|
||||||
, url = (fullClientUrl apiUrl) ++ "/sync" ++ "?since=" ++ (nextBatch) ++ "&timeout=10000"
|
, url = (fullClientUrl apiUrl) ++ "/sync" ++ "?since=" ++ (nextBatch) ++ "&timeout=10000"
|
||||||
|
@ -37,6 +37,17 @@ sync nextBatch apiUrl token = request
|
||||||
, tracker = Nothing
|
, 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 -> ApiToken -> Int -> String -> String -> Cmd Msg
|
||||||
sendTextMessage apiUrl token transactionId room message = request
|
sendTextMessage apiUrl token transactionId room message = request
|
||||||
{ method = "PUT"
|
{ method = "PUT"
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
module Scylla.Model exposing (..)
|
module Scylla.Model exposing (..)
|
||||||
import Scylla.Api 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.Login exposing (LoginResponse, Username, Password)
|
||||||
import Scylla.UserData exposing (UserData)
|
import Scylla.UserData exposing (UserData)
|
||||||
import Scylla.Route exposing (Route(..), RoomId)
|
import Scylla.Route exposing (Route(..), RoomId)
|
||||||
|
@ -50,6 +50,8 @@ type Msg =
|
||||||
| ReceiveCompletedTypingIndicator (Result Http.Error ()) -- HTTP, typing indicator request completed
|
| ReceiveCompletedTypingIndicator (Result Http.Error ()) -- HTTP, typing indicator request completed
|
||||||
| ReceiveStoreData Json.Decode.Value -- We are send back a value on request from localStorage.
|
| ReceiveStoreData Json.Decode.Value -- We are send back a value on request from localStorage.
|
||||||
| TypingTick Posix -- Tick for updating the typing status
|
| 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 : Model -> Username -> String
|
||||||
displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData
|
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.Api exposing (..)
|
||||||
import Scylla.Notification exposing (..)
|
import Scylla.Notification exposing (..)
|
||||||
import Scylla.Login exposing (Username)
|
import Scylla.Login exposing (Username)
|
||||||
|
import Scylla.Route exposing (RoomId)
|
||||||
import Dict exposing (Dict)
|
import Dict exposing (Dict)
|
||||||
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field)
|
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field)
|
||||||
import Json.Decode.Pipeline exposing (required, optional)
|
import Json.Decode.Pipeline exposing (required, optional)
|
||||||
|
@ -258,6 +259,20 @@ presenceDecoder =
|
||||||
Decode.succeed Presence
|
Decode.succeed Presence
|
||||||
|> maybeDecode "events" (list eventDecoder)
|
|> 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
|
-- Business Logic
|
||||||
uniqueByRecursive : (a -> comparable) -> List a -> Set comparable -> List a
|
uniqueByRecursive : (a -> comparable) -> List a -> Set comparable -> List a
|
||||||
uniqueByRecursive f l s = case l of
|
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
|
mergeState s1 s2 = State <| mergeMaybe mergeStateEvents s1.events s2.events
|
||||||
|
|
||||||
mergeTimeline : Timeline -> Timeline -> Timeline
|
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 : Ephemeral -> Ephemeral -> Ephemeral
|
||||||
mergeEphemeral e1 e2 = Ephemeral <| mergeMaybe mergeEvents e1.events e2.events
|
mergeEphemeral e1 e2 = Ephemeral <| mergeMaybe mergeEvents e1.events e2.events
|
||||||
|
@ -374,6 +389,40 @@ mergeSyncResponse l r =
|
||||||
, accountData = mergeMaybe mergeAccountData l.accountData r.accountData
|
, 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
|
-- Business Logic: Names
|
||||||
senderName : String -> String
|
senderName : String -> String
|
||||||
senderName s =
|
senderName s =
|
||||||
|
|
|
@ -109,12 +109,12 @@ loginView m = div [ class "login-wrapper" ]
|
||||||
, button [ onClick AttemptLogin ] [ text "Log In" ]
|
, button [ onClick AttemptLogin ] [ text "Log In" ]
|
||||||
]
|
]
|
||||||
|
|
||||||
joinedRoomView : Model -> String -> JoinedRoom -> Html Msg
|
joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg
|
||||||
joinedRoomView m roomId jr =
|
joinedRoomView m roomId jr =
|
||||||
let
|
let
|
||||||
events = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
|
events = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
|
||||||
renderedEvents = List.filterMap (eventView m) events
|
renderedEvents = List.filterMap (eventView m) events
|
||||||
eventWrapper = eventWrapperView m renderedEvents
|
eventWrapper = eventWrapperView m roomId renderedEvents
|
||||||
typing = List.map (displayName m) <| roomTypingUsers jr
|
typing = List.map (displayName m) <| roomTypingUsers jr
|
||||||
typingText = String.join ", " typing
|
typingText = String.join ", " typing
|
||||||
typingSuffix = case List.length typing of
|
typingSuffix = case List.length typing of
|
||||||
|
@ -155,8 +155,11 @@ iconView name =
|
||||||
[ Svg.Attributes.class "feather-icon"
|
[ Svg.Attributes.class "feather-icon"
|
||||||
] [ Svg.use [ Svg.Attributes.xlinkHref (url ++ "#" ++ name) ] [] ]
|
] [ Svg.use [ Svg.Attributes.xlinkHref (url ++ "#" ++ name) ] [] ]
|
||||||
|
|
||||||
eventWrapperView : Model -> List (Html Msg) -> Html Msg
|
eventWrapperView : Model -> RoomId -> List (Html Msg) -> Html Msg
|
||||||
eventWrapperView m es = div [ class "events-wrapper", id "events-wrapper" ] [ table [ class "events-table" ] es ]
|
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 : Model -> RoomEvent -> Maybe (Html Msg)
|
||||||
eventView m re =
|
eventView m re =
|
||||||
|
|
|
@ -148,6 +148,14 @@ div.message-wrapper {
|
||||||
div.events-wrapper {
|
div.events-wrapper {
|
||||||
overflow-y: scroll;
|
overflow-y: scroll;
|
||||||
flex-grow: 1;
|
flex-grow: 1;
|
||||||
|
|
||||||
|
a.history-link {
|
||||||
|
display: block;
|
||||||
|
width: 100%;
|
||||||
|
text-align: center;
|
||||||
|
box-sizing: border-box;
|
||||||
|
padding: 5px;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
table.events-table {
|
table.events-table {
|
||||||
|
|
Loading…
Reference in New Issue
Block a user