restores all functionnality after refactoring

ready to go on !
This commit is contained in:
2019-11-06 21:50:49 +01:00
parent 081ef1a89f
commit 8a604279db
6 changed files with 694 additions and 394 deletions

1
.gitignore vendored
View File

@@ -1,2 +1,3 @@
fontawesome fontawesome
elm-stuff elm-stuff
main.js

View File

@@ -1,17 +1,18 @@
module Api exposing (..) module Api exposing (..)
import Http import Http
import Json.Decode as D import Json.Decode as D exposing (Decoder, field, int, string, succeed)
import Json.Decode exposing (Decoder, int, string, field, succeed)
import Json.Encode as E import Json.Encode as E
import Modes exposing (ViewMode) import Modes exposing (ViewMode)
type alias HttpResult a = (Result Http.Error a)
type alias HttpResult a =
Result Http.Error a
type alias Response = type alias Response =
{ value: Maybe String { value : Maybe String
, notification: Maybe String , notification : Maybe String
, updates : Maybe (List Update) , updates : Maybe (List Update)
, errors : Maybe String , errors : Maybe String
} }
@@ -24,6 +25,7 @@ type Update
| ClaimAdded () | ClaimAdded ()
| ClaimRemoved () | ClaimRemoved ()
type Msg type Msg
= GotPlayer (HttpResult Player) = GotPlayer (HttpResult Player)
| GotClaims Int (HttpResult Claims) | GotClaims Int (HttpResult Claims)
@@ -31,60 +33,76 @@ type Msg
| GotActionResult (HttpResult Response) | GotActionResult (HttpResult Response)
--- ---
-- MODELS -- MODELS
--- ---
-- Player -- Player
type alias Player = type alias Player =
{ id: Int { id : Int
, name: String , name : String
, debt: Int , debt : Int
, wealth: Wealth , wealth : Wealth
} }
blankPlayer = blankPlayer =
Player 0 "Loot-a-lot" 0 (Wealth 0 0 0 0) Player 0 "Loot-a-lot" 0 (Wealth 0 0 0 0)
type alias Wealth = type alias Wealth =
{ cp: Int { cp : Int
, sp: Int , sp : Int
, gp: Int , gp : Int
, pp: Int , pp : Int
} }
-- Loot -- Loot
type alias Loot = List Item
type alias Loot =
List Item
type alias Item = type alias Item =
{ id: Int { id : Int
, name: String , name : String
, base_price: Int , base_price : Int
} }
-- Claims -- Claims
type alias Claims = List Claim
type alias Claims =
List Claim
type alias Claim = type alias Claim =
{ id: Int { id : Int
, player_id: Int , player_id : Int
, loot_id: Int , loot_id : Int
} }
-- PLAYERS -- PLAYERS
-- --
fetchPlayer : Int -> Cmd Msg fetchPlayer : Int -> Cmd Msg
fetchPlayer id = fetchPlayer id =
Http.get Http.get
{ url = "http://localhost:8088/api/players/" ++ (String.fromInt id) ++ "/" { url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/"
, expect = Http.expectJson GotPlayer (valueDecoder playerDecoder ) , expect = Http.expectJson GotPlayer (valueDecoder playerDecoder)
} }
playerDecoder : Decoder Player playerDecoder : Decoder Player
playerDecoder = playerDecoder =
D.map4 Player D.map4 Player
@@ -93,6 +111,7 @@ playerDecoder =
(D.field "debt" int) (D.field "debt" int)
wealthDecoder wealthDecoder
wealthDecoder : Decoder Wealth wealthDecoder : Decoder Wealth
wealthDecoder = wealthDecoder =
D.map4 Wealth D.map4 Wealth
@@ -101,83 +120,111 @@ wealthDecoder =
(D.field "gp" int) (D.field "gp" int)
(D.field "pp" int) (D.field "pp" int)
-- LOOT
-- LOOT
-- Location of a loot -- Location of a loot
type ToChest type ToChest
= OfPlayer Int = OfPlayer Int
| OfGroup | OfGroup
| OfShop | OfShop
itemDecoder = itemDecoder =
D.map3 Item D.map3 Item
(D.field "id" int) (D.field "id" int)
(D.field "name" string) (D.field "name" string)
(D.field "base_price" int) (D.field "base_price" int)
lootDecoder : Decoder Loot lootDecoder : Decoder Loot
lootDecoder = lootDecoder =
Json.Decode.list itemDecoder D.list itemDecoder
fetchLoot : ToChest -> Cmd Msg fetchLoot : ToChest -> Cmd Msg
fetchLoot dest = fetchLoot dest =
let let
url = case dest of url =
OfPlayer id -> "http://localhost:8088/api/players/" ++ (String.fromInt id) ++ "/loot" case dest of
OfShop -> "http://localhost:8088/api/items" OfPlayer id ->
OfGroup -> "http://localhost:8088/api/players/0/loot" "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/loot"
OfShop ->
"http://localhost:8088/api/items"
OfGroup ->
"http://localhost:8088/api/players/0/loot"
in in
Http.get Http.get
{ url = url { url = url
, expect = Http.expectJson (GotLoot dest) (valueDecoder lootDecoder)} , expect = Http.expectJson (GotLoot dest) (valueDecoder lootDecoder)
}
-- CLAIMS -- CLAIMS
claimDecoder = claimDecoder =
D.map3 Claim D.map3 Claim
(D.field "id" int) (D.field "id" int)
(D.field "player_id" int) (D.field "player_id" int)
(D.field "loot_id" int) (D.field "loot_id" int)
fetchClaims : Int -> Cmd Msg fetchClaims : Int -> Cmd Msg
fetchClaims playerId = fetchClaims playerId =
Http.get Http.get
{ url = "http://localhost:8088/api/claims" { url = "http://localhost:8088/api/claims"
, expect = valueDecoder (D.list claimDecoder) , expect =
valueDecoder (D.list claimDecoder)
|> Http.expectJson (GotClaims playerId) |> Http.expectJson (GotClaims playerId)
} }
-- API Response -- API Response
-- --
valueDecoder : Decoder a -> Decoder a valueDecoder : Decoder a -> Decoder a
valueDecoder thenDecoder = valueDecoder thenDecoder =
D.field "value" thenDecoder D.field "value" thenDecoder
-- TODO: update server to produce better json -- TODO: update server to produce better json
-- like an object with list of updates of the same type -- like an object with list of updates of the same type
-- { ItemRemoved : [..], Wealth : [ .. ], .. } -- { ItemRemoved : [..], Wealth : [ .. ], .. }
updatesDecoder : Decoder Update updatesDecoder : Decoder Update
updatesDecoder = updatesDecoder =
-- We expect one update but do not know it's kind -- We expect one update but do not know it's kind
Json.Decode.oneOf D.oneOf
[ (field "ItemRemoved" (itemDecoder |> Json.Decode.andThen (\i -> succeed <| ItemRemoved i))) [ field "ItemRemoved" (itemDecoder |> D.andThen (\i -> succeed <| ItemRemoved i))
, (field "ItemAdded" (itemDecoder |> Json.Decode.andThen (\i -> succeed <| ItemAdded i))) , field "ItemAdded" (itemDecoder |> D.andThen (\i -> succeed <| ItemAdded i))
, (field "Wealth" (wealthDecoder |> Json.Decode.andThen (\i -> succeed <| WealthUpdated i))) , field "Wealth" (wealthDecoder |> D.andThen (\i -> succeed <| WealthUpdated i))
, (field "ClaimRemoved" (succeed () |> Json.Decode.andThen (\i -> succeed <| ClaimRemoved i))) , field "ClaimRemoved" (succeed () |> D.andThen (\i -> succeed <| ClaimRemoved i))
, (field "ClaimAdded" (succeed () |> Json.Decode.andThen (\i -> succeed <| ClaimAdded i))) , field "ClaimAdded" (succeed () |> D.andThen (\i -> succeed <| ClaimAdded i))
] ]
apiResponseDecoder : Decoder Response apiResponseDecoder : Decoder Response
apiResponseDecoder = apiResponseDecoder =
Json.Decode.map4 Response D.map4 Response
(D.maybe (field "value" string)) (D.maybe (field "value" string))
(Json.Decode.maybe (field "notification" string)) (D.maybe (field "notification" string))
(Json.Decode.maybe (field "updates" (Json.Decode.list updatesDecoder))) (D.maybe (field "updates" (D.list updatesDecoder)))
(Json.Decode.maybe (field "errors" string)) (D.maybe (field "errors" string))
undoLastAction id = Http.request
{ url = "http://localhost:8088/api/players/" ++ String.fromInt id ++"/events/last" undoLastAction id =
Http.request
{ url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/events/last"
, method = "DELETE" , method = "DELETE"
, headers = [] , headers = []
, body = Http.emptyBody , body = Http.emptyBody
@@ -186,42 +233,59 @@ undoLastAction id = Http.request
, tracker = Nothing , tracker = Nothing
} }
buildPayload : ViewMode -> List Item -> E.Value buildPayload : ViewMode -> List Item -> E.Value
buildPayload mode items = buildPayload mode items =
case mode of case mode of
Modes.Buy -> E.object Modes.Buy ->
[ ( "items", items |> E.list (\i -> E.list identity [E.int i.id, E.null])) E.object
, ("global_mod", E.null ) [ ( "items", items |> E.list (\i -> E.list identity [ E.int i.id, E.null ]) )
, ( "global_mod", E.null )
] ]
Modes.Sell -> E.object
[ ( "items", items |> E.list (\i -> E.list identity [E.int i.id, E.null])) Modes.Sell ->
, ("global_mod", E.null ) E.object
[ ( "items", items |> E.list (\i -> E.list identity [ E.int i.id, E.null ]) )
, ( "global_mod", E.null )
] ]
Modes.Grab -> E.object
[ ( "items", items |> E.list (\i -> E.int i.id)) Modes.Grab ->
, ("global_mod", E.null ) E.object
[ ( "items", items |> E.list (\i -> E.int i.id) )
, ( "global_mod", E.null )
] ]
Modes.Add -> E.object
[ ( "items", items |> E.list (\i -> E.int i.id)) Modes.Add ->
, ("global_mod", E.null ) E.object
[ ( "items", items |> E.list (\i -> E.int i.id) )
, ( "global_mod", E.null )
] ]
sendRequest : ViewMode -> String -> List Item -> Cmd Msg sendRequest : ViewMode -> String -> List Item -> Cmd Msg
sendRequest mode id items = sendRequest mode id items =
let let
(endpoint, method) = case mode of ( endpoint, method ) =
case mode of
Modes.Add -> Modes.Add ->
( "http://localhost:8088/api/players/" ++ id ++ "/loot" ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
, "POST" ) , "POST"
)
Modes.Buy -> Modes.Buy ->
( "http://localhost:8088/api/players/" ++ id ++ "/loot" ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
, "PUT" ) , "PUT"
)
Modes.Sell -> Modes.Sell ->
( "http://localhost:8088/api/players/" ++ id ++ "/loot" ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
, "DELETE" ) , "DELETE"
)
Modes.Grab -> Modes.Grab ->
( "http://localhost:8088/api/players/" ++ id ++ "/claims" ( "http://localhost:8088/api/players/" ++ id ++ "/claims"
, "POST" ) , "POST"
)
in in
Http.request Http.request
{ method = method { method = method
@@ -234,9 +298,11 @@ sendRequest mode id items =
} }
printError : Http.Error -> String printError : Http.Error -> String
printError error = printError error =
case error of case error of
Http.NetworkError -> "Le serveur ne répond pas" Http.NetworkError ->
_ -> "Erreur inconnue" "Le serveur ne répond pas"
_ ->
"Erreur inconnue"

