cleans up project structure

src/Bulma.elm

@@ -0,0 +1,72 @@
+module Bulma exposing (..)
+
+{-
+
+   Helper to style with Bulma.css
+
+-}
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Svg.Attributes
+
+
+
+-- ICONS
+
+
+icon : { icon : String, size : Maybe String, ratio : Maybe String } -> Html msg
+icon params =
+    span [ class <| "icon " ++ Maybe.withDefault "" params.size ]
+        [ i [ Svg.Attributes.class <| params.icon ++ " " ++ Maybe.withDefault "" params.ratio ] [] ]
+
+
+
+-- BUTTONS
+
+
+btn : msg -> { text : String, icon : String, color : String } -> Html msg
+btn msg params =
+    button
+        [ class <| "button " ++ params.color
+        , onClick msg
+        ]
+        [ icon { icon = params.icon, size = Nothing, ratio = Nothing }
+        , p [] [ text params.text ]
+        ]
+
+
+buttons btns =
+    div [ class "buttons level-item" ] btns
+
+
+confirmButtons confirm cancel =
+    buttons [ confirmBtn confirm, cancelBtn cancel ]
+
+
+confirmBtn msg =
+    btn msg { text = "Ok", icon = "fas fa-check", color = "is-primary" }
+
+
+cancelBtn msg =
+    btn msg { text = "Annuler", icon = "fas fa-times", color = "is-danger" }
+
+
+
+-- TABLES
+--
+
+
+datatable headers rows =
+    table [ class "table is-fullwidth is-striped" ]
+        [ thead [ class "table-header" ] <|
+            List.map
+                (\header -> th [] [ text header ])
+                headers
+        , tbody [] rows
+        ]
+
+
+
+-- Section

src/Chest.elm

@@ -1,9 +1,9 @@
-module Page.Chest exposing (..)
+module Chest exposing (..)
 
 import Api exposing (Claims, Item, Loot)
+import Chest.NewFromInventory as NewFromInventory
+import Chest.Selection as Selection
 import Html exposing (..)
-import Page.Chest.NewFromInventory as NewFromInventory
-import Page.Chest.Selection as Selection
 import Table
 import Utils
 

src/Chest/NewFromInventory.elm

@@ -1,6 +1,7 @@
-module Page.Chest.NewFromInventory exposing (..)
+module Chest.NewFromInventory exposing (..)
 
 import Api exposing (Item, Loot)
+import Bulma as B
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
@@ -25,25 +26,22 @@ init =
 view : Model -> Html Msg
 view model =
     article []
