Group rooms by homeserver.

This commit is contained in:
Danila Fedorin 2018-12-24 14:08:26 -08:00
parent 1d3b0febde
commit 3c91be9fb6
3 changed files with 42 additions and 6 deletions

View File

@ -273,6 +273,15 @@ 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
uniqueByRecursive : (a -> comparable) -> List a -> Set comparable -> List a uniqueByRecursive : (a -> comparable) -> List a -> Set comparable -> List a
uniqueByRecursive f l s = case l of uniqueByRecursive f l s = case l of
x::tail -> if Set.member (f x) s x::tail -> if Set.member (f x) s
@ -432,6 +441,16 @@ senderName s =
in in
String.slice 1 colonIndex s 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 : JoinedRoom -> List StateEvent
allRoomStateEvents jr = allRoomStateEvents jr =

View File

@ -12,10 +12,11 @@ import Svg
import Svg.Attributes import Svg.Attributes
import Url.Builder import Url.Builder
import Json.Decode as Decode import Json.Decode as Decode
import Html exposing (Html, Attribute, div, input, text, button, div, span, a, h2, table, td, tr, img, textarea, video, source) import Html exposing (Html, Attribute, div, input, text, button, div, span, a, h2, h3, table, td, tr, img, textarea, video, source)
import Html.Attributes exposing (type_, value, href, class, style, src, id, rows, controls, src) import Html.Attributes exposing (type_, value, href, class, style, src, id, rows, controls, src)
import Html.Events exposing (onInput, onClick, preventDefaultOn) import Html.Events exposing (onInput, onClick, preventDefaultOn)
import Dict import Dict exposing (Dict)
import Tuple
contentRepositoryDownloadUrl : ApiUrl -> String -> String contentRepositoryDownloadUrl : ApiUrl -> String -> String
contentRepositoryDownloadUrl apiUrl s = contentRepositoryDownloadUrl apiUrl s =
@ -70,14 +71,30 @@ baseView m jr =
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 rooms = Maybe.withDefault (Dict.empty)
roomList = div [ class "rooms-list" ] <| Dict.values <| Dict.map roomListElementView rooms <| Maybe.andThen .join
<| m.sync.rooms
groups = roomGroups
<| Dict.toList rooms
homeserverList = div [ class "homeservers-list" ]
<| List.map (\(k, v) -> homeserverView k v)
<| Dict.toList groups
in in
div [ class "rooms-wrapper" ] div [ class "rooms-wrapper" ]
[ h2 [] [ text "Rooms" ] [ h2 [] [ text "Rooms" ]
, roomList , homeserverList
] ]
roomGroups : List (String, JoinedRoom) -> Dict String (List (String, JoinedRoom))
roomGroups jrs = groupBy (homeserver << Tuple.first) jrs
homeserverView : String -> List (String, JoinedRoom) -> Html Msg
homeserverView hs rs =
let
roomList = div [ class "rooms-list" ] <| List.map (\(rid, r) -> roomListElementView rid r) rs
in
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
roomListElementView : String -> JoinedRoom -> Html Msg roomListElementView : String -> JoinedRoom -> Html Msg
roomListElementView s jr = roomListElementView s jr =
let let

View File

@ -67,7 +67,7 @@ a {
} }
} }
h2 { h2, h3 {
margin: 0px; margin: 0px;
margin-bottom: 3px; margin-bottom: 3px;
} }