restructure the code, learning from spa-example-app

This commit is contained in:
2019-11-10 23:18:19 +01:00
parent eb29c5a24f
commit 5725d81236
7 changed files with 609 additions and 549 deletions

View File

@@ -8,13 +8,12 @@ import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Json.Encode as E
import Modes
import Route exposing (..)
import Set exposing (Set)
import Svg.Attributes
import Url
import Utils exposing (..)
import Session exposing (..)
-- Main
@@ -35,55 +34,35 @@ main =
-- Model
type Model
= Chest Chest.Model
| Admin Admin.Model
| About
type alias State =
{ menuOpen : Bool
, error : Maybe String
, notification : Maybe String
}
type alias Model =
{ state : State
, navKey : Nav.Key
, route : Route
, mode : Modes.Model
, player : Player
, chest : Chest.Model
}
init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
-- This is not what we really want.
-- The flags will be a Maybe Int (id of logged in player), so
-- in case there is no player logged in, we need to display
-- a "Home" page
-- This mean Chest cannot be initiated right away, and many model
-- fields are useless.
--
-- A User can :
-- - not be logged in -> See About page
-- - just loggend in -> See Loading page then Chest
-- - coming back being still logged in -> See Chest (or same as above)
init : Maybe Int -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
init flags url key =
let
route =
case routeParser url of
Just r ->
r
case flags of
Just id ->
let
session =
Session.LoggedIn key <| Session.User.Player id
in
(Chest <| Chest.init id, Cmd.none)
Nothing ->
PlayerChest
Nothing ->
(About, Cmd.none)
(chest, cmd) =
Chest.init 0
in
( Model
(State False Nothing Nothing)
key
route
Modes.init
Api.blankPlayer
chest
, Cmd.batch
[ initPlayer 0
, Cmd.map ChestMsg cmd
]
)
initPlayer id =
Cmd.map ApiMsg <| Api.fetchPlayer id
---
@@ -93,206 +72,26 @@ initPlayer id =
view : Model -> Browser.Document Msg
view model =
let
renderControls =
Modes.viewControls model.mode model.route
|> List.map (Html.map ModeMsg)
(title, body) =
case model of
Chest chest ->
("Loot-a-lot", Chest.view chest)
Admin session ->
("Administration", Admin.view session)
About ->
("A propos", p [] ["A propos"])
in
{ title = "Loot-a-lot in ELM"
, body =
[ viewHeaderBar model
, viewPlayerBar model.player renderControls
, main_
[ class "container" ]
[ viewNotification model.state.notification
, Chest.view
model.mode
model.route
model.chest
|> Html.map ChestMsg
]
, hr [] []
, section [ class "container" ] [ viewDebugSection model ]
]
}
viewNotification : Maybe String -> Html Msg
viewNotification notification =
case notification of
Just t ->
div [ class "notification is-success is-marginless" ]
[ button [ class "delete", onClick ClearNotification ] []
, text t
]
Nothing ->
text ""
-- DEBUG SECTION
viewDebugSection : Model -> Html Msg
viewDebugSection model =
div [ class "panel is-danger" ]
[ p [ class "panel-heading" ] [ text "Debug" ]
, debugSwitchPlayers
, p [ class "panel-block has-text-danger" ] [ text <| Maybe.withDefault "" model.state.error ]
, p [ class "panel-block" ] [ text ("Route : " ++ Debug.toString model.route) ]
, p [ class "panel-block" ] [ text ("Active Mode : " ++ Debug.toString model.mode) ]
, p [ class "panel-block" ] [ text ("Selection : " ++ Debug.toString model.chest.selection) ]
, p [ class "panel-block" ] [ text ("Claims : " ++ Debug.toString model.chest.claims) ]
, p [] debugSandbox
]
stackedIcon name =
span [ class "icon is-medium" ]
[ span [ class "fa-stack" ]
[ i [ class "fas fa-circle fa-stack-2x" ] []
, i [ class (name ++ " fa-inverse fa-stack-1x") ] []
, text ""
]
]
debugSandbox =
[ stackedIcon "fas fa-coins"
, stackedIcon "fab fa-d-and-d"
, stackedIcon "fas fa-praying-hands"
, stackedIcon "fas fa-gem"
, stackedIcon "fas fa-pen"
, stackedIcon "fas fa-percentage"
, stackedIcon "fas fa-store-alt"
, stackedIcon "fas fa-cart-plus"
, stackedIcon "fas fa-angry"
, stackedIcon "fas fa-plus"
, stackedIcon "fas fa-tools"
, stackedIcon "fas fa-search"
]
debugSwitchPlayers : Html Msg
debugSwitchPlayers =
div [ class "panel-tabs" ]
[ a [ onClick (PlayerChanged 0) ] [ text "Groupe" ]
, a [ onClick (PlayerChanged 1) ] [ text "Lomion" ]
, a [ onClick (PlayerChanged 2) ] [ text "Fefi" ]
]
-- HEADER SECTION
viewHeaderBar : Model -> Html Msg
viewHeaderBar model =
nav [ class "navbar container", class "is-info" ]
[ div [ class "navbar-brand" ]
[ a [ class "navbar-item", href "/" ]
[ renderIcon { icon = "fab fa-d-and-d", size = "medium", ratio = "2x" }
, span [] [ text model.player.name ]
]
, a [ class "navbar-burger is-active" ]
[ span [ attribute "aria-hidden" "true" ] []
, span [ attribute "aria-hidden" "true" ] []
, span [ attribute "aria-hidden" "true" ] []
]
]
, div [ class "navbar-menu is-active" ]
[ div [ class "navbar-end" ]
[ a [ class "navbar-item", href "/marchand" ]
[ renderIcon { icon = "fas fa-store-alt", ratio = "1x", size = "medium" }
, span [] [ text "Marchand" ]
]
, a
[ class "navbar-item"
, href
(if model.player.id == 0 then
"/nouveau-tresor"
else
"/coffre"
)
]
[ renderIcon { icon = "fas fa-gem", ratio = "1x", size = "medium" }
, span []
[ text
(if model.player.id == 0 then
"Nouveau loot"
else
"Coffre de groupe"
)
]
]
]
]
]
-- PLAYER BAR
viewPlayerBar : Player -> List (Html Msg) -> Html Msg
viewPlayerBar player actionControls =
section [ class "level container is-mobile box" ]
[ div [ class "level-left" ]
([ div [ class "level-item" ]
[ span [ class "icon is-large" ]
[ i [ class "fas fa-2x fa-piggy-bank" ] [] ]
]
]
++ viewWealth player.wealth
++ (if player.debt > 0 then
[ div [ class "level-item" ]
[ p [ class "heading is-size-4 has-text-danger" ]
[ text ("Dette : " ++ String.fromInt player.debt ++ "po") ]
]
]
else
[]
)
)
, div [ class "level-right" ] actionControls
]
viewWealth : Wealth -> List (Html Msg)
viewWealth wealth =
[ showWealthField "pp" <| String.fromInt wealth.pp
, showWealthField "gp" <| String.padLeft 2 '0' <| String.fromInt wealth.gp
, showWealthField "sp" <| String.fromInt wealth.sp
, showWealthField "cp" <| String.fromInt wealth.cp
]
showWealthField : String -> String -> Html Msg
showWealthField name value =
div [ class "level-item" ]
[ p [ class "has-text-right" ]
[ strong [ class "heading is-marginless" ] [ text name ]
, span [ class <| "is-size-4" ] [ text value ]
]
]
-- UPDATE
{ title = title
, body = body }
type Msg
= LinkClicked Browser.UrlRequest
| UrlChanged Url.Url
| ApiMsg Api.Msg
| ChestMsg Chest.Msg
| ModeMsg Modes.Msg
| PlayerChanged Int
| ClearNotification
= UrlChanged Url.Url
| LinkClicked Browser.UrlRequest
| GotChestMsg Chest.Msg
| GotAdminMsg Admin.Msg
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
LinkClicked urlRequest ->
@@ -326,188 +125,12 @@ update msg model =
Nothing ->
( setError "Invalid route" model, Cmd.none )
PlayerChanged newId ->
( { model | player = Api.blankPlayer }, initPlayer newId )
ChestMsg chestMsg ->
GotChestMsg chestMsg ->
let
( chest, _ ) =
( chest, cmd ) =
Chest.update chestMsg model.chest
in
( { model | chest = chest }, Cmd.none )
ApiMsg apiMsg ->
case apiMsg of
Api.GotActionResult response ->
case response of
Ok result ->
let
updates =
Maybe.withDefault [] result.updates
notification =
result.notification
errors =
Maybe.withDefault "" result.errors
in
List.foldl applyUpdate model updates
|> setNotification notification
|> setError errors
|> update (ModeMsg (Modes.ModeSwitched Modes.None))
Err r ->
( setError (Debug.toString r) model, Cmd.none )
Api.GotPlayer result ->
case result of
Ok player ->
( { model | player = player }
, Cmd.none
)
Err error ->
( setError ("Fetching player... " ++ Debug.toString error) model
, Cmd.none
)
ModeMsg modeMsg ->
case modeMsg of
Modes.ModeSwitched newMode ->
( { model
| mode = newMode
, chest =
let
( newChest, _ ) =
Chest.update
(Chest.SetSelection
(case newMode of
Modes.None ->
Nothing
Modes.Grab ->
-- Currently claimed object are initially selected
Just (Set.fromList <| List.map (\c -> c.loot_id) model.chest.claims)
others ->
Just Set.empty
)
)
model.chest
in
newChest
}
, Cmd.none
)
Modes.ConfirmAction ->
case model.mode of
-- This should not happen, so we ignore it
Modes.None ->
(model, Cmd.none)
mode ->
let
items =
Chest.getSelected model.route model.chest
in
( model
, Cmd.map ApiMsg <|
Api.sendRequest
mode
(String.fromInt model.player.id)
items
)
ClearNotification ->
( setNotification Nothing model, Cmd.none )
setNotification : Maybe String -> Model -> Model
setNotification notification model =
let
state =
model.state
in
{ model
| state =
{ state | notification = notification }
}
setLoot : Loot -> Model -> Model
setLoot items model =
let
chest =
model.chest
in
{ model | chest = { chest | loot = items } }
setClaims : Claims -> Model -> Model
setClaims claims model =
let
chest = model.chest
in
{ model | chest = { chest | claims = claims } }
-- DbUpdates always refer to the active player's loot
applyUpdate : Api.Update -> Model -> Model
applyUpdate u model =
case u of
Api.ItemRemoved item ->
model
|> setLoot (List.filter (\i -> i.id /= item.id) model.chest.loot)
Api.ItemAdded item ->
model |> setLoot (item :: model.chest.loot)
Api.WealthUpdated diff ->
let
player =
model.player
wealth =
player.wealth
in
{ model
| player =
{ player
| wealth =
Wealth
(wealth.cp + diff.cp)
(wealth.sp + diff.sp)
(wealth.gp + diff.gp)
(wealth.pp + diff.pp)
}
}
Api.ClaimAdded claim ->
model |> setClaims (claim :: model.chest.claims)
Api.ClaimRemoved claim ->
model
|> setClaims (List.filter (\c -> c.id /= claim.id) model.chest.claims)
-- ERRORS
setError : String -> Model -> Model
setError error model =
let
state =
model.state
in
{ model
| state =
{ state | error = Just error }
}
( Chest chest, Cmd.map GotChestMsg cmd )
-- STATE Utils
-- SUBSCRIPTIONS