View File

@@ -1,33 +1,46 @@
module Chest exposing (..) module Chest exposing (..)
import Api exposing (Claims, Item, Loot)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onCheck) import Html.Events exposing (onCheck)
import Set exposing (Set)
import Route
import Modes exposing (ViewMode) import Modes exposing (ViewMode)
import Api exposing (Item) import Route exposing (..)
import Set exposing (Set)
import Utils exposing (..) import Utils exposing (..)
type alias Model = type alias Model =
{ items: List Item { loot : Loot
, groupLoot : Loot
, merchantItems : Loot
, newLoot : Loot
, selection : Maybe Selection , selection : Maybe Selection
, claims : Claims
} }
type alias Selection = Set Int
type alias Selection =
Set Int
type Msg type Msg
= SetSelection (Maybe Selection) = SetSelection (Maybe Selection)
| SwitchSelectionState Int | SwitchSelectionState Int
init : Model init : Model
init = init =
{ items = [] { loot = []
, groupLoot = []
, merchantItems = []
, newLoot = []
, selection = Nothing , selection = Nothing
, claims = []
} }
update : Msg -> Model -> (Model, Cmd Msg)
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model = update msg model =
case msg of case msg of
SwitchSelectionState id -> SwitchSelectionState id ->
@@ -36,66 +49,121 @@ update msg model =
SetSelection new -> SetSelection new ->
( { model | selection = new }, Cmd.none ) ( { model | selection = new }, Cmd.none )
view : Maybe ViewMode -> Route.Route -> Model -> Html Msg view : Maybe ViewMode -> Route.Route -> Model -> Html Msg
view mode route model = view mode route model =
let let
isSelected = itemInSelection model.selection ( header, shownItems ) =
rowControls = case mode of case route of
Route.PlayerChest ->
( "Mon coffre", model.loot )
Route.GroupLoot ->
( "Coffre de groupe", model.groupLoot )
Route.Merchant ->
( "Marchand", model.merchantItems )
Route.NewLoot ->
( "Nouveau trésor :)", [] )
isSelected =
itemInSelection model.selection
rowControls =
case mode of
Just m -> Just m ->
Just (rowControlsForMode isSelected m) Just (rowControlsForMode isSelected m)
Nothing -> -- Claim controls for Group chest
case route of
Route.GroupLoot -> Just (claimedItemRenderer isSelected)
_ -> Nothing
Nothing ->
case route of
Route.GroupLoot ->
-- Claim controls for Group chest
Just <|
claimedItemRenderer <|
itemInClaims model.claims
_ ->
Nothing
in in
table [ class "table is-fullwidth is-hoverable"] article
[ class "section" ]
[ p [ class "heading" ] [ text header ]
, viewSearchBar
, table [ class "table is-fullwidth is-hoverable" ]
[ thead [ class "table-header" ] [ thead [ class "table-header" ]
[ th [] [ text "Nom" ] ] [ th [] [ text "Nom" ] ]
, tbody [] <| List.map (viewItemTableRow isSelected rowControls) model.items , tbody [] <| List.map (viewItemTableRow isSelected rowControls) shownItems
]
] ]
claimedItemRenderer isSelected item =
case isSelected item of claimedItemRenderer : (Item -> Bool) -> Item -> Html Msg
True -> renderIcon "fas fa-praying-hands" "1x" claimedItemRenderer isClaimed item =
False -> text "" case isClaimed item of
True ->
renderIcon "fas fa-praying-hands" "1x"
False ->
text ""
-- Renders controls for a specific mode -- Renders controls for a specific mode
rowControlsForMode : (Item -> Bool) -> ViewMode -> Item -> Html Msg rowControlsForMode : (Item -> Bool) -> ViewMode -> Item -> Html Msg
rowControlsForMode isSelected mode item = rowControlsForMode isSelected mode item =
let let
itemInfo = case mode of itemInfo =
Modes.Buy -> p [class "level-item"] [ text (String.fromInt item.base_price ++ "po")] case mode of
Modes.Sell -> p [class "level-item"] [ text (String.fromFloat (toFloat item.base_price / 2) ++ "po")] Modes.Buy ->
Modes.Grab -> p [class "level-item"] [ text "Grab" ] p [ class "level-item" ] [ text (String.fromInt item.base_price ++ "po") ]
Modes.Add -> p [class "level-item"] [ text "New !" ]
Modes.Sell ->
p [ class "level-item" ] [ text (String.fromFloat (toFloat item.base_price / 2) ++ "po") ]
Modes.Grab ->
p [ class "level-item" ] [ text "Grab" ]
Modes.Add ->
p [ class "level-item" ] [ text "New !" ]
in in
div [ class "level-right" ] div [ class "level-right" ] <|
<| itemInfo itemInfo
:: if Modes.canSelectIn mode then :: (if Modes.canSelectIn mode then
[input [ class "checkbox level-item" [ input
[ class "checkbox level-item"
, type_ "checkbox" , type_ "checkbox"
, checked <| isSelected item , checked <| isSelected item
, onCheck (\v -> SwitchSelectionState item.id) , onCheck (\v -> SwitchSelectionState item.id)
] [] ] ]
[]
]
else else
[] []
)
viewItemTableRow : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Item -> Html Msg viewItemTableRow : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Item -> Html Msg
viewItemTableRow isSelected rowControls item = viewItemTableRow isSelected rowControls item =
tr [ classList [ ("is-selected", isSelected item) ] ] tr [ classList [ ( "is-selected", isSelected item ) ] ]
[ td [] [ td []
[ label [ class "level checkbox" ] [ label [ class "level checkbox" ] <|
<| div [ class "level-left" ] div [ class "level-left" ]
[ p [class "level-item"] [ text item.name ]] [ p [ class "level-item" ] [ text item.name ] ]
:: case rowControls of :: (case rowControls of
Just render -> List.singleton (render item) Just render ->
Nothing -> [] List.singleton (render item)
Nothing ->
[]
)
] ]
] ]
itemInSelection : Maybe Selection -> Item -> Bool itemInSelection : Maybe Selection -> Item -> Bool
itemInSelection selection item = itemInSelection selection item =
Maybe.map (Set.member item.id) selection Maybe.map (Set.member item.id) selection
@@ -106,7 +174,54 @@ switchSelectionState : Int -> Maybe Selection -> Maybe Selection
switchSelectionState id selection = switchSelectionState id selection =
case selection of case selection of
Just s -> Just s ->
Just <| case Set.member id s of Just <|
True -> Set.remove id s case Set.member id s of
False -> Set.insert id s True ->
Nothing -> Debug.log "ignore switchSelectionState" Nothing Set.remove id s
False ->
Set.insert id s
Nothing ->
Debug.log "ignore switchSelectionState" Nothing
--
-- Search Bar
viewSearchBar : Html Msg
viewSearchBar =
input [ class "input" ] []
targetItemsFor : Route -> Model -> List Item
targetItemsFor route model =
case route of
Route.NewLoot ->
model.newLoot
Route.Merchant ->
model.merchantItems
Route.PlayerChest ->
model.loot
Route.GroupLoot ->
model.groupLoot
getSelected : Route -> Model -> Loot
getSelected route model =
targetItemsFor route model
|> List.filter (itemInSelection model.selection)
-- LOOT Views
itemInClaims : Claims -> Item -> Bool
itemInClaims claims item =
List.any (\c -> c.loot_id == item.id) claims

