module Main exposing (main) import Browser import Html exposing (Attribute, Html, button, div, hr, input, span, table, tbody, td, text, th, thead, tr) 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 exposing (Decoder, field, float, int, list, map, map2, map3, map4) import Json.Encode as Encode exposing (Value, object) import Round import Set exposing (Set) -- MAIN main = Browser.element { init = init, update = update, view = view, subscriptions = \_ -> Sub.none } -- MODEL type alias Capital = { principal : Float , interest : Float } capitalDecoder : Decoder Capital capitalDecoder = map2 Capital (field "principal" float) (field "interest" float) 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) type alias SimSpecsRaw = { titleTxt : String , totalValueTxt : String , initialTxt : String , financedRateTxt : String , i1Txt : String , yearsTxt : String } simSpecsParse : SimSpecsRaw -> Maybe SimSpecs simSpecsParse { totalValueTxt, financedRateTxt, i1Txt, yearsTxt } = case ( List.map String.toFloat [ totalValueTxt, i1Txt ] , List.map String.toInt [ financedRateTxt, yearsTxt ] ) of ( [ Just totalValue, Just i1 ], [ Just rate, Just years ] ) -> Just { principal = totalValue * toFloat rate / 100, i1 = i1, years = years } _ -> Nothing type alias SimSpecs = { principal : Float , i1 : Float , years : Int } type alias Model = { error : String , simSpecsRaw : SimSpecsRaw , expandedYears : Set Int , 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 simSpecsRaw = { titleTxt = "" , totalValueTxt = "200000" , financedRateTxt = "80" , initialTxt = "40000" , i1Txt = "1.621" , yearsTxt = "30" } in ( { error = "", simSpecsRaw = simSpecsRaw, expandedYears = Set.empty, simulation = Nothing }, Cmd.none ) -- UPDATE type SimSpecUpdate = Title | Principal | Rate | Initial | I1 | Years 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 totalValueTxt = case ( String.toFloat val, String.toInt totalValueTxt ) of ( Just x, Just totalValue ) -> Just <| String.fromFloat <| convert x totalValue _ -> Nothing type Msg = GotSimulation (Result Http.Error Simulation) | UpdateSimSpecs SimSpecUpdate String | RunSimulation SimSpecs | SetExpandedYears (Set Int) update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = 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 specs -> ( model, runSimulation specs ) UpdateSimSpecs u val -> let simSpecsRaw = model.simSpecsRaw newSimSpecsTxt = case u of Title -> { simSpecsRaw | titleTxt = val } Principal -> { simSpecsRaw | totalValueTxt = val } Rate -> { simSpecsRaw | financedRateTxt = val , initialTxt = Maybe.withDefault simSpecsRaw.initialTxt <| convertInitialRate rateToInitial val simSpecsRaw.totalValueTxt } Initial -> { simSpecsRaw | initialTxt = val , financedRateTxt = Maybe.withDefault simSpecsRaw.financedRateTxt <| convertInitialRate initialToRate val simSpecsRaw.totalValueTxt } I1 -> { simSpecsRaw | i1Txt = val } Years -> { simSpecsRaw | yearsTxt = val } in ( { model | simSpecsRaw = newSimSpecsTxt }, Cmd.none ) SetExpandedYears eyears -> ( { model | expandedYears = eyears }, Cmd.none ) -- VIEW (THEME) butAttrs : List (Attribute Msg) butAttrs = [ class "px-3 rounded-md bg-lime-300 enabled:active:bg-lime-400 border border-lime-600 disabled:opacity-75" ] clickableAttrs : Msg -> List (Attribute Msg) clickableAttrs msg = [ onClick msg, class "text-lime-600", style "cursor" "pointer" ] -- 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 : SimSpecsRaw -> Html Msg specsView simSpecsRaw = let { titleTxt, totalValueTxt, financedRateTxt, initialTxt, i1Txt, yearsTxt } = simSpecsRaw simSpecs = simSpecsParse simSpecsRaw simButAttrs = case simSpecs of Nothing -> [ disabled True ] Just specs -> [ onClick (RunSimulation specs) ] in div [] [ div [] [ input [ class "min-w-full mb-2 py-1 px-3 text-xl font-bold lime-100" , placeholder "Title..." , value titleTxt , onInput (UpdateSimSpecs Title) ] [] ] , div [ class "flex my-1" ] [ text "Property price: " , input [ type_ "range" , class "accent-lime-400" , Html.Attributes.min "0" , Html.Attributes.max "1000000" , step "5000" , value totalValueTxt , onInput (UpdateSimSpecs Principal) ] [] , text totalValueTxt ] , div [ class "flex my-1" ] [ div [ class "" ] [ text "Initial contribution: " , input [ class "w-[100px] border border-lime-500 border-2 px-2" , Html.Attributes.min "0" , Html.Attributes.max totalValueTxt , value initialTxt , onInput (UpdateSimSpecs Initial) ] [] ] , div [ class "ml-4" ] [ text " (" , input [ class "w-[50px] border border-lime-500 border-2 px-2" , Html.Attributes.min "10" , Html.Attributes.max "100" , value financedRateTxt , onInput (UpdateSimSpecs Rate) ] [] , text "%)" ] ] , div [ class "my-1" ] [ text "Interest rate: " , input [ class "w-[80px] border border-lime-500 border-2 px-2" , Html.Attributes.min "0" , Html.Attributes.max "100" , value i1Txt , onInput (UpdateSimSpecs I1) ] [] , text " % (nominal)" ] , div [ class "flex my-1 mb-2" ] [ text "Years: " , input [ type_ "range" , class "accent-lime-400" , Html.Attributes.min "1" , Html.Attributes.max "50" , step "1" , value yearsTxt , onInput (UpdateSimSpecs Years) ] [] , text yearsTxt ] , button (butAttrs ++ simButAttrs) [ text "Simulate" ] ] historyView : Model -> List Quota -> Html Msg historyView m quotas = let titles = [ "Year", "Month", "Quota", "Pending" ] head = thead [ class "bg-lime-100" ] [ tr [] (List.map (\t -> th [ class "px-3 py-1 border border-gray-300" ] [ text t ]) 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 ) ] ] capitalSumView : Capital -> Html Msg capitalSumView { principal, interest } = let partsTitle = String.concat [ "Principal: " , Round.round 2 principal , "\nInterest: " , Round.round 2 interest , " (" , Round.round 2 (100 * interest / (principal + interest)) , "% from total)" ] in span [ class "underline", title partsTitle ] [ text (Round.round 2 (principal + interest)) ] 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 payed , text (Round.round 2 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 payed , text (Round.round 2 pending_principal) ] ) else text "" simView : Model -> Simulation -> Html Msg simView m { history, topay, payed } = let { totalValueTxt, initialTxt } = m.simSpecsRaw total = Round.round 2 <| topay.principal + topay.interest + Maybe.withDefault 0 (String.toFloat initialTxt) in div [] [ hr [ class "my-5" ] [] , div [] [ text "To pay: " , text total , text " (" , text initialTxt , text " initial + " , capitalSumView topay , text " financed)" ] -- , div [] [ text "payed: ", capitalSumView payed ] , historyView m history ] view : Model -> Html Msg view m = 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.simSpecsRaw , case m.simulation of Nothing -> text "" Just sim -> simView m sim , text m.error ] ]