adds admin, pratices ELM refactoring with 'wealth'

This commit is contained in:
2019-11-21 12:11:33 +01:00
parent 27d7ca63b1
commit 75968f73c1
5 changed files with 234 additions and 101 deletions

View File

@@ -7,6 +7,7 @@ import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Json.Encode as E
import Page.Admin as Admin
import Page.Chest as Chest exposing (Msg)
import Route exposing (..)
import Session exposing (..)
@@ -54,7 +55,7 @@ initNavbar key =
type Page
= Chest Chest.Model
-- | Admin Admin.Model
| Admin Admin.Model
| About
| Loading
@@ -115,8 +116,9 @@ viewPage page =
Chest chest ->
( "Loot-a-lot", List.map (Html.map GotChestMsg) (Chest.view chest) )
-- Admin admin ->
-- ("Administration", Admin.view admin)
Admin admin ->
( "Administration", Admin.view admin )
About ->
( "A propos", [ p [] [ text "A propos" ] ] )
@@ -128,6 +130,9 @@ viewPage page =
Chest chest ->
chest.state.player.name
Admin _ ->
"Administration"
About ->
"Loot-a-lot"
@@ -200,6 +205,7 @@ type Msg
| SessionLoaded (Maybe Session)
| SwitchMenuOpen
| GotChestMsg Chest.Msg
| GotAdminMsg Admin.Msg
@@ -225,12 +231,28 @@ update msg model =
SessionLoaded session ->
case session of
Just logged ->
let
navKey =
Session.key logged
user =
Session.user logged
in
case user of
Session.Player playerId ->
let
( chest, cmd ) =
Chest.init logged
Chest.init navKey playerId
in
( model |> setPage (Chest chest), Cmd.map GotChestMsg cmd )
Session.Admin ->
let
( admin, cmd ) =
Admin.init navKey
in
( model |> setPage (Admin admin), Cmd.map GotAdminMsg cmd )
Nothing ->
( model |> setPage About, Cmd.none )
@@ -262,6 +284,9 @@ update msg model =
GotChestMsg chestMsg ->
updateChest chestMsg
GotAdminMsg adminMsg ->
( model, Cmd.none )
SwitchMenuOpen ->
( { model | navbar = Navbar (not model.navbar.menuOpen) model.navbar.navKey }, Cmd.none )

23
src/Page/Admin.elm Normal file
View File

@@ -0,0 +1,23 @@
module Page.Admin exposing (..)
import Browser.Navigation as Nav
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
type alias Model =
{ navKey : Nav.Key
}
init navKey =
( { navKey = navKey }, Cmd.none )
view model =
[ p [ class "title" ] [ text "Administration" ] ]
type Msg
= Nope

View File

