this is a lot of work...
This commit is contained in:
311
src/Page.elm
311
src/Page.elm
@@ -1,39 +1,27 @@
|
||||
module Page exposing (Page(..), PageMsg, gotoHome, gotoShop, update, view)
|
||||
module Page exposing (Page(..), PageMsg, gotoHome, gotoShop, initHome, update, view)
|
||||
|
||||
import Api
|
||||
import Api.Player
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (..)
|
||||
import Page.Admin as Admin
|
||||
import Page.Chest as Chest
|
||||
import Page.Chest.Wealth as Wealth
|
||||
import Page.Dashboard as Dashboard
|
||||
import Page.GroupChest as GroupChest
|
||||
import Page.Shop as Shop
|
||||
import Session exposing (Session)
|
||||
import Utils exposing (renderIcon)
|
||||
import Wealth
|
||||
|
||||
|
||||
type Page
|
||||
= Chest Chest.Model
|
||||
| Admin Admin.Model
|
||||
= Dashboard Dashboard.Model
|
||||
| GroupChest GroupChest.Model
|
||||
| Shop Shop.Model
|
||||
| About
|
||||
| Loading
|
||||
|
||||
|
||||
|
||||
{-
|
||||
|
||||
type Page
|
||||
= Dashboard Session
|
||||
| GroupChest Session
|
||||
| Shop Shop.Model
|
||||
| NewLoot Session
|
||||
| About
|
||||
| Loading
|
||||
|
||||
|
||||
-}
|
||||
|
||||
|
||||
init =
|
||||
Loading
|
||||
|
||||
@@ -42,29 +30,40 @@ mapMsg toMsg =
|
||||
List.map (Html.map toMsg)
|
||||
|
||||
|
||||
maybeSession page =
|
||||
case page of
|
||||
Dashboard model ->
|
||||
Just <| Session.getSession model
|
||||
|
||||
GroupChest model ->
|
||||
Just <| Session.getSession model
|
||||
|
||||
Shop model ->
|
||||
Just <| Session.getSession model
|
||||
|
||||
_ ->
|
||||
Nothing
|
||||
|
||||
|
||||
view page =
|
||||
let
|
||||
maybeSession =
|
||||
case page of
|
||||
Chest model ->
|
||||
Just <| Session.getSession model
|
||||
|
||||
Admin model ->
|
||||
Just <| Admin.getSession model
|
||||
|
||||
Shop model ->
|
||||
Just <| Session.getSession model
|
||||
|
||||
_ ->
|
||||
Nothing
|
||||
|
||||
( title, ( controls, content ) ) =
|
||||
case page of
|
||||
Chest chest ->
|
||||
( "Lootalot", ( text "", mapMsg GotChestMsg <| Chest.view chest ) )
|
||||
Dashboard home ->
|
||||
( "Lootalot"
|
||||
, Dashboard.view home
|
||||
|> Tuple.mapBoth
|
||||
(Html.map GotDashboardMsg)
|
||||
(mapMsg GotDashboardMsg)
|
||||
)
|
||||
|
||||
Admin admin ->
|
||||
( "Administration", ( text "", mapMsg GotAdminMsg <| Admin.view admin ) )
|
||||
GroupChest chest ->
|
||||
( "Lootalot"
|
||||
, GroupChest.view chest
|
||||
|> Tuple.mapBoth
|
||||
(Html.map GotGroupChestMsg)
|
||||
(mapMsg GotGroupChestMsg)
|
||||
)
|
||||
|
||||
Shop shop ->
|
||||
( "Marchand"
|
||||
@@ -81,7 +80,7 @@ view page =
|
||||
( "Loot-a-lot", ( text "", [ p [] [ text "Chargement" ] ] ) )
|
||||
|
||||
navbarTitle =
|
||||
case maybeSession of
|
||||
case maybeSession page of
|
||||
Just session ->
|
||||
case Session.user session of
|
||||
Session.Player player _ ->
|
||||
@@ -94,7 +93,7 @@ view page =
|
||||
"Loot-a-lot"
|
||||
|
||||
navbarLinks =
|
||||
case maybeSession of
|
||||
case maybeSession page of
|
||||
Just session ->
|
||||
case Session.user session of
|
||||
Session.Player player _ ->
|
||||
@@ -119,20 +118,24 @@ view page =
|
||||
( title
|
||||
, { title = navbarTitle, links = navbarLinks }
|
||||
, [ div [ class "container" ] <|
|
||||
viewSessionBar maybeSession [ controls ]
|
||||
viewSessionBar (maybeSession page) [ controls ]
|
||||
:: content
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
viewSessionBar maybeSession controls =
|
||||
viewSessionBar session controls =
|
||||
let
|
||||
user =
|
||||
case Maybe.map Session.user maybeSession of
|
||||
case Maybe.map Session.user session of
|
||||
Nothing ->
|
||||
[ text "" ]
|
||||
|
||||
Just (Session.Player player wealth) ->
|
||||
let
|
||||
_ =
|
||||
Debug.log "viewSessionBar wealth" player.wealth
|
||||
in
|
||||
Wealth.view player.wealth wealth
|
||||
++ (if player.debt > 0 then
|
||||
[ div [ class "level-item" ]
|
||||
@@ -176,30 +179,135 @@ navLink icon linkText url =
|
||||
|
||||
-- UPDATE
|
||||
--
|
||||
-- Note : All pages 'update' function
|
||||
-- shall return (subMode, Cmd Api.Msg)
|
||||
|
||||
|
||||
type PageMsg
|
||||
= GotChestMsg Chest.Msg
|
||||
| GotAdminMsg Admin.Msg
|
||||
= ApiMsg Api.Msg
|
||||
| GotGroupChestMsg GroupChest.Msg
|
||||
| GotDashboardMsg Dashboard.Msg
|
||||
| GotShopMsg Shop.Msg
|
||||
| Wealth Wealth.Msg
|
||||
|
||||
|
||||
|
||||
-- Maps the page session to a function, if any
|
||||
|
||||
|
||||
map func page =
|
||||
case maybeSession page of
|
||||
Nothing ->
|
||||
page
|
||||
|
||||
Just session ->
|
||||
case page of
|
||||
Dashboard model ->
|
||||
Dashboard { model | session = func session }
|
||||
|
||||
GroupChest model ->
|
||||
GroupChest { model | session = func session }
|
||||
|
||||
Shop model ->
|
||||
Shop { model | session = func session }
|
||||
|
||||
_ ->
|
||||
page
|
||||
|
||||
|
||||
update msg page =
|
||||
case ( msg, page ) of
|
||||
( GotChestMsg subMsg, Chest chest ) ->
|
||||
Chest.update subMsg chest
|
||||
|> updatePage Chest GotChestMsg
|
||||
case ( msg, page, maybeSession page ) of
|
||||
( GotGroupChestMsg subMsg, GroupChest chest, _ ) ->
|
||||
GroupChest.update subMsg chest
|
||||
|> updatePage GroupChest GotGroupChestMsg
|
||||
|
||||
( GotAdminMsg subMsg, Admin admin ) ->
|
||||
Admin.update subMsg admin
|
||||
|> updatePage Admin GotAdminMsg
|
||||
( GotGroupChestMsg _, _, _ ) ->
|
||||
( page, Cmd.none )
|
||||
|
||||
( GotShopMsg subMsg, Shop shop ) ->
|
||||
( GotDashboardMsg subMsg, Dashboard home, _ ) ->
|
||||
Dashboard.update subMsg home
|
||||
|> updatePage Dashboard GotDashboardMsg
|
||||
|
||||
( GotDashboardMsg _, _, _ ) ->
|
||||
( page, Cmd.none )
|
||||
|
||||
( GotShopMsg subMsg, Shop shop, _ ) ->
|
||||
Shop.update subMsg shop
|
||||
|> updatePage Shop GotShopMsg
|
||||
|
||||
_ ->
|
||||
( GotShopMsg _, _, _ ) ->
|
||||
( page, Cmd.none )
|
||||
|
||||
( Wealth wealthMsg, _, Just session ) ->
|
||||
let
|
||||
wealthModel =
|
||||
Session.wealth session
|
||||
in
|
||||
case Session.user session of
|
||||
Session.Player player aModel ->
|
||||
let
|
||||
( newWealth, maybeEdit ) =
|
||||
Wealth.update wealthMsg aModel
|
||||
in
|
||||
( map (Session.updateWealth newWealth) page
|
||||
, case maybeEdit of
|
||||
Just amount ->
|
||||
Api.confirmAction
|
||||
(String.fromInt (.id player))
|
||||
(Api.WealthPayload amount)
|
||||
|> Cmd.map ApiMsg
|
||||
|
||||
Nothing ->
|
||||
Cmd.none
|
||||
)
|
||||
|
||||
_ ->
|
||||
Debug.log "not a player but updates wealth"
|
||||
( page, Cmd.none )
|
||||
|
||||
( Wealth wealthMsg, _, Nothing ) ->
|
||||
( page, Cmd.none )
|
||||
|
||||
( ApiMsg (Api.GotActionResult response), _, Just session ) ->
|
||||
let
|
||||
_ =
|
||||
Debug.log "got api response" response
|
||||
in
|
||||
case response of
|
||||
Ok result ->
|
||||
let
|
||||
updates =
|
||||
Maybe.withDefault [] result.updates
|
||||
|
||||
notification =
|
||||
result.notification
|
||||
|
||||
errors =
|
||||
Maybe.withDefault "" result.errors
|
||||
|
||||
newUser =
|
||||
Debug.log "newUser" <|
|
||||
List.foldl applyUpdate (Session.user session) updates
|
||||
in
|
||||
( map (Session.updateUser newUser) page
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
-- |> setNotification notification
|
||||
-- |> setError errors
|
||||
-- |> update (ModeSwitched View)
|
||||
Err r ->
|
||||
let
|
||||
_ =
|
||||
Debug.log "ERR: ActionResult:" r
|
||||
in
|
||||
( page, Cmd.none )
|
||||
|
||||
( ApiMsg apiMsg, _, Nothing ) ->
|
||||
let
|
||||
_ =
|
||||
Debug.log "rogue api msg !" apiMsg
|
||||
in
|
||||
( page, Cmd.none )
|
||||
|
||||
|
||||
@@ -209,28 +317,95 @@ updatePage toPage toMsg ( subModel, subMsg ) =
|
||||
)
|
||||
|
||||
|
||||
applyUpdate : Api.Update -> Session.User -> Session.User
|
||||
applyUpdate u user =
|
||||
let
|
||||
_ =
|
||||
Debug.log "applyUpdate" u
|
||||
|
||||
_ =
|
||||
Debug.log "on" user
|
||||
in
|
||||
{- Note: DbUpdates always refer to the active player -}
|
||||
case user of
|
||||
Session.Player player wealthModel ->
|
||||
case u of
|
||||
Api.ItemRemoved item ->
|
||||
--List.filter (\i -> i.id /= item.id) model.state.playerLoot
|
||||
user
|
||||
|
||||
Api.ItemAdded item ->
|
||||
--{ model | state = { state | playerLoot = item :: model.state.playerLoot } }
|
||||
user
|
||||
|
||||
Api.WealthUpdated diff ->
|
||||
let
|
||||
wealth =
|
||||
player.wealth
|
||||
|
||||
_ =
|
||||
Debug.log "updatePlayerWealth" diff
|
||||
in
|
||||
Session.Player
|
||||
{ player
|
||||
| wealth =
|
||||
Api.Player.Wealth
|
||||
(wealth.cp + diff.cp)
|
||||
(wealth.sp + diff.sp)
|
||||
(wealth.gp + diff.gp)
|
||||
(wealth.pp + diff.pp)
|
||||
}
|
||||
wealthModel
|
||||
|
||||
Api.ClaimAdded claim ->
|
||||
-- { model | claims = claim :: model.claims }
|
||||
user
|
||||
|
||||
Api.ClaimRemoved claim ->
|
||||
-- { model | claims = List.filter (\c -> c.id /= claim.id) model.claims }
|
||||
user
|
||||
|
||||
Session.Admin ->
|
||||
user
|
||||
|
||||
|
||||
|
||||
-- CHANGE ROUTE
|
||||
|
||||
|
||||
gotoHome session =
|
||||
case Session.user session of
|
||||
Session.Player _ _ ->
|
||||
Chest.init session
|
||||
|> updatePage Chest GotChestMsg
|
||||
|
||||
Session.Admin ->
|
||||
Admin.init session
|
||||
|> updatePage Admin GotAdminMsg
|
||||
initHome session =
|
||||
Dashboard.init session
|
||||
|> updatePage Dashboard GotDashboardMsg
|
||||
|
||||
|
||||
gotoShop session =
|
||||
Shop.init session
|
||||
|> updatePage Shop GotShopMsg
|
||||
gotoHome page =
|
||||
case maybeSession page of
|
||||
Nothing ->
|
||||
( page, Cmd.none )
|
||||
|
||||
Just session ->
|
||||
Dashboard.init session
|
||||
|> updatePage Dashboard GotDashboardMsg
|
||||
|
||||
|
||||
gotoGroupChest session =
|
||||
()
|
||||
gotoShop page =
|
||||
case maybeSession page of
|
||||
Nothing ->
|
||||
( page, Cmd.none )
|
||||
|
||||
Just session ->
|
||||
Shop.init session
|
||||
|> updatePage Shop GotShopMsg
|
||||
|
||||
|
||||
gotoGroupChest page =
|
||||
case maybeSession page of
|
||||
Nothing ->
|
||||
( page, Cmd.none )
|
||||
|
||||
Just session ->
|
||||
GroupChest.init session
|
||||
|> updatePage GroupChest GotGroupChestMsg
|
||||
|
||||
|
||||
gotoInventory session =
|
||||
|
||||
Reference in New Issue
Block a user