Updates in front (RO)

1 files changed, 286 insertions, 141 deletions

diff --git a/front/src/Main.elm b/front/src/Main.elm
index baa76d3..bc3f763 100644
--- a/front/src/Main.elm
+++ b/front/src/Main.elm
@@ -2,6 +2,7 @@ module Main exposing (main)
 
 import Browser exposing (Document, UrlRequest(..))
 import Browser.Navigation as Nav
+import Dict exposing (Dict)
 import Html
     exposing
         ( Attribute
@@ -11,6 +12,7 @@ import Html
         , div
         , hr
         , input
+        , p
         , pre
         , span
         , table
@@ -37,8 +39,8 @@ import Html.Attributes
         )
 import Html.Events exposing (onClick, onInput)
 import Http
-import Json.Decode exposing (Decoder, field, float, int, list, map2, map3, map4)
-import Json.Encode as Encode exposing (Value, object)
+import Json.Decode as JD
+import Json.Encode as JE
 import Platform.Cmd exposing (batch)
 import Round
 import Set exposing (Set)
@@ -141,18 +143,18 @@ main =
 
 
 type alias Quota =
-    { period : Int
+    { month : Int
     , payed : Capital
     , pending_principal : Float
     }
 
 
-quotaDecoder : Decoder Quota
+quotaDecoder : JD.Decoder Quota
 quotaDecoder =
-    map3 Quota
-        (field "period" int)
-        (field "payed" capitalDecoder)
-        (field "pending_principal" float)
+    JD.map3 Quota
+        (JD.field "period" JD.int)
+        (JD.field "payed" capitalDecoder)
+        (JD.field "pending_principal" JD.float)
 
 
 type alias Capital =
@@ -161,11 +163,11 @@ type alias Capital =
     }
 
 
-capitalDecoder : Decoder Capital
+capitalDecoder : JD.Decoder Capital
 capitalDecoder =
-    map2 Capital
-        (field "principal" float)
-        (field "interest" float)
+    JD.map2 Capital
+        (JD.field "principal" JD.float)
+        (JD.field "interest" JD.float)
 
 
 capitalSumView : Model -> Capital -> Html Msg
@@ -188,20 +190,22 @@ capitalSumView { t, settings } { principal, interest } =
 
 
 type alias MortgageSim =
