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

everything starts to connect, still a big mess though !!

Browse Source
This commit is contained in:
Arthur Gerbaud
2019-12-01 16:00:57 +01:00
parent dbc99830d6
commit 09bd6560cc
11 changed files with 797 additions and 193 deletions
Download Patch File Download Diff File Expand all files Collapse all files

73
src/Api.elm
View File

@@ -13,6 +13,8 @@ module Api exposing
, fetchClaimsOf
, fetchLoot
, fetchSession
, getLoot
, printError
, replaceShopItems
)
@@ -421,23 +423,25 @@ replaceShopItems toMsg loot =
}
-- This is where the error happened
fetchSession =
Http.task
{ method = "GET"
, url = "http://localhost:8088/session"
, headers = []
, body = Http.emptyBody
, resolver = Http.stringResolver <| handleJsonResponse Api.Player.playerDecoder
, timeout = Nothing
}
fetchSession toMsg =
let
gotResponse r =
case Debug.log "got session:" r of
Ok player ->
toMsg (Just player)
Err _ ->
toMsg Nothing
in
Http.get
{ url = "http://localhost:8088/session"
, expect = Http.expectJson gotResponse Api.Player.playerDecoder
getLoot id =
Http.task
{ method = "GET"
, url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/loot"
, headers = []
, body = Http.emptyBody
, resolver = Http.stringResolver <| handleJsonResponse (valueDecoder lootDecoder)
, timeout = Nothing
}
@@ -445,11 +449,44 @@ fetchSession toMsg =
-- UTILS
handleJsonResponse : Decoder a -> Http.Response String -> Result Http.Error a
handleJsonResponse decoder response =
case response of
Http.BadUrl_ url ->
Err (Http.BadUrl url)
Http.Timeout_ ->
Err Http.Timeout
Http.BadStatus_ { statusCode } _ ->
Err (Http.BadStatus statusCode)
Http.NetworkError_ ->
Err Http.NetworkError
Http.GoodStatus_ _ body ->
case D.decodeString decoder body of
Err _ ->
Err (Http.BadBody body)
Ok result ->
Ok result
printError : Http.Error -> String
printError error =
case error of
Http.NetworkError ->
"Le serveur ne répond pas"
"Le réseau ne fonctionne pas"
_ ->
"Erreur inconnue"
Http.Timeout ->
"Le serveur ne réponse pas (timeout)"
Http.BadUrl url ->
"La resource " ++ url ++ "n'existe pas"
Http.BadStatus statusCode ->
"Le serveur a renvoyé une erreur (" ++ String.fromInt statusCode ++ ")"
Http.BadBody body ->
"La réponse n'a pas pu être lue : " ++ body

11
src/Main.elm
View File

@@ -7,7 +7,6 @@ import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Json.Encode as E
import Page exposing (Page)
import Page.Admin as Admin
import Page.Chest as Chest exposing (Msg)
import Route exposing (..)
import Session exposing (..)
@@ -130,7 +129,7 @@ viewHeaderBar navbarTitle navbarLinks navbar =
type Msg
= UrlChanged Url.Url
| LinkClicked Browser.UrlRequest
| SessionLoaded (Maybe Session)
| SessionLoaded (Result String Session)
| PageMsg Page.PageMsg
| SwitchMenuOpen
@@ -140,14 +139,18 @@ update msg model =
case ( msg, model.page ) of
( SessionLoaded session, _ ) ->
case session of
Just logged ->
Ok logged ->
let
( page, cmd ) =
Page.initHome logged
in
( model |> setPage page, Cmd.map PageMsg cmd )
Nothing ->
Err error ->
let
_ =
Debug.log "SessionLoaded Error" error
in
( model |> setPage Page.About, Cmd.none )
( LinkClicked urlRequest, _ ) ->

33
src/Page.elm
View File

@@ -5,7 +5,6 @@ import Api.Player
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Page.Admin as Admin
import Page.Dashboard as Dashboard
import Page.GroupChest as GroupChest
import Page.Shop as Shop
@@ -33,7 +32,7 @@ mapMsg toMsg =
maybeSession page =
case page of
Dashboard model ->
Just <| Session.getSession model
Just <| Dashboard.getSession model
GroupChest model ->
Just <| Session.getSession model
@@ -83,7 +82,7 @@ view page =
case maybeSession page of
Just session ->
case Session.user session of
Session.Player player _ ->
Session.Player player _ _ ->
player.name
Session.Admin ->
@@ -96,7 +95,7 @@ view page =
case maybeSession page of
Just session ->
case Session.user session of
Session.Player player _ ->
Session.Player player _ _ ->
let
linkWithGem =
navLink "fas fa-gem"
@@ -131,7 +130,7 @@ viewSessionBar session controls =
Nothing ->
[ text "" ]
Just (Session.Player player wealth) ->
Just (Session.Player player wealth _) ->
let
_ =
Debug.log "viewSessionBar wealth" player.wealth
@@ -179,8 +178,6 @@ navLink icon linkText url =
-- UPDATE
--
-- Note : All pages 'update' function
-- shall return (subMode, Cmd Api.Msg)
type PageMsg
@@ -203,7 +200,7 @@ map func page =
Just session ->
case page of
Dashboard model ->
Dashboard { model | session = func session }
Dashboard <| Dashboard.updateSession model (func session)
GroupChest model ->
GroupChest { model | session = func session }
@@ -224,6 +221,9 @@ update msg page =
( GotGroupChestMsg _, _, _ ) ->
( page, Cmd.none )
( GotDashboardMsg (Dashboard.Api apiMsg), Dashboard home, _ ) ->
update (ApiMsg apiMsg) page
( GotDashboardMsg subMsg, Dashboard home, _ ) ->
Dashboard.update subMsg home
|> updatePage Dashboard GotDashboardMsg
@@ -231,6 +231,9 @@ update msg page =
( GotDashboardMsg _, _, _ ) ->
( page, Cmd.none )
( GotShopMsg (Shop.Api apiMsg), Shop shop, _ ) ->
update (ApiMsg apiMsg) page
( GotShopMsg subMsg, Shop shop, _ ) ->
Shop.update subMsg shop
|> updatePage Shop GotShopMsg
@@ -244,7 +247,7 @@ update msg page =
Session.wealth session
in
case Session.user session of
Session.Player player aModel ->
Session.Player player aModel _ ->
let
( newWealth, maybeEdit ) =
Wealth.update wealthMsg aModel
@@ -328,15 +331,16 @@ applyUpdate u user =
in
{- Note: DbUpdates always refer to the active player -}
case user of
Session.Player player wealthModel ->
Session.Player player wealthModel loot ->
case u of
Api.ItemRemoved item ->
--List.filter (\i -> i.id /= item.id) model.state.playerLoot
user
Session.Player player wealthModel <|
List.filter
(\i -> i.id /= item.id)
loot
Api.ItemAdded item ->
--{ model | state = { state | playerLoot = item :: model.state.playerLoot } }
user
Session.Player player wealthModel (item :: loot)
Api.WealthUpdated diff ->
let
@@ -356,6 +360,7 @@ applyUpdate u user =
(wealth.pp + diff.pp)
}
wealthModel
loot
Api.ClaimAdded claim ->
-- { model | claims = claim :: model.claims }

