diff --git a/src/Main.elm b/src/Main.elm index 14cdbc1..b128cbd 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -143,7 +143,7 @@ update msg model = Just logged -> let ( page, cmd ) = - Page.gotoHome logged + Page.initHome logged in ( model |> setPage page, Cmd.map PageMsg cmd ) @@ -158,20 +158,22 @@ update msg model = Browser.External href -> ( model, Cmd.none ) - ( UrlChanged url, page ) -> + ( UrlChanged url, from ) -> -- Handle routing according to current page - case ( Route.fromUrl url, page ) of - ( Just (Route.Home Route.MerchantLoot), Page.Admin admin ) -> + case Route.fromUrl url of + Just (Route.Home Route.MerchantLoot) -> let ( shopPage, cmd ) = - Page.gotoShop (Admin.getSession admin) + Page.gotoShop from in ( model |> setPage shopPage, Cmd.map PageMsg cmd ) - ( Just (Route.Home content), Page.Chest chest ) -> - ( model |> setPage (Page.Chest (Chest.setContent content chest)) - , Cmd.none - ) + Just (Route.Home Route.PlayerLoot) -> + let + ( shopPage, cmd ) = + Page.gotoHome from + in + ( model |> setPage shopPage, Cmd.map PageMsg cmd ) {- ( Just route, Page.Admin admin ) -> diff --git a/src/Page.elm b/src/Page.elm index fb4f745..314d235 100644 --- a/src/Page.elm +++ b/src/Page.elm @@ -1,39 +1,27 @@ -module Page exposing (Page(..), PageMsg, gotoHome, gotoShop, update, view) +module Page exposing (Page(..), PageMsg, gotoHome, gotoShop, initHome, update, view) +import Api +import Api.Player import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) import Page.Admin as Admin -import Page.Chest as Chest -import Page.Chest.Wealth as Wealth +import Page.Dashboard as Dashboard +import Page.GroupChest as GroupChest import Page.Shop as Shop import Session exposing (Session) import Utils exposing (renderIcon) +import Wealth type Page - = Chest Chest.Model - | Admin Admin.Model + = Dashboard Dashboard.Model + | GroupChest GroupChest.Model | Shop Shop.Model | About | Loading - -{- - - type Page - = Dashboard Session - | GroupChest Session - | Shop Shop.Model - | NewLoot Session - | About - | Loading - - --} - - init = Loading @@ -42,29 +30,40 @@ mapMsg toMsg = List.map (Html.map toMsg) +maybeSession page = + case page of + Dashboard model -> + Just <| Session.getSession model + + GroupChest model -> + Just <| Session.getSession model + + Shop model -> + Just <| Session.getSession model + + _ -> + Nothing + + view page = let - maybeSession = - case page of - Chest model -> - Just <| Session.getSession model - - Admin model -> - Just <| Admin.getSession model - - Shop model -> - Just <| Session.getSession model - - _ -> - Nothing - ( title, ( controls, content ) ) = case page of - Chest chest -> - ( "Lootalot", ( text "", mapMsg GotChestMsg <| Chest.view chest ) ) + Dashboard home -> + ( "Lootalot" + , Dashboard.view home + |> Tuple.mapBoth + (Html.map GotDashboardMsg) + (mapMsg GotDashboardMsg) + ) - Admin admin -> - ( "Administration", ( text "", mapMsg GotAdminMsg <| Admin.view admin ) ) + GroupChest chest -> + ( "Lootalot" + , GroupChest.view chest + |> Tuple.mapBoth + (Html.map GotGroupChestMsg) + (mapMsg GotGroupChestMsg) + ) Shop shop -> ( "Marchand" @@ -81,7 +80,7 @@ view page = ( "Loot-a-lot", ( text "", [ p [] [ text "Chargement" ] ] ) ) navbarTitle = - case maybeSession of + case maybeSession page of Just session -> case Session.user session of Session.Player player _ -> @@ -94,7 +93,7 @@ view page = "Loot-a-lot" navbarLinks = - case maybeSession of + case maybeSession page of Just session -> case Session.user session of Session.Player player _ -> @@ -119,20 +118,24 @@ view page = ( title , { title = navbarTitle, links = navbarLinks } , [ div [ class "container" ] <| - viewSessionBar maybeSession [ controls ] + viewSessionBar (maybeSession page) [ controls ] :: content ] ) -viewSessionBar maybeSession controls = +viewSessionBar session controls = let user = - case Maybe.map Session.user maybeSession of + case Maybe.map Session.user session of Nothing -> [ text "" ] Just (Session.Player player wealth) -> + let + _ = + Debug.log "viewSessionBar wealth" player.wealth + in Wealth.view player.wealth wealth ++ (if player.debt > 0 then [ div [ class "level-item" ] @@ -176,30 +179,135 @@ navLink icon linkText url = -- UPDATE -- +-- Note : All pages 'update' function +-- shall return (subMode, Cmd Api.Msg) type PageMsg - = GotChestMsg Chest.Msg - | GotAdminMsg Admin.Msg + = ApiMsg Api.Msg + | GotGroupChestMsg GroupChest.Msg + | GotDashboardMsg Dashboard.Msg | GotShopMsg Shop.Msg | Wealth Wealth.Msg + +-- Maps the page session to a function, if any + + +map func page = + case maybeSession page of + Nothing -> + page + + Just session -> + case page of + Dashboard model -> + Dashboard { model | session = func session } + + GroupChest model -> + GroupChest { model | session = func session } + + Shop model -> + Shop { model | session = func session } + + _ -> + page + + update msg page = - case ( msg, page ) of - ( GotChestMsg subMsg, Chest chest ) -> - Chest.update subMsg chest - |> updatePage Chest GotChestMsg + case ( msg, page, maybeSession page ) of + ( GotGroupChestMsg subMsg, GroupChest chest, _ ) -> + GroupChest.update subMsg chest + |> updatePage GroupChest GotGroupChestMsg - ( GotAdminMsg subMsg, Admin admin ) -> - Admin.update subMsg admin - |> updatePage Admin GotAdminMsg + ( GotGroupChestMsg _, _, _ ) -> + ( page, Cmd.none ) - ( GotShopMsg subMsg, Shop shop ) -> + ( GotDashboardMsg subMsg, Dashboard home, _ ) -> + Dashboard.update subMsg home + |> updatePage Dashboard GotDashboardMsg + + ( GotDashboardMsg _, _, _ ) -> + ( page, Cmd.none ) + + ( GotShopMsg subMsg, Shop shop, _ ) -> Shop.update subMsg shop |> updatePage Shop GotShopMsg - _ -> + ( GotShopMsg _, _, _ ) -> + ( page, Cmd.none ) + + ( Wealth wealthMsg, _, Just session ) -> + let + wealthModel = + Session.wealth session + in + case Session.user session of + Session.Player player aModel -> + let + ( newWealth, maybeEdit ) = + Wealth.update wealthMsg aModel + in + ( map (Session.updateWealth newWealth) page + , case maybeEdit of + Just amount -> + Api.confirmAction + (String.fromInt (.id player)) + (Api.WealthPayload amount) + |> Cmd.map ApiMsg + + Nothing -> + Cmd.none + ) + + _ -> + Debug.log "not a player but updates wealth" + ( page, Cmd.none ) + + ( Wealth wealthMsg, _, Nothing ) -> + ( page, Cmd.none ) + + ( ApiMsg (Api.GotActionResult response), _, Just session ) -> + let + _ = + Debug.log "got api response" response + in + case response of + Ok result -> + let + updates = + Maybe.withDefault [] result.updates + + notification = + result.notification + + errors = + Maybe.withDefault "" result.errors + + newUser = + Debug.log "newUser" <| + List.foldl applyUpdate (Session.user session) updates + in + ( map (Session.updateUser newUser) page + , Cmd.none + ) + + -- |> setNotification notification + -- |> setError errors + -- |> update (ModeSwitched View) + Err r -> + let + _ = + Debug.log "ERR: ActionResult:" r + in + ( page, Cmd.none ) + + ( ApiMsg apiMsg, _, Nothing ) -> + let + _ = + Debug.log "rogue api msg !" apiMsg + in ( page, Cmd.none ) @@ -209,28 +317,95 @@ updatePage toPage toMsg ( subModel, subMsg ) = ) +applyUpdate : Api.Update -> Session.User -> Session.User +applyUpdate u user = + let + _ = + Debug.log "applyUpdate" u + + _ = + Debug.log "on" user + in + {- Note: DbUpdates always refer to the active player -} + case user of + Session.Player player wealthModel -> + case u of + Api.ItemRemoved item -> + --List.filter (\i -> i.id /= item.id) model.state.playerLoot + user + + Api.ItemAdded item -> + --{ model | state = { state | playerLoot = item :: model.state.playerLoot } } + user + + Api.WealthUpdated diff -> + let + wealth = + player.wealth + + _ = + Debug.log "updatePlayerWealth" diff + in + Session.Player + { player + | wealth = + Api.Player.Wealth + (wealth.cp + diff.cp) + (wealth.sp + diff.sp) + (wealth.gp + diff.gp) + (wealth.pp + diff.pp) + } + wealthModel + + Api.ClaimAdded claim -> + -- { model | claims = claim :: model.claims } + user + + Api.ClaimRemoved claim -> + -- { model | claims = List.filter (\c -> c.id /= claim.id) model.claims } + user + + Session.Admin -> + user + + -- CHANGE ROUTE -gotoHome session = - case Session.user session of - Session.Player _ _ -> - Chest.init session - |> updatePage Chest GotChestMsg - - Session.Admin -> - Admin.init session - |> updatePage Admin GotAdminMsg +initHome session = + Dashboard.init session + |> updatePage Dashboard GotDashboardMsg -gotoShop session = - Shop.init session - |> updatePage Shop GotShopMsg +gotoHome page = + case maybeSession page of + Nothing -> + ( page, Cmd.none ) + + Just session -> + Dashboard.init session + |> updatePage Dashboard GotDashboardMsg -gotoGroupChest session = - () +gotoShop page = + case maybeSession page of + Nothing -> + ( page, Cmd.none ) + + Just session -> + Shop.init session + |> updatePage Shop GotShopMsg + + +gotoGroupChest page = + case maybeSession page of + Nothing -> + ( page, Cmd.none ) + + Just session -> + GroupChest.init session + |> updatePage GroupChest GotGroupChestMsg gotoInventory session = diff --git a/src/Page/Chest.elm b/src/Page/Chest.elm index 7a1a57c..8431445 100644 --- a/src/Page/Chest.elm +++ b/src/Page/Chest.elm @@ -1,1306 +1,72 @@ -module Page.Chest exposing (Model, Msg, init, setContent, update, view) +module Page.Chest exposing (Chest, Msg, init, initCreate, initSelection, update, view) -import Api - exposing - ( Claims - , HttpResult - , Item - , Loot - , RequestData(..) - , confirmAction - ) -import Api.Player exposing (Player, Wealth, blankPlayer) -import Browser.Navigation as Nav -import Dict exposing (Dict) +import Api exposing (Item, Loot) 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 (..) +import Page.Chest.NewFromInventory as NewFromInventory +import Page.Chest.Selection as Selection +import Table -setContent : ChestContent -> Model -> Model -setContent content model = - update (SetContent content) model - |> Tuple.first +type alias RowRenderer msg = + Item -> List (Html msg) - -{- - type AddMsg - = NewItemAdded Item - | NewItemNameChanged String - | NewItemPriceChanged String - | SourceNameChanged String - | SetNewItem Item - | OpenModal - | FromListChanged String - | FromListConfirmed - | NewItemsFromList Loot (Maybe String) - - type SelectionMsg - = SetSelection (Maybe Selection) - | SwitchSelectionState Int - -- Buy/Sell modes - | PriceModifierChanged Int String - | WealthMsg Wealth.Msg - - - type Msg - = ApiMsg Api.Msg - | GotLoot Api.ToChest (HttpResult Loot) - | GotClaims (HttpResult Claims) - | GotPlayer (HttpResult Player) - | ClearNotification - | GotChestMsg ChestMsg - --} - - -type ActionMode +type Chest = View - | Sell - | Buy - | Grab - | Add + | Selection Selection.Model + | Create NewFromInventory.Model -type alias State = - { mode : ActionMode - , error : Maybe String - , notification : Maybe String +init = + View - -- Chest state - -- Buy/Sell loot - , priceModifiers : Dict Int Int - -- AddLoot - , showModal : Bool - , autoComplete : Loot - , newItem : Maybe Item - , sourceName : Maybe String - , itemList : Maybe (List String) +initCreate = + Create NewFromInventory.init - -- , inventoryItems : Loot - -- Fetched on init - , player : Player - , playerLoot : Loot - , groupLoot : Loot - , merchantLoot : Loot - , newLoot : Loot - } +initSelection = + Selection Selection.init -type alias Selection = - Set Int - - -type alias Model = - { session : Session - , state : State - - -- Chest - , shown : Route.ChestContent - , selection : Maybe Selection - , searchText : String - - -- Others - , wealth : Wealth.Model - , claims : Claims - } - - -init : Session -> ( Model, Cmd Msg ) -init session = - let - navKey = - Session.key session - - playerId = - case Session.user session of - Session.Player player _ -> - player.id - - Session.Admin -> - 0 - in - ( Model - session - (State - View - Nothing - Nothing - Dict.empty - False - [] - Nothing - Nothing - Nothing - blankPlayer - [] - [] - [] - [] - ) - Route.PlayerLoot - Nothing - "" - Wealth.init - [] - , Cmd.batch - [ Api.Player.get GotPlayer playerId - , Api.fetchClaimsOf GotClaims playerId - , Api.fetchLoot GotLoot (Api.OfPlayer playerId) - , Api.fetchLoot GotLoot Api.OfGroup - , Api.fetchLoot GotLoot Api.OfShop - ] - ) - - -viewNotification : Model -> Html Msg -viewNotification model = - div [ class "section" ] - [ case model.state.notification of - Just t -> - div [ class "notification is-success" ] - [ button [ class "delete", onClick ClearNotification ] [] - , text t - ] - - Nothing -> - text "" - , case model.state.error of - Just e -> - div [ class "notification is-danger" ] - [ button [ class "delete", onClick ClearNotification ] [] - , text e - ] - - Nothing -> - text "" - ] - - - --- PLAYER BAR - - -viewPlayerBar : 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" ] - (Wealth.view player.wealth wealthModel - ++ (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 - [] - ) - ) - |> Html.map WealthMsg - , div [ class "level-right" ] actionControls - ] - ] - ] - - - --- VIEW - - -type alias ItemRenderer = - Item -> List (Html Msg) - - -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 - - isSelected = - itemInSelection model.selection - - canSelect = - canSelectIn model.state.mode - - rowRenderer item = - case model.state.mode of - View -> - case ( model.state.player.id, model.shown ) of - ( 0, PlayerLoot ) -> - -- The group is viewing its chest - let - isClaimed = - itemInClaims model.claims - in - case isClaimed item of - True -> - [ renderIcon - { icon = "fas fa-praying-hands" - , size = "small" - , ratio = "1x" - } - ] - - False -> - [] - - ( _, GroupLoot ) -> - -- A player is viewing group chest - let - isClaimed = - itemInClaims model.claims - in - case isClaimed item of - True -> - [ renderIcon - { icon = "fas fa-praying-hands" - , size = "small" - , ratio = "1x" - } - ] - - False -> - [] - - _ -> - [] - - Buy -> - let - maybeMod = - Dict.get item.id model.state.priceModifiers - in - [ viewPriceWithModApplied - (Maybe.map (\i -> toFloatingMod i) maybeMod) - (toFloat item.base_price) - , if isSelected item then - viewPriceModifier item.id <| - case Dict.get item.id model.state.priceModifiers of - Just mod -> - String.fromInt mod - - Nothing -> - "0" - - else - text "" - ] - - Sell -> - let - maybeMod = - Dict.get item.id model.state.priceModifiers - in - [ viewPriceWithModApplied - (Maybe.map (\i -> toFloatingMod i) maybeMod) - (toFloat item.base_price / 2) - , if isSelected item then - viewPriceModifier item.id <| - case maybeMod of - Just mod -> - String.fromInt mod - - Nothing -> - "0" - - else - text "" - ] - - Grab -> - [ p [ class "level-item" ] [ text "Grab" ] - ] - - Add -> - [ p [ class "level-item" ] [ text <| "Valeur : " ++ String.fromInt item.base_price ++ "po" ] - ] - - filteredItems = - shownItems - |> List.filter - (\i -> String.toLower i.name |> String.contains (String.toLower model.searchText)) - in - [ viewPlayerBar model.state.player renderControls model.wealth - , main_ - [ class "container" ] - [ viewNotification model - , article - [ class "section" ] - (case model.state.mode of - Add -> - [ Html.map AddMsg (viewAddLoot model) - , viewLoot rowRenderer canSelect isSelected shownItems - ] - - _ -> - [ div [ class "columns" ] - [ div [ class "column is-one-third" ] [ p [ class "title" ] [ text header ] ] - , div [ class "column" ] [ viewSearchBar model.searchText ] - ] - , viewLoot rowRenderer canSelect isSelected filteredItems - ] - ) - ] - ] - - - -{- - - module ActionMode - - type Model - = Add - | Sell - | ... - - - rowRenderer mode = - ... - - controlButtons mode = - ... - - cancelAction toMsg mode = - ... - - confirmAction toMsg items mode = - ... - - - --} --- VIEW LOOT - - -viewLoot : ItemRenderer -> Bool -> (Item -> Bool) -> Loot -> Html Msg -viewLoot rowRenderer canSelect isSelected items = - table [ class "table is-fullwidth is-striped is-hoverable" ] - [ thead [ class "table-header" ] - [ th [] [ text "Nom" ] ] - , tbody [] <| List.map (viewItemTableRow isSelected canSelect rowRenderer) items - ] - - - --- Search Bar - - -viewSearchBar : String -> Html Msg -viewSearchBar textValue = - div [ class "field" ] - [ p [ class "control has-icons-left" ] - [ input - [ class "input" - , onInput SearchTextChanged - , value textValue - ] - [] - , span [ class "icon is-left" ] [ i [ class "fas fa-search" ] [] ] - ] - ] - - -toFloatingMod : Int -> Float -toFloatingMod percent = - (100 + Debug.log "toFloat" (toFloat percent)) / 100 - - - --- Renderers : Item -> Html Msg - - -viewPriceWithModApplied : Maybe Float -> Float -> Html Msg -viewPriceWithModApplied maybeMod basePrice = - case maybeMod of - Just mod -> - p [ class "level-item has-text-weight-bold" ] - [ (Debug.log "withMod" (String.fromFloat (basePrice * mod)) ++ "po") - |> text - ] - - Nothing -> - p [ class "level-item" ] [ (String.fromFloat basePrice ++ "po") |> text ] - - -viewPriceModifier : Int -> String -> Html Msg -viewPriceModifier id modValue = - div [ class "level-item field has-addons" ] - [ div [ class "control has-icons-left" ] - [ input - [ type_ "number" - , value modValue - , class "input is-small" - , size 3 - , style "width" "6em" - , Html.Attributes.min "-50" - , Html.Attributes.max "50" - , step "5" - , onInput (PriceModifierChanged id) - ] - [] - , span [ class "icon is-left" ] [ i [ class "fas fa-percent" ] [] ] - ] - ] - - -viewItemTableRow : (Item -> Bool) -> Bool -> ItemRenderer -> Item -> Html Msg -viewItemTableRow isSelected canSelect rowRenderer item = - let - rightLevel = - div [ class "level-right" ] <| - (if canSelect then - input - [ class "checkbox level-item" - , type_ "checkbox" - , checked <| isSelected item - , onCheck (\v -> SwitchSelectionState item.id) - ] - [] - - else - text "" - ) - :: rowRenderer item - in - tr [ classList [ ( "is-selected", isSelected item ) ] ] - [ td [] - [ label [ class "level checkbox" ] - [ div [ class "level-left" ] - [ p [ class "level-item" ] [ text item.name ] ] - , rightLevel - ] - ] - ] - - - --- Adding new loot --- - - -fromListModal isActive itemList = - div [ class "modal", classList [ ( "is-active", isActive ) ] ] - [ div [ class "modal-background" ] [] - , div [ class "modal-card" ] - [ header [ class "modal-card-head" ] [ p [ class "modal-card-title" ] [ text "Liste d'objets" ] ] - , div [ class "modal-card-body" ] - [ textarea [ class "textarea", value (String.join "\n" itemList), onInput FromListChanged ] [] - ] - , div [ class "modal-card-foot" ] - [ button [ class "button", onClick FromListConfirmed ] [ text "Ok" ] - , button [ class "button" ] [ text "Annuler" ] - ] - ] - ] - - -viewCompletionDropdown : Bool -> Loot -> Html AddMsg -viewCompletionDropdown shown results = - div - [ class "dropdown" - , classList [ ( "is-active", shown ) ] - ] - [ div [ class "dropdown-menu" ] - [ div [ class "dropdown-content" ] - (List.map - (\item -> - a - [ class "dropdown-item" - , onClick (SetNewItem item) - ] - [ text item.name ] - ) - results - ) - ] - ] - - -viewAddLoot : Model -> Html AddMsg -viewAddLoot model = - let - autoResults = - model.state.autoComplete - - showCompletionTips = - if List.length autoResults > 0 && newItem.base_price == 0 then - True - - else - False - - showModal = - model.state.showModal - - newItem = - case model.state.newItem of - Just item -> - item - - Nothing -> - Item 0 "" 0 - - itemList = - case model.state.itemList of - Just items -> - items - - Nothing -> - [] - - sourceName = - case model.state.sourceName of - Just name -> - name - - Nothing -> - "" - - itemIsValid = - if nameValid && priceValid then - True - - else - False - - nameValid = - newItem.name /= "" - - priceValid = - newItem.base_price > 0 - - doesNotYetExists = - newItem.id == 0 - in - div [ class "box is-primary" ] - [ fromListModal showModal itemList - , div [ class "field is-horizontal" ] - [ div [ class "field-label is-medium" ] [ label [ class "label" ] [ text "Source du loot" ] ] - , div [ class "field-body" ] - [ div [ class "field" ] - [ div [ class "control is-expanded" ] - [ input - [ class "input" - , type_ "text" - , name "source" - , value sourceName - , onInput SourceNameChanged - ] - [] - ] - , p [ class "help" ] [ text "Personnage, lieu ou événement d'où provient ce loot." ] - ] - ] - ] - , hr [] [] - , div [ class "field is-horizontal" ] - [ div [ class "field-label is-medium" ] [ label [ class "label" ] [ text "Nouvel objet" ] ] - , div [ class "field-body" ] - [ div [ class "field" ] - [ div [ class "control" ] - [ input - [ class "input" - , classList [ ( "is-success", nameValid ), ( "is-danger", not nameValid ) ] - , type_ "text" - , value newItem.name - , onInput NewItemNameChanged - ] - [] - ] - , if showCompletionTips then - viewCompletionDropdown showCompletionTips autoResults - - else - text "" - , p [ class "help has-text-warning" ] - [ text - (if nameValid && doesNotYetExists then - "Cet objet n'existe pas dans l'inventaire. Il y sera ajouté si vous validez." - - else - "" - ) - ] - ] - , div [ class "field is-narrow" ] - [ div [ class "field has-addons" ] - [ p [ class "control" ] [ a [ class "button is-static" ] [ text "PO" ] ] - , p [ class "control" ] - [ input - [ type_ "number" - , class "input" - , value <| String.fromInt newItem.base_price - , onInput NewItemPriceChanged - , classList [ ( "is-danger", not priceValid ), ( "is-success", priceValid ) ] - ] - [] - ] - ] - , p [ class "help has-text-danger" ] - [ text - (if priceValid then - "" - - else - "Vous devez renseigner le prix !" - ) - ] - ] - , div [ class "field is-narrow" ] - [ div [ class "control" ] - [ button - [ class "button" - , classList [ ( "is-primary", not doesNotYetExists ), ( "is-warning", doesNotYetExists ) ] - , disabled <| not itemIsValid - , onClick <| NewItemAdded newItem - ] - [ text "Ajouter au coffre" ] - ] - ] - ] - ] - , div [ class "field is-horizontal" ] - [ div [ class "field-label is-medium" ] [ label [ class "label" ] [ text "ou" ] ] - , div [ class "field-body" ] - [ div [ class "control" ] - [ button - [ class "button" - , onClick OpenModal - ] - [ text "Depuis une liste" ] - ] - ] - ] - ] - - - --- ACTION MODES --- - - -canSelectIn : ActionMode -> Bool -canSelectIn mode = - case mode of - Sell -> - True - - Buy -> - True - - Grab -> - True - - Add -> - False +view : Chest -> Loot -> Html Msg +view model loot = + case model of View -> - False + Table.view Table.name loot + |> Html.map GotViewMsg + Selection subModel -> + Selection.view subModel loot + |> Html.map GotSelectionMsg -viewControls : ActionMode -> ChestContent -> List (Html Msg) -viewControls mode content = - case mode of - View -> - 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 View) "Annuler" "times" "danger" - ] - - - --- UPDATE - - -type AddMsg - = NewItemAdded Item - | NewItemNameChanged String - | NewItemPriceChanged String - | SourceNameChanged String - | SetNewItem Item - | OpenModal - | FromListChanged String - | FromListConfirmed - | NewItemsFromList Loot (Maybe String) + Create subModel -> + NewFromInventory.view subModel + |> Html.map GotCreateMsg type Msg - = ApiMsg Api.Msg - | GotLoot Api.ToChest (HttpResult Loot) - | GotClaims (HttpResult Claims) - | GotPlayer (HttpResult Player) - -- Chest UI - | ClearNotification - | SetContent ChestContent - | SearchTextChanged String - -- Selection - | SetSelection (Maybe Selection) - | SwitchSelectionState Int - -- Action modes - | ModeSwitched ActionMode - | OnModeEnter ActionMode - | OnModeExit ActionMode - | ConfirmAction - -- Add loot - | AddMsg AddMsg - -- Buy/Sell modes - | PriceModifierChanged Int String - | WealthMsg Wealth.Msg + = GotCreateMsg NewFromInventory.Msg + | GotSelectionMsg Selection.Msg + | GotViewMsg Never - --- Edit wealth ---| EditWealth ---| AmountChanged String ---| ConfirmEditWealth - - -insensitiveContains : String -> String -> Bool -insensitiveContains substring string = - String.contains (String.toLower substring) (String.toLower string) - - -switchEditWealth state = - { state | editWealth = not state.editWealth } - - -setWealthAmount state amount = - { state - | wealthAmount = String.replace "," "." amount - } - - -update : Msg -> Model -> ( Model, Cmd Msg ) +update : Msg -> Chest -> ( Chest, Cmd Msg ) update msg model = - case msg 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 -> - Cmd.map ApiMsg <| - Api.confirmAction - (String.fromInt model.state.player.id) - (Api.WealthPayload a) + case ( msg, model ) of + ( GotCreateMsg subMsg, Create subModel ) -> + NewFromInventory.update subMsg subModel + |> updateChest GotCreateMsg Create - Nothing -> - Cmd.none - ) + ( GotSelectionMsg subMsg, Selection subModel ) -> + Selection.update subMsg subModel + |> updateChest GotSelectionMsg Selection - _ -> - ( { model | wealth = Wealth.update wealthMsg model.wealth }, Cmd.none ) + _ -> + ( model, Cmd.none ) - PriceModifierChanged id value -> - let - state = - model.state - in - ( { model - | state = - { state - | priceModifiers = - Dict.insert - id - (case String.toInt value of - Just i -> - i - Nothing -> - 0 - ) - model.state.priceModifiers - } - } - , Cmd.none - ) - - AddMsg addMsg -> - case addMsg of - NewItemsFromList newLoot maybeErrors -> - let - state = - model.state - - error = - case maybeErrors of - Just errors -> - (String.lines errors - |> String.join "" - ) - ++ "n'ont pas pu être ajoutés.\n Faites le manuellement !" - |> Just - - Nothing -> - Nothing - in - ( { model - | state = - { state - | itemList = Nothing - , newLoot = newLoot ++ model.state.newLoot - , error = error - } - } - , Cmd.none - ) - - FromListChanged newText -> - let - state = - model.state - - itemList = - String.lines newText - in - ( { model | state = { state | itemList = Just itemList } } - , Cmd.none - ) - - FromListConfirmed -> - let - state = - model.state - - itemList = - Maybe.withDefault [] model.state.itemList - in - ( { model | state = { state | showModal = False } } - , Cmd.map AddMsg <| Api.checkList NewItemsFromList itemList - ) - - OpenModal -> - let - state = - model.state - in - ( { model | state = { state | showModal = True } }, Cmd.none ) - - NewItemAdded item -> - let - state = - model.state - in - ( { model | state = { state | newLoot = item :: state.newLoot } }, Cmd.none ) - - SetNewItem item -> - let - state = - model.state - in - ( { model | state = { state | newItem = Just item } }, Cmd.none ) - - SourceNameChanged name -> - let - state = - model.state - in - ( { model | state = { state | sourceName = Just name } } - , Cmd.none - ) - - NewItemPriceChanged price -> - case String.toInt price of - Just newPrice -> - let - newItem = - case model.state.newItem of - Just item -> - { item | base_price = newPrice } - - Nothing -> - Item 0 "" newPrice - in - update (AddMsg (SetNewItem newItem)) model - - Nothing -> - ( model, Cmd.none ) - - NewItemNameChanged itemName -> - let - state = - model.state - - -- Recalculate auto-completion results - matches = - if itemName == "" then - [] - - else - -- TODO: For now, merchantLoot *IS* the inventory - model.state.merchantLoot - |> List.filter (\i -> insensitiveContains itemName i.name) - in - { model | state = { state | autoComplete = matches } } - -- Update newItem field and erase other (outdated) values - |> update - (AddMsg (SetNewItem <| Item 0 itemName 0)) - - 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 View) - - Err r -> - ( setError (Debug.toString r) model, Cmd.none ) - - SetContent content -> - if content == NewLoot then - { model | shown = content } - |> update (ModeSwitched Add) - - else - ( { 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 - ) - - OnModeEnter mode -> - update - (SetSelection - (case ( mode, canSelectIn mode ) of - ( _, False ) -> - Nothing - - -- Currently claimed object are initially selected - ( Grab, _ ) -> - Just (Set.fromList <| List.map (\c -> c.loot_id) model.claims) - - ( _, True ) -> - Just Set.empty - ) - ) - model - - OnModeExit mode -> - if mode == Add || mode == Buy then - -- Redirect to PlayerLoot view - ( model, Nav.pushUrl (Session.key model.session) "/" ) - - else - ( model, Cmd.none ) - - ModeSwitched newMode -> - let - state = - model.state - - -- We chain exit old mode and enter new mode updates - ( exit, exit_cmd ) = - update (OnModeExit model.state.mode) model - - ( entered, enter_cmd ) = - update (OnModeEnter newMode) exit - in - ( { entered | state = { state | mode = newMode } } - , Cmd.batch [ exit_cmd, enter_cmd ] - ) - - ConfirmAction -> - let - items = - getSelectedItems model - - maybeData = - case model.state.mode of - Add -> - Just <| - Api.AddPayload - (Maybe.withDefault - "nouveau loot" - model.state.sourceName - ) - (selectContent model) - - Buy -> - let - modList = - List.map - (\item -> - Dict.get item.id model.state.priceModifiers - |> Maybe.map (\i -> toFloatingMod i) - ) - items - in - Just <| Api.BuyPayload items Nothing modList - - Sell -> - let - modList = - List.map - (\item -> - Dict.get item.id model.state.priceModifiers - |> Maybe.map (\i -> toFloatingMod i) - ) - items - in - Just <| Api.SellPayload items Nothing modList [] - - Grab -> - Just <| Api.GrabPayload items - - View -> - Nothing - in - ( model - , case maybeData of - Just data -> - Cmd.map ApiMsg <| - Api.confirmAction - (String.fromInt model.state.player.id) - data - - Nothing -> - Cmd.none - ) - - ClearNotification -> - ( setNotification Nothing model, Cmd.none ) - - SwitchSelectionState id -> - ( { model | selection = switchSelectionState id model.selection }, Cmd.none ) - - SetSelection new -> - ( { model | selection = new }, Cmd.none ) - - SearchTextChanged search -> - ( { model | searchText = search }, 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 - Api.OfPlayer _ -> - { model | state = { state | playerLoot = loot } } - - Api.OfGroup -> - { model | state = { state | groupLoot = loot } } - - Api.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 - - newError = - if error == "" then - Nothing - - else - Just error - in - { model - | state = - { state | error = newError } - } - - -applyUpdate : Api.Update -> Model -> Model -applyUpdate u model = - {- Note: DbUpdates always refer to the active player's loot -} - 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 = - Api.Player.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 } - - - --- Selection --- Get list of selected items - - -getSelectedItems : Model -> Loot -getSelectedItems model = - selectContent 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 : Model -> List Item -selectContent model = - case model.shown of - NewLoot -> - model.state.newLoot - - MerchantLoot -> - model.state.merchantLoot - - PlayerLoot -> - model.state.playerLoot - - GroupLoot -> - model.state.groupLoot +updateChest toMsg toChest ( model, cmd ) = + ( toChest model + , Cmd.map toMsg cmd + ) diff --git a/src/Page/Chest.elm.old b/src/Page/Chest.elm.old new file mode 100644 index 0000000..eed3302 --- /dev/null +++ b/src/Page/Chest.elm.old @@ -0,0 +1,1301 @@ +module Page.Chest exposing (Model, Msg, init, setContent, update, view) + +import Api + exposing + ( Claims + , HttpResult + , Item + , Loot + , RequestData(..) + , confirmAction + ) +import Api.Player exposing (Player, Wealth, blankPlayer) +import Browser.Navigation as Nav +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 (..) + + +setContent : ChestContent -> Model -> Model +setContent content model = + update (SetContent content) model + |> Tuple.first + + + +{- + type AddMsg + = NewItemAdded Item + | NewItemNameChanged String + | NewItemPriceChanged String + | SourceNameChanged String + | SetNewItem Item + | OpenModal + | FromListChanged String + | FromListConfirmed + | NewItemsFromList Loot (Maybe String) + + type SelectionMsg + = SetSelection (Maybe Selection) + | SwitchSelectionState Int + -- Buy/Sell modes + | PriceModifierChanged Int String + | WealthMsg Wealth.Msg + + + type Msg + = ApiMsg Api.Msg + | GotLoot Api.ToChest (HttpResult Loot) + | GotClaims (HttpResult Claims) + | GotPlayer (HttpResult Player) + | ClearNotification + | GotChestMsg ChestMsg + +-} + + +type ActionMode + = View + | Sell + | Buy + | Grab + | Add + + +type alias State = + { mode : ActionMode + , error : Maybe String + , notification : Maybe String + + -- Chest state + -- Buy/Sell loot + , priceModifiers : Dict Int Int + + -- AddLoot + , showModal : Bool + , autoComplete : Loot + , newItem : Maybe Item + , sourceName : Maybe String + , itemList : Maybe (List String) + + -- , inventoryItems : Loot + -- Fetched on init + , player : Player + , playerLoot : Loot + , groupLoot : Loot + , merchantLoot : Loot + , newLoot : Loot + } + + +type alias Selection = + Set Int + + +type alias Model = + { session : Session + , state : State + + -- Chest + , shown : Route.ChestContent + , selection : Maybe Selection + , searchText : String + + -- Others + , wealth : Wealth.Model + , claims : Claims + } + + +init : Session -> ( Model, Cmd Msg ) +init session = + let + navKey = + Session.key session + + playerId = + case Session.user session of + Session.Player player _ -> + player.id + + Session.Admin -> + 0 + in + ( Model + session + (State + View + Nothing + Nothing + Dict.empty + False + [] + Nothing + Nothing + Nothing + blankPlayer + [] + [] + [] + [] + ) + Route.PlayerLoot + Nothing + "" + Wealth.init + [] + , Cmd.batch + [ Api.Player.get GotPlayer playerId + , Api.fetchClaimsOf GotClaims playerId + , Api.fetchLoot GotLoot (Api.OfPlayer playerId) + , Api.fetchLoot GotLoot Api.OfGroup + , Api.fetchLoot GotLoot Api.OfShop + ] + ) + + +viewNotification : Model -> Html Msg +viewNotification model = + div [ class "section" ] + [ case model.state.notification of + Just t -> + div [ class "notification is-success" ] + [ button [ class "delete", onClick ClearNotification ] [] + , text t + ] + + Nothing -> + text "" + , case model.state.error of + Just e -> + div [ class "notification is-danger" ] + [ button [ class "delete", onClick ClearNotification ] [] + , text e + ] + + Nothing -> + text "" + ] + + + +-- PLAYER BAR + + +viewPlayerBar : 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" ] + (Wealth.view player.wealth wealthModel + ++ (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 + [] + ) + ) + |> Html.map WealthMsg + , div [ class "level-right" ] actionControls + ] + ] + ] + + + +-- VIEW + + +type alias ItemRenderer = + Item -> List (Html Msg) + + +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 + + isSelected = + itemInSelection model.selection + + canSelect = + canSelectIn model.state.mode + + rowRenderer item = + case model.state.mode of + View -> + case ( model.state.player.id, model.shown ) of + ( 0, PlayerLoot ) -> + -- The group is viewing its chest + let + isClaimed = + itemInClaims model.claims + in + case isClaimed item of + True -> + [ renderIcon + { icon = "fas fa-praying-hands" + , size = "small" + , ratio = "1x" + } + ] + + False -> + [] + + ( _, GroupLoot ) -> + -- A player is viewing group chest + let + isClaimed = + itemInClaims model.claims + in + case isClaimed item of + True -> + [ renderIcon + { icon = "fas fa-praying-hands" + , size = "small" + , ratio = "1x" + } + ] + + False -> + [] + + _ -> + [] + + Buy -> + let + maybeMod = + Dict.get item.id model.state.priceModifiers + in + [ viewPriceWithModApplied + (Maybe.map (\i -> toFloatingMod i) maybeMod) + (toFloat item.base_price) + , if isSelected item then + viewPriceModifier item.id <| + case Dict.get item.id model.state.priceModifiers of + Just mod -> + String.fromInt mod + + Nothing -> + "0" + + else + text "" + ] + + Sell -> + let + maybeMod = + Dict.get item.id model.state.priceModifiers + in + [ viewPriceWithModApplied + (Maybe.map (\i -> toFloatingMod i) maybeMod) + (toFloat item.base_price / 2) + , if isSelected item then + viewPriceModifier item.id <| + case maybeMod of + Just mod -> + String.fromInt mod + + Nothing -> + "0" + + else + text "" + ] + + Grab -> + [ p [ class "level-item" ] [ text "Grab" ] + ] + + Add -> + [ p [ class "level-item" ] [ text <| "Valeur : " ++ String.fromInt item.base_price ++ "po" ] + ] + + filteredItems = + shownItems + |> List.filter + (\i -> String.toLower i.name |> String.contains (String.toLower model.searchText)) + in + [ viewPlayerBar model.state.player renderControls model.wealth + , main_ + [ class "container" ] + [ viewNotification model + , article + [ class "section" ] + (case model.state.mode of + Add -> + [ Html.map AddMsg (viewAddLoot model) + , viewLoot rowRenderer canSelect isSelected shownItems + ] + + _ -> + [ div [ class "columns" ] + [ div [ class "column is-one-third" ] [ p [ class "title" ] [ text header ] ] + , div [ class "column" ] [ viewSearchBar model.searchText ] + ] + , viewLoot rowRenderer canSelect isSelected filteredItems + ] + ) + ] + ] + + + +{- + + module ActionMode + + type Model + = Add + | Sell + | ... + + + rowRenderer mode = + ... + + controlButtons mode = + ... + + cancelAction toMsg mode = + ... + + confirmAction toMsg items mode = + ... + + + +-} +-- VIEW LOOT + + +viewLoot : ItemRenderer -> Bool -> (Item -> Bool) -> Loot -> Html Msg +viewLoot rowRenderer canSelect isSelected items = + table [ class "table is-fullwidth is-striped is-hoverable" ] + [ thead [ class "table-header" ] + [ th [] [ text "Nom" ] ] + , tbody [] <| List.map (viewItemTableRow isSelected canSelect rowRenderer) items + ] + + + +-- Search Bar + + +viewSearchBar : String -> Html Msg +viewSearchBar textValue = + div [ class "field" ] + [ p [ class "control has-icons-left" ] + [ input + [ class "input" + , onInput SearchTextChanged + , value textValue + ] + [] + , span [ class "icon is-left" ] [ i [ class "fas fa-search" ] [] ] + ] + ] + + +toFloatingMod : Int -> Float +toFloatingMod percent = + (100 + Debug.log "toFloat" (toFloat percent)) / 100 + + + +-- Renderers : Item -> Html Msg + + +viewPriceWithModApplied : Maybe Float -> Float -> Html Msg +viewPriceWithModApplied maybeMod basePrice = + case maybeMod of + Just mod -> + p [ class "level-item has-text-weight-bold" ] + [ (Debug.log "withMod" (String.fromFloat (basePrice * mod)) ++ "po") + |> text + ] + + Nothing -> + p [ class "level-item" ] [ (String.fromFloat basePrice ++ "po") |> text ] + + +viewPriceModifier : Int -> String -> Html Msg +viewPriceModifier id modValue = + div [ class "level-item field has-addons" ] + [ div [ class "control has-icons-left" ] + [ input + [ type_ "number" + , value modValue + , class "input is-small" + , size 3 + , style "width" "6em" + , Html.Attributes.min "-50" + , Html.Attributes.max "50" + , step "5" + , onInput (PriceModifierChanged id) + ] + [] + , span [ class "icon is-left" ] [ i [ class "fas fa-percent" ] [] ] + ] + ] + + +viewItemTableRow : (Item -> Bool) -> Bool -> ItemRenderer -> Item -> Html Msg +viewItemTableRow isSelected canSelect rowRenderer item = + let + rightLevel = + div [ class "level-right" ] <| + (if canSelect then + input + [ class "checkbox level-item" + , type_ "checkbox" + , checked <| isSelected item + , onCheck (\v -> SwitchSelectionState item.id) + ] + [] + + else + text "" + ) + :: rowRenderer item + in + tr [ classList [ ( "is-selected", isSelected item ) ] ] + [ td [] + [ label [ class "level checkbox" ] + [ div [ class "level-left" ] + [ p [ class "level-item" ] [ text item.name ] ] + , rightLevel + ] + ] + ] + + + +-- Adding new loot +-- + + +fromListModal isActive itemList = + div [ class "modal", classList [ ( "is-active", isActive ) ] ] + [ div [ class "modal-background" ] [] + , div [ class "modal-card" ] + [ header [ class "modal-card-head" ] [ p [ class "modal-card-title" ] [ text "Liste d'objets" ] ] + , div [ class "modal-card-body" ] + [ textarea [ class "textarea", value (String.join "\n" itemList), onInput FromListChanged ] [] + ] + , div [ class "modal-card-foot" ] + [ button [ class "button", onClick FromListConfirmed ] [ text "Ok" ] + , button [ class "button" ] [ text "Annuler" ] + ] + ] + ] + + +viewCompletionDropdown : Bool -> Loot -> Html AddMsg +viewCompletionDropdown shown results = + div + [ class "dropdown" + , classList [ ( "is-active", shown ) ] + ] + [ div [ class "dropdown-menu" ] + [ div [ class "dropdown-content" ] + (List.map + (\item -> + a + [ class "dropdown-item" + , onClick (SetNewItem item) + ] + [ text item.name ] + ) + results + ) + ] + ] + + +viewAddLoot : Model -> Html AddMsg +viewAddLoot model = + let + autoResults = + model.state.autoComplete + + showCompletionTips = + if List.length autoResults > 0 && newItem.base_price == 0 then + True + + else + False + + showModal = + model.state.showModal + + newItem = + case model.state.newItem of + Just item -> + item + + Nothing -> + Item 0 "" 0 + + itemList = + case model.state.itemList of + Just items -> + items + + Nothing -> + [] + + sourceName = + case model.state.sourceName of + Just name -> + name + + Nothing -> + "" + + itemIsValid = + if nameValid && priceValid then + True + + else + False + + nameValid = + newItem.name /= "" + + priceValid = + newItem.base_price > 0 + + doesNotYetExists = + newItem.id == 0 + in + div [ class "box is-primary" ] + [ fromListModal showModal itemList + , div [ class "field is-horizontal" ] + [ div [ class "field-label is-medium" ] [ label [ class "label" ] [ text "Source du loot" ] ] + , div [ class "field-body" ] + [ div [ class "field" ] + [ div [ class "control is-expanded" ] + [ input + [ class "input" + , type_ "text" + , name "source" + , value sourceName + , onInput SourceNameChanged + ] + [] + ] + , p [ class "help" ] [ text "Personnage, lieu ou événement d'où provient ce loot." ] + ] + ] + ] + , hr [] [] + , div [ class "field is-horizontal" ] + [ div [ class "field-label is-medium" ] [ label [ class "label" ] [ text "Nouvel objet" ] ] + , div [ class "field-body" ] + [ div [ class "field" ] + [ div [ class "control" ] + [ input + [ class "input" + , classList [ ( "is-success", nameValid ), ( "is-danger", not nameValid ) ] + , type_ "text" + , value newItem.name + , onInput NewItemNameChanged + ] + [] + ] + , if showCompletionTips then + viewCompletionDropdown showCompletionTips autoResults + + else + text "" + , p [ class "help has-text-warning" ] + [ text + (if nameValid && doesNotYetExists then + "Cet objet n'existe pas dans l'inventaire. Il y sera ajouté si vous validez." + + else + "" + ) + ] + ] + , div [ class "field is-narrow" ] + [ div [ class "field has-addons" ] + [ p [ class "control" ] [ a [ class "button is-static" ] [ text "PO" ] ] + , p [ class "control" ] + [ input + [ type_ "number" + , class "input" + , value <| String.fromInt newItem.base_price + , onInput NewItemPriceChanged + , classList [ ( "is-danger", not priceValid ), ( "is-success", priceValid ) ] + ] + [] + ] + ] + , p [ class "help has-text-danger" ] + [ text + (if priceValid then + "" + + else + "Vous devez renseigner le prix !" + ) + ] + ] + , div [ class "field is-narrow" ] + [ div [ class "control" ] + [ button + [ class "button" + , classList [ ( "is-primary", not doesNotYetExists ), ( "is-warning", doesNotYetExists ) ] + , disabled <| not itemIsValid + , onClick <| NewItemAdded newItem + ] + [ text "Ajouter au coffre" ] + ] + ] + ] + ] + , div [ class "field is-horizontal" ] + [ div [ class "field-label is-medium" ] [ label [ class "label" ] [ text "ou" ] ] + , div [ class "field-body" ] + [ div [ class "control" ] + [ button + [ class "button" + , onClick OpenModal + ] + [ text "Depuis une liste" ] + ] + ] + ] + ] + + + +-- ACTION MODES +-- + + +canSelectIn : ActionMode -> Bool +canSelectIn mode = + case mode of + Sell -> + True + + Buy -> + True + + Grab -> + True + + Add -> + False + + View -> + False + + +viewControls : ActionMode -> ChestContent -> List (Html Msg) +viewControls mode content = + case mode of + View -> + 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 View) "Annuler" "times" "danger" + ] + + + +-- UPDATE + + +type AddMsg + = NewItemAdded Item + | NewItemNameChanged String + | NewItemPriceChanged String + | SourceNameChanged String + | SetNewItem Item + | OpenModal + | FromListChanged String + | FromListConfirmed + | NewItemsFromList Loot (Maybe String) + + +type Msg + = ApiMsg Api.Msg + | GotLoot Api.ToChest (HttpResult Loot) + | GotClaims (HttpResult Claims) + | GotPlayer (HttpResult Player) + -- Chest UI + | ClearNotification + | SetContent ChestContent + | SearchTextChanged String + -- Selection + | SetSelection (Maybe Selection) + | SwitchSelectionState Int + -- Action modes + | ModeSwitched ActionMode + | OnModeEnter ActionMode + | OnModeExit ActionMode + | ConfirmAction + -- Add loot + | AddMsg AddMsg + -- Buy/Sell modes + | PriceModifierChanged Int String + | WealthMsg Wealth.Msg + + + +-- Edit wealth +--| EditWealth +--| AmountChanged String +--| ConfirmEditWealth + + +insensitiveContains : String -> String -> Bool +insensitiveContains substring string = + String.contains (String.toLower substring) (String.toLower string) + + +switchEditWealth state = + { state | editWealth = not state.editWealth } + + +setWealthAmount state amount = + { state + | wealthAmount = String.replace "," "." amount + } + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + WealthMsg wealthMsg -> + let + ( newWealth, edited ) = + Wealth.update wealthMsg model.wealth + in + ( { model | wealth = newWealth } + , case edited of + Just a -> + Cmd.map ApiMsg <| + Api.confirmAction + (String.fromInt model.state.player.id) + (Api.WealthPayload a) + + Nothing -> + Cmd.none + ) + + PriceModifierChanged id value -> + let + state = + model.state + in + ( { model + | state = + { state + | priceModifiers = + Dict.insert + id + (case String.toInt value of + Just i -> + i + + Nothing -> + 0 + ) + model.state.priceModifiers + } + } + , Cmd.none + ) + + AddMsg addMsg -> + case addMsg of + NewItemsFromList newLoot maybeErrors -> + let + state = + model.state + + error = + case maybeErrors of + Just errors -> + (String.lines errors + |> String.join "" + ) + ++ "n'ont pas pu être ajoutés.\n Faites le manuellement !" + |> Just + + Nothing -> + Nothing + in + ( { model + | state = + { state + | itemList = Nothing + , newLoot = newLoot ++ model.state.newLoot + , error = error + } + } + , Cmd.none + ) + + FromListChanged newText -> + let + state = + model.state + + itemList = + String.lines newText + in + ( { model | state = { state | itemList = Just itemList } } + , Cmd.none + ) + + FromListConfirmed -> + let + state = + model.state + + itemList = + Maybe.withDefault [] model.state.itemList + in + ( { model | state = { state | showModal = False } } + , Cmd.map AddMsg <| Api.checkList NewItemsFromList itemList + ) + + OpenModal -> + let + state = + model.state + in + ( { model | state = { state | showModal = True } }, Cmd.none ) + + NewItemAdded item -> + let + state = + model.state + in + ( { model | state = { state | newLoot = item :: state.newLoot } }, Cmd.none ) + + SetNewItem item -> + let + state = + model.state + in + ( { model | state = { state | newItem = Just item } }, Cmd.none ) + + SourceNameChanged name -> + let + state = + model.state + in + ( { model | state = { state | sourceName = Just name } } + , Cmd.none + ) + + NewItemPriceChanged price -> + case String.toInt price of + Just newPrice -> + let + newItem = + case model.state.newItem of + Just item -> + { item | base_price = newPrice } + + Nothing -> + Item 0 "" newPrice + in + update (AddMsg (SetNewItem newItem)) model + + Nothing -> + ( model, Cmd.none ) + + NewItemNameChanged itemName -> + let + state = + model.state + + -- Recalculate auto-completion results + matches = + if itemName == "" then + [] + + else + -- TODO: For now, merchantLoot *IS* the inventory + model.state.merchantLoot + |> List.filter (\i -> insensitiveContains itemName i.name) + in + { model | state = { state | autoComplete = matches } } + -- Update newItem field and erase other (outdated) values + |> update + (AddMsg (SetNewItem <| Item 0 itemName 0)) + + 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 View) + + Err r -> + ( setError (Debug.toString r) model, Cmd.none ) + + SetContent content -> + if content == NewLoot then + { model | shown = content } + |> update (ModeSwitched Add) + + else + ( { 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 + ) + + OnModeEnter mode -> + update + (SetSelection + (case ( mode, canSelectIn mode ) of + ( _, False ) -> + Nothing + + -- Currently claimed object are initially selected + ( Grab, _ ) -> + Just (Set.fromList <| List.map (\c -> c.loot_id) model.claims) + + ( _, True ) -> + Just Set.empty + ) + ) + model + + OnModeExit mode -> + if mode == Add || mode == Buy then + -- Redirect to PlayerLoot view + ( model, Nav.pushUrl (Session.key model.session) "/" ) + + else + ( model, Cmd.none ) + + ModeSwitched newMode -> + let + state = + model.state + + -- We chain exit old mode and enter new mode updates + ( exit, exit_cmd ) = + update (OnModeExit model.state.mode) model + + ( entered, enter_cmd ) = + update (OnModeEnter newMode) exit + in + ( { entered | state = { state | mode = newMode } } + , Cmd.batch [ exit_cmd, enter_cmd ] + ) + + ConfirmAction -> + let + items = + getSelectedItems model + + maybeData = + case model.state.mode of + Add -> + Just <| + Api.AddPayload + (Maybe.withDefault + "nouveau loot" + model.state.sourceName + ) + (selectContent model) + + Buy -> + let + modList = + List.map + (\item -> + Dict.get item.id model.state.priceModifiers + |> Maybe.map (\i -> toFloatingMod i) + ) + items + in + Just <| Api.BuyPayload items Nothing modList + + Sell -> + let + modList = + List.map + (\item -> + Dict.get item.id model.state.priceModifiers + |> Maybe.map (\i -> toFloatingMod i) + ) + items + in + Just <| Api.SellPayload items Nothing modList [] + + Grab -> + Just <| Api.GrabPayload items + + View -> + Nothing + in + ( model + , case maybeData of + Just data -> + Cmd.map ApiMsg <| + Api.confirmAction + (String.fromInt model.state.player.id) + data + + Nothing -> + Cmd.none + ) + + ClearNotification -> + ( setNotification Nothing model, Cmd.none ) + + SwitchSelectionState id -> + ( { model | selection = switchSelectionState id model.selection }, Cmd.none ) + + SetSelection new -> + ( { model | selection = new }, Cmd.none ) + + SearchTextChanged search -> + ( { model | searchText = search }, 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 + Api.OfPlayer _ -> + { model | state = { state | playerLoot = loot } } + + Api.OfGroup -> + { model | state = { state | groupLoot = loot } } + + Api.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 + + newError = + if error == "" then + Nothing + + else + Just error + in + { model + | state = + { state | error = newError } + } + + +applyUpdate : Api.Update -> Model -> Model +applyUpdate u model = + {- Note: DbUpdates always refer to the active player's loot -} + 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 = + Api.Player.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 } + + + +-- Selection +-- Get list of selected items + + +getSelectedItems : Model -> Loot +getSelectedItems model = + selectContent 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 : Model -> List Item +selectContent model = + case model.shown of + NewLoot -> + model.state.newLoot + + MerchantLoot -> + model.state.merchantLoot + + PlayerLoot -> + model.state.playerLoot + + GroupLoot -> + model.state.groupLoot diff --git a/src/Page/Chest/NewFromInventory.elm b/src/Page/Chest/NewFromInventory.elm index 28a720f..af9d1f1 100644 --- a/src/Page/Chest/NewFromInventory.elm +++ b/src/Page/Chest/NewFromInventory.elm @@ -7,11 +7,6 @@ import Html.Events exposing (..) import Table -type ExitStatus - = Confirmed Loot - | Canceled - - type alias Model = { itemList : String , invalidItems : Loot @@ -27,30 +22,10 @@ init = [] -view : Model -> ( Html Msg, List (Html Msg) ) +view : Model -> Html Msg view model = - let - allLootValid = - if List.length model.invalidItems + List.length model.validItems == 0 then - False - - else - List.all itemIsValid model.invalidItems - in - ( div [ class "buttons" ] - [ button - [ class "button" - , disabled <| not allLootValid - , onClick ConfirmClicked - ] - [ text "Ok" ] - , button - [ class "button" - , onClick CancelClicked - ] - [ text "Annuler" ] - ] - , [ div [ class "section" ] + article [] + [ div [ class "section" ] [ textarea [ class "textarea" , value model.itemList @@ -64,10 +39,20 @@ view model = ] [ text "Mettre dans le coffre" ] ] - , div [ class "section" ] - [ model.validItems ++ model.invalidItems |> Table.view viewOrEditRenderer ] - ] - ) + , div [ class "section" ] + [ model.validItems + ++ model.invalidItems + |> Table.view (Table.renderRowLevel viewOrEditRenderer (\i -> [])) + ] + ] + + +allValid model = + if List.length model.invalidItems + List.length model.validItems == 0 then + False + + else + List.all itemIsValid model.invalidItems itemIsValid item = @@ -111,7 +96,7 @@ viewOrEditRenderer item = ] else - Table.name item + [ p [] [ text <| .name item ] ] type Msg @@ -120,24 +105,20 @@ type Msg | InvalidItemNameChanged Int String | InvalidItemPriceChanged Int String | GotCheckedItems Loot (Maybe String) - | ConfirmClicked - | CancelClicked -update : Msg -> Model -> ( Model, Cmd Msg, Maybe ExitStatus ) +update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of ItemListInput newList -> ( { model | itemList = newList } , Cmd.none - , Nothing ) ItemListSend -> ( { model | itemList = "" } , Api.checkList GotCheckedItems <| String.split "\n" model.itemList - , Nothing ) GotCheckedItems valid errors -> @@ -163,7 +144,6 @@ update msg model = , validItems = valid ++ model.validItems } , Cmd.none - , Nothing ) InvalidItemNameChanged id newName -> @@ -173,7 +153,6 @@ update msg model = |> editItem (\item -> { item | name = newName }) id } , Cmd.none - , Nothing ) InvalidItemPriceChanged id newPrice -> @@ -186,15 +165,8 @@ update msg model = model.invalidItems |> editItem (\item -> { item | base_price = price }) id } , Cmd.none - , Nothing ) - ConfirmClicked -> - ( model, Cmd.none, Just (Confirmed <| allLoot model) ) - - CancelClicked -> - ( model, Cmd.none, Just Canceled ) - allLoot model = model.invalidItems ++ model.validItems diff --git a/src/Page/Chest/Selection.elm b/src/Page/Chest/Selection.elm new file mode 100644 index 0000000..99550c8 --- /dev/null +++ b/src/Page/Chest/Selection.elm @@ -0,0 +1,37 @@ +module Page.Chest.Selection exposing (Model, Msg, init, update, view) + +import Api exposing (Loot) +import Html exposing (..) +import Html.Attributes exposing (..) +import Table + + +type Selection + = Selection + + +type Model + = Model Selection + + +init = + Model Selection + + +view : Model -> Loot -> Html Msg +view model loot = + Table.view + (Table.renderRowLevel + (\item -> [ p [] [ text <| item.name ++ "selectable" ] ]) + (\item -> [ input [ type_ "checkbox" ] [] ]) + ) + loot + + +type Msg + = Msg + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + ( model, Cmd.none ) diff --git a/src/Page/Dashboard.elm b/src/Page/Dashboard.elm index e69de29..337cf79 100644 --- a/src/Page/Dashboard.elm +++ b/src/Page/Dashboard.elm @@ -0,0 +1,49 @@ +module Page.Dashboard exposing (Model, Msg, init, update, view) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Page.Chest as Chest exposing (Chest) +import Session exposing (Session) + + +type alias Model = + { session : Session + , chest : Mode + } + + +type Mode + = View Chest + + +init : Session -> ( Model, Cmd Msg ) +init session = + ( Model session (View Chest.init) + , Cmd.none + ) + + +view : Model -> ( Html Msg, List (Html Msg) ) +view model = + case Session.user model.session of + Session.Player player _ -> + ( text "" + , [ if player.id == 0 then + p [] [ text "Groupe" ] + + else + p [] [ text "Joueur" ] + ] + ) + + Session.Admin -> + ( text "", [ p [] [ text "Joueur" ] ] ) + + +type Msg + = Msg + + +update msg model = + ( model, Cmd.none ) diff --git a/src/Page/GroupChest.elm b/src/Page/GroupChest.elm index ed37161..ad459b6 100644 --- a/src/Page/GroupChest.elm +++ b/src/Page/GroupChest.elm @@ -41,8 +41,8 @@ view model = Session.Admin -> text "" - Session.Player id -> - if id == 0 then + Session.Player p _ -> + if p.id == 0 then button [ class "button" ] [ text "Vendre" ] else diff --git a/src/Page/Shop.elm b/src/Page/Shop.elm index 641582d..d46d18b 100644 --- a/src/Page/Shop.elm +++ b/src/Page/Shop.elm @@ -5,7 +5,9 @@ import Dict exposing (Dict) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) +import Page.Chest as Chest exposing (Chest) import Page.Chest.NewFromInventory as NewChest +import Page.Chest.Selection as Selection import Session exposing (Session, getSession) import Set exposing (Set) import Table @@ -13,20 +15,46 @@ import Table type alias Model = { session : Session - , state : State + , loot : Status Loot + , chest : Mode } -type State +type Status a = Loading | LoadError String - | View Loot - | Refresh NewChest.Model - | Sending + | Loaded a + + +type Mode + = View Chest + | Buy Chest + | Refresh Chest + + +getChest mode = + case mode of + View c -> + c + + Buy c -> + c + + Refresh c -> + c + + + +{- + | View Loot + | Refresh NewChest.Model + | Buy Selection.Model + | Sending +-} init session = - ( Model session Loading, fetchShopItems ) + ( Model session Loading <| View Chest.init, fetchShopItems ) fetchShopItems = @@ -35,93 +63,168 @@ fetchShopItems = view : Model -> ( Html Msg, List (Html Msg) ) view model = - case model.state of + case model.loot of Loading -> - ( text "", [ p [ class "title" ] [ text "loading..." ] ] ) + ( text "" + , [ p [ class "title" ] [ text "loading..." ] ] + ) LoadError error -> - ( text "", [ p [ class "has-text-danger" ] [ text <| "Error : " ++ error ] ] ) - - View loot -> - ( case Session.user model.session of - Session.Admin -> - button [ class "button", onClick IntoRefresh ] [ text "Remplacer" ] - - Session.Player _ _ -> - button [ class "button" ] [ text "Acheter" ] - , [ Table.view Table.name loot ] + ( text "" + , [ p [ class "has-text-danger" ] [ text <| "Error : " ++ error ] ] ) - Refresh chest -> + Loaded loot -> let - ( controls, content ) = - NewChest.view chest + controls = + case model.chest of + View chest -> + case Session.user model.session of + Session.Admin -> + button [ class "button", onClick IntoRefresh ] [ text "Remplacer" ] - toMsg = - Html.map GotChestMsg + Session.Player _ _ -> + button [ class "button" ] [ text "Acheter" ] + + Buy chest -> + text "" + + Refresh chest -> + text "" in - ( toMsg controls - , List.map toMsg content + ( controls + , [ Chest.view (getChest model.chest) loot |> Html.map GotChestMsg ] ) - Sending -> - ( text "", [ p [] [ text "En attente du serveur..." ] ] ) + + +{- + Buy selection -> + let + ( controls, content ) = + Selection.view selection + + toMsg = + Html.map GotBuyMsg + in + ( toMsg controls + , List.map toMsg content + ) + + Refresh chest -> + let + ( controls, content ) = + NewChest.view chest + + toMsg = + Html.map GotChestMsg + in + ( toMsg controls + , List.map toMsg content + ) + + Sending -> + ( text "", [ p [] [ text "En attente du serveur..." ] ] ) +-} type Msg = GotLoot Api.ToChest (HttpResult Loot) | IntoRefresh - | GotChestMsg NewChest.Msg - | GotRefreshResult (Maybe ()) | IntoBuy + | GotChestMsg Chest.Msg + + +updateChest model chest = + { model + | chest = + case model.chest of + Buy _ -> + Buy chest + + Refresh _ -> + Refresh chest + + View _ -> + View chest + } + + + +-- GotRefreshResult (Maybe ()) +--| GotBuyMsg Selection.Msg +--| GotBuyResult (Maybe ()) update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = - case ( msg, model.state ) of - ( GotLoot Api.OfShop response, Loading ) -> + case msg of + GotLoot Api.OfShop response -> case response of Ok loot -> - ( { model | state = View loot }, Cmd.none ) + ( { model | loot = Loaded loot }, Cmd.none ) -- TODO: handle error Err e -> - ( { model | state = LoadError <| Debug.toString e }, Cmd.none ) + ( { model | loot = LoadError <| Debug.toString e }, Cmd.none ) - ( IntoRefresh, View _ ) -> + -- Refresh mode + IntoRefresh -> case Session.user (getSession model) of Session.Admin -> - ( { model | state = Refresh NewChest.init }, Cmd.none ) + ( { model | chest = Refresh Chest.initCreate }, Cmd.none ) _ -> ( model, Cmd.none ) - ( GotChestMsg chestMsg, Refresh chest ) -> - let - ( newState, cmd, exit ) = - NewChest.update chestMsg chest - in - case exit of - Just status -> - case status of - NewChest.Confirmed loot -> - ( model, Api.replaceShopItems GotRefreshResult loot ) + -- Buy mode + IntoBuy -> + case Session.user (getSession model) of + Session.Player _ _ -> + ( { model | chest = Buy Chest.initSelection }, Cmd.none ) - NewChest.Canceled -> - init <| getSession model + _ -> + ( model, Cmd.none ) - Nothing -> - ( { model | state = Refresh newState }, Cmd.map GotChestMsg cmd ) + GotChestMsg subMsg -> + Chest.update subMsg (getChest model.chest) + |> Tuple.mapBoth + (updateChest model) + (Cmd.map GotChestMsg) - ( GotRefreshResult result, _ ) -> - case result of - Just _ -> - init <| getSession model + {- + (GotChestMsg chestMsg, Refresh chest ) -> + let + ( newState, cmd, exit ) = + NewChest.update chestMsg chest + in + case exit of + Just status -> + case status of + NewChest.Confirmed loot -> + ( model, Api.replaceShopItems GotRefreshResult loot ) - Nothing -> - ( { model | state = LoadError "L'ajout a échoué. Vous devez recommencer :'( " } - , Cmd.none - ) + NewChest.Canceled -> + init <| getSession model + Nothing -> + ( { model | state = Refresh newState }, Cmd.map GotChestMsg cmd ) + + ( GotRefreshResult result, _ ) -> + case result of + Just _ -> + init <| getSession model + + Nothing -> + ( { model | state = LoadError "L'ajout a échoué. Vous devez recommencer :'( " } + , Cmd.none + ) + + ( GotBuyMsg subMsg, Buy subModel ) -> + Selection.update subMsg subModel + |> Tuple.mapBoth + (\m -> { model | state = Buy m }) + (\c -> Cmd.map GotBuyMsg c) + -} _ -> ( model, Cmd.none ) diff --git a/src/Session.elm b/src/Session.elm index edda7bb..654a6db 100644 --- a/src/Session.elm +++ b/src/Session.elm @@ -1,11 +1,11 @@ -module Session exposing (Session, User(..), getSession, init, key, user) +module Session exposing (Session, User(..), getSession, init, key, updateUser, updateWealth, user, wealth) import Api import Api.Player as Player exposing (Player) import Browser.Navigation as Nav import Http import Json.Decode as D -import Page.Chest.Wealth as Wealth +import Wealth type User @@ -53,3 +53,49 @@ user session = session in loggedUser + + +wealth : Session -> Maybe Wealth.Model +wealth session = + case user session of + Player _ model -> + Just model + + Admin -> + Nothing + + +setWealth wealthModel session = + let + (Session navKey isUser) = + session + in + case isUser of + Player p _ -> + Session navKey (Player p wealthModel) + + Admin -> + Session navKey Admin + + +updateWealth : Wealth.Model -> Session -> Session +updateWealth newWealthModel model = + let + (Session navKey loggedUser) = + model + in + case loggedUser of + Player player _ -> + Session navKey (Player player newWealthModel) + + Admin -> + Session navKey Admin + + +updateUser : User -> Session -> Session +updateUser newUser model = + let + (Session navKey _) = + model + in + Session navKey newUser diff --git a/src/Table.elm b/src/Table.elm index 83dd3fa..a5fb67f 100644 --- a/src/Table.elm +++ b/src/Table.elm @@ -1,10 +1,14 @@ -module Table exposing (name, view) +module Table exposing (name, renderRowLevel, view) import Html exposing (..) import Html.Attributes exposing (..) type alias RowRenderer a msg = + a -> Html msg + + +type alias ItemRenderer a msg = a -> List (Html msg) @@ -15,10 +19,20 @@ view rowRenderer content = [ th [] [ text "Nom" ] ] , tbody [] <| List.map - (\i -> tr [] [ td [] <| rowRenderer i ]) + rowRenderer content ] -name item = - [ p [] [ text item.name ] ] +renderRowLevel : ItemRenderer a msg -> ItemRenderer a msg -> RowRenderer a msg +renderRowLevel left right item = + tr [] + [ td [ class "level" ] + [ div [ class "level-left" ] <| left item + , div [ class "level-right" ] <| right item + ] + ] + + +name = + renderRowLevel (\item -> [ p [] [ text item.name ] ]) (\item -> []) diff --git a/src/Page/Chest/Wealth.elm b/src/Wealth.elm similarity index 86% rename from src/Page/Chest/Wealth.elm rename to src/Wealth.elm index 9dd73ea..5753fba 100644 --- a/src/Page/Chest/Wealth.elm +++ b/src/Wealth.elm @@ -1,4 +1,4 @@ -module Page.Chest.Wealth exposing (Model, Msg(..), editValue, init, update, view) +module Wealth exposing (Model, Msg(..), editValue, init, update, view) import Api.Player exposing (Wealth) import Html exposing (..) @@ -71,20 +71,22 @@ type Msg | ConfirmEdit -update : Msg -> Model -> Model +update : Msg -> Model -> ( Model, Maybe Float ) update msg model = case msg of StartEdit -> - Edit "0.0" + ( Edit "0.0", Nothing ) QuitEdit -> - View + ( View, Nothing ) AmountChanged newAmount -> - Edit <| String.replace "," "." newAmount + ( Edit <| String.replace "," "." newAmount + , Nothing + ) - _ -> - View + ConfirmEdit -> + ( View, editValue model )