this is a lot of work...

This commit is contained in:
2019-11-29 16:20:07 +01:00
parent c50cb37900
commit dbc99830d6
12 changed files with 1941 additions and 1474 deletions

View File

@@ -143,7 +143,7 @@ update msg model =
Just logged ->
let
( page, cmd ) =
Page.gotoHome logged
Page.initHome logged
in
( model |> setPage page, Cmd.map PageMsg cmd )
@@ -158,20 +158,22 @@ update msg model =
Browser.External href ->
( model, Cmd.none )
( UrlChanged url, page ) ->
( UrlChanged url, from ) ->
-- Handle routing according to current page
case ( Route.fromUrl url, page ) of
( Just (Route.Home Route.MerchantLoot), Page.Admin admin ) ->
case Route.fromUrl url of
Just (Route.Home Route.MerchantLoot) ->
let
( shopPage, cmd ) =
Page.gotoShop (Admin.getSession admin)
Page.gotoShop from
in
( model |> setPage shopPage, Cmd.map PageMsg cmd )
( Just (Route.Home content), Page.Chest chest ) ->
( model |> setPage (Page.Chest (Chest.setContent content chest))
, Cmd.none
)
Just (Route.Home Route.PlayerLoot) ->
let
( shopPage, cmd ) =
Page.gotoHome from
in
( model |> setPage shopPage, Cmd.map PageMsg cmd )
{-
( Just route, Page.Admin admin ) ->

View File

@@ -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,15 +30,13 @@ mapMsg toMsg =
List.map (Html.map toMsg)
view page =
let
maybeSession =
maybeSession page =
case page of
Chest model ->
Dashboard model ->
Just <| Session.getSession model
Admin model ->
Just <| Admin.getSession model
GroupChest model ->
Just <| Session.getSession model
Shop model ->
Just <| Session.getSession model
@@ -58,13 +44,26 @@ view page =
_ ->
Nothing
view page =
let
( 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 =
gotoHome page =
case maybeSession page of
Nothing ->
( page, Cmd.none )
Just session ->
Dashboard.init session
|> updatePage Dashboard GotDashboardMsg
gotoShop page =
case maybeSession page of
Nothing ->
( page, Cmd.none )
Just session ->
Shop.init session
|> updatePage Shop GotShopMsg
gotoGroupChest session =
()
gotoGroupChest page =
case maybeSession page of
Nothing ->
( page, Cmd.none )
Just session ->
GroupChest.init session
|> updatePage GroupChest GotGroupChestMsg
gotoInventory session =

File diff suppressed because it is too large Load Diff

1301
src/Page/Chest.elm.old Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -7,11 +7,6 @@ import Html.Events exposing (..)
import Table
type ExitStatus
= Confirmed Loot
| Canceled
type alias Model =
{ itemList : String
, invalidItems : Loot
@@ -27,30 +22,10 @@ init =
[]
view : Model -> ( Html Msg, List (Html Msg) )
view : Model -> Html Msg
view model =
let
allLootValid =
if List.length model.invalidItems + List.length model.validItems == 0 then
False
else
List.all itemIsValid model.invalidItems
in
( div [ class "buttons" ]
[ button
[ class "button"
, disabled <| not allLootValid
, onClick ConfirmClicked
]
[ text "Ok" ]
, button
[ class "button"
, onClick CancelClicked
]
[ text "Annuler" ]
]
, [ div [ class "section" ]
article []
[ div [ class "section" ]
[ textarea
[ class "textarea"
, value model.itemList
@@ -65,9 +40,19 @@ view model =
[ text "Mettre dans le coffre" ]
]
, div [ class "section" ]
[ model.validItems ++ model.invalidItems |> Table.view viewOrEditRenderer ]
[ model.validItems
++ model.invalidItems
|> Table.view (Table.renderRowLevel viewOrEditRenderer (\i -> []))
]
)
]
allValid model =
if List.length model.invalidItems + List.length model.validItems == 0 then
False
else
List.all itemIsValid model.invalidItems
itemIsValid item =
@@ -111,7 +96,7 @@ viewOrEditRenderer item =
]
else
Table.name item
[ p [] [ text <| .name item ] ]
type Msg
@@ -120,24 +105,20 @@ type Msg
| InvalidItemNameChanged Int String
| InvalidItemPriceChanged Int String
| GotCheckedItems Loot (Maybe String)
| ConfirmClicked
| CancelClicked
update : Msg -> Model -> ( Model, Cmd Msg, Maybe ExitStatus )
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
ItemListInput newList ->
( { model | itemList = newList }
, Cmd.none
, Nothing
)
ItemListSend ->
( { model | itemList = "" }
, Api.checkList GotCheckedItems <|
String.split "\n" model.itemList
, Nothing
)
GotCheckedItems valid errors ->
@@ -163,7 +144,6 @@ update msg model =
, validItems = valid ++ model.validItems
}
, Cmd.none
, Nothing
)
InvalidItemNameChanged id newName ->
@@ -173,7 +153,6 @@ update msg model =
|> editItem (\item -> { item | name = newName }) id
}
, Cmd.none
, Nothing
)
InvalidItemPriceChanged id newPrice ->
@@ -186,15 +165,8 @@ update msg model =
model.invalidItems |> editItem (\item -> { item | base_price = price }) id
}
, Cmd.none
, Nothing
)
ConfirmClicked ->
( model, Cmd.none, Just (Confirmed <| allLoot model) )
CancelClicked ->
( model, Cmd.none, Just Canceled )
allLoot model =
model.invalidItems ++ model.validItems

