From 8a604279db1e997abef5de7b1ffb04870208f32d Mon Sep 17 00:00:00 2001 From: Artus Date: Wed, 6 Nov 2019 21:50:49 +0100 Subject: [PATCH] restores all functionnality after refactoring ready to go on ! --- .gitignore | 1 + src/Api.elm | 248 +++++++++++++-------- src/Chest.elm | 215 +++++++++++++----- src/Main.elm | 603 +++++++++++++++++++++++++++++--------------------- src/Modes.elm | 16 +- src/Utils.elm | 5 +- 6 files changed, 694 insertions(+), 394 deletions(-) diff --git a/.gitignore b/.gitignore index f6acb14..b8c552c 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ fontawesome elm-stuff +main.js diff --git a/src/Api.elm b/src/Api.elm index a31921f..a461948 100644 --- a/src/Api.elm +++ b/src/Api.elm @@ -1,17 +1,18 @@ module Api exposing (..) import Http -import Json.Decode as D -import Json.Decode exposing (Decoder, int, string, field, succeed) +import Json.Decode as D exposing (Decoder, field, int, string, succeed) import Json.Encode as E - import Modes exposing (ViewMode) -type alias HttpResult a = (Result Http.Error a) + +type alias HttpResult a = + Result Http.Error a + type alias Response = - { value: Maybe String - , notification: Maybe String + { value : Maybe String + , notification : Maybe String , updates : Maybe (List Update) , errors : Maybe String } @@ -24,6 +25,7 @@ type Update | ClaimAdded () | ClaimRemoved () + type Msg = GotPlayer (HttpResult Player) | GotClaims Int (HttpResult Claims) @@ -31,67 +33,84 @@ type Msg | GotActionResult (HttpResult Response) + --- -- MODELS --- - -- Player + type alias Player = - { id: Int - , name: String - , debt: Int - , wealth: Wealth + { id : Int + , name : String + , debt : Int + , wealth : Wealth } + blankPlayer = Player 0 "Loot-a-lot" 0 (Wealth 0 0 0 0) type alias Wealth = - { cp: Int - , sp: Int - , gp: Int - , pp: Int + { cp : Int + , sp : Int + , gp : Int + , pp : Int } + + -- Loot -type alias Loot = List Item + +type alias Loot = + List Item + type alias Item = - { id: Int - , name: String - , base_price: Int + { id : Int + , name : String + , base_price : Int } + + -- Claims -type alias Claims = List Claim + +type alias Claims = + List Claim + type alias Claim = - { id: Int - , player_id: Int - , loot_id: Int + { id : Int + , player_id : Int + , loot_id : Int } + + -- PLAYERS -- + fetchPlayer : Int -> Cmd Msg fetchPlayer id = Http.get - { url = "http://localhost:8088/api/players/" ++ (String.fromInt id) ++ "/" - , expect = Http.expectJson GotPlayer (valueDecoder playerDecoder ) + { url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/" + , expect = Http.expectJson GotPlayer (valueDecoder playerDecoder) } + playerDecoder : Decoder Player playerDecoder = D.map4 Player - (D.field "id" int) - (D.field "name" string) - (D.field "debt" int) - wealthDecoder + (D.field "id" int) + (D.field "name" string) + (D.field "debt" int) + wealthDecoder + wealthDecoder : Decoder Wealth wealthDecoder = @@ -101,127 +120,172 @@ wealthDecoder = (D.field "gp" int) (D.field "pp" int) --- LOOT + +-- LOOT -- Location of a loot + + type ToChest = OfPlayer Int | OfGroup | OfShop + itemDecoder = D.map3 Item (D.field "id" int) (D.field "name" string) (D.field "base_price" int) + lootDecoder : Decoder Loot lootDecoder = - Json.Decode.list itemDecoder + D.list itemDecoder + fetchLoot : ToChest -> Cmd Msg fetchLoot dest = let - url = case dest of - OfPlayer id -> "http://localhost:8088/api/players/" ++ (String.fromInt id) ++ "/loot" - OfShop -> "http://localhost:8088/api/items" - OfGroup -> "http://localhost:8088/api/players/0/loot" + url = + case dest of + OfPlayer id -> + "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/loot" + + OfShop -> + "http://localhost:8088/api/items" + + OfGroup -> + "http://localhost:8088/api/players/0/loot" in Http.get { url = url - , expect = Http.expectJson (GotLoot dest) (valueDecoder lootDecoder)} + , expect = Http.expectJson (GotLoot dest) (valueDecoder lootDecoder) + } + + -- CLAIMS + claimDecoder = D.map3 Claim (D.field "id" int) (D.field "player_id" int) (D.field "loot_id" int) + fetchClaims : Int -> Cmd Msg fetchClaims playerId = Http.get { url = "http://localhost:8088/api/claims" - , expect = valueDecoder (D.list claimDecoder) - |> Http.expectJson (GotClaims playerId) + , expect = + valueDecoder (D.list claimDecoder) + |> Http.expectJson (GotClaims playerId) } + + -- API Response -- + + valueDecoder : Decoder a -> Decoder a valueDecoder thenDecoder = D.field "value" thenDecoder + + -- TODO: update server to produce better json -- like an object with list of updates of the same type -- { ItemRemoved : [..], Wealth : [ .. ], .. } + + updatesDecoder : Decoder Update updatesDecoder = -- We expect one update but do not know it's kind - Json.Decode.oneOf - [ (field "ItemRemoved" (itemDecoder |> Json.Decode.andThen (\i -> succeed <| ItemRemoved i))) - , (field "ItemAdded" (itemDecoder |> Json.Decode.andThen (\i -> succeed <| ItemAdded i))) - , (field "Wealth" (wealthDecoder |> Json.Decode.andThen (\i -> succeed <| WealthUpdated i))) - , (field "ClaimRemoved" (succeed () |> Json.Decode.andThen (\i -> succeed <| ClaimRemoved i))) - , (field "ClaimAdded" (succeed () |> Json.Decode.andThen (\i -> succeed <| ClaimAdded i))) - ] + D.oneOf + [ field "ItemRemoved" (itemDecoder |> D.andThen (\i -> succeed <| ItemRemoved i)) + , field "ItemAdded" (itemDecoder |> D.andThen (\i -> succeed <| ItemAdded i)) + , field "Wealth" (wealthDecoder |> D.andThen (\i -> succeed <| WealthUpdated i)) + , field "ClaimRemoved" (succeed () |> D.andThen (\i -> succeed <| ClaimRemoved i)) + , field "ClaimAdded" (succeed () |> D.andThen (\i -> succeed <| ClaimAdded i)) + ] apiResponseDecoder : Decoder Response apiResponseDecoder = - Json.Decode.map4 Response + D.map4 Response (D.maybe (field "value" string)) - (Json.Decode.maybe (field "notification" string)) - (Json.Decode.maybe (field "updates" (Json.Decode.list updatesDecoder))) - (Json.Decode.maybe (field "errors" string)) + (D.maybe (field "notification" string)) + (D.maybe (field "updates" (D.list updatesDecoder))) + (D.maybe (field "errors" string)) + + +undoLastAction id = + Http.request + { url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/events/last" + , method = "DELETE" + , headers = [] + , body = Http.emptyBody + , expect = Http.expectJson GotActionResult apiResponseDecoder + , timeout = Nothing + , tracker = Nothing + } -undoLastAction id = Http.request - { url = "http://localhost:8088/api/players/" ++ String.fromInt id ++"/events/last" - , method = "DELETE" - , headers = [] - , body = Http.emptyBody - , expect = Http.expectJson GotActionResult apiResponseDecoder - , timeout = Nothing - , tracker = Nothing - } buildPayload : ViewMode -> List Item -> E.Value buildPayload mode items = - case mode of - Modes.Buy -> E.object - [ ( "items", items |> E.list (\i -> E.list identity [E.int i.id, E.null])) - , ("global_mod", E.null ) - ] - Modes.Sell -> E.object - [ ( "items", items |> E.list (\i -> E.list identity [E.int i.id, E.null])) - , ("global_mod", E.null ) - ] - Modes.Grab -> E.object - [ ( "items", items |> E.list (\i -> E.int i.id)) - , ("global_mod", E.null ) - ] - Modes.Add -> E.object - [ ( "items", items |> E.list (\i -> E.int i.id)) - , ("global_mod", E.null ) - ] + case mode of + Modes.Buy -> + E.object + [ ( "items", items |> E.list (\i -> E.list identity [ E.int i.id, E.null ]) ) + , ( "global_mod", E.null ) + ] + + Modes.Sell -> + E.object + [ ( "items", items |> E.list (\i -> E.list identity [ E.int i.id, E.null ]) ) + , ( "global_mod", E.null ) + ] + + Modes.Grab -> + E.object + [ ( "items", items |> E.list (\i -> E.int i.id) ) + , ( "global_mod", E.null ) + ] + + Modes.Add -> + E.object + [ ( "items", items |> E.list (\i -> E.int i.id) ) + , ( "global_mod", E.null ) + ] + sendRequest : ViewMode -> String -> List Item -> Cmd Msg sendRequest mode id items = let - (endpoint, method) = case mode of - Modes.Add -> - ( "http://localhost:8088/api/players/" ++ id ++ "/loot" - , "POST" ) - Modes.Buy -> - ( "http://localhost:8088/api/players/" ++ id ++ "/loot" - , "PUT" ) - Modes.Sell -> - ( "http://localhost:8088/api/players/" ++ id ++ "/loot" - , "DELETE" ) - Modes.Grab -> - ( "http://localhost:8088/api/players/" ++ id ++ "/claims" - , "POST" ) + ( endpoint, method ) = + case mode of + Modes.Add -> + ( "http://localhost:8088/api/players/" ++ id ++ "/loot" + , "POST" + ) + + Modes.Buy -> + ( "http://localhost:8088/api/players/" ++ id ++ "/loot" + , "PUT" + ) + + Modes.Sell -> + ( "http://localhost:8088/api/players/" ++ id ++ "/loot" + , "DELETE" + ) + + Modes.Grab -> + ( "http://localhost:8088/api/players/" ++ id ++ "/claims" + , "POST" + ) in Http.request { method = method @@ -234,9 +298,11 @@ sendRequest mode id items = } - printError : Http.Error -> String printError error = case error of - Http.NetworkError -> "Le serveur ne répond pas" - _ -> "Erreur inconnue" + Http.NetworkError -> + "Le serveur ne répond pas" + + _ -> + "Erreur inconnue" diff --git a/src/Chest.elm b/src/Chest.elm index 129cff2..1cd04b7 100644 --- a/src/Chest.elm +++ b/src/Chest.elm @@ -1,33 +1,46 @@ module Chest exposing (..) +import Api exposing (Claims, Item, Loot) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onCheck) -import Set exposing (Set) - -import Route import Modes exposing (ViewMode) -import Api exposing (Item) +import Route exposing (..) +import Set exposing (Set) import Utils exposing (..) + type alias Model = - { items: List Item + { loot : Loot + , groupLoot : Loot + , merchantItems : Loot + , newLoot : Loot , selection : Maybe Selection + , claims : Claims } -type alias Selection = Set Int + +type alias Selection = + Set Int + type Msg = SetSelection (Maybe Selection) | SwitchSelectionState Int + init : Model init = - { items = [] + { loot = [] + , groupLoot = [] + , merchantItems = [] + , newLoot = [] , selection = Nothing + , claims = [] } -update : Msg -> Model -> (Model, Cmd Msg) + +update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of SwitchSelectionState id -> @@ -36,66 +49,121 @@ update msg model = SetSelection new -> ( { model | selection = new }, Cmd.none ) + view : Maybe ViewMode -> Route.Route -> Model -> Html Msg view mode route model = let - isSelected = itemInSelection model.selection - rowControls = case mode of - Just m -> - Just (rowControlsForMode isSelected m) - Nothing -> -- Claim controls for Group chest - case route of - Route.GroupLoot -> Just (claimedItemRenderer isSelected) - _ -> Nothing + ( header, shownItems ) = + case route of + Route.PlayerChest -> + ( "Mon coffre", model.loot ) + Route.GroupLoot -> + ( "Coffre de groupe", model.groupLoot ) + + Route.Merchant -> + ( "Marchand", model.merchantItems ) + + Route.NewLoot -> + ( "Nouveau trésor :)", [] ) + + isSelected = + itemInSelection model.selection + + rowControls = + case mode of + Just m -> + Just (rowControlsForMode isSelected m) + + Nothing -> + case route of + Route.GroupLoot -> + -- Claim controls for Group chest + Just <| + claimedItemRenderer <| + itemInClaims model.claims + + _ -> + Nothing in - table [ class "table is-fullwidth is-hoverable"] - [ thead [ class "table-header" ] - [ th [] [ text "Nom" ] ] - , tbody [] <| List.map (viewItemTableRow isSelected rowControls) model.items + article + [ class "section" ] + [ p [ class "heading" ] [ text header ] + , viewSearchBar + , table [ class "table is-fullwidth is-hoverable" ] + [ thead [ class "table-header" ] + [ th [] [ text "Nom" ] ] + , tbody [] <| List.map (viewItemTableRow isSelected rowControls) shownItems + ] ] -claimedItemRenderer isSelected item = - case isSelected item of - True -> renderIcon "fas fa-praying-hands" "1x" - False -> text "" + +claimedItemRenderer : (Item -> Bool) -> Item -> Html Msg +claimedItemRenderer isClaimed item = + case isClaimed item of + True -> + renderIcon "fas fa-praying-hands" "1x" + + False -> + text "" + -- Renders controls for a specific mode + + rowControlsForMode : (Item -> Bool) -> ViewMode -> Item -> Html Msg rowControlsForMode isSelected mode item = let - itemInfo = case mode of - Modes.Buy -> p [class "level-item"] [ text (String.fromInt item.base_price ++ "po")] - Modes.Sell -> p [class "level-item"] [ text (String.fromFloat (toFloat item.base_price / 2) ++ "po")] - Modes.Grab -> p [class "level-item"] [ text "Grab" ] - Modes.Add -> p [class "level-item"] [ text "New !" ] + itemInfo = + case mode of + Modes.Buy -> + p [ class "level-item" ] [ text (String.fromInt item.base_price ++ "po") ] + + Modes.Sell -> + p [ class "level-item" ] [ text (String.fromFloat (toFloat item.base_price / 2) ++ "po") ] + + Modes.Grab -> + p [ class "level-item" ] [ text "Grab" ] + + Modes.Add -> + p [ class "level-item" ] [ text "New !" ] in - div [ class "level-right" ] - <| itemInfo - :: if Modes.canSelectIn mode then - [input [ class "checkbox level-item" - , type_ "checkbox" - , checked <| isSelected item - , onCheck (\v -> SwitchSelectionState item.id) - ] [] ] - else - [] + div [ class "level-right" ] <| + itemInfo + :: (if Modes.canSelectIn mode then + [ input + [ class "checkbox level-item" + , type_ "checkbox" + , checked <| isSelected item + , onCheck (\v -> SwitchSelectionState item.id) + ] + [] + ] + + else + [] + ) viewItemTableRow : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Item -> Html Msg viewItemTableRow isSelected rowControls item = - tr [ classList [ ("is-selected", isSelected item) ] ] + tr [ classList [ ( "is-selected", isSelected item ) ] ] [ td [] - [ label [ class "level checkbox" ] - <| div [ class "level-left" ] - [ p [class "level-item"] [ text item.name ]] - :: case rowControls of - Just render -> List.singleton (render item) - Nothing -> [] + [ label [ class "level checkbox" ] <| + div [ class "level-left" ] + [ p [ class "level-item" ] [ text item.name ] ] + :: (case rowControls of + Just render -> + List.singleton (render item) + + Nothing -> + [] + ) ] ] + itemInSelection : Maybe Selection -> Item -> Bool itemInSelection selection item = Maybe.map (Set.member item.id) selection @@ -106,7 +174,54 @@ 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 + Just <| + case Set.member id s of + True -> + Set.remove id s + + False -> + Set.insert id s + + Nothing -> + Debug.log "ignore switchSelectionState" Nothing + + + +-- +-- Search Bar + + +viewSearchBar : Html Msg +viewSearchBar = + input [ class "input" ] [] + + +targetItemsFor : Route -> Model -> List Item +targetItemsFor route model = + case route of + Route.NewLoot -> + model.newLoot + + Route.Merchant -> + model.merchantItems + + Route.PlayerChest -> + model.loot + + Route.GroupLoot -> + model.groupLoot + + +getSelected : Route -> Model -> Loot +getSelected route model = + targetItemsFor route model + |> List.filter (itemInSelection model.selection) + + + +-- LOOT Views + + +itemInClaims : Claims -> Item -> Bool +itemInClaims claims item = + List.any (\c -> c.loot_id == item.id) claims diff --git a/src/Main.elm b/src/Main.elm index 638b4e6..87fb403 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -1,23 +1,25 @@ module Main exposing (..) +import Api exposing (Claim, Claims, Item, Loot, Player, Wealth) import Browser import Browser.Navigation as Nav -import Url +import Chest exposing (Msg) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Svg.Attributes -import Set exposing (Set) import Json.Encode as E - -import Api exposing (Player, Loot, Wealth, Item, Claim, Claims) import Modes exposing (ViewMode) import Route exposing (..) -import Chest -import Chest exposing (Msg) +import Set exposing (Set) +import Svg.Attributes +import Url import Utils exposing (..) + + + -- Main + main : Program () Model Msg main = Browser.application @@ -29,45 +31,48 @@ main = , onUrlRequest = LinkClicked } + + -- Model type alias State = - { navKey : Nav.Key - , route : Route - , error : String - , menuOpen : Bool - , activeMode : Maybe ViewMode + { menuOpen : Bool + , error : Maybe String + , notification : Maybe String } + type alias Model = { state : State - , player: Player + , navKey : Nav.Key + , route : Route + , mode : Maybe ViewMode + , player : Player , chest : Chest.Model - , claims : Claims - , notification : Maybe String - , loot: Maybe Loot - , groupLoot : Maybe Loot - , merchantItems : Maybe Loot } + init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) init flags url key = let - route = case routeParser url of - Just r -> r - Nothing -> PlayerChest + route = + case routeParser url of + Just r -> + r + + Nothing -> + PlayerChest in - ( Model - (State key route "" False Nothing) - Api.blankPlayer - Chest.init - [] - Nothing - Nothing - Nothing - Nothing - , fetchInitialData 0) + ( Model + (State False Nothing Nothing) + key + route + Nothing + Api.blankPlayer + Chest.init + , fetchInitialData 0 + ) fetchInitialData : Int -> Cmd Msg @@ -78,6 +83,7 @@ fetchInitialData playerId = , Cmd.map ApiMsg <| Api.fetchLoot Api.OfGroup ] + initPlayer id = Cmd.batch [ Cmd.map ApiMsg <| Api.fetchPlayer id @@ -85,8 +91,11 @@ initPlayer id = , Cmd.map ApiMsg <| Api.fetchClaims id ] + + -- UPDATE + type Msg = LinkClicked Browser.UrlRequest | UrlChanged Url.Url @@ -98,303 +107,391 @@ type Msg | UndoLastAction | ClearNotification + update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of LinkClicked urlRequest -> case urlRequest of Browser.Internal url -> - ( model, Nav.pushUrl model.state.navKey (Url.toString url) ) + ( model, Nav.pushUrl model.navKey (Url.toString url) ) Browser.External href -> ( setError ("External request '" ++ href ++ "'") model - , Cmd.none ) + , Cmd.none + ) UrlChanged url -> let - route = routeParser url - state = model.state + route = + routeParser url in - case route of - Just page -> - { model | state = { state | route = page }} - |> update (case page of - -- Directly enter add mode on NewLoot view - NewLoot -> ModeSwitched (Just Modes.Add) - other -> ModeSwitched Nothing - ) + case route of + Just page -> + { model | route = page } + |> update + (case page of + -- Directly enter add mode on NewLoot view + NewLoot -> + ModeSwitched (Just Modes.Add) - Nothing -> - ( setError "Invalid route" model, Cmd.none ) + other -> + ModeSwitched Nothing + ) + + Nothing -> + ( setError "Invalid route" model, Cmd.none ) PlayerChanged newId -> ( { model | player = Api.blankPlayer }, initPlayer newId ) ChestMsg chestMsg -> let - (chest, _) = Chest.update chestMsg model.chest + ( chest, _ ) = + Chest.update chestMsg model.chest in - ( { model | chest = chest }, Cmd.none ) + ( { model | chest = chest }, Cmd.none ) - ApiMsg apiMsg -> case apiMsg of - Api.GotActionResult response -> - case response of - Ok result -> - let - updates = Maybe.withDefault [] result.updates - notification = result.notification - errors = Maybe.withDefault "" result.errors - in + ApiMsg apiMsg -> + case apiMsg of + Api.GotActionResult response -> + case response of + Ok result -> + let + updates = + Maybe.withDefault [] result.updates + + notification = + result.notification + + errors = + Maybe.withDefault "" result.errors + in List.foldl applyUpdate model updates |> setNotification notification |> setError errors |> update (ModeSwitched Nothing) - Err r -> (setError (Debug.toString r) model, Cmd.none) - Api.GotPlayer result -> - case result of - Ok player -> - ( { model | player = player } - , Cmd.none - ) - Err error -> - ( setError ("Fetching player... " ++ Debug.toString error) model - , Cmd.none - ) + Err r -> + ( setError (Debug.toString r) model, Cmd.none ) - Api.GotClaims id result -> - case result of - Ok claims -> ( { model | claims = List.filter (\c -> c.player_id == id) claims}, Cmd.none ) - Err error -> ( setError ("Fetching claims..." ++ Debug.toString error) model, Cmd.none) + Api.GotPlayer result -> + case result of + Ok player -> + ( { model | player = player } + , Cmd.none + ) - Api.GotLoot dest result -> - case result of - Ok loot -> - ( case dest of - Api.OfPlayer _ -> { model | loot = Just loot} - Api.OfGroup -> { model | groupLoot = Just loot} - Api.OfShop -> { model | merchantItems = Just loot} - , Cmd.none - ) - Err error -> - ( setError ("Fetching loot... " ++ Debug.toString error) model - , Cmd.none - ) + Err error -> + ( setError ("Fetching player... " ++ Debug.toString error) model + , Cmd.none + ) + + Api.GotClaims id result -> + case result of + Ok claims -> + ( let + chest = + model.chest + in + { model + | chest = + { chest + | claims = + List.filter + (\c -> c.player_id == id) + claims + } + } + , Cmd.none + ) + + Err error -> + ( setError ("Fetching claims..." ++ Debug.toString error) model, Cmd.none ) + + Api.GotLoot dest result -> + case result of + Ok loot -> + let + chest = + model.chest + in + ( case dest of + Api.OfPlayer _ -> + { model | chest = { chest | loot = loot } } + + Api.OfGroup -> + { model | chest = { chest | groupLoot = loot } } + + Api.OfShop -> + { model | chest = { chest | merchantItems = loot } } + , Cmd.none + ) + + Err error -> + ( setError ("Fetching loot... " ++ Debug.toString error) model + , Cmd.none + ) ModeSwitched newMode -> - let - state = model.state - in - ( { model | state = - { state | activeMode = newMode } - , chest = - let - (newChest, _) = Chest.update (Chest.SetSelection + ( { model + | mode = newMode + , chest = + let + ( newChest, _ ) = + Chest.update + (Chest.SetSelection (case newMode of Nothing -> Nothing - Just Modes.Grab -> -- Currently claimed object are initially selected - Just ( Set.fromList <| List.map (\c -> c.loot_id) model.claims) + Just Modes.Grab -> + -- Currently claimed object are initially selected + Just (Set.fromList <| List.map (\c -> c.loot_id) model.chest.claims) Just others -> Just Set.empty - )) - model.chest - in newChest - } - , Cmd.none ) + ) + ) + model.chest + in + newChest + } + , Cmd.none + ) ConfirmAction -> - case model.state.activeMode of + case model.mode of Nothing -> update (ModeSwitched Nothing) model Just mode -> - let items = targetItemsFor mode model - |> List.filter (Chest.itemInSelection model.chest.selection) + let + items = + Chest.getSelected model.route model.chest in ( model - , Cmd.map ApiMsg - <| Api.sendRequest + , Cmd.map ApiMsg <| + Api.sendRequest mode (String.fromInt model.player.id) items ) UndoLastAction -> - (model, Cmd.map ApiMsg <| Api.undoLastAction model.player.id) + ( model, Cmd.map ApiMsg <| Api.undoLastAction model.player.id ) ClearNotification -> - ( { model | notification = Nothing }, Cmd.none ) + ( setNotification Nothing model, Cmd.none ) + setNotification : Maybe String -> Model -> Model setNotification notification model = - { model | notification = notification } + let + state = + model.state + in + { model + | state = + { state | notification = notification } + } + + +setLoot : Loot -> Model -> Model +setLoot items model = + let + chest = + model.chest + in + { model | chest = { chest | loot = items } } + -targetItemsFor : ViewMode -> Model -> List Item -targetItemsFor mode model = - case mode of - Modes.Add -> [] - Modes.Buy -> Maybe.withDefault [] model.merchantItems - Modes.Sell ->Maybe.withDefault [] model.loot - Modes.Grab -> Maybe.withDefault [] model.groupLoot -- DbUpdates always refer to the active player's loot + + applyUpdate : Api.Update -> Model -> Model applyUpdate u model = case u of - Api.ItemRemoved item -> { model | loot = Just - <| List.filter (\i -> i.id /= item.id) - <| Maybe.withDefault [] model.loot } - Api.ItemAdded item -> { model | loot = Just - <| item :: Maybe.withDefault [] model.loot } + Api.ItemRemoved item -> + model + |> setLoot (List.filter (\i -> i.id /= item.id) model.chest.loot) + + Api.ItemAdded item -> + model |> setLoot (item :: model.chest.loot) + Api.WealthUpdated diff -> let - player = model.player - wealth = player.wealth + player = + model.player + + wealth = + player.wealth in - { model | player = { player | wealth = - (Wealth - (wealth.cp + diff.cp) - (wealth.sp + diff.sp) - (wealth.gp + diff.gp) - (wealth.pp + diff.pp) - )}} - Api.ClaimAdded _ -> model - Api.ClaimRemoved _ -> model + { model + | player = + { player + | wealth = + Wealth + (wealth.cp + diff.cp) + (wealth.sp + diff.sp) + (wealth.gp + diff.gp) + (wealth.pp + diff.pp) + } + } + + Api.ClaimAdded _ -> + model + + Api.ClaimRemoved _ -> + model + -- ERRORS + setError : String -> Model -> Model setError error model = let - state = model.state + state = + model.state in - { model | state = - { state | error = error }} + { model + | state = + { state | error = Just error } + } + -- STATE Utils - -- SUBSCRIPTIONS -- + + subscriptions : Model -> Sub Msg subscriptions _ = Sub.none + --- -- VIEWS --- + actionButton msg t icon color = - button [ class <| "button level-item is-" ++ color - , onClick msg ] - [ span [ class "icon" ] [ i [ Svg.Attributes.class <| "fas fa-" ++ icon ] [] ] - , p [] [text t] + button + [ class <| "button level-item is-" ++ color + , onClick msg ] + [ span [ class "icon" ] [ i [ Svg.Attributes.class <| "fas fa-" ++ icon ] [] ] + , p [] [ text t ] + ] + controlsWhenModeActive : ViewMode -> List (Html Msg) controlsWhenModeActive mode = - [ actionButton (ConfirmAction) "Valider" "check" "primary" - , actionButton (ModeSwitched Nothing) "Annuler" "times" "danger" - ] + [ actionButton ConfirmAction "Valider" "check" "primary" + , actionButton (ModeSwitched Nothing) "Annuler" "times" "danger" + ] + controlsWhenRoute : Route -> List (Html Msg) controlsWhenRoute route = case route of - PlayerChest -> [actionButton (ModeSwitched (Just Modes.Sell)) "Vendre" "coins" "danger"] - GroupLoot -> [actionButton (ModeSwitched (Just Modes.Grab)) "Demander" "praying-hands" "primary"] - Merchant -> [actionButton (ModeSwitched (Just Modes.Buy)) "Acheter" "coins" "success"] - NewLoot -> [actionButton (ModeSwitched (Just Modes.Add)) "Nouveau loot" "plus" "primary"] - + PlayerChest -> + [ actionButton (ModeSwitched (Just Modes.Sell)) "Vendre" "coins" "danger" ] + + GroupLoot -> + [ actionButton (ModeSwitched (Just Modes.Grab)) "Demander" "praying-hands" "primary" ] + + Merchant -> + [ actionButton (ModeSwitched (Just Modes.Buy)) "Acheter" "coins" "success" ] + + NewLoot -> + [ actionButton (ModeSwitched (Just Modes.Add)) "Nouveau loot" "plus" "primary" ] + + view : Model -> Browser.Document Msg view model = let -- What do we show inside the chest ? - (header, shownLoot) = - case model.state.route of - PlayerChest -> - ("Mon coffre", Maybe.withDefault [] model.loot) - GroupLoot -> - ("Coffre de groupe", Maybe.withDefault [] model.groupLoot) - Merchant -> - ("Marchand", Maybe.withDefault [] model.merchantItems) - NewLoot -> - ("Nouveau trésor :)", [] ) - {- Dynamic renderers for ViewMode - Header controls are inserted in the PlayerBar - and rowControls to the right side of every item rows + Header controls are inserted in the PlayerBar + and rowControls to the right side of every item rows -} headerControls = - case model.state.activeMode of - Just mode -> controlsWhenModeActive mode - Nothing -> -- Buttons to enter mode + case model.mode of + Just mode -> + controlsWhenModeActive mode + + Nothing -> + -- Buttons to enter mode actionButton UndoLastAction "Annuler action" "backspace" "danger" - :: controlsWhenRoute model.state.route + :: controlsWhenRoute model.route in { title = "Loot-a-lot in ELM" , body = [ viewHeaderBar model - , viewPlayerBar model.player model.notification headerControls - , article - [ class "section container" ] - [ viewNotification model.notification - , p [class "heading"] [text header] - , viewSearchBar + , viewPlayerBar model.player headerControls + , main_ + [ class "container" ] + [ viewNotification model.state.notification , Chest.view - model.state.activeMode - model.state.route + model.mode + model.route model.chest - |> Html.map ChestMsg + |> Html.map ChestMsg ] , hr [] [] - , section [class "container"] [viewDebugSection model] + , section [ class "container" ] [ viewDebugSection model ] ] } + viewNotification : Maybe String -> Html Msg viewNotification notification = case notification of - Just t -> div [ class "notification is-success is-marginless"] - [ button [class "delete", onClick ClearNotification ] [] - , text t ] - Nothing -> text "" + Just t -> + div [ class "notification is-success is-marginless" ] + [ button [ class "delete", onClick ClearNotification ] [] + , text t + ] + + Nothing -> + text "" --- LOOT Views -itemInClaims : List Claim -> Item -> Bool -itemInClaims claims item = - List.any (\c -> c.loot_id == item.id) claims -- DEBUG SECTION + viewDebugSection : Model -> Html Msg viewDebugSection model = - div [class "panel is-danger"] - [ p [class "panel-heading"] [text "Debug"] + div [ class "panel is-danger" ] + [ p [ class "panel-heading" ] [ text "Debug" ] , debugSwitchPlayers - , p [class "panel-block has-text-danger"] [text model.state.error] - , p [class "panel-block"] [text ("Route : " ++ Debug.toString model.state.route)] - , p [class "panel-block"] [text ("Active Mode : " ++ Debug.toString model.state.activeMode)] - , p [class "panel-block"] [text ("Selection : " ++ Debug.toString model.chest.selection)] - , p [class "panel-block"] [text ("Claims : " ++ Debug.toString model.claims)] - , p [] debugSandbox + , p [ class "panel-block has-text-danger" ] [ text <| Maybe.withDefault "" model.state.error ] + , p [ class "panel-block" ] [ text ("Route : " ++ Debug.toString model.route) ] + , p [ class "panel-block" ] [ text ("Active Mode : " ++ Debug.toString model.mode) ] + , p [ class "panel-block" ] [ text ("Selection : " ++ Debug.toString model.chest.selection) ] + , p [ class "panel-block" ] [ text ("Claims : " ++ Debug.toString model.chest.claims) ] + , p [] debugSandbox ] + stackedIcon name = - span [class "icon is-medium"] + span [ class "icon is-medium" ] [ span [ class "fa-stack" ] - [ i [ class "fas fa-circle fa-stack-2x" ] [] - , i [ class (name ++ " fa-inverse fa-stack-1x") ] [] - , text "" - ] + [ i [ class "fas fa-circle fa-stack-2x" ] [] + , i [ class (name ++ " fa-inverse fa-stack-1x") ] [] + , text "" + ] ] + debugSandbox = [ stackedIcon "fas fa-coins" , stackedIcon "fab fa-d-and-d" @@ -410,76 +507,92 @@ debugSandbox = , stackedIcon "fas fa-search" ] + debugSwitchPlayers : Html Msg debugSwitchPlayers = div [ class "panel-tabs" ] - [ a [ onClick (PlayerChanged 0) ] [text "Groupe"] - , a [ onClick (PlayerChanged 1) ] [text "Lomion"] - , a [ onClick (PlayerChanged 2) ] [text "Fefi"] + [ a [ onClick (PlayerChanged 0) ] [ text "Groupe" ] + , a [ onClick (PlayerChanged 1) ] [ text "Lomion" ] + , a [ onClick (PlayerChanged 2) ] [ text "Fefi" ] ] -- HEADER SECTION + viewHeaderBar : Model -> Html Msg viewHeaderBar model = nav [ class "navbar container", class "is-info" ] [ div [ class "navbar-brand" ] - [ a [ class "navbar-item", href "/"] - [ renderIcon "fab fa-d-and-d" "2x" - , span [] [ text model.player.name ] - ] - , a [class "navbar-burger is-active"] - [ span [attribute "aria-hidden" "true"] [] - , span [attribute "aria-hidden" "true"] [] - , span [attribute "aria-hidden" "true"] [] - ] - ] + [ a [ class "navbar-item", href "/" ] + [ renderIcon "fab fa-d-and-d" "2x" + , span [] [ text model.player.name ] + ] + , a [ class "navbar-burger is-active" ] + [ span [ attribute "aria-hidden" "true" ] [] + , span [ attribute "aria-hidden" "true" ] [] + , span [ attribute "aria-hidden" "true" ] [] + ] + ] , div [ class "navbar-menu is-active" ] - [ div [class "navbar-end"] - [ a [class "navbar-item", href "/marchand"] - [ renderIcon "fas fa-store-alt" "1x" - , span [] [text "Marchand"] - ] - , a - [ class "navbar-item" - , href (if model.player.id == 0 - then - "/nouveau-tresor" - else - "/coffre") - ] - [ renderIcon "fas fa-gem" "1x" - , span [] [text (if model.player.id == 0 then "Nouveau loot" else "Coffre de groupe")] - ] + [ div [ class "navbar-end" ] + [ a [ class "navbar-item", href "/marchand" ] + [ renderIcon "fas fa-store-alt" "1x" + , span [] [ text "Marchand" ] ] - ] + , a + [ class "navbar-item" + , href + (if model.player.id == 0 then + "/nouveau-tresor" + else + "/coffre" + ) + ] + [ renderIcon "fas fa-gem" "1x" + , span [] + [ text + (if model.player.id == 0 then + "Nouveau loot" + + else + "Coffre de groupe" + ) + ] + ] + ] + ] ] + + -- PLAYER BAR -viewPlayerBar : Player -> Maybe String -> List (Html Msg)-> Html Msg -viewPlayerBar player notification actionControls = + +viewPlayerBar : Player -> List (Html Msg) -> Html Msg +viewPlayerBar player actionControls = section [ class "level container is-mobile box" ] - [ div [class "level-left"] - ([div [ class "level-item" ] - [ span [ class "icon is-large" ] - [ i [ class "fas fa-2x fa-piggy-bank" ] [] ]] + [ div [ class "level-left" ] + ([ div [ class "level-item" ] + [ span [ class "icon is-large" ] + [ i [ class "fas fa-2x fa-piggy-bank" ] [] ] ] - ++ (viewWealth player.wealth) + ] + ++ viewWealth player.wealth ++ (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")] - ]] + [ div [ class "level-item" ] + [ p [ class "heading is-size-4 has-text-danger" ] + [ text ("Dette : " ++ String.fromInt player.debt ++ "po") ] + ] + ] + else [] ) - ) - , viewNotification notification - , div [class "level-right"] actionControls + ) + , div [ class "level-right" ] actionControls ] @@ -491,16 +604,12 @@ viewWealth wealth = , showWealthField "cp" <| String.fromInt wealth.cp ] + showWealthField : String -> String -> Html Msg showWealthField name value = div [ class "level-item" ] - [ p [class "has-text-right"] [ strong [ class "heading is-marginless"] [text name] - , span [ class <| "is-size-4" ] [ text value ] - ] + [ p [ class "has-text-right" ] + [ strong [ class "heading is-marginless" ] [ text name ] + , span [ class <| "is-size-4" ] [ text value ] + ] ] - --- Search Bar - -viewSearchBar : Html Msg -viewSearchBar = - input [class "input"] [] diff --git a/src/Modes.elm b/src/Modes.elm index e7ac8c0..1861be7 100644 --- a/src/Modes.elm +++ b/src/Modes.elm @@ -1,5 +1,6 @@ module Modes exposing (..) + type ViewMode = Sell | Buy @@ -10,7 +11,14 @@ type ViewMode canSelectIn : ViewMode -> Bool canSelectIn mode = case mode of - Sell -> True - Buy -> True - Grab -> True - Add -> False + Sell -> + True + + Buy -> + True + + Grab -> + True + + Add -> + False diff --git a/src/Utils.elm b/src/Utils.elm index 18b648a..a286865 100644 --- a/src/Utils.elm +++ b/src/Utils.elm @@ -3,6 +3,7 @@ module Utils exposing (renderIcon) import Html exposing (..) import Html.Attributes exposing (..) + renderIcon name size = - span [ class <| "icon is-medium"] - [ i [ class <| name ++ " fa-" ++ size] [] ] + span [ class <| "icon is-medium" ] + [ i [ class <| name ++ " fa-" ++ size ] [] ]