@@ -8,7 +8,6 @@ import Api
, Item
, Loot
, RequestData(..)
, Wealth
, confirmAction
)
import Browser.Navigation as Nav
@@ -16,8 +15,8 @@ import Dict exposing (Dict)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onClick, onInput)
import Page.Chest.Wealth as Wealth
import Route exposing (ChestContent(..))
import Session exposing (Session(..))
import Set exposing (Set)
import Utils exposing (..)
@@ -42,9 +41,6 @@ type alias State =
, itemList : Maybe (List String)
-- , inventoryItems : Loot
, editWealth : Bool
, wealthAmount : String
-- Fetched on init
, player : Api.Player
, playerLoot : Loot
@@ -64,11 +60,12 @@ type alias Model =
, shown : Route.ChestContent
, selection : Maybe Selection
, searchText : String
, wealth : Wealth.Model
, claims : Claims
}
init (Player navKey playerId) =
init navKey playerId =
( Model
navKey
(State
@@ -81,8 +78,6 @@ init (Player navKey playerId) =
Nothing
Nothing
Nothing
False
"0.0"
Api.blankPlayer
[]
[]
@@ -92,6 +87,9 @@ init (Player navKey playerId) =
Route.PlayerLoot
Nothing
""
(Wealth.init
Api.blankPlayer.wealth
)
[]
, Cmd.batch
[ Api.fetchPlayer GotPlayer playerId
@@ -105,7 +103,7 @@ init (Player navKey playerId) =
viewNotification : Model -> Html Msg
viewNotification model =
div []
div [ class "section" ]
[ case model.state.notification of
Just t ->
div [ class "notification is-success" ]
@@ -131,22 +129,13 @@ viewNotification model =
-- PLAYER BAR
viewPlayerBar : Api.Player -> List (Html Msg) -> ( Bool, String ) -> Html Msg
viewPlayerBar player actionControls ( editing, amount ) =
viewPlayerBar : Api.Player -> List (Html Msg) -> Wealth.Model -> Html Msg
viewPlayerBar player actionControls wealthModel =
section [ class "hero is-dark is-bold" ]
[ div [ class "hero-body" ]
[ div [ class "level container is-mobile" ]
[ div [ class "level-left" ]
(div [ class "level-item" ]
[ span [ class "icon is-large" ] [ i [ class "fas fa-2x fa-piggy-bank" ] [] ]
, span [ class "icon", onClick EditWealth ] [ i [ class "fas fa-tools" ] [] ]
]
:: (if editing then
viewUpdateWealth amount
else
viewWealth player.wealth
)
(Wealth.view player.wealth wealthModel
++ (if player.debt > 0 then
[ div [ class "level-item" ]
[ p [ class "heading is-size-4 has-text-danger" ]
@@ -158,46 +147,13 @@ viewPlayerBar player actionControls ( editing, amount ) =
[]
)
)
|> Html.map WealthMsg
, div [ class "level-right" ] actionControls
]
]
]
viewUpdateWealth amount =
let
isAmountValid =
case String.toFloat amount of
Just _ ->
True
Nothing ->
False
in
[ input [ class "level-item", class "input", classList [ ( "is-danger", not isAmountValid ) ], value amount, onInput AmountChanged ] []
, button [ class "level-item button", onClick ConfirmEditWealth ] [ text "Ok" ]
]
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 has-text-white" ] [ text name ]
, span [ class <| "is-size-4" ] [ text value ]
]
]
-- VIEW
@@ -305,10 +261,7 @@ view model =
Dict.get item.id model.state.priceModifiers
in
[ viewPriceWithModApplied
(Debug.log
"maybeMod"
(Maybe.map (\i -> toFloatingMod i) maybeMod)
)
(toFloat item.base_price / 2)
, if isSelected item then
viewPriceModifier item.id <|
@@ -336,7 +289,7 @@ view model =
|> List.filter
(\i -> String.toLower i.name |> String.contains (String.toLower model.searchText))
in
[ viewPlayerBar model.state.player renderControls ( model.state.editWealth, model.state.wealthAmount )
[ viewPlayerBar model.state.player renderControls model.wealth
, main_
[ class "container" ]
[ viewNotification model
@@ -775,10 +728,14 @@ type Msg
| AddMsg AddMsg
-- Buy/Sell modes
| PriceModifierChanged Int String
| WealthMsg Wealth.Msg
-- Edit wealth
| EditWealth
| AmountChanged String
| ConfirmEditWealth
--| EditWealth
--| AmountChanged String
--| ConfirmEditWealth
insensitiveContains : String -> String -> Bool
@@ -799,29 +756,28 @@ setWealthAmount state amount =
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
EditWealth ->
( { model | state = switchEditWealth model.state }, Cmd.none )
AmountChanged amount ->
( { model | state = setWealthAmount model.state amount }, Cmd.none )
ConfirmEditWealth ->
WealthMsg wealthMsg ->
case wealthMsg of
Wealth.ConfirmEdit ->
let
amount =
case String.toFloat model.state.wealthAmount of
Just a ->
a
Nothing ->
0.0
Wealth.editValue model.wealth
in
( { model | state = setWealthAmount model.state "0" |> switchEditWealth }
, Cmd.map ApiMsg <|
( { model | wealth = Wealth.update Wealth.QuitEdit model.wealth }
, case amount of
Just a ->
Cmd.map ApiMsg <|
Api.confirmAction
(String.fromInt model.state.player.id)
(Api.WealthPayload amount)
(Api.WealthPayload a)
Nothing ->
Cmd.none
)
_ ->
( { model | wealth = Wealth.update wealthMsg model.wealth }, Cmd.none )
PriceModifierChanged id value ->
let
state =
@@ -1221,7 +1177,7 @@ applyUpdate u model =
| player =
{ player
| wealth =
Wealth
Api.Wealth
(wealth.cp + diff.cp)
(wealth.sp + diff.sp)
(wealth.gp + diff.gp)

114
src/Page/Chest/Wealth.elm Normal file
View File

@@ -0,0 +1,114 @@
module Page.Chest.Wealth exposing (Model, Msg(..), editValue, init, update, view)
import Api
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
type Model
= View
| Edit String
init wealth =
View
view wealth model =
div [ class "level-item" ]
[ span [ class "icon is-large" ] [ i [ class "fas fa-2x fa-piggy-bank" ] [] ]
, span [ class "icon", onClick StartEdit ] [ i [ class "fas fa-tools" ] [] ]
]
:: (case model of
View ->
viewWealth wealth
Edit amount ->
viewUpdateWealth amount
)
viewUpdateWealth amount =
[ input
[ class "level-item"
, class "input"
, classList
[ ( "is-danger", (not << isValid) amount )
, ( "is-success", isValid amount )
]
, value amount
, onInput AmountChanged
]
[]
, button [ class "level-item button", onClick ConfirmEdit ] [ text "Ok" ]
]
viewWealth : Api.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 has-text-white" ] [ text name ]
, span [ class <| "is-size-4" ] [ text value ]
]
]
type Msg
= StartEdit
| QuitEdit
| AmountChanged String
| ConfirmEdit
update : Msg -> Model -> Model
update msg model =
case msg of
StartEdit ->
Edit "0.0"
QuitEdit ->
View
AmountChanged newAmount ->
Edit <| String.replace "," "." newAmount
_ ->
View
-- Checks that the amount is a valid float
isValid amount =
case String.toFloat amount of
Just _ ->
True
Nothing ->
False
-- Returns the edited value as a Float, if it exists
editValue : Model -> Maybe Float
editValue model =
case model of
View ->
Nothing
Edit value ->
String.toFloat value

View File

@@ -1,20 +1,17 @@
module Session exposing (Session(..), init, playerSession)
module Session exposing (Session, User(..), init, key, user)
import Browser.Navigation as Nav
import Http
import Json.Decode as D
type User
= Player Int
| Admin
type Session
= Player Nav.Key Int
-- | Admin Nav.Key
playerSession navKey playerId =
Player navKey playerId
= Session Nav.Key User
init : (Maybe Session -> msg) -> Nav.Key -> Cmd msg
@@ -26,7 +23,7 @@ init toMsg navKey =
Ok value ->
case String.toInt value of
Just id ->
toMsg <| Just (Player navKey id)
toMsg <| Just (Session navKey (Player id))
Nothing ->
toMsg
@@ -39,3 +36,21 @@ init toMsg navKey =
{ url = "http://localhost:8088/session"
, expect = Http.expectJson toSession D.string
}
key : Session -> Nav.Key
key session =
let
(Session navKey _) =
session
in
navKey
user : Session -> User
user session =
let
(Session _ loggedUser) =
session
in
loggedUser