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": [
|
"source-directories": [
|
||||||
"src"
|
"src"
|
||||||
],
|
],
|
||||||
"elm-version": "0.19.0",
|
"elm-version": "0.19.1",
|
||||||
"dependencies": {
|
"dependencies": {
|
||||||
"direct": {
|
"direct": {
|
||||||
"NoRedInk/elm-json-decode-pipeline": "1.0.0",
|
"NoRedInk/elm-json-decode-pipeline": "1.0.0",
|
||||||
@@ -29,4 +29,4 @@
|
|||||||
"direct": {},
|
"direct": {},
|
||||||
"indirect": {}
|
"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 exposing (application, UrlRequest(..))
|
||||||
import Browser.Navigation as Nav
|
import Browser.Navigation as Nav
|
||||||
import Browser.Dom exposing (Viewport, setViewportOf)
|
import Browser.Dom exposing (Viewport, setViewportOf)
|
||||||
|
import Scylla.Room exposing (OpenRooms, applySync)
|
||||||
import Scylla.Sync exposing (..)
|
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.Messages exposing (..)
|
||||||
import Scylla.Login exposing (..)
|
import Scylla.Login exposing (..)
|
||||||
import Scylla.Api exposing (..)
|
import Scylla.Api exposing (..)
|
||||||
@@ -9,11 +15,10 @@ import Scylla.Model exposing (..)
|
|||||||
import Scylla.Http exposing (..)
|
import Scylla.Http exposing (..)
|
||||||
import Scylla.Views exposing (viewFull)
|
import Scylla.Views exposing (viewFull)
|
||||||
import Scylla.Route exposing (Route(..), RoomId)
|
import Scylla.Route exposing (Route(..), RoomId)
|
||||||
import Scylla.UserData exposing (..)
|
|
||||||
import Scylla.Notification exposing (..)
|
import Scylla.Notification exposing (..)
|
||||||
import Scylla.Storage exposing (..)
|
import Scylla.Storage exposing (..)
|
||||||
import Scylla.Markdown exposing (..)
|
import Scylla.Markdown exposing (..)
|
||||||
import Scylla.AccountData exposing (..)
|
import Scylla.Room exposing (..)
|
||||||
import Url exposing (Url)
|
import Url exposing (Url)
|
||||||
import Url.Parser exposing (parse)
|
import Url.Parser exposing (parse)
|
||||||
import Url.Builder
|
import Url.Builder
|
||||||
@@ -40,20 +45,15 @@ init _ url key =
|
|||||||
, loginUsername = ""
|
, loginUsername = ""
|
||||||
, loginPassword = ""
|
, loginPassword = ""
|
||||||
, apiUrl = "https://matrix.org"
|
, apiUrl = "https://matrix.org"
|
||||||
, sync =
|
, nextBatch = ""
|
||||||
{ nextBatch = ""
|
, accountData = { events = Just [] }
|
||||||
, rooms = Nothing
|
|
||||||
, presence = Nothing
|
|
||||||
, accountData = Nothing
|
|
||||||
}
|
|
||||||
, errors = []
|
, errors = []
|
||||||
, roomText = Dict.empty
|
, roomText = Dict.empty
|
||||||
, sending = Dict.empty
|
, sending = Dict.empty
|
||||||
, transactionId = 0
|
, transactionId = 0
|
||||||
, userData = Dict.empty
|
|
||||||
, roomNames = Dict.empty
|
|
||||||
, connected = True
|
, connected = True
|
||||||
, searchText = ""
|
, searchText = ""
|
||||||
|
, rooms = emptyOpenRooms
|
||||||
}
|
}
|
||||||
cmd = getStoreValuePort "scylla.loginInfo"
|
cmd = getStoreValuePort "scylla.loginInfo"
|
||||||
in
|
in
|
||||||
@@ -62,7 +62,7 @@ init _ url key =
|
|||||||
view : Model -> Browser.Document Msg
|
view : Model -> Browser.Document Msg
|
||||||
view m =
|
view m =
|
||||||
let
|
let
|
||||||
notificationString = totalNotificationCountString m.sync
|
notificationString = getTotalNotificationCountString m.rooms
|
||||||
titleString = case notificationString of
|
titleString = case notificationString of
|
||||||
Nothing -> "Scylla"
|
Nothing -> "Scylla"
|
||||||
Just s -> s ++ " Scylla"
|
Just s -> s ++ " Scylla"
|
||||||
@@ -85,7 +85,7 @@ update msg model = case msg of
|
|||||||
ReceiveLoginResponse a r -> updateLoginResponse model a r
|
ReceiveLoginResponse a r -> updateLoginResponse model a r
|
||||||
ReceiveFirstSyncResponse r -> updateSyncResponse model r False
|
ReceiveFirstSyncResponse r -> updateSyncResponse model r False
|
||||||
ReceiveSyncResponse r -> updateSyncResponse model r True
|
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
|
ChangeRoomText r t -> updateChangeRoomText model r t
|
||||||
SendRoomText r -> updateSendRoomText model r
|
SendRoomText r -> updateSendRoomText model r
|
||||||
SendRoomTextResponse t r -> updateSendRoomTextResponse model t r
|
SendRoomTextResponse t r -> updateSendRoomTextResponse model t r
|
||||||
@@ -111,12 +111,6 @@ update msg model = case msg of
|
|||||||
requestScrollCmd : Cmd Msg
|
requestScrollCmd : Cmd Msg
|
||||||
requestScrollCmd = Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "messages-wrapper")
|
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 : Model -> Int -> Result Http.Error String -> (Model, Cmd Msg)
|
||||||
updateSendRoomTextResponse m t r =
|
updateSendRoomTextResponse m t r =
|
||||||
let
|
let
|
||||||
@@ -178,25 +172,15 @@ updateUploadSelected m rid f fs msg =
|
|||||||
|
|
||||||
updateHistoryResponse : Model -> RoomId -> Result Http.Error HistoryResponse -> (Model, Cmd Msg)
|
updateHistoryResponse : Model -> RoomId -> Result Http.Error HistoryResponse -> (Model, Cmd Msg)
|
||||||
updateHistoryResponse m r hr =
|
updateHistoryResponse m r hr =
|
||||||
let
|
case hr of
|
||||||
userDataCmd h = newUsersCmd m
|
Ok h -> ({ m | rooms = applyHistoryResponse r h m.rooms }, Cmd.none)
|
||||||
<| newUsers m
|
Err _ -> ({ m | errors = "Unable to load older history from server"::m.errors }, Cmd.none)
|
||||||
<| 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)
|
|
||||||
|
|
||||||
updateHistory : Model -> RoomId -> (Model, Cmd Msg)
|
updateHistory : Model -> RoomId -> (Model, Cmd Msg)
|
||||||
updateHistory m r =
|
updateHistory m r =
|
||||||
let
|
let
|
||||||
prevBatch = Maybe.andThen .prevBatch
|
prevBatch = Dict.get r m.rooms
|
||||||
<| Maybe.andThen .timeline
|
|> Maybe.andThen (.prevHistoryBatch)
|
||||||
<| Maybe.andThen (Dict.get r)
|
|
||||||
<| Maybe.andThen .join
|
|
||||||
<| m.sync.rooms
|
|
||||||
command = case prevBatch of
|
command = case prevBatch of
|
||||||
Just pv -> getHistory m.apiUrl (Maybe.withDefault "" m.token) r pv
|
Just pv -> getHistory m.apiUrl (Maybe.withDefault "" m.token) r pv
|
||||||
Nothing -> Cmd.none
|
Nothing -> Cmd.none
|
||||||
@@ -251,9 +235,10 @@ updateChangeRoute : Model -> Route -> (Model, Cmd Msg)
|
|||||||
updateChangeRoute m r =
|
updateChangeRoute m r =
|
||||||
let
|
let
|
||||||
joinedRoom = case r of
|
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
|
_ -> 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
|
readMarkerCmd = case (r, lastMessage) of
|
||||||
(Room rid, Just re) -> setReadMarkers m.apiUrl (Maybe.withDefault "" m.token) rid re.eventId <| Just re.eventId
|
(Room rid, Just re) -> setReadMarkers m.apiUrl (Maybe.withDefault "" m.token) rid re.eventId <| Just re.eventId
|
||||||
_ -> Cmd.none
|
_ -> Cmd.none
|
||||||
@@ -269,11 +254,6 @@ updateViewportAfterMessage m vr =
|
|||||||
in
|
in
|
||||||
(m, Result.withDefault Cmd.none <| Result.map cmd vr)
|
(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 : Model -> RoomId -> (Model, Cmd Msg)
|
||||||
updateSendRoomText m r =
|
updateSendRoomText m r =
|
||||||
let
|
let
|
||||||
@@ -309,21 +289,21 @@ updateSyncResponse : Model -> Result Http.Error SyncResponse -> Bool -> (Model,
|
|||||||
updateSyncResponse model r notify =
|
updateSyncResponse model r notify =
|
||||||
let
|
let
|
||||||
token = Maybe.withDefault "" model.token
|
token = Maybe.withDefault "" model.token
|
||||||
nextBatch = Result.withDefault model.sync.nextBatch
|
nextBatch = Result.withDefault model.nextBatch
|
||||||
<| Result.map .nextBatch r
|
<| Result.map .nextBatch r
|
||||||
syncCmd = sync model.apiUrl token nextBatch
|
syncCmd = sync model.apiUrl token nextBatch
|
||||||
userDataCmd sr = newUsersCmd model
|
notification sr =
|
||||||
<| newUsers model
|
getPushRuleset model.accountData
|
||||||
<| allUsers sr
|
|> Maybe.map (\rs -> getNotificationEvents rs sr)
|
||||||
notification sr = findFirstBy
|
|> Maybe.withDefault []
|
||||||
(\(s, e) -> e.originServerTs)
|
|> findFirstBy
|
||||||
(\(s, e) -> e.sender /= model.loginUsername)
|
(\(s, e) -> e.originServerTs)
|
||||||
<| joinedRoomNotificationEvents sr
|
(\(s, e) -> e.sender /= model.loginUsername)
|
||||||
notificationCmd sr = if notify
|
notificationCmd sr = if notify
|
||||||
then Maybe.withDefault Cmd.none
|
then Maybe.withDefault Cmd.none
|
||||||
<| Maybe.map (\(s, e) -> sendNotificationPort
|
<| Maybe.map (\(s, e) -> sendNotificationPort
|
||||||
{ name = displayName model.userData e.sender
|
{ name = roomLocalDisplayName model s e.sender
|
||||||
, text = notificationText e
|
, text = getText e
|
||||||
, room = s
|
, room = s
|
||||||
}) <| notification sr
|
}) <| notification sr
|
||||||
else Cmd.none
|
else Cmd.none
|
||||||
@@ -331,6 +311,7 @@ updateSyncResponse model r notify =
|
|||||||
roomMessages sr = case room of
|
roomMessages sr = case room of
|
||||||
Just rid -> List.filter (((==) "m.room.message") << .type_)
|
Just rid -> List.filter (((==) "m.room.message") << .type_)
|
||||||
<| Maybe.withDefault []
|
<| Maybe.withDefault []
|
||||||
|
<| Maybe.map (List.filterMap (toMessageEvent))
|
||||||
<| Maybe.andThen .events
|
<| Maybe.andThen .events
|
||||||
<| Maybe.andThen .timeline
|
<| Maybe.andThen .timeline
|
||||||
<| Maybe.andThen (Dict.get rid)
|
<| 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
|
(Just rid, Just re) -> setReadMarkers model.apiUrl token rid re.eventId <| Just re.eventId
|
||||||
_ -> Cmd.none
|
_ -> Cmd.none
|
||||||
receivedEvents sr = List.map Just <| allTimelineEventIds sr
|
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
|
<| allTimelineEvents sr
|
||||||
sending sr = Dict.filter (\tid (rid, { body, id }) -> not <| List.member (String.fromInt tid) <| receivedTransactions sr) model.sending
|
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 =
|
newModel sr =
|
||||||
{ model | sync = newSync sr
|
{ model | nextBatch = nextBatch
|
||||||
, sending = sending (mergeSyncResponse model.sync sr)
|
, sending = sending sr
|
||||||
, roomNames = computeRoomsDisplayNames model.userData (newSync sr)
|
, rooms = applySync sr model.rooms
|
||||||
|
, accountData = applyAccountData sr.accountData model.accountData
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
case r of
|
case r of
|
||||||
Ok sr -> (newModel sr
|
Ok sr -> (newModel sr
|
||||||
, Cmd.batch
|
, Cmd.batch
|
||||||
[ syncCmd
|
[ syncCmd
|
||||||
, userDataCmd sr
|
|
||||||
, notificationCmd sr
|
, notificationCmd sr
|
||||||
, setScrollCmd sr
|
, setScrollCmd sr
|
||||||
, setReadReceiptCmd 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
|
, tracker = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
userData : ApiUrl -> ApiToken -> Username -> Cmd Msg
|
getUserData : ApiUrl -> ApiToken -> Username -> Cmd Msg
|
||||||
userData apiUrl token username = request
|
getUserData apiUrl token username = request
|
||||||
{ method = "GET"
|
{ method = "GET"
|
||||||
, headers = authenticatedHeaders token
|
, headers = authenticatedHeaders token
|
||||||
, url = (fullClientUrl apiUrl) ++ "/profile/" ++ username
|
, 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 (..)
|
module Scylla.Messages exposing (..)
|
||||||
import Scylla.Sync exposing (RoomEvent)
|
import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
|
||||||
import Scylla.Login exposing (Username)
|
import Scylla.Login exposing (Username)
|
||||||
import Scylla.Route exposing (RoomId)
|
import Scylla.Route exposing (RoomId)
|
||||||
|
import Scylla.Room exposing (RoomData)
|
||||||
import Dict exposing (Dict)
|
import Dict exposing (Dict)
|
||||||
|
|
||||||
type SendingMessageBody = TextMessage String
|
type SendingMessageBody = TextMessage String
|
||||||
@@ -13,15 +14,15 @@ type alias SendingMessage =
|
|||||||
|
|
||||||
type Message
|
type Message
|
||||||
= Sending SendingMessage
|
= Sending SendingMessage
|
||||||
| Received RoomEvent
|
| Received MessageEvent
|
||||||
|
|
||||||
messageUsername : Username -> Message -> Username
|
getUsername : Username -> Message -> Username
|
||||||
messageUsername u msg = case msg of
|
getUsername u msg = case msg of
|
||||||
Sending _ -> u
|
Sending _ -> u
|
||||||
Received re -> re.sender
|
Received re -> re.sender
|
||||||
|
|
||||||
mergeMessages : Username -> List Message -> List (Username, List Message)
|
groupMessages : Username -> List Message -> List (Username, List Message)
|
||||||
mergeMessages du xs =
|
groupMessages du xs =
|
||||||
let
|
let
|
||||||
initialState = (Nothing, [], [])
|
initialState = (Nothing, [], [])
|
||||||
appendNamed mu ms msl = case mu of
|
appendNamed mu ms msl = case mu of
|
||||||
@@ -29,18 +30,19 @@ mergeMessages du xs =
|
|||||||
Nothing -> msl
|
Nothing -> msl
|
||||||
foldFunction msg (pu, ms, msl) =
|
foldFunction msg (pu, ms, msl) =
|
||||||
let
|
let
|
||||||
nu = Just <| messageUsername du msg
|
nu = Just <| getUsername du msg
|
||||||
in
|
in
|
||||||
if pu == nu then (pu, ms ++ [msg], msl) else (nu, [msg], appendNamed pu ms msl)
|
if pu == nu then (pu, ms ++ [msg], msl) else (nu, [msg], appendNamed pu ms msl)
|
||||||
(fmu, fms, fmsl) = List.foldl foldFunction initialState xs
|
(fmu, fms, fmsl) = List.foldl foldFunction initialState xs
|
||||||
in
|
in
|
||||||
appendNamed fmu fms fmsl
|
appendNamed fmu fms fmsl
|
||||||
|
|
||||||
receivedMessagesRoom : List RoomEvent -> List Message
|
getReceivedMessages : RoomData -> List Message
|
||||||
receivedMessagesRoom es = List.map Received
|
getReceivedMessages rd = rd.messages
|
||||||
<| List.filter (\e -> e.type_ == "m.room.message") es
|
|> List.filter (\e -> e.type_ == "m.room.message")
|
||||||
|
|> List.map Received
|
||||||
|
|
||||||
sendingMessagesRoom : RoomId -> Dict Int (RoomId, SendingMessage) -> List Message
|
getSendingMessages : RoomId -> Dict Int (RoomId, SendingMessage) -> List Message
|
||||||
sendingMessagesRoom rid ms = List.map (\(tid, (_, sm)) -> Sending sm)
|
getSendingMessages rid ms = List.map (\(tid, (_, sm)) -> Sending sm)
|
||||||
<| List.filter (\(_, (nrid, _)) -> nrid == rid)
|
<| List.filter (\(_, (nrid, _)) -> nrid == rid)
|
||||||
<| Dict.toList ms
|
<| Dict.toList ms
|
||||||
|
|||||||
@@ -1,9 +1,14 @@
|
|||||||
module Scylla.Model exposing (..)
|
module Scylla.Model exposing (..)
|
||||||
import Scylla.Api exposing (..)
|
import Scylla.Api exposing (..)
|
||||||
import Scylla.Sync exposing (SyncResponse, HistoryResponse, JoinedRoom, senderName, roomName, roomJoinedUsers, findFirst, AccountData)
|
import Scylla.Room exposing (getLocalDisplayName)
|
||||||
import Scylla.AccountData exposing (directMessagesDecoder)
|
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.Login exposing (LoginResponse, Username, Password)
|
||||||
import Scylla.UserData exposing (UserData)
|
|
||||||
import Scylla.Route exposing (Route(..), RoomId)
|
import Scylla.Route exposing (Route(..), RoomId)
|
||||||
import Scylla.Messages exposing (..)
|
import Scylla.Messages exposing (..)
|
||||||
import Scylla.Storage exposing (..)
|
import Scylla.Storage exposing (..)
|
||||||
@@ -26,15 +31,15 @@ type alias Model =
|
|||||||
, loginUsername : Username
|
, loginUsername : Username
|
||||||
, loginPassword : Password
|
, loginPassword : Password
|
||||||
, apiUrl : ApiUrl
|
, apiUrl : ApiUrl
|
||||||
, sync : SyncResponse
|
, accountData : AccountData
|
||||||
|
, nextBatch : String
|
||||||
, errors : List String
|
, errors : List String
|
||||||
, roomText : Dict RoomId String
|
, roomText : Dict RoomId String
|
||||||
, sending : Dict Int (RoomId, SendingMessage)
|
, sending : Dict Int (RoomId, SendingMessage)
|
||||||
, transactionId : Int
|
, transactionId : Int
|
||||||
, userData : Dict Username UserData
|
|
||||||
, roomNames : Dict RoomId String
|
|
||||||
, connected : Bool
|
, connected : Bool
|
||||||
, searchText : String
|
, searchText : String
|
||||||
|
, rooms : OpenRooms
|
||||||
}
|
}
|
||||||
|
|
||||||
type Msg =
|
type Msg =
|
||||||
@@ -73,58 +78,19 @@ type Msg =
|
|||||||
| AttemptReconnect -- User wants to reconnect to server
|
| AttemptReconnect -- User wants to reconnect to server
|
||||||
| UpdateSearchText String -- Change search text in room list
|
| 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 : String -> String
|
||||||
roomUrl s = Url.Builder.absolute [ "room", s ] []
|
roomUrl s = Url.Builder.absolute [ "room", s ] []
|
||||||
|
|
||||||
loginUrl : String
|
loginUrl : String
|
||||||
loginUrl = Url.Builder.absolute [ "login" ] []
|
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 : Model -> Maybe RoomId
|
||||||
currentRoomId m = case m.route of
|
currentRoomId m = case m.route of
|
||||||
Room r -> Just r
|
Room r -> Just r
|
||||||
_ -> Nothing
|
_ -> 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 (..)
|
port module Scylla.Notification exposing (..)
|
||||||
import Scylla.Sync exposing (SyncResponse, RoomEvent, joinedRoomsTimelineEvents)
|
import Scylla.Sync exposing (SyncResponse, joinedRoomsTimelineEvents)
|
||||||
import Scylla.AccountData exposing (..)
|
import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
|
||||||
|
import Scylla.Sync.Push exposing (Ruleset, getEventNotification)
|
||||||
import Json.Decode as Decode exposing (string, field)
|
import Json.Decode as Decode exposing (string, field)
|
||||||
import Dict
|
import Dict
|
||||||
|
|
||||||
@@ -13,17 +14,19 @@ type alias Notification =
|
|||||||
port sendNotificationPort : Notification -> Cmd msg
|
port sendNotificationPort : Notification -> Cmd msg
|
||||||
port onNotificationClickPort : (String -> msg) -> Sub msg
|
port onNotificationClickPort : (String -> msg) -> Sub msg
|
||||||
|
|
||||||
notificationText : RoomEvent -> String
|
getText : MessageEvent -> String
|
||||||
notificationText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
|
getText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
|
||||||
Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content)
|
Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content)
|
||||||
_ -> ""
|
_ -> ""
|
||||||
|
|
||||||
joinedRoomNotificationEvents : SyncResponse -> List (String, RoomEvent)
|
getNotificationEvents : Ruleset -> SyncResponse -> List (String, MessageEvent)
|
||||||
joinedRoomNotificationEvents s =
|
getNotificationEvents rs s = s.rooms
|
||||||
let
|
|> Maybe.andThen .join
|
||||||
applyPair k = List.map (\v -> (k, v))
|
|> Maybe.map (Dict.map (\k v -> v.timeline
|
||||||
in
|
|> Maybe.andThen .events
|
||||||
List.sortBy (\(k, v) -> v.originServerTs)
|
|> Maybe.map (List.filter <| getEventNotification rs k)
|
||||||
<| Dict.foldl (\k v a -> a ++ applyPair k v) []
|
|> Maybe.map (List.filterMap <| toMessageEvent)
|
||||||
<| joinedRoomsTimelineEvents s
|
|> 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.Api exposing (..)
|
||||||
import Scylla.Login exposing (Username)
|
import Scylla.Login exposing (Username)
|
||||||
import Scylla.Route exposing (RoomId)
|
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 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)
|
||||||
import Set exposing (Set)
|
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
|
-- General Sync Response
|
||||||
type alias SyncResponse =
|
type alias SyncResponse =
|
||||||
{ nextBatch : String
|
{ nextBatch : String
|
||||||
@@ -259,213 +52,20 @@ historyResponseDecoder =
|
|||||||
|> required "chunk" (list roomEventDecoder)
|
|> required "chunk" (list roomEventDecoder)
|
||||||
|
|
||||||
-- Business Logic: Helper Functions
|
-- 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 : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
|
||||||
findFirstEvent = findFirstBy .originServerTs
|
findFirstEvent = findFirstBy .originServerTs
|
||||||
|
|
||||||
findLastEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
|
findLastEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
|
||||||
findLastEvent = findLastBy .originServerTs
|
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
|
-- 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 String { a | timeline : Maybe Timeline } -> List RoomEvent
|
||||||
allRoomDictTimelineEvents dict = List.concatMap (Maybe.withDefault [] << .events)
|
allRoomDictTimelineEvents dict = List.concatMap (Maybe.withDefault [] << .events)
|
||||||
<| List.filterMap .timeline
|
<| List.filterMap .timeline
|
||||||
<| Dict.values dict
|
<| Dict.values dict
|
||||||
|
|
||||||
allTimelineEventIds : SyncResponse -> List String
|
allTimelineEventIds : SyncResponse -> List String
|
||||||
allTimelineEventIds s = List.map .eventId <| allTimelineEvents s
|
allTimelineEventIds s = List.map getEventId <| allTimelineEvents s
|
||||||
|
|
||||||
allTimelineEvents : SyncResponse -> List RoomEvent
|
allTimelineEvents : SyncResponse -> List RoomEvent
|
||||||
allTimelineEvents s =
|
allTimelineEvents s =
|
||||||
@@ -476,7 +76,7 @@ allTimelineEvents s =
|
|||||||
joinedEvents = eventsFor .join
|
joinedEvents = eventsFor .join
|
||||||
leftEvents = eventsFor .leave
|
leftEvents = eventsFor .leave
|
||||||
in
|
in
|
||||||
uniqueBy .eventId <| leftEvents ++ joinedEvents
|
leftEvents ++ joinedEvents
|
||||||
|
|
||||||
joinedRoomsTimelineEvents : SyncResponse -> Dict String (List RoomEvent)
|
joinedRoomsTimelineEvents : SyncResponse -> Dict String (List RoomEvent)
|
||||||
joinedRoomsTimelineEvents s =
|
joinedRoomsTimelineEvents s =
|
||||||
@@ -484,65 +84,6 @@ joinedRoomsTimelineEvents s =
|
|||||||
<| Maybe.map (Dict.map (\k v -> Maybe.withDefault [] <| Maybe.andThen .events v.timeline))
|
<| Maybe.map (Dict.map (\k v -> Maybe.withDefault [] <| Maybe.andThen .events v.timeline))
|
||||||
<| Maybe.andThen .join s.rooms
|
<| 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
|
-- Business Logic: Users
|
||||||
allUsers : SyncResponse -> List Username
|
allUsers : SyncResponse -> List Username
|
||||||
allUsers s = uniqueBy (\u -> u) <| List.map .sender <| allTimelineEvents s
|
allUsers s = uniqueBy (\u -> u) <| List.map getSender <| 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
|
|
||||||
|
|||||||
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 (..)
|
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 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)
|
||||||
|
import Dict exposing (Dict)
|
||||||
|
|
||||||
type alias UserData =
|
type alias UserData =
|
||||||
{ displayName : Maybe String
|
{ displayName : Maybe String
|
||||||
@@ -12,3 +14,13 @@ userDataDecoder =
|
|||||||
Decode.succeed UserData
|
Decode.succeed UserData
|
||||||
|> optional "displayname" (Decode.map Just string) Nothing
|
|> optional "displayname" (Decode.map Just string) Nothing
|
||||||
|> optional "avatar_url" (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 (..)
|
module Scylla.Views exposing (..)
|
||||||
import Scylla.Model exposing (..)
|
import Scylla.Model exposing (..)
|
||||||
import Scylla.Sync 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.Route exposing (..)
|
||||||
import Scylla.Fnv as Fnv
|
import Scylla.Fnv as Fnv
|
||||||
import Scylla.Messages exposing (..)
|
import Scylla.Messages exposing (..)
|
||||||
import Scylla.Login exposing (Username)
|
import Scylla.Login exposing (Username)
|
||||||
import Scylla.UserData exposing (UserData)
|
|
||||||
import Scylla.Http exposing (fullMediaUrl)
|
import Scylla.Http exposing (fullMediaUrl)
|
||||||
import Scylla.Api exposing (ApiUrl)
|
import Scylla.Api exposing (ApiUrl)
|
||||||
|
import Scylla.ListUtils exposing (groupBy)
|
||||||
import Html.Parser
|
import Html.Parser
|
||||||
import Html.Parser.Util
|
import Html.Parser.Util
|
||||||
import Svg
|
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 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.Attributes exposing (type_, placeholder, value, href, class, style, src, id, rows, controls, src, classList)
|
||||||
import Html.Events exposing (onInput, onClick, preventDefaultOn)
|
import Html.Events exposing (onInput, onClick, preventDefaultOn)
|
||||||
import Html.Lazy exposing (lazy6)
|
import Html.Lazy exposing (lazy5)
|
||||||
import Dict exposing (Dict)
|
import Dict exposing (Dict)
|
||||||
import Tuple
|
import Tuple
|
||||||
|
|
||||||
@@ -44,10 +47,8 @@ stringColor s =
|
|||||||
viewFull : Model -> List (Html Msg)
|
viewFull : Model -> List (Html Msg)
|
||||||
viewFull model =
|
viewFull model =
|
||||||
let
|
let
|
||||||
room r = Maybe.map (\jr -> (r, jr))
|
room r = Dict.get r model.rooms
|
||||||
<| Maybe.andThen (Dict.get r)
|
|> Maybe.map (\rd -> (r, rd))
|
||||||
<| Maybe.andThen .join
|
|
||||||
<| model.sync.rooms
|
|
||||||
core = case model.route of
|
core = case model.route of
|
||||||
Login -> loginView model
|
Login -> loginView model
|
||||||
Base -> baseView model Nothing
|
Base -> baseView model Nothing
|
||||||
@@ -63,10 +64,10 @@ errorsView = div [ class "errors-wrapper" ] << List.indexedMap errorView
|
|||||||
errorView : Int -> String -> Html Msg
|
errorView : Int -> String -> Html Msg
|
||||||
errorView i s = div [ class "error-wrapper", onClick <| DismissError i ] [ iconView "alert-triangle", text s ]
|
errorView i s = div [ class "error-wrapper", onClick <| DismissError i ] [ iconView "alert-triangle", text s ]
|
||||||
|
|
||||||
baseView : Model -> Maybe (RoomId, JoinedRoom) -> Html Msg
|
baseView : Model -> Maybe (RoomId, RoomData) -> Html Msg
|
||||||
baseView m jr =
|
baseView m rd =
|
||||||
let
|
let
|
||||||
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) jr
|
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) rd
|
||||||
reconnect = reconnectView m
|
reconnect = reconnectView m
|
||||||
in
|
in
|
||||||
div [ class "base-wrapper" ] <| maybeHtml
|
div [ class "base-wrapper" ] <| maybeHtml
|
||||||
@@ -83,11 +84,8 @@ reconnectView m = if m.connected
|
|||||||
roomListView : Model -> Html Msg
|
roomListView : Model -> Html Msg
|
||||||
roomListView m =
|
roomListView m =
|
||||||
let
|
let
|
||||||
rooms = Maybe.withDefault (Dict.empty)
|
|
||||||
<| Maybe.andThen .join
|
|
||||||
<| m.sync.rooms
|
|
||||||
groups = roomGroups
|
groups = roomGroups
|
||||||
<| Dict.toList rooms
|
<| Dict.toList m.rooms
|
||||||
homeserverList = div [ class "homeservers-list" ]
|
homeserverList = div [ class "homeservers-list" ]
|
||||||
<| List.map (\(k, v) -> homeserverView m k v)
|
<| List.map (\(k, v) -> homeserverView m k v)
|
||||||
<| Dict.toList groups
|
<| Dict.toList groups
|
||||||
@@ -104,22 +102,22 @@ roomListView m =
|
|||||||
, homeserverList
|
, homeserverList
|
||||||
]
|
]
|
||||||
|
|
||||||
roomGroups : List (String, JoinedRoom) -> Dict String (List (String, JoinedRoom))
|
roomGroups : List (String, RoomData) -> Dict String (List (String, RoomData))
|
||||||
roomGroups jrs = groupBy (homeserver << Tuple.first) jrs
|
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 =
|
homeserverView m hs rs =
|
||||||
let
|
let
|
||||||
roomList = div [ class "rooms-list" ]
|
roomList = div [ class "rooms-list" ]
|
||||||
<| List.map (\(rid, r) -> roomListElementView m rid r)
|
<| 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
|
in
|
||||||
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
|
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
|
||||||
|
|
||||||
roomListElementView : Model -> RoomId -> JoinedRoom -> Html Msg
|
roomListElementView : Model -> RoomId -> RoomData -> Html Msg
|
||||||
roomListElementView m rid jr =
|
roomListElementView m rid rd =
|
||||||
let
|
let
|
||||||
name = roomDisplayName m.roomNames rid
|
name = getRoomName m.accountData rid rd
|
||||||
isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name)
|
isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name)
|
||||||
isCurrentRoom = case currentRoomId m of
|
isCurrentRoom = case currentRoomId m of
|
||||||
Nothing -> False
|
Nothing -> False
|
||||||
@@ -131,10 +129,10 @@ roomListElementView m rid jr =
|
|||||||
, ("hidden", not isVisible)
|
, ("hidden", not isVisible)
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
<| roomNotificationCountView jr.unreadNotifications ++
|
<| roomNotificationCountView rd.unreadNotifications ++
|
||||||
[ a [ href <| roomUrl rid ] [ text name ] ]
|
[ a [ href <| roomUrl rid ] [ text name ] ]
|
||||||
|
|
||||||
roomNotificationCountView : Maybe UnreadNotificationCounts -> List (Html Msg)
|
roomNotificationCountView : UnreadNotificationCounts -> List (Html Msg)
|
||||||
roomNotificationCountView ns =
|
roomNotificationCountView ns =
|
||||||
let
|
let
|
||||||
wrap b = span
|
wrap b = span
|
||||||
@@ -143,7 +141,7 @@ roomNotificationCountView ns =
|
|||||||
, ("bright", b)
|
, ("bright", b)
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
getCount f = Maybe.withDefault 0 << Maybe.andThen f
|
getCount f = Maybe.withDefault 0 << f
|
||||||
in
|
in
|
||||||
case (getCount .notificationCount ns, getCount .highlightCount ns) of
|
case (getCount .notificationCount ns, getCount .highlightCount ns) of
|
||||||
(0, 0) -> []
|
(0, 0) -> []
|
||||||
@@ -159,10 +157,10 @@ loginView m = div [ class "login-wrapper" ]
|
|||||||
, button [ onClick AttemptLogin ] [ text "Log In" ]
|
, button [ onClick AttemptLogin ] [ text "Log In" ]
|
||||||
]
|
]
|
||||||
|
|
||||||
joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg
|
joinedRoomView : Model -> RoomId -> RoomData -> Html Msg
|
||||||
joinedRoomView m roomId jr =
|
joinedRoomView m roomId rd =
|
||||||
let
|
let
|
||||||
typing = List.map (displayName m.userData) <| roomTypingUsers jr
|
typing = List.map (getLocalDisplayName rd) <| getRoomTypingUsers rd
|
||||||
typingText = String.join ", " typing
|
typingText = String.join ", " typing
|
||||||
typingSuffix = case List.length typing of
|
typingSuffix = case List.length typing of
|
||||||
0 -> ""
|
0 -> ""
|
||||||
@@ -183,21 +181,19 @@ joinedRoomView m roomId jr =
|
|||||||
]
|
]
|
||||||
in
|
in
|
||||||
div [ class "room-wrapper" ]
|
div [ class "room-wrapper" ]
|
||||||
[ h2 [] [ text <| roomDisplayName m.roomNames roomId ]
|
[ h2 [] [ text <| getRoomName m.accountData roomId rd ]
|
||||||
, lazy6 lazyMessagesView m.userData roomId jr m.apiUrl m.loginUsername m.sending
|
, lazy5 lazyMessagesView roomId rd m.apiUrl m.loginUsername m.sending
|
||||||
, messageInput
|
, messageInput
|
||||||
, typingWrapper
|
, typingWrapper
|
||||||
]
|
]
|
||||||
|
|
||||||
lazyMessagesView : Dict String UserData -> RoomId -> JoinedRoom -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg
|
lazyMessagesView : RoomId -> RoomData -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg
|
||||||
lazyMessagesView ud rid jr au lu snd =
|
lazyMessagesView rid rd au lu snd =
|
||||||
let
|
let
|
||||||
roomReceived = receivedMessagesRoom
|
roomReceived = getReceivedMessages rd
|
||||||
<| Maybe.withDefault []
|
roomSending = getSendingMessages rid snd
|
||||||
<| Maybe.andThen .events jr.timeline
|
renderedMessages = List.map (userMessagesView rd au)
|
||||||
roomSending = sendingMessagesRoom rid snd
|
<| groupMessages lu
|
||||||
renderedMessages = List.map (userMessagesView ud au)
|
|
||||||
<| mergeMessages lu
|
|
||||||
<| roomReceived ++ roomSending
|
<| roomReceived ++ roomSending
|
||||||
in
|
in
|
||||||
messagesWrapperView rid renderedMessages
|
messagesWrapperView rid renderedMessages
|
||||||
@@ -227,50 +223,50 @@ messagesWrapperView rid es = div [ class "messages-wrapper", id "messages-wrappe
|
|||||||
, table [ class "messages-table" ] es
|
, table [ class "messages-table" ] es
|
||||||
]
|
]
|
||||||
|
|
||||||
senderView : Dict String UserData -> Username -> Html Msg
|
senderView : RoomData -> Username -> Html Msg
|
||||||
senderView ud s =
|
senderView rd s =
|
||||||
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName ud s ]
|
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| getLocalDisplayName rd s ]
|
||||||
|
|
||||||
userMessagesView : Dict String UserData -> ApiUrl -> (Username, List Message) -> Html Msg
|
userMessagesView : RoomData -> ApiUrl -> (Username, List Message) -> Html Msg
|
||||||
userMessagesView ud apiUrl (u, ms) =
|
userMessagesView rd apiUrl (u, ms) =
|
||||||
let
|
let
|
||||||
wrap h = div [ class "message" ] [ h ]
|
wrap h = div [ class "message" ] [ h ]
|
||||||
in
|
in
|
||||||
tr []
|
tr []
|
||||||
[ td [] [ senderView ud u ]
|
[ td [] [ senderView rd u ]
|
||||||
, td [] <| List.map wrap <| List.filterMap (messageView ud apiUrl) ms
|
, td [] <| List.map wrap <| List.filterMap (messageView rd apiUrl) ms
|
||||||
]
|
]
|
||||||
|
|
||||||
messageView : Dict String UserData -> ApiUrl -> Message -> Maybe (Html Msg)
|
messageView : RoomData -> ApiUrl -> Message -> Maybe (Html Msg)
|
||||||
messageView ud apiUrl msg = case msg of
|
messageView rd apiUrl msg = case msg of
|
||||||
Sending t -> Just <| sendingMessageView t
|
Sending t -> Just <| sendingMessageView t
|
||||||
Received re -> roomEventView ud apiUrl re
|
Received re -> roomEventView rd apiUrl re
|
||||||
|
|
||||||
sendingMessageView : SendingMessage -> Html Msg
|
sendingMessageView : SendingMessage -> Html Msg
|
||||||
sendingMessageView msg = case msg.body of
|
sendingMessageView msg = case msg.body of
|
||||||
TextMessage t -> span [ class "sending"] [ text t ]
|
TextMessage t -> span [ class "sending"] [ text t ]
|
||||||
|
|
||||||
roomEventView : Dict String UserData -> ApiUrl -> RoomEvent -> Maybe (Html Msg)
|
roomEventView : RoomData -> ApiUrl -> MessageEvent -> Maybe (Html Msg)
|
||||||
roomEventView ud apiUrl re =
|
roomEventView rd apiUrl re =
|
||||||
let
|
let
|
||||||
msgtype = Decode.decodeValue (Decode.field "msgtype" Decode.string) re.content
|
msgtype = Decode.decodeValue (Decode.field "msgtype" Decode.string) re.content
|
||||||
in
|
in
|
||||||
case msgtype of
|
case msgtype of
|
||||||
Ok "m.text" -> roomEventTextView re
|
Ok "m.text" -> roomEventTextView re
|
||||||
Ok "m.notice" -> roomEventNoticeView 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.image" -> roomEventImageView apiUrl re
|
||||||
Ok "m.file" -> roomEventFileView apiUrl re
|
Ok "m.file" -> roomEventFileView apiUrl re
|
||||||
Ok "m.video" -> roomEventVideoView apiUrl re
|
Ok "m.video" -> roomEventVideoView apiUrl re
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
roomEventFormattedContent : RoomEvent -> Maybe (List (Html Msg))
|
roomEventFormattedContent : MessageEvent -> Maybe (List (Html Msg))
|
||||||
roomEventFormattedContent re = Maybe.map Html.Parser.Util.toVirtualDom
|
roomEventFormattedContent re = Maybe.map Html.Parser.Util.toVirtualDom
|
||||||
<| Maybe.andThen (Result.toMaybe << Html.Parser.run )
|
<| Maybe.andThen (Result.toMaybe << Html.Parser.run )
|
||||||
<| Result.toMaybe
|
<| Result.toMaybe
|
||||||
<| Decode.decodeValue (Decode.field "formatted_body" Decode.string) re.content
|
<| 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 =
|
roomEventContent f re =
|
||||||
let
|
let
|
||||||
body = Decode.decodeValue (Decode.field "body" Decode.string) re.content
|
body = Decode.decodeValue (Decode.field "body" Decode.string) re.content
|
||||||
@@ -280,20 +276,20 @@ roomEventContent f re =
|
|||||||
Just c -> Just <| f c
|
Just c -> Just <| f c
|
||||||
Nothing -> Maybe.map (f << List.singleton << text) <| Result.toMaybe body
|
Nothing -> Maybe.map (f << List.singleton << text) <| Result.toMaybe body
|
||||||
|
|
||||||
roomEventEmoteView : Dict String UserData -> RoomEvent -> Maybe (Html Msg)
|
roomEventEmoteView : RoomData -> MessageEvent -> Maybe (Html Msg)
|
||||||
roomEventEmoteView ud re =
|
roomEventEmoteView rd re =
|
||||||
let
|
let
|
||||||
emoteText = "* " ++ displayName ud re.sender ++ " "
|
emoteText = "* " ++ getLocalDisplayName rd re.sender ++ " "
|
||||||
in
|
in
|
||||||
roomEventContent (\cs -> span [] (text emoteText :: cs)) re
|
roomEventContent (\cs -> span [] (text emoteText :: cs)) re
|
||||||
|
|
||||||
roomEventNoticeView : RoomEvent -> Maybe (Html Msg)
|
roomEventNoticeView : MessageEvent -> Maybe (Html Msg)
|
||||||
roomEventNoticeView = roomEventContent (span [ class "message-notice" ])
|
roomEventNoticeView = roomEventContent (span [ class "message-notice" ])
|
||||||
|
|
||||||
roomEventTextView : RoomEvent -> Maybe (Html Msg)
|
roomEventTextView : MessageEvent -> Maybe (Html Msg)
|
||||||
roomEventTextView = roomEventContent (span [])
|
roomEventTextView = roomEventContent (span [])
|
||||||
|
|
||||||
roomEventImageView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
|
roomEventImageView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
|
||||||
roomEventImageView apiUrl re =
|
roomEventImageView apiUrl re =
|
||||||
let
|
let
|
||||||
body = Decode.decodeValue (Decode.field "url" Decode.string) re.content
|
body = Decode.decodeValue (Decode.field "url" Decode.string) re.content
|
||||||
@@ -302,7 +298,7 @@ roomEventImageView apiUrl re =
|
|||||||
<| Maybe.map (contentRepositoryDownloadUrl apiUrl)
|
<| Maybe.map (contentRepositoryDownloadUrl apiUrl)
|
||||||
<| Result.toMaybe body
|
<| Result.toMaybe body
|
||||||
|
|
||||||
roomEventFileView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
|
roomEventFileView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
|
||||||
roomEventFileView apiUrl re =
|
roomEventFileView apiUrl re =
|
||||||
let
|
let
|
||||||
decoder = Decode.map2 (\l r -> (l, r)) (Decode.field "url" Decode.string) (Decode.field "body" Decode.string)
|
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))
|
<| Maybe.map (\(url, name) -> (contentRepositoryDownloadUrl apiUrl url, name))
|
||||||
<| Result.toMaybe fileData
|
<| Result.toMaybe fileData
|
||||||
|
|
||||||
roomEventVideoView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
|
roomEventVideoView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
|
||||||
roomEventVideoView apiUrl re =
|
roomEventVideoView apiUrl re =
|
||||||
let
|
let
|
||||||
decoder = Decode.map2 (\l r -> (l, r))
|
decoder = Decode.map2 (\l r -> (l, r))
|
||||||
|
|||||||
Reference in New Issue
Block a user