refactoring with one page per route (wip)

This commit is contained in:
2019-11-27 16:04:26 +01:00
parent 89b22bb07d
commit 32ff8bd2d6
7 changed files with 353 additions and 228 deletions

View File

@@ -6,6 +6,7 @@ import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Json.Encode as E
import Page exposing (Page)
import Page.Admin as Admin
import Page.Chest as Chest exposing (Msg)
import Route exposing (..)
@@ -52,28 +53,6 @@ initNavbar key =
Navbar False key
type Page
= Chest Chest.Model
| Admin Admin.Model
| About
| Loading
{-
type Page
= Dashboard Session
| GroupChest Session
| Shop Shop.Model
| NewLoot Session
| About
| Loading
-}
type alias HasPage r =
{ r | page : Page }
@@ -83,24 +62,10 @@ setPage page model =
{ model | page = page }
-- 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 : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
init _ _ key =
( { navbar = initNavbar key
, page = Loading
, page = Page.Loading
}
, Session.init SessionLoaded key
)
@@ -114,69 +79,15 @@ view : Model -> Browser.Document Msg
view model =
let
( title, header, content ) =
viewPage model.page
Page.view model.page
in
{ title = title
, body =
viewHeaderBar header.title header.links model.navbar
:: content
:: List.map (Html.map PageMsg) content
}
viewPage page =
let
( title, content ) =
case page of
Chest chest ->
( "Loot-a-lot", List.map (Html.map GotChestMsg) (Chest.view chest) )
Admin admin ->
( "Administration", List.map (Html.map GotAdminMsg) (Admin.view admin) )
About ->
( "A propos", [ p [] [ text "A propos" ] ] )
Loading ->
( "Veuillez patienter...", [ p [] [ text "Chargement" ] ] )
navbarTitle =
case page of
Chest chest ->
chest.state.player.name
Admin _ ->
"Administration"
About ->
"Loot-a-lot"
Loading ->
"Loot-a-(...)"
navbarLinks =
case page of
Chest chest ->
let
linkWithGem =
navLink "fas fa-gem"
in
[ navLink "fas fa-store-alt" "Marchand" "/marchand"
, if chest.state.player.id == 0 then
linkWithGem "Nouveau loot" "/nouveau-tresor"
else
linkWithGem "Coffre de groupe" "/coffre"
]
Admin _ ->
[ navLink "fas fa-store-alt" "Marchand" "/marchand" ]
_ ->
[]
in
( title, { title = navbarTitle, links = navbarLinks }, content )
-- HEADER SECTION
@@ -220,15 +131,10 @@ type Msg
= UrlChanged Url.Url
| LinkClicked Browser.UrlRequest
| SessionLoaded (Maybe Session)
| GotChestMsg Chest.Msg
| GotAdminMsg Admin.Msg
| PageMsg Page.PageMsg
| SwitchMenuOpen
-- | GotAdminMsg Admin.Msg
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case ( msg, model.page ) of
@@ -236,23 +142,13 @@ update msg model =
case session of
Just logged ->
let
navKey =
Session.key logged
user =
Session.user logged
( page, cmd ) =
Page.gotoHome logged
in
case user of
Session.Player playerId ->
updatePage Chest GotChestMsg model <|
Chest.init navKey playerId
Session.Admin ->
updatePage Admin GotAdminMsg model <|
Admin.init logged
( model |> setPage page, Cmd.map PageMsg cmd )
Nothing ->
( model |> setPage About, Cmd.none )
( model |> setPage Page.About, Cmd.none )
( LinkClicked urlRequest, _ ) ->
case urlRequest of
@@ -265,38 +161,37 @@ update msg model =
( UrlChanged url, page ) ->
-- Handle routing according to current page
case ( Route.fromUrl url, page ) of
( Just (Route.Home content), Chest chest ) ->
( model |> setPage (Chest (Chest.setContent content chest))
( Just (Route.Home Route.MerchantLoot), Page.Admin admin ) ->
let
( shopPage, cmd ) =
Page.gotoShop (Admin.getSession admin)
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, Admin admin ) ->
Admin.routeChanged route admin
|> updatePage Admin GotAdminMsg model
{-
( Just route, Page.Admin admin ) ->
Admin.routeChanged route admin
|> updatePage Page.Admin GotAdminMsg model
-}
_ ->
( model |> setPage About, Cmd.none )
( model |> setPage Page.About, Cmd.none )
( SwitchMenuOpen, _ ) ->
( { model | navbar = Navbar (not model.navbar.menuOpen) model.navbar.navKey }, Cmd.none )
( GotChestMsg chestMsg, Chest chest ) ->
Chest.update chestMsg chest
|> updatePage Chest GotChestMsg model
( GotAdminMsg adminMsg, Admin adminModel ) ->
Admin.update adminMsg adminModel
|> updatePage Admin GotAdminMsg model
( _, _ ) ->
( model, Cmd.none )
updatePage : (pageModel -> Page) -> (pageMsg -> Msg) -> Model -> ( pageModel, Cmd pageMsg ) -> ( Model, Cmd Msg )
updatePage toPage toMsg model ( pageModel, pageCmd ) =
( { model | page = toPage pageModel }
, Cmd.map toMsg pageCmd
)
( PageMsg pageMsg, page ) ->
let
( newPage, cmd ) =
Page.update pageMsg page
in
( { model | page = newPage }
, Cmd.map PageMsg cmd
)

