Merge branch 'refactoring' of elm/lootalot-client into master

Refactors and splits into a few modules

.gitignore

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

src/Api.elm

@@ -0,0 +1,308 @@
+module Api exposing (..)
+
+import Http
+import Json.Decode as D exposing (Decoder, field, int, string, succeed)
+import Json.Encode as E
+import Modes exposing (ViewMode)
+
+
+type alias HttpResult a =
+    Result Http.Error a
+
+
+type alias Response =
+    { value : Maybe String
+    , notification : Maybe String
+    , updates : Maybe (List Update)
+    , errors : Maybe String
+    }
+
+
+type Update
+    = ItemRemoved Item
+    | ItemAdded Item
+    | WealthUpdated Wealth
+    | ClaimAdded ()
+    | ClaimRemoved ()
+
+
+type Msg
+    = GotPlayer (HttpResult Player)
+    | GotClaims Int (HttpResult Claims)
+    | 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
+--
+
+
+fetchPlayer : Int -> Cmd Msg
+fetchPlayer id =
+    Http.get
+        { url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/"
+        , expect = Http.expectJson GotPlayer (valueDecoder playerDecoder)
+        }
+
+
+playerDecoder : Decoder Player
+playerDecoder =
+    D.map4 Player
+        (D.field "id" int)
+        (D.field "name" string)
+        (D.field "debt" int)
+        wealthDecoder
+
+
+wealthDecoder : Decoder Wealth
+wealthDecoder =
+    D.map4 Wealth
+        (D.field "cp" int)
+        (D.field "sp" int)
+        (D.field "gp" int)
+        (D.field "pp" int)
+
+
+
+-- LOOT
+-- Location of a loot
+
+
+type ToChest
+    = OfPlayer Int
+    | OfGroup
+    | OfShop
+
+
+itemDecoder =
+    D.map3 Item
+        (D.field "id" int)
+        (D.field "name" string)
+        (D.field "base_price" int)
+
+
+lootDecoder : Decoder Loot
+lootDecoder =
+    D.list itemDecoder
+
+
+fetchLoot : ToChest -> Cmd Msg
+fetchLoot dest =
+    let
+        url =
+            case dest of
+                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
+        , expect = Http.expectJson (GotLoot dest) (valueDecoder lootDecoder)
+        }
+
+
+
+-- CLAIMS
+
+
+claimDecoder =
+    D.map3 Claim
+        (D.field "id" int)
+        (D.field "player_id" int)
+        (D.field "loot_id" int)
+
+
+fetchClaims : Int -> Cmd Msg
+fetchClaims playerId =
+    Http.get
+        { url = "http://localhost:8088/api/claims"
+        , expect =
+            valueDecoder (D.list claimDecoder)
+                |> Http.expectJson (GotClaims playerId)
+        }
+
+
+
+-- API Response
+--
+
+
+valueDecoder : Decoder a -> Decoder a
+valueDecoder thenDecoder =
+    D.field "value" thenDecoder
+
+
+
+-- TODO: update server to produce better json
+--       like an object with list of updates of the same type
+--       { ItemRemoved : [..], Wealth : [ .. ], .. }
+
+
+updatesDecoder : Decoder Update
+updatesDecoder =
+    -- We expect one update but do not know it's kind
+    D.oneOf
+        [ field "ItemRemoved" (itemDecoder |> D.andThen (\i -> succeed <| ItemRemoved i))
+        , field "ItemAdded" (itemDecoder |> D.andThen (\i -> succeed <| ItemAdded i))
+        , field "Wealth" (wealthDecoder |> D.andThen (\i -> succeed <| WealthUpdated i))
+        , field "ClaimRemoved" (succeed () |> D.andThen (\i -> succeed <| ClaimRemoved i))
+        , field "ClaimAdded" (succeed () |> D.andThen (\i -> succeed <| ClaimAdded i))
+        ]
+
+
+apiResponseDecoder : Decoder Response
+apiResponseDecoder =
+    D.map4 Response
+        (D.maybe (field "value" string))
+        (D.maybe (field "notification" string))
+        (D.maybe (field "updates" (D.list updatesDecoder)))
+        (D.maybe (field "errors" string))
+
+
+undoLastAction id =
+    Http.request
+        { url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/events/last"
+        , method = "DELETE"
+        , headers = []
+        , body = Http.emptyBody
+        , expect = Http.expectJson GotActionResult apiResponseDecoder
+        , timeout = Nothing
+        , tracker = Nothing
+        }
+
+
+buildPayload : ViewMode -> List Item -> E.Value
+buildPayload mode items =
+    case mode of
+        Modes.Buy ->
+            E.object
+                [ ( "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 ]) )
+                , ( "global_mod", E.null )
+                ]
+
+        Modes.Grab ->
+            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) )
+                , ( "global_mod", E.null )
+                ]
+
+
+sendRequest : ViewMode -> String -> List Item -> Cmd Msg
+sendRequest mode id items =
+    let
+        ( endpoint, method ) =
+            case mode of
+                Modes.Add ->
+                    ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
+                    , "POST"
+                    )
+
+                Modes.Buy ->
+                    ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
+                    , "PUT"
+                    )
+
+                Modes.Sell ->
+                    ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
+                    , "DELETE"
+                    )
+
+                Modes.Grab ->
+                    ( "http://localhost:8088/api/players/" ++ id ++ "/claims"
+                    , "POST"
+                    )
+    in
+    Http.request
+        { method = method
+        , headers = []
+        , url = endpoint
+        , body = Http.jsonBody <| buildPayload mode items
+        , 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/Chest.elm

@@ -0,0 +1,227 @@
+module Chest exposing (..)
+
+import Api exposing (Claims, Item, Loot)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onCheck)
+import Modes exposing (ViewMode)
+import Route exposing (..)
+import Set exposing (Set)
+import Utils exposing (..)
+
+
+type alias Model =
+    { loot : Loot
+    , groupLoot : Loot
+    , merchantItems : Loot
+    , newLoot : Loot
+    , selection : Maybe Selection
+    , claims : Claims
+    }
+
+
+type alias Selection =
+    Set Int
+
+
+type Msg
+    = SetSelection (Maybe Selection)
+    | SwitchSelectionState Int
+
+
+init : Model
+init =
+    { loot = []
+    , groupLoot = []
+    , merchantItems = []
+    , newLoot = []
+    , selection = Nothing
+    , claims = []
+    }
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        SwitchSelectionState id ->
+            ( { model | selection = switchSelectionState id model.selection }, Cmd.none )
+
+        SetSelection new ->
+            ( { model | selection = new }, Cmd.none )
+
+
+view : Maybe ViewMode -> Route.Route -> Model -> Html Msg
+view mode route model =
+    let
+        ( header, shownItems ) =
+            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 (rowControlsForMode isSelected m)
+
+                Nothing ->
+                    case route of
+                        Route.GroupLoot ->
+                            -- Claim controls for Group chest
+                            Just <|
+                                claimedItemRenderer <|
+                                    itemInClaims model.claims
+
+                        _ ->
+                            Nothing
+    in
+    article
+        [ class "section" ]
+        [ p [ class "heading" ] [ text header ]
+        , viewSearchBar
+        , table [ class "table is-fullwidth is-hoverable" ]
+            [ thead [ class "table-header" ]
+                [ th [] [ text "Nom" ] ]
+            , tbody [] <| List.map (viewItemTableRow isSelected rowControls) shownItems
+            ]
+        ]
+
+
+claimedItemRenderer : (Item -> Bool) -> Item -> Html Msg
+claimedItemRenderer isClaimed item =
+    case isClaimed item of
+        True ->
+            renderIcon "fas fa-praying-hands" "1x"
+
+        False ->
+            text ""
+
+
+
+-- Renders controls for a specific mode
+
+
+rowControlsForMode : (Item -> Bool) -> ViewMode -> Item -> Html Msg
+rowControlsForMode isSelected mode item =
+    let
+        itemInfo =
+            case mode of
+                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 Modes.canSelectIn mode then
+                    [ input
+                        [ class "checkbox level-item"
+                        , type_ "checkbox"
+                        , checked <| isSelected item
+                        , onCheck (\v -> SwitchSelectionState item.id)
+                        ]
+                        []
+                    ]
+
+                else
+                    []
+               )
+
+
+viewItemTableRow : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Item -> Html Msg
+viewItemTableRow isSelected rowControls item =
+    tr [ classList [ ( "is-selected", isSelected item ) ] ]
+        [ td []
+            [ label [ class "level checkbox" ] <|
+                div [ class "level-left" ]
+                    [ p [ class "level-item" ] [ text item.name ] ]
+                    :: (case rowControls of
+                            Just render ->
+                                List.singleton (render item)
+
+                            Nothing ->
+                                []
+                       )
+            ]
+        ]
+
+
+itemInSelection : Maybe Selection -> Item -> Bool
+itemInSelection selection item =
+    Maybe.map (Set.member item.id) selection
+        |> Maybe.withDefault False
+
+
+switchSelectionState : Int -> Maybe Selection -> Maybe Selection
+switchSelectionState id selection =
+    case selection of
+        Just s ->
+            Just <|
+                case Set.member id s of
+                    True ->
+                        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

src/Modes.elm

@@ -0,0 +1,24 @@
+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

src/Route.elm

@@ -0,0 +1,25 @@
+module Route exposing(..)
+
+import Url
+import Url.Parser as P exposing (Parser, (</>), oneOf, s)
+---
+-- ROUTES
+---
+
+type Route
+    = PlayerChest
+    | Merchant
+    | GroupLoot
+    | NewLoot
+
+routeParser : Url.Url -> Maybe Route
+routeParser url =
+    P.parse
+        (oneOf
+            [ P.map GroupLoot (P.s "coffre")
+            , P.map PlayerChest P.top
+            , P.map Merchant (P.s "marchand")
+            , P.map NewLoot (P.s "nouveau-tresor")
+            ]
+        )
+        url

src/Utils.elm

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

tmux.sh

@@ -2,6 +2,7 @@
 
 tmux new-session -d -s elm
 tmux split-window -v "elm reactor --port 8080"
-tmux split-window -h -c $HOME/Projets/rust/lootalot "cargo run"
+tmux split-window -v -c $HOME/Projets/rust/lootalot "cargo run"
+tmux select-pane -U
 tmux select-pane -U
 tmux attach-session -t elm