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 -> 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) Nothing -> Cmd.none ) _ -> ( { model | wealth = Wealth.update wealthMsg model.wealth }, 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