diff --git a/src/Scylla/Sync.elm b/src/Scylla/Sync.elm index ecdf409..c4e5c98 100644 --- a/src/Scylla/Sync.elm +++ b/src/Scylla/Sync.elm @@ -273,6 +273,15 @@ historyResponseDecoder = |> required "chunk" (list roomEventDecoder) -- Business Logic: Helper Functions +groupBy : (a -> comparable) -> List a -> Dict comparable (List a) +groupBy f xs = + let + update v ml = case ml of + Just l -> Just (v::l) + Nothing -> Just [ v ] + in + List.foldl (\v acc -> Dict.update (f v) (update v) acc) Dict.empty xs + uniqueByRecursive : (a -> comparable) -> List a -> Set comparable -> List a uniqueByRecursive f l s = case l of x::tail -> if Set.member (f x) s @@ -432,6 +441,16 @@ senderName s = in String.slice 1 colonIndex s +homeserver : String -> String +homeserver s = + let + colonIndex = Maybe.withDefault 0 + <| Maybe.map ((+) 1) + <| List.head + <| String.indexes ":" s + in + String.dropLeft colonIndex s + -- Business Logic: Events allRoomStateEvents : JoinedRoom -> List StateEvent allRoomStateEvents jr = diff --git a/src/Scylla/Views.elm b/src/Scylla/Views.elm index fa14cbe..e6c5738 100644 --- a/src/Scylla/Views.elm +++ b/src/Scylla/Views.elm @@ -12,10 +12,11 @@ import Svg import Svg.Attributes import Url.Builder 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.Events exposing (onInput, onClick, preventDefaultOn) -import Dict +import Dict exposing (Dict) +import Tuple contentRepositoryDownloadUrl : ApiUrl -> String -> String contentRepositoryDownloadUrl apiUrl s = @@ -70,14 +71,30 @@ baseView m jr = roomListView : Model -> Html Msg roomListView m = let - rooms = Maybe.withDefault (Dict.empty) <| Maybe.andThen .join <| m.sync.rooms - roomList = div [ class "rooms-list" ] <| Dict.values <| Dict.map roomListElementView rooms + rooms = Maybe.withDefault (Dict.empty) + <| 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 div [ class "rooms-wrapper" ] [ 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 s jr = let diff --git a/static/scss/style.scss b/static/scss/style.scss index c73de69..f0ee57c 100644 --- a/static/scss/style.scss +++ b/static/scss/style.scss @@ -67,7 +67,7 @@ a { } } -h2 { +h2, h3 { margin: 0px; margin-bottom: 3px; }