Add navigation and proper room views.
This commit is contained in:
parent
e492452451
commit
0ceb1413ce
|
@ -1,4 +1,4 @@
|
|||
import Browser exposing (application)
|
||||
import Browser exposing (application, UrlRequest(..))
|
||||
import Browser.Navigation as Nav
|
||||
import Scylla.Sync exposing (..)
|
||||
import Scylla.Login exposing (..)
|
||||
|
@ -52,10 +52,15 @@ update msg model = case msg of
|
|||
ChangeLoginUsername u -> ({ model | loginUsername = u }, Cmd.none)
|
||||
ChangeLoginPassword p -> ({ model | loginPassword = p }, Cmd.none)
|
||||
AttemptLogin -> (model, Scylla.Http.login model.apiUrl model.loginUsername model.loginPassword) -- TODO
|
||||
TryUrl urlRequest -> updateTryUrl model urlRequest
|
||||
ChangeRoute r -> ({ model | route = r }, Cmd.none)
|
||||
ReceiveLoginResponse r -> updateLoginResponse model r
|
||||
ReceiveSyncResponse r -> updateSyncResponse model r
|
||||
_ -> (model, Cmd.none)
|
||||
|
||||
updateTryUrl : Model -> Browser.UrlRequest -> (Model, Cmd Msg)
|
||||
updateTryUrl m ur = case ur of
|
||||
Internal u -> (m, Nav.pushUrl m.key (Url.toString u))
|
||||
_ -> (m, Cmd.none)
|
||||
|
||||
updateLoginResponse : Model -> Result Http.Error LoginResponse -> (Model, Cmd Msg)
|
||||
updateLoginResponse model r = case r of
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
module Scylla.Sync exposing (..)
|
||||
import Scylla.Api exposing (..)
|
||||
import Dict exposing (Dict)
|
||||
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool)
|
||||
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field)
|
||||
import Json.Decode.Pipeline exposing (required, optional)
|
||||
|
||||
-- Special Decoding
|
||||
|
@ -258,3 +258,12 @@ presenceDecoder =
|
|||
-- Business Logic
|
||||
mergeSyncResponse : SyncResponse -> SyncResponse -> SyncResponse
|
||||
mergeSyncResponse l r = r
|
||||
|
||||
roomName : JoinedRoom -> Maybe String
|
||||
roomName jr =
|
||||
let
|
||||
state = jr.state
|
||||
nameEvent = List.head << List.sortBy (\e -> -e.originServerTs) << List.filter (\e -> e.type_ == "m.room.name")
|
||||
name e = Result.toMaybe <| Decode.decodeValue (field "name" string) e.content
|
||||
in
|
||||
Maybe.andThen name <| Maybe.andThen nameEvent <| Maybe.andThen .events <| state
|
||||
|
|
|
@ -2,9 +2,10 @@ module Scylla.Views exposing (..)
|
|||
import Scylla.Model exposing (..)
|
||||
import Scylla.Sync exposing (..)
|
||||
import Scylla.Route exposing (..)
|
||||
import Url.Builder
|
||||
import Json.Decode as Decode
|
||||
import Html exposing (Html, div, input, text, button, div, span)
|
||||
import Html.Attributes exposing (type_, value)
|
||||
import Html exposing (Html, div, input, text, button, div, span, a)
|
||||
import Html.Attributes exposing (type_, value, href)
|
||||
import Html.Events exposing (onInput, onClick)
|
||||
import Dict
|
||||
|
||||
|
@ -13,8 +14,11 @@ viewFull model =
|
|||
let
|
||||
core = case model.route of
|
||||
Login -> loginView model
|
||||
Base -> normalView model
|
||||
Room r -> normalView model
|
||||
Base -> baseView model
|
||||
Room r -> Maybe.withDefault (div [] [])
|
||||
<| Maybe.map (joinedRoomView model)
|
||||
<| Maybe.andThen (Dict.get r)
|
||||
<| Maybe.andThen .join model.sync.rooms
|
||||
_ -> div [] []
|
||||
errorList = errorsView model.errors
|
||||
in
|
||||
|
@ -26,8 +30,19 @@ errorsView = div [] << List.map errorView
|
|||
errorView : String -> Html Msg
|
||||
errorView s = div [] [ text s ]
|
||||
|
||||
normalView : Model -> Html Msg
|
||||
normalView m = div [] []
|
||||
baseView : Model -> Html Msg
|
||||
baseView m =
|
||||
let
|
||||
rooms = Maybe.withDefault (Dict.empty) <| Maybe.andThen .join <| m.sync.rooms
|
||||
in
|
||||
div [] <| Dict.values <| Dict.map roomListView rooms
|
||||
|
||||
roomListView : String -> JoinedRoom -> Html Msg
|
||||
roomListView s jr =
|
||||
let
|
||||
name = Maybe.withDefault "<No Name>" <| roomName jr
|
||||
in
|
||||
a [ href <| Url.Builder.absolute [ "room", s ] [] ] [ text name ]
|
||||
|
||||
loginView : Model -> Html Msg
|
||||
loginView m = div []
|
||||
|
|
Loading…
Reference in New Issue
Block a user