makes it compile as is

This commit is contained in:
2019-11-11 15:49:39 +01:00
parent 5725d81236
commit 3aee238cd9
6 changed files with 794 additions and 845 deletions

View File

@@ -20,6 +20,7 @@
<script>
var app = Elm.Main.init({
node: document.getElementById('app'),
flags: 0,
});
</script>
</body>

View File

@@ -1,15 +1,21 @@
module Api exposing (..)
module Api exposing (Update(..), Msg(..)
, HttpResult
, Player, Wealth, fetchPlayer, blankPlayer
, Item, Loot, fetchLoot
, Claim, Claims, fetchClaims
, ActionMode(..), confirmAction
)
import Http
import Json.Decode as D exposing (Decoder, field, int, string, succeed)
import Json.Encode as E
import Modes
type alias HttpResult a =
Result Http.Error a
-- Format of the server's response
type alias Response =
{ value : Maybe String
, notification : Maybe String
@@ -27,8 +33,7 @@ type Update
type Msg
= GotPlayer (HttpResult Player)
| GotActionResult (HttpResult Response)
= GotActionResult (HttpResult Response)
@@ -95,10 +100,10 @@ claimDecoder =
(D.field "loot_id" int)
fetchClaims : (Result Http.Error Claims -> msg) -> Cmd msg
fetchClaims toMsg =
fetchClaims : (Result Http.Error Claims -> msg) -> Int -> Cmd msg
fetchClaims toMsg playerId =
Http.get
{ url = "http://localhost:8088/api/claims"
{ url = "http://localhost:8088/api/claims" -- TODO: ++ playerId
, expect =
valueDecoder (D.list claimDecoder)
|> Http.expectJson toMsg
@@ -109,11 +114,12 @@ fetchClaims toMsg =
--
fetchPlayer : Int -> Cmd Msg
fetchPlayer id =
fetchPlayer : (Result Http.Error Player -> msg) -> Int -> Cmd msg
fetchPlayer toMsg id =
Http.get
{ url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/"
, expect = Http.expectJson GotPlayer (valueDecoder playerDecoder)
, expect = Http.expectJson toMsg (valueDecoder playerDecoder)
}
@@ -214,16 +220,23 @@ undoLastAction id =
}
buildPayload : Modes.Model -> List Item -> E.Value
type ActionMode
= Sell
| Buy
| Grab
| Add
| NoMode
buildPayload : ActionMode -> List Item -> E.Value
buildPayload mode items =
case mode of
Modes.Buy ->
Buy ->
E.object
[ ( "items", items |> E.list (\i -> E.list identity [ E.int i.id, E.null ]) )
, ( "global_mod", E.null )
]
Modes.Sell ->
Sell ->
E.object
[ ( "items", items |> E.list (\i -> E.list identity [ E.int i.id, E.null ]) )
, ( "global_mod", E.null )
@@ -231,43 +244,43 @@ buildPayload mode items =
]
-- API expects the list of claimed loot ids
Modes.Grab ->
Grab ->
items |> E.list (\i -> E.int i.id)
Modes.Add ->
Add ->
E.object
[ ( "items", items |> E.list (\i -> E.int i.id) )
]
Modes.None -> E.null
NoMode -> E.null
sendRequest : Modes.Model -> String -> List Item -> Cmd Msg
sendRequest mode id items =
confirmAction : ActionMode -> String -> List Item -> Cmd Msg
confirmAction mode id items =
let
( endpoint, method ) =
case mode of
Modes.Add ->
Add ->
( "http://localhost:8088/api/players/" ++ id ++ "/loot"
, "POST"
)
Modes.Buy ->
Buy ->
( "http://localhost:8088/api/players/" ++ id ++ "/loot"
, "PUT"
)
Modes.Sell ->
Sell ->
( "http://localhost:8088/api/players/" ++ id ++ "/loot"
, "DELETE"
)
Modes.Grab ->
Grab ->
( "http://localhost:8088/api/players/" ++ id ++ "/claims"
, "POST"
)
-- TODO: ???
Modes.None -> ("", "GET")
NoMode -> ("", "GET")
in
Http.request
{ method = method

View File

@@ -1,771 +0,0 @@
module Chest exposing (..)
import Api exposing (Claims, HttpResult, Item, Loot)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck)
import Route exposing (..)
import Set exposing (Set)
import Utils exposing (..)
-- MODEL
type alias State =
{ menuOpen : Bool
, mode : ActionMode
, error : Maybe String
, notification : Maybe String
}
type alias Selection =
Set Int
type ActionMode
= Sell
| Buy
| Grab
| Add
| NoMode
type alias Model =
{ state : State
, shown : Route.ChestContent
, playerLoot : Loot
, groupLoot : Loot
, merchantLoot : Loot
, newLoot : Loot
, selection : Maybe Selection
, claims : Claims
}
init : Int -> ( Model, Cmd Msg )
init playerId =
( Model
(State False Modes.None Nothing Nothing)
[]
[]
[]
[]
Nothing
[]
, Api.fetchClaims (GotClaims playerId)
)
viewNotification : Maybe String -> Html Msg
viewNotification notification =
case notification of
Just t ->
div [ class "notification is-success is-marginless" ]
[ button [ class "delete", onClick ClearNotification ] []
, text t
]
Nothing ->
text ""
-- DEBUG SECTION
viewDebugSection : Model -> Html Msg
viewDebugSection model =
div [ class "panel is-danger" ]
[ p [ class "panel-heading" ] [ text "Debug" ]
, debugSwitchPlayers
, p [ class "panel-block has-text-danger" ] [ text <| Maybe.withDefault "" model.state.error ]
, p [ class "panel-block" ] [ text ("Route : " ++ Debug.toString model.route) ]
, p [ class "panel-block" ] [ text ("Active Mode : " ++ Debug.toString model.mode) ]
, p [ class "panel-block" ] [ text ("Selection : " ++ Debug.toString model.chest.selection) ]
, p [ class "panel-block" ] [ text ("Claims : " ++ Debug.toString model.chest.claims) ]
, p [] debugSandbox
]
stackedIcon name =
span [ class "icon is-medium" ]
[ span [ class "fa-stack" ]
[ i [ class "fas fa-circle fa-stack-2x" ] []
, i [ class (name ++ " fa-inverse fa-stack-1x") ] []
, text ""
]
]
debugSandbox =
[ stackedIcon "fas fa-coins"
, stackedIcon "fab fa-d-and-d"
, stackedIcon "fas fa-praying-hands"
, stackedIcon "fas fa-gem"
, stackedIcon "fas fa-pen"
, stackedIcon "fas fa-percentage"
, stackedIcon "fas fa-store-alt"
, stackedIcon "fas fa-cart-plus"
, stackedIcon "fas fa-angry"
, stackedIcon "fas fa-plus"
, stackedIcon "fas fa-tools"
, stackedIcon "fas fa-search"
]
debugSwitchPlayers : Html Msg
debugSwitchPlayers =
div [ class "panel-tabs" ]
[ a [ onClick (PlayerChanged 0) ] [ text "Groupe" ]
, a [ onClick (PlayerChanged 1) ] [ text "Lomion" ]
, a [ onClick (PlayerChanged 2) ] [ text "Fefi" ]
]
-- HEADER SECTION
viewHeaderBar : String -> Model -> Html Msg
viewHeaderBar title model =
nav [ class "navbar container", class "is-info" ]
[ div [ class "navbar-brand" ]
[ a [ class "navbar-item", href "/" ]
[ renderIcon { icon = "fab fa-d-and-d", size = "medium", ratio = "2x" }
, span [] [ text model.player.name ]
]
, a [ class "navbar-burger is-active" ]
[ span [ attribute "aria-hidden" "true" ] []
, span [ attribute "aria-hidden" "true" ] []
, span [ attribute "aria-hidden" "true" ] []
]
]
, div [ class "navbar-menu is-active" ]
[ div [ class "navbar-end" ]
[ a [ class "navbar-item", href "/marchand" ]
[ renderIcon { icon = "fas fa-store-alt", ratio = "1x", size = "medium" }
, span [] [ text "Marchand" ]
]
, a
[ class "navbar-item"
, href
(if model.player.id == 0 then
"/nouveau-tresor"
else
"/coffre"
)
]
[ renderIcon { icon = "fas fa-gem", ratio = "1x", size = "medium" }
, span []
[ text
(if model.player.id == 0 then
"Nouveau loot"
else
"Coffre de groupe"
)
]
]
]
]
]
-- PLAYER BAR
viewPlayerBar : Player -> List (Html Msg) -> Html Msg
viewPlayerBar player actionControls =
section [ class "level container is-mobile box" ]
[ div [ class "level-left" ]
([ div [ class "level-item" ]
[ span [ class "icon is-large" ]
[ i [ class "fas fa-2x fa-piggy-bank" ] [] ]
]
]
++ viewWealth player.wealth
++ (if player.debt > 0 then
[ div [ class "level-item" ]
[ p [ class "heading is-size-4 has-text-danger" ]
[ text ("Dette : " ++ String.fromInt player.debt ++ "po") ]
]
]
else
[]
)
)
, div [ class "level-right" ] actionControls
]
viewWealth : Wealth -> List (Html Msg)
viewWealth wealth =
[ showWealthField "pp" <| String.fromInt wealth.pp
, showWealthField "gp" <| String.padLeft 2 '0' <| String.fromInt wealth.gp
, showWealthField "sp" <| String.fromInt wealth.sp
, showWealthField "cp" <| String.fromInt wealth.cp
]
showWealthField : String -> String -> Html Msg
showWealthField name value =
div [ class "level-item" ]
[ p [ class "has-text-right" ]
[ strong [ class "heading is-marginless" ] [ text name ]
, span [ class <| "is-size-4" ] [ text value ]
]
]
-- UPDATE
initPlayer id =
Cmd.map ApiMsg <| Api.fetchPlayer id
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
PlayerChanged newId ->
let
( chest, cmd ) =
Chest.init newId
in
( { model
| player = Api.blankPlayer
, route = PlayerChest
, chest = chest
}
, Cmd.batch
[ initPlayer newId
, Cmd.map ChestMsg cmd
]
)
ApiMsg apiMsg ->
case apiMsg of
Api.GotActionResult response ->
case response of
Ok result ->
let
updates =
Maybe.withDefault [] result.updates
notification =
result.notification
errors =
Maybe.withDefault "" result.errors
in
List.foldl applyUpdate model updates
|> setNotification notification
|> setError errors
|> update (ModeMsg (Modes.ModeSwitched Modes.None))
Err r ->
( setError (Debug.toString r) model, Cmd.none )
Api.GotPlayer result ->
case result of
Ok player ->
( { model | player = player }
, Cmd.none
)
Err error ->
( setError ("Fetching player... " ++ Debug.toString error) model
, Cmd.none
)
ModeMsg modeMsg ->
case modeMsg of
Modes.ModeSwitched newMode ->
( { model
| mode = newMode
, chest =
let
( newChest, _ ) =
Chest.update
(Chest.SetSelection
(case newMode of
Modes.None ->
Nothing
Modes.Grab ->
-- Currently claimed object are initially selected
Just (Set.fromList <| List.map (\c -> c.loot_id) model.chest.claims)
others ->
Just Set.empty
)
)
model.chest
in
newChest
}
, Cmd.none
)
Modes.ConfirmAction ->
case model.mode of
-- This should not happen, so we ignore it
Modes.None ->
( model, Cmd.none )
mode ->
let
items =
Chest.getSelected model.route model.chest
in
( model
, Cmd.map ApiMsg <|
Api.sendRequest
mode
(String.fromInt model.player.id)
items
)
ClearNotification ->
( setNotification Nothing model, Cmd.none )
setNotification : Maybe String -> Model -> Model
setNotification notification model =
let
state =
model.state
in
{ model
| state =
{ state | notification = notification }
}
setLoot : Loot -> Model -> Model
setLoot items model =
let
chest =
model.chest
in
{ model | chest = { chest | loot = items } }
setClaims : Claims -> Model -> Model
setClaims claims model =
let
chest =
model.chest
in
{ model | chest = { chest | claims = claims } }
-- DbUpdates always refer to the active player's loot
applyUpdate : Api.Update -> Model -> Model
applyUpdate u model =
case u of
Api.ItemRemoved item ->
model
|> setLoot (List.filter (\i -> i.id /= item.id) model.chest.loot)
Api.ItemAdded item ->
model |> setLoot (item :: model.chest.loot)
Api.WealthUpdated diff ->
let
player =
model.player
wealth =
player.wealth
in
{ model
| player =
{ player
| wealth =
Wealth
(wealth.cp + diff.cp)
(wealth.sp + diff.sp)
(wealth.gp + diff.gp)
(wealth.pp + diff.pp)
}
}
Api.ClaimAdded claim ->
model |> setClaims (claim :: model.chest.claims)
Api.ClaimRemoved claim ->
model
|> setClaims (List.filter (\c -> c.id /= claim.id) model.chest.claims)
-- ERRORS
setError : String -> Model -> Model
setError error model =
let
state =
model.state
in
{ model
| state =
{ state | error = Just error }
}
type ToChest
= OfPlayer Int
| OfGroup
| OfShop
fetchLoot : ToChest -> Cmd Msg
fetchLoot dest =
let
url =
case dest of
OfPlayer id ->
"http://localhost:8088/api/players/" ++ String.fromInt id ++ "/loot"
OfShop ->
"http://localhost:8088/api/items"
OfGroup ->
"http://localhost:8088/api/players/0/loot"
in
Api.fetchLoot url (GotLoot dest)
-- VIEW
view : Modes.Model -> Route.Route -> Model -> Html Msg
view mode route model =
let
renderControls =
Modes.viewControls model.mode model.route
|> List.map (Html.map ModeMsg)
( header, shownItems ) =
case route of
Route.PlayerChest ->
( "Mon coffre", model.loot )
Route.GroupLoot ->
( "Coffre de groupe", model.groupLoot )
Route.Merchant ->
( "Marchand", model.merchantItems )
Route.NewLoot ->
( "Nouveau trésor :)", [] )
isSelected =
itemInSelection model.selection
rowRenderer =
case mode of
Modes.None ->
case route of
Route.GroupLoot ->
let
isClaimed =
itemInClaims model.claims
in
-- Claim controls for Group chest
Just (claimedItemRenderer isClaimed)
_ ->
Nothing
activeMode ->
Just (rowRendererForMode isSelected activeMode)
in
[ viewHeaderBar player.name model
, viewPlayerBar model.player renderControls
, main_
[ class "container" ]
[ viewNotification model.state.notification
, article
[ class "section" ]
[ div [ class "columns" ]
[ div [ class "column is-one-third" ] [ p [ class "title" ] [ text header ] ]
, div [ class "column" ] [ viewSearchBar ]
]
, table [ class "table is-fullwidth is-striped is-hoverable" ]
[ thead [ class "table-header" ]
[ th [] [ text "Nom" ] ]
, tbody [] <| List.map (viewItemTableRow isSelected rowRenderer) shownItems
]
]
]
, hr [] []
, section [ class "container" ] [ viewDebugSection model ]
]
-- Renderers
--
-- Item -> Html Msg
claimedItemRenderer : (Item -> Bool) -> Item -> Html Msg
claimedItemRenderer isClaimed item =
case isClaimed item of
True ->
renderIcon
{ icon = "fas fa-praying-hands"
, size = "small"
, ratio = "1x"
}
False ->
text ""
rowRendererForMode : (Item -> Bool) -> Modes.Model -> Item -> Html Msg
rowRendererForMode isSelected mode item =
let
canSelect =
Modes.canSelectIn mode
renderInfo =
case mode of
Modes.Buy ->
p [ class "level-item" ] [ text (String.fromInt item.base_price ++ "po") ]
Modes.Sell ->
p [ class "level-item" ] [ text (String.fromFloat (toFloat item.base_price / 2) ++ "po") ]
Modes.Grab ->
p [ class "level-item" ] [ text "Grab" ]
Modes.Add ->
p [ class "level-item" ] [ text "New !" ]
Modes.None ->
text ""
in
div [ class "level-right" ] <|
renderInfo
:: (if canSelect then
[ input
[ class "checkbox level-item"
, type_ "checkbox"
, checked <| isSelected item
, onCheck (\v -> SwitchSelectionState item.id)
]
[]
]
else
[]
)
viewItemTableRow : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Item -> Html Msg
viewItemTableRow isSelected rowRenderer item =
tr [ classList [ ( "is-selected", isSelected item ) ] ]
[ td []
[ label [ class "level checkbox" ] <|
div [ class "level-left" ]
[ p [ class "level-item" ] [ text item.name ] ]
:: (case rowRenderer of
Just render ->
List.singleton (render item)
Nothing ->
[]
)
]
]
-- Search Bar
viewSearchBar : Html Msg
viewSearchBar =
div [ class "field" ]
[ p [ class "control has-icons-left" ]
[ input [ class "input" ] []
, span [ class "icon is-left" ] [ i [ class "fas fa-search" ] [] ]
]
]
-- ACTION MODES
--
canSelectIn : ActionMode -> Bool
canSelectIn mode =
case mode of
Sell ->
True
Buy ->
True
Grab ->
True
Add ->
False
NoMode ->
False
viewControls : ActionMode -> Route.Route -> List (Html Msg)
viewControls mode route =
case mode of
None ->
case route of
Route.PlayerChest ->
[ actionButton (ModeSwitched Sell) "Vendre" "coins" "danger" ]
Route.GroupLoot ->
[ actionButton (ModeSwitched Grab) "Demander" "praying-hands" "primary" ]
Route.Merchant ->
[ actionButton (ModeSwitched Buy) "Acheter" "coins" "success" ]
Route.NewLoot ->
[ actionButton (ModeSwitched Add) "Nouveau loot" "plus" "primary" ]
m ->
[ actionButton ConfirmAction "Valider" "check" "primary"
, actionButton (ModeSwitched None) "Annuler" "times" "danger"
]
-- UPDATE
type Msg
= ApiMsg Api.Msg
| ModeMsg Modes.Msg
| PlayerChanged Int
| ClearNotification
type Msg
= SetSelection (Maybe Selection)
| GotLoot ToChest (HttpResult Loot)
| GotClaims Int (HttpResult Claims)
| SwitchSelectionState Int
| ModeSwitched ActionMode
| ConfirmAction
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
SwitchSelectionState id ->
( { model | selection = switchSelectionState id model.selection }, Cmd.none )
SetSelection new ->
( { model | selection = new }, Cmd.none )
GotClaims id result ->
case result of
Ok claims ->
( { model
| claims =
List.filter
(\c -> c.player_id == id)
claims
}
, Cmd.none
)
Err error ->
( model, Cmd.none )
GotLoot dest result ->
case result of
Ok loot ->
( case dest of
OfPlayer _ ->
{ model | loot = loot }
OfGroup ->
{ model | groupLoot = loot }
OfShop ->
{ model | merchantItems = loot }
, Cmd.none
)
Err error ->
( model, Cmd.none )
-- Selection
-- Get list of selected items
getSelected : Route -> Model -> Loot
getSelected route model =
targetItemsFor route model
|> List.filter (itemInSelection model.selection)
itemInSelection : Maybe Selection -> Item -> Bool
itemInSelection selection item =
Maybe.map (Set.member item.id) selection
|> Maybe.withDefault False
itemInClaims : Claims -> Item -> Bool
itemInClaims claims item =
List.any (\c -> c.loot_id == item.id) claims
switchSelectionState : Int -> Maybe Selection -> Maybe Selection
switchSelectionState id selection =
case selection of
Just s ->
Just <|
case Set.member id s of
True ->
Set.remove id s
False ->
Set.insert id s
Nothing ->
Debug.log "ignore switchSelectionState" Nothing
targetItemsFor : Route -> Model -> List Item
targetItemsFor route model =
case route of
Route.NewLoot ->
model.newLoot
Route.Merchant ->
model.merchantItems
Route.PlayerChest ->
model.loot
Route.GroupLoot ->
model.groupLoot

View File

@@ -3,7 +3,7 @@ module Main exposing (..)
import Api exposing (Claim, Claims, Item, Loot, Player, Wealth)
import Browser
import Browser.Navigation as Nav
import Chest exposing (Msg)
import Page.Chest as Chest exposing (Msg)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
@@ -19,7 +19,7 @@ import Session exposing (..)
-- Main
main : Program () Model Msg
main : Program (Maybe Int) Model Msg
main =
Browser.application
{ init = init
@@ -36,7 +36,7 @@ main =
type Model
= Chest Chest.Model
| Admin Admin.Model
-- | Admin Admin.Model
| About
-- This is not what we really want.
@@ -51,14 +51,14 @@ type Model
-- - just loggend in -> See Loading page then Chest
-- - coming back being still logged in -> See Chest (or same as above)
init : Maybe Int -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
init flags url key =
init flags _ key =
case flags of
Just id ->
let
session =
Session.LoggedIn key <| Session.User.Player id
session = Session.playerSession key id
(chest, cmd) = Chest.init session
in
(Chest <| Chest.init id, Cmd.none)
(Chest chest, Cmd.map GotChestMsg cmd)
Nothing ->
(About, Cmd.none)
@@ -72,65 +72,66 @@ init flags url key =
view : Model -> Browser.Document Msg
view model =
let
(title, body) =
(title, content) =
case model of
Chest chest ->
("Loot-a-lot", Chest.view chest)
Admin session ->
("Administration", Admin.view session)
("Loot-a-lot", List.map (Html.map GotChestMsg) (Chest.view chest))
-- Admin admin ->
-- ("Administration", Admin.view admin)
About ->
("A propos", p [] ["A propos"])
("A propos", [ p [] [text "A propos"] ])
in
{ title = title
, body = body }
, body = content }
type Msg
= UrlChanged Url.Url
| LinkClicked Browser.UrlRequest
| GotChestMsg Chest.Msg
| GotAdminMsg Admin.Msg
-- | GotAdminMsg Admin.Msg
update msg model =
let
updateChest chestMsg =
case model of
Chest chest ->
let
(newChest, cmd) =
Chest.update chestMsg chest
in
(Chest newChest, Cmd.map GotChestMsg cmd)
_ -> (About, Cmd.none)
in
case msg of
LinkClicked urlRequest ->
case model of
Chest chestModel ->
case urlRequest of
Browser.Internal url ->
( model, Nav.pushUrl model.navKey (Url.toString url) )
( model, Nav.pushUrl chestModel.navKey (Url.toString url) )
Browser.External href ->
( setError ("External request '" ++ href ++ "'") model
, Cmd.none
)
( model, Cmd.none)
_ -> (model, Cmd.none)
UrlChanged url ->
let
route =
routeParser url
Route.fromUrl url
in
case route of
Just page ->
{ model | route = page }
|> update
(case page of
-- Directly enter add mode on NewLoot view
NewLoot ->
ModeMsg (Modes.ModeSwitched Modes.Add)
other ->
ModeMsg (Modes.ModeSwitched Modes.None)
)
Nothing ->
( setError "Invalid route" model, Cmd.none )
Just (Route.Home content) ->
updateChest (Chest.SetContent content)
_ ->
(About, Cmd.none)
GotChestMsg chestMsg ->
let
( chest, cmd ) =
Chest.update chestMsg model.chest
in
( Chest chest, Cmd.map GotChestMsg cmd )
updateChest chestMsg
-- STATE Utils
-- SUBSCRIPTIONS

View File

@@ -1,6 +1,710 @@
module Page.Chest exposing (..)
-- Put the rest of Chest here
import Browser.Navigation as Nav
init =
()
import Api exposing (ActionMode(..), confirmAction, HttpResult
, Wealth, Claims
, Item, Loot)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onClick)
import Route exposing (ChestContent(..))
import Set exposing (Set)
import Utils exposing (..)
import Session exposing (Session(..))
-- MODEL
type alias State =
{ menuOpen : Bool
, mode : ActionMode
, error : Maybe String
, notification : Maybe String
-- Fetched on init
, player : Api.Player
, playerLoot : Loot
, groupLoot : Loot
, merchantLoot : Loot
, newLoot : Loot
}
type alias Selection =
Set Int
type alias Model =
{ navKey : Nav.Key
, state : State
, shown : Route.ChestContent
, selection : Maybe Selection
, claims : Claims
}
init (Player navKey playerId) =
( Model
navKey
(State False NoMode Nothing Nothing Api.blankPlayer [] [] [] [])
Route.PlayerLoot
Nothing
[]
, Cmd.batch
[ Api.fetchPlayer GotPlayer playerId
, Api.fetchClaims GotClaims playerId
, fetchLoot (OfPlayer playerId)
, fetchLoot (OfGroup)
, fetchLoot (OfShop)
]
)
viewNotification : Maybe String -> Html Msg
viewNotification notification =
case notification of
Just t ->
div [ class "notification is-success is-marginless" ]
[ button [ class "delete", onClick ClearNotification ] []
, text t
]
Nothing ->
text ""
-- DEBUG SECTION
viewDebugSection : Model -> Html Msg
viewDebugSection model =
div [ class "panel is-danger" ]
[ p [ class "panel-heading" ] [ text "Debug" ]
, p [ class "panel-block has-text-danger" ] [ text <| Maybe.withDefault "" model.state.error ]
, p [ class "panel-block" ] [ text ("Shown content : " ++ Debug.toString model.shown) ]
, p [ class "panel-block" ] [ text ("Active Mode : " ++ Debug.toString model.state.mode) ]
, p [ class "panel-block" ] [ text ("Selection : " ++ Debug.toString model.selection) ]
, p [ class "panel-block" ] [ text ("Claims : " ++ Debug.toString model.claims) ]
, p [] debugSandbox
]
stackedIcon name =
span [ class "icon is-medium" ]
[ span [ class "fa-stack" ]
[ i [ class "fas fa-circle fa-stack-2x" ] []
, i [ class (name ++ " fa-inverse fa-stack-1x") ] []
, text ""
]
]
debugSandbox =
[ stackedIcon "fas fa-coins"
, stackedIcon "fab fa-d-and-d"
, stackedIcon "fas fa-praying-hands"
, stackedIcon "fas fa-gem"
, stackedIcon "fas fa-pen"
, stackedIcon "fas fa-percentage"
, stackedIcon "fas fa-store-alt"
, stackedIcon "fas fa-cart-plus"
, stackedIcon "fas fa-angry"
, stackedIcon "fas fa-plus"
, stackedIcon "fas fa-tools"
, stackedIcon "fas fa-search"
]
-- HEADER SECTION
viewHeaderBar : String -> Model -> Html Msg
viewHeaderBar title model =
nav [ class "navbar container", class "is-info" ]
[ div [ class "navbar-brand" ]
[ a [ class "navbar-item", href "/" ]
[ renderIcon { icon = "fab fa-d-and-d", size = "medium", ratio = "2x" }
, span [] [ text model.state.player.name ]
]
, a [ class "navbar-burger is-active" ]
[ span [ attribute "aria-hidden" "true" ] []
, span [ attribute "aria-hidden" "true" ] []
, span [ attribute "aria-hidden" "true" ] []
]
]
, div [ class "navbar-menu is-active" ]
[ div [ class "navbar-end" ]
[ a [ class "navbar-item", href "/marchand" ]
[ renderIcon { icon = "fas fa-store-alt", ratio = "1x", size = "medium" }
, span [] [ text "Marchand" ]
]
, a
[ class "navbar-item"
, href
(if model.state.player.id == 0 then
"/nouveau-tresor"
else
"/coffre"
)
]
[ renderIcon { icon = "fas fa-gem", ratio = "1x", size = "medium" }
, span []
[ text
(if model.state.player.id == 0 then
"Nouveau loot"
else
"Coffre de groupe"
)
]
]
]
]
]
-- PLAYER BAR
viewPlayerBar : Api.Player -> List (Html Msg) -> Html Msg
viewPlayerBar player actionControls =
section [ class "level container is-mobile box" ]
[ div [ class "level-left" ]
([ div [ class "level-item" ]
[ span [ class "icon is-large" ]
[ i [ class "fas fa-2x fa-piggy-bank" ] [] ]
]
]
++ viewWealth player.wealth
++ (if player.debt > 0 then
[ div [ class "level-item" ]
[ p [ class "heading is-size-4 has-text-danger" ]
[ text ("Dette : " ++ String.fromInt player.debt ++ "po") ]
]
]
else
[]
)
)
, div [ class "level-right" ] actionControls
]
viewWealth : Wealth -> List (Html Msg)
viewWealth wealth =
[ showWealthField "pp" <| String.fromInt wealth.pp
, showWealthField "gp" <| String.padLeft 2 '0' <| String.fromInt wealth.gp
, showWealthField "sp" <| String.fromInt wealth.sp
, showWealthField "cp" <| String.fromInt wealth.cp
]
showWealthField : String -> String -> Html Msg
showWealthField name value =
div [ class "level-item" ]
[ p [ class "has-text-right" ]
[ strong [ class "heading is-marginless" ] [ text name ]
, span [ class <| "is-size-4" ] [ text value ]
]
]
-- VIEW
view : Model -> List (Html Msg)
view model =
let
renderControls =
viewControls model.state.mode model.shown
header =
case model.shown of
PlayerLoot ->
"Mon coffre"
GroupLoot ->
"Coffre de groupe"
MerchantLoot ->
"Marchand"
NewLoot ->
"Nouveau trésor :)"
shownItems =
selectContent model.shown
isSelected =
itemInSelection model.selection
rowRenderer =
case model.state.mode of
NoMode ->
case model.shown of
GroupLoot ->
let
isClaimed =
itemInClaims model.claims
in
-- Claim controls for Group chest
Just (claimedItemRenderer isClaimed)
_ ->
Nothing
activeMode ->
Just (rowRendererForMode isSelected activeMode)
in
[ viewHeaderBar model.state.player.name model
, viewPlayerBar model.state.player renderControls
, main_
[ class "container" ]
[ viewNotification model.state.notification
, article
[ class "section" ]
[ div [ class "columns" ]
[ div [ class "column is-one-third" ] [ p [ class "title" ] [ text header ] ]
, div [ class "column" ] [ viewSearchBar ]
]
, table [ class "table is-fullwidth is-striped is-hoverable" ]
[ thead [ class "table-header" ]
[ th [] [ text "Nom" ] ]
, tbody [] <| List.map (viewItemTableRow isSelected rowRenderer) <| shownItems model
]
]
]
, hr [] []
, section [ class "container" ] [ viewDebugSection model ]
]
-- Renderers
--
-- Item -> Html Msg
claimedItemRenderer : (Item -> Bool) -> Item -> Html Msg
claimedItemRenderer isClaimed item =
case isClaimed item of
True ->
renderIcon
{ icon = "fas fa-praying-hands"
, size = "small"
, ratio = "1x"
}
False ->
text ""
rowRendererForMode : (Item -> Bool) -> ActionMode -> Item -> Html Msg
rowRendererForMode isSelected mode item =
let
canSelect =
canSelectIn mode
renderInfo =
case mode of
Buy ->
p [ class "level-item" ] [ text (String.fromInt item.base_price ++ "po") ]
Sell ->
p [ class "level-item" ] [ text (String.fromFloat (toFloat item.base_price / 2) ++ "po") ]
Grab ->
p [ class "level-item" ] [ text "Grab" ]
Add ->
p [ class "level-item" ] [ text "New !" ]
NoMode ->
text ""
in
div [ class "level-right" ] <|
renderInfo
:: (if canSelect then
[ input
[ class "checkbox level-item"
, type_ "checkbox"
, checked <| isSelected item
, onCheck (\v -> SwitchSelectionState item.id)
]
[]
]
else
[]
)
viewItemTableRow : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Item -> Html Msg
viewItemTableRow isSelected rowRenderer item =
tr [ classList [ ( "is-selected", isSelected item ) ] ]
[ td []
[ label [ class "level checkbox" ] <|
div [ class "level-left" ]
[ p [ class "level-item" ] [ text item.name ] ]
:: (case rowRenderer of
Just render ->
List.singleton (render item)
Nothing ->
[]
)
]
]
-- Search Bar
viewSearchBar : Html Msg
viewSearchBar =
div [ class "field" ]
[ p [ class "control has-icons-left" ]
[ input [ class "input" ] []
, span [ class "icon is-left" ] [ i [ class "fas fa-search" ] [] ]
]
]
-- ACTION MODES
--
canSelectIn : ActionMode -> Bool
canSelectIn mode =
case mode of
Sell ->
True
Buy ->
True
Grab ->
True
Add ->
False
NoMode ->
False
viewControls : ActionMode -> ChestContent -> List (Html Msg)
viewControls mode content =
case mode of
NoMode ->
case content of
PlayerLoot ->
[ actionButton (ModeSwitched Sell) "Vendre" "coins" "danger" ]
GroupLoot ->
[ actionButton (ModeSwitched Grab) "Demander" "praying-hands" "primary" ]
MerchantLoot ->
[ actionButton (ModeSwitched Buy) "Acheter" "coins" "success" ]
NewLoot ->
[ actionButton (ModeSwitched Add) "Nouveau loot" "plus" "primary" ]
m ->
[ actionButton ConfirmAction "Valider" "check" "primary"
, actionButton (ModeSwitched NoMode) "Annuler" "times" "danger"
]
-- UPDATE
type Msg
= ApiMsg Api.Msg
| ClearNotification
| SetContent (ChestContent)
| SetSelection (Maybe Selection)
| GotLoot ToChest (HttpResult Loot)
| GotClaims (HttpResult Claims)
| GotPlayer (HttpResult Api.Player)
| SwitchSelectionState Int
| ModeSwitched ActionMode
| ConfirmAction
-- UPDATE
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
ApiMsg apiMsg ->
case apiMsg of
Api.GotActionResult response ->
case response of
Ok result ->
let
updates =
Maybe.withDefault [] result.updates
notification =
result.notification
errors =
Maybe.withDefault "" result.errors
in
List.foldl applyUpdate model updates
|> setNotification notification
|> setError errors
|> update (ModeSwitched NoMode)
Err r ->
( setError (Debug.toString r) model, Cmd.none )
SetContent content ->
( { model | shown = content }, Cmd.none )
GotPlayer result ->
case result of
Ok player ->
let
state = model.state
in
( { model | state = { state | player = player }} , Cmd.none)
Err error ->
( setError ("Fetching player... " ++ Debug.toString error) model
, Cmd.none
)
ModeSwitched newMode ->
let state = model.state in
{ model | state = { state | mode = newMode }}
|> update
(SetSelection
(case newMode of
NoMode ->
Nothing
Grab ->
-- Currently claimed object are initially selected
Just (Set.fromList <| List.map (\c -> c.loot_id) model.claims)
others ->
Just Set.empty
)
)
ConfirmAction ->
case model.state.mode of
-- This should not happen, so we ignore it
NoMode ->
( model, Cmd.none )
mode ->
let
items =
getSelected model.shown model
in
( model
, Cmd.map ApiMsg <|
Api.confirmAction
mode
(String.fromInt model.state.player.id)
items
)
ClearNotification ->
( setNotification Nothing model, Cmd.none )
SwitchSelectionState id ->
( { model | selection = switchSelectionState id model.selection }, Cmd.none )
SetSelection new ->
( { model | selection = new }, Cmd.none )
GotClaims (Ok claims )->
( { model | claims = claims } , Cmd.none )
GotClaims (Err error) ->
( setError (Debug.toString error) model, Cmd.none )
GotLoot dest (Ok loot) ->
(
let
state = model.state
in
case dest of
OfPlayer _ ->
{ model | state = { state | playerLoot = loot }}
OfGroup ->
{ model | state = { state | groupLoot = loot }}
OfShop ->
{ model | state = { state | merchantLoot = loot }}
, Cmd.none
)
GotLoot _ (Err error) ->
( setError (Debug.toString error) model, Cmd.none )
setNotification : Maybe String -> Model -> Model
setNotification notification model =
let
state =
model.state
in
{ model
| state =
{ state | notification = notification }
}
-- ERRORS
setError : String -> Model -> Model
setError error model =
let
state =
model.state
in
{ model
| state =
{ state | error = Just error }
}
-- DbUpdates always refer to the active player's loot
applyUpdate : Api.Update -> Model -> Model
applyUpdate u model =
let
state = model.state
in
case u of
Api.ItemRemoved item ->
{ model | state = { state | playerLoot =
List.filter (\i -> i.id /= item.id) model.state.playerLoot }}
Api.ItemAdded item ->
{ model | state = { state | playerLoot = (item :: model.state.playerLoot) }}
Api.WealthUpdated diff ->
let
player =
model.state.player
wealth =
player.wealth
in
{ model | state = { state
| player =
{ player
| wealth =
Wealth
(wealth.cp + diff.cp)
(wealth.sp + diff.sp)
(wealth.gp + diff.gp)
(wealth.pp + diff.pp)
}
}}
Api.ClaimAdded claim ->
{ model | claims = (claim :: model.claims) }
Api.ClaimRemoved claim ->
{ model | claims = List.filter (\c -> c.id /= claim.id) model.claims }
type ToChest
= OfPlayer Int
| OfGroup
| OfShop
fetchLoot : ToChest -> Cmd Msg
fetchLoot dest =
let
url =
case dest of
OfPlayer id ->
"http://localhost:8088/api/players/" ++ String.fromInt id ++ "/loot"
OfShop ->
"http://localhost:8088/api/items"
OfGroup ->
"http://localhost:8088/api/players/0/loot"
in
Api.fetchLoot url (GotLoot dest)
-- Selection
-- Get list of selected items
getSelected : ChestContent -> Model -> Loot
getSelected content model =
selectContent content model
|> List.filter (itemInSelection model.selection)
itemInSelection : Maybe Selection -> Item -> Bool
itemInSelection selection item =
Maybe.map (Set.member item.id) selection
|> Maybe.withDefault False
itemInClaims : Claims -> Item -> Bool
itemInClaims claims item =
List.any (\c -> c.loot_id == item.id) claims
switchSelectionState : Int -> Maybe Selection -> Maybe Selection
switchSelectionState id selection =
case selection of
Just s ->
Just <|
case Set.member id s of
True ->
Set.remove id s
False ->
Set.insert id s
Nothing ->
Debug.log "ignore switchSelectionState" Nothing
selectContent : ChestContent -> Model -> List Item
selectContent content model =
case content of
NewLoot ->
model.state.newLoot
MerchantLoot ->
model.state.merchantLoot
PlayerLoot ->
model.state.playerLoot
GroupLoot ->
model.state.groupLoot

View File

@@ -1,12 +1,13 @@
module Session exposing (..)
module Session exposing (Session(..), playerSession)
import Browser.Navigation as Nav
import Api
type User
= Player Int
| Admin
type Session
= Player Nav.Key Int
-- | Admin Nav.Key
type Model
= LoggedIn Nav.Key User
| LoggedOut Nav.Key
playerSession navKey playerId =
Player navKey playerId