Compare commits
14 Commits
ccfd2fe76b
...
master
| Author | SHA1 | Date | |
|---|---|---|---|
| 38968c3247 | |||
| 71845ae091 | |||
| 4505b4ba27 | |||
| 4ef8471585 | |||
| c3c2036c69 | |||
| c3ed5c4cd1 | |||
| 105f7e6012 | |||
| c594d9858f | |||
| 71e0b3f64e | |||
| 8627123143 | |||
| 5c02ae8a58 | |||
| 29e81a88ac | |||
| 676d6c28a7 | |||
| 595e28853e |
77
elm-dependencies.nix
Normal file
77
elm-dependencies.nix
Normal file
@@ -0,0 +1,77 @@
|
||||
{
|
||||
|
||||
"NoRedInk/elm-json-decode-pipeline" = {
|
||||
sha256 = "0y25xn0yx1q2xlg1yx1i0hg4xq1yxx6yfa99g272z8162si75hnl";
|
||||
version = "1.0.0";
|
||||
};
|
||||
|
||||
"elm/browser" = {
|
||||
sha256 = "1zlmx672glg7fdgkvh5jm47y85pv7pdfr5mkhg6x7ar6k000vyka";
|
||||
version = "1.0.1";
|
||||
};
|
||||
|
||||
"elm/core" = {
|
||||
sha256 = "1l0qdbczw91kzz8sx5d5zwz9x662bspy7p21dsr3f2rigxiix2as";
|
||||
version = "1.0.2";
|
||||
};
|
||||
|
||||
"elm/file" = {
|
||||
sha256 = "15vw1ilbg0msimq2k9magwigp8lwqrgvz3vk6qia6b3ldahvw8jr";
|
||||
version = "1.0.1";
|
||||
};
|
||||
|
||||
"elm/html" = {
|
||||
sha256 = "1n3gpzmpqqdsldys4ipgyl1zacn0kbpc3g4v3hdpiyfjlgh8bf3k";
|
||||
version = "1.0.0";
|
||||
};
|
||||
|
||||
"elm/http" = {
|
||||
sha256 = "008bs76mnp48b4dw8qwjj4fyvzbxvlrl4xpa2qh1gg2kfwyw56v1";
|
||||
version = "2.0.0";
|
||||
};
|
||||
|
||||
"elm/json" = {
|
||||
sha256 = "1a107nmm905dih4w4mjjkkpdcjbgaf5qjvr7fl30kkpkckfjjnrw";
|
||||
version = "1.1.2";
|
||||
};
|
||||
|
||||
"elm/svg" = {
|
||||
sha256 = "1cwcj73p61q45wqwgqvrvz3aypjyy3fw732xyxdyj6s256hwkn0k";
|
||||
version = "1.0.1";
|
||||
};
|
||||
|
||||
"elm/time" = {
|
||||
sha256 = "0vch7i86vn0x8b850w1p69vplll1bnbkp8s383z7pinyg94cm2z1";
|
||||
version = "1.0.0";
|
||||
};
|
||||
|
||||
"elm/url" = {
|
||||
sha256 = "0av8x5syid40sgpl5vd7pry2rq0q4pga28b4yykn9gd9v12rs3l4";
|
||||
version = "1.0.0";
|
||||
};
|
||||
|
||||
"hecrj/html-parser" = {
|
||||
sha256 = "0pla6hswsl9piwrj3yl4pc4nfs5adc4g4c93644j4xila7bqqg8a";
|
||||
version = "2.0.0";
|
||||
};
|
||||
|
||||
"elm/bytes" = {
|
||||
sha256 = "040d7irrawcbnq9jxhzx8p9qacdlw5bncy6lgndd6inm53rvvwbp";
|
||||
version = "1.0.7";
|
||||
};
|
||||
|
||||
"elm/parser" = {
|
||||
sha256 = "0a3cxrvbm7mwg9ykynhp7vjid58zsw03r63qxipxp3z09qks7512";
|
||||
version = "1.1.0";
|
||||
};
|
||||
|
||||
"elm/virtual-dom" = {
|
||||
sha256 = "0q1v5gi4g336bzz1lgwpn5b1639lrn63d8y6k6pimcyismp2i1yg";
|
||||
version = "1.0.2";
|
||||
};
|
||||
|
||||
"rtfeldman/elm-hex" = {
|
||||
sha256 = "1y0aa16asvwdqmgbskh5iba6psp43lkcjjw9mgzj3gsrg33lp00d";
|
||||
version = "1.0.0";
|
||||
};
|
||||
}
|
||||
4
elm.json
4
elm.json
@@ -3,7 +3,7 @@
|
||||
"source-directories": [
|
||||
"src"
|
||||
],
|
||||
"elm-version": "0.19.0",
|
||||
"elm-version": "0.19.1",
|
||||
"dependencies": {
|
||||
"direct": {
|
||||
"NoRedInk/elm-json-decode-pipeline": "1.0.0",
|
||||
@@ -29,4 +29,4 @@
|
||||
"direct": {},
|
||||
"indirect": {}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
56
elm.nix
Normal file
56
elm.nix
Normal file
@@ -0,0 +1,56 @@
|
||||
{ lib, stdenv, elm, fetchElmDeps, uglify-js, sass }:
|
||||
|
||||
let
|
||||
mkDerivation =
|
||||
{ srcs ? ./elm-dependencies.nix
|
||||
, src
|
||||
, name
|
||||
, srcdir ? "./src"
|
||||
, targets ? []
|
||||
, registryDat ? ./registry.dat
|
||||
, outputJavaScript ? false
|
||||
}:
|
||||
stdenv.mkDerivation {
|
||||
inherit name src;
|
||||
|
||||
buildInputs = [ elm sass ]
|
||||
++ lib.optional outputJavaScript uglify-js;
|
||||
|
||||
buildPhase = fetchElmDeps {
|
||||
elmPackages = import srcs;
|
||||
elmVersion = "0.19.1";
|
||||
inherit registryDat;
|
||||
};
|
||||
|
||||
installPhase = let
|
||||
elmfile = module: "${srcdir}/${builtins.replaceStrings ["."] ["/"] module}.elm";
|
||||
extension = if outputJavaScript then "js" else "html";
|
||||
in ''
|
||||
${lib.concatStrings (map (module: ''
|
||||
echo "compiling ${elmfile module}"
|
||||
elm make ${elmfile module} --optimize --output $out/${module}.${extension}
|
||||
${lib.optionalString outputJavaScript ''
|
||||
echo "minifying ${elmfile module}"
|
||||
uglifyjs $out/${module}.${extension} --compress 'pure_funcs="F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9",pure_getters,keep_fargs=false,unsafe_comps,unsafe' \
|
||||
| uglifyjs --mangle --output $out/${module}.min.${extension}
|
||||
''}
|
||||
'') targets)}
|
||||
|
||||
# Custom logic for Scylla in particular
|
||||
mkdir $out/static $out/static/js $out/static/css $out/static/svg
|
||||
cp $src/index.html $out/index.html
|
||||
cp $out/Main.min.js $out/static/js/elm.js
|
||||
cp $src/static/js/*.js $out/static/js
|
||||
cp $src/static/svg/*.svg $out/static/svg
|
||||
sass $src/static/scss/style.scss $out/static/css/style.css
|
||||
'';
|
||||
};
|
||||
in mkDerivation {
|
||||
name = "Scylla-0.1.0";
|
||||
srcs = ./elm-dependencies.nix;
|
||||
src = ./.;
|
||||
targets = ["Main"];
|
||||
srcdir = "./src";
|
||||
outputJavaScript = true;
|
||||
}
|
||||
|
||||
61
flake.lock
generated
Normal file
61
flake.lock
generated
Normal file
@@ -0,0 +1,61 @@
|
||||
{
|
||||
"nodes": {
|
||||
"flake-utils": {
|
||||
"inputs": {
|
||||
"systems": "systems"
|
||||
},
|
||||
"locked": {
|
||||
"lastModified": 1731533236,
|
||||
"narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
|
||||
"owner": "numtide",
|
||||
"repo": "flake-utils",
|
||||
"rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "numtide",
|
||||
"repo": "flake-utils",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"nixpkgs": {
|
||||
"locked": {
|
||||
"lastModified": 1766736597,
|
||||
"narHash": "sha256-BASnpCLodmgiVn0M1MU2Pqyoz0aHwar/0qLkp7CjvSQ=",
|
||||
"owner": "nixos",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "f560ccec6b1116b22e6ed15f4c510997d99d5852",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "nixos",
|
||||
"ref": "nixos-25.11",
|
||||
"repo": "nixpkgs",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"root": {
|
||||
"inputs": {
|
||||
"flake-utils": "flake-utils",
|
||||
"nixpkgs": "nixpkgs"
|
||||
}
|
||||
},
|
||||
"systems": {
|
||||
"locked": {
|
||||
"lastModified": 1681028828,
|
||||
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
|
||||
"owner": "nix-systems",
|
||||
"repo": "default",
|
||||
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "nix-systems",
|
||||
"repo": "default",
|
||||
"type": "github"
|
||||
}
|
||||
}
|
||||
},
|
||||
"root": "root",
|
||||
"version": 7
|
||||
}
|
||||
23
flake.nix
Normal file
23
flake.nix
Normal file
@@ -0,0 +1,23 @@
|
||||
{
|
||||
inputs = {
|
||||
nixpkgs.url = "github:nixos/nixpkgs/nixos-25.11";
|
||||
flake-utils.url = "github:numtide/flake-utils";
|
||||
};
|
||||
outputs = { self, nixpkgs, flake-utils }:
|
||||
flake-utils.lib.eachDefaultSystem (
|
||||
system:
|
||||
let
|
||||
pkgs = import nixpkgs { inherit system; };
|
||||
Scylla = import ./elm.nix {
|
||||
inherit (pkgs) lib stdenv sass;
|
||||
inherit (pkgs.elmPackages) fetchElmDeps elm;
|
||||
inherit (pkgs.nodePackages) uglify-js;
|
||||
};
|
||||
in
|
||||
{
|
||||
packages = { inherit Scylla; };
|
||||
defaultPackage = Scylla;
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
BIN
registry.dat
Normal file
BIN
registry.dat
Normal file
Binary file not shown.
92
src/Main.elm
92
src/Main.elm
@@ -1,7 +1,13 @@
|
||||
module Main exposing (..)
|
||||
import Browser exposing (application, UrlRequest(..))
|
||||
import Browser.Navigation as Nav
|
||||
import Browser.Dom exposing (Viewport, setViewportOf)
|
||||
import Scylla.Room exposing (OpenRooms, applySync)
|
||||
import Scylla.Sync exposing (..)
|
||||
import Scylla.Sync.Events exposing (toMessageEvent, getType, getSender, getUnsigned)
|
||||
import Scylla.Sync.AccountData exposing (..)
|
||||
import Scylla.Sync.Push exposing (..)
|
||||
import Scylla.ListUtils exposing (..)
|
||||
import Scylla.Messages exposing (..)
|
||||
import Scylla.Login exposing (..)
|
||||
import Scylla.Api exposing (..)
|
||||
@@ -9,11 +15,10 @@ import Scylla.Model exposing (..)
|
||||
import Scylla.Http exposing (..)
|
||||
import Scylla.Views exposing (viewFull)
|
||||
import Scylla.Route exposing (Route(..), RoomId)
|
||||
import Scylla.UserData exposing (..)
|
||||
import Scylla.Notification exposing (..)
|
||||
import Scylla.Storage exposing (..)
|
||||
import Scylla.Markdown exposing (..)
|
||||
import Scylla.AccountData exposing (..)
|
||||
import Scylla.Room exposing (..)
|
||||
import Url exposing (Url)
|
||||
import Url.Parser exposing (parse)
|
||||
import Url.Builder
|
||||
@@ -40,20 +45,15 @@ init _ url key =
|
||||
, loginUsername = ""
|
||||
, loginPassword = ""
|
||||
, apiUrl = "https://matrix.org"
|
||||
, sync =
|
||||
{ nextBatch = ""
|
||||
, rooms = Nothing
|
||||
, presence = Nothing
|
||||
, accountData = Nothing
|
||||
}
|
||||
, nextBatch = ""
|
||||
, accountData = { events = Just [] }
|
||||
, errors = []
|
||||
, roomText = Dict.empty
|
||||
, sending = Dict.empty
|
||||
, transactionId = 0
|
||||
, userData = Dict.empty
|
||||
, roomNames = Dict.empty
|
||||
, connected = True
|
||||
, searchText = ""
|
||||
, rooms = emptyOpenRooms
|
||||
}
|
||||
cmd = getStoreValuePort "scylla.loginInfo"
|
||||
in
|
||||
@@ -62,7 +62,7 @@ init _ url key =
|
||||
view : Model -> Browser.Document Msg
|
||||
view m =
|
||||
let
|
||||
notificationString = totalNotificationCountString m.sync
|
||||
notificationString = getTotalNotificationCountString m.rooms
|
||||
titleString = case notificationString of
|
||||
Nothing -> "Scylla"
|
||||
Just s -> s ++ " Scylla"
|
||||
@@ -85,7 +85,7 @@ update msg model = case msg of
|
||||
ReceiveLoginResponse a r -> updateLoginResponse model a r
|
||||
ReceiveFirstSyncResponse r -> updateSyncResponse model r False
|
||||
ReceiveSyncResponse r -> updateSyncResponse model r True
|
||||
ReceiveUserData s r -> updateUserData model s r
|
||||
ReceiveUserData s r -> (model, Cmd.none)
|
||||
ChangeRoomText r t -> updateChangeRoomText model r t
|
||||
SendRoomText r -> updateSendRoomText model r
|
||||
SendRoomTextResponse t r -> updateSendRoomTextResponse model t r
|
||||
@@ -111,12 +111,6 @@ update msg model = case msg of
|
||||
requestScrollCmd : Cmd Msg
|
||||
requestScrollCmd = Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "messages-wrapper")
|
||||
|
||||
newUsersCmd : Model -> List Username -> Cmd Msg
|
||||
newUsersCmd m us = m.token
|
||||
|> Maybe.map (\t -> List.map (userData m.apiUrl t) us)
|
||||
|> Maybe.withDefault []
|
||||
|> Cmd.batch
|
||||
|
||||
updateSendRoomTextResponse : Model -> Int -> Result Http.Error String -> (Model, Cmd Msg)
|
||||
updateSendRoomTextResponse m t r =
|
||||
let
|
||||
@@ -178,25 +172,15 @@ updateUploadSelected m rid f fs msg =
|
||||
|
||||
updateHistoryResponse : Model -> RoomId -> Result Http.Error HistoryResponse -> (Model, Cmd Msg)
|
||||
updateHistoryResponse m r hr =
|
||||
let
|
||||
userDataCmd h = newUsersCmd m
|
||||
<| newUsers m
|
||||
<| uniqueBy identity
|
||||
<| List.map .sender
|
||||
<| h.chunk
|
||||
in
|
||||
case hr of
|
||||
Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, userDataCmd h)
|
||||
Err _ -> ({ m | errors = "Unable to load older history from server"::m.errors }, Cmd.none)
|
||||
case hr of
|
||||
Ok h -> ({ m | rooms = applyHistoryResponse r h m.rooms }, Cmd.none)
|
||||
Err _ -> ({ m | errors = "Unable to load older history from server"::m.errors }, 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
|
||||
prevBatch = Dict.get r m.rooms
|
||||
|> Maybe.andThen (.prevHistoryBatch)
|
||||
command = case prevBatch of
|
||||
Just pv -> getHistory m.apiUrl (Maybe.withDefault "" m.token) r pv
|
||||
Nothing -> Cmd.none
|
||||
@@ -251,9 +235,10 @@ updateChangeRoute : Model -> Route -> (Model, Cmd Msg)
|
||||
updateChangeRoute m r =
|
||||
let
|
||||
joinedRoom = case r of
|
||||
Room rid -> Maybe.andThen (Dict.get rid) <| Maybe.andThen .join <| m.sync.rooms
|
||||
Room rid -> Dict.get rid m.rooms
|
||||
_ -> Nothing
|
||||
lastMessage = Maybe.andThen (findLastEvent (((==) "m.room.message") << .type_)) <| Maybe.andThen .events <| Maybe.andThen .timeline joinedRoom
|
||||
lastMessage = Maybe.map .messages joinedRoom
|
||||
|> Maybe.andThen (findLastEvent (((==) "m.room.message") << .type_))
|
||||
readMarkerCmd = case (r, lastMessage) of
|
||||
(Room rid, Just re) -> setReadMarkers m.apiUrl (Maybe.withDefault "" m.token) rid re.eventId <| Just re.eventId
|
||||
_ -> Cmd.none
|
||||
@@ -269,11 +254,6 @@ updateViewportAfterMessage m vr =
|
||||
in
|
||||
(m, Result.withDefault Cmd.none <| Result.map cmd vr)
|
||||
|
||||
updateUserData : Model -> String -> Result Http.Error UserData -> (Model, Cmd Msg)
|
||||
updateUserData m s r = case r of
|
||||
Ok ud -> ({ m | userData = Dict.insert s ud m.userData }, Cmd.none)
|
||||
Err e -> ({ m | errors = ("Failed to retrieve user data for user " ++ s)::m.errors }, Cmd.none)
|
||||
|
||||
updateSendRoomText : Model -> RoomId -> (Model, Cmd Msg)
|
||||
updateSendRoomText m r =
|
||||
let
|
||||
@@ -309,21 +289,21 @@ updateSyncResponse : Model -> Result Http.Error SyncResponse -> Bool -> (Model,
|
||||
updateSyncResponse model r notify =
|
||||
let
|
||||
token = Maybe.withDefault "" model.token
|
||||
nextBatch = Result.withDefault model.sync.nextBatch
|
||||
nextBatch = Result.withDefault model.nextBatch
|
||||
<| Result.map .nextBatch r
|
||||
syncCmd = sync model.apiUrl token nextBatch
|
||||
userDataCmd sr = newUsersCmd model
|
||||
<| newUsers model
|
||||
<| allUsers sr
|
||||
notification sr = findFirstBy
|
||||
(\(s, e) -> e.originServerTs)
|
||||
(\(s, e) -> e.sender /= model.loginUsername)
|
||||
<| joinedRoomNotificationEvents sr
|
||||
notification sr =
|
||||
getPushRuleset model.accountData
|
||||
|> Maybe.map (\rs -> getNotificationEvents rs sr)
|
||||
|> Maybe.withDefault []
|
||||
|> findFirstBy
|
||||
(\(s, e) -> e.originServerTs)
|
||||
(\(s, e) -> e.sender /= model.loginUsername)
|
||||
notificationCmd sr = if notify
|
||||
then Maybe.withDefault Cmd.none
|
||||
<| Maybe.map (\(s, e) -> sendNotificationPort
|
||||
{ name = displayName model.userData e.sender
|
||||
, text = notificationText e
|
||||
{ name = roomLocalDisplayName model s e.sender
|
||||
, text = getText e
|
||||
, room = s
|
||||
}) <| notification sr
|
||||
else Cmd.none
|
||||
@@ -331,6 +311,7 @@ updateSyncResponse model r notify =
|
||||
roomMessages sr = case room of
|
||||
Just rid -> List.filter (((==) "m.room.message") << .type_)
|
||||
<| Maybe.withDefault []
|
||||
<| Maybe.map (List.filterMap (toMessageEvent))
|
||||
<| Maybe.andThen .events
|
||||
<| Maybe.andThen .timeline
|
||||
<| Maybe.andThen (Dict.get rid)
|
||||
@@ -345,21 +326,20 @@ updateSyncResponse model r notify =
|
||||
(Just rid, Just re) -> setReadMarkers model.apiUrl token rid re.eventId <| Just re.eventId
|
||||
_ -> Cmd.none
|
||||
receivedEvents sr = List.map Just <| allTimelineEventIds sr
|
||||
receivedTransactions sr = List.filterMap (Maybe.andThen .transactionId << .unsigned)
|
||||
receivedTransactions sr = List.filterMap (Maybe.andThen .transactionId << getUnsigned)
|
||||
<| allTimelineEvents sr
|
||||
sending sr = Dict.filter (\tid (rid, { body, id }) -> not <| List.member (String.fromInt tid) <| receivedTransactions sr) model.sending
|
||||
newSync sr = mergeSyncResponse model.sync sr
|
||||
newModel sr =
|
||||
{ model | sync = newSync sr
|
||||
, sending = sending (mergeSyncResponse model.sync sr)
|
||||
, roomNames = computeRoomsDisplayNames model.userData (newSync sr)
|
||||
{ model | nextBatch = nextBatch
|
||||
, sending = sending sr
|
||||
, rooms = applySync sr model.rooms
|
||||
, accountData = applyAccountData sr.accountData model.accountData
|
||||
}
|
||||
in
|
||||
case r of
|
||||
Ok sr -> (newModel sr
|
||||
, Cmd.batch
|
||||
[ syncCmd
|
||||
, userDataCmd sr
|
||||
, notificationCmd sr
|
||||
, setScrollCmd sr
|
||||
, setReadReceiptCmd sr
|
||||
|
||||
@@ -1,21 +0,0 @@
|
||||
module Scylla.AccountData exposing (..)
|
||||
import Scylla.Sync exposing (SyncResponse, AccountData, JoinedRoom, roomAccountData)
|
||||
import Json.Decode as Decode
|
||||
import Json.Encode as Encode
|
||||
import Dict exposing (Dict)
|
||||
|
||||
type alias DirectMessages = Dict String String
|
||||
type alias DirectMessagesRaw = Dict String (List String)
|
||||
|
||||
directMessagesDecoder : Decode.Decoder DirectMessages
|
||||
directMessagesDecoder =
|
||||
Decode.dict (Decode.list Decode.string)
|
||||
|> Decode.map (invertDirectMessages)
|
||||
|
||||
invertDirectMessages : DirectMessagesRaw -> DirectMessages
|
||||
invertDirectMessages dmr =
|
||||
Dict.foldl
|
||||
(\k lv acc -> List.foldl (\v -> Dict.insert v k) acc lv)
|
||||
Dict.empty
|
||||
dmr
|
||||
|
||||
@@ -138,8 +138,8 @@ login apiUrl username password = request
|
||||
, tracker = Nothing
|
||||
}
|
||||
|
||||
userData : ApiUrl -> ApiToken -> Username -> Cmd Msg
|
||||
userData apiUrl token username = request
|
||||
getUserData : ApiUrl -> ApiToken -> Username -> Cmd Msg
|
||||
getUserData apiUrl token username = request
|
||||
{ method = "GET"
|
||||
, headers = authenticatedHeaders token
|
||||
, url = (fullClientUrl apiUrl) ++ "/profile/" ++ username
|
||||
|
||||
39
src/Scylla/ListUtils.elm
Normal file
39
src/Scylla/ListUtils.elm
Normal file
@@ -0,0 +1,39 @@
|
||||
module Scylla.ListUtils exposing (..)
|
||||
import Dict exposing (Dict)
|
||||
import Set exposing (Set)
|
||||
|
||||
groupBy : (a -> comparable) -> List a -> Dict comparable (List a)
|
||||
groupBy f xs =
|
||||
let
|
||||
update v ml = case ml of
|
||||
Just l -> Just (v::l)
|
||||
Nothing -> Just [ v ]
|
||||
in
|
||||
List.foldl (\v acc -> Dict.update (f v) (update v) acc) Dict.empty xs
|
||||
|
||||
uniqueByTailRecursive : (a -> comparable) -> List a -> Set comparable -> List a -> List a
|
||||
uniqueByTailRecursive f l s acc =
|
||||
case l of
|
||||
x::tail ->
|
||||
if Set.member (f x) s
|
||||
then uniqueByTailRecursive f tail s acc
|
||||
else uniqueByTailRecursive f tail (Set.insert (f x) s) (x::acc)
|
||||
[] -> List.reverse acc
|
||||
|
||||
uniqueBy : (a -> comparable) -> List a -> List a
|
||||
uniqueBy f l = uniqueByTailRecursive f l Set.empty []
|
||||
|
||||
findFirst : (a -> Bool) -> List a -> Maybe a
|
||||
findFirst cond l = case l of
|
||||
x::xs -> if cond x then Just x else findFirst cond xs
|
||||
[] -> Nothing
|
||||
|
||||
findLast : (a -> Bool) -> List a -> Maybe a
|
||||
findLast cond l = findFirst cond <| List.reverse l
|
||||
|
||||
findFirstBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
|
||||
findFirstBy sortFunction cond l = findFirst cond <| List.sortBy sortFunction l
|
||||
|
||||
findLastBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
|
||||
findLastBy sortFunction cond l = findLast cond <| List.sortBy sortFunction l
|
||||
|
||||
@@ -1,7 +1,8 @@
|
||||
module Scylla.Messages exposing (..)
|
||||
import Scylla.Sync exposing (RoomEvent)
|
||||
import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
|
||||
import Scylla.Login exposing (Username)
|
||||
import Scylla.Route exposing (RoomId)
|
||||
import Scylla.Room exposing (RoomData)
|
||||
import Dict exposing (Dict)
|
||||
|
||||
type SendingMessageBody = TextMessage String
|
||||
@@ -13,15 +14,15 @@ type alias SendingMessage =
|
||||
|
||||
type Message
|
||||
= Sending SendingMessage
|
||||
| Received RoomEvent
|
||||
| Received MessageEvent
|
||||
|
||||
messageUsername : Username -> Message -> Username
|
||||
messageUsername u msg = case msg of
|
||||
getUsername : Username -> Message -> Username
|
||||
getUsername u msg = case msg of
|
||||
Sending _ -> u
|
||||
Received re -> re.sender
|
||||
|
||||
mergeMessages : Username -> List Message -> List (Username, List Message)
|
||||
mergeMessages du xs =
|
||||
groupMessages : Username -> List Message -> List (Username, List Message)
|
||||
groupMessages du xs =
|
||||
let
|
||||
initialState = (Nothing, [], [])
|
||||
appendNamed mu ms msl = case mu of
|
||||
@@ -29,18 +30,19 @@ mergeMessages du xs =
|
||||
Nothing -> msl
|
||||
foldFunction msg (pu, ms, msl) =
|
||||
let
|
||||
nu = Just <| messageUsername du msg
|
||||
nu = Just <| getUsername du msg
|
||||
in
|
||||
if pu == nu then (pu, ms ++ [msg], msl) else (nu, [msg], appendNamed pu ms msl)
|
||||
(fmu, fms, fmsl) = List.foldl foldFunction initialState xs
|
||||
in
|
||||
appendNamed fmu fms fmsl
|
||||
|
||||
receivedMessagesRoom : List RoomEvent -> List Message
|
||||
receivedMessagesRoom es = List.map Received
|
||||
<| List.filter (\e -> e.type_ == "m.room.message") es
|
||||
getReceivedMessages : RoomData -> List Message
|
||||
getReceivedMessages rd = rd.messages
|
||||
|> List.filter (\e -> e.type_ == "m.room.message")
|
||||
|> List.map Received
|
||||
|
||||
sendingMessagesRoom : RoomId -> Dict Int (RoomId, SendingMessage) -> List Message
|
||||
sendingMessagesRoom rid ms = List.map (\(tid, (_, sm)) -> Sending sm)
|
||||
getSendingMessages : RoomId -> Dict Int (RoomId, SendingMessage) -> List Message
|
||||
getSendingMessages rid ms = List.map (\(tid, (_, sm)) -> Sending sm)
|
||||
<| List.filter (\(_, (nrid, _)) -> nrid == rid)
|
||||
<| Dict.toList ms
|
||||
|
||||
@@ -1,9 +1,14 @@
|
||||
module Scylla.Model exposing (..)
|
||||
import Scylla.Api exposing (..)
|
||||
import Scylla.Sync exposing (SyncResponse, HistoryResponse, JoinedRoom, senderName, roomName, roomJoinedUsers, findFirst, AccountData)
|
||||
import Scylla.AccountData exposing (directMessagesDecoder)
|
||||
import Scylla.Room exposing (getLocalDisplayName)
|
||||
import Scylla.Sync exposing (SyncResponse, HistoryResponse)
|
||||
import Scylla.ListUtils exposing (findFirst)
|
||||
import Scylla.Room exposing (OpenRooms)
|
||||
import Scylla.UserData exposing (UserData, getSenderName)
|
||||
import Scylla.Sync.Rooms exposing (JoinedRoom)
|
||||
import Scylla.Sync.Push exposing (Ruleset)
|
||||
import Scylla.Sync.AccountData exposing (AccountData, directMessagesDecoder)
|
||||
import Scylla.Login exposing (LoginResponse, Username, Password)
|
||||
import Scylla.UserData exposing (UserData)
|
||||
import Scylla.Route exposing (Route(..), RoomId)
|
||||
import Scylla.Messages exposing (..)
|
||||
import Scylla.Storage exposing (..)
|
||||
@@ -26,15 +31,15 @@ type alias Model =
|
||||
, loginUsername : Username
|
||||
, loginPassword : Password
|
||||
, apiUrl : ApiUrl
|
||||
, sync : SyncResponse
|
||||
, accountData : AccountData
|
||||
, nextBatch : String
|
||||
, errors : List String
|
||||
, roomText : Dict RoomId String
|
||||
, sending : Dict Int (RoomId, SendingMessage)
|
||||
, transactionId : Int
|
||||
, userData : Dict Username UserData
|
||||
, roomNames : Dict RoomId String
|
||||
, connected : Bool
|
||||
, searchText : String
|
||||
, rooms : OpenRooms
|
||||
}
|
||||
|
||||
type Msg =
|
||||
@@ -73,58 +78,19 @@ type Msg =
|
||||
| AttemptReconnect -- User wants to reconnect to server
|
||||
| UpdateSearchText String -- Change search text in room list
|
||||
|
||||
displayName : Dict String UserData -> Username -> String
|
||||
displayName ud s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s ud
|
||||
|
||||
roomDisplayName : Dict RoomId String -> RoomId -> String
|
||||
roomDisplayName rd rid =
|
||||
Maybe.withDefault "<No Name>" <| Dict.get rid rd
|
||||
|
||||
computeRoomDisplayName : Dict String UserData -> Maybe AccountData -> RoomId -> JoinedRoom -> Maybe String
|
||||
computeRoomDisplayName ud ad rid jr =
|
||||
let
|
||||
customName = roomName jr
|
||||
direct = ad
|
||||
|> Maybe.andThen .events
|
||||
|> Maybe.andThen (findFirst ((==) "m.direct" << .type_))
|
||||
|> Maybe.map (Decode.decodeValue directMessagesDecoder << .content)
|
||||
|> Maybe.andThen Result.toMaybe
|
||||
|> Maybe.andThen (Dict.get rid)
|
||||
in
|
||||
case (customName, direct) of
|
||||
(Just s, _) -> customName
|
||||
(_, Just u) -> direct
|
||||
_ -> Nothing
|
||||
|
||||
computeRoomsDisplayNames : Dict String UserData -> SyncResponse -> Dict String String
|
||||
computeRoomsDisplayNames ud sr =
|
||||
sr.rooms
|
||||
|> Maybe.andThen .join
|
||||
|> Maybe.map Dict.toList
|
||||
|> Maybe.map (List.foldl
|
||||
(\(rid, jr) d ->
|
||||
computeRoomDisplayName ud sr.accountData rid jr
|
||||
|> Maybe.map (\n -> Dict.insert rid n d)
|
||||
|> Maybe.withDefault d) Dict.empty)
|
||||
|> Maybe.withDefault Dict.empty
|
||||
|
||||
roomUrl : String -> String
|
||||
roomUrl s = Url.Builder.absolute [ "room", s ] []
|
||||
|
||||
loginUrl : String
|
||||
loginUrl = Url.Builder.absolute [ "login" ] []
|
||||
|
||||
newUsers : Model -> List Username -> List Username
|
||||
newUsers m lus = List.filter (\u -> not <| Dict.member u m.userData) lus
|
||||
|
||||
joinedRooms : Model -> Dict RoomId JoinedRoom
|
||||
joinedRooms m = Maybe.withDefault Dict.empty <| Maybe.andThen .join <| m.sync.rooms
|
||||
|
||||
currentRoom : Model -> Maybe JoinedRoom
|
||||
currentRoom m =
|
||||
Maybe.andThen (\s -> Dict.get s <| joinedRooms m) <| currentRoomId m
|
||||
|
||||
currentRoomId : Model -> Maybe RoomId
|
||||
currentRoomId m = case m.route of
|
||||
Room r -> Just r
|
||||
_ -> Nothing
|
||||
|
||||
roomLocalDisplayName : Model -> RoomId -> Username -> String
|
||||
roomLocalDisplayName m rid u =
|
||||
case Dict.get rid m.rooms of
|
||||
Just rd -> getLocalDisplayName rd u
|
||||
_ -> getSenderName u
|
||||
|
||||
@@ -1,6 +1,7 @@
|
||||
port module Scylla.Notification exposing (..)
|
||||
import Scylla.Sync exposing (SyncResponse, RoomEvent, joinedRoomsTimelineEvents)
|
||||
import Scylla.AccountData exposing (..)
|
||||
import Scylla.Sync exposing (SyncResponse, joinedRoomsTimelineEvents)
|
||||
import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
|
||||
import Scylla.Sync.Push exposing (Ruleset, getEventNotification)
|
||||
import Json.Decode as Decode exposing (string, field)
|
||||
import Dict
|
||||
|
||||
@@ -13,17 +14,19 @@ type alias Notification =
|
||||
port sendNotificationPort : Notification -> Cmd msg
|
||||
port onNotificationClickPort : (String -> msg) -> Sub msg
|
||||
|
||||
notificationText : RoomEvent -> String
|
||||
notificationText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
|
||||
getText : MessageEvent -> String
|
||||
getText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
|
||||
Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content)
|
||||
_ -> ""
|
||||
|
||||
joinedRoomNotificationEvents : SyncResponse -> List (String, RoomEvent)
|
||||
joinedRoomNotificationEvents s =
|
||||
let
|
||||
applyPair k = List.map (\v -> (k, v))
|
||||
in
|
||||
List.sortBy (\(k, v) -> v.originServerTs)
|
||||
<| Dict.foldl (\k v a -> a ++ applyPair k v) []
|
||||
<| joinedRoomsTimelineEvents s
|
||||
|
||||
getNotificationEvents : Ruleset -> SyncResponse -> List (String, MessageEvent)
|
||||
getNotificationEvents rs s = s.rooms
|
||||
|> Maybe.andThen .join
|
||||
|> Maybe.map (Dict.map (\k v -> v.timeline
|
||||
|> Maybe.andThen .events
|
||||
|> Maybe.map (List.filter <| getEventNotification rs k)
|
||||
|> Maybe.map (List.filterMap <| toMessageEvent)
|
||||
|> Maybe.withDefault []))
|
||||
|> Maybe.withDefault Dict.empty
|
||||
|> Dict.toList
|
||||
|> List.concatMap (\(k, vs) -> List.map (\v -> (k, v)) vs)
|
||||
|
||||
187
src/Scylla/Room.elm
Normal file
187
src/Scylla/Room.elm
Normal file
@@ -0,0 +1,187 @@
|
||||
module Scylla.Room exposing (..)
|
||||
import Scylla.Route exposing (RoomId)
|
||||
import Scylla.Sync exposing (SyncResponse)
|
||||
import Scylla.Login exposing (Username)
|
||||
import Scylla.UserData exposing (getSenderName)
|
||||
import Scylla.Sync exposing (HistoryResponse)
|
||||
import Scylla.Sync.Events exposing (MessageEvent, StateEvent, toStateEvent, toMessageEvent)
|
||||
import Scylla.Sync.AccountData exposing (AccountData, getDirectMessages, applyAccountData)
|
||||
import Scylla.Sync.Rooms exposing (JoinedRoom, UnreadNotificationCounts, Ephemeral)
|
||||
import Scylla.ListUtils exposing (findFirst, uniqueBy)
|
||||
import Json.Decode as Decode exposing (Decoder, Value, decodeValue, field, string, list)
|
||||
import Dict exposing (Dict)
|
||||
|
||||
type alias RoomState = Dict (String, String) Value
|
||||
|
||||
type alias RoomData =
|
||||
{ roomState : RoomState
|
||||
, messages : List (MessageEvent)
|
||||
, accountData : AccountData
|
||||
, ephemeral : Ephemeral
|
||||
, unreadNotifications : UnreadNotificationCounts
|
||||
, prevHistoryBatch : Maybe String
|
||||
, text : String
|
||||
}
|
||||
|
||||
type alias OpenRooms = Dict RoomId RoomData
|
||||
|
||||
emptyOpenRooms : OpenRooms
|
||||
emptyOpenRooms = Dict.empty
|
||||
|
||||
emptyRoomData : RoomData
|
||||
emptyRoomData =
|
||||
{ roomState = Dict.empty
|
||||
, messages = []
|
||||
, accountData = { events = Just [] }
|
||||
, ephemeral = { events = Just [] }
|
||||
, unreadNotifications =
|
||||
{ highlightCount = Just 0
|
||||
, notificationCount = Just 0
|
||||
}
|
||||
, prevHistoryBatch = Nothing
|
||||
, text = ""
|
||||
}
|
||||
|
||||
changeRoomStateEvent : StateEvent -> RoomState -> RoomState
|
||||
changeRoomStateEvent se = Dict.insert (se.type_, se.stateKey) se.content
|
||||
|
||||
changeRoomStateEvents : List StateEvent -> RoomState -> RoomState
|
||||
changeRoomStateEvents es rs = List.foldr (changeRoomStateEvent) rs es
|
||||
|
||||
changeRoomState : JoinedRoom -> RoomState -> RoomState
|
||||
changeRoomState jr rs =
|
||||
let
|
||||
stateDiff = jr.state
|
||||
|> Maybe.andThen .events
|
||||
|> Maybe.withDefault []
|
||||
timelineDiff = jr.timeline
|
||||
|> Maybe.andThen .events
|
||||
|> Maybe.map (List.filterMap toStateEvent)
|
||||
|> Maybe.withDefault []
|
||||
in
|
||||
rs
|
||||
|> changeRoomStateEvents stateDiff
|
||||
|> changeRoomStateEvents timelineDiff
|
||||
|
||||
changeTimeline : JoinedRoom -> List (MessageEvent) -> List (MessageEvent)
|
||||
changeTimeline jr tl =
|
||||
let
|
||||
newMessages = jr.timeline
|
||||
|> Maybe.andThen .events
|
||||
|> Maybe.map (List.filterMap toMessageEvent)
|
||||
|> Maybe.withDefault []
|
||||
in
|
||||
tl ++ newMessages
|
||||
|
||||
changeEphemeral : JoinedRoom -> Ephemeral -> Ephemeral
|
||||
changeEphemeral jr e = Maybe.withDefault e jr.ephemeral
|
||||
|
||||
changeNotifications : JoinedRoom -> UnreadNotificationCounts -> UnreadNotificationCounts
|
||||
changeNotifications jr un = Maybe.withDefault un jr.unreadNotifications
|
||||
|
||||
changeRoomData : JoinedRoom -> RoomData -> RoomData
|
||||
changeRoomData jr rd =
|
||||
{ rd | accountData = applyAccountData jr.accountData rd.accountData
|
||||
, roomState = changeRoomState jr rd.roomState
|
||||
, messages = changeTimeline jr rd.messages
|
||||
, ephemeral = changeEphemeral jr rd.ephemeral
|
||||
, unreadNotifications = changeNotifications jr rd.unreadNotifications
|
||||
, prevHistoryBatch =
|
||||
case rd.prevHistoryBatch of
|
||||
Nothing -> Maybe.andThen .prevBatch jr.timeline
|
||||
Just _ -> rd.prevHistoryBatch
|
||||
}
|
||||
|
||||
updateRoomData : JoinedRoom -> Maybe RoomData -> Maybe RoomData
|
||||
updateRoomData jr mrd = Maybe.withDefault emptyRoomData mrd
|
||||
|> changeRoomData jr
|
||||
|> Just
|
||||
|
||||
applyJoinedRoom : RoomId -> JoinedRoom -> OpenRooms -> OpenRooms
|
||||
applyJoinedRoom rid jr = Dict.update rid (updateRoomData jr)
|
||||
|
||||
applySync : SyncResponse -> OpenRooms -> OpenRooms
|
||||
applySync sr or =
|
||||
let
|
||||
joinedRooms = sr.rooms
|
||||
|> Maybe.andThen .join
|
||||
|> Maybe.withDefault Dict.empty
|
||||
in
|
||||
Dict.foldl applyJoinedRoom or joinedRooms
|
||||
|
||||
addHistoryRoomData : HistoryResponse -> Maybe RoomData -> Maybe RoomData
|
||||
addHistoryRoomData hr = Maybe.map
|
||||
(\rd ->
|
||||
{ rd | messages = uniqueBy .eventId
|
||||
<| (List.reverse <| List.filterMap toMessageEvent hr.chunk) ++ rd.messages
|
||||
, prevHistoryBatch = Just hr.end
|
||||
})
|
||||
|
||||
applyHistoryResponse : RoomId -> HistoryResponse -> OpenRooms -> OpenRooms
|
||||
applyHistoryResponse rid hr = Dict.update rid (addHistoryRoomData hr)
|
||||
|
||||
getStateData : (String, String) -> Decoder a -> RoomData -> Maybe a
|
||||
getStateData k d rd = Dict.get k rd.roomState
|
||||
|> Maybe.andThen (Result.toMaybe << decodeValue d)
|
||||
|
||||
getEphemeralData : String -> Decoder a -> RoomData -> Maybe a
|
||||
getEphemeralData k d rd = rd.ephemeral.events
|
||||
|> Maybe.andThen (findFirst ((==) k << .type_))
|
||||
|> Maybe.andThen (Result.toMaybe << decodeValue d << .content)
|
||||
|
||||
getRoomTypingUsers : RoomData -> List String
|
||||
getRoomTypingUsers = Maybe.withDefault []
|
||||
<< getEphemeralData "m.typing" (field "user_ids" (list string))
|
||||
|
||||
getRoomName : AccountData -> RoomId -> RoomData -> String
|
||||
getRoomName ad rid rd =
|
||||
let
|
||||
customName = getStateData ("m.room.name", "") (field "name" (string)) rd
|
||||
direct = getDirectMessages ad
|
||||
|> Maybe.andThen (Dict.get rid)
|
||||
in
|
||||
case (customName, direct) of
|
||||
(Just cn, _) -> cn
|
||||
(_, Just d) -> getLocalDisplayName rd d
|
||||
_ -> rid
|
||||
|
||||
getLocalDisplayName : RoomData -> Username -> String
|
||||
getLocalDisplayName rd u =
|
||||
getStateData ("m.room.member", u) (field "displayname" string) rd
|
||||
|> Maybe.withDefault (getSenderName u)
|
||||
|
||||
getNotificationCount : RoomData -> (Int, Int)
|
||||
getNotificationCount rd =
|
||||
( Maybe.withDefault 0 rd.unreadNotifications.notificationCount
|
||||
, Maybe.withDefault 0 rd.unreadNotifications.highlightCount
|
||||
)
|
||||
|
||||
getTotalNotificationCount : OpenRooms -> (Int, Int)
|
||||
getTotalNotificationCount =
|
||||
let
|
||||
sumTuples (x1, y1) (x2, y2) = (x1+x2, y1+y2)
|
||||
in
|
||||
Dict.foldl (\_ -> sumTuples << getNotificationCount) (0, 0)
|
||||
|
||||
getTotalNotificationCountString : OpenRooms -> Maybe String
|
||||
getTotalNotificationCountString or =
|
||||
let
|
||||
(n, h) = getTotalNotificationCount or
|
||||
suffix = case h of
|
||||
0 -> ""
|
||||
_ -> "!"
|
||||
in
|
||||
case n of
|
||||
0 -> Nothing
|
||||
_ -> Just <| "(" ++ String.fromInt n ++ suffix ++ ")"
|
||||
|
||||
getHomeserver : String -> String
|
||||
getHomeserver s =
|
||||
let
|
||||
colonIndex = Maybe.withDefault 0
|
||||
<| Maybe.map ((+) 1)
|
||||
<| List.head
|
||||
<| String.indexes ":" s
|
||||
in
|
||||
String.dropLeft colonIndex s
|
||||
|
||||
@@ -2,223 +2,16 @@ module Scylla.Sync exposing (..)
|
||||
import Scylla.Api exposing (..)
|
||||
import Scylla.Login exposing (Username)
|
||||
import Scylla.Route exposing (RoomId)
|
||||
import Scylla.ListUtils exposing (..)
|
||||
import Scylla.Sync.DecodeTools exposing (maybeDecode)
|
||||
import Scylla.Sync.Events exposing (..)
|
||||
import Scylla.Sync.Rooms exposing (..)
|
||||
import Scylla.Sync.AccountData exposing (..)
|
||||
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)
|
||||
import Set exposing (Set)
|
||||
|
||||
-- Special Decoding
|
||||
decodeJust : Decoder a -> Decoder (Maybe a)
|
||||
decodeJust = Decode.map Just
|
||||
|
||||
maybeDecode : String -> Decoder a -> Decoder (Maybe a -> b) -> Decoder b
|
||||
maybeDecode s d = optional s (decodeJust d) Nothing
|
||||
|
||||
-- General Events
|
||||
type alias Event =
|
||||
{ content : Decode.Value
|
||||
, type_ : String
|
||||
}
|
||||
|
||||
eventDecoder : Decoder Event
|
||||
eventDecoder =
|
||||
Decode.succeed Event
|
||||
|> required "content" value
|
||||
|> required "type" string
|
||||
|
||||
type alias EventContent = Decode.Value
|
||||
|
||||
eventContentDecoder : Decoder EventContent
|
||||
eventContentDecoder = Decode.value
|
||||
|
||||
-- Unsigned Data
|
||||
type alias UnsignedData =
|
||||
{ age : Maybe Int
|
||||
, redactedBecause : Maybe Event
|
||||
, transactionId : Maybe String
|
||||
}
|
||||
|
||||
unsignedDataDecoder : Decoder UnsignedData
|
||||
unsignedDataDecoder =
|
||||
Decode.succeed UnsignedData
|
||||
|> maybeDecode "age" int
|
||||
|> maybeDecode "redacted_because" eventDecoder
|
||||
|> maybeDecode "transaction_id" string
|
||||
|
||||
-- State
|
||||
type alias State =
|
||||
{ events : Maybe (List StateEvent)
|
||||
}
|
||||
|
||||
stateDecoder : Decoder State
|
||||
stateDecoder =
|
||||
Decode.succeed State
|
||||
|> maybeDecode "events" (list stateEventDecoder)
|
||||
|
||||
type alias StateEvent =
|
||||
{ content : Decode.Value
|
||||
, type_ : String
|
||||
, eventId : String
|
||||
, sender : String
|
||||
, originServerTs : Int
|
||||
, unsigned : Maybe UnsignedData
|
||||
, prevContent : Maybe EventContent
|
||||
, stateKey : String
|
||||
}
|
||||
|
||||
stateEventDecoder : Decoder StateEvent
|
||||
stateEventDecoder =
|
||||
Decode.succeed StateEvent
|
||||
|> required "content" value
|
||||
|> required "type" string
|
||||
|> required "event_id" string
|
||||
|> required "sender" string
|
||||
|> required "origin_server_ts" int
|
||||
|> maybeDecode "unsigned" unsignedDataDecoder
|
||||
|> maybeDecode "prev_content" eventContentDecoder
|
||||
|> required "state_key" string
|
||||
|
||||
-- Rooms
|
||||
type alias Rooms =
|
||||
{ join : Maybe (Dict String JoinedRoom)
|
||||
, invite : Maybe (Dict String InvitedRoom)
|
||||
, leave : Maybe (Dict String LeftRoom)
|
||||
}
|
||||
|
||||
roomsDecoder : Decoder Rooms
|
||||
roomsDecoder =
|
||||
Decode.succeed Rooms
|
||||
|> maybeDecode "join" (dict joinedRoomDecoder)
|
||||
|> maybeDecode "invite" (dict invitedRoomDecoder)
|
||||
|> maybeDecode "leave" (dict leftRoomDecoder)
|
||||
|
||||
type alias JoinedRoom =
|
||||
{ state : Maybe State
|
||||
, timeline : Maybe Timeline
|
||||
, ephemeral : Maybe Ephemeral
|
||||
, accountData : Maybe AccountData
|
||||
, unreadNotifications : Maybe UnreadNotificationCounts
|
||||
}
|
||||
|
||||
joinedRoomDecoder : Decoder JoinedRoom
|
||||
joinedRoomDecoder =
|
||||
Decode.succeed JoinedRoom
|
||||
|> maybeDecode "state" stateDecoder
|
||||
|> maybeDecode "timeline" timelineDecoder
|
||||
|> maybeDecode "ephemeral" ephemeralDecoder
|
||||
|> maybeDecode "account_data" accountDataDecoder
|
||||
|> maybeDecode "unread_notifications" unreadNotificationCountsDecoder
|
||||
|
||||
|
||||
-- Joined Room Data
|
||||
type alias Timeline =
|
||||
{ events : Maybe (List RoomEvent)
|
||||
, limited : Maybe Bool
|
||||
, prevBatch : Maybe String
|
||||
}
|
||||
|
||||
timelineDecoder =
|
||||
Decode.succeed Timeline
|
||||
|> maybeDecode "events" (list roomEventDecoder)
|
||||
|> maybeDecode "limited" bool
|
||||
|> maybeDecode "prev_batch" string
|
||||
|
||||
type alias RoomEvent =
|
||||
{ content : Decode.Value
|
||||
, type_ : String
|
||||
, eventId : String
|
||||
, sender : String
|
||||
, originServerTs : Int
|
||||
, unsigned : Maybe UnsignedData
|
||||
}
|
||||
|
||||
roomEventDecoder : Decoder RoomEvent
|
||||
roomEventDecoder =
|
||||
Decode.succeed RoomEvent
|
||||
|> required "content" value
|
||||
|> required "type" string
|
||||
|> required "event_id" string
|
||||
|> required "sender" string
|
||||
|> required "origin_server_ts" int
|
||||
|> maybeDecode "unsigned" unsignedDataDecoder
|
||||
|
||||
type alias Ephemeral =
|
||||
{ events : Maybe (List Event)
|
||||
}
|
||||
|
||||
ephemeralDecoder : Decoder Ephemeral
|
||||
ephemeralDecoder =
|
||||
Decode.succeed Ephemeral
|
||||
|> maybeDecode "events" (list eventDecoder)
|
||||
|
||||
type alias AccountData =
|
||||
{ events : Maybe (List Event)
|
||||
}
|
||||
|
||||
accountDataDecoder : Decoder AccountData
|
||||
accountDataDecoder =
|
||||
Decode.succeed AccountData
|
||||
|> maybeDecode "events" (list eventDecoder)
|
||||
|
||||
type alias UnreadNotificationCounts =
|
||||
{ highlightCount : Maybe Int
|
||||
, notificationCount : Maybe Int
|
||||
}
|
||||
|
||||
unreadNotificationCountsDecoder : Decoder UnreadNotificationCounts
|
||||
unreadNotificationCountsDecoder =
|
||||
Decode.succeed UnreadNotificationCounts
|
||||
|> maybeDecode "highlight_count" int
|
||||
|> maybeDecode "notification_count" int
|
||||
|
||||
-- Invited Room Data
|
||||
type alias InvitedRoom =
|
||||
{ inviteState : Maybe InviteState
|
||||
}
|
||||
|
||||
invitedRoomDecoder : Decoder InvitedRoom
|
||||
invitedRoomDecoder =
|
||||
Decode.succeed InvitedRoom
|
||||
|> maybeDecode "invite_state" inviteStateDecoder
|
||||
|
||||
type alias InviteState =
|
||||
{ events : Maybe (List StrippedState)
|
||||
}
|
||||
|
||||
inviteStateDecoder : Decoder InviteState
|
||||
inviteStateDecoder =
|
||||
Decode.succeed InviteState
|
||||
|> maybeDecode "events" (list strippedStateDecoder)
|
||||
|
||||
type alias StrippedState =
|
||||
{ content : EventContent
|
||||
, stateKey : String
|
||||
, type_ : String
|
||||
, sender : String
|
||||
}
|
||||
|
||||
strippedStateDecoder : Decoder StrippedState
|
||||
strippedStateDecoder =
|
||||
Decode.succeed StrippedState
|
||||
|> required "content" eventContentDecoder
|
||||
|> required "state_key" string
|
||||
|> required "type" string
|
||||
|> required "sender" string
|
||||
|
||||
-- Left Room Data
|
||||
type alias LeftRoom =
|
||||
{ state : Maybe State
|
||||
, timeline : Maybe Timeline
|
||||
, accountData : Maybe AccountData
|
||||
}
|
||||
|
||||
leftRoomDecoder : Decoder LeftRoom
|
||||
leftRoomDecoder =
|
||||
Decode.succeed LeftRoom
|
||||
|> maybeDecode "state" stateDecoder
|
||||
|> maybeDecode "timeline" timelineDecoder
|
||||
|> maybeDecode "account_data" accountDataDecoder
|
||||
|
||||
-- General Sync Response
|
||||
type alias SyncResponse =
|
||||
{ nextBatch : String
|
||||
@@ -259,213 +52,20 @@ historyResponseDecoder =
|
||||
|> required "chunk" (list roomEventDecoder)
|
||||
|
||||
-- Business Logic: Helper Functions
|
||||
groupBy : (a -> comparable) -> List a -> Dict comparable (List a)
|
||||
groupBy f xs =
|
||||
let
|
||||
update v ml = case ml of
|
||||
Just l -> Just (v::l)
|
||||
Nothing -> Just [ v ]
|
||||
in
|
||||
List.foldl (\v acc -> Dict.update (f v) (update v) acc) Dict.empty xs
|
||||
|
||||
uniqueByTailRecursive : (a -> comparable) -> List a -> Set comparable -> List a -> List a
|
||||
uniqueByTailRecursive f l s acc =
|
||||
case l of
|
||||
x::tail ->
|
||||
if Set.member (f x) s
|
||||
then uniqueByTailRecursive f tail s acc
|
||||
else uniqueByTailRecursive f tail (Set.insert (f x) s) (x::acc)
|
||||
[] -> List.reverse acc
|
||||
|
||||
uniqueBy : (a -> comparable) -> List a -> List a
|
||||
uniqueBy f l = uniqueByTailRecursive f l Set.empty []
|
||||
|
||||
findFirst : (a -> Bool) -> List a -> Maybe a
|
||||
findFirst cond l = case l of
|
||||
x::xs -> if cond x then Just x else findFirst cond xs
|
||||
[] -> Nothing
|
||||
|
||||
findLast : (a -> Bool) -> List a -> Maybe a
|
||||
findLast cond l = findFirst cond <| List.reverse l
|
||||
|
||||
findFirstBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
|
||||
findFirstBy sortFunction cond l = findFirst cond <| List.sortBy sortFunction l
|
||||
|
||||
findLastBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
|
||||
findLastBy sortFunction cond l = findLast cond <| List.sortBy sortFunction l
|
||||
|
||||
findFirstEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
|
||||
findFirstEvent = findFirstBy .originServerTs
|
||||
|
||||
findLastEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
|
||||
findLastEvent = findLastBy .originServerTs
|
||||
|
||||
-- Business Logic: Merging
|
||||
mergeMaybe : (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
|
||||
mergeMaybe f l r = case (l, r) of
|
||||
(Just v1, Just v2) -> Just <| f v1 v2
|
||||
(Just v, Nothing) -> l
|
||||
(Nothing, Just v) -> r
|
||||
_ -> Nothing
|
||||
|
||||
mergeEvents : List Event -> List Event -> List Event
|
||||
mergeEvents l1 l2 = l1 ++ l2
|
||||
|
||||
mergeStateEvents : List StateEvent -> List StateEvent -> List StateEvent
|
||||
mergeStateEvents l1 l2 = uniqueBy .eventId <| l1 ++ l2
|
||||
|
||||
mergeRoomEvents : List RoomEvent -> List RoomEvent -> List RoomEvent
|
||||
mergeRoomEvents l1 l2 = uniqueBy .eventId <| l1 ++ l2
|
||||
|
||||
mergeStrippedStates : List StrippedState -> List StrippedState -> List StrippedState
|
||||
mergeStrippedStates l1 l2 = l1 ++ l2
|
||||
|
||||
mergeAccountData : AccountData -> AccountData -> AccountData
|
||||
mergeAccountData a1 a2 = AccountData <| mergeMaybe mergeEvents a1.events a2.events
|
||||
|
||||
mergePresence : Presence -> Presence -> Presence
|
||||
mergePresence p1 p2 = Presence <| mergeMaybe mergeEvents p1.events p2.events
|
||||
|
||||
mergeDicts : (b -> b -> b) -> Dict comparable b -> Dict comparable b -> Dict comparable b
|
||||
mergeDicts f d1 d2 =
|
||||
let
|
||||
inOne = Dict.insert
|
||||
inBoth k v1 v2 = Dict.insert k (f v1 v2)
|
||||
in
|
||||
Dict.merge inOne inBoth inOne d1 d2 (Dict.empty)
|
||||
|
||||
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 t1.prevBatch
|
||||
|
||||
mergeEphemeral : Ephemeral -> Ephemeral -> Ephemeral
|
||||
mergeEphemeral e1 e2 = Ephemeral <| mergeMaybe mergeEvents e1.events e2.events
|
||||
|
||||
mergeJoinedRoom : JoinedRoom -> JoinedRoom -> JoinedRoom
|
||||
mergeJoinedRoom r1 r2 =
|
||||
{ r2 | state = mergeMaybe mergeState r1.state r2.state
|
||||
, timeline = mergeMaybe mergeTimeline r1.timeline r2.timeline
|
||||
, accountData = mergeMaybe mergeAccountData r1.accountData r2.accountData
|
||||
, ephemeral = mergeMaybe mergeEphemeral r1.ephemeral r2.ephemeral
|
||||
}
|
||||
|
||||
mergeInviteState : InviteState -> InviteState -> InviteState
|
||||
mergeInviteState i1 i2 = InviteState <| mergeMaybe mergeStrippedStates i1.events i2.events
|
||||
|
||||
mergeInvitedRoom : InvitedRoom -> InvitedRoom -> InvitedRoom
|
||||
mergeInvitedRoom i1 i2 = InvitedRoom <| mergeMaybe mergeInviteState i1.inviteState i2.inviteState
|
||||
|
||||
mergeLeftRoom : LeftRoom -> LeftRoom -> LeftRoom
|
||||
mergeLeftRoom l1 l2 = LeftRoom
|
||||
(mergeMaybe mergeState l1.state l2.state)
|
||||
(mergeMaybe mergeTimeline l1.timeline l2.timeline)
|
||||
(mergeMaybe mergeAccountData l1.accountData l2.accountData)
|
||||
|
||||
mergeJoin : Dict String JoinedRoom -> Dict String JoinedRoom -> Dict String JoinedRoom
|
||||
mergeJoin = mergeDicts mergeJoinedRoom
|
||||
|
||||
mergeInvite : Dict String InvitedRoom -> Dict String InvitedRoom -> Dict String InvitedRoom
|
||||
mergeInvite = mergeDicts mergeInvitedRoom
|
||||
|
||||
mergeLeave : Dict String LeftRoom -> Dict String LeftRoom -> Dict String LeftRoom
|
||||
mergeLeave = mergeDicts mergeLeftRoom
|
||||
|
||||
mergeRooms : Rooms -> Rooms -> Rooms
|
||||
mergeRooms r1 r2 =
|
||||
{ join = mergeMaybe mergeJoin r1.join r2.join
|
||||
, invite = mergeMaybe mergeInvite r1.invite r2.invite
|
||||
, leave = mergeMaybe mergeLeave r1.leave r2.leave
|
||||
}
|
||||
|
||||
mergeSyncResponse : SyncResponse -> SyncResponse -> SyncResponse
|
||||
mergeSyncResponse l r =
|
||||
{ r | rooms = mergeMaybe mergeRooms l.rooms r.rooms
|
||||
, 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 =
|
||||
let
|
||||
colonIndex = Maybe.withDefault -1
|
||||
<| List.head
|
||||
<| String.indexes ":" s
|
||||
in
|
||||
String.slice 1 colonIndex s
|
||||
|
||||
homeserver : String -> String
|
||||
homeserver s =
|
||||
let
|
||||
colonIndex = Maybe.withDefault 0
|
||||
<| Maybe.map ((+) 1)
|
||||
<| List.head
|
||||
<| String.indexes ":" s
|
||||
in
|
||||
String.dropLeft colonIndex s
|
||||
|
||||
-- Business Logic: Events
|
||||
allRoomStateEvents : JoinedRoom -> List StateEvent
|
||||
allRoomStateEvents jr =
|
||||
let
|
||||
stateEvents = Maybe.withDefault [] <| Maybe.andThen .events jr.state
|
||||
timelineEvents = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
|
||||
roomToStateEvent re =
|
||||
{ content = re.content
|
||||
, type_ = re.type_
|
||||
, eventId = re.eventId
|
||||
, sender = re.sender
|
||||
, originServerTs = re.originServerTs
|
||||
, unsigned = re.unsigned
|
||||
, prevContent = Nothing
|
||||
, stateKey = ""
|
||||
}
|
||||
allStateEvents = uniqueBy .eventId (stateEvents ++ (List.map roomToStateEvent timelineEvents))
|
||||
in
|
||||
allStateEvents
|
||||
|
||||
allRoomDictTimelineEvents : Dict String { a | timeline : Maybe Timeline } -> List RoomEvent
|
||||
allRoomDictTimelineEvents dict = List.concatMap (Maybe.withDefault [] << .events)
|
||||
<| List.filterMap .timeline
|
||||
<| Dict.values dict
|
||||
|
||||
allTimelineEventIds : SyncResponse -> List String
|
||||
allTimelineEventIds s = List.map .eventId <| allTimelineEvents s
|
||||
allTimelineEventIds s = List.map getEventId <| allTimelineEvents s
|
||||
|
||||
allTimelineEvents : SyncResponse -> List RoomEvent
|
||||
allTimelineEvents s =
|
||||
@@ -476,7 +76,7 @@ allTimelineEvents s =
|
||||
joinedEvents = eventsFor .join
|
||||
leftEvents = eventsFor .leave
|
||||
in
|
||||
uniqueBy .eventId <| leftEvents ++ joinedEvents
|
||||
leftEvents ++ joinedEvents
|
||||
|
||||
joinedRoomsTimelineEvents : SyncResponse -> Dict String (List RoomEvent)
|
||||
joinedRoomsTimelineEvents s =
|
||||
@@ -484,65 +84,6 @@ joinedRoomsTimelineEvents s =
|
||||
<| Maybe.map (Dict.map (\k v -> Maybe.withDefault [] <| Maybe.andThen .events v.timeline))
|
||||
<| Maybe.andThen .join s.rooms
|
||||
|
||||
totalNotificationCountString : SyncResponse -> Maybe String
|
||||
totalNotificationCountString sr =
|
||||
let
|
||||
(h, n) = totalNotificationCounts sr
|
||||
suffix = case h of
|
||||
0 -> ""
|
||||
_ -> "!"
|
||||
in
|
||||
case n of
|
||||
0 -> Nothing
|
||||
_ -> Just <| "(" ++ String.fromInt n ++ suffix ++ ")"
|
||||
|
||||
totalNotificationCounts : SyncResponse -> (Int, Int)
|
||||
totalNotificationCounts sr =
|
||||
let
|
||||
rooms = Maybe.withDefault []
|
||||
<| Maybe.map (Dict.values)
|
||||
<| Maybe.andThen (.join) sr.rooms
|
||||
zeroDefault = Maybe.withDefault 0
|
||||
getCounts = Maybe.map (\cs -> (zeroDefault cs.highlightCount, zeroDefault cs.notificationCount))
|
||||
<< .unreadNotifications
|
||||
sumCounts (h1, n1) (h2, n2) = (h1 + h2, n1 + n2)
|
||||
in
|
||||
List.foldl sumCounts (0, 0)
|
||||
<| List.filterMap getCounts rooms
|
||||
|
||||
-- Business Logic: Room Info
|
||||
roomAccountData : JoinedRoom -> String -> Maybe Decode.Value
|
||||
roomAccountData jr et =
|
||||
Maybe.map .content
|
||||
<| Maybe.andThen (List.head << List.filter (((==) et) << .type_))
|
||||
<| Maybe.andThen .events jr.accountData
|
||||
|
||||
roomName : JoinedRoom -> Maybe String
|
||||
roomName jr =
|
||||
let
|
||||
name c = Result.toMaybe <| Decode.decodeValue (field "name" string) c
|
||||
nameEvent = findLastEvent (((==) "m.room.name") << .type_) <| allRoomStateEvents jr
|
||||
in
|
||||
Maybe.andThen (name << .content) nameEvent
|
||||
|
||||
roomTypingUsers : JoinedRoom -> List Username
|
||||
roomTypingUsers jr = Maybe.withDefault []
|
||||
<| Maybe.andThen (Result.toMaybe << Decode.decodeValue (Decode.field "user_ids" (list string)))
|
||||
<| Maybe.map .content
|
||||
<| Maybe.andThen (findLast (((==) "m.typing") << .type_))
|
||||
<| Maybe.andThen .events jr.ephemeral
|
||||
|
||||
-- Business Logic: Users
|
||||
allUsers : SyncResponse -> List Username
|
||||
allUsers s = uniqueBy (\u -> u) <| List.map .sender <| allTimelineEvents s
|
||||
|
||||
roomJoinedUsers : JoinedRoom -> List Username
|
||||
roomJoinedUsers r =
|
||||
let
|
||||
contentDecoder = Decode.field "membership" Decode.string
|
||||
isJoin e = Ok "join" == (Decode.decodeValue contentDecoder e.content)
|
||||
in
|
||||
List.map .sender
|
||||
<| List.filter isJoin
|
||||
<| List.filter (((==) "m.room.member") << .type_)
|
||||
<| allRoomStateEvents r
|
||||
allUsers s = uniqueBy (\u -> u) <| List.map getSender <| allTimelineEvents s
|
||||
|
||||
54
src/Scylla/Sync/AccountData.elm
Normal file
54
src/Scylla/Sync/AccountData.elm
Normal file
@@ -0,0 +1,54 @@
|
||||
module Scylla.Sync.AccountData exposing (..)
|
||||
import Scylla.ListUtils exposing (..)
|
||||
import Scylla.Sync.DecodeTools exposing (maybeDecode)
|
||||
import Scylla.Sync.Events exposing (Event, eventDecoder)
|
||||
import Scylla.Sync.Push exposing (Ruleset, rulesetDecoder)
|
||||
import Json.Decode as Decode exposing (Decoder, list, field, decodeValue)
|
||||
import Dict exposing (Dict)
|
||||
|
||||
type alias AccountData =
|
||||
{ events : Maybe (List Event)
|
||||
}
|
||||
|
||||
accountDataDecoder : Decoder AccountData
|
||||
accountDataDecoder =
|
||||
Decode.succeed AccountData
|
||||
|> maybeDecode "events" (list eventDecoder)
|
||||
|
||||
type alias DirectMessages = Dict String String
|
||||
|
||||
directMessagesDecoder : Decode.Decoder DirectMessages
|
||||
directMessagesDecoder =
|
||||
Decode.dict (Decode.list Decode.string)
|
||||
|> Decode.map (invertDirectMessages)
|
||||
|
||||
type alias DirectMessagesRaw = Dict String (List String)
|
||||
|
||||
invertDirectMessages : DirectMessagesRaw -> DirectMessages
|
||||
invertDirectMessages dmr =
|
||||
Dict.foldl
|
||||
(\k lv acc -> List.foldl (\v -> Dict.insert v k) acc lv)
|
||||
Dict.empty
|
||||
dmr
|
||||
|
||||
applyAccountData : Maybe AccountData -> AccountData -> AccountData
|
||||
applyAccountData mad ad =
|
||||
case mad of
|
||||
Nothing -> ad
|
||||
Just newAd ->
|
||||
case (newAd.events, ad.events) of
|
||||
(Just es, Nothing) -> newAd
|
||||
(Just newEs, Just es) -> { events = Just (newEs ++ es) }
|
||||
_ -> ad
|
||||
|
||||
getAccountData : String -> Decode.Decoder a -> AccountData -> Maybe a
|
||||
getAccountData key d ad = ad.events
|
||||
|> Maybe.andThen (findFirst ((==) key << .type_))
|
||||
|> Maybe.map .content
|
||||
|> Maybe.andThen (Result.toMaybe << decodeValue d)
|
||||
|
||||
getDirectMessages : AccountData -> Maybe DirectMessages
|
||||
getDirectMessages = getAccountData "m.direct" directMessagesDecoder
|
||||
|
||||
getPushRuleset : AccountData -> Maybe Ruleset
|
||||
getPushRuleset = getAccountData "m.push_rules" (field "global" rulesetDecoder)
|
||||
9
src/Scylla/Sync/DecodeTools.elm
Normal file
9
src/Scylla/Sync/DecodeTools.elm
Normal file
@@ -0,0 +1,9 @@
|
||||
module Scylla.Sync.DecodeTools exposing (..)
|
||||
import Json.Decode as Decode exposing (Decoder)
|
||||
import Json.Decode.Pipeline exposing (optional)
|
||||
|
||||
decodeJust : Decoder a -> Decoder (Maybe a)
|
||||
decodeJust = Decode.map Just
|
||||
|
||||
maybeDecode : String -> Decoder a -> Decoder (Maybe a -> b) -> Decoder b
|
||||
maybeDecode s d = optional s (decodeJust d) Nothing
|
||||
149
src/Scylla/Sync/Events.elm
Normal file
149
src/Scylla/Sync/Events.elm
Normal file
@@ -0,0 +1,149 @@
|
||||
module Scylla.Sync.Events exposing (..)
|
||||
import Scylla.Sync.DecodeTools exposing (maybeDecode)
|
||||
import Json.Decode as Decode exposing (Decoder, int, string, value, oneOf)
|
||||
import Json.Decode.Pipeline exposing (required)
|
||||
|
||||
type alias UnsignedData =
|
||||
{ age : Maybe Int
|
||||
, redactedBecause : Maybe Event
|
||||
, transactionId : Maybe String
|
||||
}
|
||||
|
||||
unsignedDataDecoder : Decoder UnsignedData
|
||||
unsignedDataDecoder =
|
||||
Decode.succeed UnsignedData
|
||||
|> maybeDecode "age" int
|
||||
|> maybeDecode "redacted_because" eventDecoder
|
||||
|> maybeDecode "transaction_id" string
|
||||
|
||||
type alias EventContent = Decode.Value
|
||||
|
||||
eventContentDecoder : Decoder EventContent
|
||||
eventContentDecoder = Decode.value
|
||||
|
||||
type alias Event =
|
||||
{ content : Decode.Value
|
||||
, type_ : String
|
||||
}
|
||||
|
||||
eventDecoder : Decoder Event
|
||||
eventDecoder =
|
||||
Decode.succeed Event
|
||||
|> required "content" value
|
||||
|> required "type" string
|
||||
|
||||
type RoomEvent
|
||||
= StateRoomEvent StateEvent
|
||||
| MessageRoomEvent MessageEvent
|
||||
|
||||
roomEventDecoder : Decoder RoomEvent
|
||||
roomEventDecoder = oneOf
|
||||
[ Decode.map StateRoomEvent stateEventDecoder
|
||||
, Decode.map MessageRoomEvent messageEventDecoder
|
||||
]
|
||||
|
||||
type alias MessageEvent =
|
||||
{ content : EventContent
|
||||
, type_ : String
|
||||
, eventId : String
|
||||
, sender : String
|
||||
, originServerTs : Int
|
||||
, unsigned : Maybe UnsignedData
|
||||
}
|
||||
|
||||
messageEventDecoder : Decoder MessageEvent
|
||||
messageEventDecoder =
|
||||
Decode.succeed MessageEvent
|
||||
|> required "content" value
|
||||
|> required "type" string
|
||||
|> required "event_id" string
|
||||
|> required "sender" string
|
||||
|> required "origin_server_ts" int
|
||||
|> maybeDecode "unsigned" unsignedDataDecoder
|
||||
|
||||
type alias StateEvent =
|
||||
{ content : EventContent
|
||||
, type_ : String
|
||||
, eventId : String
|
||||
, sender : String
|
||||
, originServerTs : Int
|
||||
, unsigned : Maybe UnsignedData
|
||||
, prevContent : Maybe EventContent
|
||||
, stateKey : String
|
||||
}
|
||||
|
||||
stateEventDecoder : Decoder StateEvent
|
||||
stateEventDecoder =
|
||||
Decode.succeed StateEvent
|
||||
|> required "content" value
|
||||
|> required "type" string
|
||||
|> required "event_id" string
|
||||
|> required "sender" string
|
||||
|> required "origin_server_ts" int
|
||||
|> maybeDecode "unsigned" unsignedDataDecoder
|
||||
|> maybeDecode "prev_content" eventContentDecoder
|
||||
|> required "state_key" string
|
||||
|
||||
type alias StrippedStateEvent =
|
||||
{ content : EventContent
|
||||
, stateKey : String
|
||||
, type_ : String
|
||||
, sender : String
|
||||
}
|
||||
|
||||
strippedStateEventDecoder : Decoder StrippedStateEvent
|
||||
strippedStateEventDecoder =
|
||||
Decode.succeed StrippedStateEvent
|
||||
|> required "content" eventContentDecoder
|
||||
|> required "state_key" string
|
||||
|> required "type" string
|
||||
|> required "sender" string
|
||||
|
||||
-- Operations on Room Events
|
||||
getUnsigned : RoomEvent -> Maybe UnsignedData
|
||||
getUnsigned re =
|
||||
case re of
|
||||
StateRoomEvent e -> e.unsigned
|
||||
MessageRoomEvent e -> e.unsigned
|
||||
|
||||
getEventId : RoomEvent -> String
|
||||
getEventId re =
|
||||
case re of
|
||||
StateRoomEvent e -> e.eventId
|
||||
MessageRoomEvent e -> e.eventId
|
||||
|
||||
getSender : RoomEvent -> String
|
||||
getSender re =
|
||||
case re of
|
||||
StateRoomEvent e -> e.sender
|
||||
MessageRoomEvent e -> e.sender
|
||||
|
||||
getType : RoomEvent -> String
|
||||
getType re =
|
||||
case re of
|
||||
StateRoomEvent e -> e.type_
|
||||
MessageRoomEvent e -> e.type_
|
||||
|
||||
getContent : RoomEvent -> Decode.Value
|
||||
getContent re =
|
||||
case re of
|
||||
StateRoomEvent e -> e.content
|
||||
MessageRoomEvent e -> e.content
|
||||
|
||||
toStateEvent : RoomEvent -> Maybe StateEvent
|
||||
toStateEvent re =
|
||||
case re of
|
||||
StateRoomEvent e -> Just e
|
||||
_ -> Nothing
|
||||
|
||||
toMessageEvent : RoomEvent -> Maybe MessageEvent
|
||||
toMessageEvent re =
|
||||
case re of
|
||||
MessageRoomEvent e -> Just e
|
||||
_ -> Nothing
|
||||
|
||||
toEvent : RoomEvent -> Event
|
||||
toEvent re =
|
||||
case re of
|
||||
StateRoomEvent e -> { content = e.content, type_ = e.type_ }
|
||||
MessageRoomEvent e -> { content = e.content, type_ = e.type_ }
|
||||
167
src/Scylla/Sync/Push.elm
Normal file
167
src/Scylla/Sync/Push.elm
Normal file
@@ -0,0 +1,167 @@
|
||||
module Scylla.Sync.Push exposing (..)
|
||||
import Scylla.Sync.DecodeTools exposing (maybeDecode)
|
||||
import Scylla.Sync.Events exposing (RoomEvent, getSender, getContent, getType)
|
||||
import Scylla.Route exposing (RoomId)
|
||||
import Json.Decode as Decode exposing (Decoder, string, int, field, value, bool, list)
|
||||
import Json.Decode.Pipeline exposing (required, optional)
|
||||
|
||||
type Condition
|
||||
= EventMatch String String
|
||||
| ContainsDisplayName
|
||||
| RoomMemberCount Int
|
||||
| SenderNotificationPermission String
|
||||
|
||||
conditionDecoder : Decoder Condition
|
||||
conditionDecoder =
|
||||
let
|
||||
eventMatchDecoder =
|
||||
Decode.succeed EventMatch
|
||||
|> required "key" string
|
||||
|> required "pattern" string
|
||||
containsDisplayNameDecoder =
|
||||
Decode.succeed ContainsDisplayName
|
||||
roomMemberCountDecoder =
|
||||
Decode.succeed RoomMemberCount
|
||||
|> required "is"
|
||||
(Decode.map (Maybe.withDefault 0 << String.toInt) string)
|
||||
senderNotifPermissionDecoder =
|
||||
Decode.succeed SenderNotificationPermission
|
||||
|> required "key" string
|
||||
dispatchDecoder k =
|
||||
case k of
|
||||
"event_match" -> eventMatchDecoder
|
||||
"contains_display_name" -> containsDisplayNameDecoder
|
||||
"room_member_count" -> roomMemberCountDecoder
|
||||
"sender_notification_permission" -> senderNotifPermissionDecoder
|
||||
_ -> Decode.fail "Unknown condition code"
|
||||
in
|
||||
field "kind" string
|
||||
|> Decode.andThen dispatchDecoder
|
||||
|
||||
type Action
|
||||
= Notify
|
||||
| DontNotify
|
||||
| Coalesce
|
||||
| SetTweak String (Maybe Decode.Value)
|
||||
|
||||
actionDecoder : Decoder Action
|
||||
actionDecoder =
|
||||
let
|
||||
dispatchStringDecoder s =
|
||||
case s of
|
||||
"notify" -> Decode.succeed Notify
|
||||
"dont_notify" -> Decode.succeed DontNotify
|
||||
"coalesce" -> Decode.succeed Coalesce
|
||||
_ -> Decode.fail "Unknown action string"
|
||||
objectDecoder =
|
||||
Decode.succeed SetTweak
|
||||
|> required "set_tweak" string
|
||||
|> maybeDecode "value" value
|
||||
in
|
||||
Decode.oneOf
|
||||
[ string |> Decode.andThen dispatchStringDecoder
|
||||
, objectDecoder
|
||||
]
|
||||
|
||||
type alias Rule =
|
||||
{ ruleId : String
|
||||
, default : Bool
|
||||
, enabled : Bool
|
||||
, conditions : List Condition
|
||||
, actions : List Action
|
||||
}
|
||||
|
||||
ruleDecoder : Decoder Rule
|
||||
ruleDecoder =
|
||||
let
|
||||
patternDecoder = Decode.oneOf
|
||||
[ field "pattern" string
|
||||
|> Decode.andThen
|
||||
(\p -> Decode.succeed <| \r ->
|
||||
{ r | conditions = (EventMatch "content.body" p)::r.conditions })
|
||||
, Decode.succeed identity
|
||||
]
|
||||
basicRuleDecoder = Decode.succeed Rule
|
||||
|> required "rule_id" string
|
||||
|> optional "default" bool True
|
||||
|> optional "enabled" bool False
|
||||
|> optional "conditions" (list conditionDecoder) []
|
||||
|> required "actions" (list actionDecoder)
|
||||
in
|
||||
patternDecoder
|
||||
|> Decode.andThen (\f -> Decode.map f basicRuleDecoder)
|
||||
|
||||
type alias Ruleset =
|
||||
{ content : List Rule
|
||||
, override : List Rule
|
||||
, room : List Rule
|
||||
, sender : List Rule
|
||||
, underride : List Rule
|
||||
}
|
||||
|
||||
rulesetDecoder : Decoder Ruleset
|
||||
rulesetDecoder = Decode.succeed Ruleset
|
||||
|> optional "content" (list ruleDecoder) []
|
||||
|> optional "override" (list ruleDecoder) []
|
||||
|> optional "room" (list ruleDecoder) []
|
||||
|> optional "sender" (list ruleDecoder) []
|
||||
|> optional "underride" (list ruleDecoder) []
|
||||
|
||||
checkCondition : RoomEvent -> Condition -> Bool
|
||||
checkCondition re c =
|
||||
let
|
||||
pathDecoder xs p =
|
||||
Decode.at xs string
|
||||
|> Decode.map (String.contains p << String.toLower)
|
||||
matchesPattern xs p =
|
||||
case Decode.decodeValue (pathDecoder xs p) (getContent re) of
|
||||
Ok True -> True
|
||||
_ -> False
|
||||
in
|
||||
case c of
|
||||
EventMatch k p ->
|
||||
case String.split "." k of
|
||||
"content"::xs -> matchesPattern xs p
|
||||
"type"::[] -> String.contains p <| getType re
|
||||
_ -> False
|
||||
ContainsDisplayName -> False
|
||||
RoomMemberCount _ -> False
|
||||
SenderNotificationPermission _ -> False
|
||||
|
||||
applyAction : Action -> List Action -> List Action
|
||||
applyAction a as_ =
|
||||
case a of
|
||||
Notify -> Notify :: List.filter (\a_ -> a_ /= DontNotify) as_
|
||||
DontNotify -> DontNotify :: List.filter (\a_ -> a_ /= Notify) as_
|
||||
Coalesce -> Coalesce :: List.filter (\a_ -> a_ /= DontNotify) as_
|
||||
a_ -> a_ :: as_
|
||||
|
||||
applyActions : List Action -> List Action -> List Action
|
||||
applyActions l r = List.foldl applyAction r l
|
||||
|
||||
updatePushRuleActions : Rule -> RoomEvent -> List Action -> List Action
|
||||
updatePushRuleActions r re as_ =
|
||||
if List.all (checkCondition re) r.conditions
|
||||
then applyActions r.actions as_
|
||||
else as_
|
||||
|
||||
updatePushActions : List Rule -> RoomEvent -> List Action -> List Action
|
||||
updatePushActions rs re as_ =
|
||||
List.filter .enabled rs
|
||||
|> List.foldl (\r -> updatePushRuleActions r re) as_
|
||||
|
||||
getPushActions : Ruleset -> RoomId -> RoomEvent -> List Action
|
||||
getPushActions rs rid re =
|
||||
let
|
||||
roomRules = List.filter (((==) rid) << .ruleId) rs.room
|
||||
senderRules = List.filter (((==) <| getSender re) << .ruleId) rs.sender
|
||||
in
|
||||
updatePushActions rs.underride re []
|
||||
|> updatePushActions senderRules re
|
||||
|> updatePushActions roomRules re
|
||||
|> updatePushActions rs.override re
|
||||
|
||||
getEventNotification : Ruleset -> RoomId -> RoomEvent -> Bool
|
||||
getEventNotification rs rid re =
|
||||
getPushActions rs rid re
|
||||
|> List.member Notify
|
||||
109
src/Scylla/Sync/Rooms.elm
Normal file
109
src/Scylla/Sync/Rooms.elm
Normal file
@@ -0,0 +1,109 @@
|
||||
module Scylla.Sync.Rooms exposing (..)
|
||||
import Scylla.Sync.DecodeTools exposing (maybeDecode)
|
||||
import Scylla.Sync.Events exposing (Event, RoomEvent, StateEvent, StrippedStateEvent, stateEventDecoder, strippedStateEventDecoder, roomEventDecoder, eventDecoder)
|
||||
import Scylla.Sync.AccountData exposing (AccountData, accountDataDecoder)
|
||||
import Json.Decode as Decode exposing (Decoder, int, string, dict, list, bool)
|
||||
import Json.Decode.Pipeline exposing (required)
|
||||
import Dict exposing (Dict)
|
||||
|
||||
type alias Rooms =
|
||||
{ join : Maybe (Dict String JoinedRoom)
|
||||
, invite : Maybe (Dict String InvitedRoom)
|
||||
, leave : Maybe (Dict String LeftRoom)
|
||||
}
|
||||
|
||||
roomsDecoder : Decoder Rooms
|
||||
roomsDecoder =
|
||||
Decode.succeed Rooms
|
||||
|> maybeDecode "join" (dict joinedRoomDecoder)
|
||||
|> maybeDecode "invite" (dict invitedRoomDecoder)
|
||||
|> maybeDecode "leave" (dict leftRoomDecoder)
|
||||
|
||||
type alias JoinedRoom =
|
||||
{ state : Maybe State
|
||||
, timeline : Maybe Timeline
|
||||
, ephemeral : Maybe Ephemeral
|
||||
, accountData : Maybe AccountData
|
||||
, unreadNotifications : Maybe UnreadNotificationCounts
|
||||
}
|
||||
|
||||
joinedRoomDecoder : Decoder JoinedRoom
|
||||
joinedRoomDecoder =
|
||||
Decode.succeed JoinedRoom
|
||||
|> maybeDecode "state" stateDecoder
|
||||
|> maybeDecode "timeline" timelineDecoder
|
||||
|> maybeDecode "ephemeral" ephemeralDecoder
|
||||
|> maybeDecode "account_data" accountDataDecoder
|
||||
|> maybeDecode "unread_notifications" unreadNotificationCountsDecoder
|
||||
|
||||
type alias InvitedRoom =
|
||||
{ inviteState : Maybe InviteState
|
||||
}
|
||||
|
||||
invitedRoomDecoder : Decoder InvitedRoom
|
||||
invitedRoomDecoder =
|
||||
Decode.succeed InvitedRoom
|
||||
|> maybeDecode "invite_state" inviteStateDecoder
|
||||
|
||||
type alias LeftRoom =
|
||||
{ state : Maybe State
|
||||
, timeline : Maybe Timeline
|
||||
, accountData : Maybe AccountData
|
||||
}
|
||||
|
||||
leftRoomDecoder : Decoder LeftRoom
|
||||
leftRoomDecoder =
|
||||
Decode.succeed LeftRoom
|
||||
|> maybeDecode "state" stateDecoder
|
||||
|> maybeDecode "timeline" timelineDecoder
|
||||
|> maybeDecode "account_data" accountDataDecoder
|
||||
|
||||
type alias State =
|
||||
{ events : Maybe (List StateEvent)
|
||||
}
|
||||
|
||||
stateDecoder : Decoder State
|
||||
stateDecoder =
|
||||
Decode.succeed State
|
||||
|> maybeDecode "events" (list stateEventDecoder)
|
||||
|
||||
type alias InviteState =
|
||||
{ events : Maybe (List StrippedStateEvent)
|
||||
}
|
||||
|
||||
inviteStateDecoder : Decoder InviteState
|
||||
inviteStateDecoder =
|
||||
Decode.succeed InviteState
|
||||
|> maybeDecode "events" (list strippedStateEventDecoder)
|
||||
|
||||
type alias Timeline =
|
||||
{ events : Maybe (List RoomEvent)
|
||||
, limited : Maybe Bool
|
||||
, prevBatch : Maybe String
|
||||
}
|
||||
|
||||
timelineDecoder =
|
||||
Decode.succeed Timeline
|
||||
|> maybeDecode "events" (list roomEventDecoder)
|
||||
|> maybeDecode "limited" bool
|
||||
|> maybeDecode "prev_batch" string
|
||||
|
||||
type alias Ephemeral =
|
||||
{ events : Maybe (List Event)
|
||||
}
|
||||
|
||||
ephemeralDecoder : Decoder Ephemeral
|
||||
ephemeralDecoder =
|
||||
Decode.succeed Ephemeral
|
||||
|> maybeDecode "events" (list eventDecoder)
|
||||
|
||||
type alias UnreadNotificationCounts =
|
||||
{ highlightCount : Maybe Int
|
||||
, notificationCount : Maybe Int
|
||||
}
|
||||
|
||||
unreadNotificationCountsDecoder : Decoder UnreadNotificationCounts
|
||||
unreadNotificationCountsDecoder =
|
||||
Decode.succeed UnreadNotificationCounts
|
||||
|> maybeDecode "highlight_count" int
|
||||
|> maybeDecode "notification_count" int
|
||||
@@ -1,6 +1,8 @@
|
||||
module Scylla.UserData exposing (..)
|
||||
import Scylla.Login exposing (Username)
|
||||
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field)
|
||||
import Json.Decode.Pipeline exposing (required, optional)
|
||||
import Dict exposing (Dict)
|
||||
|
||||
type alias UserData =
|
||||
{ displayName : Maybe String
|
||||
@@ -12,3 +14,13 @@ userDataDecoder =
|
||||
Decode.succeed UserData
|
||||
|> optional "displayname" (Decode.map Just string) Nothing
|
||||
|> optional "avatar_url" (Decode.map Just string) Nothing
|
||||
|
||||
getSenderName : Username -> String
|
||||
getSenderName s =
|
||||
let
|
||||
colonIndex = Maybe.withDefault -1
|
||||
<| List.head
|
||||
<| String.indexes ":" s
|
||||
in
|
||||
String.slice 1 colonIndex s
|
||||
|
||||
|
||||
@@ -1,13 +1,16 @@
|
||||
module Scylla.Views exposing (..)
|
||||
import Scylla.Model exposing (..)
|
||||
import Scylla.Sync exposing (..)
|
||||
import Scylla.Sync.Events exposing (..)
|
||||
import Scylla.Sync.Rooms exposing (..)
|
||||
import Scylla.Room exposing (RoomData, emptyOpenRooms, getHomeserver, getRoomName, getRoomTypingUsers, getLocalDisplayName)
|
||||
import Scylla.Route exposing (..)
|
||||
import Scylla.Fnv as Fnv
|
||||
import Scylla.Messages exposing (..)
|
||||
import Scylla.Login exposing (Username)
|
||||
import Scylla.UserData exposing (UserData)
|
||||
import Scylla.Http exposing (fullMediaUrl)
|
||||
import Scylla.Api exposing (ApiUrl)
|
||||
import Scylla.ListUtils exposing (groupBy)
|
||||
import Html.Parser
|
||||
import Html.Parser.Util
|
||||
import Svg
|
||||
@@ -17,7 +20,7 @@ import Json.Decode as Decode
|
||||
import Html exposing (Html, Attribute, div, input, text, button, div, span, a, h2, h3, table, td, tr, img, textarea, video, source, p)
|
||||
import Html.Attributes exposing (type_, placeholder, value, href, class, style, src, id, rows, controls, src, classList)
|
||||
import Html.Events exposing (onInput, onClick, preventDefaultOn)
|
||||
import Html.Lazy exposing (lazy6)
|
||||
import Html.Lazy exposing (lazy5)
|
||||
import Dict exposing (Dict)
|
||||
import Tuple
|
||||
|
||||
@@ -44,10 +47,8 @@ stringColor s =
|
||||
viewFull : Model -> List (Html Msg)
|
||||
viewFull model =
|
||||
let
|
||||
room r = Maybe.map (\jr -> (r, jr))
|
||||
<| Maybe.andThen (Dict.get r)
|
||||
<| Maybe.andThen .join
|
||||
<| model.sync.rooms
|
||||
room r = Dict.get r model.rooms
|
||||
|> Maybe.map (\rd -> (r, rd))
|
||||
core = case model.route of
|
||||
Login -> loginView model
|
||||
Base -> baseView model Nothing
|
||||
@@ -63,10 +64,10 @@ errorsView = div [ class "errors-wrapper" ] << List.indexedMap errorView
|
||||
errorView : Int -> String -> Html Msg
|
||||
errorView i s = div [ class "error-wrapper", onClick <| DismissError i ] [ iconView "alert-triangle", text s ]
|
||||
|
||||
baseView : Model -> Maybe (RoomId, JoinedRoom) -> Html Msg
|
||||
baseView m jr =
|
||||
baseView : Model -> Maybe (RoomId, RoomData) -> Html Msg
|
||||
baseView m rd =
|
||||
let
|
||||
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) jr
|
||||
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) rd
|
||||
reconnect = reconnectView m
|
||||
in
|
||||
div [ class "base-wrapper" ] <| maybeHtml
|
||||
@@ -83,11 +84,8 @@ reconnectView m = if m.connected
|
||||
roomListView : Model -> Html Msg
|
||||
roomListView m =
|
||||
let
|
||||
rooms = Maybe.withDefault (Dict.empty)
|
||||
<| Maybe.andThen .join
|
||||
<| m.sync.rooms
|
||||
groups = roomGroups
|
||||
<| Dict.toList rooms
|
||||
<| Dict.toList m.rooms
|
||||
homeserverList = div [ class "homeservers-list" ]
|
||||
<| List.map (\(k, v) -> homeserverView m k v)
|
||||
<| Dict.toList groups
|
||||
@@ -104,22 +102,22 @@ roomListView m =
|
||||
, homeserverList
|
||||
]
|
||||
|
||||
roomGroups : List (String, JoinedRoom) -> Dict String (List (String, JoinedRoom))
|
||||
roomGroups jrs = groupBy (homeserver << Tuple.first) jrs
|
||||
roomGroups : List (String, RoomData) -> Dict String (List (String, RoomData))
|
||||
roomGroups jrs = groupBy (getHomeserver << Tuple.first) jrs
|
||||
|
||||
homeserverView : Model -> String -> List (String, JoinedRoom) -> Html Msg
|
||||
homeserverView : Model -> String -> List (String, RoomData) -> Html Msg
|
||||
homeserverView m hs rs =
|
||||
let
|
||||
roomList = div [ class "rooms-list" ]
|
||||
<| List.map (\(rid, r) -> roomListElementView m rid r)
|
||||
<| List.sortBy (\(rid, r) -> roomDisplayName m.roomNames rid) rs
|
||||
<| List.sortBy (\(rid, r) -> getRoomName m.accountData rid r) rs
|
||||
in
|
||||
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
|
||||
|
||||
roomListElementView : Model -> RoomId -> JoinedRoom -> Html Msg
|
||||
roomListElementView m rid jr =
|
||||
roomListElementView : Model -> RoomId -> RoomData -> Html Msg
|
||||
roomListElementView m rid rd =
|
||||
let
|
||||
name = roomDisplayName m.roomNames rid
|
||||
name = getRoomName m.accountData rid rd
|
||||
isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name)
|
||||
isCurrentRoom = case currentRoomId m of
|
||||
Nothing -> False
|
||||
@@ -131,10 +129,10 @@ roomListElementView m rid jr =
|
||||
, ("hidden", not isVisible)
|
||||
]
|
||||
]
|
||||
<| roomNotificationCountView jr.unreadNotifications ++
|
||||
<| roomNotificationCountView rd.unreadNotifications ++
|
||||
[ a [ href <| roomUrl rid ] [ text name ] ]
|
||||
|
||||
roomNotificationCountView : Maybe UnreadNotificationCounts -> List (Html Msg)
|
||||
roomNotificationCountView : UnreadNotificationCounts -> List (Html Msg)
|
||||
roomNotificationCountView ns =
|
||||
let
|
||||
wrap b = span
|
||||
@@ -143,7 +141,7 @@ roomNotificationCountView ns =
|
||||
, ("bright", b)
|
||||
]
|
||||
]
|
||||
getCount f = Maybe.withDefault 0 << Maybe.andThen f
|
||||
getCount f = Maybe.withDefault 0 << f
|
||||
in
|
||||
case (getCount .notificationCount ns, getCount .highlightCount ns) of
|
||||
(0, 0) -> []
|
||||
@@ -159,10 +157,10 @@ loginView m = div [ class "login-wrapper" ]
|
||||
, button [ onClick AttemptLogin ] [ text "Log In" ]
|
||||
]
|
||||
|
||||
joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg
|
||||
joinedRoomView m roomId jr =
|
||||
joinedRoomView : Model -> RoomId -> RoomData -> Html Msg
|
||||
joinedRoomView m roomId rd =
|
||||
let
|
||||
typing = List.map (displayName m.userData) <| roomTypingUsers jr
|
||||
typing = List.map (getLocalDisplayName rd) <| getRoomTypingUsers rd
|
||||
typingText = String.join ", " typing
|
||||
typingSuffix = case List.length typing of
|
||||
0 -> ""
|
||||
@@ -183,21 +181,19 @@ joinedRoomView m roomId jr =
|
||||
]
|
||||
in
|
||||
div [ class "room-wrapper" ]
|
||||
[ h2 [] [ text <| roomDisplayName m.roomNames roomId ]
|
||||
, lazy6 lazyMessagesView m.userData roomId jr m.apiUrl m.loginUsername m.sending
|
||||
[ h2 [] [ text <| getRoomName m.accountData roomId rd ]
|
||||
, lazy5 lazyMessagesView roomId rd m.apiUrl m.loginUsername m.sending
|
||||
, messageInput
|
||||
, typingWrapper
|
||||
]
|
||||
|
||||
lazyMessagesView : Dict String UserData -> RoomId -> JoinedRoom -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg
|
||||
lazyMessagesView ud rid jr au lu snd =
|
||||
lazyMessagesView : RoomId -> RoomData -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg
|
||||
lazyMessagesView rid rd au lu snd =
|
||||
let
|
||||
roomReceived = receivedMessagesRoom
|
||||
<| Maybe.withDefault []
|
||||
<| Maybe.andThen .events jr.timeline
|
||||
roomSending = sendingMessagesRoom rid snd
|
||||
renderedMessages = List.map (userMessagesView ud au)
|
||||
<| mergeMessages lu
|
||||
roomReceived = getReceivedMessages rd
|
||||
roomSending = getSendingMessages rid snd
|
||||
renderedMessages = List.map (userMessagesView rd au)
|
||||
<| groupMessages lu
|
||||
<| roomReceived ++ roomSending
|
||||
in
|
||||
messagesWrapperView rid renderedMessages
|
||||
@@ -227,50 +223,50 @@ messagesWrapperView rid es = div [ class "messages-wrapper", id "messages-wrappe
|
||||
, table [ class "messages-table" ] es
|
||||
]
|
||||
|
||||
senderView : Dict String UserData -> Username -> Html Msg
|
||||
senderView ud s =
|
||||
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName ud s ]
|
||||
senderView : RoomData -> Username -> Html Msg
|
||||
senderView rd s =
|
||||
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| getLocalDisplayName rd s ]
|
||||
|
||||
userMessagesView : Dict String UserData -> ApiUrl -> (Username, List Message) -> Html Msg
|
||||
userMessagesView ud apiUrl (u, ms) =
|
||||
userMessagesView : RoomData -> ApiUrl -> (Username, List Message) -> Html Msg
|
||||
userMessagesView rd apiUrl (u, ms) =
|
||||
let
|
||||
wrap h = div [ class "message" ] [ h ]
|
||||
in
|
||||
tr []
|
||||
[ td [] [ senderView ud u ]
|
||||
, td [] <| List.map wrap <| List.filterMap (messageView ud apiUrl) ms
|
||||
[ td [] [ senderView rd u ]
|
||||
, td [] <| List.map wrap <| List.filterMap (messageView rd apiUrl) ms
|
||||
]
|
||||
|
||||
messageView : Dict String UserData -> ApiUrl -> Message -> Maybe (Html Msg)
|
||||
messageView ud apiUrl msg = case msg of
|
||||
messageView : RoomData -> ApiUrl -> Message -> Maybe (Html Msg)
|
||||
messageView rd apiUrl msg = case msg of
|
||||
Sending t -> Just <| sendingMessageView t
|
||||
Received re -> roomEventView ud apiUrl re
|
||||
Received re -> roomEventView rd apiUrl re
|
||||
|
||||
sendingMessageView : SendingMessage -> Html Msg
|
||||
sendingMessageView msg = case msg.body of
|
||||
TextMessage t -> span [ class "sending"] [ text t ]
|
||||
|
||||
roomEventView : Dict String UserData -> ApiUrl -> RoomEvent -> Maybe (Html Msg)
|
||||
roomEventView ud apiUrl re =
|
||||
roomEventView : RoomData -> ApiUrl -> MessageEvent -> Maybe (Html Msg)
|
||||
roomEventView rd apiUrl re =
|
||||
let
|
||||
msgtype = Decode.decodeValue (Decode.field "msgtype" Decode.string) re.content
|
||||
in
|
||||
case msgtype of
|
||||
Ok "m.text" -> roomEventTextView re
|
||||
Ok "m.notice" -> roomEventNoticeView re
|
||||
Ok "m.emote" -> roomEventEmoteView ud re
|
||||
Ok "m.emote" -> roomEventEmoteView rd re
|
||||
Ok "m.image" -> roomEventImageView apiUrl re
|
||||
Ok "m.file" -> roomEventFileView apiUrl re
|
||||
Ok "m.video" -> roomEventVideoView apiUrl re
|
||||
_ -> Nothing
|
||||
|
||||
roomEventFormattedContent : RoomEvent -> Maybe (List (Html Msg))
|
||||
roomEventFormattedContent : MessageEvent -> Maybe (List (Html Msg))
|
||||
roomEventFormattedContent re = Maybe.map Html.Parser.Util.toVirtualDom
|
||||
<| Maybe.andThen (Result.toMaybe << Html.Parser.run )
|
||||
<| Result.toMaybe
|
||||
<| Decode.decodeValue (Decode.field "formatted_body" Decode.string) re.content
|
||||
|
||||
roomEventContent : (List (Html Msg) -> Html Msg) -> RoomEvent -> Maybe (Html Msg)
|
||||
roomEventContent : (List (Html Msg) -> Html Msg) -> MessageEvent -> Maybe (Html Msg)
|
||||
roomEventContent f re =
|
||||
let
|
||||
body = Decode.decodeValue (Decode.field "body" Decode.string) re.content
|
||||
@@ -280,20 +276,20 @@ roomEventContent f re =
|
||||
Just c -> Just <| f c
|
||||
Nothing -> Maybe.map (f << List.singleton << text) <| Result.toMaybe body
|
||||
|
||||
roomEventEmoteView : Dict String UserData -> RoomEvent -> Maybe (Html Msg)
|
||||
roomEventEmoteView ud re =
|
||||
roomEventEmoteView : RoomData -> MessageEvent -> Maybe (Html Msg)
|
||||
roomEventEmoteView rd re =
|
||||
let
|
||||
emoteText = "* " ++ displayName ud re.sender ++ " "
|
||||
emoteText = "* " ++ getLocalDisplayName rd re.sender ++ " "
|
||||
in
|
||||
roomEventContent (\cs -> span [] (text emoteText :: cs)) re
|
||||
|
||||
roomEventNoticeView : RoomEvent -> Maybe (Html Msg)
|
||||
roomEventNoticeView : MessageEvent -> Maybe (Html Msg)
|
||||
roomEventNoticeView = roomEventContent (span [ class "message-notice" ])
|
||||
|
||||
roomEventTextView : RoomEvent -> Maybe (Html Msg)
|
||||
roomEventTextView : MessageEvent -> Maybe (Html Msg)
|
||||
roomEventTextView = roomEventContent (span [])
|
||||
|
||||
roomEventImageView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
|
||||
roomEventImageView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
|
||||
roomEventImageView apiUrl re =
|
||||
let
|
||||
body = Decode.decodeValue (Decode.field "url" Decode.string) re.content
|
||||
@@ -302,7 +298,7 @@ roomEventImageView apiUrl re =
|
||||
<| Maybe.map (contentRepositoryDownloadUrl apiUrl)
|
||||
<| Result.toMaybe body
|
||||
|
||||
roomEventFileView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
|
||||
roomEventFileView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
|
||||
roomEventFileView apiUrl re =
|
||||
let
|
||||
decoder = Decode.map2 (\l r -> (l, r)) (Decode.field "url" Decode.string) (Decode.field "body" Decode.string)
|
||||
@@ -312,7 +308,7 @@ roomEventFileView apiUrl re =
|
||||
<| Maybe.map (\(url, name) -> (contentRepositoryDownloadUrl apiUrl url, name))
|
||||
<| Result.toMaybe fileData
|
||||
|
||||
roomEventVideoView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
|
||||
roomEventVideoView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
|
||||
roomEventVideoView apiUrl re =
|
||||
let
|
||||
decoder = Decode.map2 (\l r -> (l, r))
|
||||
|
||||
Reference in New Issue
Block a user