Add new Elm types

I have had a few helpful Elm ideas and lessons while at FOSDEM, which may help the project in positive ways. For example, the fact that the file `Leaking.elm` exists, suggests that the code has a few downsides that may shine through when a refactor is made. For this reason, some features will be reworked and reprogrammed.

Luckily, Elm's homepage claims that this language is easy to refactor. :)

src/Internal/Config/Leaking.elm

@@ -31,6 +31,11 @@ originServerTs =
     Time.millisToPosix 0
 
 
+prevBatch : String
+prevBatch =
+    "this_previous_batch_does_not_exist"
+
+
 roomId : String
 roomId =
     "!unknown-room:example.org"

src/Internal/Tools/Fold.elm

@@ -0,0 +1,49 @@
+module Internal.Tools.Fold exposing (..)
+
+{-| This module allows users to iterate over lists in more intelligent ways.
+-}
+
+
+type FoldingState a
+    = Calculating a
+    | AnswerFound a
+
+
+type FoldingResponse a
+    = ContinueWith a
+    | AnswerWith a
+    | AnswerWithPrevious
+
+
+{-| Fold until a given condition is met.
+The first argument is a function that returns a `Maybe b`. As soon as that value is `Nothing`, the function will ignore the rest of the list and return the most recent value.
+-}
+untilCompleted : ((a -> FoldingState b -> FoldingState b) -> FoldingState b -> List a -> FoldingState b) -> (a -> b -> FoldingResponse b) -> b -> List a -> b
+untilCompleted folder updater startValue items =
+    folder
+        (\piece oldValue ->
+            case oldValue of
+                AnswerFound x ->
+                    AnswerFound x
+
+                Calculating x ->
+                    case updater piece x of
+                        ContinueWith y ->
+                            Calculating y
+
+                        AnswerWith y ->
+                            AnswerFound y
+
+                        AnswerWithPrevious ->
+                            AnswerFound x
+        )
+        (Calculating startValue)
+        items
+        |> (\resp ->
+                case resp of
+                    Calculating x ->
+                        x
+
+                    AnswerFound x ->
+                        x
+           )

src/Internal/Tools/Hashdict.elm

@@ -0,0 +1,41 @@
+module Internal.Tools.Hashdict exposing (..)
+
+{-| This module abstracts the `Dict` type with one function that chooses the unique identifier for each type.
+
+For example, this is used to store events by their event id, or store rooms by their room id.
+
+-}
+
+import Dict exposing (Dict)
+
+
+type Hashdict a
+    = Hashdict
+        { hash : a -> String
+        , values : Dict String a
+        }
+
+
+empty : (a -> String) -> Hashdict a
+empty hash =
+    Hashdict { hash = hash, values = Dict.empty }
+
+
+get : String -> Hashdict a -> Maybe a
+get k (Hashdict h) =
+    Dict.get k h.values
+
+
+insert : a -> Hashdict a -> Hashdict a
+insert v (Hashdict h) =
+    Hashdict { h | values = Dict.insert (h.hash v) v h.values }
+
+
+keys : Hashdict a -> List String
+keys (Hashdict h) =
+    Dict.keys h.values
+
+
+values : Hashdict a -> List a
+values (Hashdict h) =
+    Dict.values h.values

src/Internal/Values/Credentials.elm

@@ -0,0 +1,45 @@
+module Internal.Values.Credentials exposing (..)
+
+import Dict exposing (Dict)
+import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
+import Internal.Values.Room as Room exposing (Room)
+
+
+type Credentials
+    = Credentials { access : AccessToken, homeserver : String, rooms : Hashdict Room }
+
+
+type AccessToken
+    = AccessToken String
+    | NoAccess
+    | UsernameAndPassword { username : String, password : String, accessToken : Maybe String }
+
+defaultCredentials : String -> Credentials
+defaultCredentials homeserver =
+    Credentials
+        { access = NoAccess
+        , homeserver = homeserver
+        , rooms = Hashdict.empty Room.roomId
+        }
+
+fromAccessToken : { accessToken : String, homeserver : String } -> Credentials
+fromAccessToken { accessToken, homeserver } =
+    case defaultCredentials homeserver of
+        Credentials c ->
+            Credentials { c | access = AccessToken accessToken }
+
+fromLoginCredentials : { username : String, password : String, homeserver : String } -> Credentials
+fromLoginCredentials { username, password, homeserver } =
+    case defaultCredentials homeserver of
+        Credentials c ->
+            Credentials { c | access = UsernameAndPassword { username = username, password = password, accessToken = Nothing } }
+
+getRoomById : String -> Credentials -> Maybe Room
+getRoomById roomId (Credentials cred) =
+    Hashdict.get roomId cred.rooms
+
+
+insertRoom : Room -> Credentials -> Credentials
+insertRoom room (Credentials cred) =
+    Credentials
+        { cred | rooms = Hashdict.insert room cred.rooms }