-    { history : List Quota
+    { updates : SimUpdates
+    , history : List Quota
     , topay : Capital
     , payed : Capital
     , payed_amortized : Float
     }
 
 
-simDecoder : Decoder MortgageSim
+simDecoder : JD.Decoder MortgageSim
 simDecoder =
-    map4 MortgageSim
-        (field "history" (list quotaDecoder))
-        (field "topay" capitalDecoder)
-        (field "payed" capitalDecoder)
-        (field "payed_amortized" float)
+    JD.map5 MortgageSim
+        (JD.field "updates" simUpdatesDecoder)
+        (JD.field "history" (JD.list quotaDecoder))
+        (JD.field "topay" capitalDecoder)
+        (JD.field "payed" capitalDecoder)
+        (JD.field "payed_amortized" JD.float)
 
 
 type alias RawSpecs =
@@ -265,41 +269,179 @@ modelToUrl { settings, rawSpecs } =
         (settingsToQS settings ++ rawSpecsToQS rawSpecs)
 
 
-type alias MortgageSpecs =
+type SimUpdate
+    = Amortize Float
+
+
+simUpdateEncode : SimUpdate -> JE.Value
+simUpdateEncode mupdate =
+    case mupdate of
+        Amortize f ->
+            JE.object [ ( "Amortize", JE.float f ) ]
+
+
+simUpdateDecoder : JD.Decoder SimUpdate
+simUpdateDecoder =
+    JD.oneOf
+        [ JD.field "Amortize" <| JD.map Amortize JD.float
+        ]
+
+
+simUpdateFlatten : List SimUpdate -> List SimUpdate
+simUpdateFlatten us =
+    let
+        { amortized } =
+            List.foldr
+                (\upd acc ->
+                    case upd of
+                        Amortize f ->
+                            { acc | amortized = acc.amortized + f }
+                )
+                { amortized = 0 }
+                us
+    in
+    [ Amortize amortized ]
+
+
+type alias PeriodicUpdate =
+    { period : Int
+    , from : Maybe Int
+    , to : Maybe Int
+    , upd : SimUpdate
+    }
+
+
+periodicUpdateInMonth : Int -> PeriodicUpdate -> Bool
+periodicUpdateInMonth month { period, from, to } =
+    let
+        base =
+            Maybe.withDefault 0 from
+    in
+    modBy period month == base && base <= month && Maybe.withDefault (month + 1) to > month
+
+
+periodicUpdateEncode : PeriodicUpdate -> JE.Value
+periodicUpdateEncode { period, from, to, upd } =
+    let
+        toJInt x =
+            case x of
+                Nothing ->
+                    JE.null
+
+                Just val ->
+                    JE.int val
+    in
+    JE.object
+        [ ( "period", JE.int period )
+        , ( "from", toJInt from )
+        , ( "to", toJInt to )
+        , ( "update", simUpdateEncode upd )
+        ]
+
+
+periodicUpdateDecoder : JD.Decoder PeriodicUpdate
+periodicUpdateDecoder =
+    JD.map4 PeriodicUpdate
+        (JD.field "period" JD.int)
+        (JD.field "from" (JD.nullable JD.int))
+        (JD.field "to" (JD.nullable JD.int))
+        (JD.field "update" simUpdateDecoder)
+
+
+type alias SimUpdates =
+    { periodically : List PeriodicUpdate
+    , byMonth : List ( Int, List SimUpdate )
+    }
+
+
+updatesInMonth : SimUpdates -> Int -> SimUpdates
+updatesInMonth { periodically, byMonth } month =
+    let
+        newPeriodically =
+            List.filter (periodicUpdateInMonth month) periodically
+
+        newByMonth =
+            List.filter (\( m, updates ) -> m == month) byMonth
+    in
+    { periodically = newPeriodically, byMonth = newByMonth }
+
+
+simUpdatesEncode : SimUpdates -> JE.Value
+simUpdatesEncode { periodically, byMonth } =
+    JE.object
+        [ ( "periodically", JE.list periodicUpdateEncode periodically )
+        , ( "by_month"
+          , JE.object <|
+                List.map
+                    (\( m, us ) ->
+                        ( String.fromInt m, JE.list simUpdateEncode us )
+                    )
+                    byMonth
+          )
+        ]
+
+
+simUpdatesDecoder : JD.Decoder SimUpdates
+simUpdatesDecoder =
+    JD.map2 SimUpdates
+        (JD.field "periodically" (JD.list periodicUpdateDecoder))
+        (JD.field "by_month"
+            (JD.keyValuePairs (JD.list simUpdateDecoder)
+                |> JD.map
+                    (\l ->
+                        List.map (\( k, v ) -> ( Maybe.withDefault 0 (String.toInt k), v )) l
+                    )
+            )
+        )
+
+
+type alias SimSpecs =
     { principal : Float
     , i1 : Float
     , years : Int
+    , updates : SimUpdates
     }
 
 
-parseMortgageSpecs : RawSpecs -> Maybe MortgageSpecs
-parseMortgageSpecs { total, rate, i1, years } =
+parseSimSpecs : RawSpecs -> Maybe SimSpecs
+parseSimSpecs { total, rate, i1, years } =
     case
         ( List.map String.toFloat [ total, i1 ]
         , List.map String.toInt [ rate, years ]
         )
     of
         ( [ Just totalValueF, Just i1F ], [ Just rateI, Just yearsI ] ) ->
-            Just { principal = totalValueF * toFloat rateI / 100, i1 = i1F, years = yearsI }
+            let
+                updates =
+                    { periodically = [], byMonth = [] }
+            in
+            Just
+                { principal = totalValueF * toFloat rateI / 100
+                , i1 = i1F
+                , years = yearsI
+                , updates = updates
+                }
 
         _ ->
             Nothing
 
 
-mortgageSpecsToUrl : MortgageSpecs -> String
-mortgageSpecsToUrl { principal, i1, years } =
-    UB.absolute [ "api", "simulate" ]
-        [ UB.string "principal" (String.fromFloat principal)
-        , UB.string "i1" (String.fromFloat (i1 / 100))
-        , UB.int "years" years
+simSpecsEncode : SimSpecs -> JE.Value
+simSpecsEncode { principal, i1, years, updates } =
+    JE.object
+        [ ( "principal", JE.float principal )
+        , ( "i1", JE.float <| i1 / 100 )
+        , ( "years", JE.int years )
+        , ( "updates", simUpdatesEncode updates )
         ]
 
 
-runMortgageSim : Model -> MortgageSpecs -> Cmd Msg
-runMortgageSim m mortgageSpecs =
-    Http.get
-        { url = mortgageSpecsToUrl mortgageSpecs
-        , expect = Http.expectJson (GotMortgageSim m) simDecoder
+runSim : Model -> SimSpecs -> Cmd Msg
+runSim m simSpecs =
+    Http.post
+        { url = UB.absolute [ "api", "simulate" ] []
+        , body = Http.jsonBody <| simSpecsEncode simSpecs
+        , expect = Http.expectJson (GotSim m) simDecoder
         }
 
 
@@ -541,8 +683,8 @@ type Msg
     | ChangedUrl Url
     | UpdateSpecs SpecField String
     | UpdateSettings SettingsChange
-    | RunMortgageSim MortgageSpecs
-    | GotMortgageSim Model (Result Http.Error MortgageSim)
+    | RunSim SimSpecs
+    | GotSim Model (Result Http.Error MortgageSim)
     | SetExpandedYears (Set Int)
 
 
@@ -553,7 +695,7 @@ update msg m =
             Debug.log "UPDATE!" msg
     in
     case msg of
-        GotMortgageSim old_m (Ok msim) ->
+        GotSim old_m (Ok msim) ->
             ( { m
                 | simulation =
                     Just ( old_m.rawSpecs, msim )
@@ -561,15 +703,12 @@ update msg m =
             , Cmd.none
             )
 
-        GotMortgageSim _ (Err err) ->
+        GotSim _ (Err err) ->
             ( { m | error = errorToString err }, Cmd.none )
 
-        RunMortgageSim specs ->
+        RunSim specs ->
             ( m
-            , batch
-                [ runMortgageSim m specs
-                , Nav.pushUrl m.navKey (modelToUrl m)
-                ]
+            , batch [ runSim m specs, Nav.pushUrl m.navKey (modelToUrl m) ]
             )
 
         SetUrl (Internal url) ->
@@ -781,11 +920,18 @@ amountView currency amount =
     case String.split "." amountStr of
         int :: float :: [] ->
             let
+                floatPart =
+                    case float of
+                        "00" ->
+                            []
+
+                        _ ->
+                            [ text <| String.fromChar (currencySep currency).decimal
+                            , span [ class "text-sm" ] [ text float ]
+                            ]
+
                 els =
-                    [ text (insertThousandsSep currency int)
-                    , text <| String.fromChar (currencySep currency).decimal
-                    , span [ class "text-sm" ] [ text float ]
-                    ]
+                    [ text (insertThousandsSep currency int) ] ++ floatPart
             in
             span [] <|
                 case currencyOrder currency of
@@ -806,17 +952,17 @@ specsView { t, settings, rawSpecs } =
             rawSpecs
 
         simButAttrs =
-            case parseMortgageSpecs rawSpecs of
+            case parseSimSpecs rawSpecs of
                 Nothing ->
                     [ disabled True ]
 
                 Just specs ->
-                    [ onClick (RunMortgageSim specs) ]
+                    [ onClick (RunSim specs) ]
     in
     div []
         [ div []
             [ input
-                [ class "min-w-full mb-2 py-1 px-3 text-xl font-bold lime-100"
+                [ class "min-w-full mb-2 py-1 px-3 text-xl font-bold"
                 , placeholder (t "Title...")
                 , value title
                 , onInput (UpdateSpecs Title)
@@ -891,92 +1037,59 @@ specsView { t, settings, rawSpecs } =
         ]
 
 
-historyView : Model -> List Quota -> Html Msg
-historyView m quotas =
-    let
-        titles =
-            [ "Year", "Month", "Quota", "Pending" ]
-
-        head =
-            thead [ class "bg-lime-100" ]
-                [ tr []
-                    (List.map
-                        (\txt ->
-                            th [ class "px-3 py-1 border border-gray-300" ]
-                                [ text <| m.t txt ]
-                        )
-                        titles
-                    )
-                ]
-    in
-    div [ class "pt-4 flex flex-col items-center" ]
-        [ table [ class "border border-collapse bg-gray-50 border-gray-400" ]
-            [ head
-            , tbody []
-                (List.map (quotaView m)
-                    quotas
-                )
-            ]
-        ]
+monthToYear : Int -> Int
+monthToYear month =
+    ((month - 1) // 12) + 1
 
 
-periodToYear : Int -> Int
-periodToYear period =
-    ((period - 1) // 12) + 1
+simUpdateView : List (Attribute Msg) -> Model -> SimUpdate -> Html Msg
+simUpdateView attrs m upd =
+    case upd of
+        Amortize f ->
+            span attrs [ text "+", amountView m.settings.currency f ]
 
 
-quotaView : Model -> Quota -> Html Msg
-quotaView m { period, payed, pending_principal } =
+quotaView : Model -> MortgageSim -> Quota -> Html Msg
+quotaView m { updates } { month, payed, pending_principal } =
     let
+        monthUpdates =
+            updatesInMonth updates month
+
         year =
-            periodToYear period
+            monthToYear month
 
-        yearExpanded =
+        monthInExpandedYear =
             Set.member year m.expandedYears
-    in
-    if modBy 12 (period - 1) == 0 then
-        tr []
-            (List.map (\t -> td [ class "px-3 py-1 border border-gray-300" ] [ t ])
-                [ div []
-                    [ span
-                        (clickableAttrs
-                            (SetExpandedYears
-                                ((if yearExpanded then
-                                    Set.remove
-
-                                  else
-                                    Set.insert
-                                 )
-                                    year
-                                    m.expandedYears
-                                )
-                            )
-                        )
-                        [ text
-                            (if yearExpanded then
-                                "− "
 
-                             else
-                                "+ "
-                            )
-                        ]
+        ( toggleYearIcon, newExpandedYears ) =
+            if monthInExpandedYear then
+                ( "− ", Set.remove year m.expandedYears )
+
+            else
+                ( "+ ", Set.insert year m.expandedYears )
+
+        ( yearField, updatesField ) =
+            if modBy 12 (month - 1) == 0 then
+                ( div []
+                    [ span (clickableAttrs (SetExpandedYears newExpandedYears)) [ text toggleYearIcon ]
                     , text (String.fromInt year)
                     ]
-                , text
-                    (String.fromInt period)
-                , capitalSumView m payed
-                , amountView m.settings.currency pending_principal
-                ]
-            )
+                , text "..."
+                )
 
-    else if yearExpanded then
+            else
+                ( text ""
+                , div [] (List.map (simUpdateView [ class "bg-lime-200" ] m << .upd) <| monthUpdates.periodically)
+                )
+    in
+    if modBy 12 (month - 1) == 0 || monthInExpandedYear then
         tr []
             (List.map (\t -> td [ class "px-3 py-1 border border-gray-300" ] [ t ])
-                [ text ""
-                , text
-                    (String.fromInt period)
+                [ yearField
+                , text (String.fromInt month)
                 , capitalSumView m payed
                 , amountView m.settings.currency pending_principal
+                , updatesField
                 ]
             )
 
@@ -984,8 +1097,34 @@ quotaView m { period, payed, pending_principal } =
         text ""
 
 
+mortgageView : Model -> MortgageSim -> Html Msg
+mortgageView m sim =
+    let
+        titles =
+            [ "Year", "Month", "Quota", "Pending", "Updates" ]
+
+        head =
+            thead [ class "bg-lime-100" ]
+                [ tr []
+                    (List.map
+                        (\txt ->
+                            th [ class "px-3 py-1 border border-gray-300" ]
+                                [ text <| m.t txt ]
+                        )
+                        titles
+                    )
+                ]
+    in
+    div [ class "pt-4 flex flex-col items-center" ]
+        [ table [ class "border border-collapse bg-gray-50 border-gray-400" ]
+            [ head
+            , tbody [] (List.map (quotaView m sim) sim.history)
+            ]
+        ]
+
+
 simView : Model -> ( RawSpecs, MortgageSim ) -> Html Msg
-simView m ( rawSpecs, { history, topay, payed } ) =
+simView m ( rawSpecs, sim ) =
     let
         currency =
             m.settings.currency
@@ -1007,6 +1146,26 @@ simView m ( rawSpecs, { history, topay, payed } ) =
 
         fee =
             total * parseFloat rawSpecs.fee / 100
+
+        overview financed =
+            div []
+                [ pre []
+                    [ text <| t "Financed (mortgage): "
+                    , capitalSumView m financed
+                    ]
+                , pre []
+                    [ text <| t "Total to pay: "
+                    , span [ class "font-bold" ]
+                        [ amountView currency
+                            (financed.principal
+                                + financed.interest
+                                + initial
+                                + vat
+                                + fee
+                            )
+                        ]
+                    ]
+                ]
     in
     div []
         [ hr [ class "my-5" ] []
@@ -1023,25 +1182,11 @@ simView m ( rawSpecs, { history, topay, payed } ) =
             , text <| t "VAT: "
             , amountView currency vat
             ]
-        , pre []
-            [ text <| t "Financed (mortgage): "
-            , capitalSumView m topay
-            ]
-        , pre []
-            [ text <| t "Total to pay: "
-            , span [ class "font-bold" ]
-                [ amountView currency
-                    (topay.principal
-                        + topay.interest
-                        + initial
-                        + vat
-                        + fee
-                    )
-                ]
-            ]
-
-        -- , div [] [ text "payed: ", capitalSumView m payed ]
-        , historyView m history
+        , p [ class "text-lg font-bold" ] [ text "-- without early payments --" ]
+        , overview sim.topay
+        , p [ class "text-lg font-bold" ] [ text "-- with early payments --" ]
+        , overview sim.payed
+        , mortgageView m sim
         ]
 
 
@@ -1058,7 +1203,7 @@ view m =
 
                     Just sim ->
                         simView m sim
-                , text m.error
+                , span [ class "text-rose-600" ] [ text m.error ]
                 ]
             ]
         ]