Compare commits

..

3 Commits

5 changed files with 351 additions and 301 deletions

View File

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

View File

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

View File

@ -1,9 +1,9 @@
module Internal.Values.Timeline exposing
( Batch, fromToken, fromSlice
, Timeline
( Batch, Timeline
, empty, singleton
, mostRecentEvents
, addSync, insert
, encode, decoder
)
{-|
@ -19,12 +19,7 @@ and maintain this room state.
## Batch
@docs Batch, fromToken, fromSlice
## Timeline
@docs Timeline
@docs Batch, Timeline
## Create
@ -41,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)
@ -142,8 +144,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 +206,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
@ -227,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
@ -234,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
@ -247,13 +410,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 +426,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 +459,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

View File

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

View File

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