-        [ div [ class "section" ]
+        [ textarea
-            [ textarea
+            [ class "textarea"
-                [ class "textarea"
+            , value model.itemList
-                , value model.itemList
+            , onInput ItemListInput
-                , onInput ItemListInput
+            , placeholder "Coller une liste d'objets"
-                , placeholder "Coller une liste d'objets"
-                ]
-                []
-            , button
-                [ class "button is-primary is-fullwidth"
-                , onClick ItemListSend
-                ]
-                [ text "Mettre dans le coffre" ]
             ]
-        , div [ class "section" ]
+            []
-            [ model.validItems
+        , button
-                ++ model.invalidItems
+            [ class "button is-primary is-fullwidth"
-                |> Table.view (Table.renderRowLevel viewOrEditRenderer (\i -> []))
+            , onClick ItemListSend
             ]
+            [ text "Mettre dans le coffre" ]
+        , hr [] []
+        , model.validItems
+            ++ model.invalidItems
+            |> Table.view (Table.renderRowLevel viewOrEditRenderer (\i -> []))
         ]
 
 
@@ -72,18 +70,21 @@ viewOrEditRenderer item =
 
             priceValid =
                 item.base_price > 0
+
+            itemValid =
+                nameValid && priceValid
         in
-        [ div [ class "field is-grouped" ]
+        [ div [ class "field level-item" ]
-            [ div [ class "control" ]
+            [ input
-                [ input
+                [ class "input is-small "
-                    [ class "input is-small "
+                , type_ "text"
-                    , type_ "text"
+                , value item.name
-                    , value item.name
+                , onInput <| InvalidItemNameChanged item.id
-                    , onInput <| InvalidItemNameChanged item.id
-                    ]
-                    []
                 ]
-            , div [ class "control" ]
+                []
+            ]
+        , div [ class "field has-addons level-item" ]
+            [ p [ class "control" ]
                 [ input
                     [ class "input is-small "
                     , type_ "text"
@@ -92,7 +93,13 @@ viewOrEditRenderer item =
                     ]
                     []
                 ]
+            , p [ class "control is-small" ] [ a [ class "button is-static" ] [ text "Prix" ] ]
             ]
+        , if itemValid then
+            B.icon { icon = "fas fa-check", size = Nothing, ratio = Nothing }
+
+          else
+            B.icon { icon = "fas fa-times", size = Nothing, ratio = Nothing }
         ]
 
     else

src/Chest/Selection.elm

@@ -1,4 +1,4 @@
-module Page.Chest.Selection exposing (Model, Msg, init, modifiers, selected, update, view)
+module Chest.Selection exposing (Model, Msg, init, modifiers, selected, update, view)
 
 import Api exposing (Item, Loot)
 import Dict exposing (Dict)

src/Page/Admin.elm.old

@@ -1,181 +0,0 @@
-module Page.Admin exposing (Model)
-
-import Api exposing (Loot)
-import Api.Player as Player exposing (Player, Wealth)
-import Browser.Navigation as Nav
-import Html exposing (..)
-import Html.Attributes exposing (..)
-import Html.Events exposing (..)
-import Page.Shop as Shop
-import Route exposing (Route)
-import Session exposing (Session)
-
-
-type alias NewPlayerForm =
-    { name : String
-    , wealth : Float
-    }
-
-
-type alias Status =
-    { session : Session
-    , players : List Player
-    , newPlayer : NewPlayerForm
-    }
-
-
-type Model
-    = Dashboard Status
-    | MerchantLoot Shop.Model
-
-
-init : Session -> ( Model, Cmd Msg )
-init session =
-    ( Dashboard (Status session [] (NewPlayerForm "" 0.0))
-    , Player.list GotPlayers
-    )
-
-
-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
-        Dashboard config ->
-            [ div [ class "container" ]
-                [ p [ class "title" ] [ text "Administration" ]
-                , div [ class "section" ]
-                    [ table [ class "table is-fullwidth is-striped" ]
-                        [ thead [ class "table-header" ]
-                            [ th [] [ text "Joueurs" ] ]
-                        , tbody [] <|
-                            editNewPlayer config.newPlayer
-                                :: List.map viewPlayer config.players
-                        ]
-                    ]
-                , div [ class "section" ]
-                    [ p [] [ text "Campagnes" ] ]
-                ]
-            ]
-
-        MerchantLoot shop ->
-            let
-                toShopMsg =
-                    Html.map ShopMsg
-
-                ( controls, viewShop ) =
-                    Shop.view shop
-                        |> Tuple.mapBoth toShopMsg (List.map toShopMsg)
-            in
-            [ div [ class "container" ] <|
-                p [ class "title" ] [ text "Marchand" ]
-                    :: controls
-                    :: viewShop
-            ]
-
-
-viewPlayer : Player -> Html Msg
-viewPlayer player =
-    tr [] [ td [] [ p [] [ text (player.name ++ " (" ++ String.fromInt player.id ++ ")") ] ] ]
-
-
-editNewPlayer : NewPlayerForm -> Html Msg
-editNewPlayer newPlayer =
-    tr []
-        [ td []
-            [ div [ class "field is-horizontal" ]
-                [ div [ class "field-body" ]
-                    [ div [ class "field" ]
-                        [ input
-                            [ class "input"
-                            , type_ "text"
-                            , value newPlayer.name
-                            , onInput <| GotFormMsg << NameChanged
-                            ]
-                            []
-                        ]
-                    , div [ class "field" ]
-                        [ input
-                            [ class "input"
-                            , type_ "text"
-                            , value <| String.fromFloat newPlayer.wealth
-                            , onInput <| GotFormMsg << WealthChanged
-                            ]
-                            []
-                        ]
-                    ]
-                ]
-            ]
-        ]
-
-
-type Msg
-    = GotPlayers (List Player)
-    | GotFormMsg FormMsg
-    | ShopMsg Shop.Msg
-
-
-type FormMsg
-    = NameChanged String
-    | WealthChanged String
-
-
-updateForm : FormMsg -> NewPlayerForm -> NewPlayerForm
-updateForm msg form =
-    case msg of
-        NameChanged newName ->
-            { form | name = newName }
-
-        WealthChanged newWealth ->
-            { form | wealth = Maybe.withDefault 0.0 <| String.toFloat newWealth }
-
-
-routeChanged : Route.Route -> Model -> ( Model, Cmd Msg )
-routeChanged route model =
-    case model of
-        Dashboard config ->
-            case route of
-                Route.Home Route.MerchantLoot ->
-                    Tuple.mapBoth
-                        MerchantLoot
-                        (Cmd.map ShopMsg)
-                        (config.session |> Shop.init)
-
-                _ ->
-                    ( model, Cmd.none )
-
-        MerchantLoot shop ->
-            case route of
-                Route.Home Route.PlayerLoot ->
-                    init shop.session
-
-                _ ->
-                    ( model, Cmd.none )
-
-
-update msg model =
-    case ( msg, model ) of
-        ( GotPlayers players, Dashboard config ) ->
-            ( Dashboard { config | players = players }, Cmd.none )
-
-        ( GotFormMsg formMsg, Dashboard config ) ->
-            ( Dashboard { config | newPlayer = updateForm formMsg config.newPlayer }, Cmd.none )
-
-        ( _, Dashboard _ ) ->
-            ( model, Cmd.none )
-
-        ( ShopMsg shopMsg, MerchantLoot shopModel ) ->
-            Shop.update shopMsg shopModel
-                |> Tuple.mapBoth
-                    MerchantLoot
-                    (Cmd.map ShopMsg)
-
-        ( _, MerchantLoot _ ) ->
-            ( model, Cmd.none )

src/Page/Dashboard.elm

@@ -2,10 +2,11 @@ module Page.Dashboard exposing (Model, Msg(..), getSession, init, update, update
 
 import Api
 import Api.Player as Player exposing (Player, Wealth)
+import Bulma as B
+import Chest exposing (Chest)
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
-import Page.Chest as Chest exposing (Chest)
 import Session exposing (Session)
 
 
@@ -98,16 +99,34 @@ view model =
                             Chest.View _ ->
                                 case data.player.id of
                                     0 ->
-                                        buttons [ modeButton "Vendre" (GotChestMsg Chest.sell), modeButton "Ajouter" (GotChestMsg Chest.new) ]
+                                        buttons
+                                            [ B.btn
+                                                (GotChestMsg Chest.sell)
+                                                { text = "Vendre"
+                                                , icon = "fas fa-coins"
+                                                , color = "is-primary"
+                                                }
+                                            , B.btn
+                                                (GotChestMsg Chest.new)
+                                                { text = "Nouveau loot"
+                                                , icon = "fas fa-plus"
+                                                , color = "is-primary"
+                                                }
+                                            ]
 
                                     _ ->
-                                        modeButton "Vendre" (GotChestMsg Chest.sell)
+                                        B.btn
+                                            (GotChestMsg Chest.sell)
+                                            { text = "Vendre"
+                                            , icon = "fas fa-coins"
+                                            , color = "is-primary"
+                                            }
 
                             Chest.Sell _ ->
-                                buttons [ modeButton "Ok" ConfirmSell, modeButton "Annuler" toShow ]
+                                B.confirmButtons ConfirmSell toShow
 
                             Chest.New _ ->
-                                buttons [ modeButton "Ok" ConfirmAdd, modeButton "Annuler" toShow ]
+                                B.confirmButtons ConfirmAdd toShow
 
                             _ ->
                                 text ""
@@ -125,10 +144,15 @@ view model =
         Admin (AdminConfig session players playerForm) ->
             ( case playerForm of
                 Nothing ->
-                    modeButton "Ajouter un joueur" (AdminViewer EditPlayer)
+                    B.btn
+                        (AdminViewer EditPlayer)
+                        { text = "Ajouter un joueur"
+                        , icon = "fas fa-plus"
+                        , color = "is-primary"
+                        }
 
                 Just _ ->
-                    buttons [ modeButton "Ok" ConfirmNewPlayer, modeButton "Annuler" CloseEdit ]
+                    B.confirmButtons ConfirmNewPlayer CloseEdit
                         |> Html.map AdminViewer
             , [ div [ class "section" ]
                     [ case playerForm of
@@ -137,11 +161,9 @@ view model =
 
                         Just form ->
                             editNewPlayer form
-                    , table [ class "table is-fullwidth is-striped" ]
+                    , B.datatable
-                        [ thead [ class "table-header" ]
+                        [ "Joueurs" ]
-                            [ th [] [ text "Joueurs" ] ]
+                        (List.map viewPlayer players)
-                        , tbody [] <| List.map viewPlayer players
-                        ]
                     ]
               ]
             )

src/Page/GroupChest.elm

@@ -1,14 +1,12 @@
-module Page.GroupChest exposing (Model, Msg(..), init, refresh, update, view)
+module Page.GroupChest exposing (Model, Msg(..), init, update, view)
 
 import Api exposing (HttpResult, Loot)
+import Bulma as B
+import Chest exposing (Chest)
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
-import Page.Chest as Chest exposing (Chest)
 import Session exposing (Session, User(..))
-import Set
-import Table
-import Utils exposing (renderIcon)
 
 
 type alias Model =
@@ -26,7 +24,7 @@ type State
 
 getClaimsFromSession session =
     case Session.user session of
-        Session.Player data ->
+        Player data ->
             if data.player.id /= 0 then
                 data.claims
                 -- TODO: The group and admin case should be impossible !
@@ -34,7 +32,7 @@ getClaimsFromSession session =
             else
                 []
 
-        Session.Admin _ ->
+        Admin _ ->
             []
 
 
@@ -66,23 +64,20 @@ view model =
                 let
                     ( isPlayer, isGroup ) =
                         case Session.user model.session of
-                            Session.Admin _ ->
+                            Admin _ ->
                                 ( False, False )
 
-                            Session.Player data ->
+                            Player data ->
                                 ( True, data.player.id == 0 )
                 in
                 case ( model.chest, isPlayer && not isGroup ) of
                     ( Chest.View _, True ) ->
-                        button
+                        B.btn
-                            [ class "button"
+                            (GotChestMsg <| Chest.claim (getClaimsFromSession model.session))
-                            , onClick
+                            { text = "Demander", icon = "fas fa-praying-hands", color = "is-primary" }
-                                (GotChestMsg <| Chest.claim (getClaimsFromSession model.session))
-                            ]
-                            [ text "Demander" ]
 
                     ( Chest.Claim _, True ) ->
-                        button [ class "button", onClick ConfirmGrab ] [ text "Valider" ]
+                        B.confirmButtons ConfirmGrab (GotChestMsg Chest.show)
 
                     ( _, _ ) ->
                         text ""
@@ -103,10 +98,6 @@ type InnerMsg
     | ConfirmGrab
 
 
-refresh model =
-    update (Internal <| GotChestMsg (Chest.intoMode (Chest.IntoViewWithClaims (getClaimsFromSession model.session)))) model
-
-
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
     case msg of
@@ -115,7 +106,7 @@ update msg model =
 
         Internal ConfirmGrab ->
             case ( Session.user model.session, model.loot, model.chest ) of
-                ( Session.Player data, Loaded loot, Chest.Claim _ ) ->
+                ( Player data, Loaded loot, Chest.Claim _ ) ->
                     ( model
                     , Chest.confirmGrab
                         data.player.id
@@ -128,24 +119,19 @@ update msg model =
                     ( model, Cmd.none )
 
         Internal innerMsg ->
-            (case innerMsg of
+            Tuple.mapSecond (Cmd.map Internal) <|
-                GotLoot _ (Ok loot) ->
+                case innerMsg of
-                    ( { model | loot = Loaded loot }, Cmd.none )
+                    GotLoot _ (Ok loot) ->
+                        ( { model | loot = Loaded loot }, Cmd.none )
 
-                GotLoot _ (Err _) ->
+                    GotLoot _ (Err _) ->
-                    ( { model | loot = LoadError "Le chargement a échoué" }, Cmd.none )
+                        ( { model | loot = LoadError "Le chargement a échoué" }, Cmd.none )
 
-                GotChestMsg chestMsg ->
+                    GotChestMsg chestMsg ->
-                    Chest.update chestMsg model.chest
+                        Chest.update chestMsg model.chest
-                        |> updateChest model
+                            |> Tuple.mapBoth
+                                (\chest -> { model | chest = chest })
+                                (Cmd.map GotChestMsg)
 
-                _ ->
+                    _ ->
-                    ( model, Cmd.none )
+                        ( model, Cmd.none )
-            )
-                |> Tuple.mapSecond (Cmd.map Internal)
-
-
-updateChest model ( chestModel, chestCmd ) =
-    ( { model | chest = chestModel }
-    , Cmd.map GotChestMsg chestCmd
-    )

src/Page/LoggedOut.elm

@@ -1,7 +0,0 @@
-module Page.LoggedOut exposing (view)
-
-import Html exposing (..)
-import Html.Attributes exposing (..)
-
-view =
-    p [ class "header is-1" ] [ text "Loot-a-lot" ]

src/Page/Shop.elm

@@ -1,15 +1,13 @@
 module Page.Shop exposing (Model, Msg(..), init, update, view)
 
 import Api exposing (HttpResult, Item, Loot)
-import Dict exposing (Dict)
+import Bulma as B
+import Chest exposing (Chest)
+import Chest.NewFromInventory as NewChest
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
-import Page.Chest as Chest exposing (Chest)
-import Page.Chest.NewFromInventory as NewChest
 import Session exposing (Session, getSession)
-import Set exposing (Set)
-import Table
 
 
 type alias Model =
@@ -29,21 +27,6 @@ init session =
     ( Model session Loading Chest.init, fetchShopItems )
 
 
-fetchShopItems =
-    Api.fetchLoot GotLoot Api.OfShop
-        |> Cmd.map Internal
-
-
-btn : String -> msg -> Html msg
-btn t msg =
-    button [ class "button", onClick msg ] [ text t ]
-
-
-buttons : List (Html msg) -> Html msg
-buttons bs =
-    div [ class "buttons" ] bs
-
-
 view : Model -> ( Html Msg, List (Html Msg) )
 view model =
     case model.loot of
@@ -58,27 +41,26 @@ view model =
             )
 
         Loaded loot ->
-            let
+            ( Html.map Internal <|
-                controls =
+                case ( model.chest, Session.user model.session ) of
-                    Html.map Internal <|
+                    ( Chest.View _, Session.Admin _ ) ->
-                        case ( model.chest, Session.user model.session ) of
+                        B.btn (GotChestMsg Chest.new) { text = "Remplacer", icon = "fas fa-sync-alt", color = "is-primary" }
-                            ( Chest.View _, Session.Admin _ ) ->
-                                btn "Remplacer" (GotChestMsg Chest.new)
 
-                            ( Chest.View _, Session.Player _ ) ->
+                    ( Chest.View _, Session.Player _ ) ->
-                                btn "Acheter" (GotChestMsg Chest.buy)
+                        B.btn (GotChestMsg Chest.buy) { text = "Acheter", icon = "fas fa-coins", color = "is-primary" }
 
-                            ( Chest.Buy _, Session.Player _ ) ->
+                    ( Chest.Buy _, Session.Player _ ) ->
-                                buttons [ btn "Ok" ConfirmBuy, btn "Annuler" (GotChestMsg Chest.show) ]
+                        B.confirmButtons ConfirmBuy (GotChestMsg Chest.show)
 
-                            ( Chest.New _, Session.Admin _ ) ->
+                    ( Chest.New _, Session.Admin _ ) ->
-                                buttons [ btn "Ok" ConfirmRefresh, btn "Annuler" (GotChestMsg Chest.show) ]
+                        B.confirmButtons ConfirmRefresh (GotChestMsg Chest.show)
 
-                            _ ->
+                    _ ->
-                                text ""
+                        text ""
-            in
+            , List.map
-            ( controls
+                (Html.map Internal)
-            , [ Chest.view model.chest loot |> Html.map (Internal << GotChestMsg) ]
+                [ Chest.view model.chest loot |> Html.map GotChestMsg
+                ]
             )
 
 
@@ -180,3 +162,8 @@ update msg model =
 
         _ ->
             ( model, Cmd.none )
+
+
+fetchShopItems =
+    Api.fetchLoot GotLoot Api.OfShop
+        |> Cmd.map Internal