Compare commits

..

7 Commits

Author SHA1 Message Date
Bram 20b4ea2f5c elm-format 2023-12-29 14:58:50 +01:00
Bram 5cdb4fad33 Remove warnings 2023-12-29 14:57:59 +01:00
Bram e1a4bcab9b Add StateManager type 2023-12-29 14:50:43 +01:00
Bram acfeabb39e Merge branch 'elm-test' into 3-state-manager 2023-12-26 17:44:48 +01:00
Bram c7a3fe804b elm-format + add more tests 2023-12-26 16:11:51 +01:00
Bram f465c9cbb1 Add isEqual function for Hashdict + tests 2023-12-26 12:59:50 +01:00
Bram 26ca6600d7 Add Hashdict test 2023-12-24 15:49:55 +01:00
6 changed files with 617 additions and 2 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

@ -1,7 +1,7 @@
module Internal.Tools.Hashdict exposing module Internal.Tools.Hashdict exposing
( Hashdict ( Hashdict
, empty, singleton, insert, remove, removeKey , empty, singleton, insert, remove, removeKey
, isEmpty, member, memberKey, get, size , isEmpty, member, memberKey, get, size, isEqual
, keys, values, toList, fromList , keys, values, toList, fromList
, rehash, union , rehash, union
, encode, decoder, softDecoder , encode, decoder, softDecoder
@ -25,7 +25,7 @@ This allows you to store values based on an externally defined identifier.
## Query ## Query
@docs isEmpty, member, memberKey, get, size @docs isEmpty, member, memberKey, get, size, isEqual
## Lists ## Lists
@ -151,6 +151,14 @@ insert v (Hashdict h) =
Hashdict { h | values = Dict.insert (h.hash v) v h.values } 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. {-| Determine if a hashdict is empty.
-} -}
isEmpty : Hashdict a -> Bool isEmpty : Hashdict a -> Bool

View File

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

View File

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

View File

@ -20,6 +20,23 @@ fuzzer =
(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 =
Fuzz.map4 Fuzz.map4

View File

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