View File

@@ -1,23 +1,25 @@
module Main exposing (..) module Main exposing (..)
import Api exposing (Claim, Claims, Item, Loot, Player, Wealth)
import Browser import Browser
import Browser.Navigation as Nav import Browser.Navigation as Nav
import Url import Chest exposing (Msg)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (..) import Html.Events exposing (..)
import Svg.Attributes
import Set exposing (Set)
import Json.Encode as E import Json.Encode as E
import Api exposing (Player, Loot, Wealth, Item, Claim, Claims)
import Modes exposing (ViewMode) import Modes exposing (ViewMode)
import Route exposing (..) import Route exposing (..)
import Chest import Set exposing (Set)
import Chest exposing (Msg) import Svg.Attributes
import Url
import Utils exposing (..) import Utils exposing (..)
-- Main -- Main
main : Program () Model Msg main : Program () Model Msg
main = main =
Browser.application Browser.application
@@ -29,45 +31,48 @@ main =
, onUrlRequest = LinkClicked , onUrlRequest = LinkClicked
} }
-- Model -- Model
type alias State = type alias State =
{ navKey : Nav.Key { menuOpen : Bool
, route : Route , error : Maybe String
, error : String , notification : Maybe String
, menuOpen : Bool
, activeMode : Maybe ViewMode
} }
type alias Model = type alias Model =
{ state : State { state : State
, player: Player , navKey : Nav.Key
, route : Route
, mode : Maybe ViewMode
, player : Player
, chest : Chest.Model , chest : Chest.Model
, claims : Claims
, notification : Maybe String
, loot: Maybe Loot
, groupLoot : Maybe Loot
, merchantItems : Maybe Loot
} }
init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
init flags url key = init flags url key =
let let
route = case routeParser url of route =
Just r -> r case routeParser url of
Nothing -> PlayerChest Just r ->
r
Nothing ->
PlayerChest
in in
( Model ( Model
(State key route "" False Nothing) (State False Nothing Nothing)
key
route
Nothing
Api.blankPlayer Api.blankPlayer
Chest.init Chest.init
[] , fetchInitialData 0
Nothing )
Nothing
Nothing
Nothing
, fetchInitialData 0)
fetchInitialData : Int -> Cmd Msg fetchInitialData : Int -> Cmd Msg
@@ -78,6 +83,7 @@ fetchInitialData playerId =
, Cmd.map ApiMsg <| Api.fetchLoot Api.OfGroup , Cmd.map ApiMsg <| Api.fetchLoot Api.OfGroup
] ]
initPlayer id = initPlayer id =
Cmd.batch Cmd.batch
[ Cmd.map ApiMsg <| Api.fetchPlayer id [ Cmd.map ApiMsg <| Api.fetchPlayer id
@@ -85,8 +91,11 @@ initPlayer id =
, Cmd.map ApiMsg <| Api.fetchClaims id , Cmd.map ApiMsg <| Api.fetchClaims id
] ]
-- UPDATE -- UPDATE
type Msg type Msg
= LinkClicked Browser.UrlRequest = LinkClicked Browser.UrlRequest
| UrlChanged Url.Url | UrlChanged Url.Url
@@ -98,30 +107,36 @@ type Msg
| UndoLastAction | UndoLastAction
| ClearNotification | ClearNotification
update : Msg -> Model -> ( Model, Cmd Msg ) update : Msg -> Model -> ( Model, Cmd Msg )
update msg model = update msg model =
case msg of case msg of
LinkClicked urlRequest -> LinkClicked urlRequest ->
case urlRequest of case urlRequest of
Browser.Internal url -> Browser.Internal url ->
( model, Nav.pushUrl model.state.navKey (Url.toString url) ) ( model, Nav.pushUrl model.navKey (Url.toString url) )
Browser.External href -> Browser.External href ->
( setError ("External request '" ++ href ++ "'") model ( setError ("External request '" ++ href ++ "'") model
, Cmd.none ) , Cmd.none
)
UrlChanged url -> UrlChanged url ->
let let
route = routeParser url route =
state = model.state routeParser url
in in
case route of case route of
Just page -> Just page ->
{ model | state = { state | route = page }} { model | route = page }
|> update (case page of |> update
(case page of
-- Directly enter add mode on NewLoot view -- Directly enter add mode on NewLoot view
NewLoot -> ModeSwitched (Just Modes.Add) NewLoot ->
other -> ModeSwitched Nothing ModeSwitched (Just Modes.Add)
other ->
ModeSwitched Nothing
) )
Nothing -> Nothing ->
@@ -132,24 +147,33 @@ update msg model =
ChestMsg chestMsg -> ChestMsg chestMsg ->
let let
(chest, _) = Chest.update chestMsg model.chest ( chest, _ ) =
Chest.update chestMsg model.chest
in in
( { model | chest = chest }, Cmd.none ) ( { model | chest = chest }, Cmd.none )
ApiMsg apiMsg -> case apiMsg of ApiMsg apiMsg ->
case apiMsg of
Api.GotActionResult response -> Api.GotActionResult response ->
case response of case response of
Ok result -> Ok result ->
let let
updates = Maybe.withDefault [] result.updates updates =
notification = result.notification Maybe.withDefault [] result.updates
errors = Maybe.withDefault "" result.errors
notification =
result.notification
errors =
Maybe.withDefault "" result.errors
in in
List.foldl applyUpdate model updates List.foldl applyUpdate model updates
|> setNotification notification |> setNotification notification
|> setError errors |> setError errors
|> update (ModeSwitched Nothing) |> update (ModeSwitched Nothing)
Err r -> (setError (Debug.toString r) model, Cmd.none)
Err r ->
( setError (Debug.toString r) model, Cmd.none )
Api.GotPlayer result -> Api.GotPlayer result ->
case result of case result of
@@ -157,6 +181,7 @@ update msg model =
( { model | player = player } ( { model | player = player }
, Cmd.none , Cmd.none
) )
Err error -> Err error ->
( setError ("Fetching player... " ++ Debug.toString error) model ( setError ("Fetching player... " ++ Debug.toString error) model
, Cmd.none , Cmd.none
@@ -164,230 +189,301 @@ update msg model =
Api.GotClaims id result -> Api.GotClaims id result ->
case result of case result of
Ok claims -> ( { model | claims = List.filter (\c -> c.player_id == id) claims}, Cmd.none ) Ok claims ->
Err error -> ( setError ("Fetching claims..." ++ Debug.toString error) model, Cmd.none) ( 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 -> Api.GotLoot dest result ->
case result of case result of
Ok loot -> Ok loot ->
let
chest =
model.chest
in
( case dest of ( case dest of
Api.OfPlayer _ -> { model | loot = Just loot} Api.OfPlayer _ ->
Api.OfGroup -> { model | groupLoot = Just loot} { model | chest = { chest | loot = loot } }
Api.OfShop -> { model | merchantItems = Just loot}
Api.OfGroup ->
{ model | chest = { chest | groupLoot = loot } }
Api.OfShop ->
{ model | chest = { chest | merchantItems = loot } }
, Cmd.none , Cmd.none
) )
Err error -> Err error ->
( setError ("Fetching loot... " ++ Debug.toString error) model ( setError ("Fetching loot... " ++ Debug.toString error) model
, Cmd.none , Cmd.none
) )
ModeSwitched newMode -> ModeSwitched newMode ->
let ( { model
state = model.state | mode = newMode
in
( { model | state =
{ state | activeMode = newMode }
, chest = , chest =
let let
(newChest, _) = Chest.update (Chest.SetSelection ( newChest, _ ) =
Chest.update
(Chest.SetSelection
(case newMode of (case newMode of
Nothing -> Nothing ->
Nothing Nothing
Just Modes.Grab -> -- Currently claimed object are initially selected Just Modes.Grab ->
Just ( Set.fromList <| List.map (\c -> c.loot_id) model.claims) -- Currently claimed object are initially selected
Just (Set.fromList <| List.map (\c -> c.loot_id) model.chest.claims)
Just others -> Just others ->
Just Set.empty Just Set.empty
)) )
)
model.chest model.chest
in newChest in
newChest
} }
, Cmd.none ) , Cmd.none
)
ConfirmAction -> ConfirmAction ->
case model.state.activeMode of case model.mode of
Nothing -> Nothing ->
update (ModeSwitched Nothing) model update (ModeSwitched Nothing) model
Just mode -> Just mode ->
let items = targetItemsFor mode model let
|> List.filter (Chest.itemInSelection model.chest.selection) items =
Chest.getSelected model.route model.chest
in in
( model ( model
, Cmd.map ApiMsg , Cmd.map ApiMsg <|
<| Api.sendRequest Api.sendRequest
mode mode
(String.fromInt model.player.id) (String.fromInt model.player.id)
items items
) )
UndoLastAction -> UndoLastAction ->
(model, Cmd.map ApiMsg <| Api.undoLastAction model.player.id) ( model, Cmd.map ApiMsg <| Api.undoLastAction model.player.id )
ClearNotification -> ClearNotification ->
( { model | notification = Nothing }, Cmd.none ) ( setNotification Nothing model, Cmd.none )
setNotification : Maybe String -> Model -> Model setNotification : Maybe String -> Model -> Model
setNotification notification model = setNotification notification model =
{ model | notification = notification } 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 } }
targetItemsFor : ViewMode -> Model -> List Item
targetItemsFor mode model =
case mode of
Modes.Add -> []
Modes.Buy -> Maybe.withDefault [] model.merchantItems
Modes.Sell ->Maybe.withDefault [] model.loot
Modes.Grab -> Maybe.withDefault [] model.groupLoot
-- DbUpdates always refer to the active player's loot -- DbUpdates always refer to the active player's loot
applyUpdate : Api.Update -> Model -> Model applyUpdate : Api.Update -> Model -> Model
applyUpdate u model = applyUpdate u model =
case u of case u of
Api.ItemRemoved item -> { model | loot = Just Api.ItemRemoved item ->
<| List.filter (\i -> i.id /= item.id) model
<| Maybe.withDefault [] model.loot } |> setLoot (List.filter (\i -> i.id /= item.id) model.chest.loot)
Api.ItemAdded item -> { model | loot = Just
<| item :: Maybe.withDefault [] model.loot } Api.ItemAdded item ->
model |> setLoot (item :: model.chest.loot)
Api.WealthUpdated diff -> Api.WealthUpdated diff ->
let let
player = model.player player =
wealth = player.wealth model.player
wealth =
player.wealth
in in
{ model | player = { player | wealth = { model
(Wealth | player =
{ player
| wealth =
Wealth
(wealth.cp + diff.cp) (wealth.cp + diff.cp)
(wealth.sp + diff.sp) (wealth.sp + diff.sp)
(wealth.gp + diff.gp) (wealth.gp + diff.gp)
(wealth.pp + diff.pp) (wealth.pp + diff.pp)
)}} }
Api.ClaimAdded _ -> model }
Api.ClaimRemoved _ -> model
Api.ClaimAdded _ ->
model
Api.ClaimRemoved _ ->
model
-- ERRORS -- ERRORS
setError : String -> Model -> Model setError : String -> Model -> Model
setError error model = setError error model =
let let
state = model.state state =
model.state
in in
{ model | state = { model
{ state | error = error }} | state =
{ state | error = Just error }
}
-- STATE Utils -- STATE Utils
-- SUBSCRIPTIONS -- SUBSCRIPTIONS
-- --
subscriptions : Model -> Sub Msg subscriptions : Model -> Sub Msg
subscriptions _ = subscriptions _ =
Sub.none Sub.none
--- ---
-- VIEWS -- VIEWS
--- ---
actionButton msg t icon color = actionButton msg t icon color =
button [ class <| "button level-item is-" ++ color button
, onClick msg ] [ class <| "button level-item is-" ++ color
[ span [ class "icon" ] [ i [ Svg.Attributes.class <| "fas fa-" ++ icon ] [] ] , onClick msg
, p [] [text t]
] ]
[ span [ class "icon" ] [ i [ Svg.Attributes.class <| "fas fa-" ++ icon ] [] ]
, p [] [ text t ]
]
controlsWhenModeActive : ViewMode -> List (Html Msg) controlsWhenModeActive : ViewMode -> List (Html Msg)
controlsWhenModeActive mode = controlsWhenModeActive mode =
[ actionButton (ConfirmAction) "Valider" "check" "primary" [ actionButton ConfirmAction "Valider" "check" "primary"
, actionButton (ModeSwitched Nothing) "Annuler" "times" "danger" , actionButton (ModeSwitched Nothing) "Annuler" "times" "danger"
] ]
controlsWhenRoute : Route -> List (Html Msg) controlsWhenRoute : Route -> List (Html Msg)
controlsWhenRoute route = controlsWhenRoute route =
case route of case route of
PlayerChest -> [actionButton (ModeSwitched (Just Modes.Sell)) "Vendre" "coins" "danger"] PlayerChest ->
GroupLoot -> [actionButton (ModeSwitched (Just Modes.Grab)) "Demander" "praying-hands" "primary"] [ actionButton (ModeSwitched (Just Modes.Sell)) "Vendre" "coins" "danger" ]
Merchant -> [actionButton (ModeSwitched (Just Modes.Buy)) "Acheter" "coins" "success"]
NewLoot -> [actionButton (ModeSwitched (Just Modes.Add)) "Nouveau loot" "plus" "primary"] 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 -> Browser.Document Msg
view model = view model =
let let
-- What do we show inside the chest ? -- What do we show inside the chest ?
(header, shownLoot) =
case model.state.route of
PlayerChest ->
("Mon coffre", Maybe.withDefault [] model.loot)
GroupLoot ->
("Coffre de groupe", Maybe.withDefault [] model.groupLoot)
Merchant ->
("Marchand", Maybe.withDefault [] model.merchantItems)
NewLoot ->
("Nouveau trésor :)", [] )
{- Dynamic renderers for ViewMode {- Dynamic renderers for ViewMode
Header controls are inserted in the PlayerBar Header controls are inserted in the PlayerBar
and rowControls to the right side of every item rows and rowControls to the right side of every item rows
-} -}
headerControls = headerControls =
case model.state.activeMode of case model.mode of
Just mode -> controlsWhenModeActive mode Just mode ->
Nothing -> -- Buttons to enter mode controlsWhenModeActive mode
Nothing ->
-- Buttons to enter mode
actionButton UndoLastAction "Annuler action" "backspace" "danger" actionButton UndoLastAction "Annuler action" "backspace" "danger"
:: controlsWhenRoute model.state.route :: controlsWhenRoute model.route
in in
{ title = "Loot-a-lot in ELM" { title = "Loot-a-lot in ELM"
, body = , body =
[ viewHeaderBar model [ viewHeaderBar model
, viewPlayerBar model.player model.notification headerControls , viewPlayerBar model.player headerControls
, article , main_
[ class "section container" ] [ class "container" ]
[ viewNotification model.notification [ viewNotification model.state.notification
, p [class "heading"] [text header]
, viewSearchBar
, Chest.view , Chest.view
model.state.activeMode model.mode
model.state.route model.route
model.chest model.chest
|> Html.map ChestMsg |> Html.map ChestMsg
] ]
, hr [] [] , hr [] []
, section [class "container"] [viewDebugSection model] , section [ class "container" ] [ viewDebugSection model ]
] ]
} }
viewNotification : Maybe String -> Html Msg viewNotification : Maybe String -> Html Msg
viewNotification notification = viewNotification notification =
case notification of case notification of
Just t -> div [ class "notification is-success is-marginless"] Just t ->
[ button [class "delete", onClick ClearNotification ] [] div [ class "notification is-success is-marginless" ]
, text t ] [ button [ class "delete", onClick ClearNotification ] []
Nothing -> text "" , text t
]
Nothing ->
text ""
-- LOOT Views
itemInClaims : List Claim -> Item -> Bool
itemInClaims claims item =
List.any (\c -> c.loot_id == item.id) claims
-- DEBUG SECTION -- DEBUG SECTION
viewDebugSection : Model -> Html Msg viewDebugSection : Model -> Html Msg
viewDebugSection model = viewDebugSection model =
div [class "panel is-danger"] div [ class "panel is-danger" ]
[ p [class "panel-heading"] [text "Debug"] [ p [ class "panel-heading" ] [ text "Debug" ]
, debugSwitchPlayers , debugSwitchPlayers
, p [class "panel-block has-text-danger"] [text model.state.error] , p [ class "panel-block has-text-danger" ] [ text <| Maybe.withDefault "" model.state.error ]
, p [class "panel-block"] [text ("Route : " ++ Debug.toString model.state.route)] , p [ class "panel-block" ] [ text ("Route : " ++ Debug.toString model.route) ]
, p [class "panel-block"] [text ("Active Mode : " ++ Debug.toString model.state.activeMode)] , 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 ("Selection : " ++ Debug.toString model.chest.selection) ]
, p [class "panel-block"] [text ("Claims : " ++ Debug.toString model.claims)] , p [ class "panel-block" ] [ text ("Claims : " ++ Debug.toString model.chest.claims) ]
, p [] debugSandbox , p [] debugSandbox
] ]
stackedIcon name = stackedIcon name =
span [class "icon is-medium"] span [ class "icon is-medium" ]
[ span [ class "fa-stack" ] [ span [ class "fa-stack" ]
[ i [ class "fas fa-circle fa-stack-2x" ] [] [ i [ class "fas fa-circle fa-stack-2x" ] []
, i [ class (name ++ " fa-inverse fa-stack-1x") ] [] , i [ class (name ++ " fa-inverse fa-stack-1x") ] []
@@ -395,6 +491,7 @@ stackedIcon name =
] ]
] ]
debugSandbox = debugSandbox =
[ stackedIcon "fas fa-coins" [ stackedIcon "fas fa-coins"
, stackedIcon "fab fa-d-and-d" , stackedIcon "fab fa-d-and-d"
@@ -410,76 +507,92 @@ debugSandbox =
, stackedIcon "fas fa-search" , stackedIcon "fas fa-search"
] ]
debugSwitchPlayers : Html Msg debugSwitchPlayers : Html Msg
debugSwitchPlayers = debugSwitchPlayers =
div [ class "panel-tabs" ] div [ class "panel-tabs" ]
[ a [ onClick (PlayerChanged 0) ] [text "Groupe"] [ a [ onClick (PlayerChanged 0) ] [ text "Groupe" ]
, a [ onClick (PlayerChanged 1) ] [text "Lomion"] , a [ onClick (PlayerChanged 1) ] [ text "Lomion" ]
, a [ onClick (PlayerChanged 2) ] [text "Fefi"] , a [ onClick (PlayerChanged 2) ] [ text "Fefi" ]
] ]
-- HEADER SECTION -- HEADER SECTION
viewHeaderBar : Model -> Html Msg viewHeaderBar : Model -> Html Msg
viewHeaderBar model = viewHeaderBar model =
nav [ class "navbar container", class "is-info" ] nav [ class "navbar container", class "is-info" ]
[ div [ class "navbar-brand" ] [ div [ class "navbar-brand" ]
[ a [ class "navbar-item", href "/"] [ a [ class "navbar-item", href "/" ]
[ renderIcon "fab fa-d-and-d" "2x" [ renderIcon "fab fa-d-and-d" "2x"
, span [] [ text model.player.name ] , span [] [ text model.player.name ]
] ]
, a [class "navbar-burger is-active"] , a [ class "navbar-burger is-active" ]
[ span [attribute "aria-hidden" "true"] [] [ span [ attribute "aria-hidden" "true" ] []
, span [attribute "aria-hidden" "true"] [] , span [ attribute "aria-hidden" "true" ] []
, span [attribute "aria-hidden" "true"] [] , span [ attribute "aria-hidden" "true" ] []
] ]
] ]
, div [ class "navbar-menu is-active" ] , div [ class "navbar-menu is-active" ]
[ div [class "navbar-end"] [ div [ class "navbar-end" ]
[ a [class "navbar-item", href "/marchand"] [ a [ class "navbar-item", href "/marchand" ]
[ renderIcon "fas fa-store-alt" "1x" [ renderIcon "fas fa-store-alt" "1x"
, span [] [text "Marchand"] , span [] [ text "Marchand" ]
] ]
, a , a
[ class "navbar-item" [ class "navbar-item"
, href (if model.player.id == 0 , href
then (if model.player.id == 0 then
"/nouveau-tresor" "/nouveau-tresor"
else else
"/coffre") "/coffre"
)
] ]
[ renderIcon "fas fa-gem" "1x" [ renderIcon "fas fa-gem" "1x"
, span [] [text (if model.player.id == 0 then "Nouveau loot" else "Coffre de groupe")] , span []
[ text
(if model.player.id == 0 then
"Nouveau loot"
else
"Coffre de groupe"
)
]
]
] ]
] ]
] ]
]
-- PLAYER BAR -- PLAYER BAR
viewPlayerBar : Player -> Maybe String -> List (Html Msg)-> Html Msg
viewPlayerBar player notification actionControls = viewPlayerBar : Player -> List (Html Msg) -> Html Msg
viewPlayerBar player actionControls =
section [ class "level container is-mobile box" ] section [ class "level container is-mobile box" ]
[ div [class "level-left"] [ div [ class "level-left" ]
([div [ class "level-item" ] ([ div [ class "level-item" ]
[ span [ class "icon is-large" ] [ span [ class "icon is-large" ]
[ i [ class "fas fa-2x fa-piggy-bank" ] [] ]] [ i [ class "fas fa-2x fa-piggy-bank" ] [] ]
] ]
++ (viewWealth player.wealth) ]
++ viewWealth player.wealth
++ (if player.debt > 0 then ++ (if player.debt > 0 then
[div [class "level-item"] [ div [ class "level-item" ]
[p [class "heading is-size-4 has-text-danger"] [ p [ class "heading is-size-4 has-text-danger" ]
[text ("Dette : " ++ (String.fromInt player.debt) ++ "po")] [ text ("Dette : " ++ String.fromInt player.debt ++ "po") ]
]] ]
]
else else
[] []
) )
) )
, viewNotification notification , div [ class "level-right" ] actionControls
, div [class "level-right"] actionControls
] ]
@@ -491,16 +604,12 @@ viewWealth wealth =
, showWealthField "cp" <| String.fromInt wealth.cp , showWealthField "cp" <| String.fromInt wealth.cp
] ]
showWealthField : String -> String -> Html Msg showWealthField : String -> String -> Html Msg
showWealthField name value = showWealthField name value =
div [ class "level-item" ] div [ class "level-item" ]
[ p [class "has-text-right"] [ strong [ class "heading is-marginless"] [text name] [ p [ class "has-text-right" ]
[ strong [ class "heading is-marginless" ] [ text name ]
, span [ class <| "is-size-4" ] [ text value ] , span [ class <| "is-size-4" ] [ text value ]
] ]
] ]
-- Search Bar
viewSearchBar : Html Msg
viewSearchBar =
input [class "input"] []

View File

@@ -1,5 +1,6 @@
module Modes exposing (..) module Modes exposing (..)
type ViewMode type ViewMode
= Sell = Sell
| Buy | Buy
@@ -10,7 +11,14 @@ type ViewMode
canSelectIn : ViewMode -> Bool canSelectIn : ViewMode -> Bool
canSelectIn mode = canSelectIn mode =
case mode of case mode of
Sell -> True Sell ->
Buy -> True True
Grab -> True
Add -> False Buy ->
True
Grab ->
True
Add ->
False

View File

@@ -3,6 +3,7 @@ module Utils exposing (renderIcon)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
renderIcon name size = renderIcon name size =
span [ class <| "icon is-medium"] span [ class <| "icon is-medium" ]
[ i [ class <| name ++ " fa-" ++ size] [] ] [ i [ class <| name ++ " fa-" ++ size ] [] ]