From eb29c5a24fb0bbf436100dcc9df910a76b84ec89 Mon Sep 17 00:00:00 2001 From: Artus Date: Fri, 8 Nov 2019 15:56:07 +0100 Subject: [PATCH] cleaning up --- src/Api.elm | 42 ++-- src/Chest.elm | 220 ++++++++++++------ src/Main.elm | 615 +++++++++++++++++++++----------------------------- src/Modes.elm | 39 +++- src/Utils.elm | 14 +- 5 files changed, 464 insertions(+), 466 deletions(-) diff --git a/src/Api.elm b/src/Api.elm index cab7847..95e3053 100644 --- a/src/Api.elm +++ b/src/Api.elm @@ -3,7 +3,7 @@ module Api exposing (..) import Http import Json.Decode as D exposing (Decoder, field, int, string, succeed) import Json.Encode as E -import Modes exposing (ViewMode) +import Modes type alias HttpResult a = @@ -28,8 +28,6 @@ type Update type Msg = GotPlayer (HttpResult Player) - | GotClaims Int (HttpResult Claims) - | GotLoot ToChest (HttpResult Loot) | GotActionResult (HttpResult Response) @@ -97,13 +95,13 @@ claimDecoder = (D.field "loot_id" int) -fetchClaims : Int -> Cmd Msg -fetchClaims playerId = +fetchClaims : (Result Http.Error Claims -> msg) -> Cmd msg +fetchClaims toMsg = Http.get { url = "http://localhost:8088/api/claims" , expect = valueDecoder (D.list claimDecoder) - |> Http.expectJson (GotClaims playerId) + |> Http.expectJson toMsg } @@ -142,12 +140,6 @@ wealthDecoder = -- Location of a loot -type ToChest - = OfPlayer Int - | OfGroup - | OfShop - - itemDecoder = D.map3 Item (D.field "id" int) @@ -160,23 +152,11 @@ lootDecoder = D.list itemDecoder -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 +fetchLoot : String -> (Result Http.Error Loot -> msg) -> Cmd msg +fetchLoot url toMsg = Http.get { url = url - , expect = Http.expectJson (GotLoot dest) (valueDecoder lootDecoder) + , expect = Http.expectJson toMsg (valueDecoder lootDecoder) } @@ -234,7 +214,7 @@ undoLastAction id = } -buildPayload : ViewMode -> List Item -> E.Value +buildPayload : Modes.Model -> List Item -> E.Value buildPayload mode items = case mode of Modes.Buy -> @@ -259,8 +239,10 @@ buildPayload mode items = [ ( "items", items |> E.list (\i -> E.int i.id) ) ] + Modes.None -> E.null -sendRequest : ViewMode -> String -> List Item -> Cmd Msg + +sendRequest : Modes.Model -> String -> List Item -> Cmd Msg sendRequest mode id items = let ( endpoint, method ) = @@ -284,6 +266,8 @@ sendRequest mode id items = ( "http://localhost:8088/api/players/" ++ id ++ "/claims" , "POST" ) + -- TODO: ??? + Modes.None -> ("", "GET") in Http.request { method = method diff --git a/src/Chest.elm b/src/Chest.elm index 439da0d..aab044c 100644 --- a/src/Chest.elm +++ b/src/Chest.elm @@ -1,15 +1,18 @@ module Chest exposing (..) -import Api exposing (Claims, Item, Loot) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onCheck) -import Modes exposing (ViewMode) + +import Api exposing (HttpResult, Claims, Item, Loot) +import Modes import Route exposing (..) import Set exposing (Set) import Utils exposing (..) +-- MODEL + type alias Model = { loot : Loot , groupLoot : Loot @@ -20,37 +23,51 @@ type alias Model = } + +type ToChest + = OfPlayer Int + | OfGroup + | OfShop + type alias Selection = Set Int +init : Int -> (Model, Cmd Msg) +init playerId = + ( { loot = [] + , groupLoot = [] + , merchantItems = [] + , newLoot = [] + , selection = Nothing + , claims = [] + } + , Cmd.batch + [ fetchLoot OfShop + , fetchLoot OfGroup + , fetchLoot (OfPlayer playerId) + , Api.fetchClaims (GotClaims playerId) + ] + ) -type Msg - = SetSelection (Maybe Selection) - | SwitchSelectionState Int +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" -init : Model -init = - { loot = [] - , groupLoot = [] - , merchantItems = [] - , newLoot = [] - , selection = Nothing - , claims = [] - } + OfGroup -> + "http://localhost:8088/api/players/0/loot" + in + Api.fetchLoot url (GotLoot dest) +-- VIEW -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 ) - - -view : Maybe ViewMode -> Route.Route -> Model -> Html Msg +view : Modes.Model -> Route.Route -> Model -> Html Msg view mode route model = let ( header, shownItems ) = @@ -67,24 +84,26 @@ view mode route model = Route.NewLoot -> ( "Nouveau trésor :)", [] ) + isSelected = itemInSelection model.selection - rowControls = + rowRenderer = case mode of - Just m -> - Just (rowControlsForMode isSelected m) - - Nothing -> + Modes.None -> case route of Route.GroupLoot -> + let + isClaimed = itemInClaims model.claims + in -- Claim controls for Group chest - Just <| - claimedItemRenderer <| - itemInClaims model.claims + Just (claimedItemRenderer isClaimed) _ -> Nothing + + activeMode -> + Just (rowRendererForMode isSelected activeMode) in article [ class "section" ] @@ -95,10 +114,13 @@ view mode route model = , table [ class "table is-fullwidth is-striped is-hoverable" ] [ thead [ class "table-header" ] [ th [] [ text "Nom" ] ] - , tbody [] <| List.map (viewItemTableRow isSelected rowControls) shownItems + , tbody [] <| List.map (viewItemTableRow isSelected rowRenderer) shownItems ] ] +-- Renderers +-- +-- Item -> Html Msg claimedItemRenderer : (Item -> Bool) -> Item -> Html Msg claimedItemRenderer isClaimed item = @@ -114,14 +136,13 @@ claimedItemRenderer isClaimed item = text "" - --- Renders controls for a specific mode - - -rowControlsForMode : (Item -> Bool) -> ViewMode -> Item -> Html Msg -rowControlsForMode isSelected mode item = +rowRendererForMode: (Item -> Bool) -> Modes.Model -> Item -> Html Msg +rowRendererForMode isSelected mode item = let - itemInfo = + canSelect = + Modes.canSelectIn mode + + renderInfo = case mode of Modes.Buy -> p [ class "level-item" ] [ text (String.fromInt item.base_price ++ "po") ] @@ -134,10 +155,12 @@ rowControlsForMode isSelected mode item = Modes.Add -> p [ class "level-item" ] [ text "New !" ] + + Modes.None -> text "" in div [ class "level-right" ] <| - itemInfo - :: (if Modes.canSelectIn mode then + renderInfo + :: (if canSelect then [ input [ class "checkbox level-item" , type_ "checkbox" @@ -153,13 +176,13 @@ rowControlsForMode isSelected mode item = viewItemTableRow : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Item -> Html Msg -viewItemTableRow isSelected rowControls item = +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 rowControls of + :: (case rowRenderer of Just render -> List.singleton (render item) @@ -169,6 +192,78 @@ viewItemTableRow isSelected rowControls item = ] ] +-- 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" ] [] ] + ] + ] + +-- UPDATE + +type Msg + = SetSelection (Maybe Selection) + | GotLoot ToChest (HttpResult Loot) + | GotClaims Int (HttpResult Claims) + | SwitchSelectionState Int + + + +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 = @@ -176,6 +271,11 @@ itemInSelection selection item = |> 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 @@ -192,21 +292,6 @@ switchSelectionState id selection = Debug.log "ignore switchSelectionState" 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" ] [] ] - ] - ] - - targetItemsFor : Route -> Model -> List Item targetItemsFor route model = case route of @@ -221,18 +306,3 @@ targetItemsFor route model = Route.GroupLoot -> model.groupLoot - - -getSelected : Route -> Model -> Loot -getSelected route model = - targetItemsFor route model - |> List.filter (itemInSelection model.selection) - - - --- LOOT Views - - -itemInClaims : Claims -> Item -> Bool -itemInClaims claims item = - List.any (\c -> c.loot_id == item.id) claims diff --git a/src/Main.elm b/src/Main.elm index 342ab0b..bb5d1e6 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -8,7 +8,7 @@ import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) import Json.Encode as E -import Modes exposing (ViewMode) +import Modes import Route exposing (..) import Set exposing (Set) import Svg.Attributes @@ -47,7 +47,7 @@ type alias Model = { state : State , navKey : Nav.Key , route : Route - , mode : Maybe ViewMode + , mode : Modes.Model , player : Player , chest : Chest.Model } @@ -63,386 +63,44 @@ init flags url key = Nothing -> PlayerChest + + (chest, cmd) = + Chest.init 0 in ( Model (State False Nothing Nothing) key route - Nothing + Modes.init Api.blankPlayer - Chest.init - , fetchInitialData 0 + chest + , Cmd.batch + [ initPlayer 0 + , Cmd.map ChestMsg cmd + ] ) -fetchInitialData : Int -> Cmd Msg -fetchInitialData playerId = - Cmd.batch - [ initPlayer playerId - , Cmd.map ApiMsg <| Api.fetchLoot Api.OfShop - , Cmd.map ApiMsg <| Api.fetchLoot Api.OfGroup - ] - initPlayer id = - Cmd.batch - [ Cmd.map ApiMsg <| Api.fetchPlayer id - , Cmd.map ApiMsg <| Api.fetchLoot (Api.OfPlayer id) - , Cmd.map ApiMsg <| Api.fetchClaims id - ] - - - --- UPDATE - - -type Msg - = LinkClicked Browser.UrlRequest - | UrlChanged Url.Url - | ApiMsg Api.Msg - | ChestMsg Chest.Msg - | PlayerChanged Int - | ModeSwitched (Maybe ViewMode) - | ConfirmAction - | UndoLastAction - | ClearNotification - - -update : Msg -> Model -> ( Model, Cmd Msg ) -update msg model = - case msg of - LinkClicked urlRequest -> - case urlRequest of - Browser.Internal url -> - ( model, Nav.pushUrl model.navKey (Url.toString url) ) - - Browser.External href -> - ( setError ("External request '" ++ href ++ "'") model - , Cmd.none - ) - - UrlChanged url -> - let - route = - routeParser url - in - case route of - Just page -> - { model | route = page } - |> update - (case page of - -- Directly enter add mode on NewLoot view - NewLoot -> - ModeSwitched (Just Modes.Add) - - other -> - ModeSwitched Nothing - ) - - Nothing -> - ( setError "Invalid route" model, Cmd.none ) - - PlayerChanged newId -> - ( { model | player = Api.blankPlayer }, initPlayer newId ) - - ChestMsg chestMsg -> - let - ( chest, _ ) = - Chest.update chestMsg model.chest - in - ( { model | chest = chest }, Cmd.none ) - - 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 Nothing) - - 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 - ) - - Api.GotClaims id result -> - case result of - Ok claims -> - ( let - chest = - model.chest - in - { model - | chest = - { chest - | claims = - List.filter - (\c -> c.player_id == id) - claims - } - } - , Cmd.none - ) - - Err error -> - ( setError ("Fetching claims..." ++ Debug.toString error) model, Cmd.none ) - - Api.GotLoot dest result -> - case result of - Ok loot -> - let - chest = - model.chest - in - ( case dest of - Api.OfPlayer _ -> - { model | chest = { chest | loot = loot } } - - Api.OfGroup -> - { model | chest = { chest | groupLoot = loot } } - - Api.OfShop -> - { model | chest = { chest | merchantItems = loot } } - , Cmd.none - ) - - Err error -> - ( setError ("Fetching loot... " ++ Debug.toString error) model - , Cmd.none - ) - - ModeSwitched newMode -> - ( { model - | mode = newMode - , chest = - let - ( newChest, _ ) = - Chest.update - (Chest.SetSelection - (case newMode of - Nothing -> - Nothing - - Just Modes.Grab -> - -- Currently claimed object are initially selected - Just (Set.fromList <| List.map (\c -> c.loot_id) model.chest.claims) - - Just others -> - Just Set.empty - ) - ) - model.chest - in - newChest - } - , Cmd.none - ) - - ConfirmAction -> - case model.mode of - Nothing -> - update (ModeSwitched Nothing) model - - Just mode -> - let - items = - Chest.getSelected model.route model.chest - in - ( model - , Cmd.map ApiMsg <| - Api.sendRequest - mode - (String.fromInt model.player.id) - items - ) - - UndoLastAction -> - ( model, Cmd.map ApiMsg <| Api.undoLastAction model.player.id ) - - 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 } - } - - - --- STATE Utils --- SUBSCRIPTIONS --- - - -subscriptions : Model -> Sub Msg -subscriptions _ = - Sub.none - + Cmd.map ApiMsg <| Api.fetchPlayer id --- -- VIEWS --- - -actionButton msg t icon color = - button - [ class <| "button level-item is-" ++ color - , onClick msg - ] - [ span [ class "icon" ] [ i [ Svg.Attributes.class <| "fas fa-" ++ icon ] [] ] - , p [] [ text t ] - ] - - -controlsWhenModeActive : ViewMode -> List (Html Msg) -controlsWhenModeActive mode = - [ actionButton ConfirmAction "Valider" "check" "primary" - , actionButton (ModeSwitched Nothing) "Annuler" "times" "danger" - ] - - -controlsWhenRoute : Route -> List (Html Msg) -controlsWhenRoute route = - case route of - PlayerChest -> - [ actionButton (ModeSwitched (Just Modes.Sell)) "Vendre" "coins" "danger" ] - - GroupLoot -> - [ actionButton (ModeSwitched (Just Modes.Grab)) "Demander" "praying-hands" "primary" ] - - Merchant -> - [ actionButton (ModeSwitched (Just Modes.Buy)) "Acheter" "coins" "success" ] - - NewLoot -> - [ actionButton (ModeSwitched (Just Modes.Add)) "Nouveau loot" "plus" "primary" ] - - view : Model -> Browser.Document Msg view model = let - -- What do we show inside the chest ? - {- Dynamic renderers for ViewMode - - Header controls are inserted in the PlayerBar - and rowControls to the right side of every item rows - -} - headerControls = - case model.mode of - Just mode -> - controlsWhenModeActive mode - - Nothing -> - -- Buttons to enter mode - actionButton UndoLastAction "Annuler action" "backspace" "danger" - :: controlsWhenRoute model.route + renderControls = + Modes.viewControls model.mode model.route + |> List.map (Html.map ModeMsg) in { title = "Loot-a-lot in ELM" , body = [ viewHeaderBar model - , viewPlayerBar model.player headerControls + , viewPlayerBar model.player renderControls , main_ [ class "container" ] [ viewNotification model.state.notification @@ -620,3 +278,244 @@ showWealthField name value = , span [ class <| "is-size-4" ] [ text value ] ] ] + +-- UPDATE + + +type Msg + = LinkClicked Browser.UrlRequest + | UrlChanged Url.Url + | ApiMsg Api.Msg + | ChestMsg Chest.Msg + | ModeMsg Modes.Msg + | PlayerChanged Int + | ClearNotification + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + LinkClicked urlRequest -> + case urlRequest of + Browser.Internal url -> + ( model, Nav.pushUrl model.navKey (Url.toString url) ) + + Browser.External href -> + ( setError ("External request '" ++ href ++ "'") model + , Cmd.none + ) + + UrlChanged url -> + let + route = + routeParser 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 ) + + PlayerChanged newId -> + ( { model | player = Api.blankPlayer }, initPlayer newId ) + + ChestMsg chestMsg -> + let + ( chest, _ ) = + Chest.update chestMsg model.chest + in + ( { model | chest = chest }, Cmd.none ) + + 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 } + } + + + +-- STATE Utils +-- SUBSCRIPTIONS +-- + + +subscriptions : Model -> Sub Msg +subscriptions _ = + Sub.none + + diff --git a/src/Modes.elm b/src/Modes.elm index 1861be7..d0bed8b 100644 --- a/src/Modes.elm +++ b/src/Modes.elm @@ -1,14 +1,25 @@ module Modes exposing (..) +import Route +import Html exposing (..) +import Html.Attributes exposing (..) +import Utils exposing(actionButton) -type ViewMode +type Model = Sell | Buy | Grab | Add + | None +init = + None -canSelectIn : ViewMode -> Bool +type Msg + = ModeSwitched Model + | ConfirmAction + +canSelectIn : Model -> Bool canSelectIn mode = case mode of Sell -> @@ -22,3 +33,27 @@ canSelectIn mode = Add -> False + + None -> + False + +viewControls : Model -> 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" + ] diff --git a/src/Utils.elm b/src/Utils.elm index 05dbe41..dcb9b66 100644 --- a/src/Utils.elm +++ b/src/Utils.elm @@ -1,9 +1,19 @@ -module Utils exposing (renderIcon) +module Utils exposing (renderIcon, actionButton) import Html exposing (..) import Html.Attributes exposing (..) - +import Html.Events exposing (..) +import Svg.Attributes renderIcon params = span [ class <| "icon is-" ++ params.size ] [ i [ class <| params.icon ++ " fa-" ++ params.ratio ] [] ] + +actionButton msg t icon color = + button + [ class <| "button level-item is-" ++ color + , onClick msg + ] + [ span [ class "icon" ] [ i [ Svg.Attributes.class <| "fas fa-" ++ icon ] [] ] + , p [] [ text t ] + ]