510 lines
14 KiB
Elm
510 lines
14 KiB
Elm
module Page exposing (Page(..), PageMsg, gotoGroupChest, gotoHome, gotoShop, initHome, update, view)
|
|
|
|
import Api
|
|
import Api.Player
|
|
import Html exposing (..)
|
|
import Html.Attributes exposing (..)
|
|
import Html.Events exposing (..)
|
|
import Page.Dashboard as Home
|
|
import Page.GroupChest as GroupChest
|
|
import Page.Shop as Shop
|
|
import Route
|
|
import Session exposing (Session)
|
|
import Utils exposing (renderIcon)
|
|
import Wealth
|
|
|
|
|
|
type Page
|
|
= Home Home.Model
|
|
| GroupChest GroupChest.Model
|
|
| Shop Shop.Model
|
|
| About
|
|
| Loading
|
|
|
|
|
|
init =
|
|
Loading
|
|
|
|
|
|
mapPageMsg toMsg ( controls, content ) =
|
|
( Html.map toMsg controls
|
|
, List.map (Html.map toMsg) content
|
|
)
|
|
|
|
|
|
maybeSession page =
|
|
case page of
|
|
Home model ->
|
|
Just <| Home.getSession model
|
|
|
|
GroupChest model ->
|
|
Just <| Session.getSession model
|
|
|
|
Shop model ->
|
|
Just <| Session.getSession model
|
|
|
|
_ ->
|
|
Nothing
|
|
|
|
|
|
view page =
|
|
let
|
|
( title, ( controls, content ) ) =
|
|
case page of
|
|
Home home ->
|
|
( "Lootalot"
|
|
, Home.view home
|
|
|> mapPageMsg GotHomeMsg
|
|
)
|
|
|
|
GroupChest chest ->
|
|
( "Lootalot"
|
|
, GroupChest.view chest
|
|
|> mapPageMsg GotGroupChestMsg
|
|
)
|
|
|
|
Shop shop ->
|
|
( "Marchand"
|
|
, Shop.view shop
|
|
|> mapPageMsg GotShopMsg
|
|
)
|
|
|
|
About ->
|
|
( "Loot-a-lot", ( text "", [ p [] [ text "A propos" ] ] ) )
|
|
|
|
Loading ->
|
|
( "Loot-a-lot"
|
|
, ( text ""
|
|
, [ div [ class "hero" ]
|
|
[ div [ class "hero-body" ]
|
|
[ p [] [ text "Chargement" ] ]
|
|
]
|
|
]
|
|
)
|
|
)
|
|
|
|
navbarTitle =
|
|
case maybeSession page of
|
|
Just session ->
|
|
case Session.user session of
|
|
Session.Player data ->
|
|
data.player.name
|
|
|
|
Session.Admin ->
|
|
"Administration"
|
|
|
|
Nothing ->
|
|
"Loot-a-lot"
|
|
|
|
navbarLinks =
|
|
case maybeSession page of
|
|
Just session ->
|
|
case Session.user session of
|
|
Session.Player data ->
|
|
[ navLink "fas fa-store-alt" Route.Merchant page
|
|
, if data.player.id /= 0 then
|
|
navLink "fas fa-gem" Route.GroupChest page
|
|
|
|
else
|
|
text ""
|
|
]
|
|
|
|
Session.Admin ->
|
|
[ navLink "fas fa-store-alt" Route.Merchant page ]
|
|
|
|
Nothing ->
|
|
[]
|
|
in
|
|
( title
|
|
, { title = navbarTitle, links = navbarLinks }
|
|
, [ div [ class "container" ] <|
|
|
viewSessionBar (maybeSession page) [ controls ]
|
|
:: div [ class "section" ]
|
|
[ case Maybe.map Session.notification (maybeSession page) of
|
|
Just (Just t) ->
|
|
viewNotification NotifySuccess t
|
|
|
|
_ ->
|
|
text ""
|
|
, case Maybe.map Session.error (maybeSession page) of
|
|
Just (Just t) ->
|
|
viewNotification NotifyError t
|
|
|
|
_ ->
|
|
text ""
|
|
]
|
|
:: content
|
|
]
|
|
)
|
|
|
|
|
|
type NotificationKind
|
|
= NotifySuccess
|
|
| NotifyError
|
|
|
|
|
|
viewNotification kind content =
|
|
let
|
|
className =
|
|
case kind of
|
|
NotifySuccess ->
|
|
"is-success"
|
|
|
|
NotifyError ->
|
|
"is-danger"
|
|
in
|
|
div [ class ("notification " ++ className) ]
|
|
[ text content ]
|
|
|
|
|
|
viewSessionBar session controls =
|
|
let
|
|
user =
|
|
case Maybe.map Session.user session of
|
|
Nothing ->
|
|
[ text "" ]
|
|
|
|
Just (Session.Player data) ->
|
|
-- TODO: Urgh ! When will this Wealth.Model move out of session !
|
|
Wealth.view data.player.wealth data.wealth
|
|
++ (if data.player.debt > 0 then
|
|
[ div [ class "level-item" ]
|
|
[ p [ class "has-text-right has-text-danger" ]
|
|
[ strong [ class "heading is-marginless has-text-danger" ] [ text "Dette" ]
|
|
, span [ class <| "is-size-4" ] [ text (String.fromInt data.player.debt ++ "po") ]
|
|
]
|
|
]
|
|
]
|
|
|
|
else
|
|
[]
|
|
)
|
|
|> List.map (Html.map Wealth)
|
|
|
|
Just Session.Admin ->
|
|
[ text "Admin" ]
|
|
in
|
|
section [ class "hero is-dark is-bold" ]
|
|
[ div [ class "hero-body" ]
|
|
[ renderLevel user controls ]
|
|
]
|
|
|
|
|
|
renderLevel left right =
|
|
div [ class "level container is-mobile" ]
|
|
[ div [ class "level-left" ] left
|
|
, div [ class "level-right" ] right
|
|
]
|
|
|
|
|
|
|
|
-- PLAYER BAR
|
|
|
|
|
|
navLink icon route page =
|
|
let
|
|
( link, url ) =
|
|
case route of
|
|
Route.Merchant ->
|
|
( "Marchand", "/marchand" )
|
|
|
|
Route.GroupChest ->
|
|
( "Coffre de groupe", "/groupe" )
|
|
|
|
Route.Home ->
|
|
( "Home", "/" )
|
|
|
|
Route.About ->
|
|
( "About", "/" )
|
|
|
|
isActive =
|
|
case ( route, page ) of
|
|
( Route.Merchant, Shop _ ) ->
|
|
True
|
|
|
|
( Route.GroupChest, GroupChest _ ) ->
|
|
True
|
|
|
|
( Route.Home, Home _ ) ->
|
|
True
|
|
|
|
( Route.About, About ) ->
|
|
True
|
|
|
|
_ ->
|
|
False
|
|
in
|
|
a [ class "navbar-item", classList [ ( "is-active", isActive ) ], href url ]
|
|
[ renderIcon { icon = icon, ratio = "1x", size = "medium" }
|
|
, span [] [ text link ]
|
|
]
|
|
|
|
|
|
|
|
-- UPDATE
|
|
--
|
|
|
|
|
|
type PageMsg
|
|
= ApiMsg Api.Msg
|
|
| GotGroupChestMsg GroupChest.Msg
|
|
| GotHomeMsg Home.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
|
|
Home model ->
|
|
Home <| Home.updateSession model (func session)
|
|
|
|
GroupChest model ->
|
|
GroupChest { model | session = func session }
|
|
|
|
Shop model ->
|
|
Shop { model | session = func session }
|
|
|
|
_ ->
|
|
page
|
|
|
|
|
|
|
|
-- Restores the page after an action has be resolved (either success or error)
|
|
|
|
|
|
closeAction ( page, cmd ) =
|
|
case page of
|
|
Home home ->
|
|
( page, cmd )
|
|
|
|
GroupChest chest ->
|
|
( GroupChest (GroupChest.refresh chest), cmd )
|
|
|
|
Shop shop ->
|
|
( page, cmd )
|
|
|
|
_ ->
|
|
( page, cmd )
|
|
|
|
|
|
update msg page =
|
|
case ( msg, page, maybeSession page ) of
|
|
-- Home page
|
|
-- Capture API messages
|
|
( GotHomeMsg (Home.Api apiMsg), Home home, _ ) ->
|
|
update (ApiMsg apiMsg) page
|
|
|
|
-- Relay others
|
|
( GotHomeMsg subMsg, Home home, _ ) ->
|
|
Home.update subMsg home
|
|
|> updatePage Home GotHomeMsg
|
|
|
|
( GotHomeMsg _, _, _ ) ->
|
|
( page, Cmd.none )
|
|
|
|
-- Group chest
|
|
( GotGroupChestMsg (GroupChest.Api apiMsg), GroupChest _, _ ) ->
|
|
update (ApiMsg apiMsg) page
|
|
|> closeAction
|
|
|
|
( GotGroupChestMsg subMsg, GroupChest chest, _ ) ->
|
|
GroupChest.update subMsg chest
|
|
|> updatePage GroupChest GotGroupChestMsg
|
|
|
|
( GotGroupChestMsg _, _, _ ) ->
|
|
( page, Cmd.none )
|
|
|
|
-- Shop page
|
|
( GotShopMsg (Shop.Api apiMsg), Shop shop, _ ) ->
|
|
update (ApiMsg apiMsg) page
|
|
|
|
( GotShopMsg subMsg, Shop shop, _ ) ->
|
|
Shop.update subMsg shop
|
|
|> updatePage Shop GotShopMsg
|
|
|
|
( GotShopMsg _, _, _ ) ->
|
|
( page, Cmd.none )
|
|
|
|
-- Wealth viewer/editor
|
|
( Wealth wealthMsg, _, Just session ) ->
|
|
let
|
|
wealthModel =
|
|
Session.wealth session
|
|
in
|
|
case Session.user session of
|
|
Session.Player data ->
|
|
let
|
|
( newWealth, maybeEdit ) =
|
|
Wealth.update wealthMsg data.wealth
|
|
in
|
|
( map (Session.updateWealth newWealth) page
|
|
, case maybeEdit of
|
|
Just amount ->
|
|
Api.confirmAction
|
|
(String.fromInt (.id data.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 )
|
|
|
|
-- Handle API messages
|
|
( 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
|
|
|
|
updatedUser =
|
|
List.foldl applyUpdate (Session.user session) updates
|
|
in
|
|
( page
|
|
|> map (Session.updateUser updatedUser)
|
|
|> map (Session.updateNotifications ( result.notification, result.errors ))
|
|
, 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 )
|
|
|
|
|
|
updatePage toPage toMsg ( subModel, subMsg ) =
|
|
( toPage subModel
|
|
, Cmd.map toMsg 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 data ->
|
|
case u of
|
|
Api.ItemRemoved item ->
|
|
Session.Player
|
|
{ data
|
|
| loot =
|
|
List.filter
|
|
(\i -> i.id /= item.id)
|
|
data.loot
|
|
}
|
|
|
|
Api.ItemAdded item ->
|
|
Session.Player { data | loot = item :: data.loot }
|
|
|
|
Api.WealthUpdated diff ->
|
|
let
|
|
player =
|
|
data.player
|
|
|
|
wealth =
|
|
player.wealth
|
|
in
|
|
Session.Player
|
|
{ data
|
|
| player =
|
|
{ player
|
|
| wealth =
|
|
Api.Player.Wealth
|
|
(wealth.cp + diff.cp)
|
|
(wealth.sp + diff.sp)
|
|
(wealth.gp + diff.gp)
|
|
(wealth.pp + diff.pp)
|
|
}
|
|
}
|
|
|
|
Api.ClaimAdded claim ->
|
|
Session.Player { data | claims = claim :: data.claims }
|
|
|
|
Api.ClaimRemoved claim ->
|
|
Session.Player { data | claims = List.filter (\c -> c.id /= claim.id) data.claims }
|
|
|
|
Session.Admin ->
|
|
user
|
|
|
|
|
|
|
|
-- CHANGE ROUTE
|
|
|
|
|
|
initHome session =
|
|
Home.init session
|
|
|> updatePage Home GotHomeMsg
|
|
|
|
|
|
gotoHome page =
|
|
case maybeSession page of
|
|
Nothing ->
|
|
( page, Cmd.none )
|
|
|
|
Just session ->
|
|
Home.init session
|
|
|> updatePage Home GotHomeMsg
|
|
|
|
|
|
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 =
|
|
()
|