elm/lootalot-client
1
0
Fork 0
Code Issues 3 Pull Requests Releases Wiki Activity

until it compiles...

Browse Source
This commit is contained in:
Arthur Gerbaud
2019-11-05 21:19:53 +01:00
parent dfd1e99d1c
commit c968da15f0
3 changed files with 599 additions and 591 deletions
Download Patch File Download Diff File Expand all files Collapse all files

938
main.js
View File

File diff suppressed because it is too large Load Diff

98
src/Api.elm
View File

@@ -2,9 +2,11 @@ module Api exposing (..)
import Http import Http
import Json.Decode as D import Json.Decode as D
import Json.Decode exposing (Decoder, int, string) import Json.Decode exposing (Decoder, int, string, field, succeed)
import Json.Encode as E import Json.Encode as E
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 =
@@ -28,6 +30,51 @@ type Msg
| GotLoot ToChest (HttpResult Loot) | GotLoot ToChest (HttpResult Loot)
| GotActionResult (HttpResult Response) | GotActionResult (HttpResult Response)
---
-- MODELS
---
-- Player
type alias Player =
{ id: Int
, name: String
, debt: Int
, wealth: Wealth
}
blankPlayer =
Player 0 "Loot-a-lot" 0 (Wealth 0 0 0 0)
type alias Wealth =
{ cp: Int
, sp: Int
, gp: Int
, pp: Int
}
-- Loot
type alias Loot = List Item
type alias Item =
{ id: Int
, name: String
, base_price: Int
}
-- Claims
type alias Claims = List Claim
type alias Claim =
{ id: Int
, player_id: Int
, loot_id: Int
}
-- PLAYERS -- PLAYERS
-- --
@@ -35,7 +82,7 @@ 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 Main.GotPlayer (valueDecoder playerDecoder ) , expect = Http.expectJson GotPlayer (valueDecoder playerDecoder )
} }
playerDecoder : Decoder Player playerDecoder : Decoder Player
@@ -72,13 +119,13 @@ lootDecoder : Decoder Loot
lootDecoder = lootDecoder =
Json.Decode.list itemDecoder Json.Decode.list itemDecoder
fetchLoot : Main.ToChest -> Cmd Msg fetchLoot : ToChest -> Cmd Msg
fetchLoot dest = fetchLoot dest =
let let
url = case dest of url = case dest of
Main.OfPlayer id -> "http://localhost:8088/api/players/" ++ (String.fromInt id) ++ "/loot" OfPlayer id -> "http://localhost:8088/api/players/" ++ (String.fromInt id) ++ "/loot"
Main.OfShop -> "http://localhost:8088/api/items" OfShop -> "http://localhost:8088/api/items"
Main.OfGroup -> "http://localhost:8088/api/players/0/loot" OfGroup -> "http://localhost:8088/api/players/0/loot"
in in
Http.get Http.get
{ url = url { url = url
@@ -109,7 +156,7 @@ valueDecoder 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 DbUpdate 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 Json.Decode.oneOf
@@ -121,9 +168,9 @@ updatesDecoder =
] ]
apiResponseDecoder : Decoder ApiResponse apiResponseDecoder : Decoder Response
apiResponseDecoder = apiResponseDecoder =
Json.Decode.map4 ApiResponse Json.Decode.map4 Response
(D.maybe (field "value" string)) (D.maybe (field "value" string))
(Json.Decode.maybe (field "notification" string)) (Json.Decode.maybe (field "notification" string))
(Json.Decode.maybe (field "updates" (Json.Decode.list updatesDecoder))) (Json.Decode.maybe (field "updates" (Json.Decode.list updatesDecoder)))
@@ -139,35 +186,40 @@ undoLastAction id = Http.request
, tracker = Nothing , tracker = Nothing
} }
sendRequest : Maybe ViewMode -> Model -> Cmd Msg sendRequest : ViewMode -> String -> E.Value -> Cmd Msg
sendRequest activeMode model = sendRequest mode id payload =
case activeMode of
Nothing -> Cmd.none
Just mode ->
let let
(endpoint, method) = case mode of (endpoint, method) = case mode of
Add -> Modes.Add ->
( "http://localhost:8088/api/players/" ++ (String.fromInt model.player.id) ++ "/loot" ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
, "POST" , "POST"
) )
Buy -> Modes.Buy ->
( "http://localhost:8088/api/players/" ++ (String.fromInt model.player.id) ++ "/loot" ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
, "PUT" , "PUT"
) )
Sell -> Modes.Sell ->
( "http://localhost:8088/api/players/" ++ (String.fromInt model.player.id) ++ "/loot" ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
, "DELETE" , "DELETE"
) )
Grab -> Modes.Grab ->
( "http://localhost:8088/api/players/" ++ (String.fromInt model.player.id) ++ "/claims" ( "http://localhost:8088/api/players/" ++ id ++ "/claims"
, "POST") , "POST")
in in
Http.request Http.request
{ method = method { method = method
, headers = [] , headers = []
, url = endpoint , url = endpoint
, body = Http.jsonBody <| buildPayload mode model , body = Http.jsonBody payload
, expect = Http.expectJson GotActionResult apiResponseDecoder , expect = Http.expectJson GotActionResult apiResponseDecoder
, timeout = Nothing , timeout = Nothing
, tracker = Nothing , tracker = Nothing
} }
printError : Http.Error -> String
printError error =
case error of
Http.NetworkError -> "Le serveur ne répond pas"
_ -> "Erreur inconnue"

