Add StateManager type
parent
acfeabb39e
commit
e1a4bcab9b
1
elm.json
1
elm.json
|
@ -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"
|
||||||
],
|
],
|
||||||
|
|
|
@ -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
|
|
@ -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 =
|
||||||
|
|
|
@ -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
|
||||||
|
]
|
Loading…
Reference in New Issue