2
src/Page/Admin.elm → src/Page/Admin.elm.old
View File

@@ -1,4 +1,4 @@
module Page.Admin exposing (Model, Msg, getSession, init, routeChanged, update, view)
module Page.Admin exposing (Model)
import Api exposing (Loot)
import Api.Player as Player exposing (Player, Wealth)

98
src/Page/Chest.elm
View File

@@ -1,4 +1,4 @@
module Page.Chest exposing (Chest, Msg, init, initCreate, initSelection, update, view)
module Page.Chest exposing (Chest, Msg, confirmAdd, confirmBuy, confirmSell, init, initCreate, initSelection, update, view)
import Api exposing (Item, Loot)
import Html exposing (..)
@@ -11,12 +11,40 @@ type alias RowRenderer msg =
Item -> List (Html msg)
{-
A chest is a component that acts on a list of items (loot)
It can render it's content as a table.
It does not hold any loot itself, it is given in view only !
type Chest
= Chest (RowRenderer Never)
-}
type Chest
= View
| Selection Selection.Model
| Create NewFromInventory.Model
{-
View : RowRenderer -> Chest.View
Selection : RowRenderer -> { confirm: Cmd msg, cancel: Cmd msg } -> Chest.Selection
NewFromInventory : RowRenderer -> { confirm: Cmd msg, cancel: Cmd msg } -> Chest.NewFromInventory
-}
init =
View
@@ -70,3 +98,71 @@ updateChest toMsg toChest ( model, cmd ) =
( toChest model
, Cmd.map toMsg cmd
)
-- Api actions
--
confirmBuy : Int -> Chest -> Loot -> Cmd Api.Msg
confirmBuy playerId model loot =
case model of
Selection chest ->
let
items =
Selection.selected chest loot
priceMods =
Selection.modifiers chest items
payload =
Api.BuyPayload items Nothing priceMods
in
Api.confirmAction
(String.fromInt playerId)
payload
_ ->
Cmd.none
confirmSell : Int -> Chest -> Loot -> List Int -> Cmd Api.Msg
confirmSell playerId model loot players =
case model of
Selection chest ->
let
items =
Selection.selected chest loot
priceMods =
Selection.modifiers chest items
payload =
Api.SellPayload items Nothing priceMods players
in
Api.confirmAction
(String.fromInt playerId)
payload
_ ->
Cmd.none
confirmAdd : Int -> String -> Chest -> Cmd Api.Msg
confirmAdd playerId sourceName model =
case model of
Create chest ->
let
items =
NewFromInventory.allLoot chest
payload =
Api.AddPayload sourceName items
in
Api.confirmAction
(String.fromInt playerId)
payload
_ ->
Cmd.none

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

