Add StateManager type

pull/7/head
Bram 2023-12-29 14:50:43 +01:00
parent acfeabb39e
commit e1a4bcab9b
4 changed files with 430 additions and 0 deletions

View File

@ -22,6 +22,7 @@
"Internal.Values.Envelope", "Internal.Values.Envelope",
"Internal.Values.Event", "Internal.Values.Event",
"Internal.Values.Settings", "Internal.Values.Settings",
"Internal.Values.StateManager",
"Internal.Values.Vault", "Internal.Values.Vault",
"Types" "Types"
], ],

View File

@ -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

View File

@ -19,6 +19,22 @@ fuzzer =
Fuzz.string Fuzz.string
(Fuzz.maybe unsignedDataFuzzer) (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 : Fuzzer Event.UnsignedData
unsignedDataFuzzer = unsignedDataFuzzer =

View File

@ -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
]