Add initial Room design

elm.json

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

src/Internal/Config/Text.elm

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

src/Internal/Values/Room.elm

@@ -0,0 +1,192 @@
+module Internal.Values.Room exposing
+    ( Room, init
+    , Batch, addBatch, addSync, addEvents
+    , getAccountData, setAccountData
+    )
+
+{-|
+
+
+# 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
+
+
+## Account data
+
+@docs getAccountData, setAccountData
+
+-}
+
+import FastDict as Dict exposing (Dict)
+import Internal.Config.Log exposing (log)
+import Internal.Config.Text as Text
+import Internal.Filter.Timeline 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
+            }
+        )
+
+
+{-| 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
+    }
+
+
+{-| 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 }

src/Internal/Values/StateManager.elm

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

tests/Test/Values/Room.elm

@@ -0,0 +1,72 @@
+module Test.Values.Room exposing (..)
+
+import Test exposing (..)
+import Fuzz exposing (Fuzzer)
+import Internal.Values.Room as Room exposing (Room)
+import Test.Values.Event as TestEvent
+import Test.Filter.Timeline as TestFilter
+import Json.Encode as E
+import Json.Decode as D
+import Expect
+
+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)
+            )
+        ]