module Main exposing (main) import Browser exposing (Document, UrlRequest(..)) import Browser.Navigation as Nav import Dict exposing (Dict) import Html exposing ( Attribute , Html , a , button , div , hr , input , li , p , pre , span , table , tbody , td , text , th , thead , tr , ul ) import Html.Attributes exposing ( class , disabled , max , min , placeholder , step , style , title , type_ , value ) import Html.Events exposing (onClick, onInput) import Http import Json.Decode as JD import Json.Encode as JE import Platform.Cmd exposing (batch) import Round import Set exposing (Set) import Url exposing (Url) import Url.Builder as UB import Url.Parser as U exposing (()) import Url.Parser.Query as UQ -- LOCALE make_t : Language -> String -> String make_t lang str = case lang of EN -> str ES -> case str of "Principal: " -> "Capital: " "Interest: " -> "Interés: " "% from total" -> "% del total" "Title..." -> "Título..." "Property price: " -> "Precio del inmueble: " "Initial contribution: " -> "Contribución inicial: " "Interest rate: " -> "Tipo de interés: " "Years: " -> "Años: " "VAT: " -> "IVA/ITP: " "Agent fee: " -> "Honorarios agencia: " "Simulate" -> "Simular" "Total to pay: " -> "Total a pagar: " "With early payments: " -> "Con amortizaciones anticipadas: " "Payed early: " -> "Anticipado: " "Payed: " -> "Amort: " "Saved: " -> "Ahorro: " "Initial payment: " -> "Pago inicial: " "Property: " -> "Inmueble: " "Financed (mortgage): " -> "Financiado (hipoteca): " "Remove" -> "Eliminar" "Early payment" -> "Amortización anticipada" "New interest rate" -> "Nuevo tipo de interés" "Prepay:" -> "Amortizar:" "Interest:" -> "Interés:" "Cancel" -> "Cancelar" "Apply" -> "Aplicar" "Year" -> "Año" "Month" -> "Mes" "Quota" -> "Cuota" "Pending" -> "Pendiente" "(reset)" -> "(resetear)" "Periodic update" -> "Actualización periódica" "Updates" -> "Actualizaciones" "Invalid input" -> "Datos inválidos" _ -> str -- MAIN main = Browser.application { init = init , update = update , view = view , subscriptions = \_ -> Sub.none , onUrlRequest = SetUrl , onUrlChange = ChangedUrl } -- MODEL type alias Quota = { month : Int , payed : Capital , pending_principal : Float } quotaDecoder : JD.Decoder Quota quotaDecoder = JD.map3 Quota (JD.field "period" JD.int) (JD.field "payed" capitalDecoder) (JD.field "pending_principal" JD.float) type alias Capital = { principal : Float , interest : Float } capitalDecoder : JD.Decoder Capital capitalDecoder = JD.map2 Capital (JD.field "principal" JD.float) (JD.field "interest" JD.float) capitalSumView : Model -> Capital -> Html Msg capitalSumView { t, settings } { principal, interest } = let partsTitle = String.concat [ t "Principal: " , amountToString settings.currency principal , "\n" , t "Interest: " , amountToString settings.currency interest , " (" , Round.round 2 (100 * interest / (principal + interest)) , t "% from total" , ")" ] in amountView (titledAttrs partsTitle) settings.currency (principal + interest) type alias MortgageSim = { updates : SimUpdates , history : List Quota , payed_noupdates : Capital , payed_noprepays : Capital , payed : Capital , payed_amortized : Float } simDecoder : JD.Decoder MortgageSim simDecoder = JD.map6 MortgageSim (JD.field "updates" simUpdatesDecoder) (JD.field "history" (JD.list quotaDecoder)) (JD.field "payed_noupdates" capitalDecoder) (JD.field "payed_noprepays" capitalDecoder) (JD.field "payed" capitalDecoder) (JD.field "payed_amortized" JD.float) type alias RawSpecs = { title : String , total : String , initial : String , rate : String , i1 : String , years : String , vat : String , fee : String , updates : SimUpdates } defaultRawSpecs : RawSpecs defaultRawSpecs = { title = "" , total = "200000" , initial = "40000" , rate = "80" , i1 = "2.5" , years = "30" , vat = "6" , fee = "3" , updates = defaultSimUpdates } rawSpecsParser : UQ.Parser RawSpecs rawSpecsParser = let apply argParser funcParser = UQ.map2 (<|) funcParser argParser in UQ.map RawSpecs (UQ.map (Maybe.withDefault defaultRawSpecs.title) <| UQ.string "title") |> apply (UQ.map (Maybe.withDefault defaultRawSpecs.total) <| UQ.string "total") |> apply (UQ.map (Maybe.withDefault defaultRawSpecs.initial) <| UQ.string "initial") |> apply (UQ.map (Maybe.withDefault defaultRawSpecs.rate) <| UQ.string "rate") |> apply (UQ.map (Maybe.withDefault defaultRawSpecs.i1) <| UQ.string "i1") |> apply (UQ.map (Maybe.withDefault defaultRawSpecs.years) <| UQ.string "years") |> apply (UQ.map (Maybe.withDefault defaultRawSpecs.vat) <| UQ.string "vat") |> apply (UQ.map (Maybe.withDefault defaultRawSpecs.fee) <| UQ.string "fee") |> apply simUpdatesParser rawSpecsToQS : RawSpecs -> List UB.QueryParameter rawSpecsToQS { title, total, initial, rate, i1, years, vat, fee, updates } = [ UB.string "title" title , UB.string "total" total , UB.string "initial" initial , UB.string "rate" rate , UB.string "i1" i1 , UB.string "years" years , UB.string "vat" vat , UB.string "fee" fee ] ++ simUpdatesToQS updates modelToUrl : Model -> String modelToUrl { settings, rawSpecs } = UB.toQuery (settingsToQS settings ++ rawSpecsToQS rawSpecs) type SimUpdate = Amortize Float | SetI1 Float simUpdateEncode : SimUpdate -> JE.Value simUpdateEncode mupdate = case mupdate of Amortize f -> JE.object [ ( "Amortize", JE.float f ) ] SetI1 f -> JE.object [ ( "SetI1", JE.float f ) ] simUpdateDecoder : JD.Decoder SimUpdate simUpdateDecoder = JD.oneOf [ JD.field "Amortize" <| JD.map Amortize JD.float , JD.field "SetI1" <| JD.map SetI1 JD.float ] simUpdateFlatten : List SimUpdate -> List SimUpdate simUpdateFlatten us = let { amortized, other } = List.foldr (\upd acc -> case upd of Amortize f -> { acc | amortized = acc.amortized + f } SetI1 f -> { acc | other = upd :: acc.other } ) { amortized = 0, other = [] } us in Amortize amortized :: other 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 = { periodic : List PeriodicUpdate , byMonth : List ( Int, SimUpdate ) } defaultSimUpdates = { periodic = [], byMonth = [] } simUpdatesParser : UQ.Parser SimUpdates simUpdatesParser = let parseUpdate str = String.dropLeft 1 str |> String.toFloat |> (case String.left 1 str of "P" -> Maybe.map Amortize "I" -> Maybe.map SetI1 _ -> always Nothing ) rawPeriodic str = List.foldr (\kv acc -> case String.split "-" kv of [ "p", v ] -> { acc | period = String.toInt v } [ "f", v ] -> { acc | from = String.toInt v } [ "t", v ] -> { acc | to = String.toInt v } [ "u", v ] -> { acc | upd = parseUpdate v } _ -> acc ) { period = Nothing , from = Nothing , to = Nothing , upd = Nothing } (String.split "," str) parsePeriodic rp = case ( rp.period, rp.upd ) of ( Just p, Just u ) -> Just { period = p, from = rp.from, to = rp.to, upd = u } _ -> Nothing parseByMonth str = case String.split ":" str of [ dr, ur ] -> Maybe.map2 Tuple.pair (String.toInt dr) (parseUpdate ur) _ -> Nothing in UQ.map2 SimUpdates (UQ.custom "u_period" (List.filterMap (parsePeriodic << rawPeriodic))) (UQ.custom "u_bymon" (List.filterMap parseByMonth)) simUpdatesToQS : SimUpdates -> List UB.QueryParameter simUpdatesToQS { periodic, byMonth } = let renderUpdate u = case u of Amortize f -> "P" ++ Round.round 2 f SetI1 f -> "I" ++ Round.round 4 f renderPeriod { period, from, to, upd } = [ ( "p", Just (String.fromInt period) ) , ( "f", Maybe.map String.fromInt from ) , ( "t", Maybe.map String.fromInt to ) , ( "u", Just (renderUpdate upd) ) ] |> List.filterMap (\( k, vr ) -> Maybe.map (\v -> ( k, v )) vr) |> List.map (\( k, v ) -> String.join "-" [ k, v ]) |> String.join "," renderMonth ( m, u ) = String.join ":" [ String.fromInt m, renderUpdate u ] in List.map (UB.string "u_period" << renderPeriod) periodic ++ List.map (UB.string "u_bymon" << renderMonth) byMonth updatesInMonth : SimUpdates -> Int -> SimUpdates updatesInMonth { periodic, byMonth } month = let newPeriodically = List.filter (periodicUpdateInMonth month) periodic newByMonth = List.filter (\( m, _ ) -> m == month) byMonth in { periodic = newPeriodically, byMonth = newByMonth } simUpdatesEncode : SimUpdates -> JE.Value simUpdatesEncode { periodic, byMonth } = JE.object [ ( "periodic", JE.list periodicUpdateEncode periodic ) , ( "by_month" , JE.list (\( m, us ) -> JE.list identity [ JE.int m, simUpdateEncode us ]) byMonth ) ] simUpdatesDecoder : JD.Decoder SimUpdates simUpdatesDecoder = let monthUpdateDecoder = JD.map2 Tuple.pair (JD.index 0 JD.int) (JD.index 1 simUpdateDecoder) in JD.map2 SimUpdates (JD.field "periodic" (JD.list periodicUpdateDecoder)) (JD.field "by_month" (JD.list monthUpdateDecoder)) -- (JD.list JD.string -- |> JD.map -- (\( m, u ) -> -- ( Maybe.withDefault 0 -- (String.toInt -- m -- ) -- , simUpdateDecoder u -- ) -- ) -- ) -- ) -- ) -- (simUpdateDecoder -- >> JD.map -- (List.map (\( k, v ) -> ( Maybe.withDefault 0 (String.toInt k), v ))) -- ) -- ) -- ) type alias SimSpecs = { principal : Float , i1 : Float , years : Int , updates : SimUpdates } parseSimSpecs : RawSpecs -> Maybe SimSpecs parseSimSpecs { total, rate, i1, years, updates } = case ( List.map String.toFloat [ total, i1, rate ] , List.map String.toInt [ years ] ) of ( [ Just totalValueF, Just i1F, Just rateF ], [ Just yearsI ] ) -> Just { principal = totalValueF * rateF / 100 , i1 = i1F , years = yearsI , updates = updates } _ -> Nothing 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 ) ] 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 } type Language = ES | EN langToString : Language -> String langToString lang = case lang of ES -> "ES" EN -> "EN" langFromString : String -> Language langFromString lang = case lang of "ES" -> ES _ -> EN type Currency = USD | EUR currencyToString : Currency -> String currencyToString curr = case curr of EUR -> "EUR" USD -> "USD" currencyFromString : String -> Currency currencyFromString curr = case curr of "EUR" -> EUR _ -> USD currencySymbol : Currency -> String currencySymbol curr = case curr of EUR -> "€" USD -> "$" currencySep : Currency -> { thousands : Char, decimal : Char } currencySep curr = case curr of EUR -> { thousands = '.', decimal = ',' } USD -> { thousands = ',', decimal = '.' } type CurrencyOrder = Prefix | Postfix currencyOrder : Currency -> CurrencyOrder currencyOrder curr = case curr of EUR -> Postfix USD -> Prefix type alias Settings = { lang : Language , currency : Currency } defaultSettings : Settings defaultSettings = { lang = ES , currency = EUR } settingsParser : UQ.Parser Settings settingsParser = UQ.map2 Settings (UQ.map (Maybe.withDefault defaultSettings.lang << Maybe.map langFromString) <| UQ.string "lang") (UQ.map (Maybe.withDefault defaultSettings.currency << Maybe.map currencyFromString) <| UQ.string "currency") settingsToQS : Settings -> List UB.QueryParameter settingsToQS { lang, currency } = [ UB.string "lang" (langToString lang) , UB.string "currency" (currencyToString currency) ] type Editing = AddUpdate { type_ : SimUpdate, txt : String, month : Int, error : String } type alias Model = { settings : Settings , navKey : Nav.Key , error : String , rawSpecs : RawSpecs , expandedYears : Set Int , editing : Maybe Editing , simulation : Maybe ( RawSpecs, MortgageSim ) , t : String -> String } setModelUpdates : SimUpdates -> Model -> Model setModelUpdates newUpdates m = let rawSpecs = m.rawSpecs in { m | rawSpecs = { rawSpecs | updates = newUpdates } } type Route = NotFound | Root ( Settings, RawSpecs ) routeQuery : Route -> ( Settings, RawSpecs ) routeQuery route = case route of NotFound -> ( defaultSettings, defaultRawSpecs ) Root query -> query routeParser : U.Parser (Route -> a) a routeParser = U.oneOf [ U.map Root (U.top UQ.map2 Tuple.pair settingsParser rawSpecsParser) ] toRoute : Url -> Route toRoute url = Maybe.withDefault NotFound (U.parse routeParser url) init : () -> Url -> Nav.Key -> ( Model, Cmd Msg ) init () url navKey = { settings = defaultSettings , navKey = navKey , error = "" , rawSpecs = defaultRawSpecs , expandedYears = Set.empty , editing = Nothing , simulation = Nothing , t = identity } |> update (ChangedUrl url) -- UPDATE initialToRate : Float -> Int -> Float initialToRate initial principal = 100 - (100 * initial / toFloat principal) rateToInitial : Float -> Int -> Float rateToInitial rate principal = toFloat principal * ((100 - rate) / 100) convertInitialRate : (Float -> Int -> Float) -> String -> String -> Maybe String convertInitialRate convert val total = case ( String.toFloat val, String.toInt total ) of ( Just x, Just totalValueF ) -> Just <| String.fromFloat <| convert x totalValueF _ -> Nothing 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 type SpecField = Title | TotalValue | Rate | Initial | I1 | Years | VAT | Fee type SettingsChange = ToggleLang | ToggleCurrency type Msg = SetUrl UrlRequest | ChangedUrl Url | UpdateSpecs SpecField String | UpdateSettings SettingsChange | RunSim SimSpecs | GotSim Model (Result Http.Error MortgageSim) | SetExpandedYears (Set Int) | RmPeriodicUpdate PeriodicUpdate | RmUpdate ( Int, SimUpdate ) | ResetUpdates | SetEditing (Maybe Editing) | CommitEditing delete : a -> List a -> List a delete x l = case l of [] -> [] h :: t -> if x == h then t else h :: delete x t update : Msg -> Model -> ( Model, Cmd Msg ) update msg m = let _ = Debug.log "UPDATE!" msg in case msg of GotSim old_m (Ok msim) -> ( { m | simulation = Just ( old_m.rawSpecs, msim ) } , Cmd.none ) GotSim _ (Err err) -> ( { m | error = errorToString err }, Cmd.none ) RunSim specs -> ( m, Nav.pushUrl m.navKey (modelToUrl m) ) SetUrl (Internal url) -> ( m, Nav.pushUrl m.navKey (Url.toString url) ) SetUrl (External url) -> ( m, Nav.load url ) ChangedUrl url -> let ( settings, rawSpecs ) = routeQuery (toRoute url) newM = { m | settings = settings , rawSpecs = rawSpecs , t = make_t settings.lang } in ( newM , case parseSimSpecs rawSpecs of Nothing -> Cmd.none Just specs -> runSim newM specs ) RmPeriodicUpdate pu -> let updates = m.rawSpecs.updates periodicUpdates = updates.periodic newM = setModelUpdates { updates | periodic = delete pu periodicUpdates } m in ( m, Nav.pushUrl m.navKey (modelToUrl newM) ) RmUpdate mu -> let updates = m.rawSpecs.updates byMonUpdates = updates.byMonth newM = setModelUpdates { updates | byMonth = delete mu byMonUpdates } m in ( m, Nav.pushUrl m.navKey (modelToUrl newM) ) UpdateSpecs field val -> let rawSpecs = m.rawSpecs newRawSpecs = case field of Title -> { rawSpecs | title = val } TotalValue -> { rawSpecs | total = val , initial = Maybe.withDefault rawSpecs.initial <| convertInitialRate rateToInitial rawSpecs.rate val } Rate -> { rawSpecs | rate = val , initial = Maybe.withDefault rawSpecs.initial <| convertInitialRate rateToInitial val rawSpecs.total } Initial -> { rawSpecs | initial = val , rate = Maybe.withDefault rawSpecs.rate <| convertInitialRate initialToRate val rawSpecs.total } I1 -> { rawSpecs | i1 = val } Years -> { rawSpecs | years = val } VAT -> { rawSpecs | vat = val } Fee -> { rawSpecs | fee = val } in ( { m | rawSpecs = newRawSpecs }, Cmd.none ) ResetUpdates -> let rawSpecs = m.rawSpecs newM = { m | rawSpecs = { rawSpecs | updates = defaultSimUpdates } } in ( m, Nav.pushUrl m.navKey (modelToUrl newM) ) SetExpandedYears eyears -> ( { m | expandedYears = eyears }, Cmd.none ) SetEditing editing -> ( { m | editing = editing }, Cmd.none ) CommitEditing -> case m.editing of Just (AddUpdate au) -> case String.toFloat au.txt of Just f -> let u = case au.type_ of Amortize _ -> Amortize f SetI1 _ -> SetI1 (f / 100) updates = m.rawSpecs.updates byMonth = ( au.month, u ) :: updates.byMonth newM = { m | editing = Nothing } |> setModelUpdates { updates | byMonth = byMonth } in ( newM , Nav.pushUrl m.navKey (modelToUrl newM) ) Nothing -> ( { m | editing = Just (AddUpdate { au | error = m.t "Invalid input" }) } , Cmd.none ) _ -> ( m, Cmd.none ) UpdateSettings change -> let settings = m.settings newSettings = case change of ToggleLang -> { settings | lang = case settings.lang of EN -> ES ES -> EN } ToggleCurrency -> { settings | currency = case settings.currency of EUR -> USD USD -> EUR } in ( m, Nav.pushUrl m.navKey (modelToUrl { m | settings = newSettings }) ) -- VIEW (THEME) errorTxt : String -> Html Msg errorTxt error = span [ class "text-sm text-rose-600" ] [ text error ] primaryButAttrs : List (Attribute Msg) primaryButAttrs = [ class "px-1 rounded-md bg-lime-300 enabled:active:bg-lime-400 border border-lime-600 disabled:opacity-75", style "cursor" "pointer" ] secondaryButAttrs : List (Attribute Msg) secondaryButAttrs = [ class "px-1 rounded-md text-gray-600 enabled:active:bg-gray-300 border border-gray-400 disabled:opacity-75", style "cursor" "pointer" ] tertiaryButAttrs : List (Attribute Msg) tertiaryButAttrs = [ class "px-1 text-gray-600 enabled:active:bg-gray-300 disabled:opacity-75", style "cursor" "pointer" ] clickableAttrs : Msg -> List (Attribute Msg) clickableAttrs msg = [ onClick msg, class "text-lime-600", style "cursor" "pointer" ] prepayAttrs : List (Attribute Msg) prepayAttrs = [ class "bg-emerald-100 border-emerald-800" ] i1Attrs : List (Attribute Msg) i1Attrs = [ class "bg-yellow-100 border-yellow-800" ] txtInput : List (Attribute Msg) -> (String -> Msg) -> String -> Html Msg txtInput attributes onInputMsg valueTxt = input ([ class "border border-lime-500 border-2 px-2 focus:outline focus:outline-lime-500" , onInput onInputMsg , value valueTxt ] ++ attributes ) [] slider : List (Attribute Msg) -> (String -> Msg) -> String -> Html Msg slider attributes onInputMsg valueTxt = input (attributes ++ [ type_ "range" , class "mx-1 accent-lime-400" , onInput onInputMsg , value valueTxt ] ) [] -- VIEW insertThousandsSep : Currency -> String -> String insertThousandsSep currency str = let l = List.reverse <| String.toList str indexed = List.map2 Tuple.pair (List.range 0 (String.length str)) l withCommas = List.concatMap (\( i, c ) -> if i > 0 && modBy 3 i == 0 then [ (currencySep currency).thousands, c ] else [ c ] ) indexed in String.fromList <| List.reverse withCommas amountToString : Currency -> Float -> String amountToString currency amount = let amountStr = Round.round 2 amount in case String.split "." amountStr of int :: float :: [] -> let strs = [ insertThousandsSep currency int , String.fromChar (currencySep currency).decimal , float ] in String.join "" <| case currencyOrder currency of Prefix -> [ currencySymbol currency ] ++ strs Postfix -> strs ++ [ currencySymbol currency ] _ -> amountStr amountView : List (Attribute Msg) -> Currency -> Float -> Html Msg amountView attrs currency amount = let amountStr = Round.round 2 amount in span attrs <| 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) ] ++ floatPart in case currencyOrder currency of Prefix -> [ text (currencySymbol currency) ] ++ els Postfix -> els ++ [ text (currencySymbol currency) ] _ -> [ text amountStr ] titledAttrs : String -> List (Attribute Msg) titledAttrs title_ = [ class "underline", title title_ ] specsView : Model -> Html Msg specsView { t, settings, rawSpecs } = let { title, total, rate, initial, i1, years, vat, fee, updates } = rawSpecs simButAttrs = case parseSimSpecs rawSpecs of Nothing -> [ disabled True ] Just specs -> [ onClick (RunSim specs) ] in div [] [ div [] [ input [ class "min-w-full mb-2 py-1 px-3 text-xl font-bold" , placeholder (t "Title...") , value title , onInput (UpdateSpecs Title) ] [] ] , div [ class "flex my-1" ] [ text (t "Property price: ") , slider [ Html.Attributes.min "50000", Html.Attributes.max "800000", step "5000" ] (UpdateSpecs TotalValue) total , txtInput [ class "w-[100px]", Html.Attributes.min "0" ] (UpdateSpecs TotalValue) total , text <| currencySymbol settings.currency ] , div [ class "flex my-1" ] [ div [] [ text (t "Initial contribution: ") , txtInput [ class "w-[100px]", Html.Attributes.min "0", Html.Attributes.max total ] (UpdateSpecs Initial) initial , text <| currencySymbol settings.currency ] , div [ class "ml-4" ] [ text " (" , txtInput [ class "w-[55px]", Html.Attributes.min "10", Html.Attributes.max "100" ] (UpdateSpecs Rate) rate , text "%)" ] ] , div [ class "my-1" ] [ text (t "Interest rate: ") , txtInput [ class "w-[80px]", Html.Attributes.min "0", Html.Attributes.max "100" ] (UpdateSpecs I1) i1 , text " % (nominal)" ] , div [ class "flex my-1" ] [ text (t "Years: ") , slider [ Html.Attributes.min "1", Html.Attributes.max "40", step "1" ] (UpdateSpecs Years) years , text years ] , div [ class "flex my-1" ] [ div [] [ text (t "VAT: ") , txtInput [ class "w-[55px] mx-1", Html.Attributes.min "0", Html.Attributes.max "50" ] (UpdateSpecs VAT) vat , text "%" ] , div [ class "ml-6" ] [ text (t "Agent fee: ") , txtInput [ class "w-[55px] mx-1", Html.Attributes.min "0", Html.Attributes.max "10" ] (UpdateSpecs Fee) fee , text "%" ] ] , div [ class "flex justify-between my-1 mt-2" ] [ button (primaryButAttrs ++ simButAttrs ++ [ class "px-3" ]) [ text (t "Simulate") ] , div [ class "flex" ] [ button (secondaryButAttrs ++ [ class "px-3 mr-1", onClick (UpdateSettings ToggleLang) ]) [ text <| langToString settings.lang ] , button (secondaryButAttrs ++ [ class "px-3 mr-1", onClick (UpdateSettings ToggleCurrency) ]) [ text <| currencySymbol settings.currency ] ] ] ] simUpdateView : Model -> Bool -> SimUpdate -> Msg -> Html Msg simUpdateView m periodic upd onClick = let ( title_, attrs, els ) = case upd of Amortize f -> ( m.t "Early payment" , prepayAttrs , [ text (m.t "Payed: ") , amountView [] m.settings.currency f ] ) SetI1 f -> ( m.t "New interest rate" , i1Attrs , [ text (m.t "Interest: ") , text <| String.fromFloat (f * 100) , text "%" ] ) periodicIcon = if periodic then span [ title <| m.t "Periodic update" ] [ text "⟳ " ] else text "" in span (attrs ++ [ title title_, class "px-1 rounded-md border border-1" ]) (periodicIcon :: els ++ [ text " " , span (clickableAttrs onClick ++ [ title (m.t "Remove"), class "text-red-600" ]) [ text "×" ] ] ) quotaView : Model -> MortgageSim -> Quota -> Html Msg quotaView m { updates } { month, payed, pending_principal } = let monthUpdates = updatesInMonth updates month year = ((month - 1) // 12) + 1 monthInExpandedYear = Set.member year m.expandedYears ( toggleYearIcon, newExpandedYears ) = if monthInExpandedYear then ( "− ", Set.remove year m.expandedYears ) else ( "+ ", Set.insert year m.expandedYears ) periodicUpdates = List.map (\pu -> simUpdateView m True pu.upd (RmPeriodicUpdate pu)) monthUpdates.periodic byMonUpdates = List.map (\mu -> simUpdateView m False (Tuple.second mu) (RmUpdate mu)) monthUpdates.byMonth yearField = if modBy 12 (month - 1) == 0 then div [] [ span (clickableAttrs (SetExpandedYears newExpandedYears)) [ text toggleYearIcon ] , text (String.fromInt year) ] else text "" newUpdateButton = button (secondaryButAttrs ++ [ onClick << SetEditing << Just << AddUpdate <| { type_ = Amortize 0 , txt = "" , month = month , error = "" } , title (m.t "Add update") ] ) [ text "+" ] setUpdate = SetEditing << Just << AddUpdate newUpdateInput au = let ( commonAttrs, butAttrs, afterInput ) = case au.type_ of Amortize _ -> ( prepayAttrs , { prepay = [ class "bg-emerald-200" ] , i1 = [ style "cursor" "pointer", onClick (setUpdate <| { au | type_ = SetI1 0 }) ] } , text <| currencySymbol m.settings.currency ) SetI1 _ -> ( i1Attrs , { prepay = [ style "cursor" "pointer", onClick (setUpdate <| { au | type_ = Amortize 0 }) ] , i1 = [ class "bg-yellow-200" ] } , text "%" ) in div (commonAttrs ++ [ class "flex flex-col border border-1 rounded-md p-2" ]) [ div [ class "flex justify-center" ] [ button (butAttrs.prepay ++ [ class "px-1 border border-1" , title (m.t "Early payment") ] ) [ text <| m.t "Prepay:" ] , button (butAttrs.i1 ++ [ class "px-1 border border-1" , title (m.t "New interest rate") ] ) [ text <| m.t "Interest:" ] ] , div [ class "py-1" ] [ txtInput [ class "w-[100px] border" ] (\newTxt -> setUpdate { au | txt = newTxt }) au.txt , afterInput ] , errorTxt au.error , div [ class "flex justify-end gap-1" ] [ button (tertiaryButAttrs ++ [ onClick (SetEditing Nothing) ]) [ text <| m.t "Cancel" ] , button (primaryButAttrs ++ [ onClick CommitEditing ]) [ text <| m.t "Apply" ] ] ] newUpdateButtonOrInput = case m.editing of Just (AddUpdate au) -> if au.month == month then newUpdateInput au else newUpdateButton _ -> newUpdateButton updatesField = if modBy 12 (month - 1) == 0 && not monthInExpandedYear then text "..." else div [ class "flex flex-wrap items-start gap-1" ] (periodicUpdates ++ byMonUpdates ++ [ newUpdateButtonOrInput ] ) in if modBy 12 (month - 1) == 0 || monthInExpandedYear then tr [] (List.map (\t -> td [ class "px-3 py-1 border border-gray-300" ] [ t ]) [ yearField , text (String.fromInt month) , capitalSumView m payed , amountView [] m.settings.currency pending_principal , updatesField ] ) else text "" mortgageView : Model -> MortgageSim -> Html Msg mortgageView m sim = let clearUpdates = if m.rawSpecs.updates == defaultSimUpdates then text "" else button (tertiaryButAttrs ++ [ class "text-sm", onClick ResetUpdates ]) [ text (m.t "(reset)") ] titles = List.map (\t -> [ text <| m.t t ]) [ "Year", "Month", "Quota", "Pending" ] ++ [ [ text <| m.t "Updates", clearUpdates ] ] head = thead [ class "bg-lime-100" ] [ tr [] (List.map (\txt -> th [ class "px-3 py-1 border border-gray-300" ] 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, sim ) = let currency = m.settings.currency t = m.t parseFloat = Maybe.withDefault 0 << String.toFloat total = parseFloat rawSpecs.total initial = parseFloat rawSpecs.initial vat = total * parseFloat rawSpecs.vat / 100 fee = total * parseFloat rawSpecs.fee / 100 overview title financed extraLis = div [ class "my-2 p-1 border-2 rounded-md border-gray-400" ] [ p [] [ text title , amountView [ class "font-bold" ] currency (financed.principal + financed.interest + initial + vat + fee ) ] , ul [ class "list-inside list-disc" ] ([ li [] [ text <| t "Initial payment: " , amountView [] currency (initial + vat + fee) ] , li [] [ text <| t "Financed (mortgage): " , capitalSumView m financed ] ] ++ extraLis ) ] in div [] [ hr [ class "my-5" ] [] , p [] [ text <| t "Initial payment: " , amountView [ class "font-bold" ] currency (initial + vat + fee) ] , ul [ class "list-inside list-disc" ] [ li [] [ text <| t "Property: " , amountView [] currency initial ] , li [] [ text <| t "Agent fee: " , amountView [] currency fee ] , li [] [ text <| t "VAT: " , amountView [] currency vat ] ] , overview (t "Total to pay: ") sim.payed_noprepays [] , if sim.payed_amortized > 0 then overview (t "With early payments: ") sim.payed <| [ li [] [ text <| t "Payed early: " , amountView [] currency sim.payed_amortized ] , li [] [ text <| t "Saved: " , amountView [] currency (sim.payed_noprepays.interest - sim.payed.interest) ] ] else text "" , mortgageView m sim ] view : Model -> Document Msg view m = { title = "Hiccup" , body = [ div [ class "flex flex-col max-w-2xl mx-auto items-center mt-2 p-3 border-2 rounded-md border-gray-500 bg-gray-100" ] [ div [ class "min-w-full" ] [ specsView m , case m.simulation of Nothing -> text "" Just sim -> simView m sim , errorTxt m.error ] ] ] }