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 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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 []
|
||||||
|
|
Loading…
Reference in New Issue
Block a user