adds Modes module

src/Api.elm

@@ -2,9 +2,11 @@ module Api exposing (..)
 
 import Http
 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 Modes exposing (ViewMode)
+
 type alias HttpResult a = (Result Http.Error a)
 
 type alias Response =
@@ -28,6 +30,51 @@ type Msg
     | GotLoot ToChest (HttpResult Loot)
     | 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
 --
 
@@ -35,7 +82,7 @@ fetchPlayer : Int -> Cmd Msg
 fetchPlayer id =
     Http.get
         { 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
@@ -72,13 +119,13 @@ lootDecoder : Decoder Loot
 lootDecoder =
     Json.Decode.list itemDecoder
 
-fetchLoot : Main.ToChest -> Cmd Msg
+fetchLoot : ToChest -> Cmd Msg
 fetchLoot dest =
     let
         url = case dest of
-            Main.OfPlayer id -> "http://localhost:8088/api/players/" ++ (String.fromInt id) ++ "/loot"
-            Main.OfShop -> "http://localhost:8088/api/items"
-            Main.OfGroup -> "http://localhost:8088/api/players/0/loot"
+            OfPlayer id -> "http://localhost:8088/api/players/" ++ (String.fromInt id) ++ "/loot"
+            OfShop -> "http://localhost:8088/api/items"
+            OfGroup -> "http://localhost:8088/api/players/0/loot"
     in
     Http.get
         { url = url
@@ -109,7 +156,7 @@ valueDecoder thenDecoder =
 -- TODO: update server to produce better json
 --       like an object with list of updates of the same type
 --       { ItemRemoved : [..], Wealth : [ .. ], .. }
-updatesDecoder : Decoder DbUpdate
+updatesDecoder : Decoder Update
 updatesDecoder =
     -- We expect one update but do not know it's kind
             Json.Decode.oneOf
@@ -121,9 +168,9 @@ updatesDecoder =
                 ]
 
 
-apiResponseDecoder : Decoder ApiResponse
+apiResponseDecoder : Decoder Response
 apiResponseDecoder =
-    Json.Decode.map4 ApiResponse
+    Json.Decode.map4 Response
         (D.maybe (field "value" string))
         (Json.Decode.maybe (field "notification" string))
         (Json.Decode.maybe (field "updates" (Json.Decode.list updatesDecoder)))
@@ -139,35 +186,40 @@ undoLastAction id = Http.request
             , tracker = Nothing
             }
 
-sendRequest : Maybe ViewMode -> Model -> Cmd Msg
-sendRequest activeMode model =
-    case activeMode of
-        Nothing -> Cmd.none
-        Just mode ->
+sendRequest : ViewMode -> String -> E.Value -> Cmd Msg
+sendRequest mode id payload =
             let
                 (endpoint, method) = case mode of
-                    Add ->
-                        ( "http://localhost:8088/api/players/" ++ (String.fromInt model.player.id) ++ "/loot"
+                    Modes.Add ->
+                        ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
                         , "POST"
                         )
-                    Buy ->
-                        ( "http://localhost:8088/api/players/" ++ (String.fromInt model.player.id) ++ "/loot"
+                    Modes.Buy ->
+                        ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
                         , "PUT"
                         )
-                    Sell ->
-                        ( "http://localhost:8088/api/players/" ++ (String.fromInt model.player.id) ++ "/loot"
+                    Modes.Sell ->
+                        ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
                         , "DELETE"
                         )
-                    Grab ->
-                        ( "http://localhost:8088/api/players/" ++ (String.fromInt model.player.id) ++ "/claims"
+                    Modes.Grab ->
+                        ( "http://localhost:8088/api/players/" ++ id ++ "/claims"
                         , "POST")
             in
             Http.request
                 { method = method
                 , headers = []
                 , url = endpoint
-                , body = Http.jsonBody <| buildPayload mode model
+                , body = Http.jsonBody payload
                 , expect = Http.expectJson GotActionResult apiResponseDecoder
                 , timeout = Nothing
                 , tracker = Nothing
                 }
+
+
+
+printError : Http.Error -> String
+printError error =
+    case error of
+        Http.NetworkError -> "Le serveur ne répond pas"
+        _ -> "Erreur inconnue"

src/Main.elm

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

src/Modes.elm

@@ -0,0 +1,16 @@
+module Modes exposing (..)
+
+type ViewMode
+    = Sell
+    | Buy
+    | Grab
+    | Add
+
+
+canSelectIn : ViewMode -> Bool
+canSelectIn mode =
+    case mode of
+        Sell -> True
+        Buy -> True
+        Grab -> True
+        Add -> False