From e1a4bcab9b2b75b674101aa3e605d497e8b2c63b Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Dec 2023 14:50:43 +0100 Subject: [PATCH] Add StateManager type --- elm.json | 1 + src/Internal/Values/StateManager.elm | 276 +++++++++++++++++++++++++++ tests/Test/Values/Event.elm | 16 ++ tests/Test/Values/StateManager.elm | 137 +++++++++++++ 4 files changed, 430 insertions(+) create mode 100644 src/Internal/Values/StateManager.elm create mode 100644 tests/Test/Values/StateManager.elm diff --git a/elm.json b/elm.json index a1c9977..405b455 100644 --- a/elm.json +++ b/elm.json @@ -22,6 +22,7 @@ "Internal.Values.Envelope", "Internal.Values.Event", "Internal.Values.Settings", + "Internal.Values.StateManager", "Internal.Values.Vault", "Types" ], diff --git a/src/Internal/Values/StateManager.elm b/src/Internal/Values/StateManager.elm new file mode 100644 index 0000000..976415f --- /dev/null +++ b/src/Internal/Values/StateManager.elm @@ -0,0 +1,276 @@ +module Internal.Values.StateManager exposing + ( StateManager + , empty, singleton, insert, remove, append + , isEmpty, member, memberKey, get, size, isEqual + , keys, values, fromList, toList + , encode, decoder + ) + +{-| The StateManager tracks the room state based on events, their event types +and the optional state keys they provide. Instead of making the user loop +through the room's timeline of events, the StateManager offers the user a +dictionary-like experience to navigate through the Matrix room state. + + +## Dictionaries + +@docs StateManager + + +## Build + +@docs empty, singleton, insert, remove, append + + +## Query + +@docs isEmpty, member, memberKey, get, size, isEqual + + +## Lists + +@docs keys, values, fromList, toList + + +## JSON coders + +@docs encode, decoder + +-} + +import FastDict as Dict exposing (Dict) +import Internal.Tools.Mashdict as Mashdict exposing (Mashdict) +import Internal.Values.Event as Event exposing (Event) +import Json.Decode as D +import Json.Encode as E + + +{-| The StateManager manages the room state by gathering events and looking at +their details. +-} +type StateManager + = StateManager (Dict String (Mashdict Event)) + + +{-| Add a new statemanager on top of an existing StateManager. This can be +useful when trying to calculate a room state based on two already existing +types. +-} +append : StateManager -> StateManager -> StateManager +append sm2 sm1 = + List.foldl insert sm1 (values sm2) + + +{-| Remove any floating empty Mashdicts from ALL keys in the dictionary. +-} +cleanAll : StateManager -> StateManager +cleanAll ((StateManager manager) as sm) = + List.foldl cleanKey sm (Dict.keys manager) + + +{-| To keep the StateManager as simple as possible, you can keep the dictionary +clean by removing any floating empty Mashdicts in the dictionary. + +To save time, this function exclusively removes an empty Mashdict at a given +key. This way, you don't need to run a complete clean of a large dictionary +every time you just edit a single key in the dictionary. + +-} +cleanKey : String -> StateManager -> StateManager +cleanKey key (StateManager manager) = + manager + |> Dict.update key + (Maybe.andThen + (\dict -> + if Mashdict.isEmpty dict then + Nothing + + else + Just dict + ) + ) + |> StateManager + + +{-| Decode a StateManager from a JSON value. +-} +decoder : D.Decoder StateManager +decoder = + Event.decoder + |> Mashdict.decoder .stateKey + |> D.keyValuePairs + |> D.map Dict.fromList + |> D.map StateManager + + +{-| Create an empty StateManager. +-} +empty : StateManager +empty = + StateManager Dict.empty + + +{-| Encode a StateManager into a JSON value. +-} +encode : StateManager -> E.Value +encode (StateManager manager) = + manager + |> Dict.toCoreDict + |> E.dict identity (Mashdict.encode Event.encode) + + +{-| Build a StateManager using a list of events. +-} +fromList : List Event -> StateManager +fromList events = + List.foldl insert empty events + + +{-| Get an event based on its event type and state key. If there is no such +event sent in the room, the function returns `Nothing`. +-} +get : { eventType : String, stateKey : String } -> StateManager -> Maybe Event +get { eventType, stateKey } (StateManager manager) = + manager + |> Dict.get eventType + |> Maybe.andThen (Mashdict.get stateKey) + + +{-| Insert a new event into the state manager. If the event does not have a +state key, it is overlooked. +-} +insert : Event -> StateManager -> StateManager +insert event (StateManager manager) = + manager + |> Dict.update + event.eventType + (\typeDict -> + case typeDict of + Nothing -> + Just <| Mashdict.singleton .stateKey event + + Just md -> + Just <| Mashdict.insert event md + ) + |> StateManager + |> cleanKey event.eventType + + +{-| Determine whether the StateManager contains any events. +-} +isEmpty : StateManager -> Bool +isEmpty (StateManager manager) = + Dict.isEmpty manager + + +{-| Since the StateManager's internal structure prevents Elm from making (==) +comparisons, the `isEqual` function allows you to make comparisons that ignore +the incomparable function. +-} +isEqual : StateManager -> StateManager -> Bool +isEqual (StateManager sm1) (StateManager sm2) = + if Dict.size sm1 /= Dict.size sm2 then + False + + else if Dict.keys sm1 /= Dict.keys sm2 then + False + + else + List.all + (\key -> + case ( Dict.get key sm1, Dict.get key sm2 ) of + ( Just s1, Just s2 ) -> + Mashdict.isEqual s1 s2 + + ( _, _ ) -> + False + ) + (Dict.keys sm1) + + +{-| Retrieve all keys from a StateManager. +-} +keys : StateManager -> List { eventType : String, stateKey : String } +keys (StateManager manager) = + manager + |> Dict.toList + |> List.map + (\( eventType, dict ) -> + dict + |> Mashdict.keys + |> List.map + (\stateKey -> + { eventType = eventType, stateKey = stateKey } + ) + ) + |> List.concat + + +{-| Determine whether an event is part of the StateManager. +-} +member : Event -> StateManager -> Bool +member event (StateManager manager) = + case Dict.get event.eventType manager of + Just dict -> + Mashdict.member event dict + + Nothing -> + False + + +{-| Determine whether a given key is part of the StateManager. +-} +memberKey : { eventType : String, stateKey : String } -> StateManager -> Bool +memberKey { eventType, stateKey } (StateManager manager) = + case Dict.get eventType manager of + Just dict -> + Mashdict.memberKey stateKey dict + + Nothing -> + False + + +{-| Get a StateManager without a given event in it. If the StateManager already +doesn't have the event, nothing changes. +-} +remove : Event -> StateManager -> StateManager +remove event (StateManager manager) = + manager + |> Dict.update event.eventType (Maybe.map (Mashdict.remove event)) + |> StateManager + |> cleanKey event.eventType + + +{-| Create a StateManager that contains a single event. +-} +singleton : Event -> StateManager +singleton event = + insert event empty + + +{-| Determine the StateManager's size by the amount of events. +-} +size : StateManager -> Int +size (StateManager manager) = + manager + |> Dict.values + |> List.map Mashdict.size + |> List.sum + + +{-| Transform the StateManager to a list of events. +-} +toList : StateManager -> List Event +toList = + values + + +{-| Get the values from the StateManager, ordered by their event type (and by +their state key, if multiple events are of the same event type). +-} +values : StateManager -> List Event +values (StateManager manager) = + manager + |> Dict.values + |> List.map Mashdict.values + |> List.concat diff --git a/tests/Test/Values/Event.elm b/tests/Test/Values/Event.elm index 89c80a5..68dbd8a 100644 --- a/tests/Test/Values/Event.elm +++ b/tests/Test/Values/Event.elm @@ -19,6 +19,22 @@ fuzzer = Fuzz.string (Fuzz.maybe unsignedDataFuzzer) +{-| Fuzzer for an event with a set state key +-} +fuzzerState : Fuzzer Event +fuzzerState = + Fuzz.map2 + (\event default -> + { event + | stateKey = + event.stateKey + |> Maybe.withDefault default + |> Maybe.Just + } + ) + fuzzer + Fuzz.string + unsignedDataFuzzer : Fuzzer Event.UnsignedData unsignedDataFuzzer = diff --git a/tests/Test/Values/StateManager.elm b/tests/Test/Values/StateManager.elm new file mode 100644 index 0000000..43580c7 --- /dev/null +++ b/tests/Test/Values/StateManager.elm @@ -0,0 +1,137 @@ +module Test.Values.StateManager exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Internal.Values.Event as Event +import Internal.Values.StateManager as StateManager exposing (StateManager) +import Json.Decode as D +import Json.Encode as E +import Test exposing (..) +import Test.Values.Event as TestEvent + + +fuzzer : Fuzzer StateManager +fuzzer = + TestEvent.fuzzer + |> Fuzz.list + |> Fuzz.map StateManager.fromList + + +fuzzerKey : Fuzzer { eventType : String, stateKey : String } +fuzzerKey = + Fuzz.map2 + (\a b -> { eventType = a, stateKey = b }) + Fuzz.string + Fuzz.string + + +suite : Test +suite = + describe "StateManager" + [ describe "empty" + [ test "empty isEmpty" + (StateManager.empty + |> StateManager.isEmpty + |> Expect.equal True + |> always + ) + , fuzz TestEvent.fuzzer + "empty has no member" + (\event -> + StateManager.empty + |> StateManager.member event + |> Expect.equal False + ) + , fuzz fuzzerKey + "empty has no memberKey" + (\key -> + StateManager.empty + |> StateManager.memberKey key + |> Expect.equal False + ) + , fuzz fuzzerKey + "Empty gets Nothing" + (\key -> + StateManager.empty + |> StateManager.get key + |> Expect.equal Nothing + ) + , test "Empty has no keys" + (StateManager.empty + |> StateManager.keys + |> Expect.equal [] + |> always + ) + , test "Empty has no values" + (StateManager.empty + |> StateManager.values + |> Expect.equal [] + |> always + ) + , test "toList empty equals []" + (StateManager.empty + |> StateManager.toList + |> Expect.equal [] + |> always + ) + , test "fromList [] equals empty" + ([] + |> StateManager.fromList + |> Expect.equal StateManager.empty + |> always + ) + , test "JSON encode -> JSON decode remains empty" + (StateManager.empty + |> StateManager.encode + |> E.encode 0 + |> D.decodeString StateManager.decoder + |> Expect.equal (Ok StateManager.empty) + |> always + ) + ] + , describe "singleton" + [ fuzz TestEvent.fuzzerState + "singleton = empty + event" + (\event -> + StateManager.empty + |> StateManager.insert event + |> StateManager.isEqual (StateManager.singleton event) + |> Expect.equal True + ) + , fuzz TestEvent.fuzzerState + "singleton - event = empty" + (\event -> + StateManager.singleton event + |> StateManager.remove event + |> StateManager.isEqual StateManager.empty + |> Expect.equal True + ) + , fuzz TestEvent.fuzzerState + "singleton has one member" + (\event -> + StateManager.singleton event + |> StateManager.member event + |> Expect.equal True + ) + -- , fuzz2 TestEvent.fuzzerState TestEvent.fuzzerState + -- "singleton has no other members" + -- (\e1 e2 -> + -- if (Debug.log "To compare" e1) == e2 then + -- Expect.pass + -- else + -- () + -- |> Debug.log "Not equal" + -- |> always (StateManager.singleton e1) + -- |> StateManager.member e2 + -- |> Expect.equal False + -- ) + , fuzz TestEvent.fuzzerState "singleton has one value" + (\event -> + StateManager.singleton event + |> StateManager.values + |> Expect.equal [ event ] + ) + ] + + -- Write other tests here + ]