View File

@@ -0,0 +1,37 @@
module Page.Chest.Selection exposing (Model, Msg, init, update, view)
import Api exposing (Loot)
import Html exposing (..)
import Html.Attributes exposing (..)
import Table
type Selection
= Selection
type Model
= Model Selection
init =
Model Selection
view : Model -> Loot -> Html Msg
view model loot =
Table.view
(Table.renderRowLevel
(\item -> [ p [] [ text <| item.name ++ "selectable" ] ])
(\item -> [ input [ type_ "checkbox" ] [] ])
)
loot
type Msg
= Msg
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
( model, Cmd.none )

View File

@@ -0,0 +1,49 @@
module Page.Dashboard exposing (Model, Msg, init, update, view)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Page.Chest as Chest exposing (Chest)
import Session exposing (Session)
type alias Model =
{ session : Session
, chest : Mode
}
type Mode
= View Chest
init : Session -> ( Model, Cmd Msg )
init session =
( Model session (View Chest.init)
, Cmd.none
)
view : Model -> ( Html Msg, List (Html Msg) )
view model =
case Session.user model.session of
Session.Player player _ ->
( text ""
, [ if player.id == 0 then
p [] [ text "Groupe" ]
else
p [] [ text "Joueur" ]
]
)
Session.Admin ->
( text "", [ p [] [ text "Joueur" ] ] )
type Msg
= Msg
update msg model =
( model, Cmd.none )

View File

@@ -41,8 +41,8 @@ view model =
Session.Admin ->
text ""
Session.Player id ->
if id == 0 then
Session.Player p _ ->
if p.id == 0 then
button [ class "button" ] [ text "Vendre" ]
else

View File

@@ -5,7 +5,9 @@ import Dict exposing (Dict)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Page.Chest as Chest exposing (Chest)
import Page.Chest.NewFromInventory as NewChest
import Page.Chest.Selection as Selection
import Session exposing (Session, getSession)
import Set exposing (Set)
import Table
@@ -13,20 +15,46 @@ import Table
type alias Model =
{ session : Session
, state : State
, loot : Status Loot
, chest : Mode
}
type State
type Status a
= Loading
| LoadError String
| Loaded a
type Mode
= View Chest
| Buy Chest
| Refresh Chest
getChest mode =
case mode of
View c ->
c
Buy c ->
c
Refresh c ->
c
{-
| View Loot
| Refresh NewChest.Model
| Buy Selection.Model
| Sending
-}
init session =
( Model session Loading, fetchShopItems )
( Model session Loading <| View Chest.init, fetchShopItems )
fetchShopItems =
@@ -35,21 +63,52 @@ fetchShopItems =
view : Model -> ( Html Msg, List (Html Msg) )
view model =
case model.state of
case model.loot of
Loading ->
( text "", [ p [ class "title" ] [ text "loading..." ] ] )
( text ""
, [ p [ class "title" ] [ text "loading..." ] ]
)
LoadError error ->
( text "", [ p [ class "has-text-danger" ] [ text <| "Error : " ++ error ] ] )
( text ""
, [ p [ class "has-text-danger" ] [ text <| "Error : " ++ error ] ]
)
View loot ->
( case Session.user model.session of
Loaded loot ->
let
controls =
case model.chest of
View chest ->
case Session.user model.session of
Session.Admin ->
button [ class "button", onClick IntoRefresh ] [ text "Remplacer" ]
Session.Player _ _ ->
button [ class "button" ] [ text "Acheter" ]
, [ Table.view Table.name loot ]
Buy chest ->
text ""
Refresh chest ->
text ""
in
( controls
, [ Chest.view (getChest model.chest) loot |> Html.map GotChestMsg ]
)
{-
Buy selection ->
let
( controls, content ) =
Selection.view selection
toMsg =
Html.map GotBuyMsg
in
( toMsg controls
, List.map toMsg content
)
Refresh chest ->
@@ -66,36 +125,74 @@ view model =
Sending ->
( text "", [ p [] [ text "En attente du serveur..." ] ] )
-}
type Msg
= GotLoot Api.ToChest (HttpResult Loot)
| IntoRefresh
| GotChestMsg NewChest.Msg
| GotRefreshResult (Maybe ())
| IntoBuy
| GotChestMsg Chest.Msg
updateChest model chest =
{ model
| chest =
case model.chest of
Buy _ ->
Buy chest
Refresh _ ->
Refresh chest
View _ ->
View chest
}
-- GotRefreshResult (Maybe ())
--| GotBuyMsg Selection.Msg
--| GotBuyResult (Maybe ())
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case ( msg, model.state ) of
( GotLoot Api.OfShop response, Loading ) ->
case msg of
GotLoot Api.OfShop response ->
case response of
Ok loot ->
( { model | state = View loot }, Cmd.none )
( { model | loot = Loaded loot }, Cmd.none )
-- TODO: handle error
Err e ->
( { model | state = LoadError <| Debug.toString e }, Cmd.none )
( { model | loot = LoadError <| Debug.toString e }, Cmd.none )
( IntoRefresh, View _ ) ->
-- Refresh mode
IntoRefresh ->
case Session.user (getSession model) of
Session.Admin ->
( { model | state = Refresh NewChest.init }, Cmd.none )
( { model | chest = Refresh Chest.initCreate }, Cmd.none )
_ ->
( model, Cmd.none )
-- Buy mode
IntoBuy ->
case Session.user (getSession model) of
Session.Player _ _ ->
( { model | chest = Buy Chest.initSelection }, Cmd.none )
_ ->
( model, Cmd.none )
GotChestMsg subMsg ->
Chest.update subMsg (getChest model.chest)
|> Tuple.mapBoth
(updateChest model)
(Cmd.map GotChestMsg)
{-
(GotChestMsg chestMsg, Refresh chest ) ->
let
( newState, cmd, exit ) =
@@ -123,5 +220,11 @@ update msg model =
, Cmd.none
)
( GotBuyMsg subMsg, Buy subModel ) ->
Selection.update subMsg subModel
|> Tuple.mapBoth
(\m -> { model | state = Buy m })
(\c -> Cmd.map GotBuyMsg c)
-}
_ ->
( model, Cmd.none )