154
src/Main.elm
View File

@@ -9,8 +9,10 @@ import Html.Events exposing (..)
import Svg.Attributes import Svg.Attributes
import Url.Parser as P exposing (Parser, (</>), oneOf, s) import Url.Parser as P exposing (Parser, (</>), oneOf, s)
import Set exposing (Set) import Set exposing (Set)
import Json.Encode as E
import Api import Api exposing (Player, Loot, Wealth, Item, Claim, Claims)
import Modes exposing (ViewMode)
-- Main -- Main
@@ -57,7 +59,7 @@ init flags url key =
in in
( Model ( Model
(State key route "" False Nothing Nothing) (State key route "" False Nothing Nothing)
blankPlayer Api.blankPlayer
[] []
Nothing Nothing
Nothing Nothing
@@ -74,57 +76,13 @@ fetchInitialData playerId =
, Cmd.map ApiMsg <| Api.fetchLoot Api.OfGroup , Cmd.map ApiMsg <| Api.fetchLoot Api.OfGroup
] ]
---
-- MODELS
---
-- Player
type alias Player =
{ id: Int
, name: String
, debt: Int
, wealth: Wealth
}
blankPlayer =
Player 0 "Loot-a-lot" 0 (Wealth 0 0 0 0)
initPlayer id = initPlayer id =
Cmd.batch Cmd.batch
[ Cmd.map ApiMsg <| Api.fetchPlayer id [ Cmd.map ApiMsg <| Api.fetchPlayer id
, Cmd.map ApiMsg <| Api.fetchLoot (OfPlayer id) , Cmd.map ApiMsg <| Api.fetchLoot (Api.OfPlayer id)
, Cmd.map ApiMsg <| Api.fetchClaims id , Cmd.map ApiMsg <| Api.fetchClaims id
] ]
type alias Wealth =
{ cp: Int
, sp: Int
, gp: Int
, pp: Int
}
-- Loot
type alias Loot = List Item
type alias Item =
{ id: Int
, name: String
, base_price: Int
}
-- Claims
type alias Claims = List Claim
type alias Claim =
{ id: Int
, player_id: Int
, loot_id: Int
}
-- UPDATE -- UPDATE
type Msg type Msg
@@ -160,7 +118,7 @@ update msg model =
{ model | state = { state | route = page }} { model | state = { state | 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 Add) NewLoot -> ModeSwitched (Just Modes.Add)
other -> ModeSwitched Nothing other -> ModeSwitched Nothing
) )
@@ -168,10 +126,10 @@ update msg model =
( setError "Invalid route" model, Cmd.none ) ( setError "Invalid route" model, Cmd.none )
PlayerChanged newId -> PlayerChanged newId ->
( { model | player = blankPlayer }, initPlayer newId ) ( { model | player = Api.blankPlayer }, initPlayer newId )
ApiMsg apiMsg -> case apiMsg of ApiMsg apiMsg -> case apiMsg of
GotActionResult response -> Api.GotActionResult response ->
case response of case response of
Ok result -> Ok result ->
let let
@@ -185,23 +143,23 @@ update msg model =
|> update (ModeSwitched Nothing) |> update (ModeSwitched Nothing)
Err r -> (setError (Debug.toString r) model, Cmd.none) Err r -> (setError (Debug.toString r) model, Cmd.none)
GotPlayer result -> Api.GotPlayer result ->
case result of case result of
Ok player -> Ok player ->
( { model | player = player } ( { model | player = player }
, Cmd.none , Cmd.none
) )
Err error -> Err error ->
( setError ("Fetching player... " ++ printError error) model ( setError ("Fetching player... " ++ Debug.toString error) model
, Cmd.none , Cmd.none
) )
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 -> ( { model | claims = List.filter (\c -> c.player_id == id) claims}, Cmd.none )
Err error -> ( setError ("Fetching claims..." ++ Debug.toString error) model, Cmd.none) Err error -> ( setError ("Fetching claims..." ++ Debug.toString error) model, Cmd.none)
GotLoot dest result -> Api.GotLoot dest result ->
case result of case result of
Ok loot -> Ok loot ->
( case dest of ( case dest of
@@ -211,7 +169,7 @@ update msg model =
, Cmd.none , Cmd.none
) )
Err error -> Err error ->
( setError ("Fetching loot... " ++ printError error) model ( setError ("Fetching loot... " ++ Debug.toString error) model
, Cmd.none , Cmd.none
) )
@@ -235,7 +193,7 @@ update msg model =
Nothing -> Nothing ->
Nothing Nothing
Just Grab -> -- Currently claimed object are initially selected Just Modes.Grab -> -- Currently claimed object are initially selected
Just ( Set.fromList <| List.map (\c -> c.loot_id) model.claims) Just ( Set.fromList <| List.map (\c -> c.loot_id) model.claims)
Just others -> Just others ->
@@ -244,13 +202,14 @@ update msg model =
, Cmd.none ) , Cmd.none )
ConfirmAction -> ConfirmAction ->
let case model.state.activeMode of
currentMode = model.state.activeMode Nothing ->
in update (ModeSwitched Nothing) model
(model, Cmd.map ApiMsg Api.sendRequest currentMode model) Just mode ->
(model, Cmd.map ApiMsg <| Api.sendRequest mode (String.fromInt model.player.id) (buildPayload mode model))
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 ) ( { model | notification = Nothing }, Cmd.none )
@@ -262,10 +221,10 @@ setNotification notification model =
targetItemsFor : ViewMode -> Model -> List Item targetItemsFor : ViewMode -> Model -> List Item
targetItemsFor mode model = targetItemsFor mode model =
case mode of case mode of
Add -> [] Modes.Add -> []
Buy -> Maybe.withDefault [] model.merchantItems Modes.Buy -> Maybe.withDefault [] model.merchantItems
Sell ->Maybe.withDefault [] model.loot Modes.Sell ->Maybe.withDefault [] model.loot
Grab -> Maybe.withDefault [] model.groupLoot Modes.Grab -> Maybe.withDefault [] model.groupLoot
buildPayload : ViewMode -> Model -> E.Value buildPayload : ViewMode -> Model -> E.Value
buildPayload mode model = buildPayload mode model =
@@ -274,40 +233,33 @@ buildPayload mode model =
|> List.filter (itemInSelection model.state.selection) |> List.filter (itemInSelection model.state.selection)
in in
case mode of case mode of
Buy -> E.object Modes.Buy -> E.object
[ ( "items", items |> E.list (\i -> E.list identity [E.int i.id, E.null])) [ ( "items", items |> E.list (\i -> E.list identity [E.int i.id, E.null]))
, ("global_mod", E.null ) , ("global_mod", E.null )
] ]
Sell -> E.object Modes.Sell -> E.object
[ ( "items", items |> E.list (\i -> E.list identity [E.int i.id, E.null])) [ ( "items", items |> E.list (\i -> E.list identity [E.int i.id, E.null]))
, ("global_mod", E.null ) , ("global_mod", E.null )
] ]
Grab -> E.object Modes.Grab -> E.object
[ ( "items", items |> E.list (\i -> E.int i.id)) [ ( "items", items |> E.list (\i -> E.int i.id))
, ("global_mod", E.null ) , ("global_mod", E.null )
] ]
Add -> E.object Modes.Add -> E.object
[ ( "items", items |> E.list (\i -> E.int i.id)) [ ( "items", items |> E.list (\i -> E.int i.id))
, ("global_mod", E.null ) , ("global_mod", E.null )
] ]
type DbUpdate
= ItemRemoved Item
| ItemAdded Item
| WealthUpdated Wealth
| ClaimAdded ()
| ClaimRemoved ()
-- DbUpdates always refer to the active player's loot -- DbUpdates always refer to the active player's loot
applyUpdate : DbUpdate -> Model -> Model applyUpdate : Api.Update -> Model -> Model
applyUpdate u model = applyUpdate u model =
case u of case u of
ItemRemoved item -> { model | loot = Just Api.ItemRemoved item -> { model | loot = Just
<| List.filter (\i -> i.id /= item.id) <| List.filter (\i -> i.id /= item.id)
<| Maybe.withDefault [] model.loot } <| Maybe.withDefault [] model.loot }
ItemAdded item -> { model | loot = Just Api.ItemAdded item -> { model | loot = Just
<| item :: Maybe.withDefault [] model.loot } <| item :: Maybe.withDefault [] model.loot }
WealthUpdated diff -> Api.WealthUpdated diff ->
let let
player = model.player player = model.player
wealth = player.wealth wealth = player.wealth
@@ -319,8 +271,8 @@ applyUpdate u model =
(wealth.gp + diff.gp) (wealth.gp + diff.gp)
(wealth.pp + diff.pp) (wealth.pp + diff.pp)
)}} )}}
ClaimAdded _ -> model Api.ClaimAdded _ -> model
ClaimRemoved _ -> model Api.ClaimRemoved _ -> model
-- ERRORS -- ERRORS
@@ -334,12 +286,6 @@ setError error model =
{ state | error = error }} { state | error = error }}
printError : Http.Error -> String
printError error =
case error of
Http.NetworkError -> "Le serveur ne répond pas"
_ -> "Erreur inconnue"
-- STATE Utils -- STATE Utils
switchSelectionState : Int -> Maybe Selection -> Maybe Selection switchSelectionState : Int -> Maybe Selection -> Maybe Selection
@@ -362,20 +308,6 @@ subscriptions _ =
-- VIEWS -- VIEWS
--- ---
type ViewMode
= Sell
| Buy
| Grab
| Add
canSelectIn : ViewMode -> Bool
canSelectIn mode =
case mode of
Sell -> True
Buy -> True
Grab -> True
Add -> False
actionButton msg t icon color = actionButton msg t icon color =
button [ class <| "button level-item is-" ++ color button [ class <| "button level-item is-" ++ color
, onClick msg ] , onClick msg ]
@@ -392,10 +324,10 @@ controlsWhenModeActive mode =
controlsWhenRoute : Route -> List (Html Msg) controlsWhenRoute : Route -> List (Html Msg)
controlsWhenRoute route = controlsWhenRoute route =
case route of case route of
PlayerChest -> [actionButton (ModeSwitched (Just Sell)) "Vendre" "coins" "danger"] PlayerChest -> [actionButton (ModeSwitched (Just Modes.Sell)) "Vendre" "coins" "danger"]
GroupLoot -> [actionButton (ModeSwitched (Just Grab)) "Demander" "praying-hands" "primary"] GroupLoot -> [actionButton (ModeSwitched (Just Modes.Grab)) "Demander" "praying-hands" "primary"]
Merchant -> [actionButton (ModeSwitched (Just Buy)) "Acheter" "coins" "success"] Merchant -> [actionButton (ModeSwitched (Just Modes.Buy)) "Acheter" "coins" "success"]
NewLoot -> [actionButton (ModeSwitched (Just Add)) "Nouveau loot" "plus" "primary"] NewLoot -> [actionButton (ModeSwitched (Just Modes.Add)) "Nouveau loot" "plus" "primary"]
view : Model -> Browser.Document Msg view : Model -> Browser.Document Msg
view model = view model =
@@ -487,14 +419,14 @@ rowControlsForMode : ViewMode -> (Item -> Bool) -> Item -> Html Msg
rowControlsForMode mode isSelected item = rowControlsForMode mode isSelected item =
let let
itemInfo = case mode of itemInfo = case mode of
Buy -> p [class "level-item"] [ text (String.fromInt item.base_price ++ "po")] Modes.Buy -> p [class "level-item"] [ text (String.fromInt item.base_price ++ "po")]
Sell -> p [class "level-item"] [ text (String.fromFloat (toFloat item.base_price / 2) ++ "po")] Modes.Sell -> p [class "level-item"] [ text (String.fromFloat (toFloat item.base_price / 2) ++ "po")]
Grab -> p [class "level-item"] [ text "Grab" ] Modes.Grab -> p [class "level-item"] [ text "Grab" ]
Add -> p [class "level-item"] [ text "New !" ] Modes.Add -> p [class "level-item"] [ text "New !" ]
in in
div [ class "level-right" ] div [ class "level-right" ]
<| itemInfo <| itemInfo
:: if 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