src/Internal/Values/Event.elm

@@ -3,8 +3,9 @@ module Internal.Values.Event exposing (..)
 import Internal.Tools.Timestamp exposing (Timestamp)
 import Json.Encode as E
 
-type Event =
+
-    Event
+type Event
+    = Event
         { content : E.Value
         , eventId : String
         , originServerTs : Timestamp
@@ -12,70 +13,88 @@ type Event =
         , sender : String
         , stateKey : Maybe String
         , contentType : String
-        , unsigned : Maybe { age : Maybe Int
+        , unsigned :
-                        , prevContent : Maybe E.Value
+            Maybe
-                        , redactedBecause : Maybe Event
+                { age : Maybe Int
-                        , transactionId : Maybe String
+                , prevContent : Maybe E.Value
-                        }
+                , redactedBecause : Maybe Event
+                , transactionId : Maybe String
+                }
         }
 
+
+
 {- GETTER FUNCTIONS -}
 
+
 content : Event -> E.Value
 content (Event e) =
     e.content
 
+
 eventId : Event -> String
 eventId (Event e) =
     e.eventId
 
+
 originServerTs : Event -> Timestamp
 originServerTs (Event e) =
     e.originServerTs
 
+
 roomId : Event -> String
 roomId (Event e) =
     e.roomId
-    
+
+
 sender : Event -> String
 sender (Event e) =
     e.sender
 
+
 stateKey : Event -> Maybe String
 stateKey (Event e) =
     e.stateKey
 
+
 contentType : Event -> String
 contentType (Event e) =
     e.contentType
 
+
 age : Event -> Maybe Int
 age (Event e) =
     e.unsigned
-    |> Maybe.andThen .age
+        |> Maybe.andThen .age
+
 
 redactedBecause : Event -> Maybe Event
 redactedBecause (Event e) =
     e.unsigned
-    |> Maybe.andThen .redactedBecause
+        |> Maybe.andThen .redactedBecause
 
 
 age : Event -> Maybe Int
 age (Event e) =
     e.unsigned
-    |> Maybe.andThen .age
+        |> Maybe.andThen .age
+
 
 transactionId : Event -> Maybe String
 transactionId (Event e) =
     e.unsigned
-    |> Maybe.andThen .transactionId
+        |> Maybe.andThen .transactionId
+
+
+type BlindEvent
+    = BlindEvent { contentType : String, content : E.Value }
 
-type BlindEvent = BlindEvent { contentType : String, content : E.Value }
 
 blindContent : BlindEvent -> E.Value
 blindContent (BlindEvent be) =
     be.content
 
+
 blindContentType : BlindEvent -> String
 blindContentType (BlindEvent be) =
     be.contentType

src/Internal/Values/Room.elm