View File

@@ -1,11 +1,11 @@
module Session exposing (Session, User(..), getSession, init, key, user)
module Session exposing (Session, User(..), getSession, init, key, updateUser, updateWealth, user, wealth)
import Api
import Api.Player as Player exposing (Player)
import Browser.Navigation as Nav
import Http
import Json.Decode as D
import Page.Chest.Wealth as Wealth
import Wealth
type User
@@ -53,3 +53,49 @@ user session =
session
in
loggedUser
wealth : Session -> Maybe Wealth.Model
wealth session =
case user session of
Player _ model ->
Just model
Admin ->
Nothing
setWealth wealthModel session =
let
(Session navKey isUser) =
session
in
case isUser of
Player p _ ->
Session navKey (Player p wealthModel)
Admin ->
Session navKey Admin
updateWealth : Wealth.Model -> Session -> Session
updateWealth newWealthModel model =
let
(Session navKey loggedUser) =
model
in
case loggedUser of
Player player _ ->
Session navKey (Player player newWealthModel)
Admin ->
Session navKey Admin
updateUser : User -> Session -> Session
updateUser newUser model =
let
(Session navKey _) =
model
in
Session navKey newUser

View File

@@ -1,10 +1,14 @@
module Table exposing (name, view)
module Table exposing (name, renderRowLevel, view)
import Html exposing (..)
import Html.Attributes exposing (..)
type alias RowRenderer a msg =
a -> Html msg
type alias ItemRenderer a msg =
a -> List (Html msg)
@@ -15,10 +19,20 @@ view rowRenderer content =
[ th [] [ text "Nom" ] ]
, tbody [] <|
List.map
(\i -> tr [] [ td [] <| rowRenderer i ])
rowRenderer
content
]
name item =
[ p [] [ text item.name ] ]
renderRowLevel : ItemRenderer a msg -> ItemRenderer a msg -> RowRenderer a msg
renderRowLevel left right item =
tr []
[ td [ class "level" ]
[ div [ class "level-left" ] <| left item
, div [ class "level-right" ] <| right item
]
]
name =
renderRowLevel (\item -> [ p [] [ text item.name ] ]) (\item -> [])

View File

@@ -1,4 +1,4 @@
module Page.Chest.Wealth exposing (Model, Msg(..), editValue, init, update, view)
module Wealth exposing (Model, Msg(..), editValue, init, update, view)
import Api.Player exposing (Wealth)
import Html exposing (..)
@@ -71,20 +71,22 @@ type Msg
| ConfirmEdit
update : Msg -> Model -> Model
update : Msg -> Model -> ( Model, Maybe Float )
update msg model =
case msg of
StartEdit ->
Edit "0.0"
( Edit "0.0", Nothing )
QuitEdit ->
View
( View, Nothing )
AmountChanged newAmount ->
Edit <| String.replace "," "." newAmount
( Edit <| String.replace "," "." newAmount
, Nothing
)
_ ->
View
ConfirmEdit ->
( View, editValue model )