From b97be8c321cba2aedd8ad37bab8ce13c161adafd Mon Sep 17 00:00:00 2001 From: Artus Date: Wed, 4 Dec 2019 19:16:16 +0100 Subject: [PATCH] decided to internalize modes inside Chest.elm --- src/Main.elm | 10 +-- src/Page.elm | 158 +++++++++++++++++++++++------------ src/Page/Chest.elm | 141 ++++++++++++++++++++++++------- src/Page/Chest/Selection.elm | 111 ++++++++++++++---------- src/Page/Dashboard.elm | 2 +- src/Page/GroupChest.elm | 110 +++++++----------------- src/Page/Shop.elm | 2 +- src/Route.elm | 34 ++------ src/Wealth.elm | 6 +- 9 files changed, 332 insertions(+), 242 deletions(-) diff --git a/src/Main.elm b/src/Main.elm index cfb6744..31189b4 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -7,10 +7,8 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import Json.Encode as E import Page exposing (Page) -import Page.Chest as Chest exposing (Msg) import Route exposing (..) import Session exposing (..) -import Set exposing (Set) import Svg.Attributes import Url import Utils exposing (..) @@ -100,7 +98,7 @@ navLink icon linkText url = viewHeaderBar : String -> List (Html Msg) -> Navbar -> Html Msg viewHeaderBar navbarTitle navbarLinks navbar = - nav [ class "navbar", class "is-transparent" ] + nav [ class "navbar container is-transparent is-spaced " ] [ div [ class "navbar-brand" ] [ a [ class "navbar-item", href "/" ] [ renderIcon { icon = "fab fa-d-and-d", size = "medium", ratio = "2x" } @@ -164,21 +162,21 @@ update msg model = ( UrlChanged url, from ) -> -- Handle routing according to current page case Route.fromUrl url of - Just (Route.Home Route.MerchantLoot) -> + Just Route.Merchant -> let ( shopPage, cmd ) = Page.gotoShop from in ( model |> setPage shopPage, Cmd.map PageMsg cmd ) - Just (Route.Home Route.PlayerLoot) -> + Just Route.Home -> let ( shopPage, cmd ) = Page.gotoHome from in ( model |> setPage shopPage, Cmd.map PageMsg cmd ) - Just (Route.Home Route.GroupLoot) -> + Just Route.GroupChest -> let ( page, cmd ) = Page.gotoGroupChest from diff --git a/src/Page.elm b/src/Page.elm index b4a00f3..94dc229 100644 --- a/src/Page.elm +++ b/src/Page.elm @@ -5,16 +5,17 @@ import Api.Player import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Page.Dashboard as Dashboard +import Page.Dashboard as Home import Page.GroupChest as GroupChest import Page.Shop as Shop +import Route import Session exposing (Session) import Utils exposing (renderIcon) import Wealth type Page - = Dashboard Dashboard.Model + = Home Home.Model | GroupChest GroupChest.Model | Shop Shop.Model | About @@ -25,14 +26,16 @@ init = Loading -mapMsg toMsg = - List.map (Html.map toMsg) +mapPageMsg toMsg ( controls, content ) = + ( Html.map toMsg controls + , List.map (Html.map toMsg) content + ) maybeSession page = case page of - Dashboard model -> - Just <| Dashboard.getSession model + Home model -> + Just <| Home.getSession model GroupChest model -> Just <| Session.getSession model @@ -48,35 +51,37 @@ view page = let ( title, ( controls, content ) ) = case page of - Dashboard home -> + Home home -> ( "Lootalot" - , Dashboard.view home - |> Tuple.mapBoth - (Html.map GotDashboardMsg) - (mapMsg GotDashboardMsg) + , Home.view home + |> mapPageMsg GotHomeMsg ) GroupChest chest -> ( "Lootalot" , GroupChest.view chest - |> Tuple.mapBoth - (Html.map GotGroupChestMsg) - (mapMsg GotGroupChestMsg) + |> mapPageMsg GotGroupChestMsg ) Shop shop -> ( "Marchand" , Shop.view shop - |> Tuple.mapBoth - (Html.map GotShopMsg) - (mapMsg GotShopMsg) + |> mapPageMsg GotShopMsg ) About -> ( "Loot-a-lot", ( text "", [ p [] [ text "A propos" ] ] ) ) Loading -> - ( "Loot-a-lot", ( text "", [ p [] [ text "Chargement" ] ] ) ) + ( "Loot-a-lot" + , ( text "" + , [ div [ class "hero" ] + [ div [ class "hero-body" ] + [ p [] [ text "Chargement" ] ] + ] + ] + ) + ) navbarTitle = case maybeSession page of @@ -96,20 +101,16 @@ view page = Just session -> case Session.user session of Session.Player data -> - let - linkWithGem = - navLink "fas fa-gem" - in - [ navLink "fas fa-store-alt" "Marchand" "/marchand" + [ navLink "fas fa-store-alt" Route.Merchant page , if data.player.id /= 0 then - linkWithGem "Coffre de groupe" "/coffre" + navLink "fas fa-gem" Route.GroupChest page else text "" ] Session.Admin -> - [ navLink "fas fa-store-alt" "Marchand" "/marchand" ] + [ navLink "fas fa-store-alt" Route.Merchant page ] Nothing -> [] @@ -118,25 +119,44 @@ view page = , { title = navbarTitle, links = navbarLinks } , [ div [ class "container" ] <| viewSessionBar (maybeSession page) [ controls ] - :: (case Maybe.map Session.notification (maybeSession page) of - Just (Just notify) -> - div [ class "notification is-success" ] [ text notify ] + :: div [ class "section" ] + [ case Maybe.map Session.notification (maybeSession page) of + Just (Just t) -> + viewNotification NotifySuccess t _ -> text "" - ) - :: (case Maybe.map Session.error (maybeSession page) of - Just (Just notify) -> - div [ class "notification is-danger" ] [ text notify ] + , case Maybe.map Session.error (maybeSession page) of + Just (Just t) -> + viewNotification NotifyError t _ -> text "" - ) + ] :: content ] ) +type NotificationKind + = NotifySuccess + | NotifyError + + +viewNotification kind content = + let + className = + case kind of + NotifySuccess -> + "is-success" + + NotifyError -> + "is-danger" + in + div [ class ("notification " ++ className) ] + [ text content ] + + viewSessionBar session controls = let user = @@ -149,8 +169,10 @@ viewSessionBar session controls = Wealth.view data.player.wealth data.wealth ++ (if data.player.debt > 0 then [ div [ class "level-item" ] - [ p [ class "heading is-size-4 has-text-danger" ] - [ text ("Dette : " ++ String.fromInt data.player.debt ++ "po") ] + [ p [ class "has-text-right has-text-danger" ] + [ strong [ class "heading is-marginless has-text-danger" ] [ text "Dette" ] + , span [ class <| "is-size-4" ] [ text (String.fromInt data.player.debt ++ "po") ] + ] ] ] @@ -179,10 +201,42 @@ renderLevel left right = -- PLAYER BAR -navLink icon linkText url = - a [ class "navbar-item", href url ] +navLink icon route page = + let + ( link, url ) = + case route of + Route.Merchant -> + ( "Marchand", "/marchand" ) + + Route.GroupChest -> + ( "Coffre de groupe", "/groupe" ) + + Route.Home -> + ( "Home", "/" ) + + Route.About -> + ( "About", "/" ) + + isActive = + case ( route, page ) of + ( Route.Merchant, Shop _ ) -> + True + + ( Route.GroupChest, GroupChest _ ) -> + True + + ( Route.Home, Home _ ) -> + True + + ( Route.About, About ) -> + True + + _ -> + False + in + a [ class "navbar-item", classList [ ( "is-active", isActive ) ], href url ] [ renderIcon { icon = icon, ratio = "1x", size = "medium" } - , span [] [ text linkText ] + , span [] [ text link ] ] @@ -194,7 +248,7 @@ navLink icon linkText url = type PageMsg = ApiMsg Api.Msg | GotGroupChestMsg GroupChest.Msg - | GotDashboardMsg Dashboard.Msg + | GotHomeMsg Home.Msg | GotShopMsg Shop.Msg | Wealth Wealth.Msg @@ -210,8 +264,8 @@ map func page = Just session -> case page of - Dashboard model -> - Dashboard <| Dashboard.updateSession model (func session) + Home model -> + Home <| Home.updateSession model (func session) GroupChest model -> GroupChest { model | session = func session } @@ -229,7 +283,7 @@ map func page = closeAction ( page, cmd ) = case page of - Dashboard home -> + Home home -> ( page, cmd ) GroupChest chest -> @@ -244,17 +298,17 @@ closeAction ( page, cmd ) = update msg page = case ( msg, page, maybeSession page ) of - -- Dashboard page + -- Home page -- Capture API messages - ( GotDashboardMsg (Dashboard.Api apiMsg), Dashboard home, _ ) -> + ( GotHomeMsg (Home.Api apiMsg), Home home, _ ) -> update (ApiMsg apiMsg) page -- Relay others - ( GotDashboardMsg subMsg, Dashboard home, _ ) -> - Dashboard.update subMsg home - |> updatePage Dashboard GotDashboardMsg + ( GotHomeMsg subMsg, Home home, _ ) -> + Home.update subMsg home + |> updatePage Home GotHomeMsg - ( GotDashboardMsg _, _, _ ) -> + ( GotHomeMsg _, _, _ ) -> ( page, Cmd.none ) -- Group chest @@ -417,8 +471,8 @@ applyUpdate u user = initHome session = - Dashboard.init session - |> updatePage Dashboard GotDashboardMsg + Home.init session + |> updatePage Home GotHomeMsg gotoHome page = @@ -427,8 +481,8 @@ gotoHome page = ( page, Cmd.none ) Just session -> - Dashboard.init session - |> updatePage Dashboard GotDashboardMsg + Home.init session + |> updatePage Home GotHomeMsg gotoShop page = diff --git a/src/Page/Chest.elm b/src/Page/Chest.elm index 76c1a1f..b6ec788 100644 --- a/src/Page/Chest.elm +++ b/src/Page/Chest.elm @@ -1,10 +1,11 @@ -module Page.Chest exposing (Chest, Msg, confirmAdd, confirmBuy, confirmGrab, confirmSell, init, initCreate, initSelection, show, update, view) +module Page.Chest exposing (Chest(..), IntoMode(..), Msg, confirmAdd, confirmBuy, confirmGrab, confirmSell, init, intoMode, update, view) -import Api exposing (Item, Loot) +import Api exposing (Claims, Item, Loot) import Html exposing (..) import Page.Chest.NewFromInventory as NewFromInventory import Page.Chest.Selection as Selection import Table +import Utils type alias RowRenderer msg = @@ -27,21 +28,38 @@ type alias RowRenderer msg = type Chest - = View (Item -> Html Never) - | Selection Selection.Model - | Create NewFromInventory.Model + = New NewFromInventory.Model + | View (Item -> Html Never) + | Buy Selection.Model + | Sell Selection.Model + | Claim Selection.Model + + +type IntoMode + = IntoView + | IntoViewWithClaims Claims + | IntoAdd + | IntoBuy + | IntoSell + | IntoClaim Claims {- + Dashboard : + * ViewWithClaims (group) + * View + * Add + * Sell - View : RowRenderer -> Chest.View - - Selection : RowRenderer -> { confirm: Cmd msg, cancel: Cmd msg } -> Chest.Selection - - NewFromInventory : RowRenderer -> { confirm: Cmd msg, cancel: Cmd msg } -> Chest.NewFromInventory - + Shop : + * View + * Refresh + * Buy + GroupChest : + * ViewWithClaims + * Claim -} @@ -49,19 +67,16 @@ init = View Table.name +intoMode : IntoMode -> Msg +intoMode newMode = + IntoMode newMode + + show : Table.ItemRenderer Item Never -> Chest show renderItem = View <| Table.renderRowLevel renderItem (\_ -> []) -initCreate = - Create NewFromInventory.init - - -initSelection maybeInitial = - Selection <| Selection.init maybeInitial - - view : Chest -> Loot -> Html Msg view model loot = case model of @@ -69,31 +84,95 @@ view model loot = Table.view renderItem loot |> Html.map GotViewMsg - Selection subModel -> + Buy subModel -> Selection.view subModel loot |> Html.map GotSelectionMsg - Create subModel -> + Sell subModel -> + Selection.view subModel loot + |> Html.map GotSelectionMsg + + New subModel -> NewFromInventory.view subModel - |> Html.map GotCreateMsg + |> Html.map GotNewMsg + + Claim subModel -> + Selection.view subModel loot + |> Html.map GotSelectionMsg type Msg - = GotCreateMsg NewFromInventory.Msg + = GotNewMsg NewFromInventory.Msg | GotSelectionMsg Selection.Msg | GotViewMsg Never + | IntoMode IntoMode update : Msg -> Chest -> ( Chest, Cmd Msg ) update msg model = case ( msg, model ) of - ( GotCreateMsg subMsg, Create subModel ) -> + ( GotNewMsg subMsg, New subModel ) -> NewFromInventory.update subMsg subModel - |> updateChest GotCreateMsg Create + |> updateChest GotNewMsg New - ( GotSelectionMsg subMsg, Selection subModel ) -> + ( GotNewMsg subMsg, _ ) -> + ( model, Cmd.none ) + + ( GotSelectionMsg subMsg, Buy subModel ) -> Selection.update subMsg subModel - |> updateChest GotSelectionMsg Selection + |> updateChest GotSelectionMsg Buy + + ( GotSelectionMsg subMsg, Sell subModel ) -> + Selection.update subMsg subModel + |> updateChest GotSelectionMsg Sell + + ( GotSelectionMsg subMsg, Claim subModel ) -> + Selection.update subMsg subModel + |> updateChest GotSelectionMsg Claim + + ( GotSelectionMsg subMsg, _ ) -> + ( model, Cmd.none ) + + ( IntoMode newMode, _ ) -> + case newMode of + IntoView -> + ( View Table.name, Cmd.none ) + + IntoViewWithClaims claims -> + let + isClaimed item = + List.any (\claim -> claim.loot_id == item.id) claims + + renderItem item = + [ if isClaimed item then + Utils.renderIcon + { icon = "fas fa-praying-hands" + , size = "small" + , ratio = "1x" + } + + else + text "" + , p [] [ text item.name ] + ] + in + ( View <| Table.renderRowLevel renderItem (\_ -> []), Cmd.none ) + + IntoBuy -> + ( Buy <| Selection.init Nothing True, Cmd.none ) + + IntoSell -> + ( Sell <| Selection.init Nothing True, Cmd.none ) + + IntoClaim claims -> + let + initialSelection = + List.map .loot_id claims + in + ( Claim <| Selection.init (Just initialSelection) False, Cmd.none ) + + IntoAdd -> + ( New NewFromInventory.init, Cmd.none ) _ -> ( model, Cmd.none ) @@ -113,7 +192,7 @@ updateChest toMsg toChest ( model, cmd ) = confirmBuy : Int -> Chest -> Loot -> Cmd Api.Msg confirmBuy playerId model loot = case model of - Selection chest -> + Buy chest -> let items = Selection.selected chest loot @@ -135,7 +214,7 @@ confirmBuy playerId model loot = confirmSell : Int -> Chest -> Loot -> List Int -> Cmd Api.Msg confirmSell playerId model loot players = case model of - Selection chest -> + Sell chest -> let items = Selection.selected chest loot @@ -157,7 +236,7 @@ confirmSell playerId model loot players = confirmAdd : Int -> String -> Chest -> Cmd Api.Msg confirmAdd playerId sourceName model = case model of - Create chest -> + New chest -> let items = NewFromInventory.allLoot chest @@ -176,7 +255,7 @@ confirmAdd playerId sourceName model = confirmGrab : Int -> Loot -> Chest -> Cmd Api.Msg confirmGrab playerId loot model = case model of - Selection chest -> + Claim chest -> let items = Selection.selected chest loot diff --git a/src/Page/Chest/Selection.elm b/src/Page/Chest/Selection.elm index 6c95c2d..7110ce3 100644 --- a/src/Page/Chest/Selection.elm +++ b/src/Page/Chest/Selection.elm @@ -13,16 +13,17 @@ type alias Selection = Set Int -type alias Data a = - Dict Int a +type Data a + = NoData + | Data (Dict Int a) type Model = Model Selection (Data Int) -init : Maybe (List Int) -> Model -init maybeInitial = +init : Maybe (List Int) -> Bool -> Model +init maybeInitial hasData = Model (case maybeInitial of Just initial -> @@ -31,7 +32,13 @@ init maybeInitial = Nothing -> Set.empty ) - Dict.empty + (case hasData of + True -> + Data Dict.empty + + False -> + NoData + ) view : Model -> Loot -> Html Msg @@ -40,37 +47,46 @@ view (Model selection data) loot = 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 + renderRight item = + case data of + Data inner -> + let + maybeMod = + Dict.get item.id inner + in + renderItemWithPrice .base_price isSelected maybeMod item - Nothing -> - "0" - - else - text "" - ] + NoData -> + [] in Table.view (Table.renderSelectableRow (\item -> [ p [] [ text item.name ] ]) - (\item -> renderItem item) + renderRight (\item _ -> SwitchSelectionState item.id) isSelected ) loot +renderItemWithPrice toPrice isSelected maybeMod item = + [ viewPriceWithModApplied + (Maybe.map (\i -> toFloatingMod i) maybeMod) + (toFloat item.base_price) + , if isSelected item then + viewPriceModifier item.id <| + case maybeMod of + Just mod -> + String.fromInt mod + + Nothing -> + "0" + + else + text "" + ] + + toFloatingMod : Int -> Float toFloatingMod percent = (100 + Debug.log "toFloat" (toFloat percent)) / 100 @@ -126,12 +142,17 @@ selected (Model selection data) 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 + case data of + Data inner -> + List.map + (\item -> + Dict.get item.id inner + |> Maybe.map (\i -> toFloatingMod i) + ) + items + + NoData -> + [] itemInSelection : Selection -> Item -> Bool @@ -166,18 +187,24 @@ update : Msg -> Model -> ( Model, Cmd Msg ) update msg (Model selection data) = case msg of PriceModifierChanged id value -> - ( Model selection - (Dict.insert - id - (case String.toInt value of - Just i -> - i + ( Model selection <| + case data of + Data inner -> + Data + (Dict.insert + id + (case String.toInt value of + Just i -> + i - Nothing -> - 0 - ) - data - ) + Nothing -> + 0 + ) + inner + ) + + NoData -> + data , Cmd.none ) diff --git a/src/Page/Dashboard.elm b/src/Page/Dashboard.elm index 8bc0efa..3bf13a7 100644 --- a/src/Page/Dashboard.elm +++ b/src/Page/Dashboard.elm @@ -302,7 +302,7 @@ update msg model = (Cmd.map GotChestMsg) IntoSell -> - ( Player (PlayerConfig session (Sell <| Chest.initSelection Nothing)), Cmd.none ) + ( Player (PlayerConfig session (Sell <| Chest.initSelection Nothing True)), Cmd.none ) IntoAdd -> ( Player (PlayerConfig session (Add Chest.initCreate)), Cmd.none ) diff --git a/src/Page/GroupChest.elm b/src/Page/GroupChest.elm index 96b3965..e7f03d7 100644 --- a/src/Page/GroupChest.elm +++ b/src/Page/GroupChest.elm @@ -8,29 +8,16 @@ import Page.Chest as Chest exposing (Chest) import Session exposing (Session, User(..)) import Set import Table +import Utils exposing (renderIcon) type alias Model = { session : Session , loot : State - , mode : Mode + , chest : Chest } -type Mode - = View Chest - | Grab Chest - - -mapChest fn mode = - case mode of - View chest -> - fn chest - - Grab chest -> - fn chest - - type State = Loading | LoadError String @@ -52,7 +39,13 @@ getClaimsFromSession session = init session = - ( Model session Loading (View <| showClaims (getClaimsFromSession session)), Cmd.map Internal <| Api.fetchLoot GotLoot Api.OfGroup ) + ( Model session + Loading + (Tuple.first <| + Chest.update (Chest.intoMode (Chest.IntoViewWithClaims <| getClaimsFromSession session)) Chest.init + ) + , Cmd.map Internal <| Api.fetchLoot GotLoot Api.OfGroup + ) view : Model -> ( Html Msg, List (Html Msg) ) @@ -79,21 +72,25 @@ view model = Session.Player data -> ( True, data.player.id == 0 ) in - case model.mode of - View _ -> - if isPlayer && not isGroup then - button [ class "button", onClick IntoGrab ] [ text "Demander" ] + case ( model.chest, isPlayer && not isGroup ) of + ( Chest.View _, True ) -> + button + [ class "button" + , onClick + (GotChestMsg + (Chest.intoMode <| + Chest.IntoClaim (getClaimsFromSession model.session) + ) + ) + ] + [ text "Demander" ] - else - text "" + ( Chest.Claim _, True ) -> + button [ class "button", onClick ConfirmGrab ] [ text "Valider" ] - Grab _ -> - if isPlayer && not isGroup then - button [ class "button", onClick ConfirmGrab ] [ text "Valider" ] - - else - text "" - , [ mapChest (\c -> Chest.view c loot) model.mode + ( _, _ ) -> + text "" + , [ Chest.view model.chest loot |> Html.map (Internal << GotChestMsg) ] ) @@ -107,34 +104,11 @@ type Msg type InnerMsg = GotLoot Api.ToChest (HttpResult Loot) | GotChestMsg Chest.Msg - | IntoGrab - | IntoView | ConfirmGrab -showClaims claims = - let - itemClaimed item = - List.any (\c -> c.loot_id == item.id) claims - in - Chest.show - (\item -> - [ p [] - [ text <| - (if itemClaimed item then - "C" - - else - "" - ) - ++ item.name - ] - ] - ) - - refresh model = - { model | mode = View <| showClaims (getClaimsFromSession model.session) } + update (Internal <| GotChestMsg (Chest.intoMode (Chest.IntoViewWithClaims (getClaimsFromSession model.session)))) model update : Msg -> Model -> ( Model, Cmd Msg ) @@ -144,13 +118,13 @@ update msg model = ( model, Cmd.none ) Internal ConfirmGrab -> - case ( Session.user model.session, model.loot, model.mode ) of - ( Session.Player data, Loaded loot, Grab chest ) -> + case ( Session.user model.session, model.loot, model.chest ) of + ( Session.Player data, Loaded loot, Chest.Claim _ ) -> ( model , Chest.confirmGrab data.player.id loot - chest + model.chest |> Cmd.map Api ) @@ -166,24 +140,9 @@ update msg model = ( { model | loot = LoadError "Le chargement a échoué" }, Cmd.none ) GotChestMsg chestMsg -> - mapChest (Chest.update chestMsg) model.mode + Chest.update chestMsg model.chest |> updateChest model - IntoGrab -> - let - claimedIds = - case Session.user model.session of - Player data -> - List.map .loot_id data.claims - - Admin -> - [] - in - ( { model | mode = Grab <| Chest.initSelection (Just claimedIds) }, Cmd.none ) - - IntoView -> - ( refresh model, Cmd.none ) - _ -> ( model, Cmd.none ) ) @@ -191,11 +150,6 @@ update msg model = updateChest model ( chestModel, chestCmd ) = - ( case model.mode of - View _ -> - { model | mode = View chestModel } - - Grab _ -> - { model | mode = Grab chestModel } + ( { model | chest = chestModel } , Cmd.map GotChestMsg chestCmd ) diff --git a/src/Page/Shop.elm b/src/Page/Shop.elm index 40bc805..255e101 100644 --- a/src/Page/Shop.elm +++ b/src/Page/Shop.elm @@ -210,7 +210,7 @@ update msg model = IntoBuy -> case Session.user (getSession model) of Session.Player _ -> - ( { model | chest = Buy <| Chest.initSelection Nothing }, Cmd.none ) + ( { model | chest = Buy <| Chest.initSelection Nothing True }, Cmd.none ) _ -> ( model, Cmd.none ) diff --git a/src/Route.elm b/src/Route.elm index d892c26..eba9d9f 100644 --- a/src/Route.elm +++ b/src/Route.elm @@ -8,41 +8,19 @@ import Url.Parser as P exposing ((), Parser, oneOf, s) -- ROUTES -type ChestContent - = PlayerLoot - | MerchantLoot - | GroupLoot - | NewLoot - - type Route - = Home ChestContent + = Home -- Either PlayerChest or Admin depending on Session | About - - - -{- - We could flatten this : - - type Route - = Home -- Either PlayerChest or Admin depending on Session - | About - | Merchant - | GroupChest - | NewLoot - - - --} + | Merchant + | GroupChest parser : P.Parser (Route -> a) a parser = oneOf - [ P.map (Home PlayerLoot) P.top - , P.map (Home GroupLoot) (P.s "coffre") - , P.map (Home MerchantLoot) (P.s "marchand") - , P.map (Home NewLoot) (P.s "nouveau-tresor") + [ P.map Home P.top + , P.map GroupChest (P.s "groupe") + , P.map Merchant (P.s "marchand") , P.map About (P.s "about") ] diff --git a/src/Wealth.elm b/src/Wealth.elm index 5753fba..f05f3d7 100644 --- a/src/Wealth.elm +++ b/src/Wealth.elm @@ -15,11 +15,10 @@ init = View +view : Wealth -> Model -> List (Html Msg) 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" ] [] ] - ] + [ span [ class "icon is-large" ] [ i [ class "fas fa-2x fa-piggy-bank" ] [] ] ] :: (case model of View -> viewWealth wealth @@ -27,6 +26,7 @@ view wealth model = Edit amount -> viewUpdateWealth amount ) + ++ [ span [ class "icon", onClick StartEdit ] [ i [ class "fas fa-tools" ] [] ] ] viewUpdateWealth amount =