cleaning up
This commit is contained in:
615
src/Main.elm
615
src/Main.elm
@@ -8,7 +8,7 @@ import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (..)
|
||||
import Json.Encode as E
|
||||
import Modes exposing (ViewMode)
|
||||
import Modes
|
||||
import Route exposing (..)
|
||||
import Set exposing (Set)
|
||||
import Svg.Attributes
|
||||
@@ -47,7 +47,7 @@ type alias Model =
|
||||
{ state : State
|
||||
, navKey : Nav.Key
|
||||
, route : Route
|
||||
, mode : Maybe ViewMode
|
||||
, mode : Modes.Model
|
||||
, player : Player
|
||||
, chest : Chest.Model
|
||||
}
|
||||
@@ -63,386 +63,44 @@ init flags url key =
|
||||
|
||||
Nothing ->
|
||||
PlayerChest
|
||||
|
||||
(chest, cmd) =
|
||||
Chest.init 0
|
||||
in
|
||||
( Model
|
||||
(State False Nothing Nothing)
|
||||
key
|
||||
route
|
||||
Nothing
|
||||
Modes.init
|
||||
Api.blankPlayer
|
||||
Chest.init
|
||||
, fetchInitialData 0
|
||||
chest
|
||||
, Cmd.batch
|
||||
[ initPlayer 0
|
||||
, Cmd.map ChestMsg cmd
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
fetchInitialData : Int -> Cmd Msg
|
||||
fetchInitialData playerId =
|
||||
Cmd.batch
|
||||
[ initPlayer playerId
|
||||
, Cmd.map ApiMsg <| Api.fetchLoot Api.OfShop
|
||||
, Cmd.map ApiMsg <| Api.fetchLoot Api.OfGroup
|
||||
]
|
||||
|
||||
|
||||
initPlayer id =
|
||||
Cmd.batch
|
||||
[ Cmd.map ApiMsg <| Api.fetchPlayer id
|
||||
, Cmd.map ApiMsg <| Api.fetchLoot (Api.OfPlayer id)
|
||||
, Cmd.map ApiMsg <| Api.fetchClaims id
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- UPDATE
|
||||
|
||||
|
||||
type Msg
|
||||
= LinkClicked Browser.UrlRequest
|
||||
| UrlChanged Url.Url
|
||||
| ApiMsg Api.Msg
|
||||
| ChestMsg Chest.Msg
|
||||
| PlayerChanged Int
|
||||
| ModeSwitched (Maybe ViewMode)
|
||||
| ConfirmAction
|
||||
| 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.navKey (Url.toString url) )
|
||||
|
||||
Browser.External href ->
|
||||
( setError ("External request '" ++ href ++ "'") model
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
UrlChanged url ->
|
||||
let
|
||||
route =
|
||||
routeParser url
|
||||
in
|
||||
case route of
|
||||
Just page ->
|
||||
{ model | route = page }
|
||||
|> update
|
||||
(case page of
|
||||
-- Directly enter add mode on NewLoot view
|
||||
NewLoot ->
|
||||
ModeSwitched (Just Modes.Add)
|
||||
|
||||
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
|
||||
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 (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
|
||||
)
|
||||
|
||||
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 ->
|
||||
( { 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.chest.claims)
|
||||
|
||||
Just others ->
|
||||
Just Set.empty
|
||||
)
|
||||
)
|
||||
model.chest
|
||||
in
|
||||
newChest
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
ConfirmAction ->
|
||||
case model.mode of
|
||||
Nothing ->
|
||||
update (ModeSwitched Nothing) model
|
||||
|
||||
Just mode ->
|
||||
let
|
||||
items =
|
||||
Chest.getSelected model.route model.chest
|
||||
in
|
||||
( model
|
||||
, Cmd.map ApiMsg <|
|
||||
Api.sendRequest
|
||||
mode
|
||||
(String.fromInt model.player.id)
|
||||
items
|
||||
)
|
||||
|
||||
UndoLastAction ->
|
||||
( model, Cmd.map ApiMsg <| Api.undoLastAction model.player.id )
|
||||
|
||||
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 }
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- STATE Utils
|
||||
-- SUBSCRIPTIONS
|
||||
--
|
||||
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions _ =
|
||||
Sub.none
|
||||
|
||||
Cmd.map ApiMsg <| Api.fetchPlayer id
|
||||
|
||||
|
||||
---
|
||||
-- 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 ]
|
||||
]
|
||||
|
||||
|
||||
controlsWhenModeActive : ViewMode -> List (Html Msg)
|
||||
controlsWhenModeActive mode =
|
||||
[ 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" ]
|
||||
|
||||
|
||||
view : Model -> Browser.Document Msg
|
||||
view model =
|
||||
let
|
||||
-- What do we show inside the chest ?
|
||||
{- Dynamic renderers for ViewMode
|
||||
|
||||
Header controls are inserted in the PlayerBar
|
||||
and rowControls to the right side of every item rows
|
||||
-}
|
||||
headerControls =
|
||||
case model.mode of
|
||||
Just mode ->
|
||||
controlsWhenModeActive mode
|
||||
|
||||
Nothing ->
|
||||
-- Buttons to enter mode
|
||||
actionButton UndoLastAction "Annuler action" "backspace" "danger"
|
||||
:: controlsWhenRoute model.route
|
||||
renderControls =
|
||||
Modes.viewControls model.mode model.route
|
||||
|> List.map (Html.map ModeMsg)
|
||||
in
|
||||
{ title = "Loot-a-lot in ELM"
|
||||
, body =
|
||||
[ viewHeaderBar model
|
||||
, viewPlayerBar model.player headerControls
|
||||
, viewPlayerBar model.player renderControls
|
||||
, main_
|
||||
[ class "container" ]
|
||||
[ viewNotification model.state.notification
|
||||
@@ -620,3 +278,244 @@ showWealthField name value =
|
||||
, span [ class <| "is-size-4" ] [ text value ]
|
||||
]
|
||||
]
|
||||
|
||||
-- UPDATE
|
||||
|
||||
|
||||
type Msg
|
||||
= LinkClicked Browser.UrlRequest
|
||||
| UrlChanged Url.Url
|
||||
| ApiMsg Api.Msg
|
||||
| ChestMsg Chest.Msg
|
||||
| ModeMsg Modes.Msg
|
||||
| PlayerChanged Int
|
||||
| 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.navKey (Url.toString url) )
|
||||
|
||||
Browser.External href ->
|
||||
( setError ("External request '" ++ href ++ "'") model
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
UrlChanged url ->
|
||||
let
|
||||
route =
|
||||
routeParser url
|
||||
in
|
||||
case route of
|
||||
Just page ->
|
||||
{ model | route = page }
|
||||
|> update
|
||||
(case page of
|
||||
-- Directly enter add mode on NewLoot view
|
||||
NewLoot ->
|
||||
ModeMsg (Modes.ModeSwitched Modes.Add)
|
||||
|
||||
other ->
|
||||
ModeMsg (Modes.ModeSwitched Modes.None)
|
||||
)
|
||||
|
||||
Nothing ->
|
||||
( setError "Invalid route" model, Cmd.none )
|
||||
|
||||
PlayerChanged newId ->
|
||||
( { model | player = Api.blankPlayer }, initPlayer newId )
|
||||
|
||||
ChestMsg chestMsg ->
|
||||
let
|
||||
( chest, _ ) =
|
||||
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 }
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- STATE Utils
|
||||
-- SUBSCRIPTIONS
|
||||
--
|
||||
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions _ =
|
||||
Sub.none
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user