From 4777de5b67cef3593040b24336d4fd481216208b Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Fri, 3 Nov 2023 22:44:29 +0100 Subject: [PATCH] Improve complex data types using FastDict --- elm.json | 3 +- src/Internal/Tools/DefaultDict.elm | 56 ++++++++++++++++ src/Internal/Tools/Hashdict.elm | 15 ++++- src/Internal/Tools/Iddict.elm | 40 +++++++++++ src/Internal/Values/Timeline.elm | 104 +++++++++++++++++++++++++++-- src/Matrix/RoomInvite.elm | 2 - 6 files changed, 208 insertions(+), 12 deletions(-) create mode 100644 src/Internal/Tools/DefaultDict.elm create mode 100644 src/Internal/Tools/Iddict.elm diff --git a/elm.json b/elm.json index 59e1a3e..cf69d5a 100644 --- a/elm.json +++ b/elm.json @@ -19,7 +19,8 @@ "elm/http": "2.0.0 <= v < 3.0.0", "elm/json": "1.0.0 <= v < 2.0.0", "elm/time": "1.0.0 <= v < 2.0.0", - "elm/url": "1.0.0 <= v < 2.0.0" + "elm/url": "1.0.0 <= v < 2.0.0", + "miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0" }, "test-dependencies": {} } diff --git a/src/Internal/Tools/DefaultDict.elm b/src/Internal/Tools/DefaultDict.elm new file mode 100644 index 0000000..13015e9 --- /dev/null +++ b/src/Internal/Tools/DefaultDict.elm @@ -0,0 +1,56 @@ +module Internal.Tools.DefaultDict exposing (..) + +import FastDict as Dict exposing (Dict) + +{-| A dictionary of keys and values that includes a default when a key doesn't exist. +-} +type DefaultDict k v + = DefaultDict + { content : Dict k v + , default : v + } + +{-| Create an empty dictionary that has a default value. +-} +empty : v -> DefaultDict k v +empty v = + DefaultDict + { content = Dict.empty + , default = v + } + +{-| Get the value associated with the key. Uses the default if not found. -} +get : comparable -> DefaultDict comparable v -> v +get k (DefaultDict data) = + Dict.get k data.content |> Maybe.withDefault data.default + +{-| Insert a key-value pair into a dictionary with a default. +-} +insert : comparable -> v -> DefaultDict comparable v -> DefaultDict comparable v +insert k v (DefaultDict data) = + DefaultDict { data | content = Dict.insert k v data.content } + +{-| "Remove" a value by making its value synchronize with the default value. +-} +remove : comparable -> DefaultDict comparable v -> DefaultDict comparable v +remove k (DefaultDict data) = + DefaultDict { data | content = Dict.remove k data.content } + +{-| Update the default value of all unset keys. +-} +setDefault : v -> DefaultDict k v -> DefaultDict k v +setDefault v (DefaultDict data) = + DefaultDict { data | default = v } + +{-| Update the value of a dictionary. The returned (or received) value is `Nothing`, +it means the key synchronizes with the default value. +-} +update : comparable -> (Maybe v -> Maybe v) -> DefaultDict comparable v -> DefaultDict comparable v +update k fv (DefaultDict data) = + DefaultDict { data | content = Dict.update k fv data.content } + +{-| Update the default value. +-} +updateDefault : (v -> v) -> DefaultDict k v -> DefaultDict k v +updateDefault f (DefaultDict data) = + DefaultDict { data | default = f data.default } diff --git a/src/Internal/Tools/Hashdict.elm b/src/Internal/Tools/Hashdict.elm index 1835233..cd173ef 100644 --- a/src/Internal/Tools/Hashdict.elm +++ b/src/Internal/Tools/Hashdict.elm @@ -6,8 +6,10 @@ For example, this is used to store events by their event id, or store rooms by t -} -import Dict exposing (Dict) - +import FastDict as Dict exposing (Dict) +import Json.Decode as D +import Json.Encode as E +import Hash exposing (Hash) type Hashdict a = Hashdict @@ -20,6 +22,12 @@ empty : (a -> String) -> Hashdict a empty hash = Hashdict { hash = hash, values = Dict.empty } +encode : Hashdict E.Value -> E.Value +encode (Hashdict h) = + h.values + |> Dict.toList + |> E.object + fromList : (a -> String) -> List a -> Hashdict a fromList hash xs = @@ -46,6 +54,9 @@ keys : Hashdict a -> List String keys (Hashdict h) = Dict.keys h.values +toList : Hashdict a -> List (String, a) +toList (Hashdict h) = + Dict.toList h.values union : Hashdict a -> Hashdict a -> Hashdict a union (Hashdict h1) (Hashdict h2) = diff --git a/src/Internal/Tools/Iddict.elm b/src/Internal/Tools/Iddict.elm new file mode 100644 index 0000000..c5fbafa --- /dev/null +++ b/src/Internal/Tools/Iddict.elm @@ -0,0 +1,40 @@ +module Internal.Tools.Iddict exposing (..) +{-| The id-dict stores values and gives them a unique id. +-} + +import FastDict as Dict exposing (Dict) + +type Iddict a + = Iddict + { cursor : Int + , dict : Dict Int a + } + +empty : Iddict a +empty = + Iddict + { cursor = 0 + , dict = Dict.empty + } + +get : Int -> Iddict a -> Maybe a +get k (Iddict { dict }) = + Dict.get k dict + +insert : a -> Iddict a -> (Int, Iddict a) +insert v (Iddict d) = + ( d.cursor + , Iddict { cursor = d.cursor + 1, dict = Dict.insert d.cursor v d.dict } + ) + +keys : Iddict a -> List Int +keys (Iddict { dict }) = + Dict.keys dict + +remove : Int -> Iddict a -> Iddict a +remove k (Iddict d) = + Iddict { d | dict = Dict.remove k d.dict } + +values : Iddict a -> List a +values (Iddict { dict }) = + Dict.values dict \ No newline at end of file diff --git a/src/Internal/Values/Timeline.elm b/src/Internal/Values/Timeline.elm index 628527a..2c362e5 100644 --- a/src/Internal/Values/Timeline.elm +++ b/src/Internal/Values/Timeline.elm @@ -1,23 +1,113 @@ module Internal.Values.Timeline exposing (..) - -{-| This module shapes the Timeline type used to keep track of timelines in Matrix rooms. +{-| The Timeline can be very complex, and it can be represented in surprisingly +complex manners. This module aims to provide one single Timeline type that +accepts the complex pieces of information from the API and contain it all in +a simple way to view events. -} +import FastDict as Dict exposing (Dict) import Internal.Config.Leaking as Leaking import Internal.Tools.Fold as Fold import Internal.Values.Event as Event exposing (IEvent) import Internal.Values.StateManager as StateManager exposing (StateManager) +import Internal.Tools.DefaultDict as DefaultDict exposing (DefaultDict) +import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) +import Internal.Tools.Iddict as Iddict exposing (Iddict) +import Internal.Tools.Filters.Main as Filter exposing (Filter) +import Internal.Config.Leaking exposing (nextBatch) +{-| The Timeline is a comprehensive object describing a timeline in a room. +Any Timeline type contains the following pieces of information: + +- `events` Comprehensive dictionary containing all locally stored timeline events +- `batches` Comprehensive dictionary containing all batches. Batches are pieces + of the timeline that have been sent by the homeserver. +- `token` Dictionary that maps for each batch token which batches it borders +- `mostRecentSync` Id of the most "recent" batch in the timeline +-} type Timeline = Timeline - { prevBatch : String - , nextBatch : String - , events : List IEvent - , stateAtStart : StateManager - , previous : BeforeTimeline + { events : Hashdict IEvent + , batches : Iddict TimelineBatch + , token : DefaultDict String (List Int) + , mostRecentSync : Maybe Int } +{-| A BatchToken is a token that has been handed out by the server to mark the end of a -} +type alias BatchToken = String + +type alias TimelineBatch = + { prevBatch : List Batch + , nextBatch : List Batch + , filter : Filter + , events : List String + , stateDelta : StateManager + } + +type Batch + = Token BatchToken + | Batch Int + +addNewSync : + { events : List IEvent + , filter : Filter + , limited : Bool + , nextBatch : String + , prevBatch : String + , stateDelta : Maybe StateManager + } -> Timeline -> Timeline +addNewSync data (Timeline timeline) = + let + batchToInsert : TimelineBatch + batchToInsert = + { prevBatch = + [ Just <| Token data.prevBatch + , Maybe.map Batch timeline.mostRecentSync + ] + |> List.filterMap identity + , nextBatch = + [ Token data.nextBatch ] + , filter = data.filter + , events = List.map Event.eventId data.events + , stateDelta = Maybe.withDefault StateManager.empty data.stateDelta + } + in + case Iddict.insert batchToInsert timeline.batches of + ( batchId, batches ) -> + Timeline + { events = List.foldl Hashdict.insert timeline.events data.events + , batches = batches + , mostRecentSync = Just batchId + , token = + timeline.token + |> DefaultDict.update data.prevBatch + (\value -> + case value of + Just v -> + Just (batchId :: v) + Nothing -> + Just [ batchId ] + ) + |> DefaultDict.update data.nextBatch + (\value -> + case value of + Just v -> + Just (batchId :: v) + Nothing -> + Just [ batchId ] + ) + } + +-- type Timeline +-- = Timeline +-- { prevBatch : String +-- , nextBatch : String +-- , events : List IEvent +-- , stateAtStart : StateManager +-- , previous : BeforeTimeline +-- } + type BeforeTimeline = Endless String diff --git a/src/Matrix/RoomInvite.elm b/src/Matrix/RoomInvite.elm index 1a9706c..7b4665b 100644 --- a/src/Matrix/RoomInvite.elm +++ b/src/Matrix/RoomInvite.elm @@ -32,10 +32,8 @@ Once you have the event you want, you can explore it with the following function import Internal.Api.VaultUpdate exposing (VaultUpdate) import Internal.Invite as Internal -import Internal.Tools.Exceptions as X import Internal.Values.RoomInvite as IR import Json.Encode as E -import Task exposing (Task) {-| The `RoomInvite` type serves as an invite to a given room.