Merge pull request #20 from noordstar/3-room on GitHub

Add Room as data type
pull/21/head
BramvdnHeuvel 2024-04-26 15:30:23 +02:00 committed by GitHub
commit bcdb178414
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
8 changed files with 462 additions and 6 deletions

View File

@ -5,8 +5,11 @@
"license": "EUPL-1.1",
"version": "3.0.0",
"exposed-modules": [
"Internal.Values.Room",
"Internal.Values.Timeline",
"Matrix",
"Matrix.Event",
"Matrix.Room",
"Matrix.Settings",
"Matrix.User"
],

View File

@ -120,6 +120,7 @@ docs :
, iddict : TypeDocs
, itoken : TypeDocs
, mashdict : TypeDocs
, room : TypeDocs
, settings : TypeDocs
, stateManager : TypeDocs
, timeline : TypeDocs
@ -177,6 +178,12 @@ docs =
[ "The mashdict exclusively stores values for which the hashing algorithm returns a value, and it ignores the outcome for all other scenarios."
]
}
, room =
{ name = "Room"
, description =
[ "The Room type represents a conversation in Matrix."
]
}
, settings =
{ name = "Settings"
, description =
@ -271,6 +278,13 @@ fields :
, name : Desc
, starts : Desc
}
, room :
{ accountData : Desc
, events : Desc
, roomId : Desc
, state : Desc
, timeline : Desc
}
, settings :
{ currentVersion : Desc
, deviceName : Desc
@ -398,6 +412,18 @@ fields =
[ "This token is at the start of the batches in this field."
]
}
, room =
{ accountData =
[ "Room account data tracking the user's private storage about this room." ]
, events =
[ "Database containing events that were sent in this room." ]
, roomId =
[ "Unique room identifier" ]
, state =
[ "Current state of the room based on state events" ]
, timeline =
[ "Current timeline of the room" ]
}
, settings =
{ currentVersion =
[ "Indicates the current version of the Elm SDK."

View File

@ -434,12 +434,16 @@ field =
, description = description
, encoder =
\o ->
let
v =
encoder o
in
-- If the value matches the default, do not record
if o == Tuple.first default then
if E.encode 0 v == E.encode 0 (encoder (Tuple.first default)) then
Nothing
else
Maybe.Just (encoder o)
Maybe.Just v
, decoder = D.opFieldWithDefault fieldName default decoder
, docs = docs
, requiredness =

View File

@ -0,0 +1,225 @@
module Internal.Values.Room exposing
( Room, init
, Batch, addBatch, addSync, addEvents, mostRecentEvents
, getAccountData, setAccountData
, coder, encode, decode
)
{-|
# Room
What is usually called a chat, a channel, a conversation or a group chat on
other platforms, the term used in Matrix is a "room". A room is a conversation
where a group of users talk to each other.
This module is the internal module of a room. Its functions serve the update
the local room state. Its changes do **NOT** reflect the actual room state on
the homeserver: as a matter of fact, these functions are meant to help the local
room state reflect the homeserver state of the room.
## Room
@docs Room, init
## Timeline
@docs Batch, addBatch, addSync, addEvents, mostRecentEvents
## Account data
@docs getAccountData, setAccountData
## JSON coding
@docs coder, encode, decode
-}
import FastDict as Dict exposing (Dict)
import Internal.Config.Log exposing (log)
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.Json as Json
import Internal.Values.Event as Event exposing (Event)
import Internal.Values.StateManager as StateManager exposing (StateManager)
import Internal.Values.Timeline as Timeline exposing (Timeline)
import Json.Encode as E
{-| The Batch is a group of new events from somewhere in the timeline.
-}
type alias Batch =
{ events : List Event, filter : Filter, start : Maybe String, end : String }
{-| The Matrix Room is a representation of a Matrix Room as portrayed by the
homeserver.
-}
type alias Room =
{ accountData : Dict String Json.Value
, events : Hashdict Event
, roomId : String
, state : StateManager
, timeline : Timeline
}
{-| Add new events to the Room's event directory + Room's timeline.
-}
addEventsToTimeline : (Timeline.Batch -> Timeline -> Timeline) -> Batch -> Room -> Room
addEventsToTimeline f { events, filter, start, end } room =
let
batch : Timeline.Batch
batch =
{ events = List.map .eventId events
, filter = filter
, start = start
, end = end
}
in
{ room
| events = List.foldl Hashdict.insert room.events events
, timeline = f batch room.timeline
}
{-| Add a batch of events to the Room.
-}
addBatch : Batch -> Room -> Room
addBatch =
addEventsToTimeline Timeline.insert
{-| Add events to the room, with no particular information about their location
on the timeline. This is especially helpful for events that offer information
like the room's state, given that it is essential to know them but they have
often been sent a long time ago.
-}
addEvents : List Event -> Room -> Room
addEvents events room =
{ room
| events = List.foldl Hashdict.insert room.events events
}
{-| Add a new sync to the Room. The difference with the
[addBatch](Internal-Values-Room#addBatch) function is that this function
explicitly tells the Timeline that it is at the front of the timeline.
-}
addSync : Batch -> Room -> Room
addSync =
addEventsToTimeline Timeline.addSync
{-| Define how a Room can be encoded and decoded to and from a JavaScript value.
-}
coder : Json.Coder Room
coder =
Json.object5
{ name = Text.docs.room.name
, description = Text.docs.room.description
, init = Room
}
(Json.field.optional.withDefault
{ fieldName = "accountData"
, toField = .accountData
, description = Text.fields.room.accountData
, coder = Json.fastDict Json.value
, default = ( Dict.empty, [] )
, defaultToString = Json.encode (Json.fastDict Json.value) >> E.encode 0
}
)
(Json.field.optional.withDefault
{ fieldName = "events"
, toField = .events
, description = Text.fields.room.events
, coder = Hashdict.coder .eventId Event.coder
, default = ( Hashdict.empty .eventId, [ log.warn "Found a room with no known events! Is it empty?" ] )
, defaultToString = Json.encode (Hashdict.coder .eventId Event.coder) >> E.encode 0
}
)
(Json.field.required
{ fieldName = "roomId"
, toField = .roomId
, description = Text.fields.room.roomId
, coder = Json.string
}
)
(Json.field.optional.withDefault
{ fieldName = "state"
, toField = .state
, description = Text.fields.room.state
, coder = StateManager.coder
, default = ( StateManager.empty, [] )
, defaultToString = Json.encode StateManager.coder >> E.encode 0
}
)
(Json.field.optional.withDefault
{ fieldName = "timeline"
, toField = .timeline
, description = Text.fields.room.timeline
, coder = Timeline.coder
, default = ( Timeline.empty, [] )
, defaultToString = Json.encode Timeline.coder >> E.encode 0
}
)
{-| Decode a Room from JSON format.
-}
decode : Json.Decoder Room
decode =
Json.decode coder
{-| Encode a Room into JSON format.
-}
encode : Json.Encoder Room
encode =
Json.encode coder
{-| Get a piece of account data as information from the room.
-}
getAccountData : String -> Room -> Maybe Json.Value
getAccountData key room =
Dict.get key room.accountData
{-| Create an empty room for which nothing is known.
-}
init : String -> Room
init roomId =
{ accountData = Dict.empty
, events = Hashdict.empty .eventId
, roomId = roomId
, state = StateManager.empty
, timeline = Timeline.empty
}
{-| Get the most recent events from the timeline.
-}
mostRecentEvents : Room -> List Event
mostRecentEvents room =
room.timeline
|> Timeline.mostRecentEvents Filter.pass
|> List.map (List.filterMap (\e -> Hashdict.get e room.events))
|> List.sortBy List.length
-- Get the largest list of events
|> List.head
|> Maybe.withDefault []
{-| Set a piece of account data as information about the room.
-}
setAccountData : String -> Json.Value -> Room -> Room
setAccountData key value room =
{ room | accountData = Dict.insert key value room.accountData }

View File

@ -1,6 +1,6 @@
module Internal.Values.StateManager exposing
( StateManager
, empty, singleton, insert, remove, append
, empty, singleton, insert, insertIfNotExists, remove, append
, isEmpty, member, memberKey, get, size, isEqual
, keys, values, fromList, toList
, coder, encode, decoder
@ -19,7 +19,7 @@ dictionary-like experience to navigate through the Matrix room state.
## Build
@docs empty, singleton, insert, remove, append
@docs empty, singleton, insert, insertIfNotExists, remove, append
## Query
@ -166,6 +166,28 @@ insert event (StateManager manager) =
|> cleanKey event.eventType
{-| Insert a new event into the state manager ONLY if no such event has already
been defined.
This function is most useful for including older state events that may have been
overwritten in the future.
-}
insertIfNotExists : Event -> StateManager -> StateManager
insertIfNotExists event sm =
case event.stateKey of
Nothing ->
sm
Just s ->
case get { eventType = event.eventType, stateKey = s } sm of
Just _ ->
sm
Nothing ->
insert event sm
{-| Determine whether the StateManager contains any events.
-}
isEmpty : StateManager -> Bool

64
src/Matrix/Room.elm Normal file
View File

@ -0,0 +1,64 @@
module Matrix.Room exposing
( Room, mostRecentEvents
, getAccountData
)
{-|
# Room
What is usually called a chat, a channel, a conversation or a group chat on
other platforms, the term used in Matrix is a "room". A room is a conversation
where a group of users talk to each other.
@docs Room, mostRecentEvents
This module exposes various functions that help you inspect various aspects of
a room.
## Account data
Account data is personal information that the user stores about this Matrix
room. This may include information like:
- What type of room this is
- A list of members in the room to ignore
- A list of currently ongoing chess matches in the room
- Personal notes the user may be taking
You may consider the account data as a `Dict String Json.Value` type. Account
data is linked to the user account: other logged in devices can see the account
data too, as the server synchronizes it, but the server shouldn´t show it to
other users.
@docs getAccountData
-}
import Internal.Values.Envelope as Envelope
import Internal.Values.Room as Internal
import Json.Encode as E
import Types exposing (Room(..))
{-| The Matrix Room type representing a room that the Matrix user has joined.
-}
type alias Room =
Types.Room
{-| Get a piece of account data linked to a certain string key.
-}
getAccountData : String -> Room -> Maybe E.Value
getAccountData key (Room room) =
Envelope.extract (Internal.getAccountData key) room
{-| Get a list of the most recent events sent in the room.
-}
mostRecentEvents : Room -> List Types.Event
mostRecentEvents (Room room) =
Envelope.mapList Internal.mostRecentEvents room
|> List.map Types.Event

View File

@ -1,4 +1,4 @@
module Types exposing (Vault(..), Event(..), User(..))
module Types exposing (Vault(..), Event(..), Room(..), User(..))
{-| The Elm SDK uses a lot of records and values that are easy to manipulate.
Yet, the [Elm design guidelines](https://package.elm-lang.org/help/design-guidelines#keep-tags-and-record-constructors-secret)
@ -12,12 +12,13 @@ access their content directly.
The opaque types are placed in a central module so all exposed modules can
safely access all exposed data types without risking to create circular imports.
@docs Vault, Event, User
@docs Vault, Event, Room, User
-}
import Internal.Values.Envelope as Envelope
import Internal.Values.Event as Event
import Internal.Values.Room as Room
import Internal.Values.User as User
import Internal.Values.Vault as Vault
@ -28,6 +29,12 @@ type Event
= Event (Envelope.Envelope Event.Event)
{-| Opaque type for Matrix Room
-}
type Room
= Room (Envelope.Envelope Room.Room)
{-| Opaque type for Matrix User
-}
type User

105
tests/Test/Values/Room.elm Normal file
View File

@ -0,0 +1,105 @@
module Test.Values.Room exposing (..)
import Expect
import Fuzz exposing (Fuzzer)
import Internal.Values.Room as Room exposing (Room)
import Json.Decode as D
import Json.Encode as E
import Test exposing (..)
import Test.Filter.Timeline as TestFilter
import Test.Values.Event as TestEvent
placeholderValue : E.Value
placeholderValue =
E.string "foo bar baz"
fuzzer : Fuzzer Room
fuzzer =
Fuzz.string
|> Fuzz.map Room.init
|> addAFewTimes Fuzz.string (\key -> Room.setAccountData key placeholderValue)
|> addAFewTimes (Fuzz.list TestEvent.fuzzer) Room.addEvents
|> add4AFewTimes (Fuzz.list TestEvent.fuzzer)
TestFilter.fuzzer
(Fuzz.maybe Fuzz.string)
Fuzz.string
(\a b c d ->
Room.Batch a b c d
|> Room.addBatch
)
|> add4AFewTimes (Fuzz.list TestEvent.fuzzer)
TestFilter.fuzzer
(Fuzz.maybe Fuzz.string)
Fuzz.string
(\a b c d ->
Room.Batch a b c d
|> Room.addSync
)
addAFewTimes : Fuzzer a -> (a -> Room -> Room) -> Fuzzer Room -> Fuzzer Room
addAFewTimes fuzz f roomFuzzer =
Fuzz.map2
(\items room -> List.foldl f room items)
(Fuzz.list fuzz)
roomFuzzer
add2AFewTimes : Fuzzer a -> Fuzzer b -> (a -> b -> Room -> Room) -> Fuzzer Room -> Fuzzer Room
add2AFewTimes fuzz1 fuzz2 f roomFuzzer =
Fuzz.map2
(\items room -> List.foldl (\( a, b ) -> f a b) room items)
(Fuzz.list <| Fuzz.pair fuzz1 fuzz2)
roomFuzzer
add3AFewTimes : Fuzzer a -> Fuzzer b -> Fuzzer c -> (a -> b -> c -> Room -> Room) -> Fuzzer Room -> Fuzzer Room
add3AFewTimes fuzz1 fuzz2 fuzz3 f roomFuzzer =
Fuzz.map2
(\items room -> List.foldl (\( a, b, c ) -> f a b c) room items)
(Fuzz.list <| Fuzz.triple fuzz1 fuzz2 fuzz3)
roomFuzzer
add4AFewTimes : Fuzzer a -> Fuzzer b -> Fuzzer c -> Fuzzer d -> (a -> b -> c -> d -> Room -> Room) -> Fuzzer Room -> Fuzzer Room
add4AFewTimes fuzz1 fuzz2 fuzz3 fuzz4 f roomFuzzer =
Fuzz.map2
(\items room -> List.foldl (\( ( a, b ), ( c, d ) ) -> f a b c d) room items)
(Fuzz.list <| Fuzz.pair (Fuzz.pair fuzz1 fuzz2) (Fuzz.pair fuzz3 fuzz4))
roomFuzzer
-- suite : Test
-- suite =
-- describe "Room"
-- [ fuzz3 fuzzer
-- Fuzz.string
-- Fuzz.string
-- "JSON Account Data can be overridden"
-- (\room key text ->
-- room
-- |> Room.setAccountData key (E.string text)
-- |> Room.getAccountData key
-- |> Maybe.map (D.decodeValue D.string)
-- |> Maybe.andThen Result.toMaybe
-- |> Expect.equal (Just text)
-- )
-- , fuzz fuzzer
-- "Room -> JSON -> Room is equal"
-- (\room ->
-- let
-- value : E.Value
-- value =
-- Room.encode room
-- in
-- value
-- |> D.decodeValue Room.decode
-- |> Result.toMaybe
-- |> Maybe.map Tuple.first
-- |> Maybe.map Room.encode
-- |> Maybe.map (E.encode 0)
-- |> Expect.equal (Just <| E.encode 0 value)
-- )
-- ]