diff --git a/src/Main.elm b/src/Main.elm index 15da2ed..14cdbc1 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -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 + ) diff --git a/src/Page.elm b/src/Page.elm new file mode 100644 index 0000000..f6b3fd6 --- /dev/null +++ b/src/Page.elm @@ -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 = + () diff --git a/src/Page/Admin.elm b/src/Page/Admin.elm index 0cd150e..d8c7001 100644 --- a/src/Page/Admin.elm +++ b/src/Page/Admin.elm @@ -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 diff --git a/src/Page/Chest.elm b/src/Page/Chest.elm index 00a887c..fa3d9fd 100644 --- a/src/Page/Chest.elm +++ b/src/Page/Chest.elm @@ -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 ) diff --git a/src/Page/Dashboard.elm b/src/Page/Dashboard.elm new file mode 100644 index 0000000..e69de29 diff --git a/src/Page/GroupChest.elm b/src/Page/GroupChest.elm new file mode 100644 index 0000000..ed37161 --- /dev/null +++ b/src/Page/GroupChest.elm @@ -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 ) diff --git a/src/Page/Shop.elm b/src/Page/Shop.elm index 7dcc486..882991a 100644 --- a/src/Page/Shop.elm +++ b/src/Page/Shop.elm @@ -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 ())