From 75968f73c14651aacd7d40c985b1d64c78ca48a4 Mon Sep 17 00:00:00 2001 From: Artus Date: Thu, 21 Nov 2019 12:11:33 +0100 Subject: [PATCH] adds admin, pratices ELM refactoring with 'wealth' --- src/Main.elm | 37 ++++++++++-- src/Page/Admin.elm | 23 +++++++ src/Page/Chest.elm | 124 ++++++++++++-------------------------- src/Page/Chest/Wealth.elm | 114 +++++++++++++++++++++++++++++++++++ src/Session.elm | 37 ++++++++---- 5 files changed, 234 insertions(+), 101 deletions(-) create mode 100644 src/Page/Admin.elm create mode 100644 src/Page/Chest/Wealth.elm diff --git a/src/Main.elm b/src/Main.elm index c4550ac..69ca77c 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -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 @@ -226,10 +232,26 @@ update msg model = case session of Just logged -> let - ( chest, cmd ) = - Chest.init logged + navKey = + Session.key logged + + user = + Session.user logged in - ( model |> setPage (Chest chest), Cmd.map GotChestMsg cmd ) + case user of + Session.Player playerId -> + let + ( chest, cmd ) = + 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 ) diff --git a/src/Page/Admin.elm b/src/Page/Admin.elm new file mode 100644 index 0000000..e10366b --- /dev/null +++ b/src/Page/Admin.elm @@ -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 diff --git a/src/Page/Chest.elm b/src/Page/Chest.elm index 6bc7237..d991111 100644 --- a/src/Page/Chest.elm +++ b/src/Page/Chest.elm @@ -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) - ) + (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 - -- Edit wealth - | EditWealth - | AmountChanged String - | ConfirmEditWealth + | WealthMsg Wealth.Msg + + + +-- Edit wealth +--| EditWealth +--| AmountChanged String +--| ConfirmEditWealth insensitiveContains : String -> String -> Bool @@ -799,28 +756,27 @@ 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 -> - let - amount = - case String.toFloat model.state.wealthAmount of + WealthMsg wealthMsg -> + case wealthMsg of + Wealth.ConfirmEdit -> + let + amount = + Wealth.editValue model.wealth + in + ( { model | wealth = Wealth.update Wealth.QuitEdit model.wealth } + , case amount of Just a -> - a + Cmd.map ApiMsg <| + Api.confirmAction + (String.fromInt model.state.player.id) + (Api.WealthPayload a) Nothing -> - 0.0 - in - ( { model | state = setWealthAmount model.state "0" |> switchEditWealth } - , Cmd.map ApiMsg <| - Api.confirmAction - (String.fromInt model.state.player.id) - (Api.WealthPayload amount) - ) + Cmd.none + ) + + _ -> + ( { model | wealth = Wealth.update wealthMsg model.wealth }, Cmd.none ) PriceModifierChanged id value -> let @@ -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) diff --git a/src/Page/Chest/Wealth.elm b/src/Page/Chest/Wealth.elm new file mode 100644 index 0000000..6a2af38 --- /dev/null +++ b/src/Page/Chest/Wealth.elm @@ -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 diff --git a/src/Session.elm b/src/Session.elm index 395f243..ea55f6b 100644 --- a/src/Session.elm +++ b/src/Session.elm @@ -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