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 = getClaims id =
let
path =
if id == 0 then
"api/claims"
else
"api/players/" ++ String.fromInt id ++ "/claims"
in
send send
{ method = "GET" { method = "GET"
, path = "api/players/" ++ String.fromInt id ++ "/claims" , path = path
, decoder = valueDecoder (D.list claimDecoder) , decoder = valueDecoder (D.list claimDecoder)
} }

10
src/Main.elm
View File

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

170
src/Page.elm
View File

@@ -5,16 +5,17 @@ import Api.Player
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (..) import Html.Events exposing (..)
import Page.Dashboard as Dashboard import Page.Dashboard as Home
import Page.GroupChest as GroupChest import Page.GroupChest as GroupChest
import Page.Shop as Shop import Page.Shop as Shop
import Route
import Session exposing (Session) import Session exposing (Session)
import Utils exposing (renderIcon) import Utils exposing (renderIcon)
import Wealth import Wealth
type Page type Page
= Dashboard Dashboard.Model = Home Home.Model
| GroupChest GroupChest.Model | GroupChest GroupChest.Model
| Shop Shop.Model | Shop Shop.Model
| About | About
@@ -25,14 +26,16 @@ init =
Loading Loading
mapMsg toMsg = mapPageMsg toMsg ( controls, content ) =
List.map (Html.map toMsg) ( Html.map toMsg controls
, List.map (Html.map toMsg) content
)
maybeSession page = maybeSession page =
case page of case page of
Dashboard model -> Home model ->
Just <| Dashboard.getSession model Just <| Home.getSession model
GroupChest model -> GroupChest model ->
Just <| Session.getSession model Just <| Session.getSession model
@@ -48,35 +51,37 @@ view page =
let let
( title, ( controls, content ) ) = ( title, ( controls, content ) ) =
case page of case page of
Dashboard home -> Home home ->
( "Lootalot" ( "Lootalot"
, Dashboard.view home , Home.view home
|> Tuple.mapBoth |> mapPageMsg GotHomeMsg
(Html.map GotDashboardMsg)
(mapMsg GotDashboardMsg)
) )
GroupChest chest -> GroupChest chest ->
( "Lootalot" ( "Lootalot"
, GroupChest.view chest , GroupChest.view chest
|> Tuple.mapBoth |> mapPageMsg GotGroupChestMsg
(Html.map GotGroupChestMsg)
(mapMsg GotGroupChestMsg)
) )
Shop shop -> Shop shop ->
( "Marchand" ( "Marchand"
, Shop.view shop , Shop.view shop
|> Tuple.mapBoth |> mapPageMsg GotShopMsg
(Html.map GotShopMsg)
(mapMsg GotShopMsg)
) )
About -> About ->
( "Loot-a-lot", ( text "", [ p [] [ text "A propos" ] ] ) ) ( "Loot-a-lot", ( text "", [ p [] [ text "A propos" ] ] ) )
Loading -> Loading ->
( "Loot-a-lot", ( text "", [ p [] [ text "Chargement" ] ] ) ) ( "Loot-a-lot"
, ( text ""
, [ div [ class "hero" ]
[ div [ class "hero-body" ]
[ p [] [ text "Chargement" ] ]
]
]
)
)
navbarTitle = navbarTitle =
case maybeSession page of case maybeSession page of
@@ -96,20 +101,16 @@ view page =
Just session -> Just session ->
case Session.user session of case Session.user session of
Session.Player data -> Session.Player data ->
let [ navLink "fas fa-store-alt" Route.Merchant page
linkWithGem =
navLink "fas fa-gem"
in
[ navLink "fas fa-store-alt" "Marchand" "/marchand"
, if data.player.id /= 0 then , if data.player.id /= 0 then
linkWithGem "Coffre de groupe" "/coffre" navLink "fas fa-gem" Route.GroupChest page
else else
text "" text ""
] ]
Session.Admin -> Session.Admin ->
[ navLink "fas fa-store-alt" "Marchand" "/marchand" ] [ navLink "fas fa-store-alt" Route.Merchant page ]
Nothing -> Nothing ->
[] []
@@ -118,25 +119,44 @@ view page =
, { title = navbarTitle, links = navbarLinks } , { title = navbarTitle, links = navbarLinks }
, [ div [ class "container" ] <| , [ div [ class "container" ] <|
viewSessionBar (maybeSession page) [ controls ] viewSessionBar (maybeSession page) [ controls ]
:: (case Maybe.map Session.notification (maybeSession page) of :: div [ class "section" ]
Just (Just notify) -> [ case Maybe.map Session.notification (maybeSession page) of
div [ class "notification is-success" ] [ text notify ] Just (Just t) ->
viewNotification NotifySuccess t
_ -> _ ->
text "" text ""
) , case Maybe.map Session.error (maybeSession page) of
:: (case Maybe.map Session.error (maybeSession page) of Just (Just t) ->
Just (Just notify) -> viewNotification NotifyError t
div [ class "notification is-danger" ] [ text notify ]
_ -> _ ->
text "" text ""
) ]
:: content :: 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 = viewSessionBar session controls =
let let
user = user =
@@ -149,8 +169,10 @@ viewSessionBar session controls =
Wealth.view data.player.wealth data.wealth Wealth.view data.player.wealth data.wealth
++ (if data.player.debt > 0 then ++ (if data.player.debt > 0 then
[ div [ class "level-item" ] [ div [ class "level-item" ]
[ p [ class "heading is-size-4 has-text-danger" ] [ p [ class "has-text-right has-text-danger" ]
[ text ("Dette : " ++ String.fromInt data.player.debt ++ "po") ] [ 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 -- PLAYER BAR
navLink icon linkText url = navLink icon route page =
a [ class "navbar-item", href url ] 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" } [ renderIcon { icon = icon, ratio = "1x", size = "medium" }
, span [] [ text linkText ] , span [] [ text link ]
] ]
@@ -194,7 +248,7 @@ navLink icon linkText url =
type PageMsg type PageMsg
= ApiMsg Api.Msg = ApiMsg Api.Msg
| GotGroupChestMsg GroupChest.Msg | GotGroupChestMsg GroupChest.Msg
| GotDashboardMsg Dashboard.Msg | GotHomeMsg Home.Msg
| GotShopMsg Shop.Msg | GotShopMsg Shop.Msg
| Wealth Wealth.Msg | Wealth Wealth.Msg
@@ -210,8 +264,8 @@ map func page =
Just session -> Just session ->
case page of case page of
Dashboard model -> Home model ->
Dashboard <| Dashboard.updateSession model (func session) Home <| Home.updateSession model (func session)
GroupChest model -> GroupChest model ->
GroupChest { model | session = func session } GroupChest { model | session = func session }
@@ -229,14 +283,14 @@ map func page =
closeAction ( page, cmd ) = closeAction ( page, cmd ) =
case page of case page of
Dashboard home -> Home from ->
( page, cmd ) gotoHome page
GroupChest chest -> GroupChest from ->
( GroupChest (GroupChest.refresh chest), cmd ) gotoGroupChest page
Shop shop -> Shop from ->
( page, cmd ) gotoShop page
_ -> _ ->
( page, cmd ) ( page, cmd )
@@ -244,17 +298,18 @@ closeAction ( page, cmd ) =
update msg page = update msg page =
case ( msg, page, maybeSession page ) of case ( msg, page, maybeSession page ) of
-- Dashboard page -- Home page
-- Capture API messages -- Capture API messages
( GotDashboardMsg (Dashboard.Api apiMsg), Dashboard home, _ ) -> ( GotHomeMsg (Home.Api apiMsg), Home home, _ ) ->
update (ApiMsg apiMsg) page update (ApiMsg apiMsg) page
|> closeAction
-- Relay others -- Relay others
( GotDashboardMsg subMsg, Dashboard home, _ ) -> ( GotHomeMsg subMsg, Home home, _ ) ->
Dashboard.update subMsg home Home.update subMsg home
|> updatePage Dashboard GotDashboardMsg |> updatePage Home GotHomeMsg
( GotDashboardMsg _, _, _ ) -> ( GotHomeMsg _, _, _ ) ->
( page, Cmd.none ) ( page, Cmd.none )
-- Group chest -- Group chest
@@ -272,6 +327,7 @@ update msg page =
-- Shop page -- Shop page
( GotShopMsg (Shop.Api apiMsg), Shop shop, _ ) -> ( GotShopMsg (Shop.Api apiMsg), Shop shop, _ ) ->
update (ApiMsg apiMsg) page update (ApiMsg apiMsg) page
|> closeAction
( GotShopMsg subMsg, Shop shop, _ ) -> ( GotShopMsg subMsg, Shop shop, _ ) ->
Shop.update subMsg shop Shop.update subMsg shop
@@ -417,8 +473,8 @@ applyUpdate u user =
initHome session = initHome session =
Dashboard.init session Home.init session
|> updatePage Dashboard GotDashboardMsg |> updatePage Home GotHomeMsg
gotoHome page = gotoHome page =
@@ -427,8 +483,8 @@ gotoHome page =
( page, Cmd.none ) ( page, Cmd.none )
Just session -> Just session ->
Dashboard.init session Home.init session
|> updatePage Dashboard GotDashboardMsg |> updatePage Home GotHomeMsg
gotoShop page = 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 Html exposing (..)
import Page.Chest.NewFromInventory as NewFromInventory import Page.Chest.NewFromInventory as NewFromInventory
import Page.Chest.Selection as Selection import Page.Chest.Selection as Selection
import Table import Table
import Utils
type alias RowRenderer msg = type alias RowRenderer msg =
@@ -27,21 +28,40 @@ type alias RowRenderer msg =
type Chest type Chest
= View (Item -> Html Never) = New NewFromInventory.Model
| Selection Selection.Model | View (Item -> Html Never)
| Create NewFromInventory.Model | 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 Dashboard :
* ViewWithClaims (group)
NewFromInventory : RowRenderer -> { confirm: Cmd msg, cancel: Cmd msg } -> Chest.NewFromInventory * View
* Add
* Sell
Shop :
* View
* Refresh
* Buy
GroupChest :
* ViewWithClaims
* Claim
-} -}
@@ -49,19 +69,40 @@ init =
View Table.name View Table.name
show : Table.ItemRenderer Item Never -> Chest intoMode : IntoMode -> Msg
show renderItem = 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 (\_ -> []) View <| Table.renderRowLevel renderItem (\_ -> [])
initCreate =
Create NewFromInventory.init
initSelection maybeInitial =
Selection <| Selection.init maybeInitial
view : Chest -> Loot -> Html Msg view : Chest -> Loot -> Html Msg
view model loot = view model loot =
case model of case model of
@@ -69,31 +110,95 @@ view model loot =
Table.view renderItem loot Table.view renderItem loot
|> Html.map GotViewMsg |> Html.map GotViewMsg
Selection subModel -> Buy subModel ->
Selection.view subModel loot Selection.view subModel loot
|> Html.map GotSelectionMsg |> Html.map GotSelectionMsg
Create subModel -> Sell subModel ->
Selection.view subModel loot
|> Html.map GotSelectionMsg
New subModel ->
NewFromInventory.view subModel NewFromInventory.view subModel
|> Html.map GotCreateMsg |> Html.map GotNewMsg
Claim subModel ->
Selection.view subModel loot
|> Html.map GotSelectionMsg
type Msg type Msg
= GotCreateMsg NewFromInventory.Msg = GotNewMsg NewFromInventory.Msg
| GotSelectionMsg Selection.Msg | GotSelectionMsg Selection.Msg
| GotViewMsg Never | GotViewMsg Never
| IntoMode IntoMode
update : Msg -> Chest -> ( Chest, Cmd Msg ) update : Msg -> Chest -> ( Chest, Cmd Msg )
update msg model = update msg model =
case ( msg, model ) of case ( msg, model ) of
( GotCreateMsg subMsg, Create subModel ) -> ( GotNewMsg subMsg, New subModel ) ->
NewFromInventory.update subMsg 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 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 ) ( model, Cmd.none )
@@ -113,7 +218,7 @@ updateChest toMsg toChest ( model, cmd ) =
confirmBuy : Int -> Chest -> Loot -> Cmd Api.Msg confirmBuy : Int -> Chest -> Loot -> Cmd Api.Msg
confirmBuy playerId model loot = confirmBuy playerId model loot =
case model of case model of
Selection chest -> Buy chest ->
let let
items = items =
Selection.selected chest loot Selection.selected chest loot
@@ -135,7 +240,7 @@ confirmBuy playerId model loot =
confirmSell : Int -> Chest -> Loot -> List Int -> Cmd Api.Msg confirmSell : Int -> Chest -> Loot -> List Int -> Cmd Api.Msg
confirmSell playerId model loot players = confirmSell playerId model loot players =
case model of case model of
Selection chest -> Sell chest ->
let let
items = items =
Selection.selected chest loot Selection.selected chest loot
@@ -157,7 +262,7 @@ confirmSell playerId model loot players =
confirmAdd : Int -> String -> Chest -> Cmd Api.Msg confirmAdd : Int -> String -> Chest -> Cmd Api.Msg
confirmAdd playerId sourceName model = confirmAdd playerId sourceName model =
case model of case model of
Create chest -> New chest ->
let let
items = items =
NewFromInventory.allLoot chest NewFromInventory.allLoot chest
@@ -176,7 +281,7 @@ confirmAdd playerId sourceName model =
confirmGrab : Int -> Loot -> Chest -> Cmd Api.Msg confirmGrab : Int -> Loot -> Chest -> Cmd Api.Msg
confirmGrab playerId loot model = confirmGrab playerId loot model =
case model of case model of
Selection chest -> Claim chest ->
let let
items = items =
Selection.selected chest loot Selection.selected chest loot

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

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

157
src/Page/Dashboard.elm
View File

@@ -39,20 +39,13 @@ type alias NewPlayerForm =
type PlayerConfig type PlayerConfig
= PlayerConfig Session Mode = PlayerConfig Session Chest
type AdminConfig type AdminConfig
= AdminConfig Session (List Player) NewPlayerForm = AdminConfig Session (List Player) NewPlayerForm
type Mode
= PlayerChest Chest
| GroupChest Chest
| Sell Chest
| Add Chest
init : Session -> ( Model, Cmd Msg ) init : Session -> ( Model, Cmd Msg )
init session = init session =
case Session.user session of case Session.user session of
@@ -66,10 +59,11 @@ init session =
PlayerConfig session PlayerConfig session
(if data.player.id == 0 then (if data.player.id == 0 then
-- TODO: render claimed items -- TODO: render claimed items
GroupChest Chest.init Chest.update (Chest.showWithClaims data.claims) Chest.init
|> Tuple.first
else else
PlayerChest Chest.init Chest.init
) )
, Cmd.none , Cmd.none
) )
@@ -90,33 +84,38 @@ buttons bs =
view : Model -> ( Html Msg, List (Html Msg) ) view : Model -> ( Html Msg, List (Html Msg) )
view model = view model =
case model of case model of
Player (PlayerConfig session mode) -> Player (PlayerConfig session chest) ->
case Session.user session of case Session.user session of
Session.Player data -> Session.Player data ->
Tuple.mapBoth let
(Html.map PlayerViewer) toShow =
(List.map (Html.map PlayerViewer)) case data.player.id of
<| 0 ->
case mode of GotChestMsg <| Chest.showWithClaims data.claims
PlayerChest chest ->
( modeButton "Vendre" IntoSell
, [ Html.map GotChestMsg <| Chest.view chest data.loot ]
)
GroupChest chest -> _ ->
( buttons [ modeButton "Vendre" IntoSell, modeButton "Ajouter" IntoAdd ] GotChestMsg Chest.show
, [ Html.map GotChestMsg <| Chest.view chest data.loot ] 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 ] modeButton "Vendre" (GotChestMsg Chest.sell)
, [ Html.map GotChestMsg <| Chest.view chest data.loot ]
)
Add chest -> Chest.Sell _ ->
( buttons [ modeButton "Ok" ConfirmAdd, modeButton "Annuler" IntoView ] buttons [ modeButton "Ok" ConfirmSell, modeButton "Annuler" toShow ]
, [ Html.map GotChestMsg <| Chest.view chest [] ]
) Chest.New _ ->
buttons [ modeButton "Ok" ConfirmAdd, modeButton "Annuler" toShow ]
_ ->
text ""
, [ Html.map (PlayerViewer << GotChestMsg) <| Chest.view chest data.loot ]
)
_ -> _ ->
let let
@@ -198,48 +197,8 @@ type AdminMsg
type PlayerMsg type PlayerMsg
= GotChestMsg Chest.Msg = GotChestMsg Chest.Msg
| IntoSell
| IntoAdd
| ConfirmSell | ConfirmSell
| ConfirmAdd | 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 = update msg model =
@@ -258,27 +217,23 @@ update msg model =
) )
|> Tuple.mapSecond (Cmd.map AdminViewer) |> Tuple.mapSecond (Cmd.map AdminViewer)
( PlayerViewer ConfirmSell, Player (PlayerConfig session mode) ) -> ( PlayerViewer ConfirmSell, Player (PlayerConfig session chest) ) ->
( model ( model
, Cmd.map Api <| , Cmd.map Api <|
case Session.user session of case Session.user session of
Session.Player data -> Session.Player data ->
-- TODO: handle list of players when Viewer is group -- TODO: handle list of players when Viewer is group
mapChest Chest.confirmSell
(\chest -> data.player.id
Chest.confirmSell chest
data.player.id data.loot
chest []
data.loot
[]
)
mode
_ -> _ ->
Cmd.none Cmd.none
) )
( PlayerViewer ConfirmAdd, Player (PlayerConfig session mode) ) -> ( PlayerViewer ConfirmAdd, Player (PlayerConfig session chest) ) ->
( model ( model
, Cmd.map Api <| , Cmd.map Api <|
case Session.user session of case Session.user session of
@@ -287,45 +242,23 @@ update msg model =
sourceName = sourceName =
"nouveau loot #1" "nouveau loot #1"
in in
mapChest (\chest -> Chest.confirmAdd 0 sourceName chest) mode Chest.confirmAdd
0
sourceName
chest
_ -> _ ->
Cmd.none Cmd.none
) )
( PlayerViewer aMsg, Player (PlayerConfig session mode) ) -> ( PlayerViewer aMsg, Player (PlayerConfig session chest) ) ->
(case aMsg of (case aMsg of
GotChestMsg chestMsg -> GotChestMsg chestMsg ->
mapChest (Chest.update chestMsg) mode Chest.update chestMsg chest
|> Tuple.mapBoth |> Tuple.mapBoth
(updateChest model) (\chest_ -> Player (PlayerConfig session chest_))
(Cmd.map GotChestMsg) (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 ) ( 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 Session exposing (Session, User(..))
import Set import Set
import Table import Table
import Utils exposing (renderIcon)
type alias Model = type alias Model =
{ session : Session { session : Session
, loot : State , 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 type State
= Loading = Loading
| LoadError String | LoadError String
@@ -52,7 +39,13 @@ getClaimsFromSession session =
init 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) ) view : Model -> ( Html Msg, List (Html Msg) )
@@ -79,21 +72,21 @@ view model =
Session.Player data -> Session.Player data ->
( True, data.player.id == 0 ) ( True, data.player.id == 0 )
in in
case model.mode of case ( model.chest, isPlayer && not isGroup ) of
View _ -> ( Chest.View _, True ) ->
if isPlayer && not isGroup then button
button [ class "button", onClick IntoGrab ] [ text "Demander" ] [ class "button"
, onClick
(GotChestMsg <| Chest.showWithClaims (getClaimsFromSession model.session))
]
[ text "Demander" ]
else ( Chest.Claim _, True ) ->
text "" button [ class "button", onClick ConfirmGrab ] [ text "Valider" ]
Grab _ -> ( _, _ ) ->
if isPlayer && not isGroup then text ""
button [ class "button", onClick ConfirmGrab ] [ text "Valider" ] , [ Chest.view model.chest loot
else
text ""
, [ mapChest (\c -> Chest.view c loot) model.mode
|> Html.map (Internal << GotChestMsg) |> Html.map (Internal << GotChestMsg)
] ]
) )
@@ -107,34 +100,11 @@ type Msg
type InnerMsg type InnerMsg
= GotLoot Api.ToChest (HttpResult Loot) = GotLoot Api.ToChest (HttpResult Loot)
| GotChestMsg Chest.Msg | GotChestMsg Chest.Msg
| IntoGrab
| IntoView
| ConfirmGrab | 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 = 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 ) update : Msg -> Model -> ( Model, Cmd Msg )
@@ -144,13 +114,13 @@ update msg model =
( model, Cmd.none ) ( model, Cmd.none )
Internal ConfirmGrab -> Internal ConfirmGrab ->
case ( Session.user model.session, model.loot, model.mode ) of case ( Session.user model.session, model.loot, model.chest ) of
( Session.Player data, Loaded loot, Grab chest ) -> ( Session.Player data, Loaded loot, Chest.Claim _ ) ->
( model ( model
, Chest.confirmGrab , Chest.confirmGrab
data.player.id data.player.id
loot loot
chest model.chest
|> Cmd.map Api |> Cmd.map Api
) )
@@ -166,24 +136,9 @@ update msg model =
( { model | loot = LoadError "Le chargement a échoué" }, Cmd.none ) ( { model | loot = LoadError "Le chargement a échoué" }, Cmd.none )
GotChestMsg chestMsg -> GotChestMsg chestMsg ->
mapChest (Chest.update chestMsg) model.mode Chest.update chestMsg model.chest
|> updateChest model |> 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 ) ( model, Cmd.none )
) )
@@ -191,11 +146,6 @@ update msg model =
updateChest model ( chestModel, chestCmd ) = updateChest model ( chestModel, chestCmd ) =
( case model.mode of ( { model | chest = chestModel }
View _ ->
{ model | mode = View chestModel }
Grab _ ->
{ model | mode = Grab chestModel }
, Cmd.map GotChestMsg chestCmd , Cmd.map GotChestMsg chestCmd
) )

98
src/Page/Shop.elm
View File

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

34
src/Route.elm
View File

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

6
src/Wealth.elm
View File

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