226
src/Page.elm Normal file
View File

@@ -0,0 +1,226 @@
module Page exposing (Page(..), PageMsg, gotoHome, gotoShop, update, view)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Page.Admin as Admin
import Page.Chest as Chest
import Page.Shop as Shop
import Session exposing (Session)
import Utils exposing (renderIcon)
type Page
= Chest Chest.Model
| Admin Admin.Model
| Shop Shop.Model
| About
| Loading
{-
type Page
= Dashboard Session
| GroupChest Session
| Shop Shop.Model
| NewLoot Session
| About
| Loading
-}
init =
Loading
mapMsg toMsg =
List.map (Html.map toMsg)
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 ) )
Admin admin ->
( "Administration", ( text "", mapMsg GotAdminMsg <| Admin.view admin ) )
Shop shop ->
( "Marchand"
, Shop.view shop
|> Tuple.mapBoth
(Html.map GotShopMsg)
(mapMsg GotShopMsg)
)
About ->
( "Loot-a-lot", ( text "", [ p [] [ text "A propos" ] ] ) )
Loading ->
( "Loot-a-lot", ( text "", [ p [] [ text "Chargement" ] ] ) )
navbarTitle =
case maybeSession of
Just session ->
case Session.user session of
Session.Player id ->
String.fromInt id
Session.Admin ->
"Administration"
Nothing ->
"Loot-a-lot"
navbarLinks =
case maybeSession of
Just session ->
case Session.user session of
Session.Player id ->
let
linkWithGem =
navLink "fas fa-gem"
in
[ navLink "fas fa-store-alt" "Marchand" "/marchand"
, if id == 0 then
linkWithGem "Nouveau loot" "/nouveau-tresor"
else
linkWithGem "Coffre de groupe" "/coffre"
]
Session.Admin ->
[ navLink "fas fa-store-alt" "Marchand" "/marchand" ]
Nothing ->
[]
in
( title
, { title = navbarTitle, links = navbarLinks }
, viewSessionBar maybeSession controls
:: content
)
viewSessionBar maybeSession controls =
controls
-- 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
]
]
]
-}
navLink icon linkText url =
a [ class "navbar-item", href url ]
[ renderIcon { icon = icon, ratio = "1x", size = "medium" }
, span [] [ text linkText ]
]
-- UPDATE
--
type PageMsg
= GotChestMsg Chest.Msg
| GotAdminMsg Admin.Msg
| GotShopMsg Shop.Msg
update msg page =
case ( msg, page ) of
( GotChestMsg subMsg, Chest chest ) ->
Chest.update subMsg chest
|> updatePage Chest GotChestMsg
( GotAdminMsg subMsg, Admin admin ) ->
Admin.update subMsg admin
|> updatePage Admin GotAdminMsg
( GotShopMsg subMsg, Shop shop ) ->
Shop.update subMsg shop
|> updatePage Shop GotShopMsg
_ ->
( page, Cmd.none )
updatePage toPage toMsg ( subModel, subMsg ) =
( toPage subModel
, Cmd.map toMsg subMsg
)
-- 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
gotoShop session =
Shop.init session
|> updatePage Shop GotShopMsg
gotoGroupChest session =
()
gotoInventory session =
()

View File

