From 26ca6600d735dfe0339ec10b88f6815b934037c2 Mon Sep 17 00:00:00 2001 From: Bram Date: Sun, 24 Dec 2023 15:49:55 +0100 Subject: [PATCH 1/7] Add Hashdict test --- tests/Test/Tools/Hashdict.elm | 38 +++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) create mode 100644 tests/Test/Tools/Hashdict.elm diff --git a/tests/Test/Tools/Hashdict.elm b/tests/Test/Tools/Hashdict.elm new file mode 100644 index 0000000..d389f42 --- /dev/null +++ b/tests/Test/Tools/Hashdict.elm @@ -0,0 +1,38 @@ +module Test.Tools.Hashdict exposing (..) + +import Test exposing (..) +import Fuzz exposing (Fuzzer) +import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) +import Test.Values.Event as TestEvent +import Internal.Values.Event as Event +import Json.Encode as E +import Json.Decode as D +import Expect + +fuzzer : (a -> String) -> Fuzzer a -> Fuzzer (Hashdict a) +fuzzer toHash fuz = + Fuzz.map (Hashdict.fromList toHash) (Fuzz.list fuz) + +suite : Test +suite = + describe "Hashdict" + [ describe "init" + [ test "init isEmpty" + ( Hashdict.empty identity + |> Hashdict.isEmpty + |> Expect.equal True + |> always + ) + ] + , describe "JSON" + [ fuzz2 (fuzzer .eventId TestEvent.fuzzer) (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 ) + ) + ] + ] From f465c9cbb1865d5410389e769e68edeef28ef29f Mon Sep 17 00:00:00 2001 From: Bram Date: Tue, 26 Dec 2023 12:59:50 +0100 Subject: [PATCH 2/7] Add isEqual function for Hashdict + tests --- src/Internal/Tools/Hashdict.elm | 10 ++++- tests/Test/Tools/Hashdict.elm | 75 +++++++++++++++++++++++++++++++-- 2 files changed, 80 insertions(+), 5 deletions(-) diff --git a/src/Internal/Tools/Hashdict.elm b/src/Internal/Tools/Hashdict.elm index b8be6a9..6020381 100644 --- a/src/Internal/Tools/Hashdict.elm +++ b/src/Internal/Tools/Hashdict.elm @@ -4,7 +4,7 @@ module Internal.Tools.Hashdict exposing , isEmpty, member, memberKey, get, size , keys, values, toList, fromList , rehash, union - , encode, decoder, softDecoder + , encode, decoder, softDecoder, isEqual ) {-| This module abstracts the `Dict` type with one function that assigns a @@ -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 @@ -150,6 +150,12 @@ insert : a -> Hashdict a -> Hashdict a 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. -} diff --git a/tests/Test/Tools/Hashdict.elm b/tests/Test/Tools/Hashdict.elm index d389f42..45a21e0 100644 --- a/tests/Test/Tools/Hashdict.elm +++ b/tests/Test/Tools/Hashdict.elm @@ -13,19 +13,88 @@ 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 "init" - [ test "init isEmpty" + [ 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 "JSON" - [ fuzz2 (fuzzer .eventId TestEvent.fuzzer) (Fuzz.intRange 0 10) "JSON encode -> JSON decode" + [ fuzz2 eventFuzzer (Fuzz.intRange 0 10) "JSON encode -> JSON decode" (\hashdict indent -> hashdict |> Hashdict.encode Event.encode From c7a3fe804b7e55e47d23c4814ef72121be0e495e Mon Sep 17 00:00:00 2001 From: Bram Date: Tue, 26 Dec 2023 16:11:51 +0100 Subject: [PATCH 3/7] elm-format + add more tests --- src/Internal/Tools/Hashdict.elm | 6 +- tests/Test/Tools/Hashdict.elm | 101 ++++++++++++++++++++++++++------ 2 files changed, 88 insertions(+), 19 deletions(-) diff --git a/src/Internal/Tools/Hashdict.elm b/src/Internal/Tools/Hashdict.elm index 6020381..f2e4fdb 100644 --- a/src/Internal/Tools/Hashdict.elm +++ b/src/Internal/Tools/Hashdict.elm @@ -1,10 +1,10 @@ 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, isEqual + , encode, decoder, softDecoder ) {-| This module abstracts the `Dict` type with one function that assigns a @@ -150,6 +150,7 @@ insert : a -> Hashdict a -> Hashdict a 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. -} @@ -157,6 +158,7 @@ isEqual : Hashdict a -> Hashdict a -> Bool isEqual h1 h2 = toList h1 == toList h2 + {-| Determine if a hashdict is empty. -} isEmpty : Hashdict a -> Bool diff --git a/tests/Test/Tools/Hashdict.elm b/tests/Test/Tools/Hashdict.elm index 45a21e0..500503c 100644 --- a/tests/Test/Tools/Hashdict.elm +++ b/tests/Test/Tools/Hashdict.elm @@ -1,89 +1,96 @@ module Test.Tools.Hashdict exposing (..) -import Test exposing (..) +import Expect import Fuzz exposing (Fuzzer) import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) -import Test.Values.Event as TestEvent import Internal.Values.Event as Event -import Json.Encode as E import Json.Decode as D -import Expect +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.empty identity |> Hashdict.isEmpty |> Expect.equal True |> always ) - , fuzz TestEvent.fuzzer "Nothing is member" + , fuzz TestEvent.fuzzer + "Nothing is member" (\event -> Hashdict.empty .eventId |> Hashdict.member event |> Expect.equal False ) - , fuzz Fuzz.string "No key is member" + , fuzz Fuzz.string + "No key is member" (\key -> Hashdict.empty identity |> Hashdict.memberKey key |> Expect.equal False ) - , fuzz Fuzz.string "Get gets Nothing" + , fuzz Fuzz.string + "Get gets Nothing" (\key -> Hashdict.empty identity |> Hashdict.get key |> Expect.equal Nothing ) , test "Size is zero" - ( Hashdict.empty identity + (Hashdict.empty identity |> Hashdict.size |> Expect.equal 0 |> always ) , test "No keys" - ( Hashdict.empty identity + (Hashdict.empty identity |> Hashdict.keys |> Expect.equal [] |> always ) , test "No values" - ( Hashdict.empty identity + (Hashdict.empty identity |> Hashdict.values |> Expect.equal [] |> always ) , test "To list is []" - ( Hashdict.empty identity + (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.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" + , fuzz (Fuzz.intRange 0 10) + "JSON encode -> JSON decode" (\indent -> Hashdict.empty identity |> Hashdict.encode E.string @@ -93,15 +100,75 @@ suite = |> 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" + [ 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 ) + |> Expect.equal (Ok <| Hashdict.toList hashdict) ) ] ] From 277c15c7e1cc93d80c6280a742cf81bfb162f2aa Mon Sep 17 00:00:00 2001 From: Bram Date: Tue, 26 Dec 2023 17:43:06 +0100 Subject: [PATCH 4/7] Add Mashdict --- elm.json | 1 + src/Internal/Tools/Mashdict.elm | 300 ++++++++++++++++++++++++++++++++ tests/Test/Tools/Mashdict.elm | 204 ++++++++++++++++++++++ 3 files changed, 505 insertions(+) create mode 100644 src/Internal/Tools/Mashdict.elm create mode 100644 tests/Test/Tools/Mashdict.elm diff --git a/elm.json b/elm.json index d5b89d2..a1c9977 100644 --- a/elm.json +++ b/elm.json @@ -15,6 +15,7 @@ "Internal.Tools.Encode", "Internal.Tools.Hashdict", "Internal.Tools.Iddict", + "Internal.Tools.Mashdict", "Internal.Tools.Timestamp", "Internal.Tools.VersionControl", "Internal.Values.Context", diff --git a/src/Internal/Tools/Mashdict.elm b/src/Internal/Tools/Mashdict.elm new file mode 100644 index 0000000..22c27a8 --- /dev/null +++ b/src/Internal/Tools/Mashdict.elm @@ -0,0 +1,300 @@ +module Internal.Tools.Mashdict exposing + ( Mashdict + , empty, singleton, insert, remove, removeKey + , isEmpty, member, memberKey, get, size, isEqual + , keys, values, toList, fromList + , rehash, union + , encode, decoder, softDecoder + ) + +{-| + + +# Mashdict + +A **mashdict**, (short for "maybe mashdict") is a hashdict that uses a hash +function that _maybe_ returns a value. In this case, the mashdict exclusively +stores values for which the hashing algorithm returns a value, and it ignores +the outcome for all other scenarios. + +In general, you are advised to learn more about the +[Hashdict](Internal-Tools-Hashdict) before delving into the Mashdict. + + +## Dictionaries + +@docs Mashdict + + +## Build + +@docs empty, singleton, insert, remove, removeKey + + +## Query + +@docs isEmpty, member, memberKey, get, size, isEqual + + +## Lists + +@docs keys, values, toList, fromList + + +## Transform + +@docs rehash, union + + +## JSON coders + +@docs encode, decoder, softDecoder + +-} + +import FastDict as Dict exposing (Dict) +import Json.Decode as D +import Json.Encode as E + + +{-| A dictionary of keys and values where each key is defined by its value, but +a value is not always given. For example, this can be relevant when not all +inserted values are relevant: + + import Mashdict exposing (Mashdict) + + users : Mashdict Event + users = + Mashdict.fromList .location + [ Event "Graduation party" 8 (Just "park") + , Event "National holiday" 17 Nothing + , Event "Local fair" 11 (Just "town square") + ] + + -- National holiday will be ignored + -- because it does not hash + type alias Event = + { name : String + , participants : Int + , location : Maybe String + } + +In the example listed above, all events are stored by their specified location, +which means that all you need to know is the value "park" to retrieve all the +information about the event at the park. As a result of optimization, this means +all values without a hash, are filtered out, as we can never query them. + +-} +type Mashdict a + = Mashdict + { hash : a -> Maybe String + , values : Dict String a + } + + +{-| Decode a mashdict from a JSON value. To create a mashdict, you are expected +to insert a hash function. If the hash function doesn't properly hash the values +as expected, the decoder will fail to decode the mashdict. +-} +decoder : (a -> Maybe String) -> D.Decoder a -> D.Decoder (Mashdict a) +decoder f xDecoder = + D.keyValuePairs xDecoder + |> D.andThen + (\items -> + if List.all (\( hash, value ) -> f value == Just hash) items then + items + |> Dict.fromList + |> (\d -> { hash = f, values = d }) + |> Mashdict + |> D.succeed + + else + D.fail "Hash function fails to properly hash all values" + ) + + +{-| Create an empty mashdict. +-} +empty : (a -> Maybe String) -> Mashdict a +empty hash = + Mashdict { hash = hash, values = Dict.empty } + + +{-| Encode a Mashdict into a JSON value. Keep in mind that an Elm function +cannot be universally converted to JSON, so it is up to you to preserve that +hash function! +-} +encode : (a -> E.Value) -> Mashdict a -> E.Value +encode encodeX (Mashdict h) = + h.values + |> Dict.toList + |> List.map (Tuple.mapSecond encodeX) + |> E.object + + +{-| Convert an association list into a mashdict. +-} +fromList : (a -> Maybe String) -> List a -> Mashdict a +fromList hash xs = + Mashdict + { hash = hash + , values = + xs + |> List.filterMap (\x -> hash x |> Maybe.map (\hx -> ( hx, x ))) + |> Dict.fromList + } + + +{-| Get the value associated with a hash. If the hash is not found, return +`Nothing`. This is useful when you are not sure if a hash will be in the +mashdict. +-} +get : String -> Mashdict a -> Maybe a +get k (Mashdict h) = + Dict.get k h.values + + +{-| Insert a value into a mashdict. The key is automatically generated by the +hash function. If the function generates a collision, it replaces the existing +value in the mashdict. If the function returns `Nothing`, the value isn't +inserted and the original Mashdict is returned. +-} +insert : a -> Mashdict a -> Mashdict a +insert v (Mashdict h) = + case h.hash v of + Just hash -> + Mashdict { h | values = Dict.insert hash v h.values } + + Nothing -> + Mashdict h + + +{-| Determine if a mashdict is empty. +-} +isEmpty : Mashdict a -> Bool +isEmpty (Mashdict h) = + Dict.isEmpty h.values + + +{-| Since the Hashdict contains a hash function, the == operator does not work +simply. Instead, you should use the isEqual operator. +-} +isEqual : Mashdict a -> Mashdict a -> Bool +isEqual h1 h2 = + toList h1 == toList h2 + + +{-| Get all of the hashes in a mashdict, sorted from lowest to highest. +-} +keys : Mashdict a -> List String +keys (Mashdict h) = + Dict.keys h.values + + +{-| Determine if a value's hash is in a mashdict. +-} +member : a -> Mashdict a -> Bool +member value (Mashdict h) = + h.hash value + |> Maybe.map (\key -> Dict.member key h.values) + |> Maybe.withDefault False + + +{-| Determine if a hash is in a mashdict. +-} +memberKey : String -> Mashdict a -> Bool +memberKey key (Mashdict h) = + Dict.member key h.values + + +{-| Remap a mashdict using a new hashing algorithm. +-} +rehash : (a -> Maybe String) -> Mashdict a -> Mashdict a +rehash f (Mashdict h) = + Mashdict + { hash = f + , values = + h.values + |> Dict.values + |> List.filterMap + (\v -> Maybe.map (\hash -> ( hash, v )) (f v)) + |> Dict.fromList + } + + +{-| Remove a value from a mashdict. If the value's hash is found, the key-value +pair is removed. If the value's hash is not found, no changes are made. + + hdict |> Mashdict.remove (Event "Graduation party" 8 (Just "park")) + +-} +remove : a -> Mashdict a -> Mashdict a +remove v (Mashdict h) = + case h.hash v of + Just hash -> + Mashdict { h | values = Dict.remove hash h.values } + + Nothing -> + Mashdict h + + +{-| Remove a key from a mashdict. If the key is not found, no changes are made. + + hdict |> Mashdict.removeKey "park" + +-} +removeKey : String -> Mashdict a -> Mashdict a +removeKey k (Mashdict h) = + Mashdict { h | values = Dict.remove k h.values } + + +{-| Create a mashdict with a single key-value pair. +-} +singleton : (a -> Maybe String) -> a -> Mashdict a +singleton f v = + empty f |> insert v + + +{-| Determine the number of values in a mashdict. +-} +size : Mashdict a -> Int +size (Mashdict h) = + Dict.size h.values + + +{-| Decode a mashdict from a JSON value. If you cannot deduce the originally +used hash function, (or if you simply do not care) you can use this function to +decode and rehash the Mashdict using your new hash function. +-} +softDecoder : (a -> Maybe String) -> D.Decoder a -> D.Decoder (Mashdict a) +softDecoder f xDecoder = + D.keyValuePairs xDecoder + |> D.map (List.map Tuple.second >> fromList f) + + +{-| Convert a mashdict into an association list of key-value pairs, sorted by +keys. +-} +toList : Mashdict a -> List ( String, a ) +toList (Mashdict h) = + Dict.toList h.values + + +{-| Combine two mashdicts under the hash function of the first. If there is a +collision, preference is given to the first mashdict. +-} +union : Mashdict a -> Mashdict a -> Mashdict a +union (Mashdict h1) hd2 = + case rehash h1.hash hd2 of + Mashdict h2 -> + Mashdict + { hash = h1.hash + , values = Dict.union h1.values h2.values + } + + +{-| Get all values stored in the mashdict, in the order of their keys. +-} +values : Mashdict a -> List a +values (Mashdict h) = + Dict.values h.values diff --git a/tests/Test/Tools/Mashdict.elm b/tests/Test/Tools/Mashdict.elm new file mode 100644 index 0000000..dfddc6c --- /dev/null +++ b/tests/Test/Tools/Mashdict.elm @@ -0,0 +1,204 @@ +module Test.Tools.Mashdict exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Internal.Tools.Mashdict as Mashdict exposing (Mashdict) +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 -> Maybe String) -> Fuzzer a -> Fuzzer (Mashdict a) +fuzzer toHash fuz = + Fuzz.map (Mashdict.fromList toHash) (Fuzz.list fuz) + + +eventFuzzer : Fuzzer (Mashdict Event.Event) +eventFuzzer = + fuzzer .stateKey TestEvent.fuzzer + + +suite : Test +suite = + describe "Mashdict" + [ describe "empty" + [ test "empty isEmpty" + (Mashdict.empty identity + |> Mashdict.isEmpty + |> Expect.equal True + |> always + ) + , fuzz TestEvent.fuzzer + "Nothing is member" + (\event -> + Mashdict.empty .stateKey + |> Mashdict.member event + |> Expect.equal False + ) + , fuzz Fuzz.string + "No key is member" + (\key -> + Mashdict.empty identity + |> Mashdict.memberKey key + |> Expect.equal False + ) + , fuzz Fuzz.string + "Get gets Nothing" + (\key -> + Mashdict.empty identity + |> Mashdict.get key + |> Expect.equal Nothing + ) + , test "Size is zero" + (Mashdict.empty identity + |> Mashdict.size + |> Expect.equal 0 + |> always + ) + , test "No keys" + (Mashdict.empty identity + |> Mashdict.keys + |> Expect.equal [] + |> always + ) + , test "No values" + (Mashdict.empty identity + |> Mashdict.values + |> Expect.equal [] + |> always + ) + , test "To list is []" + (Mashdict.empty identity + |> Mashdict.toList + |> Expect.equal [] + |> always + ) + , test "From list is empty" + ([] + |> Mashdict.fromList (\x -> x) + |> Mashdict.isEqual (Mashdict.empty identity) + |> Expect.equal True + |> always + ) + , test "Empty + empty == empty" + (Mashdict.empty Maybe.Just + |> Mashdict.union (Mashdict.empty Maybe.Just) + |> Mashdict.isEqual (Mashdict.empty Maybe.Just) + |> Expect.equal True + |> always + ) + , fuzz (Fuzz.intRange 0 10) + "JSON encode -> JSON decode" + (\indent -> + Mashdict.empty Just + |> Mashdict.encode E.string + |> E.encode indent + |> D.decodeString (Mashdict.decoder Just D.string) + |> Result.map (Mashdict.isEqual (Mashdict.empty Just)) + |> Expect.equal (Ok True) + ) + ] + , describe "singleton" + [ fuzz TestEvent.fuzzer + "singleton = empty + insert" + (\event -> + Mashdict.empty .stateKey + |> Mashdict.insert event + |> Mashdict.isEqual (Mashdict.singleton .stateKey event) + |> Expect.equal True + ) + , fuzz TestEvent.fuzzer + "singleton - event = empty" + (\event -> + Mashdict.singleton .stateKey event + |> Mashdict.remove event + |> Mashdict.isEqual (Mashdict.empty (always Nothing)) + |> Expect.equal True + ) + , fuzz TestEvent.fuzzer + "singleton - event (key) = empty" + (\event -> + case event.stateKey of + Just key -> + Mashdict.singleton .stateKey event + |> Mashdict.removeKey key + |> Mashdict.isEqual (Mashdict.empty .stateKey) + |> Expect.equal True + + Nothing -> + Expect.pass + ) + , fuzz TestEvent.fuzzer + "Only isEmpty when not Nothing" + (\event -> + Expect.equal + (case event.stateKey of + Just _ -> + False + + Nothing -> + True + ) + (event + |> Mashdict.singleton .stateKey + |> Mashdict.isEmpty + ) + ) + , fuzz TestEvent.fuzzer + "member" + (\event -> + Expect.equal + (case event.stateKey of + Just _ -> + True + + Nothing -> + False + ) + (Mashdict.singleton .stateKey event + |> Mashdict.member event + ) + ) + , fuzz2 TestEvent.fuzzer + Fuzz.string + "memberKey" + (\event rkey -> + case event.stateKey of + Just key -> + Mashdict.singleton .stateKey event + |> Mashdict.memberKey key + |> Expect.equal True + + Nothing -> + Mashdict.singleton .stateKey event + |> Mashdict.memberKey rkey + |> Expect.equal False + ) + , fuzz TestEvent.fuzzer + "False memberKey" + (\event -> + if event.stateKey == Just event.roomId then + Expect.pass + + else + Mashdict.singleton .stateKey event + |> Mashdict.memberKey event.roomId + |> Expect.equal False + ) + ] + , describe "JSON" + [ fuzz2 eventFuzzer + (Fuzz.intRange 0 10) + "JSON encode -> JSON decode" + (\hashdict indent -> + hashdict + |> Mashdict.encode Event.encode + |> E.encode indent + |> D.decodeString (Mashdict.decoder .stateKey Event.decoder) + |> Result.map Mashdict.toList + |> Expect.equal (Ok <| Mashdict.toList hashdict) + ) + ] + ] From e1a4bcab9b2b75b674101aa3e605d497e8b2c63b Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Dec 2023 14:50:43 +0100 Subject: [PATCH 5/7] Add StateManager type --- elm.json | 1 + src/Internal/Values/StateManager.elm | 276 +++++++++++++++++++++++++++ tests/Test/Values/Event.elm | 16 ++ tests/Test/Values/StateManager.elm | 137 +++++++++++++ 4 files changed, 430 insertions(+) create mode 100644 src/Internal/Values/StateManager.elm create mode 100644 tests/Test/Values/StateManager.elm diff --git a/elm.json b/elm.json index a1c9977..405b455 100644 --- a/elm.json +++ b/elm.json @@ -22,6 +22,7 @@ "Internal.Values.Envelope", "Internal.Values.Event", "Internal.Values.Settings", + "Internal.Values.StateManager", "Internal.Values.Vault", "Types" ], diff --git a/src/Internal/Values/StateManager.elm b/src/Internal/Values/StateManager.elm new file mode 100644 index 0000000..976415f --- /dev/null +++ b/src/Internal/Values/StateManager.elm @@ -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 diff --git a/tests/Test/Values/Event.elm b/tests/Test/Values/Event.elm index 89c80a5..68dbd8a 100644 --- a/tests/Test/Values/Event.elm +++ b/tests/Test/Values/Event.elm @@ -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 = diff --git a/tests/Test/Values/StateManager.elm b/tests/Test/Values/StateManager.elm new file mode 100644 index 0000000..43580c7 --- /dev/null +++ b/tests/Test/Values/StateManager.elm @@ -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 + ] From 5cdb4fad33b871dbf63f6cb5b9829a0c92932be9 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Dec 2023 14:57:59 +0100 Subject: [PATCH 6/7] Remove warnings --- src/Internal/Values/StateManager.elm | 10 +++++----- tests/Test/Values/StateManager.elm | 1 - 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/Internal/Values/StateManager.elm b/src/Internal/Values/StateManager.elm index 976415f..19464a2 100644 --- a/src/Internal/Values/StateManager.elm +++ b/src/Internal/Values/StateManager.elm @@ -61,11 +61,11 @@ 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) +-- {-| 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 diff --git a/tests/Test/Values/StateManager.elm b/tests/Test/Values/StateManager.elm index 43580c7..f96a0a3 100644 --- a/tests/Test/Values/StateManager.elm +++ b/tests/Test/Values/StateManager.elm @@ -2,7 +2,6 @@ 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 From 20b4ea2f5cc90af3fd92027538818cd2a0515a04 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Dec 2023 14:58:50 +0100 Subject: [PATCH 7/7] elm-format --- src/Internal/Values/StateManager.elm | 1 + tests/Test/Values/Event.elm | 9 +++++---- tests/Test/Values/StateManager.elm | 4 +++- 3 files changed, 9 insertions(+), 5 deletions(-) diff --git a/src/Internal/Values/StateManager.elm b/src/Internal/Values/StateManager.elm index 19464a2..46282aa 100644 --- a/src/Internal/Values/StateManager.elm +++ b/src/Internal/Values/StateManager.elm @@ -61,6 +61,7 @@ append sm2 sm1 = List.foldl insert sm1 (values sm2) + -- {-| Remove any floating empty Mashdicts from ALL keys in the dictionary. -- -} -- cleanAll : StateManager -> StateManager diff --git a/tests/Test/Values/Event.elm b/tests/Test/Values/Event.elm index 68dbd8a..d41abaa 100644 --- a/tests/Test/Values/Event.elm +++ b/tests/Test/Values/Event.elm @@ -19,6 +19,7 @@ fuzzer = Fuzz.string (Fuzz.maybe unsignedDataFuzzer) + {-| Fuzzer for an event with a set state key -} fuzzerState : Fuzzer Event @@ -26,10 +27,10 @@ fuzzerState = Fuzz.map2 (\event default -> { event - | stateKey = - event.stateKey - |> Maybe.withDefault default - |> Maybe.Just + | stateKey = + event.stateKey + |> Maybe.withDefault default + |> Maybe.Just } ) fuzzer diff --git a/tests/Test/Values/StateManager.elm b/tests/Test/Values/StateManager.elm index f96a0a3..ec15032 100644 --- a/tests/Test/Values/StateManager.elm +++ b/tests/Test/Values/StateManager.elm @@ -112,6 +112,7 @@ suite = |> StateManager.member event |> Expect.equal True ) + -- , fuzz2 TestEvent.fuzzerState TestEvent.fuzzerState -- "singleton has no other members" -- (\e1 e2 -> @@ -124,7 +125,8 @@ suite = -- |> StateManager.member e2 -- |> Expect.equal False -- ) - , fuzz TestEvent.fuzzerState "singleton has one value" + , fuzz TestEvent.fuzzerState + "singleton has one value" (\event -> StateManager.singleton event |> StateManager.values