@@ -1,37 +1,176 @@
module Page.Chest.Selection exposing (Model, Msg, init, update, view)
module Page.Chest.Selection exposing (Model, Msg, init, modifiers, selected, update, view)
import Api exposing (Loot)
import Api exposing (Item, Loot)
import Dict exposing (Dict)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Set exposing (Set)
import Table
type Selection
= Selection
type alias Selection =
Set Int
type alias Data a =
Dict Int a
type Model
= Model Selection
= Model Selection (Data Int)
init =
Model Selection
Model Set.empty Dict.empty
view : Model -> Loot -> Html Msg
view model loot =
view (Model selection data) loot =
let
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
Nothing ->
"0"
else
text ""
]
in
Table.view
(Table.renderRowLevel
(\item -> [ p [] [ text <| item.name ++ "selectable" ] ])
(\item -> [ input [ type_ "checkbox" ] [] ])
(Table.renderSelectableRow
(\item -> [ p [] [ text item.name ] ])
(\item -> renderItem item)
(\item _ -> SwitchSelectionState item.id)
isSelected
)
loot
toFloatingMod : Int -> Float
toFloatingMod percent =
(100 + Debug.log "toFloat" (toFloat percent)) / 100
-- Renderers : Item -> Html Msg
viewPriceWithModApplied : Maybe Float -> Float -> Html Msg
viewPriceWithModApplied maybeMod basePrice =
case maybeMod of
Just mod ->
p [ class "level-item has-text-weight-bold" ]
[ (Debug.log "withMod" (String.fromFloat (basePrice * mod)) ++ "po")
|> text
]
Nothing ->
p [ class "level-item" ] [ (String.fromFloat basePrice ++ "po") |> text ]
viewPriceModifier : Int -> String -> Html Msg
viewPriceModifier id modValue =
div [ class "level-item field has-addons" ]
[ div [ class "control has-icons-left" ]
[ input
[ type_ "number"
, value modValue
, class "input is-small"
, size 3
, style "width" "6em"
, Html.Attributes.min "-50"
, Html.Attributes.max "50"
, step "5"
, onInput (PriceModifierChanged id)
]
[]
, span [ class "icon is-left" ] [ i [ class "fas fa-percent" ] [] ]
]
]
-- Selection
-- Get list of selected items
selected : Model -> Loot -> Loot
selected (Model selection data) loot =
List.filter (itemInSelection selection) 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
itemInSelection : Selection -> Item -> Bool
itemInSelection selection item =
Set.member item.id selection
{-
itemInClaims : Claims -> Item -> Bool
itemInClaims claims item =
List.any (\c -> c.loot_id == item.id) claims
-}
switchSelectionState : Int -> Selection -> Selection
switchSelectionState id selection =
case Set.member id selection of
True ->
Set.remove id selection
False ->
Set.insert id selection
type Msg
= Msg
= SwitchSelectionState Int
| PriceModifierChanged Int String
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
( model, Cmd.none )
update msg (Model selection data) =
case msg of
PriceModifierChanged id value ->
( Model selection
(Dict.insert
id
(case String.toInt value of
Just i ->
i
Nothing ->
0
)
data
)
, Cmd.none
)
SwitchSelectionState id ->
( Model (switchSelectionState id selection) data, Cmd.none )

324
src/Page/Dashboard.elm
View File

@@ -1,5 +1,7 @@
module Page.Dashboard exposing (Model, Msg, init, update, view)
module Page.Dashboard exposing (Model, Msg(..), getSession, init, update, updateSession, view)
import Api
import Api.Player as Player exposing (Player, Wealth)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
@@ -7,43 +9,327 @@ import Page.Chest as Chest exposing (Chest)
import Session exposing (Session)
type alias Model =
{ session : Session
, chest : Mode
getSession model =
case model of
Admin (AdminConfig session _ _) ->
session
Player (PlayerConfig session _) ->
session
updateSession model session =
case model of
Admin (AdminConfig _ a b) ->
Admin (AdminConfig session a b)
Player (PlayerConfig _ a) ->
Player (PlayerConfig session a)
type Model
= Admin AdminConfig
| Player PlayerConfig
type alias NewPlayerForm =
{ name : String
, wealth : Float
}
type PlayerConfig
= PlayerConfig Session Mode
type AdminConfig
= AdminConfig Session (List Player) NewPlayerForm
type Mode
= View Chest
= PlayerChest Chest
| GroupChest Chest
| Sell Chest
| Add Chest
init : Session -> ( Model, Cmd Msg )
init session =
( Model session (View Chest.init)
, Cmd.none
)
case Session.user session of
Session.Admin ->
( Admin <| AdminConfig session [] initForm
, Player.list (AdminViewer << GotPlayers)
)
Session.Player player wealth loot ->
( Player <|
PlayerConfig session
(if player.id == 0 then
-- TODO: render claimed items
GroupChest Chest.init
else
PlayerChest Chest.init
)
, Cmd.none
)
initForm =
NewPlayerForm "" 0.0
modeButton t msg =
button [ class "button", onClick msg ] [ text t ]
buttons bs =
div [ class "buttons" ] bs
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" ]
case model of
Player (PlayerConfig session mode) ->
case Session.user session of
Session.Player player _ loot ->
Tuple.mapBoth
(Html.map PlayerViewer)
(List.map (Html.map PlayerViewer))
<|
case mode of
PlayerChest chest ->
( modeButton "Vendre" IntoSell
, [ Html.map GotChestMsg <| Chest.view chest loot ]
)
else
p [] [ text "Joueur" ]
GroupChest chest ->
( buttons [ modeButton "Vendre" IntoSell, modeButton "Ajouter" IntoAdd ]
, [ Html.map GotChestMsg <| Chest.view chest loot ]
)
Sell chest ->
( buttons [ modeButton "Ok" ConfirmSell, modeButton "Annuler" IntoView ]
, [ Html.map GotChestMsg <| Chest.view chest loot ]
)
Add chest ->
( buttons [ modeButton "Ok" ConfirmAdd, modeButton "Annuler" IntoView ]
, [ Html.map GotChestMsg <| Chest.view chest [] ]
)
_ ->
let
_ =
Debug.log "Admin in PlayerDashboard !!" ()
in
( text "", [] )
Admin (AdminConfig session players newPlayer) ->
( text ""
, [ div [ class "container" ]
[ p [ class "title" ] [ text "Administration" ]
, div [ class "section" ]
[ table [ class "table is-fullwidth is-striped" ]
[ thead [ class "table-header" ]
[ th [] [ text "Joueurs" ] ]
, tbody [] <|
editNewPlayer newPlayer
:: List.map viewPlayer players
]
]
, div [ class "section" ]
[ p [] [ text "Campagnes" ] ]
]
]
)
Session.Admin ->
( text "", [ p [] [ text "Joueur" ] ] )
viewPlayer : Player -> Html Msg
viewPlayer player =
tr [] [ td [] [ p [] [ text (player.name ++ " (" ++ String.fromInt player.id ++ ")") ] ] ]
editNewPlayer : NewPlayerForm -> Html Msg
editNewPlayer newPlayer =
tr []
[ td []
[ div [ class "field is-horizontal" ]
[ div [ class "field-body" ]
[ div [ class "field" ]
[ input
[ class "input"
, type_ "text"
, value newPlayer.name
, onInput <| NameChanged
]
[]
]
, div [ class "field" ]
[ input
[ class "input"
, type_ "text"
, value <| String.fromFloat newPlayer.wealth
, onInput <| WealthChanged
]
[]
]
]
]
]
]
|> Html.map (AdminViewer << GotFormMsg)
type Msg
= Msg
= Api Api.Msg
| AdminViewer AdminMsg
| PlayerViewer PlayerMsg
type AdminMsg
= GotPlayers (List Player)
| GotFormMsg FormMsg
-- Player
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 =
( model, Cmd.none )
case ( msg, model ) of
( AdminViewer aMsg, Admin (AdminConfig session players form) ) ->
(case aMsg of
GotPlayers newPlayers ->
( Admin (AdminConfig session newPlayers form)
, Cmd.none
)
GotFormMsg subMsg ->
( Admin (AdminConfig session players (updateForm subMsg form))
, Cmd.none
)
)
|> Tuple.mapSecond (Cmd.map AdminViewer)
( PlayerViewer ConfirmSell, Player (PlayerConfig session mode) ) ->
( model
, Cmd.map Api <|
case Session.user session of
Session.Player player _ loot ->
-- TODO: handle list of players when Viewer is group
mapChest (\chest -> Chest.confirmSell player.id chest loot []) mode
_ ->
Cmd.none
)
( PlayerViewer ConfirmAdd, Player (PlayerConfig session mode) ) ->
( model
, Cmd.map Api <|
case Session.user session of
Session.Player player _ _ ->
let
sourceName =
"nouveau loot #1"
in
mapChest (\chest -> Chest.confirmAdd 0 sourceName chest) mode
_ ->
Cmd.none
)
( PlayerViewer aMsg, Player (PlayerConfig session mode) ) ->
(case aMsg of
GotChestMsg chestMsg ->
mapChest (Chest.update chestMsg) mode
|> Tuple.mapBoth
(updateChest model)
(Cmd.map GotChestMsg)
IntoSell ->
( Player (PlayerConfig session (Sell Chest.initSelection)), Cmd.none )
IntoAdd ->
( Player (PlayerConfig session (Add Chest.initCreate)), Cmd.none )
IntoView ->
-- TODO: add the necessary test on group/player
( Player (PlayerConfig session (PlayerChest Chest.init)), Cmd.none )
_ ->
( model, Cmd.none )
)
|> Tuple.mapSecond (Cmd.map PlayerViewer)
( _, _ ) ->
let
_ =
Debug.log "unhandled msg" msg
in
( model, Cmd.none )
-- Player form
type FormMsg
= NameChanged String
| WealthChanged String
updateForm : FormMsg -> NewPlayerForm -> NewPlayerForm
updateForm msg form =
case msg of
NameChanged newName ->
{ form | name = newName }
WealthChanged newWealth ->
{ form | wealth = Maybe.withDefault 0.0 <| String.toFloat newWealth }

2
src/Page/GroupChest.elm
View File

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

213
src/Page/Shop.elm
View File

@@ -1,4 +1,4 @@
module Page.Shop exposing (Model, Msg, init, update, view)
module Page.Shop exposing (Model, Msg(..), init, update, view)
import Api exposing (HttpResult, Item, Loot)
import Dict exposing (Dict)
@@ -6,7 +6,6 @@ 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)
@@ -44,21 +43,23 @@ getChest mode =
c
{-
| View Loot
| Refresh NewChest.Model
| Buy Selection.Model
| Sending
-}
init session =
( Model session Loading <| View Chest.init, fetchShopItems )
fetchShopItems =
Api.fetchLoot GotLoot Api.OfShop
|> Cmd.map Internal
btn : String -> Msg -> Html Msg
btn t msg =
button [ class "button", onClick msg ] [ text t ]
buttons : List (Html Msg) -> Html Msg
buttons bs =
div [ class "buttons" ] bs
view : Model -> ( Html Msg, List (Html Msg) )
@@ -77,61 +78,45 @@ view model =
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" ]
case ( model.chest, Session.user model.session ) of
( View chest, Session.Admin ) ->
btn "Remplacer" (Internal IntoRefresh)
Session.Player _ _ ->
button [ class "button" ] [ text "Acheter" ]
( View chest, Session.Player _ _ _ ) ->
btn "Acheter" (Internal IntoBuy)
Buy chest ->
text ""
( Buy chest, Session.Player p _ _ ) ->
buttons [ btn "Ok" (Internal ConfirmBuy), btn "Annuler" (Internal IntoView) ]
Refresh chest ->
( Refresh chest, Session.Admin ) ->
buttons [ btn "Ok" (Internal ConfirmRefresh), btn "Annuler" (Internal IntoView) ]
_ ->
text ""
in
( controls
, [ Chest.view (getChest model.chest) loot |> Html.map GotChestMsg ]
, [ Chest.view (getChest model.chest) loot |> Html.map (Internal << GotChestMsg) ]
)
{-
Buy selection ->
let
( controls, content ) =
Selection.view selection
toMsg =
Html.map GotBuyMsg
in
( toMsg controls
, List.map toMsg content
)
Refresh chest ->
let
( controls, content ) =
NewChest.view chest
toMsg =
Html.map GotChestMsg
in
( toMsg controls
, List.map toMsg content
)
Sending ->
( text "", [ p [] [ text "En attente du serveur..." ] ] )
-}
-- Api msg are not handled by the page
type Msg
= Api Api.Msg
| Internal ShopMsg
type ShopMsg
= GotLoot Api.ToChest (HttpResult Loot)
| IntoRefresh
| ConfirmRefresh
| GotRefreshResult (Maybe ())
| IntoBuy
| ConfirmBuy
| GotBuyResult
| IntoView
| GotChestMsg Chest.Msg
@@ -159,72 +144,90 @@ updateChest model chest =
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
GotLoot Api.OfShop response ->
case response of
Ok loot ->
( { model | loot = Loaded loot }, Cmd.none )
-- TODO: handle error
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 )
Internal ConfirmBuy ->
case ( Session.user (getSession model), model.loot, model.chest ) of
( Session.Player player _ _, Loaded loot, Buy chest ) ->
( model
, Chest.confirmBuy
player.id
chest
loot
|> Cmd.map Api
)
_ ->
( model, Cmd.none )
-- Buy mode
IntoBuy ->
case Session.user (getSession model) of
Session.Player _ _ ->
( { model | chest = Buy Chest.initSelection }, Cmd.none )
Internal (GotRefreshResult result) ->
case result of
Just _ ->
init <| getSession model
_ ->
( model, Cmd.none )
Nothing ->
( { model | loot = LoadError "L'ajout a échoué. Vous devez recommencer :'( " }
, Cmd.none
)
GotChestMsg subMsg ->
Chest.update subMsg (getChest model.chest)
|> Tuple.mapBoth
(updateChest model)
(Cmd.map GotChestMsg)
Internal shopMsg ->
let
( nModel, cmd ) =
case shopMsg of
GotLoot Api.OfShop response ->
case response of
Ok loot ->
( { model | loot = Loaded loot }, Cmd.none )
{-
(GotChestMsg chestMsg, Refresh chest ) ->
let
( newState, cmd, exit ) =
NewChest.update chestMsg chest
in
case exit of
Just status ->
case status of
NewChest.Confirmed loot ->
( model, Api.replaceShopItems GotRefreshResult loot )
-- TODO: handle error
Err e ->
( { model | loot = LoadError <| Debug.toString e }, Cmd.none )
NewChest.Canceled ->
init <| getSession model
-- Refresh mode
IntoRefresh ->
case Session.user (getSession model) of
Session.Admin ->
( { model | chest = Refresh Chest.initCreate }, Cmd.none )
Nothing ->
( { model | state = Refresh newState }, Cmd.map GotChestMsg cmd )
_ ->
( model, Cmd.none )
( GotRefreshResult result, _ ) ->
case result of
Just _ ->
init <| getSession model
ConfirmRefresh ->
case Session.user (getSession model) of
Session.Admin ->
let
loot =
[]
in
( model, Api.replaceShopItems GotRefreshResult loot )
Nothing ->
( { model | state = LoadError "L'ajout a échoué. Vous devez recommencer :'( " }
, Cmd.none
)
_ ->
let
_ =
Debug.log "Forbidden action ! (is not admin)" ()
in
( model, Cmd.none )
-- Buy mode
IntoBuy ->
case Session.user (getSession model) of
Session.Player _ _ _ ->
( { model | chest = Buy Chest.initSelection }, Cmd.none )
_ ->
( model, Cmd.none )
IntoView ->
( { model | chest = View Chest.init }, Cmd.none )
GotChestMsg subMsg ->
Chest.update subMsg (getChest model.chest)
|> Tuple.mapBoth
(updateChest model)
(Cmd.map GotChestMsg)
_ ->
( model, Cmd.none )
in
( nModel, Cmd.map Internal cmd )
( GotBuyMsg subMsg, Buy subModel ) ->
Selection.update subMsg subModel
|> Tuple.mapBoth
(\m -> { model | state = Buy m })
(\c -> Cmd.map GotBuyMsg c)
-}
_ ->
( model, Cmd.none )

