Allow for non-string values in responses, and ports.

This commit is contained in:
Danila Fedorin 2018-12-17 16:32:39 -08:00
parent cf2ada4329
commit 6d39279591
3 changed files with 21 additions and 11 deletions

View File

@ -15,6 +15,7 @@ import Url exposing (Url)
import Url.Parser exposing (parse) import Url.Parser exposing (parse)
import Url.Builder import Url.Builder
import Json.Encode import Json.Encode
import Json.Decode
import Html exposing (div, text) import Html exposing (div, text)
import Http import Http
import Dict import Dict
@ -78,15 +79,17 @@ update msg model = case msg of
ReceiveCompletedReadMarker r -> (model, Cmd.none) ReceiveCompletedReadMarker r -> (model, Cmd.none)
ReceiveStoreData d -> updateStoreData model d ReceiveStoreData d -> updateStoreData model d
updateStoreData : Model -> StoreData -> (Model, Cmd Msg) updateStoreData : Model -> Json.Encode.Value -> (Model, Cmd Msg)
updateStoreData m d = case d.key of updateStoreData m d = case (Json.Decode.decodeValue storeDataDecoder d) of
"scylla.loginInfo" -> updateLoginInfo m d.value Ok { key, value } -> case key of
_ -> (m, Cmd.none) "scylla.loginInfo" -> updateLoginInfo m value
_ -> (m, Cmd.none)
Err _ -> (m, Cmd.none)
updateLoginInfo : Model -> String -> (Model, Cmd Msg) updateLoginInfo : Model -> Json.Encode.Value -> (Model, Cmd Msg)
updateLoginInfo m s = case decodeLoginInfo s of updateLoginInfo m s = case Json.Decode.decodeValue (Json.Decode.map decodeLoginInfo Json.Decode.string) s of
Just (t,a,u) -> ({ m | token = Just t, apiUrl = a, loginUsername = u}, firstSync a t) Ok (Just (t,a,u)) -> ({ m | token = Just t, apiUrl = a, loginUsername = u}, firstSync a t)
Nothing -> (m, Nav.pushUrl m.key <| Url.Builder.absolute [ "login" ] []) _ -> (m, Nav.pushUrl m.key <| Url.Builder.absolute [ "login" ] [])
updateChangeRoute : Model -> Route -> (Model, Cmd Msg) updateChangeRoute : Model -> Route -> (Model, Cmd Msg)
updateChangeRoute m r = updateChangeRoute m r =

View File

@ -46,7 +46,7 @@ type Msg =
| ReceiveLoginResponse ApiUrl (Result Http.Error LoginResponse) -- HTTP, Login has finished | ReceiveLoginResponse ApiUrl (Result Http.Error LoginResponse) -- HTTP, Login has finished
| ReceiveUserData Username (Result Http.Error UserData) | ReceiveUserData Username (Result Http.Error UserData)
| ReceiveCompletedReadMarker (Result Http.Error ()) | ReceiveCompletedReadMarker (Result Http.Error ())
| ReceiveStoreData StoreData | ReceiveStoreData Json.Decode.Value
displayName : Model -> Username -> String displayName : Model -> Username -> String
displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData

View File

@ -1,11 +1,18 @@
port module Scylla.Storage exposing (..) port module Scylla.Storage exposing (..)
import Json.Encode import Json.Encode
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool)
import Json.Decode.Pipeline exposing (required, optional)
type alias StoreData = type alias StoreData =
{ key : String { key : String
, value: String , value: Decode.Value
} }
storeDataDecoder : Decoder StoreData
storeDataDecoder = Decode.succeed StoreData
|> required "key" string
|> required "value" value
port setStoreValuePort : (String, Json.Encode.Value) -> Cmd msg port setStoreValuePort : (String, Json.Encode.Value) -> Cmd msg
port getStoreValuePort : (String) -> Cmd msg port getStoreValuePort : (String) -> Cmd msg
port receiveStoreValuePort : (StoreData -> msg) -> Sub msg port receiveStoreValuePort : (Json.Encode.Value -> msg) -> Sub msg