Add StateManager type
parent
acfeabb39e
commit
e1a4bcab9b
1
elm.json
1
elm.json
|
|
@ -22,6 +22,7 @@
|
|||
"Internal.Values.Envelope",
|
||||
"Internal.Values.Event",
|
||||
"Internal.Values.Settings",
|
||||
"Internal.Values.StateManager",
|
||||
"Internal.Values.Vault",
|
||||
"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.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 =
|
||||
|
|
|
|||
|
|
@ -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