Compare commits
7 Commits
277c15c7e1
...
20b4ea2f5c
Author | SHA1 | Date |
---|---|---|
|
20b4ea2f5c | |
|
5cdb4fad33 | |
|
e1a4bcab9b | |
|
acfeabb39e | |
|
c7a3fe804b | |
|
f465c9cbb1 | |
|
26ca6600d7 |
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"
|
||||
],
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
module Internal.Tools.Hashdict exposing
|
||||
( Hashdict
|
||||
, empty, singleton, insert, remove, removeKey
|
||||
, isEmpty, member, memberKey, get, size
|
||||
, isEmpty, member, memberKey, get, size, isEqual
|
||||
, keys, values, toList, fromList
|
||||
, rehash, union
|
||||
, encode, decoder, softDecoder
|
||||
|
@ -25,7 +25,7 @@ This allows you to store values based on an externally defined identifier.
|
|||
|
||||
## Query
|
||||
|
||||
@docs isEmpty, member, memberKey, get, size
|
||||
@docs isEmpty, member, memberKey, get, size, isEqual
|
||||
|
||||
|
||||
## Lists
|
||||
|
@ -151,6 +151,14 @@ insert v (Hashdict h) =
|
|||
Hashdict { h | values = Dict.insert (h.hash v) v h.values }
|
||||
|
||||
|
||||
{-| Since the Hashdict contains a hash function, the == operator does not work
|
||||
simply. Instead, you should use the isEqual operator.
|
||||
-}
|
||||
isEqual : Hashdict a -> Hashdict a -> Bool
|
||||
isEqual h1 h2 =
|
||||
toList h1 == toList h2
|
||||
|
||||
|
||||
{-| Determine if a hashdict is empty.
|
||||
-}
|
||||
isEmpty : Hashdict a -> Bool
|
||||
|
|
|
@ -0,0 +1,277 @@
|
|||
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
|
|
@ -0,0 +1,174 @@
|
|||
module Test.Tools.Hashdict exposing (..)
|
||||
|
||||
import Expect
|
||||
import Fuzz exposing (Fuzzer)
|
||||
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
||||
import Internal.Values.Event as Event
|
||||
import Json.Decode as D
|
||||
import Json.Encode as E
|
||||
import Test exposing (..)
|
||||
import Test.Values.Event as TestEvent
|
||||
|
||||
|
||||
fuzzer : (a -> String) -> Fuzzer a -> Fuzzer (Hashdict a)
|
||||
fuzzer toHash fuz =
|
||||
Fuzz.map (Hashdict.fromList toHash) (Fuzz.list fuz)
|
||||
|
||||
|
||||
eventFuzzer : Fuzzer (Hashdict Event.Event)
|
||||
eventFuzzer =
|
||||
fuzzer .eventId TestEvent.fuzzer
|
||||
|
||||
|
||||
suite : Test
|
||||
suite =
|
||||
describe "Hashdict"
|
||||
[ describe "empty"
|
||||
[ test "empty isEmpty"
|
||||
(Hashdict.empty identity
|
||||
|> Hashdict.isEmpty
|
||||
|> Expect.equal True
|
||||
|> always
|
||||
)
|
||||
, fuzz TestEvent.fuzzer
|
||||
"Nothing is member"
|
||||
(\event ->
|
||||
Hashdict.empty .eventId
|
||||
|> Hashdict.member event
|
||||
|> Expect.equal False
|
||||
)
|
||||
, fuzz Fuzz.string
|
||||
"No key is member"
|
||||
(\key ->
|
||||
Hashdict.empty identity
|
||||
|> Hashdict.memberKey key
|
||||
|> Expect.equal False
|
||||
)
|
||||
, fuzz Fuzz.string
|
||||
"Get gets Nothing"
|
||||
(\key ->
|
||||
Hashdict.empty identity
|
||||
|> Hashdict.get key
|
||||
|> Expect.equal Nothing
|
||||
)
|
||||
, test "Size is zero"
|
||||
(Hashdict.empty identity
|
||||
|> Hashdict.size
|
||||
|> Expect.equal 0
|
||||
|> always
|
||||
)
|
||||
, test "No keys"
|
||||
(Hashdict.empty identity
|
||||
|> Hashdict.keys
|
||||
|> Expect.equal []
|
||||
|> always
|
||||
)
|
||||
, test "No values"
|
||||
(Hashdict.empty identity
|
||||
|> Hashdict.values
|
||||
|> Expect.equal []
|
||||
|> always
|
||||
)
|
||||
, test "To list is []"
|
||||
(Hashdict.empty identity
|
||||
|> Hashdict.toList
|
||||
|> Expect.equal []
|
||||
|> always
|
||||
)
|
||||
, test "From list is empty"
|
||||
([]
|
||||
|> Hashdict.fromList (\x -> x)
|
||||
|> Hashdict.isEqual (Hashdict.empty identity)
|
||||
|> Expect.equal True
|
||||
|> always
|
||||
)
|
||||
, test "Empty + empty == empty"
|
||||
(Hashdict.empty identity
|
||||
|> Hashdict.union (Hashdict.empty String.toUpper)
|
||||
|> Hashdict.isEqual (Hashdict.empty String.toLower)
|
||||
|> Expect.equal True
|
||||
|> always
|
||||
)
|
||||
, fuzz (Fuzz.intRange 0 10)
|
||||
"JSON encode -> JSON decode"
|
||||
(\indent ->
|
||||
Hashdict.empty identity
|
||||
|> Hashdict.encode E.string
|
||||
|> E.encode indent
|
||||
|> D.decodeString (Hashdict.decoder identity D.string)
|
||||
|> Result.map (Hashdict.isEqual (Hashdict.empty String.toUpper))
|
||||
|> Expect.equal (Ok True)
|
||||
)
|
||||
]
|
||||
, describe "singleton"
|
||||
[ fuzz TestEvent.fuzzer
|
||||
"singletong = empty + insert"
|
||||
(\event ->
|
||||
Hashdict.empty .eventId
|
||||
|> Hashdict.insert event
|
||||
|> Hashdict.isEqual (Hashdict.singleton .eventId event)
|
||||
|> Expect.equal True
|
||||
)
|
||||
, fuzz TestEvent.fuzzer
|
||||
"Singleton - event = empty"
|
||||
(\event ->
|
||||
Hashdict.singleton .eventId event
|
||||
|> Hashdict.remove event
|
||||
|> Hashdict.isEqual (Hashdict.empty .sender)
|
||||
|> Expect.equal True
|
||||
)
|
||||
, fuzz TestEvent.fuzzer
|
||||
"Singletong - event (key) = empty"
|
||||
(\event ->
|
||||
Hashdict.singleton .eventId event
|
||||
|> Hashdict.removeKey event.eventId
|
||||
|> Hashdict.isEqual (Hashdict.empty .sender)
|
||||
|> Expect.equal True
|
||||
)
|
||||
, fuzz TestEvent.fuzzer
|
||||
"not isEmpty"
|
||||
(\event ->
|
||||
Hashdict.singleton .eventId event
|
||||
|> Hashdict.isEmpty
|
||||
|> Expect.equal False
|
||||
)
|
||||
, fuzz TestEvent.fuzzer
|
||||
"member"
|
||||
(\event ->
|
||||
Hashdict.singleton .eventId event
|
||||
|> Hashdict.member event
|
||||
|> Expect.equal True
|
||||
)
|
||||
, fuzz TestEvent.fuzzer
|
||||
"memberKey"
|
||||
(\event ->
|
||||
Hashdict.singleton .eventId event
|
||||
|> Hashdict.memberKey event.eventId
|
||||
|> Expect.equal True
|
||||
)
|
||||
, fuzz TestEvent.fuzzer
|
||||
"False memberKey"
|
||||
(\event ->
|
||||
if event.eventId == event.roomId then
|
||||
Expect.pass
|
||||
|
||||
else
|
||||
Hashdict.singleton .eventId event
|
||||
|> Hashdict.memberKey event.roomId
|
||||
|> Expect.equal False
|
||||
)
|
||||
]
|
||||
, describe "JSON"
|
||||
[ fuzz2 eventFuzzer
|
||||
(Fuzz.intRange 0 10)
|
||||
"JSON encode -> JSON decode"
|
||||
(\hashdict indent ->
|
||||
hashdict
|
||||
|> Hashdict.encode Event.encode
|
||||
|> E.encode indent
|
||||
|> D.decodeString (Hashdict.decoder .eventId Event.decoder)
|
||||
|> Result.map Hashdict.toList
|
||||
|> Expect.equal (Ok <| Hashdict.toList hashdict)
|
||||
)
|
||||
]
|
||||
]
|
|
@ -20,6 +20,23 @@ fuzzer =
|
|||
(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 =
|
||||
Fuzz.map4
|
||||
|
|
|
@ -0,0 +1,138 @@
|
|||
module Test.Values.StateManager exposing (..)
|
||||
|
||||
import Expect
|
||||
import Fuzz exposing (Fuzzer)
|
||||
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