Simulation in Elm

3 files changed, 271 insertions, 31 deletions

diff --git a/front/elm.json b/front/elm.json
index ce2a08d..785c5be 100644
--- a/front/elm.json
+++ b/front/elm.json
@@ -8,10 +8,13 @@
         "direct": {
             "elm/browser": "1.0.2",
             "elm/core": "1.0.5",
-            "elm/html": "1.0.0"
+            "elm/html": "1.0.0",
+            "elm/http": "2.0.0",
+            "elm/json": "1.1.3"
         },
         "indirect": {
-            "elm/json": "1.1.3",
+            "elm/bytes": "1.0.8",
+            "elm/file": "1.0.5",
             "elm/time": "1.0.0",
             "elm/url": "1.0.0",
             "elm/virtual-dom": "1.0.3"
diff --git a/front/src/Main.elm b/front/src/Main.elm
index fdf2fc4..47edd9d 100644
--- a/front/src/Main.elm
+++ b/front/src/Main.elm
@@ -1,15 +1,12 @@
 module Main exposing (..)
 
--- Press buttons to increment and decrement a counter.
---
--- Read how it works:
---   https://guide.elm-lang.org/architecture/buttons.html
---
-
-
 import Browser
-import Html exposing (Html, button, div, text)
-import Html.Events exposing (onClick)
+import Html exposing (Html, button, div, input, text)
+import Html.Attributes exposing (max, min, step, type_, value)
+import Html.Events exposing (onClick, onInput)
+import Http
+import Json.Decode exposing (Decoder, field, float, int, list, map, map2, map3, map4)
+import Json.Encode as Encode exposing (Value, object)
 
 
 
@@ -17,48 +14,287 @@ import Html.Events exposing (onClick)
 
 
 main =
-  Browser.sandbox { init = init, update = update, view = view }
+    Browser.element { init = init, update = update, view = view, subscriptions = \_ -> Sub.none }
 
 
 
 -- MODEL
 
 
-type alias Model = Int
+type alias Capital =
+    { principal : Float
+    , interest : Float
+    }
+
+
+capitalDecoder : Decoder Capital
+capitalDecoder =
+    map2 Capital
+        (field "principal" float)
+        (field "interest" float)
+
+
+capitalStr : Capital -> String
+capitalStr { principal, interest } =
+    String.concat [ "{principal=", String.fromFloat principal, ", interest=", String.fromFloat interest, "}" ]
+
+
+type alias Quota =
+    { period : Int
+    , payed : Capital
+    , pending_principal : Float
+    }
+
+
+quotaDecoder : Decoder Quota
+quotaDecoder =
+    map3 Quota
+        (field "period" int)
+        (field "payed" capitalDecoder)
+        (field "pending_principal" float)
+
+
+type alias Simulation =
+    { history : List Quota
+    , topay : Capital
+    , payed : Capital
+    , payed_amortized : Float
+    }
+
 
+simDecoder : Decoder Simulation
+simDecoder =
+    map4 Simulation
+        (field "history" (list quotaDecoder))
+        (field "topay" capitalDecoder)
+        (field "payed" capitalDecoder)
+        (field "payed_amortized" float)
 
-init : Model
-init =
-  0
+
+type alias SimSpecs =
+    { principal : Float
+    , i1 : Float
+    , years : Int
+    }
+
+
+type alias Model =
+    { error : String
+    , simSpecs : SimSpecs
+    , simulation : Maybe Simulation
+    }
+
+
+qs : List ( String, String ) -> String
+qs ss =
+    String.join "&" (List.map (\( s, t ) -> String.join "=" [ s, t ]) ss)
+
+
+simSpecsToURL : SimSpecs -> String
+simSpecsToURL { principal, i1, years } =
+    let
+        base =
+            "/api/simulate"
+    in
+    String.concat
+        [ base
+        , "?"
+        , qs
+            [ ( "principal", String.fromFloat principal )
+            , ( "i1"
+              , String.fromFloat (i1 / 100)
+              )
+            , ( "years", String.fromInt years )
+            ]
+        ]
+
+
+runSimulation : SimSpecs -> Cmd Msg
+runSimulation simSpecs =
+    Http.get
+        { url = simSpecsToURL simSpecs
+        , expect = Http.expectJson GotSimulation simDecoder
+        }
+
+
+init : () -> ( Model, Cmd Msg )
+init () =
+    let
+        simSpecs =
+            { principal = 300000.0, i1 = 2.1, years = 30 }
+
+        req =
+            runSimulation simSpecs
+    in
+    ( { error = "", simSpecs = simSpecs, simulation = Nothing }, req )
 
 
 
 -- UPDATE
 
 
+type SimSpecUpdate
+    = Principal
+    | I1
+    | Years
+
+
 type Msg
-  = Increment
-  | Decrement
+    = GotSimulation (Result Http.Error Simulation)
+    | UpdateSimSpecs SimSpecUpdate String
+    | RunSimulation
 
 
-update : Msg -> Model -> Model
+update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
-  case msg of
-    Increment ->
-      model + 1
+    let
+        _ =
+            Debug.log "UPDATE!" msg
+    in
+    case msg of
+        GotSimulation (Ok simulation) ->
+            ( { model | simulation = Just simulation }, Cmd.none )
+
+        GotSimulation (Err err) ->
+            ( { model | error = errorToString err }, Cmd.none )
+
+        RunSimulation ->
+            ( model, runSimulation model.simSpecs )
+
+        UpdateSimSpecs u val ->
+            let
+                simSpecs =
+                    model.simSpecs
+
+                m =
+                    case u of
+                        Principal ->
+                            case String.toFloat val of
+                                Just p ->
+                                    { model | simSpecs = { simSpecs | principal = p } }
+
+                                Nothing ->
+                                    { model | error = "Error parsing principal" }
+
+                        I1 ->
+                            case String.toFloat val of
+                                Just i ->
+                                    { model | simSpecs = { simSpecs | i1 = i } }
 
-    Decrement ->
-      model - 1
+                                Nothing ->
+                                    { model | error = "Error parsing interest" }
+
+                        Years ->
+                            case String.toInt val of
+                                Just i ->
+                                    { model | simSpecs = { simSpecs | years = i } }
+
+                                Nothing ->
+                                    { model | error = "Error parsing years" }
+            in
+            ( m, Cmd.none )
 
 
 
 -- VIEW
 
 
+errorToString : Http.Error -> String
+errorToString error =
+    case error of
+        Http.BadUrl url ->
+            "The URL " ++ url ++ " was invalid"
+
+        Http.Timeout ->
+            "Unable to reach the server, try again"
+
+        Http.NetworkError ->
+            "Unable to reach the server, check your network connection"
+
+        Http.BadStatus 500 ->
+            "The server had a problem, try again later"
+
+        Http.BadStatus 400 ->
+            "Verify your information and try again"
+
+        Http.BadStatus _ ->
+            "Unknown error"
+
+        Http.BadBody errorMessage ->
+            errorMessage
+
+
+specsView : SimSpecs -> Html Msg
+specsView { principal, i1, years } =
+    div []
+        [ div []
+            [ text "Principal: "
+            , input
+                [ type_ "range"
+                , Html.Attributes.min "0"
+                , Html.Attributes.max "1000000"
+                , step "10000"
+                , value (String.fromFloat principal)
+                , onInput (UpdateSimSpecs Principal)
+                ]
+                []
+            , text (String.fromFloat principal)
+            ]
+        , div []
+            [ text "Interest rate: "
+            , input
+                [ Html.Attributes.min "0"
+                , Html.Attributes.max "100"
+                , value (String.fromFloat i1)
+                , onInput (UpdateSimSpecs I1)
+                ]
+                []
+            ]
+        , div []
+            [ text "Years: "
+            , input
+                [ type_ "range"
+                , Html.Attributes.min "1"
+                , Html.Attributes.max "50"
+                , step "1"
+                , value (String.fromInt years)
+                , onInput (UpdateSimSpecs Years)
+                ]
+                []
+            , text (String.fromInt years)
+            ]
+        , button [ onClick RunSimulation ] [ text "Simulate" ]
+        ]
+
+
+quotaView : Quota -> Html Msg
+quotaView { period, payed, pending_principal } =
+    div [] [ text (String.join "\t" [ String.fromInt period, capitalStr payed, String.fromFloat pending_principal ]) ]
+
+
+historyView : List Quota -> Html Msg
+historyView quotas =
+    div [] (List.map quotaView quotas)
+
+
+simView : Simulation -> Html Msg
+simView { history, topay, payed } =
+    div []
+        [ historyView history
+        , div [] [ text (String.concat [ "to pay: ", capitalStr topay ]) ]
+        , div [] [ text (String.concat [ "payed: ", capitalStr payed ]) ]
+        ]
+
+
 view : Model -> Html Msg
 view model =
-  div []
-    [ button [ onClick Decrement ] [ text "-" ]
-    , div [] [ text (String.fromInt model) ]
-    , button [ onClick Increment ] [ text "+" ]
-    ]
+    div []
+        [ specsView model.simSpecs
+        , case model.simulation of
+            Nothing ->
+                text ""
+
+            Just sim ->
+                div [] [ simView sim ]
+        , div [] [ text model.error ]
+        ]
diff --git a/src/bin/web.rs b/src/bin/web.rs
index cc6b94f..86effcf 100644
--- a/src/bin/web.rs
+++ b/src/bin/web.rs
@@ -4,6 +4,7 @@ use serde::Deserialize;
 use std::fs;
 use axum::{
     response::{Html, Json},
+    extract::Query,
     routing::get,
     Router,
 };
@@ -19,8 +20,8 @@ struct SimSpecs {
     years: u32,
 }
 
-async fn api_simulate_get<'a>(Json(specs): Json<SimSpecs>) -> Json<hiccup::Simulation<'a>> {
-    let mut sim = Simulation::new(specs.principal, specs.i1, specs.years);
+async fn api_simulate_get<'a>(Query(specs): Query<SimSpecs>) -> Json<hiccup::Simulation<'a>> {
+    let mut sim = Simulation::new(specs. principal, specs.i1, specs.years);
     let updates: SimUpdates = SimUpdates::default();
     sim.run(updates);
     Json(sim)