init repo

src/Main.elm

@@ -0,0 +1,219 @@
+module Main exposing (..)
+
+import Browser
+import Browser.Navigation as Nav
+import Url
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Http
+import Json.Decode exposing (Decoder, field, string, int)
+-- Main
+
+main : Program () Model Msg
+main =
+    Browser.application
+        { init = init
+        , view = view
+        , update = update
+        , subscriptions = subscriptions
+        , onUrlChange = UrlChanged
+        , onUrlRequest = LinkClicked
+        }
+
+-- Model
+
+type alias Model =
+    { key : Nav.Key
+    , url : Url.Url
+    , player: Player
+    , error: String
+    }
+
+init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
+init flags url key =
+    ( Model key url blankPlayer "", (fetchPlayer 0))
+
+
+-- PLAYER
+--
+type alias Player =
+    { name: String
+    , debt: Int
+    , wealth: Wealth
+    }
+
+blankPlayer =
+    Player "Loading" 100 (Wealth 0 0 0 0)
+
+type alias Wealth =
+    { cp: Int
+    , sp: Int
+    , gp: Int
+    , pp: Int
+    }
+
+fetchPlayer : Int -> Cmd Msg
+fetchPlayer id =
+    Http.get
+        { url = "http://localhost:8088/api/players/" ++ (String.fromInt id) ++ "/"
+        , expect = Http.expectJson GotPlayer playerDecoder
+        }
+
+playerDecoder : Decoder Player
+playerDecoder =
+    Json.Decode.map3 Player
+    (field "value" (field "name" string))
+    (field "value" (field "debt" int))
+    (Json.Decode.map4 Wealth
+        (field "value" (field "cp" int))
+        (field "value" (field "sp" int))
+        (field "value" (field "gp" int))
+        (field "value" (field "pp" int)))
+
+-- UPDATE
+
+type Msg
+    = LinkClicked Browser.UrlRequest
+    | UrlChanged Url.Url
+    | DebugSwitchPlayer Int
+    | GotPlayer (Result Http.Error Player)
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        LinkClicked urlRequest ->
+            case urlRequest of
+                Browser.Internal url ->
+                    ( model, Nav.pushUrl model.key (Url.toString url) )
+                    --( model, Cmd.none )
+
+                Browser.External href ->
+                    ( { model | error = "Invalid request '" ++ href ++ "'" }, Cmd.none )
+
+        UrlChanged url ->
+            ( { model | url = url }
+            , Cmd.none
+            )
+
+        DebugSwitchPlayer id ->
+            ( model, fetchPlayer id)
+
+        GotPlayer result ->
+            case result of
+                Ok player ->
+                    ( { model | player = player }
+                    , Cmd.none
+                    )
+                Err error -> ( { model | error = (printError error) }, Cmd.none )
+
+-- ERRORS
+
+printError : Http.Error -> String
+printError error =
+    case error of
+        Http.NetworkError -> "Le serveur ne répond pas"
+        _ -> "Erreur inconnue"
+
+-- SUBSCRIPTIONS
+--
+subscriptions : Model -> Sub Msg
+subscriptions _ =
+    Sub.none
+
+
+-- VIEW
+--
+
+view : Model -> Browser.Document Msg
+view model =
+    { title = "Loot-a-lot in ELM"
+    , body =
+        [ viewHeaderBar model
+        , viewPlayerWealth model.player
+        , section []
+            [ text "Loot-a-lot" ]
+        , p [] [ text "Start using it !" ]
+        , viewDebugSection model
+        ]
+    }
+
+-- DEBUG SECTION
+
+viewDebugSection model =
+    div [class "panel is-danger"]
+        [ p [class "panel-heading"] [text "Debug"]
+        , debugSwitchPlayers
+        , p [class "panel-block"] [text ("URL :" ++ Url.toString model.url)]
+        , p [class "panel-block has-text-danger"] [text model.error]
+        ]
+
+debugSwitchPlayers : Html Msg
+debugSwitchPlayers =
+    div [ class "panel-tabs" ]
+        [ a [ onClick (DebugSwitchPlayer 0) ] [text "Groupe"]
+        , a [ onClick (DebugSwitchPlayer 1) ] [text "Lomion"]
+        , a [ onClick (DebugSwitchPlayer 2) ] [text "Fefi"]
+        ]
+-- HEADER SECTION
+
+viewHeaderBar : Model -> Html Msg
+viewHeaderBar model =
+    nav [ class "navbar", class "is-info" ]
+        [ div [ class "navbar-brand" ]
+              [ p [ class "navbar-item"]
+                  [ text model.player.name ]
+
+              , a [class "navbar-burger is-active"]
+                  [ span [attribute "aria-hidden" "true"] []
+                  , span [attribute "aria-hidden" "true"] []
+                  , span [attribute "aria-hidden" "true"] []
+                  ]
+              ]
+        , div [ class "navbar-menu is-active" ]
+              [ div [class "navbar-end"]
+                    [ a [class "navbar-item", href "#marchand"] [text "Marchand"]
+                    , a [class "navbar-item", href "#coffre"] [text "Mon coffre"]
+                    ]
+              ]
+
+        ]
+
+-- WEALTH
+--
+
+viewPlayerWealth : Player -> Html Msg
+viewPlayerWealth player =
+    section [ class "level" ]
+        ([div [class "level-left box"]
+            ([div [ class "level-item" ]
+                 [ p [class "is-size-3"] [text "Argent"]
+                 , span [ class "icon is-large" ] [ i [ class "fas fa-2x fa-piggy-bank" ] [] ]
+                 ]
+            ] ++ (showWealth player.wealth))
+        ] ++ (if player.debt > 0 then
+                [ div [class "level-right"]
+                    [div [class "level-item"]
+                         [p [class "heading is-size-4 has-text-danger"]
+                            [text ("Dette : " ++ (String.fromInt player.debt) ++ "po")]
+                         ]
+                    ]
+                ]
+            else
+                []
+        ))
+
+showWealth : Wealth -> List (Html Msg)
+showWealth wealth =
+    [ showWealthField "pp" wealth.pp
+    , showWealthField "gp" wealth.gp
+    , showWealthField "sp" wealth.sp
+    , showWealthField "cp" wealth.cp
+    ]
+
+showWealthField : String -> Int -> Html Msg
+showWealthField name value =
+    div [ class "level-item" ]
+        [ p [ class "is-size-4"] [text (String.fromInt value)]
+        , p [class "heading"] [text name]
+        ]