46
src/Session.elm
View File

@@ -1,15 +1,16 @@
module Session exposing (Session, User(..), getSession, init, key, updateUser, updateWealth, user, wealth)
import Api
import Api exposing (Loot)
import Api.Player as Player exposing (Player)
import Browser.Navigation as Nav
import Http
import Json.Decode as D
import Task exposing (Task)
import Wealth
type User
= Player Player Wealth.Model
= Player Player Wealth.Model Loot
| Admin
@@ -17,19 +18,32 @@ type Session
= Session Nav.Key User
init : (Maybe Session -> msg) -> Nav.Key -> Cmd msg
init : (Result String Session -> msg) -> Nav.Key -> Cmd msg
init toMsg navKey =
let
toSession : Maybe Player -> msg
toSession response =
case response of
Just player ->
toMsg <| Just (Session navKey (Player player Wealth.init))
toSession : Result String ( Player, Loot ) -> msg
toSession result =
case result of
Ok ( player, loot ) ->
toMsg <| Ok (Session navKey (Player player Wealth.init loot))
Nothing ->
toMsg Nothing
Err error ->
toMsg <| Err error
in
Api.fetchSession toSession
Task.attempt toSession initFullSession
initFullSession : Task String ( Player, Loot )
initFullSession =
Api.fetchSession
|> Task.andThen wrapLoot
|> Task.mapError Api.printError
wrapLoot : Player -> Task Http.Error ( Player, Loot )
wrapLoot player =
Api.getLoot player.id
|> Task.andThen (\loot -> Task.succeed ( player, loot ))
getSession : { r | session : Session } -> Session
@@ -58,7 +72,7 @@ user session =
wealth : Session -> Maybe Wealth.Model
wealth session =
case user session of
Player _ model ->
Player _ model _ ->
Just model
Admin ->
@@ -71,8 +85,8 @@ setWealth wealthModel session =
session
in
case isUser of
Player p _ ->
Session navKey (Player p wealthModel)
Player p _ loot ->
Session navKey (Player p wealthModel loot)
Admin ->
Session navKey Admin
@@ -85,8 +99,8 @@ updateWealth newWealthModel model =
model
in
case loggedUser of
Player player _ ->
Session navKey (Player player newWealthModel)
Player player _ loot ->
Session navKey (Player player newWealthModel loot)
Admin ->
Session navKey Admin

23
src/Table.elm
View File

@@ -1,7 +1,8 @@
module Table exposing (name, renderRowLevel, view)
module Table exposing (name, renderRowLevel, renderSelectableRow, view)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
type alias RowRenderer a msg =
@@ -24,6 +25,26 @@ view rowRenderer content =
]
renderSelectableRow : ItemRenderer a msg -> ItemRenderer a msg -> (a -> Bool -> msg) -> (a -> Bool) -> RowRenderer a msg
renderSelectableRow left right onCheckMsg isSelected item =
tr []
[ td []
[ label [ class "level checkbox" ]
[ div [ class "level-left" ] <| left item
, div [ class "level-right" ] <|
input
[ class "checkbox level-item"
, type_ "checkbox"
, checked <| isSelected item
, onCheck <| onCheckMsg item
]
[]
:: right item
]
]
]
renderRowLevel : ItemRenderer a msg -> ItemRenderer a msg -> RowRenderer a msg
renderRowLevel left right item =
tr []