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

@@ -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