@@ -1,4 +1,4 @@
module Page.Admin exposing (Model, Msg, init, routeChanged, update, view)
module Page.Admin exposing (Model, Msg, getSession, init, routeChanged, update, view)
import Api exposing (Loot)
import Api.Player as Player exposing (Player, Wealth)
@@ -8,7 +8,7 @@ import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Page.Shop as Shop
import Route exposing (Route)
import Session exposing (Session, getSession)
import Session exposing (Session)
type alias NewPlayerForm =
@@ -36,6 +36,15 @@ init session =
)
getSession model =
case model of
Dashboard status ->
Session.getSession status
MerchantLoot shop ->
Session.getSession shop
view : Model -> List (Html Msg)
view model =
case model of

View File

@@ -17,6 +17,7 @@ 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 (..)
@@ -28,89 +29,7 @@ setContent content model =
-- MODEL
{-
type alias ViewConfig =
{ filterText : String
}
type alias Selection data =
{ selection : Set Int -- Set of selected items
, selectionData : Dict Int data -- Data associated by id
}
type alias AddConfig =
{ showModal : Bool
, autoComplete : Loot
, newItem : Maybe Item
, sourceName : Maybe String
, itemList : Maybe (List String)
}
type ChestMsg
= ConfirmAction
| CancelAction
| EnterMode ActionMode
| ViewMsg
| SelectionMsg
| AddMsg
type Content
= PlayerLoot Int
| GroupLoot
| MerchantShop
| Inventory
type Context
= View String
| Sell (Selection Int)
| Buy (Selection Int)
| Grab (Selection ())
| Add AddConfig
type Chest
= Chest Context Loot
type Chest
= View ViewConfig Loot
| Sell Selection Loot
| Buy Selection Loot
| Grab Selection Loot
| Add AddConfig Loot
type alias Cache =
{ playerLoot : ...
, ...
, claims : Claims
}
-- Leading to new model
type alias Model =
{ navKey: Nav.Key
, error : Maybe String
, notification : Maybe String
, player : Player
, wealth : Wealth.Model
, cache : Cache
, chest : Chest
}
-- Hence,
type ViewMsg
= SetContent ChestContent
| SearchTextChanged String
type AddMsg
= NewItemAdded Item
| NewItemNameChanged String
@@ -180,7 +99,7 @@ type alias Selection =
type alias Model =
{ navKey : Nav.Key
{ session : Session
, state : State
-- Chest
@@ -194,9 +113,22 @@ type alias Model =
}
init navKey playerId =
init : Session -> ( Model, Cmd Msg )
init session =
let
navKey =
Session.key session
playerId =
case Session.user session of
Session.Player id ->
id
Session.Admin ->
0
in
( Model
navKey
session
(State
View
Nothing
@@ -1119,7 +1051,7 @@ update msg model =
OnModeExit mode ->
if mode == Add || mode == Buy then
-- Redirect to PlayerLoot view
( model, Nav.pushUrl model.navKey "/" )
( model, Nav.pushUrl (Session.key model.session) "/" )
else
( model, Cmd.none )

0
src/Page/Dashboard.elm Normal file
View File

64
src/Page/GroupChest.elm Normal file
View File

@@ -0,0 +1,64 @@
module Page.GroupChest exposing (..)
import Api exposing (HttpResult, Loot)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Session exposing (Session)
import Table
type alias Model =
{ session : Session
, state : State
}
type State
= Loading
| LoadError String
| View Loot
init session =
( Model session Loading, Api.fetchLoot GotLoot Api.OfGroup )
view model =
case model.state of
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 ->
text ""
Session.Player id ->
if id == 0 then
button [ class "button" ] [ text "Vendre" ]
else
button [ class "button" ] [ text "Demander" ]
, [ Table.view Table.name loot ]
)
type Msg
= GotLoot Api.ToChest (HttpResult Loot)
update msg model =
case msg of
GotLoot _ (Ok loot) ->
( { model | state = View loot }, Cmd.none )
GotLoot _ (Err _) ->
( { model | state = LoadError "Le chargement a échoué" }, Cmd.none )

View File

@@ -1,11 +1,10 @@
module Page.Shop exposing (Model, Msg, init, update, view)
import Api exposing (Item, Loot)
import Api exposing (HttpResult, Item, Loot)
import Dict exposing (Dict)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Http
import Page.Chest.NewFromInventory as NewChest
import Session exposing (Session, getSession)
import Set exposing (Set)
@@ -70,7 +69,7 @@ view model =
type Msg
= GotLoot Api.ToChest (Result Http.Error Loot)
= GotLoot Api.ToChest (HttpResult Loot)
| IntoRefresh
| GotChestMsg NewChest.Msg
| GotRefreshResult (Maybe ())