@@ -0,0 +1,55 @@
+module Internal.Values.Room exposing (..)
+
+import Dict exposing (Dict)
+import Internal.Tools.Fold as Fold
+import Internal.Tools.SpecEnums exposing (SessionDescriptionType(..))
+import Internal.Values.Event as Event exposing (BlindEvent, Event)
+import Internal.Values.StateManager as StateManager exposing (StateManager)
+import Internal.Values.Timeline as Timeline exposing (Timeline)
+import Json.Encode as E
+
+
+type Room
+    = Room
+        { accountData : Dict String E.Value
+        , ephemeral : List BlindEvent
+        , events : Dict String Event
+        , roomId : String
+        , timeline : Timeline
+        }
+
+
+{-| Add new events as the most recent events.
+-}
+addEvents :
+    { events : List Event
+    , nextBatch : String
+    , prevBatch : String
+    , stateDelta : Maybe StateManager
+    }
+    -> Room
+    -> Room
+addEvents ({ events } as data) (Room room) =
+    Room
+        { room
+            | events =
+                events
+                    |> List.map (\e -> ( Event.eventId e, e ))
+                    |> Dict.fromList
+                    |> (\x -> Dict.union x room.events)
+            , timeline = Timeline.addNewEvents data room.timeline
+        }
+
+
+{-| Get an event by its id.
+-}
+getEventById : String -> Room -> Maybe Event
+getEventById eventId (Room room) =
+    Dict.get eventId room.events
+
+
+{-| Get the room's id.
+-}
+roomId : Room -> String
+roomId (Room room) =
+    room.roomId

src/Internal/Values/StateManager.elm

@@ -3,26 +3,42 @@ module Internal.Values.StateManager exposing (..)
 import Dict exposing (Dict)
 import Internal.Values.Event as Event exposing (Event)
 
-type alias StateManager = Dict (String, String) Event
+
+type alias StateManager =
+    Dict ( String, String ) Event
+
+
+addEvent : Event -> StateManager -> StateManager
+addEvent event oldManager =
+    case Event.stateKey event of
+        Just key ->
+            Dict.insert ( Event.contentType event, key ) event oldManager
+
+        Nothing ->
+            oldManager
+
 
 getStateEvent : String -> String -> StateManager -> Maybe Event
 getStateEvent eventType stateKey =
     Dict.get ( eventType, stateKey )
 
+
 updateRoomStateWith : StateManager -> StateManager -> StateManager
-updateRoomStateWith = Dict.union
+updateRoomStateWith =
+    Dict.union
+
+
+fromEvent : Event -> StateManager
+fromEvent event =
+    Dict.empty
+        |> addEvent event
+
 
 fromEventList : List Event -> StateManager
 fromEventList =
-    List.filterMap
+    List.foldl addEvent Dict.empty
-        (\event ->
-            event
-                |> Event.stateKey
-                |> Maybe.map
-                    (\key ->
-                        ( ( Event.contentType event, key ), event )
-                    )
-        )
-        >> Dict.fromList
 
 
+empty : StateManager
+empty =
+    Dict.empty

src/Internal/Values/Timeline.elm

