From 5725d812363d06940b96d0745bc55a2c741b6d74 Mon Sep 17 00:00:00 2001 From: Artus Date: Sun, 10 Nov 2019 23:18:19 +0100 Subject: [PATCH] restructure the code, learning from spa-example-app --- src/Chest.elm | 569 +++++++++++++++++++++++++++++++++++++---- src/Main.elm | 465 ++++----------------------------- src/Modes.elm | 59 ----- src/Page/Chest.elm | 6 + src/Page/LoggedOut.elm | 7 + src/Route.elm | 40 +-- src/Session.elm | 12 + 7 files changed, 609 insertions(+), 549 deletions(-) delete mode 100644 src/Modes.elm create mode 100644 src/Page/Chest.elm create mode 100644 src/Page/LoggedOut.elm create mode 100644 src/Session.elm diff --git a/src/Chest.elm b/src/Chest.elm index aab044c..44739f9 100644 --- a/src/Chest.elm +++ b/src/Chest.elm @@ -1,53 +1,435 @@ module Chest exposing (..) +import Api exposing (Claims, HttpResult, Item, Loot) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onCheck) - -import Api exposing (HttpResult, Claims, Item, Loot) -import Modes import Route exposing (..) import Set exposing (Set) import Utils exposing (..) + -- MODEL + +type alias State = + { menuOpen : Bool + , mode : ActionMode + , error : Maybe String + , notification : Maybe String + } + + +type alias Selection = + Set Int + + +type ActionMode + = Sell + | Buy + | Grab + | Add + | NoMode + + type alias Model = - { loot : Loot + { state : State + , shown : Route.ChestContent + , playerLoot : Loot , groupLoot : Loot - , merchantItems : Loot + , merchantLoot : Loot , newLoot : Loot , selection : Maybe Selection , claims : Claims } +init : Int -> ( Model, Cmd Msg ) +init playerId = + ( Model + (State False Modes.None Nothing Nothing) + [] + [] + [] + [] + Nothing + [] + , Api.fetchClaims (GotClaims playerId) + ) + + +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 "" + + + +-- DEBUG SECTION + + +viewDebugSection : Model -> Html Msg +viewDebugSection model = + div [ class "panel is-danger" ] + [ p [ class "panel-heading" ] [ text "Debug" ] + , debugSwitchPlayers + , 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 "fa-stack" ] + [ 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" + , stackedIcon "fas fa-praying-hands" + , stackedIcon "fas fa-gem" + , stackedIcon "fas fa-pen" + , stackedIcon "fas fa-percentage" + , stackedIcon "fas fa-store-alt" + , stackedIcon "fas fa-cart-plus" + , stackedIcon "fas fa-angry" + , stackedIcon "fas fa-plus" + , stackedIcon "fas fa-tools" + , 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" ] + ] + + + +-- HEADER SECTION + + +viewHeaderBar : String -> Model -> Html Msg +viewHeaderBar title model = + nav [ class "navbar container", class "is-info" ] + [ div [ class "navbar-brand" ] + [ a [ class "navbar-item", href "/" ] + [ renderIcon { icon = "fab fa-d-and-d", size = "medium", ratio = "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 { icon = "fas fa-store-alt", ratio = "1x", size = "medium" } + , span [] [ text "Marchand" ] + ] + , a + [ class "navbar-item" + , href + (if model.player.id == 0 then + "/nouveau-tresor" + + else + "/coffre" + ) + ] + [ renderIcon { icon = "fas fa-gem", ratio = "1x", size = "medium" } + , span [] + [ text + (if model.player.id == 0 then + "Nouveau loot" + + else + "Coffre de groupe" + ) + ] + ] + ] + ] + ] + + + +-- PLAYER BAR + + +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" ] [] ] + ] + ] + ++ 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") ] + ] + ] + + else + [] + ) + ) + , div [ class "level-right" ] actionControls + ] + + +viewWealth : Wealth -> List (Html Msg) +viewWealth wealth = + [ showWealthField "pp" <| String.fromInt wealth.pp + , showWealthField "gp" <| String.padLeft 2 '0' <| String.fromInt wealth.gp + , showWealthField "sp" <| String.fromInt wealth.sp + , 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 ] + ] + ] + + + +-- UPDATE + + +initPlayer id = + Cmd.map ApiMsg <| Api.fetchPlayer id + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + PlayerChanged newId -> + let + ( chest, cmd ) = + Chest.init newId + in + ( { model + | player = Api.blankPlayer + , route = PlayerChest + , chest = chest + } + , Cmd.batch + [ initPlayer newId + , Cmd.map ChestMsg cmd + ] + ) + + ApiMsg apiMsg -> + case apiMsg of + Api.GotActionResult response -> + case response of + Ok result -> + let + updates = + Maybe.withDefault [] result.updates + + notification = + result.notification + + errors = + Maybe.withDefault "" result.errors + in + List.foldl applyUpdate model updates + |> setNotification notification + |> setError errors + |> update (ModeMsg (Modes.ModeSwitched Modes.None)) + + Err r -> + ( setError (Debug.toString r) model, Cmd.none ) + + Api.GotPlayer result -> + case result of + Ok player -> + ( { model | player = player } + , Cmd.none + ) + + Err error -> + ( setError ("Fetching player... " ++ Debug.toString error) model + , Cmd.none + ) + + ModeMsg modeMsg -> + case modeMsg of + Modes.ModeSwitched newMode -> + ( { model + | mode = newMode + , chest = + let + ( newChest, _ ) = + Chest.update + (Chest.SetSelection + (case newMode of + Modes.None -> + Nothing + + Modes.Grab -> + -- Currently claimed object are initially selected + Just (Set.fromList <| List.map (\c -> c.loot_id) model.chest.claims) + + others -> + Just Set.empty + ) + ) + model.chest + in + newChest + } + , Cmd.none + ) + + Modes.ConfirmAction -> + case model.mode of + -- This should not happen, so we ignore it + Modes.None -> + ( model, Cmd.none ) + + mode -> + let + items = + Chest.getSelected model.route model.chest + in + ( model + , Cmd.map ApiMsg <| + Api.sendRequest + mode + (String.fromInt model.player.id) + items + ) + + ClearNotification -> + ( setNotification Nothing model, Cmd.none ) + + +setNotification : Maybe String -> Model -> Model +setNotification notification model = + let + state = + model.state + in + { model + | state = + { state | notification = notification } + } + + +setLoot : Loot -> Model -> Model +setLoot items model = + let + chest = + model.chest + in + { model | chest = { chest | loot = items } } + + +setClaims : Claims -> Model -> Model +setClaims claims model = + let + chest = + model.chest + in + { model | chest = { chest | claims = claims } } + + + +-- DbUpdates always refer to the active player's loot + + +applyUpdate : Api.Update -> Model -> Model +applyUpdate u model = + case u of + Api.ItemRemoved item -> + model + |> setLoot (List.filter (\i -> i.id /= item.id) model.chest.loot) + + Api.ItemAdded item -> + model |> setLoot (item :: model.chest.loot) + + Api.WealthUpdated diff -> + let + player = + model.player + + wealth = + player.wealth + in + { model + | player = + { player + | wealth = + Wealth + (wealth.cp + diff.cp) + (wealth.sp + diff.sp) + (wealth.gp + diff.gp) + (wealth.pp + diff.pp) + } + } + + Api.ClaimAdded claim -> + model |> setClaims (claim :: model.chest.claims) + + Api.ClaimRemoved claim -> + model + |> setClaims (List.filter (\c -> c.id /= claim.id) model.chest.claims) + + + +-- ERRORS + + +setError : String -> Model -> Model +setError error model = + let + state = + model.state + in + { model + | state = + { state | error = Just error } + } + type ToChest = OfPlayer Int | OfGroup | OfShop -type alias Selection = - Set Int - -init : Int -> (Model, Cmd Msg) -init playerId = - ( { loot = [] - , groupLoot = [] - , merchantItems = [] - , newLoot = [] - , selection = Nothing - , claims = [] - } - , Cmd.batch - [ fetchLoot OfShop - , fetchLoot OfGroup - , fetchLoot (OfPlayer playerId) - , Api.fetchClaims (GotClaims playerId) - ] - ) fetchLoot : ToChest -> Cmd Msg fetchLoot dest = @@ -63,13 +445,20 @@ fetchLoot dest = OfGroup -> "http://localhost:8088/api/players/0/loot" in - Api.fetchLoot url (GotLoot dest) + Api.fetchLoot url (GotLoot dest) + + -- VIEW + view : Modes.Model -> Route.Route -> Model -> Html Msg view mode route model = let + renderControls = + Modes.viewControls model.mode model.route + |> List.map (Html.map ModeMsg) + ( header, shownItems ) = case route of Route.PlayerChest -> @@ -84,7 +473,6 @@ view mode route model = Route.NewLoot -> ( "Nouveau trésor :)", [] ) - isSelected = itemInSelection model.selection @@ -94,7 +482,8 @@ view mode route model = case route of Route.GroupLoot -> let - isClaimed = itemInClaims model.claims + isClaimed = + itemInClaims model.claims in -- Claim controls for Group chest Just (claimedItemRenderer isClaimed) @@ -105,38 +494,50 @@ view mode route model = activeMode -> Just (rowRendererForMode isSelected activeMode) in - article - [ class "section" ] - [ div [ class "columns"] - [ div [ class "column is-one-third" ] [ p [ class "title" ] [ text header ] ] - , div [ class "column" ] [ viewSearchBar ] - ] - , table [ class "table is-fullwidth is-striped is-hoverable" ] - [ thead [ class "table-header" ] - [ th [] [ text "Nom" ] ] - , tbody [] <| List.map (viewItemTableRow isSelected rowRenderer) shownItems + [ viewHeaderBar player.name model + , viewPlayerBar model.player renderControls + , main_ + [ class "container" ] + [ viewNotification model.state.notification + , article + [ class "section" ] + [ div [ class "columns" ] + [ div [ class "column is-one-third" ] [ p [ class "title" ] [ text header ] ] + , div [ class "column" ] [ viewSearchBar ] + ] + , table [ class "table is-fullwidth is-striped is-hoverable" ] + [ thead [ class "table-header" ] + [ th [] [ text "Nom" ] ] + , tbody [] <| List.map (viewItemTableRow isSelected rowRenderer) shownItems + ] ] ] + , hr [] [] + , section [ class "container" ] [ viewDebugSection model ] + ] + + -- Renderers -- -- Item -> Html Msg + claimedItemRenderer : (Item -> Bool) -> Item -> Html Msg claimedItemRenderer isClaimed item = case isClaimed item of True -> renderIcon - { icon = "fas fa-praying-hands" - , size = "small" - , ratio = "1x" - } + { icon = "fas fa-praying-hands" + , size = "small" + , ratio = "1x" + } False -> text "" -rowRendererForMode: (Item -> Bool) -> Modes.Model -> Item -> Html Msg +rowRendererForMode : (Item -> Bool) -> Modes.Model -> Item -> Html Msg rowRendererForMode isSelected mode item = let canSelect = @@ -156,7 +557,8 @@ rowRendererForMode isSelected mode item = Modes.Add -> p [ class "level-item" ] [ text "New !" ] - Modes.None -> text "" + Modes.None -> + text "" in div [ class "level-right" ] <| renderInfo @@ -192,6 +594,8 @@ viewItemTableRow isSelected rowRenderer item = ] ] + + -- Search Bar @@ -199,19 +603,75 @@ viewSearchBar : Html Msg viewSearchBar = div [ class "field" ] [ p [ class "control has-icons-left" ] - [ input [ class "input" ] [] - , span [ class "icon is-left" ] [ i [ class "fas fa-search" ] [] ] - ] + [ input [ class "input" ] [] + , span [ class "icon is-left" ] [ i [ class "fas fa-search" ] [] ] + ] ] + + +-- ACTION MODES +-- + + +canSelectIn : ActionMode -> Bool +canSelectIn mode = + case mode of + Sell -> + True + + Buy -> + True + + Grab -> + True + + Add -> + False + + NoMode -> + False + + +viewControls : ActionMode -> Route.Route -> List (Html Msg) +viewControls mode route = + case mode of + None -> + case route of + Route.PlayerChest -> + [ actionButton (ModeSwitched Sell) "Vendre" "coins" "danger" ] + + Route.GroupLoot -> + [ actionButton (ModeSwitched Grab) "Demander" "praying-hands" "primary" ] + + Route.Merchant -> + [ actionButton (ModeSwitched Buy) "Acheter" "coins" "success" ] + + Route.NewLoot -> + [ actionButton (ModeSwitched Add) "Nouveau loot" "plus" "primary" ] + + m -> + [ actionButton ConfirmAction "Valider" "check" "primary" + , actionButton (ModeSwitched None) "Annuler" "times" "danger" + ] + + + -- UPDATE + +type Msg + = ApiMsg Api.Msg + | ModeMsg Modes.Msg + | PlayerChanged Int + | ClearNotification type Msg = SetSelection (Maybe Selection) | GotLoot ToChest (HttpResult Loot) | GotClaims Int (HttpResult Claims) | SwitchSelectionState Int - + | ModeSwitched ActionMode + | ConfirmAction update : Msg -> Model -> ( Model, Cmd Msg ) @@ -226,10 +686,11 @@ update msg model = GotClaims id result -> case result of Ok claims -> - ( { model | claims = - List.filter - (\c -> c.player_id == id) - claims + ( { model + | claims = + List.filter + (\c -> c.player_id == id) + claims } , Cmd.none ) @@ -253,12 +714,14 @@ update msg model = ) Err error -> - ( model , Cmd.none) + ( model, Cmd.none ) + -- Selection - -- Get list of selected items + + getSelected : Route -> Model -> Loot getSelected route model = targetItemsFor route model diff --git a/src/Main.elm b/src/Main.elm index bb5d1e6..c2546ed 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -8,13 +8,12 @@ import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) import Json.Encode as E -import Modes import Route exposing (..) import Set exposing (Set) import Svg.Attributes import Url import Utils exposing (..) - +import Session exposing (..) -- Main @@ -35,55 +34,35 @@ main = -- Model +type Model + = Chest Chest.Model + | Admin Admin.Model + | About -type alias State = - { menuOpen : Bool - , error : Maybe String - , notification : Maybe String - } - - -type alias Model = - { state : State - , navKey : Nav.Key - , route : Route - , mode : Modes.Model - , player : Player - , chest : Chest.Model - } - - -init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) +-- This is not what we really want. +-- The flags will be a Maybe Int (id of logged in player), so +-- in case there is no player logged in, we need to display +-- a "Home" page +-- This mean Chest cannot be initiated right away, and many model +-- fields are useless. +-- +-- A User can : +-- - not be logged in -> See About page +-- - just loggend in -> See Loading page then Chest +-- - coming back being still logged in -> See Chest (or same as above) +init : Maybe Int -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) init flags url key = - let - route = - case routeParser url of - Just r -> - r + case flags of + Just id -> + let + session = + Session.LoggedIn key <| Session.User.Player id + in + (Chest <| Chest.init id, Cmd.none) - Nothing -> - PlayerChest + Nothing -> + (About, Cmd.none) - (chest, cmd) = - Chest.init 0 - in - ( Model - (State False Nothing Nothing) - key - route - Modes.init - Api.blankPlayer - chest - , Cmd.batch - [ initPlayer 0 - , Cmd.map ChestMsg cmd - ] - ) - - - -initPlayer id = - Cmd.map ApiMsg <| Api.fetchPlayer id --- @@ -93,206 +72,26 @@ initPlayer id = view : Model -> Browser.Document Msg view model = let - renderControls = - Modes.viewControls model.mode model.route - |> List.map (Html.map ModeMsg) + (title, body) = + case model of + Chest chest -> + ("Loot-a-lot", Chest.view chest) + Admin session -> + ("Administration", Admin.view session) + About -> + ("A propos", p [] ["A propos"]) in - { title = "Loot-a-lot in ELM" - , body = - [ viewHeaderBar model - , viewPlayerBar model.player renderControls - , main_ - [ class "container" ] - [ viewNotification model.state.notification - , Chest.view - model.mode - model.route - model.chest - |> Html.map ChestMsg - ] - , hr [] [] - , 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 "" - - - --- DEBUG SECTION - - -viewDebugSection : Model -> Html Msg -viewDebugSection model = - div [ class "panel is-danger" ] - [ p [ class "panel-heading" ] [ text "Debug" ] - , debugSwitchPlayers - , 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 "fa-stack" ] - [ 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" - , stackedIcon "fas fa-praying-hands" - , stackedIcon "fas fa-gem" - , stackedIcon "fas fa-pen" - , stackedIcon "fas fa-percentage" - , stackedIcon "fas fa-store-alt" - , stackedIcon "fas fa-cart-plus" - , stackedIcon "fas fa-angry" - , stackedIcon "fas fa-plus" - , stackedIcon "fas fa-tools" - , 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" ] - ] - - - --- 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 { icon = "fab fa-d-and-d", size = "medium", ratio = "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 { icon = "fas fa-store-alt", ratio = "1x", size = "medium" } - , span [] [ text "Marchand" ] - ] - , a - [ class "navbar-item" - , href - (if model.player.id == 0 then - "/nouveau-tresor" - - else - "/coffre" - ) - ] - [ renderIcon { icon = "fas fa-gem", ratio = "1x", size = "medium" } - , span [] - [ text - (if model.player.id == 0 then - "Nouveau loot" - - else - "Coffre de groupe" - ) - ] - ] - ] - ] - ] - - - --- PLAYER BAR - - -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" ] [] ] - ] - ] - ++ 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") ] - ] - ] - - else - [] - ) - ) - , div [ class "level-right" ] actionControls - ] - - -viewWealth : Wealth -> List (Html Msg) -viewWealth wealth = - [ showWealthField "pp" <| String.fromInt wealth.pp - , showWealthField "gp" <| String.padLeft 2 '0' <| String.fromInt wealth.gp - , showWealthField "sp" <| String.fromInt wealth.sp - , 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 ] - ] - ] - --- UPDATE - + { title = title + , body = body } + type Msg - = LinkClicked Browser.UrlRequest - | UrlChanged Url.Url - | ApiMsg Api.Msg - | ChestMsg Chest.Msg - | ModeMsg Modes.Msg - | PlayerChanged Int - | ClearNotification + = UrlChanged Url.Url + | LinkClicked Browser.UrlRequest + | GotChestMsg Chest.Msg + | GotAdminMsg Admin.Msg -update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of LinkClicked urlRequest -> @@ -326,188 +125,12 @@ update msg model = Nothing -> ( setError "Invalid route" model, Cmd.none ) - PlayerChanged newId -> - ( { model | player = Api.blankPlayer }, initPlayer newId ) - - ChestMsg chestMsg -> + GotChestMsg chestMsg -> let - ( chest, _ ) = + ( chest, cmd ) = Chest.update chestMsg model.chest in - ( { model | chest = chest }, Cmd.none ) - - ApiMsg apiMsg -> - case apiMsg of - Api.GotActionResult response -> - case response of - Ok result -> - let - updates = - Maybe.withDefault [] result.updates - - notification = - result.notification - - errors = - Maybe.withDefault "" result.errors - in - List.foldl applyUpdate model updates - |> setNotification notification - |> setError errors - |> update (ModeMsg (Modes.ModeSwitched Modes.None)) - - Err r -> - ( setError (Debug.toString r) model, Cmd.none ) - - Api.GotPlayer result -> - case result of - Ok player -> - ( { model | player = player } - , Cmd.none - ) - - Err error -> - ( setError ("Fetching player... " ++ Debug.toString error) model - , Cmd.none - ) - - ModeMsg modeMsg -> - case modeMsg of - Modes.ModeSwitched newMode -> - ( { model - | mode = newMode - , chest = - let - ( newChest, _ ) = - Chest.update - (Chest.SetSelection - (case newMode of - Modes.None -> - Nothing - - Modes.Grab -> - -- Currently claimed object are initially selected - Just (Set.fromList <| List.map (\c -> c.loot_id) model.chest.claims) - - others -> - Just Set.empty - ) - ) - model.chest - in - newChest - } - , Cmd.none - ) - - Modes.ConfirmAction -> - case model.mode of - -- This should not happen, so we ignore it - Modes.None -> - (model, Cmd.none) - - mode -> - let - items = - Chest.getSelected model.route model.chest - in - ( model - , Cmd.map ApiMsg <| - Api.sendRequest - mode - (String.fromInt model.player.id) - items - ) - - ClearNotification -> - ( setNotification Nothing model, Cmd.none ) - - -setNotification : Maybe String -> Model -> Model -setNotification notification model = - let - state = - model.state - in - { model - | state = - { state | notification = notification } - } - - -setLoot : Loot -> Model -> Model -setLoot items model = - let - chest = - model.chest - in - { model | chest = { chest | loot = items } } - - -setClaims : Claims -> Model -> Model -setClaims claims model = - let - chest = model.chest - in - { model | chest = { chest | claims = claims } } - --- DbUpdates always refer to the active player's loot - - -applyUpdate : Api.Update -> Model -> Model -applyUpdate u model = - case u of - Api.ItemRemoved item -> - model - |> setLoot (List.filter (\i -> i.id /= item.id) model.chest.loot) - - Api.ItemAdded item -> - model |> setLoot (item :: model.chest.loot) - - Api.WealthUpdated diff -> - let - player = - model.player - - wealth = - player.wealth - in - { model - | player = - { player - | wealth = - Wealth - (wealth.cp + diff.cp) - (wealth.sp + diff.sp) - (wealth.gp + diff.gp) - (wealth.pp + diff.pp) - } - } - - Api.ClaimAdded claim -> - model |> setClaims (claim :: model.chest.claims) - - Api.ClaimRemoved claim -> - model - |> setClaims (List.filter (\c -> c.id /= claim.id) model.chest.claims) - - - --- ERRORS - - -setError : String -> Model -> Model -setError error model = - let - state = - model.state - in - { model - | state = - { state | error = Just error } - } - - + ( Chest chest, Cmd.map GotChestMsg cmd ) -- STATE Utils -- SUBSCRIPTIONS diff --git a/src/Modes.elm b/src/Modes.elm deleted file mode 100644 index d0bed8b..0000000 --- a/src/Modes.elm +++ /dev/null @@ -1,59 +0,0 @@ -module Modes exposing (..) - -import Route -import Html exposing (..) -import Html.Attributes exposing (..) -import Utils exposing(actionButton) - -type Model - = Sell - | Buy - | Grab - | Add - | None - -init = - None - -type Msg - = ModeSwitched Model - | ConfirmAction - -canSelectIn : Model -> Bool -canSelectIn mode = - case mode of - Sell -> - True - - Buy -> - True - - Grab -> - True - - Add -> - False - - None -> - False - -viewControls : Model -> Route.Route -> List (Html Msg) -viewControls mode route = - case mode of - None -> - case route of - Route.PlayerChest -> - [ actionButton (ModeSwitched Sell) "Vendre" "coins" "danger" ] - - Route.GroupLoot -> - [ actionButton (ModeSwitched Grab) "Demander" "praying-hands" "primary" ] - - Route.Merchant -> - [ actionButton (ModeSwitched Buy) "Acheter" "coins" "success" ] - - Route.NewLoot -> - [ actionButton (ModeSwitched Add) "Nouveau loot" "plus" "primary" ] - m -> - [ actionButton ConfirmAction "Valider" "check" "primary" - , actionButton (ModeSwitched None) "Annuler" "times" "danger" - ] diff --git a/src/Page/Chest.elm b/src/Page/Chest.elm new file mode 100644 index 0000000..3828374 --- /dev/null +++ b/src/Page/Chest.elm @@ -0,0 +1,6 @@ +module Page.Chest exposing (..) + +-- Put the rest of Chest here + +init = + () diff --git a/src/Page/LoggedOut.elm b/src/Page/LoggedOut.elm new file mode 100644 index 0000000..103d528 --- /dev/null +++ b/src/Page/LoggedOut.elm @@ -0,0 +1,7 @@ +module Page.LoggedOut exposing (view) + +import Html exposing (..) +import Html.Attributes exposing (..) + +view = + p [ class "header is-1" ] [ text "Loot-a-lot" ] diff --git a/src/Route.elm b/src/Route.elm index 446d162..69ff14b 100644 --- a/src/Route.elm +++ b/src/Route.elm @@ -2,24 +2,32 @@ module Route exposing(..) import Url import Url.Parser as P exposing (Parser, (), oneOf, s) ---- --- ROUTES ---- -type Route - = PlayerChest - | Merchant +-- ROUTES + +type ChestContent + = PlayerLoot + | MerchantLoot | GroupLoot | NewLoot -routeParser : Url.Url -> Maybe Route -routeParser url = - P.parse - (oneOf - [ P.map GroupLoot (P.s "coffre") - , P.map PlayerChest P.top - , P.map Merchant (P.s "marchand") - , P.map NewLoot (P.s "nouveau-tresor") +type Route + = Home ChestContent + | About + | Admin + + +parser : P.Parser (Route -> a) a +parser = + oneOf + [ P.map (Home PlayerLoot) P.top + , P.map (Home GroupLoot) (P.s "coffre") + , P.map (Home MerchantLoot) (P.s "marchand") + , P.map (Home NewLoot) (P.s "nouveau-tresor") + , P.map About (P.s "about") + , P.map Admin (P.s "admin") ] - ) - url + +fromUrl : Url.Url -> Maybe Route +fromUrl url = + P.parse parser url diff --git a/src/Session.elm b/src/Session.elm new file mode 100644 index 0000000..6d769d4 --- /dev/null +++ b/src/Session.elm @@ -0,0 +1,12 @@ +module Session exposing (..) + +import Browser.Navigation as Nav + +type User + = Player Int + | Admin + +type Model + = LoggedIn Nav.Key User + | LoggedOut Nav.Key +