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 , p , pre , span , table , tbody , td , text , th , thead , tr ) import Html.Attributes exposing ( class , disabled , href , 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: " "Initial payment: " -> "Pago inicial: " "Property: " -> "Inmueble: " "Financed (mortgage): " -> "Financiado (hipoteca): " "Year" -> "Año" "Month" -> "Mes" "Quota" -> "Cuota" "Pending" -> "Pendiente" _ -> 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 span [ class "underline", title partsTitle ] [ amountView settings.currency (principal + interest) ] type alias MortgageSim = { updates : SimUpdates , history : List Quota , topay : Capital , payed : Capital , payed_amortized : Float } simDecoder : JD.Decoder MortgageSim simDecoder = 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 = { title : String , total : String , initial : String , rate : String , i1 : String , years : String , vat : String , fee : String } defaultRawSpecs : RawSpecs defaultRawSpecs = { title = "" , total = "200000" , initial = "40000" , rate = "80" , i1 = "1.621" , years = "30" , vat = "6" , fee = "3" } 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") rawSpecsToQS : RawSpecs -> List UB.QueryParameter rawSpecsToQS { title, total, initial, rate, i1, years, vat, fee } = [ 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 ] 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 = { 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 } 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 ] ) -> let updates = { periodically = [], byMonth = [] } in Just { principal = totalValueF * toFloat rateI / 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 alias Model = { settings : Settings , navKey : Nav.Key , error : String , rawSpecs : RawSpecs , expandedYears : Set Int , simulation : Maybe ( RawSpecs, MortgageSim ) , t : String -> String } 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 = let ( settings, rawSpecs ) = routeQuery (toRoute url) in ( { settings = settings , navKey = navKey , error = "" , rawSpecs = rawSpecs , expandedYears = Set.empty , simulation = Nothing , t = make_t settings.lang } , Cmd.none ) -- 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) 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 , batch [ runSim m specs, 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) in ( { m | settings = settings , rawSpecs = rawSpecs , t = make_t settings.lang } , Cmd.none ) 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 ) SetExpandedYears eyears -> ( { m | expandedYears = eyears }, 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) primaryButAttrs : List (Attribute Msg) primaryButAttrs = [ class "px-3 rounded-md bg-lime-300 enabled:active:bg-lime-400 border border-lime-600 disabled:opacity-75" ] secondaryButAttrs : List (Attribute Msg) secondaryButAttrs = [ class "px-3 rounded-md text-gray-700 enabled:active:bg-lime-400 border border-2 border-gray-500 disabled:opacity-75" ] clickableAttrs : Msg -> List (Attribute Msg) clickableAttrs msg = [ onClick msg, class "text-lime-600", style "cursor" "pointer" ] 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 : Currency -> Float -> Html Msg amountView currency amount = let amountStr = Round.round 2 amount in 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 span [] <| case currencyOrder currency of Prefix -> [ text (currencySymbol currency) ] ++ els Postfix -> els ++ [ text (currencySymbol currency) ] _ -> text amountStr specsView : Model -> Html Msg specsView { t, settings, rawSpecs } = let { title, total, rate, initial, i1, years, vat, fee } = 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) [ text (t "Simulate") ] , div [ class "flex" ] [ button (secondaryButAttrs ++ [ class "mr-1", onClick (UpdateSettings ToggleLang) ]) [ text <| langToString settings.lang ] , button (secondaryButAttrs ++ [ class "mr-1", onClick (UpdateSettings ToggleCurrency) ]) [ text <| currencySymbol settings.currency ] ] ] ] monthToYear : Int -> Int monthToYear month = ((month - 1) // 12) + 1 simUpdateView : List (Attribute Msg) -> Model -> SimUpdate -> Html Msg simUpdateView attrs m upd = case upd of Amortize f -> p attrs [ text "+", amountView m.settings.currency f ] SetI1 f -> p attrs [ text <| String.fromFloat f, text "%" ] quotaView : Model -> MortgageSim -> Quota -> Html Msg quotaView m { updates } { month, payed, pending_principal } = let monthUpdates = updatesInMonth updates month year = monthToYear month monthInExpandedYear = Set.member year m.expandedYears ( 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 "..." ) else ( text "" , div [] (List.map (simUpdateView [ class "bg-lime-200" ] m << .upd) monthUpdates.periodically ++ (List.map (simUpdateView [ class "bg-lime-200" ] m) <| List.concatMap Tuple.second monthUpdates.byMonth ) ) ) 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 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, 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 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" ] [] , pre [ class "leading-none" ] [ text <| t "Initial payment: " , amountView currency (initial + vat + fee) , text "\n├ " , text <| t "Property: " , amountView currency initial , text "\n├ " , text <| t "Agent fee: " , amountView currency fee , text "\n└ " , text <| t "VAT: " , amountView currency vat ] , 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 ] view : Model -> Document Msg view m = { title = "Hiccup" , body = [ div [ class "flex flex-col max-w-lg 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 , span [ class "text-rose-600" ] [ text m.error ] ] ] ] }