elm/lootalot-client
1
0
Fork 0
Code Issues 3 Pull Requests Releases Wiki Activity

Compare commits

base: elm:976fbe6b4b43279cada425cd24acf4d8cf5ffecb
Branches Tags
elm:master
..
compare: elm:b00d26e6d472dabe9383a98240c9a67dd646aaed
Branches Tags
elm:master

2 Commits
976fbe6b4b ... b00d26e6d4

Author SHA1 Message Date
Artus
b00d26e6d4 moves Modes inside Chest module 2019-12-04 22:03:29 +01:00
Artus
b97be8c321 decided to internalize modes inside Chest.elm 2019-12-04 19:16:16 +01:00
10 changed files with 434 additions and 435 deletions
Expand all files Collapse all files

10
src/Api.elm
View File

@@ -432,9 +432,17 @@ getLoot id =
getClaims id =
let
path =
if id == 0 then
"api/claims"
else
"api/players/" ++ String.fromInt id ++ "/claims"
in
send
{ method = "GET"
, path = "api/players/" ++ String.fromInt id ++ "/claims"
, path = path
, decoder = valueDecoder (D.list claimDecoder)
}

10
src/Main.elm
View File

@@ -7,10 +7,8 @@ import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Json.Encode as E
import Page exposing (Page)
import Page.Chest as Chest exposing (Msg)
import Route exposing (..)
import Session exposing (..)
import Set exposing (Set)
import Svg.Attributes
import Url
import Utils exposing (..)
@@ -100,7 +98,7 @@ navLink icon linkText url =
viewHeaderBar : String -> List (Html Msg) -> Navbar -> Html Msg
viewHeaderBar navbarTitle navbarLinks navbar =
nav [ class "navbar", class "is-transparent" ]
nav [ class "navbar container is-transparent is-spaced " ]
[ div [ class "navbar-brand" ]
[ a [ class "navbar-item", href "/" ]
[ renderIcon { icon = "fab fa-d-and-d", size = "medium", ratio = "2x" }
@@ -164,21 +162,21 @@ update msg model =
( UrlChanged url, from ) ->
-- Handle routing according to current page
case Route.fromUrl url of
Just (Route.Home Route.MerchantLoot) ->
Just Route.Merchant ->
let
( shopPage, cmd ) =
Page.gotoShop from
in
( model |> setPage shopPage, Cmd.map PageMsg cmd )
Just (Route.Home Route.PlayerLoot) ->
Just Route.Home ->
let
( shopPage, cmd ) =
Page.gotoHome from
in
( model |> setPage shopPage, Cmd.map PageMsg cmd )
Just (Route.Home Route.GroupLoot) ->
Just Route.GroupChest ->
let
( page, cmd ) =
Page.gotoGroupChest from

170
src/Page.elm
View File

@@ -5,16 +5,17 @@ import Api.Player
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Page.Dashboard as Dashboard
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
= Dashboard Dashboard.Model
= Home Home.Model
| GroupChest GroupChest.Model
| Shop Shop.Model
| About
@@ -25,14 +26,16 @@ init =
Loading
mapMsg toMsg =
List.map (Html.map toMsg)
mapPageMsg toMsg ( controls, content ) =
( Html.map toMsg controls
, List.map (Html.map toMsg) content
)
maybeSession page =
case page of
Dashboard model ->
Just <| Dashboard.getSession model
Home model ->
Just <| Home.getSession model
GroupChest model ->
Just <| Session.getSession model
@@ -48,35 +51,37 @@ view page =
let
( title, ( controls, content ) ) =
case page of
Dashboard home ->
Home home ->
( "Lootalot"
, Dashboard.view home
|> Tuple.mapBoth
(Html.map GotDashboardMsg)
(mapMsg GotDashboardMsg)
, Home.view home
|> mapPageMsg GotHomeMsg
)
GroupChest chest ->
( "Lootalot"
, GroupChest.view chest
|> Tuple.mapBoth
(Html.map GotGroupChestMsg)
(mapMsg GotGroupChestMsg)
|> mapPageMsg GotGroupChestMsg
)
Shop shop ->
( "Marchand"
, Shop.view shop
|> Tuple.mapBoth
(Html.map GotShopMsg)
(mapMsg GotShopMsg)
|> mapPageMsg GotShopMsg
)
About ->
( "Loot-a-lot", ( text "", [ p [] [ text "A propos" ] ] ) )
Loading ->
( "Loot-a-lot", ( text "", [ p [] [ text "Chargement" ] ] ) )
( "Loot-a-lot"
, ( text ""
, [ div [ class "hero" ]
[ div [ class "hero-body" ]
[ p [] [ text "Chargement" ] ]
]
]
)
)
navbarTitle =
case maybeSession page of
@@ -96,20 +101,16 @@ view page =
Just session ->
case Session.user session of
Session.Player data ->
let
linkWithGem =
navLink "fas fa-gem"
in
[ navLink "fas fa-store-alt" "Marchand" "/marchand"
[ navLink "fas fa-store-alt" Route.Merchant page
, if data.player.id /= 0 then
linkWithGem "Coffre de groupe" "/coffre"
navLink "fas fa-gem" Route.GroupChest page
else
text ""
]
Session.Admin ->
[ navLink "fas fa-store-alt" "Marchand" "/marchand" ]
[ navLink "fas fa-store-alt" Route.Merchant page ]
Nothing ->
[]
@@ -118,25 +119,44 @@ view page =
, { title = navbarTitle, links = navbarLinks }
, [ div [ class "container" ] <|
viewSessionBar (maybeSession page) [ controls ]
:: (case Maybe.map Session.notification (maybeSession page) of
Just (Just notify) ->
div [ class "notification is-success" ] [ text notify ]
:: 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 notify) ->
div [ class "notification is-danger" ] [ text notify ]
, 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 =
@@ -149,8 +169,10 @@ viewSessionBar session controls =
Wealth.view data.player.wealth data.wealth
++ (if data.player.debt > 0 then
[ div [ class "level-item" ]
[ p [ class "heading is-size-4 has-text-danger" ]
[ text ("Dette : " ++ String.fromInt data.player.debt ++ "po") ]
[ 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") ]
]
]
]
@@ -179,10 +201,42 @@ renderLevel left right =
-- PLAYER BAR
navLink icon linkText url =
a [ class "navbar-item", href url ]
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 linkText ]
, span [] [ text link ]
]
@@ -194,7 +248,7 @@ navLink icon linkText url =
type PageMsg
= ApiMsg Api.Msg
| GotGroupChestMsg GroupChest.Msg
| GotDashboardMsg Dashboard.Msg
| GotHomeMsg Home.Msg
| GotShopMsg Shop.Msg
| Wealth Wealth.Msg
@@ -210,8 +264,8 @@ map func page =
Just session ->
case page of
Dashboard model ->
Dashboard <| Dashboard.updateSession model (func session)
Home model ->
Home <| Home.updateSession model (func session)
GroupChest model ->
GroupChest { model | session = func session }
@@ -229,14 +283,14 @@ map func page =
closeAction ( page, cmd ) =
case page of
Dashboard home ->
( page, cmd )
Home from ->
gotoHome page
GroupChest chest ->
( GroupChest (GroupChest.refresh chest), cmd )
GroupChest from ->
gotoGroupChest page
Shop shop ->
( page, cmd )
Shop from ->
gotoShop page
_ ->
( page, cmd )
@@ -244,17 +298,18 @@ closeAction ( page, cmd ) =
update msg page =
case ( msg, page, maybeSession page ) of
-- Dashboard page
-- Home page
-- Capture API messages
( GotDashboardMsg (Dashboard.Api apiMsg), Dashboard home, _ ) ->
( GotHomeMsg (Home.Api apiMsg), Home home, _ ) ->
update (ApiMsg apiMsg) page
|> closeAction
-- Relay others
( GotDashboardMsg subMsg, Dashboard home, _ ) ->
Dashboard.update subMsg home
|> updatePage Dashboard GotDashboardMsg
( GotHomeMsg subMsg, Home home, _ ) ->
Home.update subMsg home
|> updatePage Home GotHomeMsg
( GotDashboardMsg _, _, _ ) ->
( GotHomeMsg _, _, _ ) ->
( page, Cmd.none )
-- Group chest
@@ -272,6 +327,7 @@ update msg page =
-- Shop page
( GotShopMsg (Shop.Api apiMsg), Shop shop, _ ) ->
update (ApiMsg apiMsg) page
|> closeAction
( GotShopMsg subMsg, Shop shop, _ ) ->
Shop.update subMsg shop
@@ -417,8 +473,8 @@ applyUpdate u user =
initHome session =
Dashboard.init session
|> updatePage Dashboard GotDashboardMsg
Home.init session
|> updatePage Home GotHomeMsg
gotoHome page =
@@ -427,8 +483,8 @@ gotoHome page =
( page, Cmd.none )
Just session ->
Dashboard.init session
|> updatePage Dashboard GotDashboardMsg
Home.init session
|> updatePage Home GotHomeMsg
gotoShop page =

167
src/Page/Chest.elm
View File

@@ -1,10 +1,11 @@
module Page.Chest exposing (Chest, Msg, confirmAdd, confirmBuy, confirmGrab, confirmSell, init, initCreate, initSelection, show, update, view)
module Page.Chest exposing (..)
import Api exposing (Item, Loot)
import Api exposing (Claims, Item, Loot)
import Html exposing (..)
import Page.Chest.NewFromInventory as NewFromInventory
import Page.Chest.Selection as Selection
import Table
import Utils
type alias RowRenderer msg =
@@ -27,21 +28,40 @@ type alias RowRenderer msg =
type Chest
= View (Item -> Html Never)
| Selection Selection.Model
| Create NewFromInventory.Model
= New NewFromInventory.Model
| View (Item -> Html Never)
| Buy Selection.Model
| Sell Selection.Model
| Claim Selection.Model
type IntoMode
= IntoView
| IntoViewWithClaims Claims
| IntoAdd
| IntoBuy
| IntoSell
| IntoClaim Claims
{-
View : RowRenderer -> Chest.View
Selection : RowRenderer -> { confirm: Cmd msg, cancel: Cmd msg } -> Chest.Selection
NewFromInventory : RowRenderer -> { confirm: Cmd msg, cancel: Cmd msg } -> Chest.NewFromInventory
Dashboard :
* ViewWithClaims (group)
* View
* Add
* Sell
Shop :
* View
* Refresh
* Buy
GroupChest :
* ViewWithClaims
* Claim
-}
@@ -49,19 +69,40 @@ init =
View Table.name
show : Table.ItemRenderer Item Never -> Chest
show renderItem =
intoMode : IntoMode -> Msg
intoMode newMode =
IntoMode newMode
new =
intoMode IntoAdd
show =
intoMode IntoView
showWithClaims claims =
intoMode (IntoViewWithClaims claims)
buy =
intoMode IntoBuy
sell =
intoMode IntoSell
claim initialClaims =
intoMode (IntoClaim initialClaims)
showWith : Table.ItemRenderer Item Never -> Chest
showWith renderItem =
View <| Table.renderRowLevel renderItem (\_ -> [])
initCreate =
Create NewFromInventory.init
initSelection maybeInitial =
Selection <| Selection.init maybeInitial
view : Chest -> Loot -> Html Msg
view model loot =
case model of
@@ -69,31 +110,95 @@ view model loot =
Table.view renderItem loot
|> Html.map GotViewMsg
Selection subModel ->
Buy subModel ->
Selection.view subModel loot
|> Html.map GotSelectionMsg
Create subModel ->
Sell subModel ->
Selection.view subModel loot
|> Html.map GotSelectionMsg
New subModel ->
NewFromInventory.view subModel
|> Html.map GotCreateMsg
|> Html.map GotNewMsg
Claim subModel ->
Selection.view subModel loot
|> Html.map GotSelectionMsg
type Msg
= GotCreateMsg NewFromInventory.Msg
= GotNewMsg NewFromInventory.Msg
| GotSelectionMsg Selection.Msg
| GotViewMsg Never
| IntoMode IntoMode
update : Msg -> Chest -> ( Chest, Cmd Msg )
update msg model =
case ( msg, model ) of
( GotCreateMsg subMsg, Create subModel ) ->
( GotNewMsg subMsg, New subModel ) ->
NewFromInventory.update subMsg subModel
|> updateChest GotCreateMsg Create
|> updateChest GotNewMsg New
( GotSelectionMsg subMsg, Selection subModel ) ->
( GotNewMsg subMsg, _ ) ->
( model, Cmd.none )
( GotSelectionMsg subMsg, Buy subModel ) ->
Selection.update subMsg subModel
|> updateChest GotSelectionMsg Selection
|> updateChest GotSelectionMsg Buy
( GotSelectionMsg subMsg, Sell subModel ) ->
Selection.update subMsg subModel
|> updateChest GotSelectionMsg Sell
( GotSelectionMsg subMsg, Claim subModel ) ->
Selection.update subMsg subModel
|> updateChest GotSelectionMsg Claim
( GotSelectionMsg subMsg, _ ) ->
( model, Cmd.none )
( IntoMode newMode, _ ) ->
case newMode of
IntoView ->
( View Table.name, Cmd.none )
IntoViewWithClaims claims ->
let
isClaimed item =
List.any (\claim_ -> claim_.loot_id == item.id) claims
renderItem item =
[ if isClaimed item then
Utils.renderIcon
{ icon = "fas fa-praying-hands"
, size = "small"
, ratio = "1x"
}
else
text ""
, p [] [ text item.name ]
]
in
( View <| Table.renderRowLevel renderItem (\_ -> []), Cmd.none )
IntoBuy ->
( Buy <| Selection.init Nothing True, Cmd.none )
IntoSell ->
( Sell <| Selection.init Nothing True, Cmd.none )
IntoClaim claims ->
let
initialSelection =
List.map .loot_id claims
in
( Claim <| Selection.init (Just initialSelection) False, Cmd.none )
IntoAdd ->
( New NewFromInventory.init, Cmd.none )
_ ->
( model, Cmd.none )
@@ -113,7 +218,7 @@ updateChest toMsg toChest ( model, cmd ) =
confirmBuy : Int -> Chest -> Loot -> Cmd Api.Msg
confirmBuy playerId model loot =
case model of
Selection chest ->
Buy chest ->
let
items =
Selection.selected chest loot
@@ -135,7 +240,7 @@ confirmBuy playerId model loot =
confirmSell : Int -> Chest -> Loot -> List Int -> Cmd Api.Msg
confirmSell playerId model loot players =
case model of
Selection chest ->
Sell chest ->
let
items =
Selection.selected chest loot
@@ -157,7 +262,7 @@ confirmSell playerId model loot players =
confirmAdd : Int -> String -> Chest -> Cmd Api.Msg
confirmAdd playerId sourceName model =
case model of
Create chest ->
New chest ->
let
items =
NewFromInventory.allLoot chest
@@ -176,7 +281,7 @@ confirmAdd playerId sourceName model =
confirmGrab : Int -> Loot -> Chest -> Cmd Api.Msg
confirmGrab playerId loot model =
case model of
Selection chest ->
Claim chest ->
let
items =
Selection.selected chest loot

111
src/Page/Chest/Selection.elm
View File

@@ -13,16 +13,17 @@ type alias Selection =
Set Int
type alias Data a =
Dict Int a
type Data a
= NoData
| Data (Dict Int a)
type Model
= Model Selection (Data Int)
init : Maybe (List Int) -> Model
init maybeInitial =
init : Maybe (List Int) -> Bool -> Model
init maybeInitial hasData =
Model
(case maybeInitial of
Just initial ->
@@ -31,7 +32,13 @@ init maybeInitial =
Nothing ->
Set.empty
)
Dict.empty
(case hasData of
True ->
Data Dict.empty
False ->
NoData
)
view : Model -> Loot -> Html Msg
@@ -40,37 +47,46 @@ view (Model selection data) loot =
isSelected =
itemInSelection selection
renderItem item =
let
maybeMod =
Dict.get item.id data
in
[ viewPriceWithModApplied
(Maybe.map (\i -> toFloatingMod i) maybeMod)
(toFloat item.base_price)
, if isSelected item then
viewPriceModifier item.id <|
case Dict.get item.id data of
Just mod ->
String.fromInt mod
renderRight item =
case data of
Data inner ->
let
maybeMod =
Dict.get item.id inner
in
renderItemWithPrice .base_price isSelected maybeMod item
Nothing ->
"0"
else
text ""
]
NoData ->
[]
in
Table.view
(Table.renderSelectableRow
(\item -> [ p [] [ text item.name ] ])
(\item -> renderItem item)
renderRight
(\item _ -> SwitchSelectionState item.id)
isSelected
)
loot
renderItemWithPrice toPrice isSelected maybeMod item =
[ viewPriceWithModApplied
(Maybe.map (\i -> toFloatingMod i) maybeMod)
(toFloat item.base_price)
, if isSelected item then
viewPriceModifier item.id <|
case maybeMod of
Just mod ->
String.fromInt mod
Nothing ->
"0"
else
text ""
]
toFloatingMod : Int -> Float
toFloatingMod percent =
(100 + Debug.log "toFloat" (toFloat percent)) / 100
@@ -126,12 +142,17 @@ selected (Model selection data) loot =
modifiers : Model -> Loot -> List (Maybe Float)
modifiers (Model selection data) items =
List.map
(\item ->
Dict.get item.id data
|> Maybe.map (\i -> toFloatingMod i)
)
items
case data of
Data inner ->
List.map
(\item ->
Dict.get item.id inner
|> Maybe.map (\i -> toFloatingMod i)
)
items
NoData ->
[]
itemInSelection : Selection -> Item -> Bool
@@ -166,18 +187,24 @@ update : Msg -> Model -> ( Model, Cmd Msg )
update msg (Model selection data) =
case msg of
PriceModifierChanged id value ->
( Model selection
(Dict.insert
id
(case String.toInt value of
Just i ->
i
( Model selection <|
case data of
Data inner ->
Data
(Dict.insert
id
(case String.toInt value of
Just i ->
i
Nothing ->
0
)
data
)
Nothing ->
0
)
inner
)
NoData ->
data
, Cmd.none
)

157
src/Page/Dashboard.elm
View File

@@ -39,20 +39,13 @@ type alias NewPlayerForm =
type PlayerConfig
= PlayerConfig Session Mode
= PlayerConfig Session Chest
type AdminConfig
= AdminConfig Session (List Player) NewPlayerForm
type Mode
= PlayerChest Chest
| GroupChest Chest
| Sell Chest
| Add Chest
init : Session -> ( Model, Cmd Msg )
init session =
case Session.user session of
@@ -66,10 +59,11 @@ init session =
PlayerConfig session
(if data.player.id == 0 then
-- TODO: render claimed items
GroupChest Chest.init
Chest.update (Chest.showWithClaims data.claims) Chest.init
|> Tuple.first
else
PlayerChest Chest.init
Chest.init
)
, Cmd.none
)
@@ -90,33 +84,38 @@ buttons bs =
view : Model -> ( Html Msg, List (Html Msg) )
view model =
case model of
Player (PlayerConfig session mode) ->
Player (PlayerConfig session chest) ->
case Session.user session of
Session.Player data ->
Tuple.mapBoth
(Html.map PlayerViewer)
(List.map (Html.map PlayerViewer))
<|
case mode of
PlayerChest chest ->
( modeButton "Vendre" IntoSell
, [ Html.map GotChestMsg <| Chest.view chest data.loot ]
)
let
toShow =
case data.player.id of
0 ->
GotChestMsg <| Chest.showWithClaims data.claims
GroupChest chest ->
( buttons [ modeButton "Vendre" IntoSell, modeButton "Ajouter" IntoAdd ]
, [ Html.map GotChestMsg <| Chest.view chest data.loot ]
)
_ ->
GotChestMsg Chest.show
in
( Html.map PlayerViewer <|
case chest of
Chest.View _ ->
case data.player.id of
0 ->
buttons [ modeButton "Vendre" (GotChestMsg Chest.sell), modeButton "Ajouter" (GotChestMsg Chest.new) ]
Sell chest ->
( buttons [ modeButton "Ok" ConfirmSell, modeButton "Annuler" IntoView ]
, [ Html.map GotChestMsg <| Chest.view chest data.loot ]
)
_ ->
modeButton "Vendre" (GotChestMsg Chest.sell)
Add chest ->
( buttons [ modeButton "Ok" ConfirmAdd, modeButton "Annuler" IntoView ]
, [ Html.map GotChestMsg <| Chest.view chest [] ]
)
Chest.Sell _ ->
buttons [ modeButton "Ok" ConfirmSell, modeButton "Annuler" toShow ]
Chest.New _ ->
buttons [ modeButton "Ok" ConfirmAdd, modeButton "Annuler" toShow ]
_ ->
text ""
, [ Html.map (PlayerViewer << GotChestMsg) <| Chest.view chest data.loot ]
)
_ ->
let
@@ -198,48 +197,8 @@ type AdminMsg
type PlayerMsg
= GotChestMsg Chest.Msg
| IntoSell
| IntoAdd
| ConfirmSell
| ConfirmAdd
| IntoView
mapChest : (Chest -> a) -> Mode -> a
mapChest fn mode =
case mode of
PlayerChest chest ->
fn chest
GroupChest chest ->
fn chest
Add chest ->
fn chest
Sell chest ->
fn chest
updateChest : Model -> Chest -> Model
updateChest model new =
case model of
Admin _ ->
model
Player (PlayerConfig s mode) ->
case mode of
PlayerChest _ ->
Player (PlayerConfig s (PlayerChest new))
GroupChest _ ->
Player (PlayerConfig s (GroupChest new))
Add _ ->
Player (PlayerConfig s (Add new))
Sell _ ->
Player (PlayerConfig s (Sell new))
update msg model =
@@ -258,27 +217,23 @@ update msg model =
)
|> Tuple.mapSecond (Cmd.map AdminViewer)
( PlayerViewer ConfirmSell, Player (PlayerConfig session mode) ) ->
( PlayerViewer ConfirmSell, Player (PlayerConfig session chest) ) ->
( model
, Cmd.map Api <|
case Session.user session of
Session.Player data ->
-- TODO: handle list of players when Viewer is group
mapChest
(\chest ->
Chest.confirmSell
data.player.id
chest
data.loot
[]
)
mode
Chest.confirmSell
data.player.id
chest
data.loot
[]
_ ->
Cmd.none
)
( PlayerViewer ConfirmAdd, Player (PlayerConfig session mode) ) ->
( PlayerViewer ConfirmAdd, Player (PlayerConfig session chest) ) ->
( model
, Cmd.map Api <|
case Session.user session of
@@ -287,45 +242,23 @@ update msg model =
sourceName =
"nouveau loot #1"
in
mapChest (\chest -> Chest.confirmAdd 0 sourceName chest) mode
Chest.confirmAdd
0
sourceName
chest
_ ->
Cmd.none
)
( PlayerViewer aMsg, Player (PlayerConfig session mode) ) ->
( PlayerViewer aMsg, Player (PlayerConfig session chest) ) ->
(case aMsg of
GotChestMsg chestMsg ->
mapChest (Chest.update chestMsg) mode
Chest.update chestMsg chest
|> Tuple.mapBoth
(updateChest model)
(\chest_ -> Player (PlayerConfig session chest_))
(Cmd.map GotChestMsg)
IntoSell ->
( Player (PlayerConfig session (Sell <| Chest.initSelection Nothing)), Cmd.none )
IntoAdd ->
( Player (PlayerConfig session (Add Chest.initCreate)), Cmd.none )
IntoView ->
let
userChest =
case Session.user session of
Session.Player data ->
if data.player.id == 0 then
GroupChest
else
PlayerChest
-- TODO: this seems not right
-- there should be a better way
-- to handle this
_ ->
PlayerChest
in
( Player (PlayerConfig session (userChest Chest.init)), Cmd.none )
_ ->
( model, Cmd.none )
)

106
src/Page/GroupChest.elm
View File

@@ -8,29 +8,16 @@ import Page.Chest as Chest exposing (Chest)
import Session exposing (Session, User(..))
import Set
import Table
import Utils exposing (renderIcon)
type alias Model =
{ session : Session
, loot : State
, mode : Mode
, chest : Chest
}
type Mode
= View Chest
| Grab Chest
mapChest fn mode =
case mode of
View chest ->
fn chest
Grab chest ->
fn chest
type State
= Loading
| LoadError String
@@ -52,7 +39,13 @@ getClaimsFromSession session =
init session =
( Model session Loading (View <| showClaims (getClaimsFromSession session)), Cmd.map Internal <| Api.fetchLoot GotLoot Api.OfGroup )
( Model session
Loading
(Tuple.first <|
Chest.update (Chest.showWithClaims <| getClaimsFromSession session) Chest.init
)
, Cmd.map Internal <| Api.fetchLoot GotLoot Api.OfGroup
)
view : Model -> ( Html Msg, List (Html Msg) )
@@ -79,21 +72,21 @@ view model =
Session.Player data ->
( True, data.player.id == 0 )
in
case model.mode of
View _ ->
if isPlayer && not isGroup then
button [ class "button", onClick IntoGrab ] [ text "Demander" ]
case ( model.chest, isPlayer && not isGroup ) of
( Chest.View _, True ) ->
button
[ class "button"
, onClick
(GotChestMsg <| Chest.showWithClaims (getClaimsFromSession model.session))
]
[ text "Demander" ]
else
text ""
( Chest.Claim _, True ) ->
button [ class "button", onClick ConfirmGrab ] [ text "Valider" ]
Grab _ ->
if isPlayer && not isGroup then
button [ class "button", onClick ConfirmGrab ] [ text "Valider" ]
else
text ""
, [ mapChest (\c -> Chest.view c loot) model.mode
( _, _ ) ->
text ""
, [ Chest.view model.chest loot
|> Html.map (Internal << GotChestMsg)
]
)
@@ -107,34 +100,11 @@ type Msg
type InnerMsg
= GotLoot Api.ToChest (HttpResult Loot)
| GotChestMsg Chest.Msg
| IntoGrab
| IntoView
| ConfirmGrab
showClaims claims =
let
itemClaimed item =
List.any (\c -> c.loot_id == item.id) claims
in
Chest.show
(\item ->
[ p []
[ text <|
(if itemClaimed item then
"C"
else
""
)
++ item.name
]
]
)
refresh model =
{ model | mode = View <| showClaims (getClaimsFromSession model.session) }
update (Internal <| GotChestMsg (Chest.intoMode (Chest.IntoViewWithClaims (getClaimsFromSession model.session)))) model
update : Msg -> Model -> ( Model, Cmd Msg )
@@ -144,13 +114,13 @@ update msg model =
( model, Cmd.none )
Internal ConfirmGrab ->
case ( Session.user model.session, model.loot, model.mode ) of
( Session.Player data, Loaded loot, Grab chest ) ->
case ( Session.user model.session, model.loot, model.chest ) of
( Session.Player data, Loaded loot, Chest.Claim _ ) ->
( model
, Chest.confirmGrab
data.player.id
loot
chest
model.chest
|> Cmd.map Api
)
@@ -166,24 +136,9 @@ update msg model =
( { model | loot = LoadError "Le chargement a échoué" }, Cmd.none )
GotChestMsg chestMsg ->
mapChest (Chest.update chestMsg) model.mode
Chest.update chestMsg model.chest
|> updateChest model
IntoGrab ->
let
claimedIds =
case Session.user model.session of
Player data ->
List.map .loot_id data.claims
Admin ->
[]
in
( { model | mode = Grab <| Chest.initSelection (Just claimedIds) }, Cmd.none )
IntoView ->
( refresh model, Cmd.none )
_ ->
( model, Cmd.none )
)
@@ -191,11 +146,6 @@ update msg model =
updateChest model ( chestModel, chestCmd ) =
( case model.mode of
View _ ->
{ model | mode = View chestModel }
Grab _ ->
{ model | mode = Grab chestModel }
( { model | chest = chestModel }
, Cmd.map GotChestMsg chestCmd
)

98
src/Page/Shop.elm
View File

@@ -15,7 +15,7 @@ import Table
type alias Model =
{ session : Session
, loot : Status Loot
, chest : Mode
, chest : Chest
}
@@ -25,26 +25,8 @@ type Status a
| Loaded a
type Mode
= View Chest
| Buy Chest
| Refresh Chest
getChest mode =
case mode of
View c ->
c
Buy c ->
c
Refresh c ->
c
init session =
( Model session Loading <| View Chest.init, fetchShopItems )
( Model session Loading Chest.init, fetchShopItems )
fetchShopItems =
@@ -52,12 +34,12 @@ fetchShopItems =
|> Cmd.map Internal
btn : String -> Msg -> Html Msg
btn : String -> msg -> Html msg
btn t msg =
button [ class "button", onClick msg ] [ text t ]
buttons : List (Html Msg) -> Html Msg
buttons : List (Html msg) -> Html msg
buttons bs =
div [ class "buttons" ] bs
@@ -78,24 +60,25 @@ view model =
Loaded loot ->
let
controls =
case ( model.chest, Session.user model.session ) of
( View chest, Session.Admin ) ->
btn "Remplacer" (Internal IntoRefresh)
Html.map Internal <|
case ( model.chest, Session.user model.session ) of
( Chest.View _, Session.Admin ) ->
btn "Remplacer" (GotChestMsg Chest.new)
( View chest, Session.Player _ ) ->
btn "Acheter" (Internal IntoBuy)
( Chest.View _, Session.Player _ ) ->
btn "Acheter" (GotChestMsg Chest.buy)
( Buy chest, Session.Player _ ) ->
buttons [ btn "Ok" (Internal ConfirmBuy), btn "Annuler" (Internal IntoView) ]
( Chest.Buy _, Session.Player _ ) ->
buttons [ btn "Ok" ConfirmBuy, btn "Annuler" (GotChestMsg Chest.show) ]
( Refresh chest, Session.Admin ) ->
buttons [ btn "Ok" (Internal ConfirmRefresh), btn "Annuler" (Internal IntoView) ]
( Chest.New _, Session.Admin ) ->
buttons [ btn "Ok" ConfirmRefresh, btn "Annuler" (GotChestMsg Chest.show) ]
_ ->
text ""
_ ->
text ""
in
( controls
, [ Chest.view (getChest model.chest) loot |> Html.map (Internal << GotChestMsg) ]
, [ Chest.view model.chest loot |> Html.map (Internal << GotChestMsg) ]
)
@@ -110,31 +93,13 @@ type Msg
type ShopMsg
= GotLoot Api.ToChest (HttpResult Loot)
| IntoRefresh
| ConfirmRefresh
| GotRefreshResult (Maybe ())
| IntoBuy
| ConfirmBuy
| GotBuyResult
| IntoView
| 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
@@ -146,11 +111,11 @@ update msg model =
case msg of
Internal ConfirmBuy ->
case ( Session.user (getSession model), model.loot, model.chest ) of
( Session.Player data, Loaded loot, Buy chest ) ->
( Session.Player data, Loaded loot, Chest.Buy _ ) ->
( model
, Chest.confirmBuy
data.player.id
chest
model.chest
loot
|> Cmd.map Api
)
@@ -181,15 +146,6 @@ update msg model =
Err e ->
( { model | loot = LoadError <| Debug.toString e }, Cmd.none )
-- Refresh mode
IntoRefresh ->
case Session.user (getSession model) of
Session.Admin ->
( { model | chest = Refresh Chest.initCreate }, Cmd.none )
_ ->
( model, Cmd.none )
ConfirmRefresh ->
case Session.user (getSession model) of
Session.Admin ->
@@ -206,22 +162,10 @@ update msg model =
in
( model, Cmd.none )
-- Buy mode
IntoBuy ->
case Session.user (getSession model) of
Session.Player _ ->
( { model | chest = Buy <| Chest.initSelection Nothing }, Cmd.none )
_ ->
( model, Cmd.none )
IntoView ->
( { model | chest = View Chest.init }, Cmd.none )
GotChestMsg subMsg ->
Chest.update subMsg (getChest model.chest)
Chest.update subMsg model.chest
|> Tuple.mapBoth
(updateChest model)
(\c -> { model | chest = c })
(Cmd.map GotChestMsg)
_ ->

34
src/Route.elm
View File

@@ -8,41 +8,19 @@ import Url.Parser as P exposing ((</>), Parser, oneOf, s)
-- ROUTES
type ChestContent
= PlayerLoot
| MerchantLoot
| GroupLoot
| NewLoot
type Route
= Home ChestContent
= Home -- Either PlayerChest or Admin depending on Session
| About
{-
We could flatten this :
type Route
= Home -- Either PlayerChest or Admin depending on Session
| About
| Merchant
| GroupChest
| NewLoot
-}
| Merchant
| GroupChest
parser : P.Parser (Route -> a) a
parser =
oneOf
[ P.map (Home PlayerLoot) P.top
, P.map (Home GroupLoot) (P.s "coffre")
, P.map (Home MerchantLoot) (P.s "marchand")
, P.map (Home NewLoot) (P.s "nouveau-tresor")
[ P.map Home P.top
, P.map GroupChest (P.s "groupe")
, P.map Merchant (P.s "marchand")
, P.map About (P.s "about")
]

6
src/Wealth.elm
View File

@@ -15,11 +15,10 @@ init =
View
view : Wealth -> Model -> List (Html Msg)
view wealth model =
div [ class "level-item" ]
[ span [ class "icon is-large" ] [ i [ class "fas fa-2x fa-piggy-bank" ] [] ]
, span [ class "icon", onClick StartEdit ] [ i [ class "fas fa-tools" ] [] ]
]
[ span [ class "icon is-large" ] [ i [ class "fas fa-2x fa-piggy-bank" ] [] ] ]
:: (case model of
View ->
viewWealth wealth
@@ -27,6 +26,7 @@ view wealth model =
Edit amount ->
viewUpdateWealth amount
)
++ [ span [ class "icon", onClick StartEdit ] [ i [ class "fas fa-tools" ] [] ] ]
viewUpdateWealth amount =