@@ -0,0 +1,226 @@
+module Internal.Values.Timeline exposing (..)
+
+{-| This module shapes the Timeline type used to keep track of timelines in Matrix rooms.
+-}
+
+import Internal.Config.Leaking as Leaking
+import Internal.Tools.Fold as Fold
+import Internal.Values.Event as Event exposing (Event)
+import Internal.Values.Room exposing (stateAtEvent)
+import Internal.Values.StateManager as StateManager exposing (StateManager)
+
+
+type Timeline
+    = Timeline
+        { prevBatch : String
+        , nextBatch : String
+        , events : List Event
+        , stateAtStart : StateManager
+        , previous : BeforeTimeline
+        }
+
+
+type BeforeTimeline
+    = Endless String
+    | Gap Timeline
+    | StartOfTimeline
+
+
+{-| Add a new batch of events to the front of the timeline.
+-}
+addNewEvents :
+    { events : List Event
+    , nextBatch : String
+    , prevBatch : String
+    , stateDelta : Maybe StateManager
+    }
+    -> Timeline
+    -> Timeline
+addNewEvents { events, nextBatch, prevBatch, stateDelta } (Timeline t) =
+    Timeline
+        (if prevBatch == t.nextBatch then
+            { t
+                | events = t.events ++ events
+                , nextBatch = nextBatch
+            }
+
+         else
+            { prevBatch = prevBatch
+            , nextBatch = nextBatch
+            , events = events
+            , stateAtStart =
+                t
+                    |> Timeline
+                    |> mostRecentState
+                    |> StateManager.updateRoomStateWith
+                        (stateDelta
+                            |> Maybe.withDefault StateManager.empty
+                        )
+            , previous = Gap (Timeline t)
+            }
+        )
+
+
+{-| Create a new timeline.
+-}
+newFromEvents :
+    { events : List Event
+    , nextBatch : String
+    , prevBatch : Maybe String
+    , stateDelta : Maybe StateManager
+    }
+    -> Timeline
+newFromEvents { events, nextBatch, prevBatch, stateDelta } =
+    Timeline
+        { events = events
+        , nextBatch = nextBatch
+        , prevBatch =
+            prevBatch
+                |> Maybe.withDefault Leaking.prevBatch
+        , previous =
+            prevBatch
+                |> Maybe.map Endless
+                |> Maybe.withDefault StartOfTimeline
+        , stateAtStart =
+            stateDelta
+                |> Maybe.withDefault StateManager.empty
+        }
+
+
+{-| Insert events starting from a known batch token.
+-}
+insertEvents :
+    { events : List Event
+    , nextBatch : String
+    , prevBatch : String
+    , stateDelta : Maybe StateManager
+    }
+    -> Timeline
+    -> Timeline
+insertEvents ({ events, nextBatch, prevBatch, stateDelta } as data) (Timeline t) =
+    Timeline
+        (if t.nextBatch == prevBatch then
+            { t
+                | events = t.events ++ events
+                , nextBatch = nextBatch
+            }
+
+         else if nextBatch == t.prevBatch then
+            case t.previous of
+                Gap (Timeline prevT) ->
+                    if prevT.nextBatch == prevBatch then
+                        { events = prevT.events ++ events ++ t.events
+                        , nextBatch = t.nextBatch
+                        , prevBatch = prevT.prevBatch
+                        , stateAtStart = prevT.stateAtStart
+                        , previous = prevT.previous
+                        }
+
+                    else
+                        { t
+                            | events = events ++ t.events
+                            , prevBatch = prevBatch
+                            , stateAtStart =
+                                stateDelta
+                                    |> Maybe.withDefault StateManager.empty
+                        }
+
+                _ ->
+                    { t
+                        | events = events ++ t.events
+                        , prevBatch = prevBatch
+                        , stateAtStart =
+                            stateDelta
+                                |> Maybe.withDefault StateManager.empty
+                    }
+
+         else
+            case t.previous of
+                Gap prevT ->
+                    { t
+                        | previous =
+                            prevT
+                                |> insertEvents data
+                                |> Gap
+                    }
+
+                _ ->
+                    t
+        )
+
+
+{-| Get the longest uninterrupted length of most recent events.
+-}
+localSize : Timeline -> Int
+localSize =
+    mostRecentEvents >> List.length
+
+
+{-| Get a list of the most recent events recorded.
+-}
+mostRecentEvents : Timeline -> List Event
+mostRecentEvents (Timeline t) =
+    t.events
+
+
+{-| Get the needed `since` parameter to get the latest events.
+-}
+nextSyncToken : Timeline -> String
+nextSyncToken (Timeline t) =
+    t.nextBatch
+
+
+{-| Get the state of the room after the most recent event.
+-}
+mostRecentState : Timeline -> StateManager
+mostRecentState (Timeline t) =
+    t.stateAtStart
+        |> StateManager.updateRoomStateWith
+            (StateManager.fromEventList t.events)
+
+
+{-| Get the timeline's room state at any given event. The function returns `Nothing` if the event is not found in the timeline.
+-}
+stateAtEvent : Event -> Timeline -> Maybe StateManager
+stateAtEvent event (Timeline t) =
+    if
+        t.events
+            |> List.map Event.eventId
+            |> List.member (Event.eventId event)
+    then
+        Fold.untilCompleted
+            List.foldl
+            (\e ->
+                StateManager.addEvent e
+                    >> (if Event.eventId e == Event.eventId event then
+                            Fold.AnswerWith
+
+                        else
+                            Fold.ContinueWith
+                       )
+            )
+            t.stateAtStart
+            t.events
+            |> Just
+
+    else
+        case t.previous of
+            Gap prevT ->
+                stateAtEvent event prevT
+
+            _ ->
+                Nothing
+
+
+{-| Count how many events the current timeline is storing.
+-}
+size : Timeline -> Int
+size (Timeline t) =
+    (case t.previous of
+        Gap prev ->
+            size prev
+
+        _ ->
+            0
+    )
+        + List.length t.events