module Main exposing (main) import Browser exposing (Document, UrlRequest(..)) import Browser.Navigation as Nav import Html exposing ( Attribute , Html , a , button , div , hr , input , 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 exposing (Decoder, field, float, int, list, map2, map3, map4) import Json.Encode as Encode exposing (Value, object) 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 de 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 = { 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 Capital = { principal : Float , interest : Float } capitalDecoder : Decoder Capital capitalDecoder = map2 Capital (field "principal" float) (field "interest" 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 = { history : List Quota , topay : Capital , payed : Capital , payed_amortized : Float } simDecoder : Decoder MortgageSim simDecoder = map4 MortgageSim (field "history" (list quotaDecoder)) (field "topay" capitalDecoder) (field "payed" capitalDecoder) (field "payed_amortized" 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 alias MortgageSpecs = { principal : Float , i1 : Float , years : Int } parseMortgageSpecs : RawSpecs -> Maybe MortgageSpecs parseMortgageSpecs { 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 } _ -> 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 ] runMortgageSim : Model -> MortgageSpecs -> Cmd Msg runMortgageSim m mortgageSpecs = Http.get { url = mortgageSpecsToUrl mortgageSpecs , expect = Http.expectJson (GotMortgageSim 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 currencyPP : Currency -> String currencyPP 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 | RunMortgageSim MortgageSpecs | GotMortgageSim 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 GotMortgageSim old_m (Ok msim) -> ( { m | simulation = Just ( old_m.rawSpecs, msim ) } , Cmd.none ) GotMortgageSim _ (Err err) -> ( { m | error = errorToString err }, Cmd.none ) RunMortgageSim specs -> ( m , batch [ runMortgageSim 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 -> [ currencyPP currency ] ++ strs Postfix -> strs ++ [ currencyPP 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 els = [ text (insertThousandsSep currency int) , text <| String.fromChar (currencySep currency).decimal , span [ class "text-sm" ] [ text float ] ] in span [] <| case currencyOrder currency of Prefix -> [ text (currencyPP currency) ] ++ els Postfix -> els ++ [ text (currencyPP currency) ] _ -> text amountStr specsView : Model -> Html Msg specsView { t, settings, rawSpecs } = let { title, total, rate, initial, i1, years, vat, fee } = rawSpecs simButAttrs = case parseMortgageSpecs rawSpecs of Nothing -> [ disabled True ] Just specs -> [ onClick (RunMortgageSim specs) ] in div [] [ div [] [ input [ class "min-w-full mb-2 py-1 px-3 text-xl font-bold lime-100" , 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 ] , 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 ] , 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 <| currencyPP settings.currency ] ] ] ] 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 ) ] ] periodToYear : Int -> Int periodToYear period = ((period - 1) // 12) + 1 quotaView : Model -> Quota -> Html Msg quotaView m { period, payed, pending_principal } = let year = periodToYear period yearExpanded = 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 "+ " ) ] , text (String.fromInt year) ] , text (String.fromInt period) , capitalSumView m payed , amountView m.settings.currency pending_principal ] ) else if yearExpanded then tr [] (List.map (\t -> td [ class "px-3 py-1 border border-gray-300" ] [ t ]) [ text "" , text (String.fromInt period) , capitalSumView m payed , amountView m.settings.currency pending_principal ] ) else text "" simView : Model -> ( RawSpecs, MortgageSim ) -> Html Msg simView m ( rawSpecs, { history, topay, payed } ) = 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 in div [] [ hr [ class "my-5" ] [] , pre [ class "leading-none" ] [ text <| t "Total to pay: " , amountView currency (topay.principal + topay.interest + initial + vat + fee) , text "\n├ " , 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 , text "\n└ " , text <| t "Financed (mortgage): " , capitalSumView m topay ] -- , div [] [ text "payed: ", capitalSumView m payed ] , historyView m history ] 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 , text m.error ] ] ] }