Add navigation and proper room views.

This commit is contained in:
Danila Fedorin 2018-12-08 20:02:29 -08:00
parent e492452451
commit 0ceb1413ce
3 changed files with 38 additions and 9 deletions

View File

@ -1,4 +1,4 @@
import Browser exposing (application) import Browser exposing (application, UrlRequest(..))
import Browser.Navigation as Nav import Browser.Navigation as Nav
import Scylla.Sync exposing (..) import Scylla.Sync exposing (..)
import Scylla.Login exposing (..) import Scylla.Login exposing (..)
@ -52,10 +52,15 @@ update msg model = case msg of
ChangeLoginUsername u -> ({ model | loginUsername = u }, Cmd.none) ChangeLoginUsername u -> ({ model | loginUsername = u }, Cmd.none)
ChangeLoginPassword p -> ({ model | loginPassword = p }, Cmd.none) ChangeLoginPassword p -> ({ model | loginPassword = p }, Cmd.none)
AttemptLogin -> (model, Scylla.Http.login model.apiUrl model.loginUsername model.loginPassword) -- TODO AttemptLogin -> (model, Scylla.Http.login model.apiUrl model.loginUsername model.loginPassword) -- TODO
TryUrl urlRequest -> updateTryUrl model urlRequest
ChangeRoute r -> ({ model | route = r }, Cmd.none) ChangeRoute r -> ({ model | route = r }, Cmd.none)
ReceiveLoginResponse r -> updateLoginResponse model r ReceiveLoginResponse r -> updateLoginResponse model r
ReceiveSyncResponse r -> updateSyncResponse 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 -> Result Http.Error LoginResponse -> (Model, Cmd Msg)
updateLoginResponse model r = case r of updateLoginResponse model r = case r of

View File

@ -1,7 +1,7 @@
module Scylla.Sync exposing (..) module Scylla.Sync exposing (..)
import Scylla.Api exposing (..) import Scylla.Api exposing (..)
import Dict exposing (Dict) 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) import Json.Decode.Pipeline exposing (required, optional)
-- Special Decoding -- Special Decoding
@ -258,3 +258,12 @@ presenceDecoder =
-- Business Logic -- Business Logic
mergeSyncResponse : SyncResponse -> SyncResponse -> SyncResponse mergeSyncResponse : SyncResponse -> SyncResponse -> SyncResponse
mergeSyncResponse l r = r 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

View File

@ -2,9 +2,10 @@ module Scylla.Views exposing (..)
import Scylla.Model exposing (..) import Scylla.Model exposing (..)
import Scylla.Sync exposing (..) import Scylla.Sync exposing (..)
import Scylla.Route exposing (..) import Scylla.Route exposing (..)
import Url.Builder
import Json.Decode as Decode import Json.Decode as Decode
import Html exposing (Html, div, input, text, button, div, span) import Html exposing (Html, div, input, text, button, div, span, a)
import Html.Attributes exposing (type_, value) import Html.Attributes exposing (type_, value, href)
import Html.Events exposing (onInput, onClick) import Html.Events exposing (onInput, onClick)
import Dict import Dict
@ -13,8 +14,11 @@ viewFull model =
let let
core = case model.route of core = case model.route of
Login -> loginView model Login -> loginView model
Base -> normalView model Base -> baseView model
Room r -> normalView model Room r -> Maybe.withDefault (div [] [])
<| Maybe.map (joinedRoomView model)
<| Maybe.andThen (Dict.get r)
<| Maybe.andThen .join model.sync.rooms
_ -> div [] [] _ -> div [] []
errorList = errorsView model.errors errorList = errorsView model.errors
in in
@ -26,8 +30,19 @@ errorsView = div [] << List.map errorView
errorView : String -> Html Msg errorView : String -> Html Msg
errorView s = div [] [ text s ] errorView s = div [] [ text s ]
normalView : Model -> Html Msg baseView : Model -> Html Msg
normalView m = div [] [] 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 : Model -> Html Msg
loginView m = div [] loginView m = div []