From 3739043f87aa9a72d29d6b168f471a694b0da3e2 Mon Sep 17 00:00:00 2001 From: Bram Date: Thu, 4 Jan 2024 02:00:31 +0100 Subject: [PATCH 01/24] Create Timeline filter --- src/Internal/Filter/Timeline.elm | 237 ++++++++++++++++++++++++++ src/Internal/Values/Event.elm | 55 +++++- tests/Test/Filter/Timeline.elm | 284 +++++++++++++++++++++++++++++++ tests/Test/Values/Event.elm | 11 ++ 4 files changed, 586 insertions(+), 1 deletion(-) create mode 100644 src/Internal/Filter/Timeline.elm create mode 100644 tests/Test/Filter/Timeline.elm diff --git a/src/Internal/Filter/Timeline.elm b/src/Internal/Filter/Timeline.elm new file mode 100644 index 0000000..735f097 --- /dev/null +++ b/src/Internal/Filter/Timeline.elm @@ -0,0 +1,237 @@ +module Internal.Filter.Timeline exposing + ( Filter + , pass, onlySenders, allSendersExcept, onlyTypes, allTypesExcept, fail + , match, run + , and + ) + +{-| + + +# Timeline filter + +The timeline filter creates filters for looking through a timeline, as well as +for interacting with the Matrix API. + + +## Timeline + +@docs Filter + + +## Create + +@docs pass, onlySenders, allSendersExcept, onlyTypes, allTypesExcept, fail + + +## Filter + +@docs match, run + + +## Combine + +@docs and + +-} + +import Set exposing (Set) +import Task exposing (fail) + + +{-| Placeholder Event type so the real Event doesn't need to be imported. +-} +type alias Event a = + { a | eventType : String, sender : String } + + +{-| The Timeline Filter filters events out of a timeline, guaranteeing that only +the events that meet the given criteria, meet the requirements. +-} +type Filter + = Filter + { senders : Set String + , sendersAllowOthers : Bool + , types : Set String + , typesAllowOthers : Bool + } + + +{-| Allow events from all senders, except if they are on the provided list. + +If the list is empty, all events are allowed. + +-} +allSendersExcept : List String -> Filter +allSendersExcept senders = + case senders of + [] -> + pass + + _ :: _ -> + Filter + { senders = Set.fromList senders + , sendersAllowOthers = True + , types = Set.empty + , typesAllowOthers = True + } + + +{-| Allow events of every event type, except if they are on the provided list. + +If the list is empty, all events are allowed. + +-} +allTypesExcept : List String -> Filter +allTypesExcept types = + case types of + [] -> + pass + + _ :: _ -> + Filter + { senders = Set.empty + , sendersAllowOthers = True + , types = Set.fromList types + , typesAllowOthers = True + } + + +{-| Only allow an event if it meets the criteria of two Filters. +-} +and : Filter -> Filter -> Filter +and (Filter f1) (Filter f2) = + let + stdAnd : Filter + stdAnd = + Filter + { senders = + case ( f1.sendersAllowOthers, f2.sendersAllowOthers ) of + ( True, True ) -> + Set.union f1.senders f2.senders + + ( True, False ) -> + Set.diff f2.senders f1.senders + + ( False, True ) -> + Set.diff f1.senders f2.senders + + ( False, False ) -> + Set.intersect f1.senders f2.senders + , sendersAllowOthers = f1.sendersAllowOthers && f2.sendersAllowOthers + , types = + case ( f1.typesAllowOthers, f2.typesAllowOthers ) of + ( True, True ) -> + Set.union f1.types f2.types + + ( True, False ) -> + Set.diff f2.types f1.types + + ( False, True ) -> + Set.diff f1.types f2.types + + ( False, False ) -> + Set.intersect f1.types f2.types + , typesAllowOthers = f2.typesAllowOthers && f2.typesAllowOthers + } + in + case stdAnd of + Filter f -> + if Set.isEmpty f.senders && (not f.sendersAllowOthers) then + fail + + else if Set.isEmpty f.types && (not f.typesAllowOthers) then + fail + + else + stdAnd + + +{-| Allow no events. This filter is likely quite useless in practice, but it is +used in the test environment for sanity checks and comparisons. +-} +fail : Filter +fail = + Filter + { senders = Set.empty + , sendersAllowOthers = False + , types = Set.empty + , typesAllowOthers = False + } + + +{-| Determine whether an event passes a filter. +-} +match : Filter -> Event a -> Bool +match (Filter f) { eventType, sender } = + let + mentionedSender : Bool + mentionedSender = + Set.member sender f.senders + + mentionedType : Bool + mentionedType = + Set.member eventType f.types + in + xor mentionedSender f.sendersAllowOthers + && xor mentionedType f.typesAllowOthers + + +{-| Only allow event sent by given senders. + +If an empty list is given, no events are allowed. + +-} +onlySenders : List String -> Filter +onlySenders senders = + case senders of + [] -> + fail + + _ :: _ -> + Filter + { senders = Set.fromList senders + , sendersAllowOthers = False + , types = Set.empty + , typesAllowOthers = True + } + + +{-| Only allow events of a given event type. + +If an empty list is given, no events are allowed. + +-} +onlyTypes : List String -> Filter +onlyTypes types = + case types of + [] -> + fail + + _ :: _ -> + Filter + { senders = Set.empty + , sendersAllowOthers = True + , types = Set.fromList types + , typesAllowOthers = False + } + + +{-| Create a filter that allows all events. This can be useful when trying to +combine multiple filters, or when simply all events are allowed. +-} +pass : Filter +pass = + Filter + { senders = Set.empty + , sendersAllowOthers = True + , types = Set.empty + , typesAllowOthers = True + } + + +{-| Use a filter on a list of events. +-} +run : Filter -> List (Event a) -> List (Event a) +run f events = + List.filter (match f) events diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index a3a37bb..9bc20ab 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -1,7 +1,7 @@ module Internal.Values.Event exposing ( Event , UnsignedData(..), age, prevContent, redactedBecause, transactionId - , encode, decoder + , encode, decoder, isEqual ) {-| @@ -24,6 +24,10 @@ of a room. @docs encode, decoder +## Test functions + +@docs isEqual + -} import Internal.Config.Default as Default @@ -122,6 +126,55 @@ encodeUnsignedData (UnsignedData data) = ] +{-| Compare two events and determine whether they're identical. Used mostly for +testing purposes. +-} +isEqual : Event -> Event -> Bool +isEqual e1 e2 = + if e1.eventId /= e2.eventId then + False + else if e1.originServerTs /= e2.originServerTs then + False + else if e1.roomId /= e2.roomId then + False + else if e1.sender /= e2.sender then + False + else if e1.stateKey /= e2.stateKey then + False + else if e1.eventType /= e2.eventType then + False + else + case (e1.unsigned, e2.unsigned) of + ( Nothing, Nothing ) -> + True + + ( Just _, Nothing ) -> + False + + ( Nothing, Just _ ) -> + False + + ( Just ( UnsignedData d1), Just ( UnsignedData d2 )) -> + if d1.age /= d2.age then + False + else if d1.transactionId /= d2.transactionId then + False + else if Maybe.map (E.encode 0) d1.prevContent /= Maybe.map (E.encode 0) d2.prevContent then + False + else + case (d1.redactedBecause, d2.redactedBecause) of + ( Nothing, Nothing) -> + True + + ( Nothing, Just _ ) -> + False + + ( Just _, Nothing ) -> + False + + ( Just se1, Just se2 ) -> + isEqual se1 se2 + {-| Determine the previous `content` value for this event. This field is only a `Just value` if the event is a state event, and the Matrix Vault has permission to see the previous content. diff --git a/tests/Test/Filter/Timeline.elm b/tests/Test/Filter/Timeline.elm new file mode 100644 index 0000000..a1e9b99 --- /dev/null +++ b/tests/Test/Filter/Timeline.elm @@ -0,0 +1,284 @@ +module Test.Filter.Timeline exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Internal.Filter.Timeline as Filter exposing (Filter) +import Internal.Values.Event as Event +import Test exposing (..) +import Test.Values.Event as TestEvent + + +fuzzer : Fuzzer Filter +fuzzer = + Fuzz.map2 Filter.and + (Fuzz.oneOf + [ Fuzz.map Filter.allSendersExcept (Fuzz.list Fuzz.string) + , Fuzz.map Filter.onlySenders (Fuzz.list Fuzz.string) + , Fuzz.constant Filter.pass + ] + ) + (Fuzz.oneOf + [ Fuzz.map Filter.allTypesExcept (Fuzz.list Fuzz.string) + , Fuzz.map Filter.onlyTypes (Fuzz.list Fuzz.string) + , Fuzz.constant Filter.pass + ] + ) + + +suite : Test +suite = + describe "Timeline filter" + [ describe "Tautological equivalences" + [ test "Pass /= fail" + (Filter.pass + |> Expect.notEqual Filter.fail + |> always + ) + , test "All senders == pass" + (Filter.allSendersExcept [] + |> Expect.equal Filter.pass + |> always + ) + , test "All types == pass" + (Filter.allTypesExcept [] + |> Expect.equal Filter.pass + |> always + ) + , test "No senders == fail" + (Filter.onlySenders [] + |> Expect.equal Filter.fail + |> always + ) + , test "No types == fail" + (Filter.onlyTypes [] + |> Expect.equal Filter.fail + |> always + ) + , fuzz2 Fuzz.string + (Fuzz.list Fuzz.string) + "Some types /= some senders" + (\head tail -> + Expect.notEqual + (Filter.onlyTypes (head :: tail)) + (Filter.onlySenders (head :: tail)) + ) + ] + , describe "Event filters" + [ fuzz TestEvent.fuzzer + "Only event type filter matches" + (\event -> + event + |> Filter.match (Filter.onlyTypes [ event.eventType ]) + |> Expect.equal True + ) + , fuzz TestEvent.fuzzer + "Only event sender filter matches" + (\event -> + event + |> Filter.match (Filter.onlySenders [ event.sender ]) + |> Expect.equal True + ) + , fuzz TestEvent.fuzzer + "Not event type filter doesn't match" + (\event -> + event + |> Filter.match (Filter.allTypesExcept [ event.eventType ]) + |> Expect.equal False + ) + , fuzz TestEvent.fuzzer + "Not event sender filter doesn't match" + (\event -> + event + |> Filter.match (Filter.allSendersExcept [ event.sender ]) + |> Expect.equal False + ) + , fuzz2 TestEvent.fuzzer + (Fuzz.list Fuzz.string) + "Only matches when in sender list" + (\event senders -> + event + |> Filter.match (Filter.onlySenders senders) + |> Expect.equal (List.member event.sender senders) + ) + , fuzz2 TestEvent.fuzzer + (Fuzz.list Fuzz.string) + "Only matches when in type list" + (\event types -> + event + |> Filter.match (Filter.onlyTypes types) + |> Expect.equal (List.member event.eventType types) + ) + , fuzz2 TestEvent.fuzzer + (Fuzz.list Fuzz.string) + "All except doesn't match when in sender list" + (\event senders -> + event + |> Filter.match (Filter.allSendersExcept senders) + |> Expect.notEqual (List.member event.sender senders) + ) + , fuzz2 TestEvent.fuzzer + (Fuzz.list Fuzz.string) + "All except doesn't match when in type list" + (\event types -> + event + |> Filter.match (Filter.allTypesExcept types) + |> Expect.notEqual (List.member event.eventType types) + ) + , fuzz (Fuzz.list Fuzz.string) + "Only list AND all except list = fail senders" + (\senders -> + Filter.onlySenders senders + |> Filter.and (Filter.allSendersExcept senders) + |> Expect.equal Filter.fail + ) + , fuzz (Fuzz.list Fuzz.string) + "Only list AND all except list = fail types" + (\types -> + Filter.onlyTypes types + |> Filter.and (Filter.allTypesExcept types) + |> Expect.equal Filter.fail + ) + ] + , describe "Use case testing" + [ fuzz3 (Fuzz.list TestEvent.fuzzer) + (Fuzz.list Fuzz.string) + (Fuzz.list Fuzz.string) + "Only senders + only type" + (\events senders types -> + let + l1 : List Event.Event + l1 = + events + |> Filter.run + ( Filter.and + ( Filter.onlySenders senders ) + ( Filter.onlyTypes types ) + ) + + l2 : List Event.Event + l2 = + ( List.filter + (\e -> + (List.member e.sender senders) && + (List.member e.eventType types) + ) + events + ) + in + Expect.all + [ Expect.equal (List.length l1) (List.length l2) + |> always + , List.map2 Event.isEqual l1 l2 + |> List.all identity + |> Expect.equal True + |> always + ] + () + ) + , fuzz3 (Fuzz.list TestEvent.fuzzer) + (Fuzz.list Fuzz.string) + (Fuzz.list Fuzz.string) + "Only senders + all except type" + (\events senders types -> + let + l1 : List Event.Event + l1 = + events + |> Filter.run + ( Filter.and + ( Filter.onlySenders senders ) + ( Filter.allTypesExcept types ) + ) + + l2 : List Event.Event + l2 = + ( List.filter + (\e -> + (List.member e.sender senders) && + (not <| List.member e.eventType types) + ) + events + ) + in + Expect.all + [ Expect.equal (List.length l1) (List.length l2) + |> always + , List.map2 Event.isEqual l1 l2 + |> List.all identity + |> Expect.equal True + |> always + ] + () + ) + , fuzz3 (Fuzz.list TestEvent.fuzzer) + (Fuzz.list Fuzz.string) + (Fuzz.list Fuzz.string) + "All except senders + only type" + (\events senders types -> + let + l1 : List Event.Event + l1 = + events + |> Filter.run + ( Filter.and + ( Filter.allSendersExcept senders ) + ( Filter.onlyTypes types ) + ) + + l2 : List Event.Event + l2 = + ( List.filter + (\e -> + (not <| List.member e.sender senders) && + (List.member e.eventType types) + ) + events + ) + in + Expect.all + [ Expect.equal (List.length l1) (List.length l2) + |> always + , List.map2 Event.isEqual l1 l2 + |> List.all identity + |> Expect.equal True + |> always + ] + () + ) + , fuzz3 (Fuzz.list TestEvent.fuzzer) + (Fuzz.list Fuzz.string) + (Fuzz.list Fuzz.string) + "All except senders + all except type" + (\events senders types -> + let + l1 : List Event.Event + l1 = + events + |> Filter.run + ( Filter.and + ( Filter.allSendersExcept senders ) + ( Filter.allTypesExcept types ) + ) + + l2 : List Event.Event + l2 = + ( List.filter + (\e -> + (not <| List.member e.sender senders) && + (not <| List.member e.eventType types) + ) + events + ) + in + Expect.all + [ Expect.equal (List.length l1) (List.length l2) + |> always + , List.map2 Event.isEqual l1 l2 + |> List.all identity + |> Expect.equal True + |> always + ] + () + ) + ] + ] diff --git a/tests/Test/Values/Event.elm b/tests/Test/Values/Event.elm index d41abaa..068fb30 100644 --- a/tests/Test/Values/Event.elm +++ b/tests/Test/Values/Event.elm @@ -5,6 +5,7 @@ import Internal.Values.Event as Event exposing (Event) import Json.Encode as E import Test exposing (..) import Test.Tools.Timestamp as TestTimestamp +import Expect fuzzer : Fuzzer Event @@ -65,3 +66,13 @@ valueFuzzer = , Fuzz.map (E.list E.string) (Fuzz.list Fuzz.string) , Fuzz.map Event.encode (Fuzz.lazy (\_ -> fuzzer)) ] + +suite : Test +suite = + describe "Sanity check" + [ fuzz fuzzer "event = event" + (\event -> + Event.isEqual event event + |> Expect.equal True + ) + ] From e8ee125def0495ce139181c0efbc7e7af26c0c12 Mon Sep 17 00:00:00 2001 From: Bram Date: Thu, 4 Jan 2024 03:13:17 +0100 Subject: [PATCH 02/24] Add subsetOf Filter function --- src/Internal/Filter/Timeline.elm | 45 +++++- src/Internal/Values/Event.elm | 34 ++-- tests/Test/Filter/Timeline.elm | 265 +++++++++++++++++++++++-------- tests/Test/Values/Event.elm | 6 +- 4 files changed, 266 insertions(+), 84 deletions(-) diff --git a/src/Internal/Filter/Timeline.elm b/src/Internal/Filter/Timeline.elm index 735f097..b837df4 100644 --- a/src/Internal/Filter/Timeline.elm +++ b/src/Internal/Filter/Timeline.elm @@ -3,6 +3,7 @@ module Internal.Filter.Timeline exposing , pass, onlySenders, allSendersExcept, onlyTypes, allTypesExcept, fail , match, run , and + , subsetOf ) {-| @@ -33,6 +34,11 @@ for interacting with the Matrix API. @docs and + +## Compare + +@docs subsetOf + -} import Set exposing (Set) @@ -132,15 +138,15 @@ and (Filter f1) (Filter f2) = ( False, False ) -> Set.intersect f1.types f2.types - , typesAllowOthers = f2.typesAllowOthers && f2.typesAllowOthers + , typesAllowOthers = f1.typesAllowOthers && f2.typesAllowOthers } in case stdAnd of Filter f -> - if Set.isEmpty f.senders && (not f.sendersAllowOthers) then + if Set.isEmpty f.senders && not f.sendersAllowOthers then fail - else if Set.isEmpty f.types && (not f.typesAllowOthers) then + else if Set.isEmpty f.types && not f.typesAllowOthers then fail else @@ -235,3 +241,36 @@ pass = run : Filter -> List (Event a) -> List (Event a) run f events = List.filter (match f) events + + +{-| Determine whether the second argument is a subset filter of the first +argument. +-} +subsetOf : Filter -> Filter -> Bool +subsetOf (Filter big) (Filter small) = + let + isSSof : Set String -> Set String -> Bool + isSSof b s = + Set.intersect b s == s + + isSubsetFor : ( Bool, Set String ) -> ( Bool, Set String ) -> Bool + isSubsetFor ( bb, sb ) ( bs, ss ) = + case ( bb, bs ) of + ( True, True ) -> + isSSof ss sb + + ( True, False ) -> + Set.isEmpty (Set.intersect sb ss) + + ( False, True ) -> + False + + ( False, False ) -> + isSSof sb ss + in + isSubsetFor + ( big.sendersAllowOthers, big.senders ) + ( small.sendersAllowOthers, small.senders ) + && isSubsetFor + ( big.typesAllowOthers, big.types ) + ( small.typesAllowOthers, small.types ) diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index 9bc20ab..65df052 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -1,7 +1,8 @@ module Internal.Values.Event exposing ( Event , UnsignedData(..), age, prevContent, redactedBecause, transactionId - , encode, decoder, isEqual + , encode, decoder + , isEqual ) {-| @@ -24,6 +25,7 @@ of a room. @docs encode, decoder + ## Test functions @docs isEqual @@ -133,48 +135,58 @@ isEqual : Event -> Event -> Bool isEqual e1 e2 = if e1.eventId /= e2.eventId then False + else if e1.originServerTs /= e2.originServerTs then False + else if e1.roomId /= e2.roomId then False + else if e1.sender /= e2.sender then False + else if e1.stateKey /= e2.stateKey then False + else if e1.eventType /= e2.eventType then False + else - case (e1.unsigned, e2.unsigned) of + case ( e1.unsigned, e2.unsigned ) of ( Nothing, Nothing ) -> True - + ( Just _, Nothing ) -> False - + ( Nothing, Just _ ) -> False - - ( Just ( UnsignedData d1), Just ( UnsignedData d2 )) -> + + ( Just (UnsignedData d1), Just (UnsignedData d2) ) -> if d1.age /= d2.age then False + else if d1.transactionId /= d2.transactionId then False + else if Maybe.map (E.encode 0) d1.prevContent /= Maybe.map (E.encode 0) d2.prevContent then False + else - case (d1.redactedBecause, d2.redactedBecause) of - ( Nothing, Nothing) -> + case ( d1.redactedBecause, d2.redactedBecause ) of + ( Nothing, Nothing ) -> True - + ( Nothing, Just _ ) -> False - + ( Just _, Nothing ) -> False - + ( Just se1, Just se2 ) -> isEqual se1 se2 + {-| Determine the previous `content` value for this event. This field is only a `Just value` if the event is a state event, and the Matrix Vault has permission to see the previous content. diff --git a/tests/Test/Filter/Timeline.elm b/tests/Test/Filter/Timeline.elm index a1e9b99..8b03f35 100644 --- a/tests/Test/Filter/Timeline.elm +++ b/tests/Test/Filter/Timeline.elm @@ -4,6 +4,7 @@ import Expect import Fuzz exposing (Fuzzer) import Internal.Filter.Timeline as Filter exposing (Filter) import Internal.Values.Event as Event +import Set import Test exposing (..) import Test.Values.Event as TestEvent @@ -138,6 +139,138 @@ suite = |> Filter.and (Filter.allTypesExcept types) |> Expect.equal Filter.fail ) + , fuzz2 (Fuzz.list Fuzz.string) + (Fuzz.list Fuzz.string) + "Only list + all except list = common types" + (\t1 t2 -> + Expect.equal + (Filter.and + (Filter.onlyTypes t1) + (Filter.allTypesExcept t2) + ) + (Set.diff (Set.fromList t1) (Set.fromList t2) + |> Set.toList + |> Filter.onlyTypes + ) + ) + , fuzz2 (Fuzz.list Fuzz.string) + (Fuzz.list Fuzz.string) + "Only list + all except list = common senders" + (\t1 t2 -> + Expect.equal + (Filter.and + (Filter.onlySenders t1) + (Filter.allSendersExcept t2) + ) + (Set.diff (Set.fromList t1) (Set.fromList t2) + |> Set.toList + |> Filter.onlySenders + ) + ) + ] + , describe "Subset testing" + [ fuzz2 fuzzer + fuzzer + "Combining two filters is always a subset" + (\filter1 filter2 -> + filter1 + |> Filter.and filter2 + |> Expect.all + [ Filter.subsetOf filter1 >> Expect.equal True + , Filter.subsetOf filter2 >> Expect.equal True + ] + ) + , fuzz + (Fuzz.bool + |> Fuzz.andThen + (\same -> + if same then + Fuzz.map (\a -> ( a, a )) fuzzer + + else + Fuzz.map2 Tuple.pair fuzzer fuzzer + ) + ) + "subset goes both way iff equal" + (\( filter1, filter2 ) -> + Expect.equal + (filter1 == filter2) + (Filter.subsetOf filter1 filter2 + && Filter.subsetOf filter2 filter1 + ) + ) + , fuzz2 Fuzz.string + (Fuzz.list Fuzz.string) + "One more excluded sender is a subset" + (\head tail -> + Filter.allSendersExcept (head :: tail) + |> Filter.subsetOf (Filter.allSendersExcept tail) + |> Expect.equal True + ) + , fuzz2 Fuzz.string + (Fuzz.list Fuzz.string) + "One more excluded type is a subset" + (\head tail -> + Filter.allTypesExcept (head :: tail) + |> Filter.subsetOf (Filter.allTypesExcept tail) + |> Expect.equal True + ) + , fuzz2 Fuzz.string + (Fuzz.list Fuzz.string) + "One less included sender is a subset" + (\head tail -> + Filter.onlySenders tail + |> Filter.subsetOf (Filter.onlySenders (head :: tail)) + |> Expect.equal True + ) + , fuzz2 Fuzz.string + (Fuzz.list Fuzz.string) + "One less included type is a subset" + (\head tail -> + Filter.onlyTypes tail + |> Filter.subsetOf (Filter.onlyTypes (head :: tail)) + |> Expect.equal True + ) + , fuzz3 Fuzz.string + (Fuzz.list Fuzz.string) + fuzzer + "One more excluded sender is a subset - even when combined with another fuzzer" + (\head tail filter -> + Filter.allSendersExcept (head :: tail) + |> Filter.and filter + |> Filter.subsetOf (Filter.and filter <| Filter.allSendersExcept tail) + |> Expect.equal True + ) + , fuzz3 Fuzz.string + (Fuzz.list Fuzz.string) + fuzzer + "One more excluded type is a subset - even when combined with another fuzzer" + (\head tail filter -> + Filter.allTypesExcept (head :: tail) + |> Filter.and filter + |> Filter.subsetOf (Filter.and filter <| Filter.allTypesExcept tail) + |> Expect.equal True + ) + , fuzz3 Fuzz.string + (Fuzz.list Fuzz.string) + fuzzer + "One less included sender is a subset - even when combined with another fuzzer" + (\head tail filter -> + Filter.onlySenders tail + |> Filter.and filter + |> Filter.subsetOf (Filter.and filter <| Filter.onlySenders (head :: tail)) + |> Expect.equal True + ) + , fuzz3 Fuzz.string + (Fuzz.list Fuzz.string) + fuzzer + "One less included type is a subset - even when combined with another fuzzer" + (\head tail filter -> + Filter.onlyTypes tail + |> Filter.and filter + |> Filter.subsetOf (Filter.and filter <| Filter.onlyTypes (head :: tail)) + |> Expect.equal True + ) ] , describe "Use case testing" [ fuzz3 (Fuzz.list TestEvent.fuzzer) @@ -150,30 +283,29 @@ suite = l1 = events |> Filter.run - ( Filter.and - ( Filter.onlySenders senders ) - ( Filter.onlyTypes types ) + (Filter.and + (Filter.onlySenders senders) + (Filter.onlyTypes types) ) - + l2 : List Event.Event l2 = - ( List.filter + List.filter (\e -> - (List.member e.sender senders) && - (List.member e.eventType types) + List.member e.sender senders + && List.member e.eventType types ) events - ) in - Expect.all - [ Expect.equal (List.length l1) (List.length l2) - |> always - , List.map2 Event.isEqual l1 l2 - |> List.all identity - |> Expect.equal True - |> always - ] - () + Expect.all + [ Expect.equal (List.length l1) (List.length l2) + |> always + , List.map2 Event.isEqual l1 l2 + |> List.all identity + |> Expect.equal True + |> always + ] + () ) , fuzz3 (Fuzz.list TestEvent.fuzzer) (Fuzz.list Fuzz.string) @@ -185,30 +317,29 @@ suite = l1 = events |> Filter.run - ( Filter.and - ( Filter.onlySenders senders ) - ( Filter.allTypesExcept types ) + (Filter.and + (Filter.onlySenders senders) + (Filter.allTypesExcept types) ) - + l2 : List Event.Event l2 = - ( List.filter + List.filter (\e -> - (List.member e.sender senders) && - (not <| List.member e.eventType types) + List.member e.sender senders + && (not <| List.member e.eventType types) ) events - ) in - Expect.all - [ Expect.equal (List.length l1) (List.length l2) - |> always - , List.map2 Event.isEqual l1 l2 - |> List.all identity - |> Expect.equal True - |> always - ] - () + Expect.all + [ Expect.equal (List.length l1) (List.length l2) + |> always + , List.map2 Event.isEqual l1 l2 + |> List.all identity + |> Expect.equal True + |> always + ] + () ) , fuzz3 (Fuzz.list TestEvent.fuzzer) (Fuzz.list Fuzz.string) @@ -220,30 +351,29 @@ suite = l1 = events |> Filter.run - ( Filter.and - ( Filter.allSendersExcept senders ) - ( Filter.onlyTypes types ) + (Filter.and + (Filter.allSendersExcept senders) + (Filter.onlyTypes types) ) - + l2 : List Event.Event l2 = - ( List.filter + List.filter (\e -> - (not <| List.member e.sender senders) && - (List.member e.eventType types) + (not <| List.member e.sender senders) + && List.member e.eventType types ) events - ) in - Expect.all - [ Expect.equal (List.length l1) (List.length l2) - |> always - , List.map2 Event.isEqual l1 l2 - |> List.all identity - |> Expect.equal True - |> always - ] - () + Expect.all + [ Expect.equal (List.length l1) (List.length l2) + |> always + , List.map2 Event.isEqual l1 l2 + |> List.all identity + |> Expect.equal True + |> always + ] + () ) , fuzz3 (Fuzz.list TestEvent.fuzzer) (Fuzz.list Fuzz.string) @@ -255,30 +385,29 @@ suite = l1 = events |> Filter.run - ( Filter.and - ( Filter.allSendersExcept senders ) - ( Filter.allTypesExcept types ) + (Filter.and + (Filter.allSendersExcept senders) + (Filter.allTypesExcept types) ) - + l2 : List Event.Event l2 = - ( List.filter + List.filter (\e -> - (not <| List.member e.sender senders) && - (not <| List.member e.eventType types) + (not <| List.member e.sender senders) + && (not <| List.member e.eventType types) ) events - ) in - Expect.all - [ Expect.equal (List.length l1) (List.length l2) - |> always - , List.map2 Event.isEqual l1 l2 - |> List.all identity - |> Expect.equal True - |> always - ] - () + Expect.all + [ Expect.equal (List.length l1) (List.length l2) + |> always + , List.map2 Event.isEqual l1 l2 + |> List.all identity + |> Expect.equal True + |> always + ] + () ) ] ] diff --git a/tests/Test/Values/Event.elm b/tests/Test/Values/Event.elm index 068fb30..bee07ba 100644 --- a/tests/Test/Values/Event.elm +++ b/tests/Test/Values/Event.elm @@ -1,11 +1,11 @@ module Test.Values.Event exposing (..) +import Expect import Fuzz exposing (Fuzzer) import Internal.Values.Event as Event exposing (Event) import Json.Encode as E import Test exposing (..) import Test.Tools.Timestamp as TestTimestamp -import Expect fuzzer : Fuzzer Event @@ -67,10 +67,12 @@ valueFuzzer = , Fuzz.map Event.encode (Fuzz.lazy (\_ -> fuzzer)) ] + suite : Test suite = describe "Sanity check" - [ fuzz fuzzer "event = event" + [ fuzz fuzzer + "event = event" (\event -> Event.isEqual event event |> Expect.equal True From 211f8f1df439f27cf107589a51aebd8f91184430 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 5 Jan 2024 13:51:06 +0100 Subject: [PATCH 03/24] Add Timeline framework The tests fail, but using test-driven development we will now build them functional --- src/Internal/Values/Timeline.elm | 114 ++++++++++++ tests/Test/Filter/Timeline.elm | 8 + tests/Test/Values/Timeline.elm | 303 +++++++++++++++++++++++++++++++ 3 files changed, 425 insertions(+) create mode 100644 src/Internal/Values/Timeline.elm create mode 100644 tests/Test/Values/Timeline.elm diff --git a/src/Internal/Values/Timeline.elm b/src/Internal/Values/Timeline.elm new file mode 100644 index 0000000..271a6dc --- /dev/null +++ b/src/Internal/Values/Timeline.elm @@ -0,0 +1,114 @@ +module Internal.Values.Timeline exposing + ( Batch, fromToken, fromSlice + , Timeline + , empty, singleton + , mostRecentEvents + , addSync, insert + ) + +{-| + + +# Timeline + +The Timeline data type represents a timeline in the Matrix room. The Matrix room +timeline is quite a complex data type, as it is constantly only partially known +by the Matrix client. This module exposes a data type that helps explore, track +and maintain this room state. + + +## Batch + +@docs Batch, fromToken, fromSlice + + +## Timeline + +@docs Timeline + + +## Create + +@docs empty, singleton + + +## Query + +@docs mostRecentEvents + + +## Manipulate + +@docs addSync, insert + +-} + +import Internal.Filter.Timeline as Filter exposing (Filter) + + +{-| The Timeline type represents the timeline state in a Matrix room. +-} +type Timeline + = Timeline + + +{-| A batch is a batch of events that is placed onto the Timeline. Functions +that require an insertion, generally require this data type. +-} +type Batch + = Batch + + +{-| When syncing a Matrix room to its most recent state, add the most recent +batch to the front of the Timeline. +-} +addSync : Batch -> Timeline -> Timeline +addSync _ timeline = + timeline + + +{-| Create a new empty timeline. +-} +empty : Timeline +empty = + Timeline + + +{-| Turn a single token into a batch. +-} +fromToken : String -> Batch +fromToken _ = + Batch + + +{-| Turn a slice of events into a batch. + +NOTE: `start` must generally be a value. If it is `Nothing`, then it is +connected until the start of the timeline. + +-} +fromSlice : { start : Maybe String, events : List String, filter : Filter, end : String } -> Batch +fromSlice _ = + Batch + + +{-| Insert a batch anywhere else in the timeline. +-} +insert : Batch -> Timeline -> Timeline +insert _ timeline = + timeline + + +{-| Under a given filter, find the most recent events. +-} +mostRecentEvents : Filter -> Timeline -> List String +mostRecentEvents _ _ = + [] + + +{-| Create a timeline with a single batch inserted. This batch is considered the +most recent batch, as if created by a sync. +-} +singleton : Batch -> Timeline +singleton b = + addSync b empty diff --git a/tests/Test/Filter/Timeline.elm b/tests/Test/Filter/Timeline.elm index 8b03f35..69b13dc 100644 --- a/tests/Test/Filter/Timeline.elm +++ b/tests/Test/Filter/Timeline.elm @@ -63,6 +63,14 @@ suite = (Filter.onlyTypes (head :: tail)) (Filter.onlySenders (head :: tail)) ) + , fuzz2 fuzzer + fuzzer + "Filter.and f1 f2 == pass iff f1 == f2 == pass" + (\filter1 filter2 -> + Expect.equal + (Filter.and filter1 filter2 == Filter.pass) + (filter1 == Filter.pass && filter2 == Filter.pass) + ) ] , describe "Event filters" [ fuzz TestEvent.fuzzer diff --git a/tests/Test/Values/Timeline.elm b/tests/Test/Values/Timeline.elm new file mode 100644 index 0000000..82f4629 --- /dev/null +++ b/tests/Test/Values/Timeline.elm @@ -0,0 +1,303 @@ +module Test.Values.Timeline exposing (..) + +import Fuzz exposing (Fuzzer) +import Internal.Filter.Timeline as Filter exposing (Filter) +import Internal.Values.Timeline as Timeline exposing (Batch, Timeline) +import Test exposing (..) +import Test.Filter.Timeline as TestFilter +import Expect + + +fuzzer : Fuzzer Timeline +fuzzer = + Fuzz.map2 + (\makers filter -> + case makers of + [] -> + Timeline.empty + + head :: tail -> + List.foldl + (\maker ( prevToken, timeline ) -> + case maker of + Sync start events end -> + ( end + , Timeline.addSync + (Timeline.fromSlice + { start = + start + |> Maybe.withDefault prevToken + |> Maybe.Just + , events = events + , filter = filter + , end = end + } + ) + timeline + ) + + Get start events efilter end -> + ( prevToken + , Timeline.insert + (Timeline.fromSlice + { start = start + , events = events + , filter = Filter.and filter efilter + , end = end + } + ) + timeline + ) + ) + (case head of + Sync start events end -> + ( end + , Timeline.addSync + (Timeline.fromSlice + { start = start + , events = events + , filter = filter + , end = end + } + ) + Timeline.empty + ) + + Get start events efilter end -> + ( end + , Timeline.addSync + (Timeline.fromSlice + { start = start + , events = events + , filter = Filter.and filter efilter + , end = end + } + ) + Timeline.empty + ) + ) + tail + |> Tuple.second + ) + (Fuzz.list fuzzerMaker) + TestFilter.fuzzer + + +fuzzerBatch : Fuzzer Batch +fuzzerBatch = + Fuzz.oneOf + [ Fuzz.map Timeline.fromToken Fuzz.string + , Fuzz.map4 + (\start events filter end -> + Timeline.fromSlice + { start = start + , events = events + , filter = filter + , end = end + } + ) + (Fuzz.maybe Fuzz.string) + (Fuzz.list Fuzz.string) + TestFilter.fuzzer + Fuzz.string + ] + + +type FuzzMaker + = Sync (Maybe String) (List String) String + | Get (Maybe String) (List String) Filter String + + +fuzzerMaker : Fuzzer FuzzMaker +fuzzerMaker = + Fuzz.frequency + [ ( 30, Fuzz.map (Sync Nothing []) Fuzz.string ) + , ( 10 + , Fuzz.map2 (Sync Nothing) + (Fuzz.listOfLengthBetween 1 32 Fuzz.string) + Fuzz.string + ) + , ( 1 + , Fuzz.map3 (\start events end -> Sync (Just start) events end) + Fuzz.string + (Fuzz.listOfLengthBetween 1 32 Fuzz.string) + Fuzz.string + ) + , ( 1 + , Fuzz.map4 Get + (Fuzz.maybe Fuzz.string) + (Fuzz.list Fuzz.string) + TestFilter.fuzzer + Fuzz.string + ) + ] + + +fuzzerForBatch : Fuzzer { start : String, events : List String, filter : Filter, end : String } +fuzzerForBatch = + Fuzz.map4 + (\start events filter end -> + { start = start, events = events, filter = filter, end = end } + ) + Fuzz.string + (Fuzz.list Fuzz.string) + TestFilter.fuzzer + Fuzz.string + + +suite : Test +suite = + describe "Timeline" + [ describe "Most recent events" + [ fuzz fuzzerForBatch "Singleton is most recent" + (\batch -> + { start = Just batch.start + , events = batch.events + , filter = batch.filter + , end = batch.end + } + |> Timeline.fromSlice + |> Timeline.singleton + |> Timeline.mostRecentEvents batch.filter + |> Expect.equal batch.events + ) + , fuzz2 fuzzerForBatch fuzzerForBatch "Double batch connects" + (\batch1 batch2 -> + [ { start = Just batch1.start + , events = batch1.events + , filter = batch1.filter + , end = batch2.start + } + , { start = Just batch2.start + , events = batch2.events + , filter = batch2.filter + , end = batch2.end + } + ] + |> List.map Timeline.fromSlice + |> List.foldl Timeline.addSync Timeline.empty + |> Timeline.mostRecentEvents (Filter.and batch1.filter batch2.filter) + |> (\outcome -> + if batch2.start == batch2.end then + Expect.equal [] outcome + else if batch1.start == batch2.start then + Expect.equal batch2.events outcome + else + Expect.equal + (List.append batch1.events batch2.events) + outcome + ) + ) + , fuzz2 fuzzerForBatch fuzzerForBatch "Disconnected double batch does not connect" + (\batch1 batch2 -> + [ { start = Just batch1.start + , events = batch1.events + , filter = batch1.filter + , end = batch1.start + } + , { start = Just batch2.start + , events = batch2.events + , filter = batch2.filter + , end = batch2.end + } + ] + |> List.map Timeline.fromSlice + |> List.foldl Timeline.addSync Timeline.empty + |> Timeline.mostRecentEvents (Filter.and batch1.filter batch2.filter) + |> (\outcome -> + if batch2.start == batch2.end then + Expect.equal [] outcome + else if batch1.start == batch2.start then + Expect.equal batch2.events outcome + else if batch1.end == batch2.start then + Expect.equal + (List.append batch1.events batch2.events) + outcome + else + Expect.equal batch2.events outcome + ) + ) + , fuzz + ( Fuzz.pair Fuzz.int (Fuzz.list Fuzz.string) + |> (\f -> Fuzz.triple f f f) + |> (\f -> Fuzz.triple f f f) + ) + "Connect 8 batches" + (\(((i1, e1), (i2, e2), (i3, e3)), ((i4, e4), (i5, e5), (i6, e6)), ((i7, e7), (i8, e8), (_, e9))) -> + [ ( i1 + , { start = Just <| String.fromInt 1 + , events = e1 + , filter = Filter.pass + , end = String.fromInt (1 + 1) + } + ) + , ( i2 + , { start = Just <| String.fromInt 2 + , events = e2 + , filter = Filter.pass + , end = String.fromInt (2 + 1) + } + ) + , ( i3 + , { start = Just <| String.fromInt 3 + , events = e3 + , filter = Filter.pass + , end = String.fromInt (3 + 1) + } + ) + , ( i4 + , { start = Just <| String.fromInt 4 + , events = e4 + , filter = Filter.pass + , end = String.fromInt (4 + 1) + } + ) + , ( i5 + , { start = Just <| String.fromInt 5 + , events = e5 + , filter = Filter.pass + , end = String.fromInt (5 + 1) + } + ) + , ( i6 + , { start = Just <| String.fromInt 6 + , events = e6 + , filter = Filter.pass + , end = String.fromInt (6 + 1) + } + ) + , ( i7 + , { start = Just <| String.fromInt 7 + , events = e7 + , filter = Filter.pass + , end = String.fromInt (7 + 1) + } + ) + , ( i8 + , { start = Just <| String.fromInt 8 + , events = e8 + , filter = Filter.pass + , end = String.fromInt (8 + 1) + } + ) + ] + |> List.sortBy Tuple.first + |> List.map Tuple.second + |> List.map Timeline.fromSlice + |> List.foldl + Timeline.insert + (Timeline.singleton + ( Timeline.fromSlice + { start = Just <| String.fromInt 9 + , events = e9 + , filter = Filter.pass + , end = String.fromInt (9 + 1) + } + ) + ) + |> Timeline.mostRecentEvents Filter.pass + |> Expect.equal + ( e1 ++ e2 ++ e3 ++ e4 ++ e5 ++ e6 ++ e7 ++ e8 ++ e9 ) + ) + ] + ] From 81b0b1c166aa1ddfdceb476ec72cdc756c53df69 Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Tue, 9 Jan 2024 18:19:29 +0100 Subject: [PATCH 04/24] Add first (faulty) design of Timeline --- src/Internal/Values/Timeline.elm | 186 ++++++++++++++++++++++++++++--- 1 file changed, 172 insertions(+), 14 deletions(-) diff --git a/src/Internal/Values/Timeline.elm b/src/Internal/Values/Timeline.elm index 271a6dc..a14f3fb 100644 --- a/src/Internal/Values/Timeline.elm +++ b/src/Internal/Values/Timeline.elm @@ -44,19 +44,67 @@ and maintain this room state. -} import Internal.Filter.Timeline as Filter exposing (Filter) - - -{-| The Timeline type represents the timeline state in a Matrix room. --} -type Timeline - = Timeline +import Internal.Tools.Mashdict as Mashdict exposing (Mashdict) +import Internal.Tools.Iddict as Iddict exposing (Iddict) +import FastDict as Dict exposing (Dict) +import Set exposing (Set) {-| A batch is a batch of events that is placed onto the Timeline. Functions that require an insertion, generally require this data type. -} type Batch - = Batch + = StartOfTimeline + | BatchToken String + | BatchSlice Batch (List String) Filter String + +{-| Internal batch that's being saved by the Timeline to track a list of events. +-} +type alias IBatch = + { events : List String + , filter : Filter + , start : ITokenPTR + , end : ITokenPTR + } + +{-| Pointer to an IBatch in the Timeline. +-} +type IBatchPTR = IBatchPTR Int + +{-| Internal token value that's being stored by the Timeline. + +If name is `Nothing`, it indicates the start of the timeline. +-} +type alias IToken = + { name : Maybe String + , starts : Set Int -- This itoken starts the following batches + , ends : Set Int -- This itoken ends the following batches + , inFrontOf : Set Int -- This itoken is in front of the following tokens + , behind : Set Int -- This itoken is behind the following tokens + } + +{-| Pointer to an IToken in the Timeline. +-} +type ITokenPTR = ITokenPTR String + +{-| The Timeline type represents the timeline state in a Matrix room. + +Following the description of the Matrix spec, a timeline contains the following +items: + +- Events that indicate timeline events +- Batch values that can be used to paginate through the timeline + +The topological shape of the timeline makes older API responses somewhat +unreliable - as a result, + +-} +type Timeline + = Timeline + { batches : Iddict IBatch + , mostRecentSync : ITokenPTR + , tokens : Mashdict IToken + } {-| When syncing a Matrix room to its most recent state, add the most recent @@ -66,19 +114,52 @@ addSync : Batch -> Timeline -> Timeline addSync _ timeline = timeline +{-| Connect two tokens to each other, revealing their relative location. +-} +connectITokentoIToken : ITokenPTR -> ITokenPTR -> Timeline -> Timeline +connectITokentoIToken (ITokenPTR early) (ITokenPTR late) (Timeline tl) = + Timeline + { tl + | tokens = + tl.tokens + |> Iddict.map early + (\data -> + { data | behind = Set.insert late data.behind } + ) + |> Iddict.map late + (\data -> + { data | inFrontOf = Set.insert early data.inFrontOf } + ) + } {-| Create a new empty timeline. -} empty : Timeline empty = - Timeline + case Iddict.singleton Nothing of + ( key, iddict ) -> + Timeline + { batches = Iddict.empty + , mostRecentSync = ITokenPTR key + , tokens = iddict + , tokenToPtr = Dict.empty + } +{-| Get an IBatch from the Timeline. +-} +getIBatch : IBatchPTR -> Timeline -> Maybe IBatch +getIBatch (IBatchPTR ptr) (Timeline { batches }) = + Iddict.get ptr batches + +getITokenFromPTR : ITokenPTR -> Timeline -> Maybe IToken +getITokenFromPTR (ITokenPTR ptr) ( Timeline { tokens }) = + Iddict.get ptr tokens {-| Turn a single token into a batch. -} fromToken : String -> Batch -fromToken _ = - Batch +fromToken token = + BatchToken token {-| Turn a slice of events into a batch. @@ -88,15 +169,92 @@ connected until the start of the timeline. -} fromSlice : { start : Maybe String, events : List String, filter : Filter, end : String } -> Batch -fromSlice _ = - Batch +fromSlice data = + BatchSlice + ( case data.start of + Just s -> + BatchToken s + + Nothing -> + StartOfTimeline + ) + data.events data.filter data.end {-| Insert a batch anywhere else in the timeline. -} insert : Batch -> Timeline -> Timeline -insert _ timeline = - timeline +insert batch (Timeline tl) = + (Timeline tl) + +-- {-| Insert a batch anywhere else in the timeline, and gain a ptr to its +-- location. +-- -} +-- insertBatch : Batch -> Timeline -> { start : ITokenPTR, end : ITokenPTR, tl : Timeline } +-- insertBatch batch (Timeline tl) = +-- case batch of +-- StartOfTimeline -> +-- case Iddict.insert Nothing tl.tokens of +-- ( key, iddict ) -> +-- { start = ITokenPTR key +-- , end = ITokenPTR key +-- , tl = Timeline { tl | tokens = iddict } +-- } + +-- BatchToken token -> +-- -- TODO: Do not insert if it already exists +-- case Iddict.insert (Just token) tl.tokens of +-- ( key, iddict ) -> +-- { start = ITokenPTR key +-- , end = ITokenPTR key +-- , tl = Timeline +-- { tl +-- | tokens = iddict +-- , tokenToPtr = +-- Dict.insert token (ITokenPTR key) tl.tokenToPtr +-- } +-- } + +-- BatchSlice prevBatch events filter end -> +-- -- Insert previous batch +-- case insertBatch prevBatch (Timeline tl) of +-- result -> +-- case result.tl of +-- (Timeline tl2) -> +-- { start = result.start +-- , end = +-- } + +{-| Insert an internal batch into the timeline, and determine its result. +-} +insertIBatch : IBatch -> Timeline -> ( IBatchPTR, Timeline ) +insertIBatch ibatch (Timeline tl) = + case Iddict.insert ibatch tl.batches of + ( key, iddict ) -> + ( IBatchPTR key, Timeline { tl | batches = iddict } ) + +insertIToken : IToken -> Timeline -> ( ITokenPTR, Timeline ) +insertIToken itoken (Timeline tl) = + case Maybe.andThen (\n -> Dict.get n tl.tokenToPtr) itoken.name of + -- Already exists: merge + Just ((ITokenPTR ptr) as pointer) -> + ( pointer + , Timeline + { tl + | tokens = + Iddict.map ptr + (\data -> + { name = data.name + , + } + ) + } + ) + + -- Doesn't exist yet: insert! + Nothing -> + (ITokenPTR 0, Timeline tl) + {-| Under a given filter, find the most recent events. From 79aff7af3bf52e909ff8c0e99a278bc58374fcd5 Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Thu, 11 Jan 2024 09:20:16 +0100 Subject: [PATCH 05/24] Refactor Timeline architecture --- src/Internal/Tools/Hashdict.elm | 32 ++- src/Internal/Tools/Mashdict.elm | 32 ++- src/Internal/Values/Timeline.elm | 336 +++++++++++++++++++------------ 3 files changed, 268 insertions(+), 132 deletions(-) diff --git a/src/Internal/Tools/Hashdict.elm b/src/Internal/Tools/Hashdict.elm index f2e4fdb..a4841c1 100644 --- a/src/Internal/Tools/Hashdict.elm +++ b/src/Internal/Tools/Hashdict.elm @@ -3,7 +3,7 @@ module Internal.Tools.Hashdict exposing , empty, singleton, insert, remove, removeKey , isEmpty, member, memberKey, get, size, isEqual , keys, values, toList, fromList - , rehash, union + , rehash, union, map , encode, decoder, softDecoder ) @@ -35,7 +35,7 @@ This allows you to store values based on an externally defined identifier. ## Transform -@docs rehash, union +@docs rehash, union, map ## JSON coders @@ -173,6 +173,34 @@ keys (Hashdict h) = Dict.keys h.values +{-| Map a value on a given key. If the outcome of the function changes the hash, +the operation does nothing. +-} +map : String -> (a -> a) -> Hashdict a -> Hashdict a +map key f (Hashdict h) = + Hashdict + { h + | values = + Dict.update + key + (Maybe.map + (\value -> + let + newValue : a + newValue = + f value + in + if h.hash newValue == h.hash value then + newValue + + else + value + ) + ) + h.values + } + + {-| Determine if a value's hash is in a hashdict. -} member : a -> Hashdict a -> Bool diff --git a/src/Internal/Tools/Mashdict.elm b/src/Internal/Tools/Mashdict.elm index 22c27a8..a8c5e8d 100644 --- a/src/Internal/Tools/Mashdict.elm +++ b/src/Internal/Tools/Mashdict.elm @@ -3,7 +3,7 @@ module Internal.Tools.Mashdict exposing , empty, singleton, insert, remove, removeKey , isEmpty, member, memberKey, get, size, isEqual , keys, values, toList, fromList - , rehash, union + , rehash, union, map , encode, decoder, softDecoder ) @@ -43,7 +43,7 @@ In general, you are advised to learn more about the ## Transform -@docs rehash, union +@docs rehash, union, map ## JSON coders @@ -191,6 +191,34 @@ keys (Mashdict h) = Dict.keys h.values +{-| Map a value on a given key. If the outcome of the function changes the hash, +the operation does nothing. +-} +map : String -> (a -> a) -> Mashdict a -> Mashdict a +map key f (Mashdict h) = + Mashdict + { h + | values = + Dict.update + key + (Maybe.map + (\value -> + case h.hash (f value) of + Just newHash -> + if newHash == key then + f value + + else + value + + Nothing -> + value + ) + ) + h.values + } + + {-| Determine if a value's hash is in a mashdict. -} member : a -> Mashdict a -> Bool diff --git a/src/Internal/Values/Timeline.elm b/src/Internal/Values/Timeline.elm index a14f3fb..b945d07 100644 --- a/src/Internal/Values/Timeline.elm +++ b/src/Internal/Values/Timeline.elm @@ -43,20 +43,23 @@ and maintain this room state. -} -import Internal.Filter.Timeline as Filter exposing (Filter) -import Internal.Tools.Mashdict as Mashdict exposing (Mashdict) -import Internal.Tools.Iddict as Iddict exposing (Iddict) import FastDict as Dict exposing (Dict) +import Internal.Filter.Timeline as Filter exposing (Filter) +import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) +import Internal.Tools.Iddict as Iddict exposing (Iddict) import Set exposing (Set) {-| A batch is a batch of events that is placed onto the Timeline. Functions that require an insertion, generally require this data type. -} -type Batch - = StartOfTimeline - | BatchToken String - | BatchSlice Batch (List String) Filter String +type alias Batch = + { events : List String + , filter : Filter + , start : Maybe TokenValue + , end : TokenValue + } + {-| Internal batch that's being saved by the Timeline to track a list of events. -} @@ -67,33 +70,53 @@ type alias IBatch = , end : ITokenPTR } + {-| Pointer to an IBatch in the Timeline. -} -type IBatchPTR = IBatchPTR Int +type IBatchPTR + = IBatchPTR IBatchPTRValue + + +{-| Location indicator of an IBatch in the Timeline. +-} +type alias IBatchPTRValue = + Int + {-| Internal token value that's being stored by the Timeline. If name is `Nothing`, it indicates the start of the timeline. + -} type alias IToken = - { name : Maybe String - , starts : Set Int -- This itoken starts the following batches - , ends : Set Int -- This itoken ends the following batches - , inFrontOf : Set Int -- This itoken is in front of the following tokens - , behind : Set Int -- This itoken is behind the following tokens + { name : TokenValue + , starts : Set IBatchPTRValue -- This itoken starts the following batches + , ends : Set IBatchPTRValue -- This itoken ends the following batches + , inFrontOf : Set ITokenPTRValue -- This itoken is in front of the following tokens + , behind : Set ITokenPTRValue -- This itoken is behind the following tokens } + {-| Pointer to an IToken in the Timeline. -} -type ITokenPTR = ITokenPTR String +type ITokenPTR + = ITokenPTR ITokenPTRValue + | StartOfTimeline + + +{-| Location indicator of an IToken in the Timeline. +-} +type alias ITokenPTRValue = + String + {-| The Timeline type represents the timeline state in a Matrix room. Following the description of the Matrix spec, a timeline contains the following items: -- Events that indicate timeline events -- Batch values that can be used to paginate through the timeline + - Events that indicate timeline events + - Batch values that can be used to paginate through the timeline The topological shape of the timeline makes older API responses somewhat unreliable - as a result, @@ -102,11 +125,19 @@ unreliable - as a result, type Timeline = Timeline { batches : Iddict IBatch + , events : Dict String ( IBatchPTR, List IBatchPTR ) + , filledBatches : Int , mostRecentSync : ITokenPTR - , tokens : Mashdict IToken + , tokens : Hashdict IToken } +{-| Opaque token value sent by the Matrix API +-} +type alias TokenValue = + String + + {-| When syncing a Matrix room to its most recent state, add the most recent batch to the front of the Timeline. -} @@ -114,36 +145,87 @@ addSync : Batch -> Timeline -> Timeline addSync _ timeline = timeline + +{-| Append a token at the end of a batch. +-} +connectIBatchToIToken : IBatchPTR -> ITokenPTR -> Timeline -> Timeline +connectIBatchToIToken (IBatchPTR bptr) pointer (Timeline tl) = + case pointer of + StartOfTimeline -> + Timeline tl + + ITokenPTR tptr -> + Timeline + { tl + | batches = + Iddict.map bptr + (\batch -> { batch | end = pointer }) + tl.batches + , tokens = + Hashdict.map tptr + (\token -> { token | ends = Set.insert bptr token.ends }) + tl.tokens + } + + +{-| Append a token at the start of a batch. +-} +connectITokenToIBatch : ITokenPTR -> IBatchPTR -> Timeline -> Timeline +connectITokenToIBatch pointer (IBatchPTR bptr) (Timeline tl) = + case pointer of + StartOfTimeline -> + Timeline tl + + ITokenPTR tptr -> + Timeline + { tl + | tokens = + Hashdict.map tptr + (\token -> { token | starts = Set.insert bptr token.starts }) + tl.tokens + , batches = + Iddict.map bptr + (\batch -> { batch | start = pointer }) + tl.batches + } + + {-| Connect two tokens to each other, revealing their relative location. -} -connectITokentoIToken : ITokenPTR -> ITokenPTR -> Timeline -> Timeline -connectITokentoIToken (ITokenPTR early) (ITokenPTR late) (Timeline tl) = - Timeline - { tl - | tokens = - tl.tokens - |> Iddict.map early - (\data -> - { data | behind = Set.insert late data.behind } - ) - |> Iddict.map late - (\data -> - { data | inFrontOf = Set.insert early data.inFrontOf } - ) - } +connectITokenToIToken : ITokenPTR -> ITokenPTR -> Timeline -> Timeline +connectITokenToIToken pointer1 pointer2 (Timeline tl) = + case ( pointer1, pointer2 ) of + ( ITokenPTR early, ITokenPTR late ) -> + Timeline + { tl + | tokens = + tl.tokens + |> Hashdict.map early + (\data -> + { data | behind = Set.insert late data.behind } + ) + |> Hashdict.map late + (\data -> + { data | inFrontOf = Set.insert early data.inFrontOf } + ) + } + + ( _, _ ) -> + Timeline tl + {-| Create a new empty timeline. -} empty : Timeline empty = - case Iddict.singleton Nothing of - ( key, iddict ) -> - Timeline - { batches = Iddict.empty - , mostRecentSync = ITokenPTR key - , tokens = iddict - , tokenToPtr = Dict.empty - } + Timeline + { batches = Iddict.empty + , events = Dict.empty + , filledBatches = 0 + , mostRecentSync = StartOfTimeline + , tokens = Hashdict.empty .name + } + {-| Get an IBatch from the Timeline. -} @@ -151,110 +233,92 @@ getIBatch : IBatchPTR -> Timeline -> Maybe IBatch getIBatch (IBatchPTR ptr) (Timeline { batches }) = Iddict.get ptr batches + getITokenFromPTR : ITokenPTR -> Timeline -> Maybe IToken -getITokenFromPTR (ITokenPTR ptr) ( Timeline { tokens }) = - Iddict.get ptr tokens +getITokenFromPTR pointer (Timeline { tokens }) = + case pointer of + ITokenPTR ptr -> + Hashdict.get ptr tokens -{-| Turn a single token into a batch. --} -fromToken : String -> Batch -fromToken token = - BatchToken token - - -{-| Turn a slice of events into a batch. - -NOTE: `start` must generally be a value. If it is `Nothing`, then it is -connected until the start of the timeline. - --} -fromSlice : { start : Maybe String, events : List String, filter : Filter, end : String } -> Batch -fromSlice data = - BatchSlice - ( case data.start of - Just s -> - BatchToken s - - Nothing -> - StartOfTimeline - ) - data.events data.filter data.end + StartOfTimeline -> + Nothing {-| Insert a batch anywhere else in the timeline. -} insert : Batch -> Timeline -> Timeline insert batch (Timeline tl) = - (Timeline tl) + Timeline tl + + +{-| Insert a batch into the timeline. +-} +insertBatch : Batch -> Timeline -> Timeline +insertBatch batch timeline = + case batch.start of + Just start -> + timeline + |> invokeIToken start + |> Tuple.mapSecond (invokeIToken batch.end) + |> (\( startPTR, ( endPTR, newTimeline ) ) -> + insertIBatch + { events = batch.events + , filter = batch.filter + , start = startPTR + , end = endPTR + } + newTimeline + ) + + Nothing -> + timeline + |> invokeIToken batch.end + |> (\( endPTR, newTimeline ) -> + insertIBatch + { events = batch.events + , filter = batch.filter + , start = StartOfTimeline + , end = endPTR + } + newTimeline + ) --- {-| Insert a batch anywhere else in the timeline, and gain a ptr to its --- location. --- -} --- insertBatch : Batch -> Timeline -> { start : ITokenPTR, end : ITokenPTR, tl : Timeline } --- insertBatch batch (Timeline tl) = --- case batch of --- StartOfTimeline -> --- case Iddict.insert Nothing tl.tokens of --- ( key, iddict ) -> --- { start = ITokenPTR key --- , end = ITokenPTR key --- , tl = Timeline { tl | tokens = iddict } --- } - --- BatchToken token -> --- -- TODO: Do not insert if it already exists --- case Iddict.insert (Just token) tl.tokens of --- ( key, iddict ) -> --- { start = ITokenPTR key --- , end = ITokenPTR key --- , tl = Timeline --- { tl --- | tokens = iddict --- , tokenToPtr = --- Dict.insert token (ITokenPTR key) tl.tokenToPtr --- } --- } - --- BatchSlice prevBatch events filter end -> --- -- Insert previous batch --- case insertBatch prevBatch (Timeline tl) of --- result -> --- case result.tl of --- (Timeline tl2) -> --- { start = result.start --- , end = --- } {-| Insert an internal batch into the timeline, and determine its result. -} -insertIBatch : IBatch -> Timeline -> ( IBatchPTR, Timeline ) +insertIBatch : IBatch -> Timeline -> Timeline insertIBatch ibatch (Timeline tl) = case Iddict.insert ibatch tl.batches of - ( key, iddict ) -> - ( IBatchPTR key, Timeline { tl | batches = iddict } ) + ( batchPTR, newBatches ) -> + { tl | batches = newBatches } + |> Timeline + |> connectITokenToIBatch ibatch.start (IBatchPTR batchPTR) + |> connectIBatchToIToken (IBatchPTR batchPTR) ibatch.end -insertIToken : IToken -> Timeline -> ( ITokenPTR, Timeline ) -insertIToken itoken (Timeline tl) = - case Maybe.andThen (\n -> Dict.get n tl.tokenToPtr) itoken.name of - -- Already exists: merge - Just ((ITokenPTR ptr) as pointer) -> - ( pointer - , Timeline - { tl - | tokens = - Iddict.map ptr - (\data -> - { name = data.name - , + +{-| Invoke an itoken to guarantee that it exists. +-} +invokeIToken : TokenValue -> Timeline -> ( ITokenPTR, Timeline ) +invokeIToken value (Timeline tl) = + ( ITokenPTR value + , Timeline + { tl + | tokens = + case Hashdict.get value tl.tokens of + Just _ -> + tl.tokens + + Nothing -> + Hashdict.insert + { name = value + , starts = Set.empty + , ends = Set.empty + , inFrontOf = Set.empty + , behind = Set.empty } - ) - } - ) - - -- Doesn't exist yet: insert! - Nothing -> - (ITokenPTR 0, Timeline tl) - + tl.tokens + } + ) {-| Under a given filter, find the most recent events. @@ -264,6 +328,22 @@ mostRecentEvents _ _ = [] +{-| Recount the Timeline's amount of filled batches. Since the Timeline +automatically tracks the count on itself, this is generally exclusively used in +specific scenarios like decoding JSON values. +-} +recountFilledBatches : Timeline -> Timeline +recountFilledBatches (Timeline tl) = + Timeline + { tl + | filledBatches = + tl.batches + |> Iddict.values + |> List.filter (\v -> v.events /= []) + |> List.length + } + + {-| Create a timeline with a single batch inserted. This batch is considered the most recent batch, as if created by a sync. -} From 29f6a5e7549b3de834043818e0506bff699e4ac7 Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Thu, 11 Jan 2024 22:35:14 +0100 Subject: [PATCH 06/24] Refactor Batch input --- src/Internal/Values/Timeline.elm | 94 ++++++++++++++++++++++---------- 1 file changed, 65 insertions(+), 29 deletions(-) diff --git a/src/Internal/Values/Timeline.elm b/src/Internal/Values/Timeline.elm index b945d07..bbf3293 100644 --- a/src/Internal/Values/Timeline.elm +++ b/src/Internal/Values/Timeline.elm @@ -1,6 +1,5 @@ module Internal.Values.Timeline exposing - ( Batch, fromToken, fromSlice - , Timeline + ( Batch, Timeline , empty, singleton , mostRecentEvents , addSync, insert @@ -19,12 +18,7 @@ and maintain this room state. ## Batch -@docs Batch, fromToken, fromSlice - - -## Timeline - -@docs Timeline +@docs Batch, Timeline ## Create @@ -142,8 +136,16 @@ type alias TokenValue = batch to the front of the Timeline. -} addSync : Batch -> Timeline -> Timeline -addSync _ timeline = - timeline +addSync batch timeline = + case insertBatch batch timeline of + ( Timeline tl, { start, end } ) -> + let + oldSync : ITokenPTR + oldSync = + tl.mostRecentSync + in + Timeline { tl | mostRecentSync = end } + |> connectITokenToIToken oldSync start {-| Append a token at the end of a batch. @@ -196,19 +198,23 @@ connectITokenToIToken : ITokenPTR -> ITokenPTR -> Timeline -> Timeline connectITokenToIToken pointer1 pointer2 (Timeline tl) = case ( pointer1, pointer2 ) of ( ITokenPTR early, ITokenPTR late ) -> - Timeline - { tl - | tokens = - tl.tokens - |> Hashdict.map early - (\data -> - { data | behind = Set.insert late data.behind } - ) - |> Hashdict.map late - (\data -> - { data | inFrontOf = Set.insert early data.inFrontOf } - ) - } + if early == late then + Timeline tl + + else + Timeline + { tl + | tokens = + tl.tokens + |> Hashdict.map early + (\data -> + { data | behind = Set.insert late data.behind } + ) + |> Hashdict.map late + (\data -> + { data | inFrontOf = Set.insert early data.inFrontOf } + ) + } ( _, _ ) -> Timeline tl @@ -247,13 +253,15 @@ getITokenFromPTR pointer (Timeline { tokens }) = {-| Insert a batch anywhere else in the timeline. -} insert : Batch -> Timeline -> Timeline -insert batch (Timeline tl) = - Timeline tl +insert batch timeline = + timeline + |> insertBatch batch + |> Tuple.first {-| Insert a batch into the timeline. -} -insertBatch : Batch -> Timeline -> Timeline +insertBatch : Batch -> Timeline -> ( Timeline, { start : ITokenPTR, end : ITokenPTR } ) insertBatch batch timeline = case batch.start of Just start -> @@ -261,26 +269,30 @@ insertBatch batch timeline = |> invokeIToken start |> Tuple.mapSecond (invokeIToken batch.end) |> (\( startPTR, ( endPTR, newTimeline ) ) -> - insertIBatch + ( insertIBatch { events = batch.events , filter = batch.filter , start = startPTR , end = endPTR } newTimeline + , { start = startPTR, end = endPTR } + ) ) Nothing -> timeline |> invokeIToken batch.end |> (\( endPTR, newTimeline ) -> - insertIBatch + ( insertIBatch { events = batch.events , filter = batch.filter , start = StartOfTimeline , end = endPTR } newTimeline + , { start = StartOfTimeline, end = endPTR } + ) ) @@ -290,7 +302,31 @@ insertIBatch : IBatch -> Timeline -> Timeline insertIBatch ibatch (Timeline tl) = case Iddict.insert ibatch tl.batches of ( batchPTR, newBatches ) -> - { tl | batches = newBatches } + { tl + | batches = newBatches + , events = + List.foldl + (\event dict -> + Dict.update event + (\value -> + case value of + Nothing -> + Just ( IBatchPTR batchPTR, [] ) + + Just ( head, tail ) -> + Just ( IBatchPTR batchPTR, head :: tail ) + ) + dict + ) + tl.events + ibatch.events + , filledBatches = + if List.isEmpty ibatch.events then + tl.filledBatches + + else + tl.filledBatches + 1 + } |> Timeline |> connectITokenToIBatch ibatch.start (IBatchPTR batchPTR) |> connectIBatchToIToken (IBatchPTR batchPTR) ibatch.end From 394799da8b720c1388dda81e067de05bc6fc16cf Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 12 Jan 2024 00:08:06 +0100 Subject: [PATCH 07/24] Add Timeline JSON coders --- src/Internal/Filter/Timeline.elm | 48 +++++++++- src/Internal/Values/Timeline.elm | 157 +++++++++++++++++++++++++++++++ tests/Test/Filter/Timeline.elm | 13 +++ 3 files changed, 217 insertions(+), 1 deletion(-) diff --git a/src/Internal/Filter/Timeline.elm b/src/Internal/Filter/Timeline.elm index b837df4..a1d31af 100644 --- a/src/Internal/Filter/Timeline.elm +++ b/src/Internal/Filter/Timeline.elm @@ -4,6 +4,7 @@ module Internal.Filter.Timeline exposing , match, run , and , subsetOf + , encode, decoder ) {-| @@ -39,10 +40,16 @@ for interacting with the Matrix API. @docs subsetOf + +## JSON coders + +@docs encode, decoder + -} +import Json.Decode as D +import Json.Encode as E import Set exposing (Set) -import Task exposing (fail) {-| Placeholder Event type so the real Event doesn't need to be imported. @@ -153,6 +160,45 @@ and (Filter f1) (Filter f2) = stdAnd +{-| Decode a Filter from a JSON value. +-} +decoder : D.Decoder Filter +decoder = + D.map4 + (\s sb t tb -> + Filter + { senders = s + , sendersAllowOthers = sb + , types = t + , typesAllowOthers = tb + } + ) + (D.string + |> D.list + |> D.map Set.fromList + |> D.field "senders" + ) + (D.field "sendersAllowOthers" D.bool) + (D.string + |> D.list + |> D.map Set.fromList + |> D.field "types" + ) + (D.field "typesAllowOthers" D.bool) + + +{-| Encode a Filter into a JSON value. +-} +encode : Filter -> E.Value +encode (Filter f) = + E.object + [ ( "senders", E.set E.string f.senders ) + , ( "sendersAllowOthers", E.bool f.sendersAllowOthers ) + , ( "types", E.set E.string f.types ) + , ( "typesAllowOthers", E.bool f.typesAllowOthers ) + ] + + {-| Allow no events. This filter is likely quite useless in practice, but it is used in the test environment for sanity checks and comparisons. -} diff --git a/src/Internal/Values/Timeline.elm b/src/Internal/Values/Timeline.elm index bbf3293..f1ee19b 100644 --- a/src/Internal/Values/Timeline.elm +++ b/src/Internal/Values/Timeline.elm @@ -3,6 +3,7 @@ module Internal.Values.Timeline exposing , empty, singleton , mostRecentEvents , addSync, insert + , encode, decoder ) {-| @@ -35,12 +36,19 @@ and maintain this room state. @docs addSync, insert + +## JSON coder + +@docs encode, decoder + -} import FastDict as Dict exposing (Dict) import Internal.Filter.Timeline as Filter exposing (Filter) import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) import Internal.Tools.Iddict as Iddict exposing (Iddict) +import Json.Decode as D +import Json.Encode as E import Set exposing (Set) @@ -233,6 +241,153 @@ empty = } +{-| Decode a Timeline from a JSON value. +-} +decoder : D.Decoder Timeline +decoder = + D.map5 + (\batches events filled sync tokens -> + Timeline + { batches = batches + , events = events + , filledBatches = filled + , mostRecentSync = sync + , tokens = tokens + } + ) + (D.field "batches" <| Iddict.decoder decoderIBatch) + (D.map2 Tuple.pair + (D.field "head" decoderIBatchPTR) + (D.field "tail" <| D.list decoderIBatchPTR) + |> D.keyValuePairs + |> D.map Dict.fromList + |> D.field "events" + ) + (D.succeed 0) + (D.field "mostRecentSync" decoderITokenPTR) + (D.field "tokens" <| Hashdict.decoder .name decoderIToken) + |> D.map recountFilledBatches + + +decoderIBatch : D.Decoder IBatch +decoderIBatch = + D.map4 IBatch + (D.field "events" <| D.list D.string) + (D.field "filter" Filter.decoder) + (D.field "start" decoderITokenPTR) + (D.field "end" decoderITokenPTR) + + +decoderIBatchPTR : D.Decoder IBatchPTR +decoderIBatchPTR = + D.map IBatchPTR decoderIBatchPTRValue + + +decoderIBatchPTRValue : D.Decoder IBatchPTRValue +decoderIBatchPTRValue = + D.int + + +decoderIToken : D.Decoder IToken +decoderIToken = + D.map5 IToken + (D.field "name" decoderTokenValue) + (D.field "starts" <| D.map Set.fromList <| D.list decoderIBatchPTRValue) + (D.field "ends" <| D.map Set.fromList <| D.list decoderIBatchPTRValue) + (D.field "inFrontOf" <| D.map Set.fromList <| D.list decoderITokenPTRValue) + (D.field "behind" <| D.map Set.fromList <| D.list decoderITokenPTRValue) + + +decoderITokenPTR : D.Decoder ITokenPTR +decoderITokenPTR = + D.oneOf + [ D.map ITokenPTR decoderITokenPTRValue + , D.null StartOfTimeline + ] + + +decoderITokenPTRValue : D.Decoder ITokenPTRValue +decoderITokenPTRValue = + D.string + + +decoderTokenValue : D.Decoder TokenValue +decoderTokenValue = + D.string + + +{-| Encode a Timeline to a JSON value. +-} +encode : Timeline -> E.Value +encode (Timeline tl) = + E.object + [ ( "batches", Iddict.encode encodeIBatch tl.batches ) + , ( "events" + , E.dict identity + (\( head, tail ) -> + E.object + [ ( "head", encodeIBatchPTR head ) + , ( "tail", E.list encodeIBatchPTR tail ) + ] + ) + (Dict.toCoreDict tl.events) + ) + , ( "mostRecentSync", encodeITokenPTR tl.mostRecentSync ) + , ( "tokens", Hashdict.encode encodeIToken tl.tokens ) + ] + + +encodeIBatch : IBatch -> E.Value +encodeIBatch batch = + E.object + [ ( "events", E.list E.string batch.events ) + , ( "filter", Filter.encode batch.filter ) + , ( "start", encodeITokenPTR batch.start ) + , ( "end", encodeITokenPTR batch.end ) + ] + + +encodeIBatchPTR : IBatchPTR -> E.Value +encodeIBatchPTR (IBatchPTR value) = + encodeIBatchPTRValue value + + +encodeIBatchPTRValue : IBatchPTRValue -> E.Value +encodeIBatchPTRValue = + E.int + + +encodeIToken : IToken -> E.Value +encodeIToken itoken = + E.object + [ ( "name", encodeTokenValue itoken.name ) + , ( "starts", E.set encodeIBatchPTRValue itoken.starts ) + , ( "ends", E.set encodeIBatchPTRValue itoken.ends ) + , ( "inFrontOf", E.set encodeITokenPTRValue itoken.inFrontOf ) + , ( "behind", E.set encodeITokenPTRValue itoken.behind ) + ] + + +encodeITokenPTR : ITokenPTR -> E.Value +encodeITokenPTR token = + case token of + ITokenPTR value -> + encodeITokenPTRValue value + + StartOfTimeline -> + E.null + + +encodeITokenPTRValue : ITokenPTRValue -> E.Value +encodeITokenPTRValue = + E.string + + +encodeTokenValue : TokenValue -> E.Value +encodeTokenValue = + E.string + + {-| Get an IBatch from the Timeline. -} getIBatch : IBatchPTR -> Timeline -> Maybe IBatch @@ -240,6 +395,8 @@ getIBatch (IBatchPTR ptr) (Timeline { batches }) = Iddict.get ptr batches +{-| Get an IToken from the Timeline. +-} getITokenFromPTR : ITokenPTR -> Timeline -> Maybe IToken getITokenFromPTR pointer (Timeline { tokens }) = case pointer of diff --git a/tests/Test/Filter/Timeline.elm b/tests/Test/Filter/Timeline.elm index 69b13dc..e686e4f 100644 --- a/tests/Test/Filter/Timeline.elm +++ b/tests/Test/Filter/Timeline.elm @@ -4,6 +4,8 @@ import Expect import Fuzz exposing (Fuzzer) import Internal.Filter.Timeline as Filter exposing (Filter) import Internal.Values.Event as Event +import Json.Decode as D +import Json.Encode as E import Set import Test exposing (..) import Test.Values.Event as TestEvent @@ -418,4 +420,15 @@ suite = () ) ] + , describe "JSON" + [ fuzz fuzzer + "encode -> decode is the same" + (\filter -> + filter + |> Filter.encode + |> E.encode 0 + |> D.decodeString Filter.decoder + |> Expect.equal (Ok filter) + ) + ] ] From 2f7a247dbd9e4c54bccd95c10bef2becbbe3f7a9 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 12 Jan 2024 00:08:35 +0100 Subject: [PATCH 08/24] Rewrite Timeline tests for comparing timelines through JSON --- elm.json | 2 + tests/Test/Values/Timeline.elm | 338 +++++++-------------------------- 2 files changed, 69 insertions(+), 271 deletions(-) diff --git a/elm.json b/elm.json index 405b455..8e7986c 100644 --- a/elm.json +++ b/elm.json @@ -11,6 +11,7 @@ "Internal.Config.Default", "Internal.Config.Leaks", "Internal.Config.Text", + "Internal.Filter.Timeline", "Internal.Tools.Decode", "Internal.Tools.Encode", "Internal.Tools.Hashdict", @@ -23,6 +24,7 @@ "Internal.Values.Event", "Internal.Values.Settings", "Internal.Values.StateManager", + "Internal.Values.Timeline", "Internal.Values.Vault", "Types" ], diff --git a/tests/Test/Values/Timeline.elm b/tests/Test/Values/Timeline.elm index 82f4629..bc002a1 100644 --- a/tests/Test/Values/Timeline.elm +++ b/tests/Test/Values/Timeline.elm @@ -1,303 +1,99 @@ module Test.Values.Timeline exposing (..) +import Expect import Fuzz exposing (Fuzzer) import Internal.Filter.Timeline as Filter exposing (Filter) import Internal.Values.Timeline as Timeline exposing (Batch, Timeline) +import Json.Decode as D +import Json.Encode as E import Test exposing (..) import Test.Filter.Timeline as TestFilter -import Expect fuzzer : Fuzzer Timeline fuzzer = - Fuzz.map2 - (\makers filter -> - case makers of - [] -> - Timeline.empty - - head :: tail -> - List.foldl - (\maker ( prevToken, timeline ) -> - case maker of - Sync start events end -> - ( end - , Timeline.addSync - (Timeline.fromSlice - { start = - start - |> Maybe.withDefault prevToken - |> Maybe.Just - , events = events - , filter = filter - , end = end - } - ) - timeline + TestFilter.fuzzer + |> Fuzz.andThen + (\globalFilter -> + Fuzz.oneOf + [ Fuzz.map2 + (\start batches -> + List.foldl + (\b ( s, f ) -> + ( b.end + , f >> Timeline.addSync { b | start = Just s, filter = globalFilter } ) - - Get start events efilter end -> - ( prevToken - , Timeline.insert - (Timeline.fromSlice - { start = start - , events = events - , filter = Filter.and filter efilter - , end = end - } - ) - timeline - ) - ) - (case head of - Sync start events end -> - ( end - , Timeline.addSync - (Timeline.fromSlice - { start = start - , events = events - , filter = filter - , end = end - } - ) - Timeline.empty - ) - - Get start events efilter end -> - ( end - , Timeline.addSync - (Timeline.fromSlice - { start = start - , events = events - , filter = Filter.and filter efilter - , end = end - } - ) - Timeline.empty ) + ( start, identity ) + batches + |> Tuple.second ) - tail - |> Tuple.second - ) - (Fuzz.list fuzzerMaker) - TestFilter.fuzzer + Fuzz.string + (Fuzz.listOfLengthBetween 0 10 fuzzerBatch) + , Fuzz.map2 + (\start batches -> + List.foldl + (\b ( s, f ) -> + ( b.end + , f >> Timeline.insert { b | start = Just s, filter = Filter.and globalFilter b.filter } + ) + ) + ( start, identity ) + batches + |> Tuple.second + ) + Fuzz.string + (Fuzz.listOfLengthBetween 0 4 fuzzerBatch) + ] + |> Fuzz.listOfLengthBetween 0 10 + |> Fuzz.map (List.foldl (<|) Timeline.empty) + ) fuzzerBatch : Fuzzer Batch fuzzerBatch = - Fuzz.oneOf - [ Fuzz.map Timeline.fromToken Fuzz.string - , Fuzz.map4 - (\start events filter end -> - Timeline.fromSlice - { start = start - , events = events - , filter = filter - , end = end - } - ) - (Fuzz.maybe Fuzz.string) - (Fuzz.list Fuzz.string) - TestFilter.fuzzer - Fuzz.string - ] - - -type FuzzMaker - = Sync (Maybe String) (List String) String - | Get (Maybe String) (List String) Filter String - - -fuzzerMaker : Fuzzer FuzzMaker -fuzzerMaker = - Fuzz.frequency - [ ( 30, Fuzz.map (Sync Nothing []) Fuzz.string ) - , ( 10 - , Fuzz.map2 (Sync Nothing) - (Fuzz.listOfLengthBetween 1 32 Fuzz.string) - Fuzz.string - ) - , ( 1 - , Fuzz.map3 (\start events end -> Sync (Just start) events end) - Fuzz.string - (Fuzz.listOfLengthBetween 1 32 Fuzz.string) - Fuzz.string - ) - , ( 1 - , Fuzz.map4 Get - (Fuzz.maybe Fuzz.string) - (Fuzz.list Fuzz.string) - TestFilter.fuzzer - Fuzz.string - ) - ] - - -fuzzerForBatch : Fuzzer { start : String, events : List String, filter : Filter, end : String } -fuzzerForBatch = - Fuzz.map4 - (\start events filter end -> - { start = start, events = events, filter = filter, end = end } - ) - Fuzz.string + Fuzz.map4 Batch (Fuzz.list Fuzz.string) TestFilter.fuzzer + (Fuzz.maybe Fuzz.string) Fuzz.string +isEqual : Timeline -> Timeline -> Expect.Expectation +isEqual t1 t2 = + Expect.equal + (E.encode 0 <| Timeline.encode t1) + (E.encode 0 <| Timeline.encode t2) + + suite : Test suite = describe "Timeline" - [ describe "Most recent events" - [ fuzz fuzzerForBatch "Singleton is most recent" + [ describe "empty" + [ fuzz fuzzerBatch + "singleton = empty + sync" (\batch -> - { start = Just batch.start - , events = batch.events - , filter = batch.filter - , end = batch.end - } - |> Timeline.fromSlice - |> Timeline.singleton - |> Timeline.mostRecentEvents batch.filter - |> Expect.equal batch.events + isEqual + (Timeline.singleton batch) + (Timeline.addSync batch Timeline.empty) ) - , fuzz2 fuzzerForBatch fuzzerForBatch "Double batch connects" - (\batch1 batch2 -> - [ { start = Just batch1.start - , events = batch1.events - , filter = batch1.filter - , end = batch2.start - } - , { start = Just batch2.start - , events = batch2.events - , filter = batch2.filter - , end = batch2.end - } - ] - |> List.map Timeline.fromSlice - |> List.foldl Timeline.addSync Timeline.empty - |> Timeline.mostRecentEvents (Filter.and batch1.filter batch2.filter) - |> (\outcome -> - if batch2.start == batch2.end then - Expect.equal [] outcome - else if batch1.start == batch2.start then - Expect.equal batch2.events outcome - else - Expect.equal - (List.append batch1.events batch2.events) - outcome + ] + , describe "JSON" + [ fuzz fuzzer + "encode -> decode is same" + (\timeline -> + timeline + |> Timeline.encode + |> E.encode 0 + |> D.decodeString Timeline.decoder + |> (\t -> + case t of + Ok v -> + isEqual v timeline + + Err e -> + Expect.fail (D.errorToString e) ) ) - , fuzz2 fuzzerForBatch fuzzerForBatch "Disconnected double batch does not connect" - (\batch1 batch2 -> - [ { start = Just batch1.start - , events = batch1.events - , filter = batch1.filter - , end = batch1.start - } - , { start = Just batch2.start - , events = batch2.events - , filter = batch2.filter - , end = batch2.end - } - ] - |> List.map Timeline.fromSlice - |> List.foldl Timeline.addSync Timeline.empty - |> Timeline.mostRecentEvents (Filter.and batch1.filter batch2.filter) - |> (\outcome -> - if batch2.start == batch2.end then - Expect.equal [] outcome - else if batch1.start == batch2.start then - Expect.equal batch2.events outcome - else if batch1.end == batch2.start then - Expect.equal - (List.append batch1.events batch2.events) - outcome - else - Expect.equal batch2.events outcome - ) - ) - , fuzz - ( Fuzz.pair Fuzz.int (Fuzz.list Fuzz.string) - |> (\f -> Fuzz.triple f f f) - |> (\f -> Fuzz.triple f f f) - ) - "Connect 8 batches" - (\(((i1, e1), (i2, e2), (i3, e3)), ((i4, e4), (i5, e5), (i6, e6)), ((i7, e7), (i8, e8), (_, e9))) -> - [ ( i1 - , { start = Just <| String.fromInt 1 - , events = e1 - , filter = Filter.pass - , end = String.fromInt (1 + 1) - } - ) - , ( i2 - , { start = Just <| String.fromInt 2 - , events = e2 - , filter = Filter.pass - , end = String.fromInt (2 + 1) - } - ) - , ( i3 - , { start = Just <| String.fromInt 3 - , events = e3 - , filter = Filter.pass - , end = String.fromInt (3 + 1) - } - ) - , ( i4 - , { start = Just <| String.fromInt 4 - , events = e4 - , filter = Filter.pass - , end = String.fromInt (4 + 1) - } - ) - , ( i5 - , { start = Just <| String.fromInt 5 - , events = e5 - , filter = Filter.pass - , end = String.fromInt (5 + 1) - } - ) - , ( i6 - , { start = Just <| String.fromInt 6 - , events = e6 - , filter = Filter.pass - , end = String.fromInt (6 + 1) - } - ) - , ( i7 - , { start = Just <| String.fromInt 7 - , events = e7 - , filter = Filter.pass - , end = String.fromInt (7 + 1) - } - ) - , ( i8 - , { start = Just <| String.fromInt 8 - , events = e8 - , filter = Filter.pass - , end = String.fromInt (8 + 1) - } - ) - ] - |> List.sortBy Tuple.first - |> List.map Tuple.second - |> List.map Timeline.fromSlice - |> List.foldl - Timeline.insert - (Timeline.singleton - ( Timeline.fromSlice - { start = Just <| String.fromInt 9 - , events = e9 - , filter = Filter.pass - , end = String.fromInt (9 + 1) - } - ) - ) - |> Timeline.mostRecentEvents Filter.pass - |> Expect.equal - ( e1 ++ e2 ++ e3 ++ e4 ++ e5 ++ e6 ++ e7 ++ e8 ++ e9 ) - ) ] ] From d40af28b387acb0e0103426469afe2181e30e984 Mon Sep 17 00:00:00 2001 From: Bram Date: Mon, 29 Jan 2024 21:42:33 +0100 Subject: [PATCH 09/24] Add RationalOrder type --- elm.json | 1 + src/Internal/Tools/RationalOrder.elm | 138 +++++++++++++++++ tests/Test/Tools/RationalOrder.elm | 223 +++++++++++++++++++++++++++ 3 files changed, 362 insertions(+) create mode 100644 src/Internal/Tools/RationalOrder.elm create mode 100644 tests/Test/Tools/RationalOrder.elm diff --git a/elm.json b/elm.json index 4085353..c899358 100644 --- a/elm.json +++ b/elm.json @@ -33,6 +33,7 @@ "elm/core": "1.0.0 <= v < 2.0.0", "elm/json": "1.0.0 <= v < 2.0.0", "elm/time": "1.0.0 <= v < 2.0.0", + "micahhahn/elm-safe-recursion": "2.0.0 <= v < 3.0.0", "miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0" }, "test-dependencies": { diff --git a/src/Internal/Tools/RationalOrder.elm b/src/Internal/Tools/RationalOrder.elm new file mode 100644 index 0000000..c61b147 --- /dev/null +++ b/src/Internal/Tools/RationalOrder.elm @@ -0,0 +1,138 @@ +module Internal.Tools.RationalOrder exposing (..) +{-| # Rational order + +The rational order module simulates the properties of the order of rational +numbers: all values have a clear direct ordering, but one can always gain a +new number in-between two existing numbers. + +While this property is similarly achievable with floats, the Float type has a +precision limit and it is therefor more desirable to achieve the same property +using an Elm type that uses Int types for comparison. + +Given the design of the order, the best case comparison design is O(1), and the +worst case comparison is O(log(n)). The worst case relies on recursively +creating two values a and b, create two new numbers in-between, and repeat. +-} + +import Recursion exposing (base, recurse, recurseThen) + +{-| The RationalOrder consists of two items: a number for ordering and a +tie-breaking next RationalOrder type for when two RationalOrders have the same +number. + +When the next RationalOrder is Nothing, it should be considered -infinite. +-} +type RationalOrder + = With Int (Maybe RationalOrder) + +{-| Find a new value that comes after a given value. For optimization reasons, +this will find the nearest number at the highest level. +-} +after : RationalOrder -> RationalOrder +after (With i _) = + With (i + 1) Nothing + +{-| Find a new value that comes before a given value. For optimization reasons, +this will find the nearest number at the highest level. +-} +before : RationalOrder -> RationalOrder +before (With i _) = + With (i - 1) Nothing + +{-| Find a new value in-between two existing values. The inputs don't need to be +ordered. +-} +between : RationalOrder -> RationalOrder -> RationalOrder +between x y = + Recursion.runRecursion + (\orders -> + case orders of + ( Nothing, Nothing ) -> + base (With 0 Nothing) + + ( Just o1, Nothing ) -> + base (before o1) + + ( Nothing, Just o2 ) -> + base (before o2) + + ( Just ((With i1 n1) as o1), Just ((With i2 n2) as o2) ) -> + case Basics.compare i1 i2 of + EQ -> + recurseThen ( n1, n2 ) + ( base << With i1 << Maybe.Just ) + + LT -> + case compare (after o1) o2 of + LT -> + base (after o1) + + _ -> + Maybe.map after n1 + |> Maybe.withDefault (With 0 Nothing) + |> Maybe.Just + |> With i1 + |> base + + GT -> + case compare (after o2) o1 of + LT -> + base (after o2) + + _ -> + Maybe.map after n2 + |> Maybe.withDefault (With 0 Nothing) + |> Maybe.Just + |> With i2 + |> base + ) + ( Just x, Just y ) + +compare : RationalOrder -> RationalOrder -> Basics.Order +compare x y = + Recursion.runRecursion + (\( With i1 n1, With i2 n2 ) -> + case (Basics.compare i1 i2, n1, n2 ) of + ( EQ, Just o1, Just o2 ) -> + recurse ( o1, o2 ) + + ( EQ, Just _, Nothing ) -> + base GT + + ( EQ, Nothing, Just _ ) -> + base LT + + ( EQ, Nothing, Nothing ) -> + base EQ + + ( LT, _, _ ) -> + base LT + + ( GT, _, _ ) -> + base GT + ) + ( x, y ) + +fromList : List Int -> Maybe RationalOrder +fromList = + Recursion.runRecursion + (\items -> + case items of + [] -> + base Nothing + + head :: tail -> + recurseThen tail (With head >> Maybe.Just >> base) + ) + +toList : RationalOrder -> List Int +toList = + Recursion.runRecursion + (\(With i next) -> + case next of + Nothing -> + base [ i ] + + Just n -> + recurseThen n ((::) i >> base) + ) \ No newline at end of file diff --git a/tests/Test/Tools/RationalOrder.elm b/tests/Test/Tools/RationalOrder.elm new file mode 100644 index 0000000..a7cdec2 --- /dev/null +++ b/tests/Test/Tools/RationalOrder.elm @@ -0,0 +1,223 @@ +module Test.Tools.RationalOrder exposing (..) + +import Test exposing (..) +import Fuzz exposing (Fuzzer) +import Expect +import Internal.Tools.RationalOrder as RO exposing (RationalOrder(..)) + +fuzzer : Fuzzer RationalOrder +fuzzer = + Fuzz.map2 With Fuzz.int (Fuzz.lazy (\_ -> Fuzz.maybe fuzzer)) + +twoUnequal : Fuzzer (RationalOrder, RationalOrder) +twoUnequal = + fuzzer + |> Fuzz.andThen + (\o -> + Fuzz.map2 + (\o1 o2 -> + if RO.compare o1 o2 == LT then + ( o1, o2 ) + else + ( o2, o1 ) + ) + (Fuzz.constant o) + (Fuzz.filter ((/=) o) fuzzer) + ) + +suite : Test +suite = + describe "RationalOrder" + [ describe "Semantic truths" + [ describe "After is always greater" + [ fuzz fuzzer "Forwards" + (\o -> + Expect.equal LT (RO.compare o (RO.after o)) + ) + , fuzz fuzzer "Backwards" + (\o -> + Expect.equal GT (RO.compare (RO.after o) o) + ) + ] + , describe "Before is always lesser" + [ fuzz fuzzer "Forwards" + (\o -> + Expect.equal GT (RO.compare o (RO.before o)) + ) + , fuzz fuzzer "Backwards" + (\o -> + Expect.equal LT (RO.compare (RO.before o) o) + ) + ] + , describe "Two unequal == two unequal" + [ fuzz twoUnequal "Forwards" + (\(small, big) -> + Expect.equal LT (RO.compare small big) + ) + , fuzz twoUnequal "Backwards" + (\(small, big) -> + Expect.equal GT (RO.compare big small) + ) + ] + , describe "compare" + [ fuzz2 fuzzer fuzzer "EQ iff same value" + (\o1 o2 -> + Expect.equal + (o1 == o2) + (RO.compare o1 o2 == EQ) + ) + , fuzz2 fuzzer fuzzer "LT iff opposite GT" + (\o1 o2 -> + Expect.equal + (RO.compare o1 o2 == LT) + (RO.compare o2 o1 == GT) + ) + ] + , describe "Between is always between" + [ fuzz twoUnequal "Less than first - forwards" + (\(small, big) -> + (RO.between small big) + |> RO.compare small + |> Expect.equal LT + ) + , fuzz twoUnequal "Less than first - backwards" + (\(small, big) -> + small + |> RO.compare (RO.between small big) + |> Expect.equal GT + ) + , fuzz twoUnequal "Less than second - forwards" + (\(small, big) -> + RO.between small big + |> RO.compare big + |> Expect.equal GT + ) + , fuzz twoUnequal "Less than second - backwards" + (\(small, big) -> + big + |> RO.compare (RO.between small big) + |> Expect.equal LT + ) + ] + ] + , describe "Between creates between" + [ test "With 0 Nothing <--> With 1 Nothing" + (\() -> + RO.between (With 0 Nothing) (With 1 Nothing) + |> Expect.equal (With 0 (Just (With 0 Nothing))) + ) + , test "With 1 Nothing <--> With 0 Nothing" + (\() -> + RO.between (With 1 Nothing) (With 0 Nothing) + |> Expect.equal (With 0 (Just (With 0 Nothing))) + ) + , test "With 0 is filled between With 1 Nothing" + (\() -> + With 0 Nothing + |> RO.between (With 1 Nothing) + |> RO.between (With 1 Nothing) + |> RO.between (With 1 Nothing) + |> RO.between (With 1 Nothing) + |> RO.between (With 1 Nothing) + |> RO.between (With 1 Nothing) + |> Expect.equal (With 0 (Just (With 5 Nothing))) + ) + , test "Will start counting high level as soon as possible" + (\() -> + With 0 Nothing + |> RO.between (With 1 Nothing) + |> RO.between (With 1 Nothing) + |> RO.between (With 1 Nothing) + |> RO.between (With 1 Nothing) + |> RO.between (With 1 Nothing) + |> RO.between (With 1 Nothing) + |> RO.between (With 5 Nothing) + |> RO.between (With 5 Nothing) + |> Expect.equal (With 2 Nothing) + ) + , test "Will start counting high level, then return lower level" + (\() -> + With 0 Nothing + |> RO.between (With 1 Nothing) + |> RO.between (With 1 Nothing) + |> RO.between (With 1 Nothing) + |> RO.between (With 1 Nothing) + |> RO.between (With 1 Nothing) + |> RO.between (With 1 Nothing) + |> RO.between (With 5 Nothing) + |> RO.between (With 5 Nothing) + |> RO.between (With 5 Nothing) + |> RO.between (With 5 Nothing) + |> RO.between (With 5 Nothing) + |> RO.between (With 5 Nothing) + |> RO.between (With 5 Nothing) + |> RO.between (With 5 Nothing) + |> RO.between (With 5 Nothing) + |> RO.between (With 5 Nothing) + |> RO.between (With 5 Nothing) + |> Expect.equal (With 4 (Just (With 6 Nothing))) + ) + , fuzz2 fuzzer fuzzer "Between is commutative" + (\o1 o2 -> + Expect.equal (RO.between o1 o2) (RO.between o2 o1) + ) + ] + , describe "After" + [ fuzz Fuzz.int "One more - level 1" + (\a -> + Expect.equal + ( RO.after <| With a Nothing ) + ( With (a + 1) Nothing) + ) + , fuzz2 Fuzz.int Fuzz.int "One more - level 2" + (\a b -> + Expect.equal + ( RO.after <| With a <| Just <| With b Nothing ) + ( With (a + 1) Nothing) + ) + , fuzz3 Fuzz.int Fuzz.int Fuzz.int "One more - level 3" + (\a b c -> + Expect.equal + ( RO.after <| With a <| Just <| With b <| Just <| With c Nothing ) + ( With (a + 1) Nothing) + ) + ] + , describe "Before" + [ fuzz Fuzz.int "One less - level 1" + (\a -> + Expect.equal + ( RO.before <| With a Nothing ) + ( With (a - 1) Nothing) + ) + , fuzz2 Fuzz.int Fuzz.int "One less - level 2" + (\a b -> + Expect.equal + ( RO.before <| With a <| Just <| With b Nothing ) + ( With (a - 1) Nothing) + ) + , fuzz3 Fuzz.int Fuzz.int Fuzz.int "One less - level 3" + (\a b c -> + Expect.equal + ( RO.before <| With a <| Just <| With b <| Just <| With c Nothing ) + ( With (a - 1) Nothing) + ) + ] + , describe "Compare vs. list compare" + [ fuzz2 + (Fuzz.listOfLengthBetween 1 32 Fuzz.int) + (Fuzz.listOfLengthBetween 1 32 Fuzz.int) + "Compares the same between normal lists and orders" + (\l1 l2 -> + Expect.equal + ( Just <| Basics.compare l1 l2 ) + ( Maybe.map2 RO.compare (RO.fromList l1) (RO.fromList l2)) + ) + , fuzz2 fuzzer fuzzer "Compares the same when converted to list" + (\o1 o2 -> + Expect.equal + ( RO.compare o1 o2 ) + ( Basics.compare (RO.toList o1) (RO.toList o2) ) + ) + ] + ] + From cd8163bb41d0c05f830c1cf874a973f21ef2814d Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 2 Feb 2024 12:57:38 +0100 Subject: [PATCH 10/24] Fix bugs --- elm.json | 21 +----------- src/Internal/Values/Event.elm | 60 +---------------------------------- 2 files changed, 2 insertions(+), 79 deletions(-) diff --git a/elm.json b/elm.json index 851903b..cf63307 100644 --- a/elm.json +++ b/elm.json @@ -26,26 +26,7 @@ "Internal.Values.Vault", "Matrix", "Matrix.Event", - "Matrix.Settings", - "Internal.Config.Default", - "Internal.Config.Leaks", - "Internal.Config.Text", - "Internal.Filter.Timeline", - "Internal.Tools.Decode", - "Internal.Tools.Encode", - "Internal.Tools.Hashdict", - "Internal.Tools.Iddict", - "Internal.Tools.Mashdict", - "Internal.Tools.Timestamp", - "Internal.Tools.VersionControl", - "Internal.Values.Context", - "Internal.Values.Envelope", - "Internal.Values.Event", - "Internal.Values.Settings", - "Internal.Values.StateManager", - "Internal.Values.Timeline", - "Internal.Values.Vault", - "Types" + "Matrix.Settings" ], "elm-version": "0.19.0 <= v < 0.20.0", "dependencies": { diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index a737eb3..71e18e6 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -35,6 +35,7 @@ of a room. import Internal.Config.Text as Text import Internal.Tools.Json as Json import Internal.Tools.Timestamp as Timestamp exposing (Timestamp) +import Json.Encode as E {-| The Event type occurs everywhere on a user's timeline. @@ -213,65 +214,6 @@ isEqual e1 e2 = isEqual se1 se2 -{-| Compare two events and determine whether they're identical. Used mostly for -testing purposes. --} -isEqual : Event -> Event -> Bool -isEqual e1 e2 = - if e1.eventId /= e2.eventId then - False - - else if e1.originServerTs /= e2.originServerTs then - False - - else if e1.roomId /= e2.roomId then - False - - else if e1.sender /= e2.sender then - False - - else if e1.stateKey /= e2.stateKey then - False - - else if e1.eventType /= e2.eventType then - False - - else - case ( e1.unsigned, e2.unsigned ) of - ( Nothing, Nothing ) -> - True - - ( Just _, Nothing ) -> - False - - ( Nothing, Just _ ) -> - False - - ( Just (UnsignedData d1), Just (UnsignedData d2) ) -> - if d1.age /= d2.age then - False - - else if d1.transactionId /= d2.transactionId then - False - - else if Maybe.map (E.encode 0) d1.prevContent /= Maybe.map (E.encode 0) d2.prevContent then - False - - else - case ( d1.redactedBecause, d2.redactedBecause ) of - ( Nothing, Nothing ) -> - True - - ( Nothing, Just _ ) -> - False - - ( Just _, Nothing ) -> - False - - ( Just se1, Just se2 ) -> - isEqual se1 se2 - - {-| Determine the previous `content` value for this event. This field is only a `Just value` if the event is a state event, and the Matrix Vault has permission to see the previous content. From 6134702d25aa89a78a1028fc4e9fa67ab4b0d8b8 Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Mon, 12 Feb 2024 18:54:58 +0100 Subject: [PATCH 11/24] Add Timeline documentation --- docs/timeline.md | 108 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 108 insertions(+) create mode 100644 docs/timeline.md diff --git a/docs/timeline.md b/docs/timeline.md new file mode 100644 index 0000000..8497f06 --- /dev/null +++ b/docs/timeline.md @@ -0,0 +1,108 @@ +# Timeline + +Given the complex nature of the Timeline design, it deserves some explanation of +the design. This document aims to describe how the Elm SDK designs the Timeline, +so that other projects may learn from it. + +## API endpoint disambiguations + +Generally speaking, there are a few API endpoints with similar design: + +- The [`/sync` endpoint](https://spec.matrix.org/v1.9/client-server-api/#get_matrixclientv3sync), +which gets the events that the homeserver received most recently. +- The [`/messages` endpoint](https://spec.matrix.org/v1.9/client-server-api/#get_matrixclientv3roomsroomidmembers), +which gets any events in the topological order. + +As noted in the Matrix spec: + +> Events are ordered in this API according to the arrival time of the event on +> the homeserver. This can conflict with other APIs which order events based on +> their partial ordering in the event graph. This can result in duplicate events +> being received (once per distinct API called). Clients SHOULD de-duplicate +> events based on the event ID when this happens. + +For this reason, the Elm SDK maintains **two independent timelines** that are tied +together when necessary to form a coherent timeline. + +## Elm design + +For those unfamiliar, the Elm Architecture breaks into three parts: + +- **Model** - the state of the application +- **View** - a way to turn your state into meaningful information +- **Update** - a way to update your state based on the Matrix API + +Since these concepts are compartmentalized, it is impossible to make an API call +while executing the **view** function; the Elm SDK must at all times find a way +to represent its state. + +## Timeline + +Concerning the Matrix timeline, it is meant to create a representation +(**Model**) of the timeline, find a way to represent (**View**) it, and find a +simple way to adjust it with every incoming Matrix API result. (**Update**) + +First, we define what a timeline batch is. + +### Timeline batch + +A timeline batch is something that most Matrix API endpoints return. It is a +little piece of the timeline and contains the following four pieces of +information: + +1. A list of events that are part of the timeline. +2. A Filter for which all provided events meet the criteria. +3. An end batch token that functions as an identifier. +4. _(Optional.)_ A start token. If not provided, it indicates the start of the + timeline. + +Here's an example of such a timeline batch: + +``` + |-->[■]->[■]->[●]->[■]->[■]->[●]-->| + | | + |<--- filter: only ■ and ● --->| + | | + start: end: + +``` + +When the Matrix API later returns a batch token that starts with ``, +we know that we can connect it to the batch above and make a longer list of +events! + +At first, this seems quite simple to connect, but there are some difficulties +that come up along the way. + +### Challenge 1: different filters, different locations + +When two timeline batches have different filters, we do not know their +respective location. For example, the following two timeline batches COULD +overlap, but it is also possible they don't: + +``` + |-->[■]->[■]->[●]->[■]->[■]->[●]-->| + | | + |<--- filter: only ■ and ● --->| + | | + start: end: + + + + |-->[★]->[★]->[★]->[★]-->| + | | + |<-- filter: only ★ -->| + | | + start: end: + +``` + +Realistically, there is currently no way of knowing without making more API +calls. However, just making more API calls isn't a solution in Elm because of +its architecture. + +> **SOLUTION:** As described in the **View** function, we may assume that +overlapping timeline batches have overlapping events. If they overlap yet have +no overlapping events, then their filters must be disjoint. If the filters are +disjoint, we do not care whether they're overlapping. + From 2d26e1826df7c05244defee21518a03ed97d0d06 Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Tue, 13 Feb 2024 11:13:16 +0100 Subject: [PATCH 12/24] Add challenge 2 --- docs/timeline.md | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/docs/timeline.md b/docs/timeline.md index 8497f06..37fcba1 100644 --- a/docs/timeline.md +++ b/docs/timeline.md @@ -106,3 +106,33 @@ overlapping timeline batches have overlapping events. If they overlap yet have no overlapping events, then their filters must be disjoint. If the filters are disjoint, we do not care whether they're overlapping. +### Challenge 2: same filters, same spot + +Suppose there is a known timeline batch, and we're trying to **Update** the +timeline to represent the timeline between `` and `` for a +different filter: + +``` + |-->[■]->[■]->[●]->[■]->[■]->[●]-->| + | | + |<--- filter: only ■ and ● --->| + | | + start: end: + +``` + +If we wish to know what's in there for a different filter `f`, then: + +1. If `f` equals the filter from the timeline batch, we can copy the events. +2. If `f` is a subfilter of the batch filter (for example: `only ■`) then we can + copy the events from the given batch, and then locally filter the events + that do no match filter `f`. +3. If the batch filter is a subfilter of `f`, then we can use an API call + between the same batch tokens `` and ``. In the worst + case, we receive the exact same list of events. In another scenario, we + might discover far more events and receive some new batch value `` + in-between `` and ``. +4. If neither filter is a subfilter of the other and the two are (at least + partially) disjoint, then they do not need to correlate and any other batch + values can be chosen. + From cf28a3f2106b87bb25a66613b8e5406d314bf87b Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Thu, 15 Feb 2024 01:27:00 +0100 Subject: [PATCH 13/24] Implement `mostRecentEvents` function --- src/Internal/Values/Timeline.elm | 239 +++++++++---------------------- 1 file changed, 70 insertions(+), 169 deletions(-) diff --git a/src/Internal/Values/Timeline.elm b/src/Internal/Values/Timeline.elm index f1ee19b..018b2fe 100644 --- a/src/Internal/Values/Timeline.elm +++ b/src/Internal/Values/Timeline.elm @@ -2,7 +2,7 @@ module Internal.Values.Timeline exposing ( Batch, Timeline , empty, singleton , mostRecentEvents - , addSync, insert + , insert , encode, decoder ) @@ -16,6 +16,29 @@ timeline is quite a complex data type, as it is constantly only partially known by the Matrix client. This module exposes a data type that helps explore, track and maintain this room state. +This design of the timeline uses the batches as waypoints to maintain an order. +The Matrix API often returns batches that have the following four pieces of +information: + +1. A list of events. +2. A filter for which all of the events meet the criteria. +3. An end batch token. +4. _(Optional)_ A start batch token. If it is not provided, it is the start of + the timeline. + +Here's an example of such a timeline batch: + + |-->[■]->[■]->[●]->[■]->[■]->[●]-->| + | | + |<-- filter: only ■ and ●, no ★ -->| + | | + start: end: + + +When the Matrix API later returns a batch token that starts with ``, +we know that we can connect it to the batch above and make a longer list of +events! + ## Batch @@ -47,8 +70,11 @@ import FastDict as Dict exposing (Dict) import Internal.Filter.Timeline as Filter exposing (Filter) import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) import Internal.Tools.Iddict as Iddict exposing (Iddict) +import Internal.Tools.Json as Json import Json.Decode as D import Json.Encode as E +import Recursion +import Recursion.Traverse import Set exposing (Set) @@ -129,7 +155,7 @@ type Timeline { batches : Iddict IBatch , events : Dict String ( IBatchPTR, List IBatchPTR ) , filledBatches : Int - , mostRecentSync : ITokenPTR + , mostRecentBatch : ITokenPTR , tokens : Hashdict IToken } @@ -140,22 +166,6 @@ type alias TokenValue = String -{-| When syncing a Matrix room to its most recent state, add the most recent -batch to the front of the Timeline. --} -addSync : Batch -> Timeline -> Timeline -addSync batch timeline = - case insertBatch batch timeline of - ( Timeline tl, { start, end } ) -> - let - oldSync : ITokenPTR - oldSync = - tl.mostRecentSync - in - Timeline { tl | mostRecentSync = end } - |> connectITokenToIToken oldSync start - - {-| Append a token at the end of a batch. -} connectIBatchToIToken : IBatchPTR -> ITokenPTR -> Timeline -> Timeline @@ -236,158 +246,11 @@ empty = { batches = Iddict.empty , events = Dict.empty , filledBatches = 0 - , mostRecentSync = StartOfTimeline + , mostRecentBatch = StartOfTimeline , tokens = Hashdict.empty .name } -{-| Decode a Timeline from a JSON value. --} -decoder : D.Decoder Timeline -decoder = - D.map5 - (\batches events filled sync tokens -> - Timeline - { batches = batches - , events = events - , filledBatches = filled - , mostRecentSync = sync - , tokens = tokens - } - ) - (D.field "batches" <| Iddict.decoder decoderIBatch) - (D.map2 Tuple.pair - (D.field "head" decoderIBatchPTR) - (D.field "tail" <| D.list decoderIBatchPTR) - |> D.keyValuePairs - |> D.map Dict.fromList - |> D.field "events" - ) - (D.succeed 0) - (D.field "mostRecentSync" decoderITokenPTR) - (D.field "tokens" <| Hashdict.decoder .name decoderIToken) - |> D.map recountFilledBatches - - -decoderIBatch : D.Decoder IBatch -decoderIBatch = - D.map4 IBatch - (D.field "events" <| D.list D.string) - (D.field "filter" Filter.decoder) - (D.field "start" decoderITokenPTR) - (D.field "end" decoderITokenPTR) - - -decoderIBatchPTR : D.Decoder IBatchPTR -decoderIBatchPTR = - D.map IBatchPTR decoderIBatchPTRValue - - -decoderIBatchPTRValue : D.Decoder IBatchPTRValue -decoderIBatchPTRValue = - D.int - - -decoderIToken : D.Decoder IToken -decoderIToken = - D.map5 IToken - (D.field "name" decoderTokenValue) - (D.field "starts" <| D.map Set.fromList <| D.list decoderIBatchPTRValue) - (D.field "ends" <| D.map Set.fromList <| D.list decoderIBatchPTRValue) - (D.field "inFrontOf" <| D.map Set.fromList <| D.list decoderITokenPTRValue) - (D.field "behind" <| D.map Set.fromList <| D.list decoderITokenPTRValue) - - -decoderITokenPTR : D.Decoder ITokenPTR -decoderITokenPTR = - D.oneOf - [ D.map ITokenPTR decoderITokenPTRValue - , D.null StartOfTimeline - ] - - -decoderITokenPTRValue : D.Decoder ITokenPTRValue -decoderITokenPTRValue = - D.string - - -decoderTokenValue : D.Decoder TokenValue -decoderTokenValue = - D.string - - -{-| Encode a Timeline to a JSON value. --} -encode : Timeline -> E.Value -encode (Timeline tl) = - E.object - [ ( "batches", Iddict.encode encodeIBatch tl.batches ) - , ( "events" - , E.dict identity - (\( head, tail ) -> - E.object - [ ( "head", encodeIBatchPTR head ) - , ( "tail", E.list encodeIBatchPTR tail ) - ] - ) - (Dict.toCoreDict tl.events) - ) - , ( "mostRecentSync", encodeITokenPTR tl.mostRecentSync ) - , ( "tokens", Hashdict.encode encodeIToken tl.tokens ) - ] - - -encodeIBatch : IBatch -> E.Value -encodeIBatch batch = - E.object - [ ( "events", E.list E.string batch.events ) - , ( "filter", Filter.encode batch.filter ) - , ( "start", encodeITokenPTR batch.start ) - , ( "end", encodeITokenPTR batch.end ) - ] - - -encodeIBatchPTR : IBatchPTR -> E.Value -encodeIBatchPTR (IBatchPTR value) = - encodeIBatchPTRValue value - - -encodeIBatchPTRValue : IBatchPTRValue -> E.Value -encodeIBatchPTRValue = - E.int - - -encodeIToken : IToken -> E.Value -encodeIToken itoken = - E.object - [ ( "name", encodeTokenValue itoken.name ) - , ( "starts", E.set encodeIBatchPTRValue itoken.starts ) - , ( "ends", E.set encodeIBatchPTRValue itoken.ends ) - , ( "inFrontOf", E.set encodeITokenPTRValue itoken.inFrontOf ) - , ( "behind", E.set encodeITokenPTRValue itoken.behind ) - ] - - -encodeITokenPTR : ITokenPTR -> E.Value -encodeITokenPTR token = - case token of - ITokenPTR value -> - encodeITokenPTRValue value - - StartOfTimeline -> - E.null - - -encodeITokenPTRValue : ITokenPTRValue -> E.Value -encodeITokenPTRValue = - E.string - - -encodeTokenValue : TokenValue -> E.Value -encodeTokenValue = - E.string - - {-| Get an IBatch from the Timeline. -} getIBatch : IBatchPTR -> Timeline -> Maybe IBatch @@ -516,9 +379,47 @@ invokeIToken value (Timeline tl) = {-| Under a given filter, find the most recent events. -} -mostRecentEvents : Filter -> Timeline -> List String -mostRecentEvents _ _ = - [] +mostRecentEvents : Filter -> Timeline -> List (List String) +mostRecentEvents filter (Timeline timeline) = + mostRecentEventsFrom filter (Timeline timeline) timeline.mostRecentBatch + + +{-| Under a given filter, starting from a given ITokenPTR, find the most recent +events. +-} +mostRecentEventsFrom : Filter -> Timeline -> ITokenPTR -> List (List String) +mostRecentEventsFrom filter timeline ptr = + Recursion.runRecursion + (\p -> + case getITokenFromPTR p.ptr timeline of + Nothing -> + Recursion.base [] + + Just token -> + if Set.member token.name p.visited then + Recursion.base [] + + else + token.ends + |> Set.toList + |> List.filterMap (\bptrv -> getIBatch (IBatchPTR bptrv) timeline) + |> List.filter (\ibatch -> Filter.subsetOf ibatch.filter filter) + |> Recursion.Traverse.traverseList + (\ibatch -> + Recursion.recurseThen + { ptr = ibatch.start, visited = Set.insert token.name p.visited } + (\optionalTimelines -> + optionalTimelines + |> List.map + (\outTimeline -> + List.append outTimeline ibatch.events + ) + |> Recursion.base + ) + ) + |> Recursion.map List.concat + ) + { ptr = ptr, visited = Set.empty } {-| Recount the Timeline's amount of filled batches. Since the Timeline From 7acae258ed9d2f257218b396593247961c804cae Mon Sep 17 00:00:00 2001 From: Bram Date: Thu, 15 Feb 2024 13:15:19 +0100 Subject: [PATCH 14/24] Complete Timeline by fixing bugs --- src/Internal/Values/Timeline.elm | 36 ++++--- tests/Test/Values/Timeline.elm | 180 +++++++++++++++++++++++++------ 2 files changed, 172 insertions(+), 44 deletions(-) diff --git a/src/Internal/Values/Timeline.elm b/src/Internal/Values/Timeline.elm index 018b2fe..305e2a0 100644 --- a/src/Internal/Values/Timeline.elm +++ b/src/Internal/Values/Timeline.elm @@ -1,9 +1,8 @@ module Internal.Values.Timeline exposing ( Batch, Timeline , empty, singleton - , mostRecentEvents + , mostRecentEvents, mostRecentEventsFrom , insert - , encode, decoder ) {-| @@ -52,7 +51,7 @@ events! ## Query -@docs mostRecentEvents +@docs mostRecentEvents, mostRecentEventsFrom ## Manipulate @@ -381,14 +380,19 @@ invokeIToken value (Timeline tl) = -} mostRecentEvents : Filter -> Timeline -> List (List String) mostRecentEvents filter (Timeline timeline) = - mostRecentEventsFrom filter (Timeline timeline) timeline.mostRecentBatch + mostRecentFrom filter (Timeline timeline) timeline.mostRecentBatch + + +mostRecentEventsFrom : Filter -> ITokenPTRValue -> Timeline -> List (List String) +mostRecentEventsFrom filter tokenName timeline = + mostRecentFrom filter timeline (ITokenPTR tokenName) {-| Under a given filter, starting from a given ITokenPTR, find the most recent events. -} -mostRecentEventsFrom : Filter -> Timeline -> ITokenPTR -> List (List String) -mostRecentEventsFrom filter timeline ptr = +mostRecentFrom : Filter -> Timeline -> ITokenPTR -> List (List String) +mostRecentFrom filter timeline ptr = Recursion.runRecursion (\p -> case getITokenFromPTR p.ptr timeline of @@ -409,12 +413,18 @@ mostRecentEventsFrom filter timeline ptr = Recursion.recurseThen { ptr = ibatch.start, visited = Set.insert token.name p.visited } (\optionalTimelines -> - optionalTimelines - |> List.map - (\outTimeline -> - List.append outTimeline ibatch.events - ) - |> Recursion.base + case optionalTimelines of + [] -> + List.singleton ibatch.events + |> Recursion.base + + _ :: _ -> + optionalTimelines + |> List.map + (\outTimeline -> + List.append outTimeline ibatch.events + ) + |> Recursion.base ) ) |> Recursion.map List.concat @@ -443,4 +453,4 @@ most recent batch, as if created by a sync. -} singleton : Batch -> Timeline singleton b = - addSync b empty + insert b empty diff --git a/tests/Test/Values/Timeline.elm b/tests/Test/Values/Timeline.elm index bc002a1..c2e3a96 100644 --- a/tests/Test/Values/Timeline.elm +++ b/tests/Test/Values/Timeline.elm @@ -21,7 +21,7 @@ fuzzer = List.foldl (\b ( s, f ) -> ( b.end - , f >> Timeline.addSync { b | start = Just s, filter = globalFilter } + , f >> Timeline.insert { b | start = Just s, filter = globalFilter } ) ) ( start, identity ) @@ -59,41 +59,159 @@ fuzzerBatch = Fuzz.string -isEqual : Timeline -> Timeline -> Expect.Expectation -isEqual t1 t2 = - Expect.equal - (E.encode 0 <| Timeline.encode t1) - (E.encode 0 <| Timeline.encode t2) - - suite : Test suite = describe "Timeline" - [ describe "empty" - [ fuzz fuzzerBatch - "singleton = empty + sync" - (\batch -> - isEqual - (Timeline.singleton batch) - (Timeline.addSync batch Timeline.empty) + [ describe "most recent events with filters" + [ fuzz TestFilter.fuzzer + "Events are returned properly" + (\filter -> + Timeline.empty + |> Timeline.insert + { events = [ "a", "b", "c" ] + , filter = filter + , start = Just "token_1" + , end = "token_2" + } + |> Timeline.insert + { events = [ "d", "e", "f" ] + , filter = filter + , start = Just "token_2" + , end = "token_3" + } + |> Timeline.mostRecentEventsFrom filter "token_3" + |> Expect.equal + [ [ "a", "b", "c", "d", "e", "f" ] ] ) - ] - , describe "JSON" - [ fuzz fuzzer - "encode -> decode is same" - (\timeline -> - timeline - |> Timeline.encode - |> E.encode 0 - |> D.decodeString Timeline.decoder - |> (\t -> - case t of - Ok v -> - isEqual v timeline - - Err e -> - Expect.fail (D.errorToString e) + , fuzz2 TestFilter.fuzzer + TestFilter.fuzzer + "Sub-events get the same results" + (\f1 f2 -> + let + subFilter = + Filter.and f1 f2 + in + Timeline.empty + |> Timeline.insert + { events = [ "a", "b", "c" ] + , filter = f1 + , start = Just "token_1" + , end = "token_2" + } + |> Timeline.insert + { events = [ "d", "e", "f" ] + , filter = f1 + , start = Just "token_2" + , end = "token_3" + } + |> Timeline.mostRecentEventsFrom subFilter "token_3" + |> Expect.equal + [ [ "a", "b", "c", "d", "e", "f" ] ] + ) + , fuzz2 TestFilter.fuzzer + TestFilter.fuzzer + "ONLY same result if sub-filter" + (\f1 f2 -> + Timeline.empty + |> Timeline.insert + { events = [ "a", "b", "c" ] + , filter = f1 + , start = Just "token_1" + , end = "token_2" + } + |> Timeline.insert + { events = [ "d", "e", "f" ] + , filter = f1 + , start = Just "token_2" + , end = "token_3" + } + |> Timeline.mostRecentEventsFrom f2 "token_3" + |> (\events -> + Expect.equal + (Filter.subsetOf f1 f2) + (events == [ [ "a", "b", "c", "d", "e", "f" ] ]) ) ) ] + , describe "Forks in the road" + [ fuzz2 TestFilter.fuzzer + TestFilter.fuzzer + "Two options returned" + (\f1 f2 -> + let + subFilter = + Filter.and f1 f2 + in + Timeline.empty + |> Timeline.insert + { events = [ "a", "b", "c" ] + , filter = f1 + , start = Just "token_1" + , end = "token_2" + } + |> Timeline.insert + { events = [ "d", "e", "f" ] + , filter = f2 + , start = Just "token_3" + , end = "token_2" + } + |> Timeline.insert + { events = [ "g", "h", "i" ] + , filter = subFilter + , start = Just "token_2" + , end = "token_4" + } + |> Timeline.mostRecentEventsFrom subFilter "token_4" + |> Expect.equal + [ [ "a", "b", "c", "g", "h", "i" ] + , [ "d", "e", "f", "g", "h", "i" ] + ] + ) + ] + , describe "Gaps" + [ fuzz TestFilter.fuzzer + "Gap leaves behind old events" + (\filter -> + Timeline.empty + |> Timeline.insert + { events = [ "a", "b", "c" ] + , filter = filter + , start = Just "token_1" + , end = "token_2" + } + |> Timeline.insert + { events = [ "d", "e", "f" ] + , filter = filter + , start = Just "token_3" + , end = "token_4" + } + |> Timeline.mostRecentEventsFrom filter "token_4" + |> Expect.equal [ [ "d", "e", "f" ] ] + ) + , fuzz TestFilter.fuzzer + "Gap can be bridged" + (\filter -> + Timeline.empty + |> Timeline.insert + { events = [ "a", "b", "c" ] + , filter = filter + , start = Just "token_1" + , end = "token_2" + } + |> Timeline.insert + { events = [ "d", "e", "f" ] + , filter = filter + , start = Just "token_3" + , end = "token_4" + } + |> Timeline.insert + { events = [ "g", "h" ] + , filter = filter + , start = Just "token_2" + , end = "token_3" + } + |> Timeline.mostRecentEventsFrom filter "token_4" + |> Expect.equal [ [ "a", "b", "c", "g", "h", "d", "e", "f" ] ] + ) + ] ] From 1940b1d51f5a578f8668d4cca12b488e0f1767d1 Mon Sep 17 00:00:00 2001 From: Bram Date: Thu, 15 Feb 2024 13:20:25 +0100 Subject: [PATCH 15/24] Fix RationalOrder formatting --- src/Internal/Tools/RationalOrder.elm | 49 +++++--- tests/Test/Tools/RationalOrder.elm | 161 ++++++++++++++++----------- 2 files changed, 128 insertions(+), 82 deletions(-) diff --git a/src/Internal/Tools/RationalOrder.elm b/src/Internal/Tools/RationalOrder.elm index c61b147..4216b5b 100644 --- a/src/Internal/Tools/RationalOrder.elm +++ b/src/Internal/Tools/RationalOrder.elm @@ -1,5 +1,9 @@ module Internal.Tools.RationalOrder exposing (..) -{-| # Rational order + +{-| + + +# Rational order The rational order module simulates the properties of the order of rational numbers: all values have a clear direct ordering, but one can always gain a @@ -12,19 +16,23 @@ using an Elm type that uses Int types for comparison. Given the design of the order, the best case comparison design is O(1), and the worst case comparison is O(log(n)). The worst case relies on recursively creating two values a and b, create two new numbers in-between, and repeat. + -} import Recursion exposing (base, recurse, recurseThen) + {-| The RationalOrder consists of two items: a number for ordering and a tie-breaking next RationalOrder type for when two RationalOrders have the same number. When the next RationalOrder is Nothing, it should be considered -infinite. + -} type RationalOrder = With Int (Maybe RationalOrder) + {-| Find a new value that comes after a given value. For optimization reasons, this will find the nearest number at the highest level. -} @@ -32,6 +40,7 @@ after : RationalOrder -> RationalOrder after (With i _) = With (i + 1) Nothing + {-| Find a new value that comes before a given value. For optimization reasons, this will find the nearest number at the highest level. -} @@ -39,6 +48,7 @@ before : RationalOrder -> RationalOrder before (With i _) = With (i - 1) Nothing + {-| Find a new value in-between two existing values. The inputs don't need to be ordered. -} @@ -49,36 +59,36 @@ between x y = case orders of ( Nothing, Nothing ) -> base (With 0 Nothing) - + ( Just o1, Nothing ) -> base (before o1) - + ( Nothing, Just o2 ) -> base (before o2) - + ( Just ((With i1 n1) as o1), Just ((With i2 n2) as o2) ) -> case Basics.compare i1 i2 of EQ -> recurseThen ( n1, n2 ) - ( base << With i1 << Maybe.Just ) - + (base << With i1 << Maybe.Just) + LT -> case compare (after o1) o2 of LT -> base (after o1) - + _ -> Maybe.map after n1 |> Maybe.withDefault (With 0 Nothing) |> Maybe.Just |> With i1 |> base - + GT -> case compare (after o2) o1 of LT -> base (after o2) - + _ -> Maybe.map after n2 |> Maybe.withDefault (With 0 Nothing) @@ -88,31 +98,33 @@ between x y = ) ( Just x, Just y ) + compare : RationalOrder -> RationalOrder -> Basics.Order compare x y = Recursion.runRecursion (\( With i1 n1, With i2 n2 ) -> - case (Basics.compare i1 i2, n1, n2 ) of + case ( Basics.compare i1 i2, n1, n2 ) of ( EQ, Just o1, Just o2 ) -> recurse ( o1, o2 ) - + ( EQ, Just _, Nothing ) -> base GT - + ( EQ, Nothing, Just _ ) -> base LT - + ( EQ, Nothing, Nothing ) -> base EQ - + ( LT, _, _ ) -> base LT - + ( GT, _, _ ) -> base GT ) ( x, y ) + fromList : List Int -> Maybe RationalOrder fromList = Recursion.runRecursion @@ -120,11 +132,12 @@ fromList = case items of [] -> base Nothing - + head :: tail -> recurseThen tail (With head >> Maybe.Just >> base) ) + toList : RationalOrder -> List Int toList = Recursion.runRecursion @@ -132,7 +145,7 @@ toList = case next of Nothing -> base [ i ] - + Just n -> recurseThen n ((::) i >> base) - ) \ No newline at end of file + ) diff --git a/tests/Test/Tools/RationalOrder.elm b/tests/Test/Tools/RationalOrder.elm index a7cdec2..a908d6a 100644 --- a/tests/Test/Tools/RationalOrder.elm +++ b/tests/Test/Tools/RationalOrder.elm @@ -1,15 +1,17 @@ module Test.Tools.RationalOrder exposing (..) -import Test exposing (..) -import Fuzz exposing (Fuzzer) import Expect +import Fuzz exposing (Fuzzer) import Internal.Tools.RationalOrder as RO exposing (RationalOrder(..)) +import Test exposing (..) + fuzzer : Fuzzer RationalOrder fuzzer = Fuzz.map2 With Fuzz.int (Fuzz.lazy (\_ -> Fuzz.maybe fuzzer)) -twoUnequal : Fuzzer (RationalOrder, RationalOrder) + +twoUnequal : Fuzzer ( RationalOrder, RationalOrder ) twoUnequal = fuzzer |> Fuzz.andThen @@ -18,6 +20,7 @@ twoUnequal = (\o1 o2 -> if RO.compare o1 o2 == LT then ( o1, o2 ) + else ( o2, o1 ) ) @@ -25,81 +28,96 @@ twoUnequal = (Fuzz.filter ((/=) o) fuzzer) ) + suite : Test suite = describe "RationalOrder" [ describe "Semantic truths" [ describe "After is always greater" - [ fuzz fuzzer "Forwards" + [ fuzz fuzzer + "Forwards" (\o -> Expect.equal LT (RO.compare o (RO.after o)) ) - , fuzz fuzzer "Backwards" + , fuzz fuzzer + "Backwards" (\o -> Expect.equal GT (RO.compare (RO.after o) o) ) ] , describe "Before is always lesser" - [ fuzz fuzzer "Forwards" + [ fuzz fuzzer + "Forwards" (\o -> Expect.equal GT (RO.compare o (RO.before o)) ) - , fuzz fuzzer "Backwards" + , fuzz fuzzer + "Backwards" (\o -> Expect.equal LT (RO.compare (RO.before o) o) ) ] , describe "Two unequal == two unequal" - [ fuzz twoUnequal "Forwards" - (\(small, big) -> + [ fuzz twoUnequal + "Forwards" + (\( small, big ) -> Expect.equal LT (RO.compare small big) ) - , fuzz twoUnequal "Backwards" - (\(small, big) -> + , fuzz twoUnequal + "Backwards" + (\( small, big ) -> Expect.equal GT (RO.compare big small) ) ] , describe "compare" - [ fuzz2 fuzzer fuzzer "EQ iff same value" + [ fuzz2 fuzzer + fuzzer + "EQ iff same value" (\o1 o2 -> Expect.equal (o1 == o2) (RO.compare o1 o2 == EQ) ) - , fuzz2 fuzzer fuzzer "LT iff opposite GT" + , fuzz2 fuzzer + fuzzer + "LT iff opposite GT" (\o1 o2 -> Expect.equal (RO.compare o1 o2 == LT) (RO.compare o2 o1 == GT) ) ] - , describe "Between is always between" - [ fuzz twoUnequal "Less than first - forwards" - (\(small, big) -> - (RO.between small big) - |> RO.compare small - |> Expect.equal LT - ) - , fuzz twoUnequal "Less than first - backwards" - (\(small, big) -> - small - |> RO.compare (RO.between small big) - |> Expect.equal GT - ) - , fuzz twoUnequal "Less than second - forwards" - (\(small, big) -> - RO.between small big - |> RO.compare big - |> Expect.equal GT - ) - , fuzz twoUnequal "Less than second - backwards" - (\(small, big) -> - big - |> RO.compare (RO.between small big) - |> Expect.equal LT - ) + , describe "Between is always between" + [ fuzz twoUnequal + "Less than first - forwards" + (\( small, big ) -> + RO.between small big + |> RO.compare small + |> Expect.equal LT + ) + , fuzz twoUnequal + "Less than first - backwards" + (\( small, big ) -> + small + |> RO.compare (RO.between small big) + |> Expect.equal GT + ) + , fuzz twoUnequal + "Less than second - forwards" + (\( small, big ) -> + RO.between small big + |> RO.compare big + |> Expect.equal GT + ) + , fuzz twoUnequal + "Less than second - backwards" + (\( small, big ) -> + big + |> RO.compare (RO.between small big) + |> Expect.equal LT + ) + ] ] - ] , describe "Between creates between" [ test "With 0 Nothing <--> With 1 Nothing" (\() -> @@ -157,49 +175,63 @@ suite = |> RO.between (With 5 Nothing) |> Expect.equal (With 4 (Just (With 6 Nothing))) ) - , fuzz2 fuzzer fuzzer "Between is commutative" + , fuzz2 fuzzer + fuzzer + "Between is commutative" (\o1 o2 -> Expect.equal (RO.between o1 o2) (RO.between o2 o1) ) ] , describe "After" - [ fuzz Fuzz.int "One more - level 1" + [ fuzz Fuzz.int + "One more - level 1" (\a -> Expect.equal - ( RO.after <| With a Nothing ) - ( With (a + 1) Nothing) + (RO.after <| With a Nothing) + (With (a + 1) Nothing) ) - , fuzz2 Fuzz.int Fuzz.int "One more - level 2" + , fuzz2 Fuzz.int + Fuzz.int + "One more - level 2" (\a b -> Expect.equal - ( RO.after <| With a <| Just <| With b Nothing ) - ( With (a + 1) Nothing) + (RO.after <| With a <| Just <| With b Nothing) + (With (a + 1) Nothing) ) - , fuzz3 Fuzz.int Fuzz.int Fuzz.int "One more - level 3" + , fuzz3 Fuzz.int + Fuzz.int + Fuzz.int + "One more - level 3" (\a b c -> Expect.equal - ( RO.after <| With a <| Just <| With b <| Just <| With c Nothing ) - ( With (a + 1) Nothing) + (RO.after <| With a <| Just <| With b <| Just <| With c Nothing) + (With (a + 1) Nothing) ) ] , describe "Before" - [ fuzz Fuzz.int "One less - level 1" + [ fuzz Fuzz.int + "One less - level 1" (\a -> Expect.equal - ( RO.before <| With a Nothing ) - ( With (a - 1) Nothing) + (RO.before <| With a Nothing) + (With (a - 1) Nothing) ) - , fuzz2 Fuzz.int Fuzz.int "One less - level 2" + , fuzz2 Fuzz.int + Fuzz.int + "One less - level 2" (\a b -> Expect.equal - ( RO.before <| With a <| Just <| With b Nothing ) - ( With (a - 1) Nothing) + (RO.before <| With a <| Just <| With b Nothing) + (With (a - 1) Nothing) ) - , fuzz3 Fuzz.int Fuzz.int Fuzz.int "One less - level 3" + , fuzz3 Fuzz.int + Fuzz.int + Fuzz.int + "One less - level 3" (\a b c -> Expect.equal - ( RO.before <| With a <| Just <| With b <| Just <| With c Nothing ) - ( With (a - 1) Nothing) + (RO.before <| With a <| Just <| With b <| Just <| With c Nothing) + (With (a - 1) Nothing) ) ] , describe "Compare vs. list compare" @@ -209,15 +241,16 @@ suite = "Compares the same between normal lists and orders" (\l1 l2 -> Expect.equal - ( Just <| Basics.compare l1 l2 ) - ( Maybe.map2 RO.compare (RO.fromList l1) (RO.fromList l2)) + (Just <| Basics.compare l1 l2) + (Maybe.map2 RO.compare (RO.fromList l1) (RO.fromList l2)) ) - , fuzz2 fuzzer fuzzer "Compares the same when converted to list" + , fuzz2 fuzzer + fuzzer + "Compares the same when converted to list" (\o1 o2 -> Expect.equal - ( RO.compare o1 o2 ) - ( Basics.compare (RO.toList o1) (RO.toList o2) ) + (RO.compare o1 o2) + (Basics.compare (RO.toList o1) (RO.toList o2)) ) ] ] - From 421e1f6ce733e1681d6c8908dffebe7a8e5cf549 Mon Sep 17 00:00:00 2001 From: Bram Date: Mon, 25 Mar 2024 08:52:55 +0100 Subject: [PATCH 16/24] Add Elm Timeline to elm.json --- elm.json | 1 + src/Internal/Config/Text.elm | 17 ++++++- src/Internal/Tools/Json.elm | 27 ++++++++++- src/Internal/Values/Timeline.elm | 83 +++++++++++++++++++++++++++++++- tests/Test/Values/Timeline.elm | 4 +- 5 files changed, 125 insertions(+), 7 deletions(-) diff --git a/elm.json b/elm.json index cf63307..fb3de0a 100644 --- a/elm.json +++ b/elm.json @@ -23,6 +23,7 @@ "Internal.Values.Event", "Internal.Values.Settings", "Internal.Values.StateManager", + "Internal.Values.Timeline", "Internal.Values.Vault", "Matrix", "Matrix.Event", diff --git a/src/Internal/Config/Text.elm b/src/Internal/Config/Text.elm index df063b5..76c8bd6 100644 --- a/src/Internal/Config/Text.elm +++ b/src/Internal/Config/Text.elm @@ -1,5 +1,5 @@ module Internal.Config.Text exposing - ( docs, failures, fields + ( docs, failures, fields, mappings , accessTokenFoundLocally, accessTokenExpired, accessTokenInvalid , versionsFoundLocally, versionsReceived, versionsFailedToDecode , unsupportedVersionForEndpoint @@ -27,7 +27,7 @@ You should only do this if you know what you're doing. ## Type documentation -@docs docs, failures, fields +@docs docs, failures, fields, mappings ## API Authentication @@ -347,6 +347,19 @@ leakingValueFound leaking_value = "Found leaking value : " ++ leaking_value +{-| Function descriptions +-} +mappings : { itokenPTR : TypeDocs } +mappings = + { itokenPTR = + { name = "ITokenPTR init" + , description = + [ "Converts an optional string to an Itoken pointer." + ] + } + } + + {-| The Matrix homeserver can specify how it wishes to communicate, and the Elm SDK aims to communicate accordingly. This may fail in some scenarios, however, in which case it will throw this error. diff --git a/src/Internal/Tools/Json.elm b/src/Internal/Tools/Json.elm index 1a9ca12..44ab34c 100644 --- a/src/Internal/Tools/Json.elm +++ b/src/Internal/Tools/Json.elm @@ -3,7 +3,7 @@ module Internal.Tools.Json exposing , Encoder, encode, Decoder, decode, Value , succeed, fail, andThen, lazy, map , Docs(..), RequiredField(..), toDocs - , list, slowDict, fastDict, maybe + , list, slowDict, fastDict, set, maybe , Field, field , object2, object3, object4, object5, object6, object7, object8, object9, object10, object11 ) @@ -49,7 +49,7 @@ module to build its encoders and decoders. ## Data types -@docs list, slowDict, fastDict, maybe +@docs list, slowDict, fastDict, set, maybe ## Objects @@ -73,6 +73,7 @@ import Internal.Tools.DecodeExtra as D import Internal.Tools.EncodeExtra as E import Json.Decode as D import Json.Encode as E +import Set exposing (Set) {-| A field of type `a` as a subtype of an object `object`. @@ -155,6 +156,7 @@ type Docs ) | DocsOptional Docs | DocsRiskyMap (Descriptive { content : Docs, failure : List String }) + | DocsSet Docs | DocsString | DocsValue @@ -1079,6 +1081,27 @@ object11 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk = } +{-| Define a set. +-} +set : Coder comparable -> Coder (Set comparable) +set (Coder data) = + Coder + { encoder = E.set data.encoder + , decoder = + data.decoder + |> D.list + |> D.map + (\items -> + ( items + |> List.map Tuple.first + |> Set.fromList + , items + |> List.concatMap Tuple.second + ) + ) + , docs = DocsSet data.docs + } + {-| Define a slow dict from the `elm/core` library. -} slowDict : Coder value -> Coder (SlowDict.Dict String value) diff --git a/src/Internal/Values/Timeline.elm b/src/Internal/Values/Timeline.elm index 305e2a0..2ad3e8d 100644 --- a/src/Internal/Values/Timeline.elm +++ b/src/Internal/Values/Timeline.elm @@ -61,7 +61,7 @@ events! ## JSON coder -@docs encode, decoder +@docs coder, encode, decoder -} @@ -70,6 +70,7 @@ import Internal.Filter.Timeline as Filter exposing (Filter) import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) import Internal.Tools.Iddict as Iddict exposing (Iddict) import Internal.Tools.Json as Json +import Internal.Config.Text as Text import Json.Decode as D import Json.Encode as E import Recursion @@ -79,6 +80,9 @@ import Set exposing (Set) {-| A batch is a batch of events that is placed onto the Timeline. Functions that require an insertion, generally require this data type. + +If the `start` value is `Nothing`, it is either the start of the timeline or the +start of the timeline part that the user is allowed to view. -} type alias Batch = { events : List String @@ -164,6 +168,83 @@ type Timeline type alias TokenValue = String +coderIBatchPTR : Json.Coder IBatchPTR +coderIBatchPTR = + Json.map + { name = Debug.todo "Add name" + , description = Debug.todo "Add description" + , back = IBatchPTR + , forth = (\(IBatchPTR value) -> value) + } + coderIBatchPTRValue + +coderIBatchPTRValue : Json.Coder IBatchPTRValue +coderIBatchPTRValue = Json.int + +coderIToken : Json.Coder IToken +coderIToken = + Json.object5 + { name = "IToken" + , description = Debug.todo "TODO: Add description" + , init = IToken + } + ( Json.field.required + { fieldName = "name" + , toField = .name + , description = Debug.todo "TODO: Add description" + , coder = coderTokenValue + } + ) + ( Json.field.optional.withDefault + { fieldName = "starts" + , toField = .starts + , description = Debug.todo "TODO: Add description" + , coder = Json.set coderIBatchPTRValue + , default = ( Set.empty, [] ) + , defaultToString = always "[]" + } + ) + ( Json.field.optional.withDefault + { fieldName = "ends" + , toField = .ends + , description = Debug.todo "TODO: Add description" + , coder = Json.set coderIBatchPTRValue + , default = ( Set.empty, [] ) + , defaultToString = always "[]" + } + ) + +coderITokenPTR : Json.Coder ITokenPTR +coderITokenPTR = + Json.maybe coderITokenPTRValue + |> Json.map + { name = Text.mappings.itokenPTR.name + , description = Text.mappings.itokenPTR.description + , back = + (\itokenptr -> + case itokenptr of + ITokenPTR name -> + Just name + + StartOfTimeline -> + Nothing + ) + , forth = + (\value -> + case value of + Just name -> + ITokenPTR name + + Nothing -> + StartOfTimeline + ) + } + +coderITokenPTRValue : Json.Coder ITokenPTRValue +coderITokenPTRValue = Json.string + +coderTokenValue : Json.Coder TokenValue +coderTokenValue = Json.string {-| Append a token at the end of a batch. -} diff --git a/tests/Test/Values/Timeline.elm b/tests/Test/Values/Timeline.elm index c2e3a96..3bca09d 100644 --- a/tests/Test/Values/Timeline.elm +++ b/tests/Test/Values/Timeline.elm @@ -170,7 +170,7 @@ suite = ] , describe "Gaps" [ fuzz TestFilter.fuzzer - "Gap leaves behind old events" + "Gaps leave behind old events" (\filter -> Timeline.empty |> Timeline.insert @@ -189,7 +189,7 @@ suite = |> Expect.equal [ [ "d", "e", "f" ] ] ) , fuzz TestFilter.fuzzer - "Gap can be bridged" + "Gaps can be bridged" (\filter -> Timeline.empty |> Timeline.insert From ed78695213f1fdd208ef6e12bdb967682506ea0f Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Mar 2024 10:46:02 +0100 Subject: [PATCH 17/24] Add Timeline JSON coder --- src/Internal/Config/Text.elm | 157 ++++++++++++++++++++++++++++++- src/Internal/Filter/Timeline.elm | 86 ++++++++++------- src/Internal/Tools/Iddict.elm | 90 +++++++++--------- src/Internal/Tools/Json.elm | 74 ++++++++++++++- src/Internal/Values/Timeline.elm | 124 ++++++++++++++++++++++-- tests/Test/Filter/Timeline.elm | 2 +- tests/Test/Tools/Iddict.elm | 25 +++-- tests/Test/Values/Timeline.elm | 59 ++++++++++-- 8 files changed, 506 insertions(+), 111 deletions(-) diff --git a/src/Internal/Config/Text.elm b/src/Internal/Config/Text.elm index 76c8bd6..f3c6354 100644 --- a/src/Internal/Config/Text.elm +++ b/src/Internal/Config/Text.elm @@ -1,5 +1,5 @@ module Internal.Config.Text exposing - ( docs, failures, fields, mappings + ( docs, failures, fields, mappings, logs , accessTokenFoundLocally, accessTokenExpired, accessTokenInvalid , versionsFoundLocally, versionsReceived, versionsFailedToDecode , unsupportedVersionForEndpoint @@ -27,7 +27,7 @@ You should only do this if you know what you're doing. ## Type documentation -@docs docs, failures, fields, mappings +@docs docs, failures, fields, mappings, logs ## API Authentication @@ -116,9 +116,14 @@ docs : , envelope : TypeDocs , event : TypeDocs , hashdict : TypeDocs + , ibatch : TypeDocs + , iddict : TypeDocs + , itoken : TypeDocs , mashdict : TypeDocs , settings : TypeDocs , stateManager : TypeDocs + , timeline : TypeDocs + , timelineFilter : TypeDocs , unsigned : TypeDocs } docs = @@ -148,6 +153,24 @@ docs = , "For example, the hashdict can store events and use their event id as their key." ] } + , ibatch = + { name = "IBatch" + , description = + [ "The internal batch tracks a patch of events on the Matrix timeline." + ] + } + , iddict = + { name = "Iddict" + , description = + [ "An iddict automatically handles creating appropriate keys by incrementally assiging a new key to new values." + ] + } + , itoken = + { name = "IToken" + , description = + [ "The IToken connects batches in the timeline and maintains relative order." + ] + } , mashdict = { name = "Mashdict" , description = @@ -167,6 +190,18 @@ docs = , "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." ] } + , timeline = + { name = "Timeline" + , description = + [ "The Timeline tracks events and orders them in a simple way for the user to view them." + ] + } + , timelineFilter = + { name = "Timeline Filter" + , description = + [ "The Timeline Filter allows the user to be very specific about which events they're interested in." + ] + } , unsigned = { name = "Unsigned Data" , description = @@ -218,11 +253,41 @@ fields : , eventType : Desc , unsigned : Desc } + , ibatch : + { end : Desc + , events : Desc + , filter : Desc + , start : Desc + } + , iddict : + { cursor : Desc + , dict : Desc + } + , itoken : + { behind : Desc + , ends : Desc + , inFrontOf : Desc + , name : Desc + , starts : Desc + } , settings : { currentVersion : Desc , deviceName : Desc , syncTime : Desc } + , timeline : + { batches : Desc + , events : Desc + , filledBatches : Desc + , mostRecentBatch : Desc + , tokens : Desc + } + , timelineFilter : + { senders : Desc + , sendersAllowOthers : Desc + , types : Desc + , typesAllowOthers : Desc + } , unsigned : { age : Desc , prevContent : Desc @@ -293,6 +358,45 @@ fields = [ "Contains optional extra information about the event." ] } + , ibatch = + { end = + [ "Pointer to the token that ends the internal batch." + ] + , events = + [ "List of event IDs contained within the internal batch." + ] + , filter = + [ "Filter that indicates how strictly the homeserver has selected when resulting into the given list of events." + ] + , start = + [ "Pointer to the token that starts the internal batch." + ] + } + , iddict = + { cursor = + [ "To ensure uniqueness of all keys and to prevent the usage of keys that were previously assigned to older values, the iddict tracks which is the smallest non-negative integer that hasn't been used yet." + ] + , dict = + [ "Dictionary that contains all values stored in the iddict." + ] + } + , itoken = + { behind = + [ "This token is behind all tokens in this field." + ] + , ends = + [ "This token is in front of the batches in this field." + ] + , inFrontOf = + [ "This token is ahead of all tokens in this field." + ] + , name = + [ "Opaque value provided by the homeserver." + ] + , starts = + [ "This token is at the start of the batches in this field." + ] + } , settings = { currentVersion = [ "Indicates the current version of the Elm SDK." @@ -304,6 +408,40 @@ fields = [ "Indicates the frequency in miliseconds with which the Elm SDK should long-poll the /sync endpoint." ] } + , timeline = + { batches = + [ "Dictionary storing all event batches in the timeline." + ] + , events = + [ "Mapping that allows us to quickly zoom in on an event." + ] + , filledBatches = + [ "Counter that tracks how many batches are kept by the timeline." + , "Batches are only counted if they are filled by at least one event." + ] + , mostRecentBatch = + [ "Tracks the most recent batch that was sent by the homeserver - usually through `/sync`" + ] + , tokens = + [ "Index of all the tokens used to connect event batches on the timeline." + ] + } + , timelineFilter = + { senders = + [ "A list of senders that is considered an exception to the infinite pool of \"other\" users" + ] + , sendersAllowOthers = + [ "Value that determines whether the infinite pool of others is included." + , "If False, only the users mentioned in `senders` are included. If True, then all users who aren't mentioned in `senders` are included." + ] + , types = + [ "A list of event types that is considered an exception to the infinite pool of \"other\" event types." + ] + , typesAllowOthers = + [ "Value that determines whether the infinite pool of others is included." + , "If False, only the event types mentioned in `types` are included. If True, then all users who aren't mentioned in `types` are included." + ] + } , unsigned = { age = [ "The time in milliseconds that has elapsed since the event was sent. This field is generated by the local homeserver, and may be incorrect if the local time on at least one of the two servers is out of sync, which can cause the age to either be negative or greater than it actually is." @@ -347,6 +485,21 @@ leakingValueFound leaking_value = "Found leaking value : " ++ leaking_value +{-| +-} +logs : { keyIsNotAnInt : String -> String } +logs = + { keyIsNotAnInt = + (\key -> + String.concat + [ "Encountered a key `" + , key + , "` that cannot be converted to an Int" + ] + ) + } + + {-| Function descriptions -} mappings : { itokenPTR : TypeDocs } diff --git a/src/Internal/Filter/Timeline.elm b/src/Internal/Filter/Timeline.elm index a1d31af..79875bf 100644 --- a/src/Internal/Filter/Timeline.elm +++ b/src/Internal/Filter/Timeline.elm @@ -4,7 +4,7 @@ module Internal.Filter.Timeline exposing , match, run , and , subsetOf - , encode, decoder + , coder, encode, decoder ) {-| @@ -43,10 +43,12 @@ for interacting with the Matrix API. ## JSON coders -@docs encode, decoder +@docs coder, encode, decoder -} +import Internal.Config.Text as Text +import Internal.Tools.Json as Json import Json.Decode as D import Json.Encode as E import Set exposing (Set) @@ -159,44 +161,64 @@ and (Filter f1) (Filter f2) = else stdAnd +coder : Json.Coder Filter +coder = + Json.object4 + { name = Text.docs.timelineFilter.name + , description = Text.docs.timelineFilter.description + , init = + (\a b c d -> + Filter + { senders = a, sendersAllowOthers = b + , types = c, typesAllowOthers = d + } + ) + } + ( Json.field.optional.withDefault + { fieldName = "senders" + , toField = (\(Filter f) -> f.senders) + , description = Text.fields.timelineFilter.senders + , coder = Json.set Json.string + , default = ( Set.empty, [] ) + , defaultToString = always "[]" + } + ) + ( Json.field.required + { fieldName = "sendersAllowOthers" + , toField = (\(Filter f) -> f.sendersAllowOthers) + , description = Text.fields.timelineFilter.sendersAllowOthers + , coder = Json.bool + } + ) + ( Json.field.optional.withDefault + { fieldName = "types" + , toField = (\(Filter f) -> f.types) + , description = Text.fields.timelineFilter.types + , coder = Json.set Json.string + , default = ( Set.empty, [] ) + , defaultToString = always "[]" + } + ) + ( Json.field.required + { fieldName = "typesAllowOthers" + , toField = (\(Filter f) -> f.typesAllowOthers) + , description = Text.fields.timelineFilter.typesAllowOthers + , coder = Json.bool + } + ) {-| Decode a Filter from a JSON value. -} -decoder : D.Decoder Filter +decoder : Json.Decoder Filter decoder = - D.map4 - (\s sb t tb -> - Filter - { senders = s - , sendersAllowOthers = sb - , types = t - , typesAllowOthers = tb - } - ) - (D.string - |> D.list - |> D.map Set.fromList - |> D.field "senders" - ) - (D.field "sendersAllowOthers" D.bool) - (D.string - |> D.list - |> D.map Set.fromList - |> D.field "types" - ) - (D.field "typesAllowOthers" D.bool) + Json.decode coder {-| Encode a Filter into a JSON value. -} -encode : Filter -> E.Value -encode (Filter f) = - E.object - [ ( "senders", E.set E.string f.senders ) - , ( "sendersAllowOthers", E.bool f.sendersAllowOthers ) - , ( "types", E.set E.string f.types ) - , ( "typesAllowOthers", E.bool f.typesAllowOthers ) - ] +encode : Json.Encoder Filter +encode = + Json.encode coder {-| Allow no events. This filter is likely quite useless in practice, but it is diff --git a/src/Internal/Tools/Iddict.elm b/src/Internal/Tools/Iddict.elm index 115816f..5dd75bb 100644 --- a/src/Internal/Tools/Iddict.elm +++ b/src/Internal/Tools/Iddict.elm @@ -3,7 +3,7 @@ module Internal.Tools.Iddict exposing , empty, singleton, insert, map, remove , isEmpty, member, get, size , keys, values - , encode, decoder + , coder, encode, decoder ) {-| The id-dict is a data type that lets us store values in a dictionary using @@ -36,11 +36,13 @@ do not need to generate identifiers yourself. ## JSON coders -@docs encode, decoder +@docs coder, encode, decoder -} import FastDict as Dict exposing (Dict) +import Internal.Config.Text as Text +import Internal.Tools.Json as Json import Json.Decode as D import Json.Encode as E @@ -53,42 +55,47 @@ type Iddict a , dict : Dict Int a } +coder : Json.Coder a -> Json.Coder (Iddict a) +coder x = + Json.object2 + { name = Text.docs.iddict.name + , description = Text.docs.iddict.description + , init = + (\c d -> + Iddict + { cursor = + Dict.keys d + |> List.maximum + |> Maybe.withDefault -1 + |> (+) 1 + |> max (Dict.size d) + |> max c + , dict = d + } + ) + } + ( Json.field.optional.withDefault + { fieldName = "cursor" + , toField = (\(Iddict i) -> i.cursor) + , description = Text.fields.iddict.cursor + , coder = Json.int + , default = ( 0, [] ) + , defaultToString = String.fromInt + } + ) + ( Json.field.required + { fieldName = "dict" + , toField = (\(Iddict i) -> i.dict) + , description = Text.fields.iddict.dict + , coder = Json.fastIntDict x + } + ) {-| Decode an id-dict from a JSON value. -} -decoder : D.Decoder a -> D.Decoder (Iddict a) -decoder xDecoder = - D.map2 - (\c pairs -> - let - dict : Dict Int a - dict = - pairs - |> List.filterMap - (\( k, v ) -> - k - |> String.toInt - |> Maybe.map (\n -> ( n, v )) - ) - |> Dict.fromList - in - Iddict - { cursor = - Dict.keys dict - -- Larger than all values in the list - |> List.map ((+) 1) - |> List.maximum - |> Maybe.withDefault 0 - |> max (Dict.size dict) - -- At least the dict size - |> max c - - -- At least the given value - , dict = dict - } - ) - (D.field "cursor" D.int) - (D.field "dict" <| D.keyValuePairs xDecoder) +decoder : Json.Coder a -> Json.Decoder (Iddict a) +decoder x = + Json.decode (coder x) {-| Create an empty id-dict. @@ -103,16 +110,9 @@ empty = {-| Encode an id-dict to a JSON value. -} -encode : (a -> E.Value) -> Iddict a -> E.Value -encode encodeX (Iddict d) = - E.object - [ ( "cursor", E.int d.cursor ) - , ( "dict" - , d.dict - |> Dict.toCoreDict - |> E.dict String.fromInt encodeX - ) - ] +encode : Json.Coder a -> Json.Encoder (Iddict a) +encode x = + Json.encode (coder x) {-| Get a value from the id-dict using its key. diff --git a/src/Internal/Tools/Json.elm b/src/Internal/Tools/Json.elm index 44ab34c..8876ca5 100644 --- a/src/Internal/Tools/Json.elm +++ b/src/Internal/Tools/Json.elm @@ -3,7 +3,7 @@ module Internal.Tools.Json exposing , Encoder, encode, Decoder, decode, Value , succeed, fail, andThen, lazy, map , Docs(..), RequiredField(..), toDocs - , list, slowDict, fastDict, set, maybe + , list, listWithOne, slowDict, fastDict, fastIntDict, set, maybe , Field, field , object2, object3, object4, object5, object6, object7, object8, object9, object10, object11 ) @@ -49,7 +49,7 @@ module to build its encoders and decoders. ## Data types -@docs list, slowDict, fastDict, set, maybe +@docs list, listWithOne, slowDict, fastDict, fastIntDict, set, maybe ## Objects @@ -68,7 +68,8 @@ Once all fields are constructed, the user can create JSON objects. import Dict as SlowDict import FastDict -import Internal.Config.Log exposing (Log) +import Internal.Config.Log as Log exposing (Log) +import Internal.Config.Text as Text import Internal.Tools.DecodeExtra as D import Internal.Tools.EncodeExtra as E import Json.Decode as D @@ -140,8 +141,10 @@ type Docs | DocsDict Docs | DocsFloat | DocsInt + | DocsIntDict Docs | DocsLazy (() -> Docs) | DocsList Docs + | DocsListWithOne Docs | DocsMap (Descriptive { content : Docs }) | DocsObject (Descriptive @@ -291,6 +294,46 @@ fastDict (Coder old) = , docs = DocsDict old.docs } +{-| Define a fast dict where the keys are integers, not strings. +-} +fastIntDict : Coder value -> Coder (FastDict.Dict Int value) +fastIntDict (Coder old) = + Coder + { encoder = FastDict.toCoreDict >> E.dict String.fromInt old.encoder + , decoder = + old.decoder + |> D.keyValuePairs + |> D.map + (\items -> + ( items + |> List.map (Tuple.mapSecond Tuple.first) + |> List.filterMap + (\(k, v) -> + Maybe.map (\a -> (a, v)) (String.toInt k) + ) + |> FastDict.fromList + , List.concat + [ items + |> List.map Tuple.first + |> List.filter + (\k -> + case String.toInt k of + Just _ -> + True + + Nothing -> + False + ) + |> List.map Text.logs.keyIsNotAnInt + |> List.map Log.log.warn + , items + |> List.map Tuple.second + |> List.concatMap Tuple.second + ] + ) + ) + , docs = DocsIntDict old.docs + } {-| Create a new field using any of the three provided options. @@ -466,6 +509,31 @@ list (Coder old) = , docs = DocsList old.docs } +{-| Define a list that has at least one value +-} +listWithOne : Coder a -> Coder (a, List a) +listWithOne (Coder old) = + Coder + { encoder = (\(h, t) -> E.list old.encoder (h :: t)) + , decoder = + old.decoder + |> D.list + |> D.andThen + (\items -> + case items of + [] -> + D.fail "Expected at least one value in list" + + ( h, l1) :: t -> + D.succeed + ( (h, List.map Tuple.first items) + , List.concatMap Tuple.second t + |> List.append l1 + ) + ) + , docs = DocsListWithOne old.docs + } + {-| Map a value. diff --git a/src/Internal/Values/Timeline.elm b/src/Internal/Values/Timeline.elm index 2ad3e8d..5967d2b 100644 --- a/src/Internal/Values/Timeline.elm +++ b/src/Internal/Values/Timeline.elm @@ -3,6 +3,7 @@ module Internal.Values.Timeline exposing , empty, singleton , mostRecentEvents, mostRecentEventsFrom , insert + , coder ) {-| @@ -168,13 +169,100 @@ type Timeline type alias TokenValue = String +coder : Json.Coder Timeline +coder = + Json.object5 + { name = Text.docs.timeline.name + , description = Text.docs.timeline.description + , init = + (\a b c d e -> + Timeline + { batches = a, events = b, filledBatches = c + , mostRecentBatch = d, tokens = e + } + ) + } + ( Json.field.required + { fieldName = "batches" + , toField = (\(Timeline t) -> t.batches) + , description = Text.fields.timeline.batches + , coder = Iddict.coder coderIBatch + } + ) + ( Json.field.required + { fieldName = "events" + , toField = (\(Timeline t) -> t.events) + , description = Text.fields.timeline.events + , coder = Json.fastDict (Json.listWithOne coderIBatchPTR) + } + ) + ( Json.field.optional.withDefault + { fieldName = "filledBatches" + , toField = (\(Timeline t) -> t.filledBatches) + , description = Text.fields.timeline.filledBatches + , coder = Json.int + , default = ( 0, [] ) + , defaultToString = String.fromInt + } + ) + ( Json.field.required + { fieldName = "mostRecentBatch" + , toField = (\(Timeline t) -> t.mostRecentBatch) + , description = Text.fields.timeline.mostRecentBatch + , coder = coderITokenPTR + } + ) + ( Json.field.required + { fieldName = "tokens" + , toField = (\(Timeline t) -> t.tokens) + , description = Text.fields.timeline.tokens + , coder = Hashdict.coder .name coderIToken + } + ) + +coderIBatch : Json.Coder IBatch +coderIBatch = + Json.object4 + { name = Text.docs.ibatch.name + , description = Text.docs.ibatch.description + , init = IBatch + } + ( Json.field.required + { fieldName = "events" + , toField = .events + , description = Text.fields.ibatch.events + , coder = Json.list Json.string + } + ) + ( Json.field.required + { fieldName = "filter" + , toField = .filter + , description = Text.fields.ibatch.filter + , coder = Filter.coder + } + ) + ( Json.field.required + { fieldName = "start" + , toField = .start + , description = Text.fields.ibatch.start + , coder = coderITokenPTR + } + ) + ( Json.field.required + { fieldName = "end" + , toField = .end + , description = Text.fields.ibatch.end + , coder = coderITokenPTR + } + ) + coderIBatchPTR : Json.Coder IBatchPTR coderIBatchPTR = Json.map - { name = Debug.todo "Add name" - , description = Debug.todo "Add description" - , back = IBatchPTR - , forth = (\(IBatchPTR value) -> value) + { name = Text.docs.itoken.name + , description = Text.docs.itoken.description + , back = (\(IBatchPTR value) -> value) + , forth = IBatchPTR } coderIBatchPTRValue @@ -184,21 +272,21 @@ coderIBatchPTRValue = Json.int coderIToken : Json.Coder IToken coderIToken = Json.object5 - { name = "IToken" - , description = Debug.todo "TODO: Add description" + { name = Text.docs.itoken.name + , description = Text.docs.itoken.description , init = IToken } ( Json.field.required { fieldName = "name" , toField = .name - , description = Debug.todo "TODO: Add description" + , description = Text.fields.itoken.name , coder = coderTokenValue } ) ( Json.field.optional.withDefault { fieldName = "starts" , toField = .starts - , description = Debug.todo "TODO: Add description" + , description = Text.fields.itoken.starts , coder = Json.set coderIBatchPTRValue , default = ( Set.empty, [] ) , defaultToString = always "[]" @@ -207,12 +295,30 @@ coderIToken = ( Json.field.optional.withDefault { fieldName = "ends" , toField = .ends - , description = Debug.todo "TODO: Add description" + , description = Text.fields.itoken.ends , coder = Json.set coderIBatchPTRValue , default = ( Set.empty, [] ) , defaultToString = always "[]" } ) + ( Json.field.optional.withDefault + { fieldName = "inFrontOf" + , toField = .inFrontOf + , description = Text.fields.itoken.inFrontOf + , coder = Json.set coderITokenPTRValue + , default = ( Set.empty, [] ) + , defaultToString = always "[]" + } + ) + ( Json.field.optional.withDefault + { fieldName = "behind" + , toField = .behind + , description = Text.fields.itoken.behind + , coder = Json.set coderITokenPTRValue + , default = ( Set.empty, [] ) + , defaultToString = always "[]" + } + ) coderITokenPTR : Json.Coder ITokenPTR coderITokenPTR = diff --git a/tests/Test/Filter/Timeline.elm b/tests/Test/Filter/Timeline.elm index e686e4f..7022738 100644 --- a/tests/Test/Filter/Timeline.elm +++ b/tests/Test/Filter/Timeline.elm @@ -428,7 +428,7 @@ suite = |> Filter.encode |> E.encode 0 |> D.decodeString Filter.decoder - |> Expect.equal (Ok filter) + |> Expect.equal (Ok (filter, [])) ) ] ] diff --git a/tests/Test/Tools/Iddict.elm b/tests/Test/Tools/Iddict.elm index ac376e8..708ecb7 100644 --- a/tests/Test/Tools/Iddict.elm +++ b/tests/Test/Tools/Iddict.elm @@ -3,6 +3,7 @@ module Test.Tools.Iddict exposing (..) import Expect import Fuzz exposing (Fuzzer) import Internal.Tools.Iddict as Iddict exposing (Iddict) +import Internal.Tools.Json as Json import Json.Decode as D import Json.Encode as E import Test exposing (..) @@ -73,21 +74,23 @@ empty = ) , test "JSON encode -> decode -> empty" (Iddict.empty - |> Iddict.encode identity - |> D.decodeValue (Iddict.decoder D.value) + |> Iddict.encode Json.value + |> D.decodeValue (Iddict.decoder Json.value) + |> Result.map Tuple.first |> Expect.equal (Ok Iddict.empty) |> always ) , test "JSON encode" (Iddict.empty - |> Iddict.encode identity + |> Iddict.encode Json.value |> E.encode 0 - |> Expect.equal "{\"cursor\":0,\"dict\":{}}" + |> Expect.equal "{\"dict\":{}}" |> always ) , test "JSON decode" - ("{\"cursor\":0,\"dict\":{}}" - |> D.decodeString (Iddict.decoder D.value) + ("{\"dict\":{}}" + |> D.decodeString (Iddict.decoder Json.value) + |> Result.map Tuple.first |> Expect.equal (Ok Iddict.empty) |> always ) @@ -170,8 +173,9 @@ singleton = "JSON encode -> decode -> singleton" (\single -> single - |> Iddict.encode E.int - |> D.decodeValue (Iddict.decoder D.int) + |> Iddict.encode Json.int + |> D.decodeValue (Iddict.decoder Json.int) + |> Result.map Tuple.first |> Expect.equal (Ok single) ) , fuzz Fuzz.int @@ -179,7 +183,7 @@ singleton = (\i -> Iddict.singleton i |> Tuple.second - |> Iddict.encode E.int + |> Iddict.encode Json.int |> E.encode 0 |> Expect.equal ("{\"cursor\":1,\"dict\":{\"0\":" ++ String.fromInt i ++ "}}") ) @@ -187,7 +191,8 @@ singleton = "JSON decode" (\i -> ("{\"cursor\":1,\"dict\":{\"0\":" ++ String.fromInt i ++ "}}") - |> D.decodeString (Iddict.decoder D.int) + |> D.decodeString (Iddict.decoder Json.int) + |> Result.map Tuple.first |> Tuple.pair 0 |> Expect.equal (Iddict.singleton i |> Tuple.mapSecond Ok) ) diff --git a/tests/Test/Values/Timeline.elm b/tests/Test/Values/Timeline.elm index 3bca09d..71fbdd7 100644 --- a/tests/Test/Values/Timeline.elm +++ b/tests/Test/Values/Timeline.elm @@ -8,6 +8,7 @@ import Json.Decode as D import Json.Encode as E import Test exposing (..) import Test.Filter.Timeline as TestFilter +import Internal.Tools.Json as Json fuzzer : Fuzzer Timeline @@ -188,8 +189,45 @@ suite = |> Timeline.mostRecentEventsFrom filter "token_4" |> Expect.equal [ [ "d", "e", "f" ] ] ) - , fuzz TestFilter.fuzzer + , fuzz3 TestFilter.fuzzer (Fuzz.list Fuzz.string) (Fuzz.pair (Fuzz.list Fuzz.string) (Fuzz.list Fuzz.string)) "Gaps can be bridged" + (\filter l1 (l2, l3) -> + Timeline.empty + |> Timeline.insert + { events = l1 + , filter = filter + , start = Just "token_1" + , end = "token_2" + } + |> Timeline.insert + { events = l3 + , filter = filter + , start = Just "token_3" + , end = "token_4" + } + |> Timeline.insert + { events = l2 + , filter = filter + , start = Just "token_2" + , end = "token_3" + } + |> Timeline.mostRecentEventsFrom filter "token_4" + |> Expect.equal [ List.concat [ l1, l2, l3 ] ] + ) + ] + , describe "JSON" + [ fuzz fuzzer "Encode + Decode gives same output" + (\timeline -> + timeline + |> Json.encode Timeline.coder + |> D.decodeValue (Json.decode Timeline.coder) + |> Result.map Tuple.first + |> Result.map (Timeline.mostRecentEvents Filter.pass) + |> Expect.equal (Ok <| Timeline.mostRecentEvents Filter.pass timeline) + ) + ] + , describe "Weird loops" + [ fuzz TestFilter.fuzzer "Weird loops stop looping" (\filter -> Timeline.empty |> Timeline.insert @@ -201,17 +239,20 @@ suite = |> Timeline.insert { events = [ "d", "e", "f" ] , filter = filter - , start = Just "token_3" - , end = "token_4" - } - |> Timeline.insert - { events = [ "g", "h" ] - , filter = filter , start = Just "token_2" , end = "token_3" } - |> Timeline.mostRecentEventsFrom filter "token_4" - |> Expect.equal [ [ "a", "b", "c", "g", "h", "d", "e", "f" ] ] + |> Timeline.insert + { events = [ "g", "h", "i" ] + , filter = filter + , start = Just "token_3" + , end = "token_2" + } + |> Timeline.mostRecentEventsFrom filter "token_2" + |> Expect.equal + [ [ "a", "b", "c" ] + , [ "d", "e", "f", "g", "h", "i" ] + ] ) ] ] From 33d98dd6ffcce5565078cc3c7f4d05064d56c462 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Mar 2024 10:51:10 +0100 Subject: [PATCH 18/24] Improve code readability Cleaning up unused imports + changing order of operations on a value that is 0 by default --- src/Internal/Tools/Iddict.elm | 6 ++---- src/Internal/Values/Timeline.elm | 2 -- tests/Test/Values/Timeline.elm | 1 - 3 files changed, 2 insertions(+), 7 deletions(-) diff --git a/src/Internal/Tools/Iddict.elm b/src/Internal/Tools/Iddict.elm index 5dd75bb..d534608 100644 --- a/src/Internal/Tools/Iddict.elm +++ b/src/Internal/Tools/Iddict.elm @@ -43,8 +43,6 @@ do not need to generate identifiers yourself. import FastDict as Dict exposing (Dict) import Internal.Config.Text as Text import Internal.Tools.Json as Json -import Json.Decode as D -import Json.Encode as E {-| The Iddict data type. @@ -66,8 +64,8 @@ coder x = { cursor = Dict.keys d |> List.maximum - |> Maybe.withDefault -1 - |> (+) 1 + |> Maybe.map ((+) 1) + |> Maybe.withDefault 0 |> max (Dict.size d) |> max c , dict = d diff --git a/src/Internal/Values/Timeline.elm b/src/Internal/Values/Timeline.elm index 5967d2b..0749529 100644 --- a/src/Internal/Values/Timeline.elm +++ b/src/Internal/Values/Timeline.elm @@ -72,8 +72,6 @@ import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) import Internal.Tools.Iddict as Iddict exposing (Iddict) import Internal.Tools.Json as Json import Internal.Config.Text as Text -import Json.Decode as D -import Json.Encode as E import Recursion import Recursion.Traverse import Set exposing (Set) diff --git a/tests/Test/Values/Timeline.elm b/tests/Test/Values/Timeline.elm index 71fbdd7..77f204f 100644 --- a/tests/Test/Values/Timeline.elm +++ b/tests/Test/Values/Timeline.elm @@ -5,7 +5,6 @@ import Fuzz exposing (Fuzzer) import Internal.Filter.Timeline as Filter exposing (Filter) import Internal.Values.Timeline as Timeline exposing (Batch, Timeline) import Json.Decode as D -import Json.Encode as E import Test exposing (..) import Test.Filter.Timeline as TestFilter import Internal.Tools.Json as Json From 792e60761aa3022d1bd88edfecf5dc25e0ac7554 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Mar 2024 11:08:42 +0100 Subject: [PATCH 19/24] Add addSync to Timeline --- src/Internal/Values/Timeline.elm | 19 ++++++- tests/Test/Values/Timeline.elm | 87 ++++++++++++++++++++++++++++++++ 2 files changed, 105 insertions(+), 1 deletion(-) diff --git a/src/Internal/Values/Timeline.elm b/src/Internal/Values/Timeline.elm index 0749529..0b8e31f 100644 --- a/src/Internal/Values/Timeline.elm +++ b/src/Internal/Values/Timeline.elm @@ -2,7 +2,7 @@ module Internal.Values.Timeline exposing ( Batch, Timeline , empty, singleton , mostRecentEvents, mostRecentEventsFrom - , insert + , insert, addSync , coder ) @@ -167,6 +167,23 @@ type Timeline type alias TokenValue = String +{-| Add a new batch as a sync +-} +addSync : Batch -> Timeline -> Timeline +addSync batch timeline = + case insertBatch batch timeline of + ( Timeline t, { start, end }) -> + let + old : ITokenPTR + old = t.mostRecentBatch + in + case Timeline { t | mostRecentBatch = end } of + tl -> + if old == start then + tl + else + connectITokenToIToken old start tl + coder : Json.Coder Timeline coder = Json.object5 diff --git a/tests/Test/Values/Timeline.elm b/tests/Test/Values/Timeline.elm index 77f204f..f55453d 100644 --- a/tests/Test/Values/Timeline.elm +++ b/tests/Test/Values/Timeline.elm @@ -254,4 +254,91 @@ suite = ] ) ] + , describe "Sync" + [ fuzz TestFilter.fuzzer "Sync fills gaps" + (\filter -> + Timeline.empty + |> Timeline.addSync + { events = [ "a", "b", "c" ] + , filter = filter + , start = Just "token_1" + , end = "token_2" + } + |> Timeline.addSync + { events = [ "f", "g", "h"] + , filter = filter + , start = Just "token_3" + , end = "token_4" + } + |> Timeline.insert + { events = [ "d", "e" ] + , filter = filter + , start = Just "token_2" + , end = "token_3" + } + |> Timeline.mostRecentEvents filter + |> Expect.equal [ [ "a", "b", "c", "d", "e", "f", "g", "h" ]] + ) + , fuzz TestFilter.fuzzer "Sync doesn't fill open gaps" + (\filter -> + Timeline.empty + |> Timeline.addSync + { events = [ "a", "b", "c" ] + , filter = filter + , start = Just "token_1" + , end = "token_2" + } + |> Timeline.addSync + { events = [ "f", "g", "h"] + , filter = filter + , start = Just "token_3" + , end = "token_4" + } + |> Timeline.mostRecentEvents filter + |> Expect.equal [ [ "f", "g", "h" ]] + ) + , fuzz3 (Fuzz.pair Fuzz.string Fuzz.string) fuzzer TestFilter.fuzzer "Getting /sync is the same as getting from the token" + (\(start, end) timeline filter -> + let + t : Timeline + t = Timeline.addSync + { events = [ "a", "b", "c" ] + , filter = filter + , start = Just start + , end = end + } + timeline + in + Expect.equal + (Timeline.mostRecentEvents filter t) + (Timeline.mostRecentEventsFrom filter end t) + ) + , fuzz TestFilter.fuzzer "Weird loops stop looping" + (\filter -> + Timeline.empty + |> Timeline.insert + { events = [ "a", "b", "c" ] + , filter = filter + , start = Just "token_1" + , end = "token_2" + } + |> Timeline.insert + { events = [ "d", "e", "f" ] + , filter = filter + , start = Just "token_2" + , end = "token_3" + } + |> Timeline.insert + { events = [ "g", "h", "i" ] + , filter = filter + , start = Just "token_3" + , end = "token_2" + } + |> Timeline.mostRecentEventsFrom filter "token_2" + |> Expect.equal + [ [ "a", "b", "c" ] + , [ "d", "e", "f", "g", "h", "i" ] + ] + ) + ] ] From d41c31e8c16e52e32c65f9c25ee48d11da6d152d Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Mar 2024 11:18:01 +0100 Subject: [PATCH 20/24] Allow Timeline fuzzers to simulate /sync --- tests/Test/Values/Timeline.elm | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/tests/Test/Values/Timeline.elm b/tests/Test/Values/Timeline.elm index f55453d..2dca2d0 100644 --- a/tests/Test/Values/Timeline.elm +++ b/tests/Test/Values/Timeline.elm @@ -44,6 +44,34 @@ fuzzer = ) Fuzz.string (Fuzz.listOfLengthBetween 0 4 fuzzerBatch) + , Fuzz.map2 + (\start batches -> + List.foldl + (\b ( s, f ) -> + ( b.end + , f >> Timeline.addSync { b | start = Just s, filter = globalFilter } + ) + ) + ( start, identity ) + batches + |> Tuple.second + ) + Fuzz.string + (Fuzz.listOfLengthBetween 0 10 fuzzerBatch) + , Fuzz.map2 + (\start batches -> + List.foldl + (\b ( s, f ) -> + ( b.end + , f >> Timeline.addSync { b | start = Just s, filter = Filter.and globalFilter b.filter } + ) + ) + ( start, identity ) + batches + |> Tuple.second + ) + Fuzz.string + (Fuzz.listOfLengthBetween 0 4 fuzzerBatch) ] |> Fuzz.listOfLengthBetween 0 10 |> Fuzz.map (List.foldl (<|) Timeline.empty) From ccefa2ed9ba923867c79ec8fc5ee46d6726e5df2 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Mar 2024 11:28:04 +0100 Subject: [PATCH 21/24] Add documentation --- src/Internal/Tools/Iddict.elm | 2 ++ src/Internal/Values/Timeline.elm | 30 ++++++++++++++++++++++++++++-- 2 files changed, 30 insertions(+), 2 deletions(-) diff --git a/src/Internal/Tools/Iddict.elm b/src/Internal/Tools/Iddict.elm index d534608..96efd31 100644 --- a/src/Internal/Tools/Iddict.elm +++ b/src/Internal/Tools/Iddict.elm @@ -53,6 +53,8 @@ type Iddict a , dict : Dict Int a } +{-| Define how an Iddict can be encoded and decoded to and from a JSON value. +-} coder : Json.Coder a -> Json.Coder (Iddict a) coder x = Json.object2 diff --git a/src/Internal/Values/Timeline.elm b/src/Internal/Values/Timeline.elm index 0b8e31f..ddf2307 100644 --- a/src/Internal/Values/Timeline.elm +++ b/src/Internal/Values/Timeline.elm @@ -3,7 +3,7 @@ module Internal.Values.Timeline exposing , empty, singleton , mostRecentEvents, mostRecentEventsFrom , insert, addSync - , coder + , coder, encode, decoder ) {-| @@ -184,6 +184,8 @@ addSync batch timeline = else connectITokenToIToken old start tl +{-| Define how a Timeline can be encoded and decoded to and from a JSON value. +-} coder : Json.Coder Timeline coder = Json.object5 @@ -235,6 +237,8 @@ coder = } ) +{-| Define how to encode and decode a IBatch to and from a JSON value. +-} coderIBatch : Json.Coder IBatch coderIBatch = Json.object4 @@ -271,6 +275,8 @@ coderIBatch = } ) +{-| Define how to encode and decode a IBatchPTR to and from a JSON value. +-} coderIBatchPTR : Json.Coder IBatchPTR coderIBatchPTR = Json.map @@ -281,9 +287,13 @@ coderIBatchPTR = } coderIBatchPTRValue +{-| Define how to encode and decode a IBatchPTRValue to and from a JSON value. +-} coderIBatchPTRValue : Json.Coder IBatchPTRValue coderIBatchPTRValue = Json.int +{-| Define how to encode and decode a IToken to and from a JSON value. +-} coderIToken : Json.Coder IToken coderIToken = Json.object5 @@ -335,6 +345,8 @@ coderIToken = } ) +{-| Define how to encode and decode a ITokenPTR to and from a JSON value. +-} coderITokenPTR : Json.Coder ITokenPTR coderITokenPTR = Json.maybe coderITokenPTRValue @@ -361,9 +373,13 @@ coderITokenPTR = ) } +{-| Define how to encode and decode a ITokenPTRValue to and from a JSON value. +-} coderITokenPTRValue : Json.Coder ITokenPTRValue coderITokenPTRValue = Json.string +{-| Define how to encode and decode a TokenValue to and from a JSON value. +-} coderTokenValue : Json.Coder TokenValue coderTokenValue = Json.string @@ -438,6 +454,10 @@ connectITokenToIToken pointer1 pointer2 (Timeline tl) = ( _, _ ) -> Timeline tl +{-| Timeline JSON decoder that helps decode a Timeline from JSON. +-} +decoder : Json.Decoder Timeline +decoder = Json.decode coder {-| Create a new empty timeline. -} @@ -451,6 +471,10 @@ empty = , tokens = Hashdict.empty .name } +{-| Directly encode a Timeline into a JSON value. +-} +encode : Json.Encoder Timeline +encode = Json.encode coder {-| Get an IBatch from the Timeline. -} @@ -584,7 +608,9 @@ mostRecentEvents : Filter -> Timeline -> List (List String) mostRecentEvents filter (Timeline timeline) = mostRecentFrom filter (Timeline timeline) timeline.mostRecentBatch - +{-| Instead of finding the most recent events from the latest sync, users can +also find the most recent events given a token value. +-} mostRecentEventsFrom : Filter -> ITokenPTRValue -> Timeline -> List (List String) mostRecentEventsFrom filter tokenName timeline = mostRecentFrom filter timeline (ITokenPTR tokenName) From db6573180b3f8bee16b32147c29b7e18ca76b808 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Mar 2024 11:52:12 +0100 Subject: [PATCH 22/24] elm-format --- elm.json | 5 +- src/Internal/Config/Text.elm | 6 +- src/Internal/Filter/Timeline.elm | 29 ++++---- src/Internal/Tools/Iddict.elm | 13 ++-- src/Internal/Tools/Json.elm | 20 +++--- src/Internal/Values/Timeline.elm | 113 +++++++++++++++++++------------ tests/Test/Filter/Timeline.elm | 2 +- tests/Test/Values/Timeline.elm | 59 +++++++++------- 8 files changed, 146 insertions(+), 101 deletions(-) diff --git a/elm.json b/elm.json index 5cb6da1..214e084 100644 --- a/elm.json +++ b/elm.json @@ -10,12 +10,14 @@ "Internal.Config.Log", "Internal.Config.Phantom", "Internal.Config.Text", + "Internal.Filter.Timeline", "Internal.Tools.DecodeExtra", "Internal.Tools.EncodeExtra", "Internal.Tools.Hashdict", "Internal.Tools.Iddict", "Internal.Tools.Json", "Internal.Tools.Mashdict", + "Internal.Tools.RationalOrder", "Internal.Tools.Timestamp", "Internal.Tools.VersionControl", "Internal.Values.Context", @@ -27,7 +29,8 @@ "Internal.Values.Vault", "Matrix", "Matrix.Event", - "Matrix.Settings" + "Matrix.Settings", + "Types" ], "elm-version": "0.19.0 <= v < 0.20.0", "dependencies": { diff --git a/src/Internal/Config/Text.elm b/src/Internal/Config/Text.elm index f3c6354..e2f4ed5 100644 --- a/src/Internal/Config/Text.elm +++ b/src/Internal/Config/Text.elm @@ -485,18 +485,16 @@ leakingValueFound leaking_value = "Found leaking value : " ++ leaking_value -{-| --} +{-| -} logs : { keyIsNotAnInt : String -> String } logs = { keyIsNotAnInt = - (\key -> + \key -> String.concat [ "Encountered a key `" , key , "` that cannot be converted to an Int" ] - ) } diff --git a/src/Internal/Filter/Timeline.elm b/src/Internal/Filter/Timeline.elm index 79875bf..a4231bf 100644 --- a/src/Internal/Filter/Timeline.elm +++ b/src/Internal/Filter/Timeline.elm @@ -161,52 +161,57 @@ and (Filter f1) (Filter f2) = else stdAnd + +{-| Define how to encode and decode a Timeline Filter to and from a JSON value. +-} coder : Json.Coder Filter coder = Json.object4 { name = Text.docs.timelineFilter.name , description = Text.docs.timelineFilter.description , init = - (\a b c d -> + \a b c d -> Filter - { senders = a, sendersAllowOthers = b - , types = c, typesAllowOthers = d + { senders = a + , sendersAllowOthers = b + , types = c + , typesAllowOthers = d } - ) } - ( Json.field.optional.withDefault + (Json.field.optional.withDefault { fieldName = "senders" - , toField = (\(Filter f) -> f.senders) + , toField = \(Filter f) -> f.senders , description = Text.fields.timelineFilter.senders , coder = Json.set Json.string , default = ( Set.empty, [] ) , defaultToString = always "[]" } ) - ( Json.field.required + (Json.field.required { fieldName = "sendersAllowOthers" - , toField = (\(Filter f) -> f.sendersAllowOthers) + , toField = \(Filter f) -> f.sendersAllowOthers , description = Text.fields.timelineFilter.sendersAllowOthers , coder = Json.bool } ) - ( Json.field.optional.withDefault + (Json.field.optional.withDefault { fieldName = "types" - , toField = (\(Filter f) -> f.types) + , toField = \(Filter f) -> f.types , description = Text.fields.timelineFilter.types , coder = Json.set Json.string , default = ( Set.empty, [] ) , defaultToString = always "[]" } ) - ( Json.field.required + (Json.field.required { fieldName = "typesAllowOthers" - , toField = (\(Filter f) -> f.typesAllowOthers) + , toField = \(Filter f) -> f.typesAllowOthers , description = Text.fields.timelineFilter.typesAllowOthers , coder = Json.bool } ) + {-| Decode a Filter from a JSON value. -} decoder : Json.Decoder Filter diff --git a/src/Internal/Tools/Iddict.elm b/src/Internal/Tools/Iddict.elm index 96efd31..da718f2 100644 --- a/src/Internal/Tools/Iddict.elm +++ b/src/Internal/Tools/Iddict.elm @@ -53,6 +53,7 @@ type Iddict a , dict : Dict Int a } + {-| Define how an Iddict can be encoded and decoded to and from a JSON value. -} coder : Json.Coder a -> Json.Coder (Iddict a) @@ -61,7 +62,7 @@ coder x = { name = Text.docs.iddict.name , description = Text.docs.iddict.description , init = - (\c d -> + \c d -> Iddict { cursor = Dict.keys d @@ -72,25 +73,25 @@ coder x = |> max c , dict = d } - ) } - ( Json.field.optional.withDefault + (Json.field.optional.withDefault { fieldName = "cursor" - , toField = (\(Iddict i) -> i.cursor) + , toField = \(Iddict i) -> i.cursor , description = Text.fields.iddict.cursor , coder = Json.int , default = ( 0, [] ) , defaultToString = String.fromInt } ) - ( Json.field.required + (Json.field.required { fieldName = "dict" - , toField = (\(Iddict i) -> i.dict) + , toField = \(Iddict i) -> i.dict , description = Text.fields.iddict.dict , coder = Json.fastIntDict x } ) + {-| Decode an id-dict from a JSON value. -} decoder : Json.Coder a -> Json.Decoder (Iddict a) diff --git a/src/Internal/Tools/Json.elm b/src/Internal/Tools/Json.elm index 8876ca5..246e29d 100644 --- a/src/Internal/Tools/Json.elm +++ b/src/Internal/Tools/Json.elm @@ -294,6 +294,7 @@ fastDict (Coder old) = , docs = DocsDict old.docs } + {-| Define a fast dict where the keys are integers, not strings. -} fastIntDict : Coder value -> Coder (FastDict.Dict Int value) @@ -308,8 +309,8 @@ fastIntDict (Coder old) = ( items |> List.map (Tuple.mapSecond Tuple.first) |> List.filterMap - (\(k, v) -> - Maybe.map (\a -> (a, v)) (String.toInt k) + (\( k, v ) -> + Maybe.map (\a -> ( a, v )) (String.toInt k) ) |> FastDict.fromList , List.concat @@ -320,7 +321,7 @@ fastIntDict (Coder old) = case String.toInt k of Just _ -> True - + Nothing -> False ) @@ -335,6 +336,7 @@ fastIntDict (Coder old) = , docs = DocsIntDict old.docs } + {-| Create a new field using any of the three provided options. For example, suppose we are creating a `Field String User` to represent the @@ -509,12 +511,13 @@ list (Coder old) = , docs = DocsList old.docs } + {-| Define a list that has at least one value -} -listWithOne : Coder a -> Coder (a, List a) +listWithOne : Coder a -> Coder ( a, List a ) listWithOne (Coder old) = Coder - { encoder = (\(h, t) -> E.list old.encoder (h :: t)) + { encoder = \( h, t ) -> E.list old.encoder (h :: t) , decoder = old.decoder |> D.list @@ -523,10 +526,10 @@ listWithOne (Coder old) = case items of [] -> D.fail "Expected at least one value in list" - - ( h, l1) :: t -> + + ( h, l1 ) :: t -> D.succeed - ( (h, List.map Tuple.first items) + ( ( h, List.map Tuple.first items ) , List.concatMap Tuple.second t |> List.append l1 ) @@ -1170,6 +1173,7 @@ set (Coder data) = , docs = DocsSet data.docs } + {-| Define a slow dict from the `elm/core` library. -} slowDict : Coder value -> Coder (SlowDict.Dict String value) diff --git a/src/Internal/Values/Timeline.elm b/src/Internal/Values/Timeline.elm index ddf2307..9bded76 100644 --- a/src/Internal/Values/Timeline.elm +++ b/src/Internal/Values/Timeline.elm @@ -2,7 +2,7 @@ module Internal.Values.Timeline exposing ( Batch, Timeline , empty, singleton , mostRecentEvents, mostRecentEventsFrom - , insert, addSync + , addSync, insert , coder, encode, decoder ) @@ -67,11 +67,11 @@ events! -} import FastDict as Dict exposing (Dict) +import Internal.Config.Text as Text import Internal.Filter.Timeline as Filter exposing (Filter) import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) import Internal.Tools.Iddict as Iddict exposing (Iddict) import Internal.Tools.Json as Json -import Internal.Config.Text as Text import Recursion import Recursion.Traverse import Set exposing (Set) @@ -82,6 +82,7 @@ that require an insertion, generally require this data type. If the `start` value is `Nothing`, it is either the start of the timeline or the start of the timeline part that the user is allowed to view. + -} type alias Batch = { events : List String @@ -167,22 +168,26 @@ type Timeline type alias TokenValue = String + {-| Add a new batch as a sync -} addSync : Batch -> Timeline -> Timeline addSync batch timeline = case insertBatch batch timeline of - ( Timeline t, { start, end }) -> + ( Timeline t, { start, end } ) -> let old : ITokenPTR - old = t.mostRecentBatch + old = + t.mostRecentBatch in - case Timeline { t | mostRecentBatch = end } of - tl -> - if old == start then - tl - else - connectITokenToIToken old start tl + case Timeline { t | mostRecentBatch = end } of + tl -> + if old == start then + tl + + else + connectITokenToIToken old start tl + {-| Define how a Timeline can be encoded and decoded to and from a JSON value. -} @@ -192,51 +197,54 @@ coder = { name = Text.docs.timeline.name , description = Text.docs.timeline.description , init = - (\a b c d e -> + \a b c d e -> Timeline - { batches = a, events = b, filledBatches = c - , mostRecentBatch = d, tokens = e + { batches = a + , events = b + , filledBatches = c + , mostRecentBatch = d + , tokens = e } - ) } - ( Json.field.required + (Json.field.required { fieldName = "batches" - , toField = (\(Timeline t) -> t.batches) + , toField = \(Timeline t) -> t.batches , description = Text.fields.timeline.batches , coder = Iddict.coder coderIBatch } ) - ( Json.field.required + (Json.field.required { fieldName = "events" - , toField = (\(Timeline t) -> t.events) + , toField = \(Timeline t) -> t.events , description = Text.fields.timeline.events , coder = Json.fastDict (Json.listWithOne coderIBatchPTR) } ) - ( Json.field.optional.withDefault + (Json.field.optional.withDefault { fieldName = "filledBatches" - , toField = (\(Timeline t) -> t.filledBatches) + , toField = \(Timeline t) -> t.filledBatches , description = Text.fields.timeline.filledBatches , coder = Json.int , default = ( 0, [] ) , defaultToString = String.fromInt } ) - ( Json.field.required + (Json.field.required { fieldName = "mostRecentBatch" - , toField = (\(Timeline t) -> t.mostRecentBatch) + , toField = \(Timeline t) -> t.mostRecentBatch , description = Text.fields.timeline.mostRecentBatch , coder = coderITokenPTR } ) - ( Json.field.required + (Json.field.required { fieldName = "tokens" - , toField = (\(Timeline t) -> t.tokens) + , toField = \(Timeline t) -> t.tokens , description = Text.fields.timeline.tokens , coder = Hashdict.coder .name coderIToken } ) + {-| Define how to encode and decode a IBatch to and from a JSON value. -} coderIBatch : Json.Coder IBatch @@ -246,28 +254,28 @@ coderIBatch = , description = Text.docs.ibatch.description , init = IBatch } - ( Json.field.required + (Json.field.required { fieldName = "events" , toField = .events , description = Text.fields.ibatch.events , coder = Json.list Json.string } ) - ( Json.field.required + (Json.field.required { fieldName = "filter" , toField = .filter , description = Text.fields.ibatch.filter , coder = Filter.coder } ) - ( Json.field.required + (Json.field.required { fieldName = "start" , toField = .start , description = Text.fields.ibatch.start , coder = coderITokenPTR } ) - ( Json.field.required + (Json.field.required { fieldName = "end" , toField = .end , description = Text.fields.ibatch.end @@ -275,6 +283,7 @@ coderIBatch = } ) + {-| Define how to encode and decode a IBatchPTR to and from a JSON value. -} coderIBatchPTR : Json.Coder IBatchPTR @@ -282,15 +291,18 @@ coderIBatchPTR = Json.map { name = Text.docs.itoken.name , description = Text.docs.itoken.description - , back = (\(IBatchPTR value) -> value) + , back = \(IBatchPTR value) -> value , forth = IBatchPTR } coderIBatchPTRValue + {-| Define how to encode and decode a IBatchPTRValue to and from a JSON value. -} coderIBatchPTRValue : Json.Coder IBatchPTRValue -coderIBatchPTRValue = Json.int +coderIBatchPTRValue = + Json.int + {-| Define how to encode and decode a IToken to and from a JSON value. -} @@ -301,14 +313,14 @@ coderIToken = , description = Text.docs.itoken.description , init = IToken } - ( Json.field.required + (Json.field.required { fieldName = "name" , toField = .name , description = Text.fields.itoken.name , coder = coderTokenValue } ) - ( Json.field.optional.withDefault + (Json.field.optional.withDefault { fieldName = "starts" , toField = .starts , description = Text.fields.itoken.starts @@ -317,7 +329,7 @@ coderIToken = , defaultToString = always "[]" } ) - ( Json.field.optional.withDefault + (Json.field.optional.withDefault { fieldName = "ends" , toField = .ends , description = Text.fields.itoken.ends @@ -326,7 +338,7 @@ coderIToken = , defaultToString = always "[]" } ) - ( Json.field.optional.withDefault + (Json.field.optional.withDefault { fieldName = "inFrontOf" , toField = .inFrontOf , description = Text.fields.itoken.inFrontOf @@ -335,7 +347,7 @@ coderIToken = , defaultToString = always "[]" } ) - ( Json.field.optional.withDefault + (Json.field.optional.withDefault { fieldName = "behind" , toField = .behind , description = Text.fields.itoken.behind @@ -345,6 +357,7 @@ coderIToken = } ) + {-| Define how to encode and decode a ITokenPTR to and from a JSON value. -} coderITokenPTR : Json.Coder ITokenPTR @@ -354,34 +367,37 @@ coderITokenPTR = { name = Text.mappings.itokenPTR.name , description = Text.mappings.itokenPTR.description , back = - (\itokenptr -> + \itokenptr -> case itokenptr of ITokenPTR name -> Just name - + StartOfTimeline -> Nothing - ) , forth = - (\value -> + \value -> case value of Just name -> ITokenPTR name - + Nothing -> StartOfTimeline - ) } + {-| Define how to encode and decode a ITokenPTRValue to and from a JSON value. -} coderITokenPTRValue : Json.Coder ITokenPTRValue -coderITokenPTRValue = Json.string +coderITokenPTRValue = + Json.string + {-| Define how to encode and decode a TokenValue to and from a JSON value. -} coderTokenValue : Json.Coder TokenValue -coderTokenValue = Json.string +coderTokenValue = + Json.string + {-| Append a token at the end of a batch. -} @@ -454,10 +470,13 @@ connectITokenToIToken pointer1 pointer2 (Timeline tl) = ( _, _ ) -> Timeline tl + {-| Timeline JSON decoder that helps decode a Timeline from JSON. -} decoder : Json.Decoder Timeline -decoder = Json.decode coder +decoder = + Json.decode coder + {-| Create a new empty timeline. -} @@ -471,10 +490,13 @@ empty = , tokens = Hashdict.empty .name } + {-| Directly encode a Timeline into a JSON value. -} encode : Json.Encoder Timeline -encode = Json.encode coder +encode = + Json.encode coder + {-| Get an IBatch from the Timeline. -} @@ -608,6 +630,7 @@ mostRecentEvents : Filter -> Timeline -> List (List String) mostRecentEvents filter (Timeline timeline) = mostRecentFrom filter (Timeline timeline) timeline.mostRecentBatch + {-| Instead of finding the most recent events from the latest sync, users can also find the most recent events given a token value. -} diff --git a/tests/Test/Filter/Timeline.elm b/tests/Test/Filter/Timeline.elm index 7022738..6e880e7 100644 --- a/tests/Test/Filter/Timeline.elm +++ b/tests/Test/Filter/Timeline.elm @@ -428,7 +428,7 @@ suite = |> Filter.encode |> E.encode 0 |> D.decodeString Filter.decoder - |> Expect.equal (Ok (filter, [])) + |> Expect.equal (Ok ( filter, [] )) ) ] ] diff --git a/tests/Test/Values/Timeline.elm b/tests/Test/Values/Timeline.elm index 2dca2d0..e1a9fff 100644 --- a/tests/Test/Values/Timeline.elm +++ b/tests/Test/Values/Timeline.elm @@ -3,11 +3,11 @@ module Test.Values.Timeline exposing (..) import Expect import Fuzz exposing (Fuzzer) import Internal.Filter.Timeline as Filter exposing (Filter) +import Internal.Tools.Json as Json import Internal.Values.Timeline as Timeline exposing (Batch, Timeline) import Json.Decode as D import Test exposing (..) import Test.Filter.Timeline as TestFilter -import Internal.Tools.Json as Json fuzzer : Fuzzer Timeline @@ -216,9 +216,11 @@ suite = |> Timeline.mostRecentEventsFrom filter "token_4" |> Expect.equal [ [ "d", "e", "f" ] ] ) - , fuzz3 TestFilter.fuzzer (Fuzz.list Fuzz.string) (Fuzz.pair (Fuzz.list Fuzz.string) (Fuzz.list Fuzz.string)) + , fuzz3 TestFilter.fuzzer + (Fuzz.list Fuzz.string) + (Fuzz.pair (Fuzz.list Fuzz.string) (Fuzz.list Fuzz.string)) "Gaps can be bridged" - (\filter l1 (l2, l3) -> + (\filter l1 ( l2, l3 ) -> Timeline.empty |> Timeline.insert { events = l1 @@ -243,7 +245,8 @@ suite = ) ] , describe "JSON" - [ fuzz fuzzer "Encode + Decode gives same output" + [ fuzz fuzzer + "Encode + Decode gives same output" (\timeline -> timeline |> Json.encode Timeline.coder @@ -254,7 +257,8 @@ suite = ) ] , describe "Weird loops" - [ fuzz TestFilter.fuzzer "Weird loops stop looping" + [ fuzz TestFilter.fuzzer + "Weird loops stop looping" (\filter -> Timeline.empty |> Timeline.insert @@ -283,7 +287,8 @@ suite = ) ] , describe "Sync" - [ fuzz TestFilter.fuzzer "Sync fills gaps" + [ fuzz TestFilter.fuzzer + "Sync fills gaps" (\filter -> Timeline.empty |> Timeline.addSync @@ -293,7 +298,7 @@ suite = , end = "token_2" } |> Timeline.addSync - { events = [ "f", "g", "h"] + { events = [ "f", "g", "h" ] , filter = filter , start = Just "token_3" , end = "token_4" @@ -305,9 +310,10 @@ suite = , end = "token_3" } |> Timeline.mostRecentEvents filter - |> Expect.equal [ [ "a", "b", "c", "d", "e", "f", "g", "h" ]] + |> Expect.equal [ [ "a", "b", "c", "d", "e", "f", "g", "h" ] ] ) - , fuzz TestFilter.fuzzer "Sync doesn't fill open gaps" + , fuzz TestFilter.fuzzer + "Sync doesn't fill open gaps" (\filter -> Timeline.empty |> Timeline.addSync @@ -317,31 +323,36 @@ suite = , end = "token_2" } |> Timeline.addSync - { events = [ "f", "g", "h"] + { events = [ "f", "g", "h" ] , filter = filter , start = Just "token_3" , end = "token_4" } |> Timeline.mostRecentEvents filter - |> Expect.equal [ [ "f", "g", "h" ]] + |> Expect.equal [ [ "f", "g", "h" ] ] ) - , fuzz3 (Fuzz.pair Fuzz.string Fuzz.string) fuzzer TestFilter.fuzzer "Getting /sync is the same as getting from the token" - (\(start, end) timeline filter -> + , fuzz3 (Fuzz.pair Fuzz.string Fuzz.string) + fuzzer + TestFilter.fuzzer + "Getting /sync is the same as getting from the token" + (\( start, end ) timeline filter -> let t : Timeline - t = Timeline.addSync - { events = [ "a", "b", "c" ] - , filter = filter - , start = Just start - , end = end - } - timeline + t = + Timeline.addSync + { events = [ "a", "b", "c" ] + , filter = filter + , start = Just start + , end = end + } + timeline in - Expect.equal - (Timeline.mostRecentEvents filter t) - (Timeline.mostRecentEventsFrom filter end t) + Expect.equal + (Timeline.mostRecentEvents filter t) + (Timeline.mostRecentEventsFrom filter end t) ) - , fuzz TestFilter.fuzzer "Weird loops stop looping" + , fuzz TestFilter.fuzzer + "Weird loops stop looping" (\filter -> Timeline.empty |> Timeline.insert From 5856084b454df34495678f7d4f33bce81ef8b6c5 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Mar 2024 11:53:24 +0100 Subject: [PATCH 23/24] Remove unused RationalOrder module Kill your darlings, I guess. :( --- src/Internal/Tools/RationalOrder.elm | 151 ---------------- tests/Test/Tools/RationalOrder.elm | 256 --------------------------- 2 files changed, 407 deletions(-) delete mode 100644 src/Internal/Tools/RationalOrder.elm delete mode 100644 tests/Test/Tools/RationalOrder.elm diff --git a/src/Internal/Tools/RationalOrder.elm b/src/Internal/Tools/RationalOrder.elm deleted file mode 100644 index 4216b5b..0000000 --- a/src/Internal/Tools/RationalOrder.elm +++ /dev/null @@ -1,151 +0,0 @@ -module Internal.Tools.RationalOrder exposing (..) - -{-| - - -# Rational order - -The rational order module simulates the properties of the order of rational -numbers: all values have a clear direct ordering, but one can always gain a -new number in-between two existing numbers. - -While this property is similarly achievable with floats, the Float type has a -precision limit and it is therefor more desirable to achieve the same property -using an Elm type that uses Int types for comparison. - -Given the design of the order, the best case comparison design is O(1), and the -worst case comparison is O(log(n)). The worst case relies on recursively -creating two values a and b, create two new numbers in-between, and repeat. - --} - -import Recursion exposing (base, recurse, recurseThen) - - -{-| The RationalOrder consists of two items: a number for ordering and a -tie-breaking next RationalOrder type for when two RationalOrders have the same -number. - -When the next RationalOrder is Nothing, it should be considered -infinite. - --} -type RationalOrder - = With Int (Maybe RationalOrder) - - -{-| Find a new value that comes after a given value. For optimization reasons, -this will find the nearest number at the highest level. --} -after : RationalOrder -> RationalOrder -after (With i _) = - With (i + 1) Nothing - - -{-| Find a new value that comes before a given value. For optimization reasons, -this will find the nearest number at the highest level. --} -before : RationalOrder -> RationalOrder -before (With i _) = - With (i - 1) Nothing - - -{-| Find a new value in-between two existing values. The inputs don't need to be -ordered. --} -between : RationalOrder -> RationalOrder -> RationalOrder -between x y = - Recursion.runRecursion - (\orders -> - case orders of - ( Nothing, Nothing ) -> - base (With 0 Nothing) - - ( Just o1, Nothing ) -> - base (before o1) - - ( Nothing, Just o2 ) -> - base (before o2) - - ( Just ((With i1 n1) as o1), Just ((With i2 n2) as o2) ) -> - case Basics.compare i1 i2 of - EQ -> - recurseThen ( n1, n2 ) - (base << With i1 << Maybe.Just) - - LT -> - case compare (after o1) o2 of - LT -> - base (after o1) - - _ -> - Maybe.map after n1 - |> Maybe.withDefault (With 0 Nothing) - |> Maybe.Just - |> With i1 - |> base - - GT -> - case compare (after o2) o1 of - LT -> - base (after o2) - - _ -> - Maybe.map after n2 - |> Maybe.withDefault (With 0 Nothing) - |> Maybe.Just - |> With i2 - |> base - ) - ( Just x, Just y ) - - -compare : RationalOrder -> RationalOrder -> Basics.Order -compare x y = - Recursion.runRecursion - (\( With i1 n1, With i2 n2 ) -> - case ( Basics.compare i1 i2, n1, n2 ) of - ( EQ, Just o1, Just o2 ) -> - recurse ( o1, o2 ) - - ( EQ, Just _, Nothing ) -> - base GT - - ( EQ, Nothing, Just _ ) -> - base LT - - ( EQ, Nothing, Nothing ) -> - base EQ - - ( LT, _, _ ) -> - base LT - - ( GT, _, _ ) -> - base GT - ) - ( x, y ) - - -fromList : List Int -> Maybe RationalOrder -fromList = - Recursion.runRecursion - (\items -> - case items of - [] -> - base Nothing - - head :: tail -> - recurseThen tail (With head >> Maybe.Just >> base) - ) - - -toList : RationalOrder -> List Int -toList = - Recursion.runRecursion - (\(With i next) -> - case next of - Nothing -> - base [ i ] - - Just n -> - recurseThen n ((::) i >> base) - ) diff --git a/tests/Test/Tools/RationalOrder.elm b/tests/Test/Tools/RationalOrder.elm deleted file mode 100644 index a908d6a..0000000 --- a/tests/Test/Tools/RationalOrder.elm +++ /dev/null @@ -1,256 +0,0 @@ -module Test.Tools.RationalOrder exposing (..) - -import Expect -import Fuzz exposing (Fuzzer) -import Internal.Tools.RationalOrder as RO exposing (RationalOrder(..)) -import Test exposing (..) - - -fuzzer : Fuzzer RationalOrder -fuzzer = - Fuzz.map2 With Fuzz.int (Fuzz.lazy (\_ -> Fuzz.maybe fuzzer)) - - -twoUnequal : Fuzzer ( RationalOrder, RationalOrder ) -twoUnequal = - fuzzer - |> Fuzz.andThen - (\o -> - Fuzz.map2 - (\o1 o2 -> - if RO.compare o1 o2 == LT then - ( o1, o2 ) - - else - ( o2, o1 ) - ) - (Fuzz.constant o) - (Fuzz.filter ((/=) o) fuzzer) - ) - - -suite : Test -suite = - describe "RationalOrder" - [ describe "Semantic truths" - [ describe "After is always greater" - [ fuzz fuzzer - "Forwards" - (\o -> - Expect.equal LT (RO.compare o (RO.after o)) - ) - , fuzz fuzzer - "Backwards" - (\o -> - Expect.equal GT (RO.compare (RO.after o) o) - ) - ] - , describe "Before is always lesser" - [ fuzz fuzzer - "Forwards" - (\o -> - Expect.equal GT (RO.compare o (RO.before o)) - ) - , fuzz fuzzer - "Backwards" - (\o -> - Expect.equal LT (RO.compare (RO.before o) o) - ) - ] - , describe "Two unequal == two unequal" - [ fuzz twoUnequal - "Forwards" - (\( small, big ) -> - Expect.equal LT (RO.compare small big) - ) - , fuzz twoUnequal - "Backwards" - (\( small, big ) -> - Expect.equal GT (RO.compare big small) - ) - ] - , describe "compare" - [ fuzz2 fuzzer - fuzzer - "EQ iff same value" - (\o1 o2 -> - Expect.equal - (o1 == o2) - (RO.compare o1 o2 == EQ) - ) - , fuzz2 fuzzer - fuzzer - "LT iff opposite GT" - (\o1 o2 -> - Expect.equal - (RO.compare o1 o2 == LT) - (RO.compare o2 o1 == GT) - ) - ] - , describe "Between is always between" - [ fuzz twoUnequal - "Less than first - forwards" - (\( small, big ) -> - RO.between small big - |> RO.compare small - |> Expect.equal LT - ) - , fuzz twoUnequal - "Less than first - backwards" - (\( small, big ) -> - small - |> RO.compare (RO.between small big) - |> Expect.equal GT - ) - , fuzz twoUnequal - "Less than second - forwards" - (\( small, big ) -> - RO.between small big - |> RO.compare big - |> Expect.equal GT - ) - , fuzz twoUnequal - "Less than second - backwards" - (\( small, big ) -> - big - |> RO.compare (RO.between small big) - |> Expect.equal LT - ) - ] - ] - , describe "Between creates between" - [ test "With 0 Nothing <--> With 1 Nothing" - (\() -> - RO.between (With 0 Nothing) (With 1 Nothing) - |> Expect.equal (With 0 (Just (With 0 Nothing))) - ) - , test "With 1 Nothing <--> With 0 Nothing" - (\() -> - RO.between (With 1 Nothing) (With 0 Nothing) - |> Expect.equal (With 0 (Just (With 0 Nothing))) - ) - , test "With 0 is filled between With 1 Nothing" - (\() -> - With 0 Nothing - |> RO.between (With 1 Nothing) - |> RO.between (With 1 Nothing) - |> RO.between (With 1 Nothing) - |> RO.between (With 1 Nothing) - |> RO.between (With 1 Nothing) - |> RO.between (With 1 Nothing) - |> Expect.equal (With 0 (Just (With 5 Nothing))) - ) - , test "Will start counting high level as soon as possible" - (\() -> - With 0 Nothing - |> RO.between (With 1 Nothing) - |> RO.between (With 1 Nothing) - |> RO.between (With 1 Nothing) - |> RO.between (With 1 Nothing) - |> RO.between (With 1 Nothing) - |> RO.between (With 1 Nothing) - |> RO.between (With 5 Nothing) - |> RO.between (With 5 Nothing) - |> Expect.equal (With 2 Nothing) - ) - , test "Will start counting high level, then return lower level" - (\() -> - With 0 Nothing - |> RO.between (With 1 Nothing) - |> RO.between (With 1 Nothing) - |> RO.between (With 1 Nothing) - |> RO.between (With 1 Nothing) - |> RO.between (With 1 Nothing) - |> RO.between (With 1 Nothing) - |> RO.between (With 5 Nothing) - |> RO.between (With 5 Nothing) - |> RO.between (With 5 Nothing) - |> RO.between (With 5 Nothing) - |> RO.between (With 5 Nothing) - |> RO.between (With 5 Nothing) - |> RO.between (With 5 Nothing) - |> RO.between (With 5 Nothing) - |> RO.between (With 5 Nothing) - |> RO.between (With 5 Nothing) - |> RO.between (With 5 Nothing) - |> Expect.equal (With 4 (Just (With 6 Nothing))) - ) - , fuzz2 fuzzer - fuzzer - "Between is commutative" - (\o1 o2 -> - Expect.equal (RO.between o1 o2) (RO.between o2 o1) - ) - ] - , describe "After" - [ fuzz Fuzz.int - "One more - level 1" - (\a -> - Expect.equal - (RO.after <| With a Nothing) - (With (a + 1) Nothing) - ) - , fuzz2 Fuzz.int - Fuzz.int - "One more - level 2" - (\a b -> - Expect.equal - (RO.after <| With a <| Just <| With b Nothing) - (With (a + 1) Nothing) - ) - , fuzz3 Fuzz.int - Fuzz.int - Fuzz.int - "One more - level 3" - (\a b c -> - Expect.equal - (RO.after <| With a <| Just <| With b <| Just <| With c Nothing) - (With (a + 1) Nothing) - ) - ] - , describe "Before" - [ fuzz Fuzz.int - "One less - level 1" - (\a -> - Expect.equal - (RO.before <| With a Nothing) - (With (a - 1) Nothing) - ) - , fuzz2 Fuzz.int - Fuzz.int - "One less - level 2" - (\a b -> - Expect.equal - (RO.before <| With a <| Just <| With b Nothing) - (With (a - 1) Nothing) - ) - , fuzz3 Fuzz.int - Fuzz.int - Fuzz.int - "One less - level 3" - (\a b c -> - Expect.equal - (RO.before <| With a <| Just <| With b <| Just <| With c Nothing) - (With (a - 1) Nothing) - ) - ] - , describe "Compare vs. list compare" - [ fuzz2 - (Fuzz.listOfLengthBetween 1 32 Fuzz.int) - (Fuzz.listOfLengthBetween 1 32 Fuzz.int) - "Compares the same between normal lists and orders" - (\l1 l2 -> - Expect.equal - (Just <| Basics.compare l1 l2) - (Maybe.map2 RO.compare (RO.fromList l1) (RO.fromList l2)) - ) - , fuzz2 fuzzer - fuzzer - "Compares the same when converted to list" - (\o1 o2 -> - Expect.equal - (RO.compare o1 o2) - (Basics.compare (RO.toList o1) (RO.toList o2)) - ) - ] - ] From f1dde4874b4204ab82af55d4c36aca4f1f3f938e Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Mar 2024 12:01:05 +0100 Subject: [PATCH 24/24] Merge Text code --- elm.json | 1 - src/Internal/Config/Text.elm | 12 ++++++++---- src/Internal/Tools/Json.elm | 2 +- 3 files changed, 9 insertions(+), 6 deletions(-) diff --git a/elm.json b/elm.json index 214e084..fae4760 100644 --- a/elm.json +++ b/elm.json @@ -17,7 +17,6 @@ "Internal.Tools.Iddict", "Internal.Tools.Json", "Internal.Tools.Mashdict", - "Internal.Tools.RationalOrder", "Internal.Tools.Timestamp", "Internal.Tools.VersionControl", "Internal.Values.Context", diff --git a/src/Internal/Config/Text.elm b/src/Internal/Config/Text.elm index e2f4ed5..a136bb1 100644 --- a/src/Internal/Config/Text.elm +++ b/src/Internal/Config/Text.elm @@ -214,13 +214,14 @@ docs = {-| Description of all edge cases where a JSON decoder can fail. -} -failures : { hashdict : Desc, mashdict : Desc } +failures : { hashdict : Desc, listWithOne : String, mashdict : Desc } failures = { hashdict = - [ "Not all values map to thir respected hash with the given hash function." + [ "Not all values map to their respected hash with the given hash function." ] + , listWithOne = "Expected at least one value in the list - zero found." , mashdict = - [ "Not all values map to thir respected hash with the given hash function." + [ "Not all values map to their respected hash with the given hash function." ] } @@ -485,7 +486,10 @@ leakingValueFound leaking_value = "Found leaking value : " ++ leaking_value -{-| -} +{-| These logs might appear during a process where something unexpected has +happened. Most of these unexpected results, are taken account of by the Elm SDK, +but logged so that the programmer can do something about it. +-} logs : { keyIsNotAnInt : String -> String } logs = { keyIsNotAnInt = diff --git a/src/Internal/Tools/Json.elm b/src/Internal/Tools/Json.elm index 246e29d..a0653bc 100644 --- a/src/Internal/Tools/Json.elm +++ b/src/Internal/Tools/Json.elm @@ -525,7 +525,7 @@ listWithOne (Coder old) = (\items -> case items of [] -> - D.fail "Expected at least one value in list" + D.fail Text.failures.listWithOne ( h, l1 ) :: t -> D.succeed