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

Add Room as data type

elm.json

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

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/Tools/Json.elm

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

src/Internal/Values/Room.elm

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

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

src/Matrix/Room.elm

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

src/Types.elm

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

tests/Test/Values/Room.elm

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